From 6e9805a9835de4c39219ca50229003ca9b8769ed Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Tue, 8 Feb 2011 14:57:54 -0500 Subject: [PATCH] exercise 5.41 on lexical addressing. --- cm.rkt | 100 ++++++++++++++++++++++++++++++++--------------- runtime.js | 112 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 180 insertions(+), 32 deletions(-) create mode 100644 runtime.js diff --git a/cm.rkt b/cm.rkt index f4024e9..a1815e4 100644 --- a/cm.rkt +++ b/cm.rkt @@ -9,29 +9,56 @@ +;; A compile-time environment is a (listof (listof symbol)). +;; A lexical address is either a 2-tuple (depth pos), or 'not-found. + + +;; find-variable: symbol compile-time-environment -> lexical-address +;; Find where the variable should be located. +(define (find-variable name cenv) + (define (find-pos sym los) + (cond + [(eq? sym (car los)) + 0] + [else + (add1 (find-pos sym (cdr los)))])) + (let loop ([cenv cenv] + [depth 0]) + (cond [(empty? cenv) + 'not-found] + [(member name (first cenv)) + (list depth (find-pos name (first cenv)))] + [else + (loop (rest cenv) (add1 depth))]))) + + + + + ;; compile: expression target linkage -> instruction-sequence -(define (compile exp target linkage) +(define (compile exp cenv target linkage) (cond [(self-evaluating? exp) - (compile-self-evaluating exp target linkage)] + (compile-self-evaluating exp cenv target linkage)] [(quoted? exp) - (compile-quoted exp target linkage)] + (compile-quoted exp cenv target linkage)] [(variable? exp) - (compile-variable exp target linkage)] + (compile-variable exp cenv target linkage)] [(assignment? exp) - (compile-assignment exp target linkage)] + (compile-assignment exp cenv target linkage)] [(definition? exp) - (compile-definition exp target linkage)] + (compile-definition exp cenv target linkage)] [(if? exp) - (compile-if exp target linkage)] + (compile-if exp cenv target linkage)] [(lambda? exp) - (compile-lambda exp target linkage)] + (compile-lambda exp cenv target linkage)] [(begin? exp) (compile-sequence (begin-actions exp) + cenv target linkage)] [(application? exp) - (compile-application exp target linkage)] + (compile-application exp cenv target linkage)] [else (error 'compile "Unknown expression type ~e" exp)])) @@ -53,7 +80,7 @@ (compile-linkage linkage))) -(define (compile-self-evaluating exp target linkage) +(define (compile-self-evaluating exp cenv target linkage) (end-with-linkage linkage (make-instruction-sequence '() @@ -61,7 +88,7 @@ `((assign ,target (const ,exp)))))) -(define (compile-quoted exp target linkage) +(define (compile-quoted exp cenv target linkage) (end-with-linkage linkage (make-instruction-sequence '() @@ -69,7 +96,8 @@ `((assign ,target (const ,(text-of-quotation exp))))))) -(define (compile-variable exp target linkage) +(define (compile-variable exp cenv target linkage) + ;; FIXME: must find lexical address (end-with-linkage linkage (make-instruction-sequence '(env) @@ -81,10 +109,11 @@ -(define (compile-assignment exp target linkage) +(define (compile-assignment exp cenv target linkage) + ;; FIXME: must find lexical address (let ([var (assignment-variable exp)] [get-value-code - (compile (assignment-value exp) 'val 'next)]) + (compile (assignment-value exp) cenv 'val 'next)]) (end-with-linkage linkage (preserving '(env) @@ -99,10 +128,11 @@ (assign ,target (const ok)))))))) -(define (compile-definition exp target linkage) +(define (compile-definition exp cenv target linkage) + ;; FIXME: must find lexical address (let ([var (definition-variable exp)] [get-value-code - (compile (definition-value exp) 'val 'next)]) + (compile (definition-value exp) cenv 'val 'next)]) (end-with-linkage linkage (preserving @@ -119,7 +149,7 @@ -(define (compile-if exp target linkage) +(define (compile-if exp cenv target linkage) (let ([t-branch (make-label 'trueBranch)] [f-branch (make-label 'falseBranch)] [after-if (make-label 'afterIf)]) @@ -127,9 +157,9 @@ (if (eq? linkage 'next) after-if linkage)]) - (let ([p-code (compile (if-predicate exp) 'val 'next)] - [c-code (compile (if-consequent exp) target consequent-linkage)] - [a-code (compile (if-alternative exp) target linkage)]) + (let ([p-code (compile (if-predicate exp) cenv 'val 'next)] + [c-code (compile (if-consequent exp) cenv target consequent-linkage)] + [a-code (compile (if-alternative exp) cenv target linkage)]) (preserving '(env cont) p-code (append-instruction-sequences @@ -145,15 +175,16 @@ -(define (compile-sequence seq target linkage) +(define (compile-sequence seq cenv target linkage) (if (last-exp? seq) - (compile (first-exp seq) target linkage) + (compile (first-exp seq) cenv target linkage) (preserving '(env cont) - (compile (first-exp seq) target 'next) - (compile-sequence (rest-exps seq) target linkage)))) + (compile (first-exp seq) cenv target 'next) + (compile-sequence (rest-exps seq) cenv target linkage)))) -(define (compile-lambda exp target linkage) +(define (compile-lambda exp cenv target linkage) + ;; FIXME: must extend compile-time lexical environment (let ([proc-entry (make-label 'entry)] [after-lambda (make-label 'afterLambda)]) (let ([lambda-linkage @@ -170,10 +201,12 @@ (op make-compiled-procedure) (label ,proc-entry) (reg env))))) - (compile-lambda-body exp proc-entry)) + (compile-lambda-body exp cenv + proc-entry)) after-lambda)))) -(define (compile-lambda-body exp proc-entry) +(define (compile-lambda-body exp cenv proc-entry) + ;; FIXME: must extend compile-time lexical environment (let ([formals (lambda-parameters exp)]) (append-instruction-sequences (make-instruction-sequence @@ -186,13 +219,13 @@ (const ,formals) (reg argl) (reg env)))) - (compile-sequence (lambda-body exp) 'val 'return)))) + (compile-sequence (lambda-body exp) cenv 'val 'return)))) -(define (compile-application exp target linkage) - (let ([proc-code (compile (operator exp) 'proc 'next)] +(define (compile-application exp cenv target linkage) + (let ([proc-code (compile (operator exp) cenv 'proc 'next)] [operand-codes (map (lambda (operand) - (compile operand 'val 'next)) + (compile operand cenv 'val 'next)) (operands exp))]) (preserving '(env cont) proc-code @@ -591,12 +624,14 @@ [else (format "~a(~a)" (case op-name + [(lookup-variable-value) "_envLookup"] [(set-variable-value!) "_envSet"] [(define-variable!) "_envDefine"] + [(extend-environment) "_envExtend"] + [(false?) "_isFalse"] [(make-compiled-procedure) "_makeClosure"] - [(extend-environment) "_envExtend"] [(list) "_list"] [(cons) "_cons"] [(primitive-procedure?) "_isPrimProc"] @@ -635,6 +670,7 @@ (define (test source-code) (let ([basic-blocks (fracture (statements (compile source-code + '() 'val 'next)))]) (printf "var invoke = function(MACHINE, k) {\n") diff --git a/runtime.js b/runtime.js new file mode 100644 index 0000000..974e4a6 --- /dev/null +++ b/runtime.js @@ -0,0 +1,112 @@ +var TopEnvironment = function() { + this.bindings = {'=': function(argl) { + return argl[0] === argl[1][0]; + }, + '+': function(argl) { + return argl[0] + argl[1][0]; + }, + '-': function(argl) { + return argl[0] - argl[1][0]; + } + }; + this.parent = undefined; +}; + +var ExtendedEnvironment = function(parent) { + this.bindings = {}; + this.parent = parent; +}; + + +var Closure = function(env, label) { + this.env = env; + this.label = label; +}; + + +var _isFalse = function(x) { if(x) return false; return true; } +var _isPrimProc = function(x) { return typeof(x) === 'function'; }; +var _applyPrimProc = function(p, argl) { return p(argl); } +var _closureEnv = function(c) { return c.env; } +var _closureEntry = function(c) { return c.label; } +var _makeClosure = function(l, e) { return new Closure(e, l); } +var _envDefine = function(n, v, e) { + e.bindings[n] = v; +}; +var _envExtend = function(ns, vs, e) { + var e2 = new ExtendedEnvironment(e); + while(ns) { + e2.bindings[ns[0]] = vs[0]; + ns = ns[1]; vs = vs[1]; + } + return e2; +}; +var _envLookup = function(n, e) { + while (e) { + if (e.bindings.hasOwnProperty(n)) { + return e.bindings[n]; + } + e = e.parent; + } + throw new Error("Not bound: " + n); +}; + + +////////////////////////////////////////////////////////////////////// +// Lexical addressing +var _lexicalAddressLookup = function(depth, pos, env) { + // FIXME +}; + +var _lexicalAddressAssign = function(depth, pos, env, value) { + // FIXME +}; + +////////////////////////////////////////////////////////////////////// + + + + + +var _cons = function(x, y) { return [x, y]; } +var _list = function() { + var i; + var result; + for (i = arguments.length - 1; i >= 0; i--) { + result = [arguments[i], result]; + } + return result; +} + + +var MACHINE={callsBeforeTrampoline: 100, + env: new TopEnvironment(), + proc:undefined, + argl:undefined, + val:undefined, + cont:undefined, + stack: []}; + + +// harness: (->) (->) -> void +var _harness = function(thunk, k) { + var toCall; + MACHINE.callsBeforeTrampoline = 100; + while(thunk) { + try { + toCall = thunk; + thunk = undefined; + toCall(); + } catch (e) { + if (typeof(e) === 'function') { + thunk = e; + MACHINE.callsBeforeTrampoline = 100; + } else if (e === 'done') { + break; + } else { + throw e; + } + } + } + k(); +};