diff --git a/cm.rkt b/cm.rkt index 1946eff..f2d34cc 100644 --- a/cm.rkt +++ b/cm.rkt @@ -17,7 +17,7 @@ ;; A compile-time environment is a (listof (listof symbol)). ;; A lexical address is either a 2-tuple (depth pos), or 'not-found. (define-type CompileTimeEnvironment (Listof (Listof Symbol))) -(define-type LexicalAddress (List Number Number)) +(define-type LexicalAddress (U (List Number Number) 'not-found)) ;; find-variable: symbol compile-time-environment -> lexical-address ;; Find where the variable should be located. @@ -30,8 +30,8 @@ 0] [else (add1 (find-pos sym (cdr los)))])) - (let: loop : (U LexicalAddress 'not-found) ([cenv : CompileTimeEnvironment cenv] - [depth : Natural 0]) + (let: loop : LexicalAddress ([cenv : CompileTimeEnvironment cenv] + [depth : Natural 0]) (cond [(empty? cenv) 'not-found] [(member name (first cenv)) @@ -39,11 +39,6 @@ [else (loop (rest cenv) (add1 depth))]))) -;; global-lexical-address?: lexical-address -> boolean -;; Produces true if the address refers to the toplevel environment. -(: global-lexical-address? (LexicalAddress -> Boolean)) -(define (global-lexical-address? address) - (eq? address 'not-found)) ;; extend-lexical-environment: lexical-environment (listof symbol) -> lexical-envrionment @@ -98,7 +93,7 @@ instruction-sequence (compile-linkage linkage))) -(: compile-self-evaluating (Expression CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-self-evaluating (Constant CompileTimeEnvironment Target Linkage -> InstructionSequence)) (define (compile-self-evaluating exp cenv target linkage) (end-with-linkage linkage (make-instruction-sequence @@ -106,7 +101,7 @@ (list target) `((assign ,target (const ,exp)))))) -(: compile-quoted (Expression CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-quoted (Quote CompileTimeEnvironment Target Linkage -> InstructionSequence)) (define (compile-quoted exp cenv target linkage) (end-with-linkage linkage (make-instruction-sequence @@ -114,11 +109,11 @@ (list target) `((assign ,target (const ,(Quote-text exp))))))) -(: compile-variable (Expression CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-variable (Var CompileTimeEnvironment Target Linkage -> InstructionSequence)) (define (compile-variable exp cenv target linkage) - (let ([lexical-pos (find-variable exp cenv)]) + (let ([lexical-pos (find-variable (Var-id exp) cenv)]) (cond - [(global-lexical-address? lexical-pos) + [(eq? lexical-pos 'not-found) (end-with-linkage linkage (make-instruction-sequence '(env) @@ -126,11 +121,11 @@ ;; Slight modification: explicitly testing for ;; global variable binding before lookup. `((perform (op check-bound-global!) - (const ,exp) + (const ,(Var-id exp)) (reg env)) (assign ,target (op lookup-variable-value) - (const ,exp) + (const ,(Var-id exp)) (reg env)))))] [else (end-with-linkage linkage @@ -144,7 +139,7 @@ (reg env)))))]))) -(: compile-assignment (Expression CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-assignment (Assign CompileTimeEnvironment Target Linkage -> InstructionSequence)) (define (compile-assignment exp cenv target linkage) (let* ([var (Assign-variable exp)] [get-value-code @@ -152,7 +147,7 @@ [lexical-address (find-variable var cenv)]) (cond - [(global-lexical-address? lexical-address) + [(eq? lexical-address 'not-found) (end-with-linkage linkage (preserving '(env) @@ -182,7 +177,7 @@ ;; FIXME: exercise 5.43 -(: compile-definition (Expression CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-definition (Def CompileTimeEnvironment Target Linkage -> InstructionSequence)) (define (compile-definition exp cenv target linkage) (let ([var (Def-variable exp)] [get-value-code @@ -202,7 +197,7 @@ (assign ,target (const ok)))))))) -(: compile-if (Expression CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-if (Branch CompileTimeEnvironment Target Linkage -> InstructionSequence)) (define (compile-if exp cenv target linkage) (let ([t-branch (make-label 'trueBranch)] [f-branch (make-label 'falseBranch)] @@ -237,7 +232,7 @@ (compile-sequence (rest-exps seq) cenv target linkage)))) -(: compile-lambda (Expression CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence)) (define (compile-lambda exp cenv target linkage) (let ([proc-entry (make-label 'entry)] [after-lambda (make-label 'afterLambda)]) @@ -265,7 +260,7 @@ proc-entry)) after-lambda)))) -(: compile-lambda-body (Expression CompileTimeEnvironment Linkage -> InstructionSequence)) +(: compile-lambda-body (Lam CompileTimeEnvironment Linkage -> InstructionSequence)) (define (compile-lambda-body exp cenv proc-entry) (let* ([formals (Lam-parameters exp)] [extended-cenv (extend-lexical-environment cenv formals)]) @@ -281,10 +276,10 @@ (reg env)))) (compile-sequence (Lam-body exp) extended-cenv 'val 'return)))) -(: compile-application (Expression CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-application (App CompileTimeEnvironment Target Linkage -> InstructionSequence)) (define (compile-application exp cenv target linkage) (let ([proc-code (compile (App-operator exp) cenv 'proc 'next)] - [operand-codes (map (lambda (operand) + [operand-codes (map (lambda: ([operand : Expression]) (compile operand cenv 'val 'next)) (App-operands exp))]) (preserving '(env cont) @@ -399,11 +394,11 @@ (: needs-register? (InstructionSequence Symbol -> Boolean)) (define (needs-register? seq reg) - (memq reg (registers-needed seq))) + (and (memq reg (registers-needed seq)) #t)) (: modifies-register? (InstructionSequence Symbol -> Boolean)) (define (modifies-register? seq reg) - (memq reg (registers-modified seq))) + (and (memq reg (registers-modified seq)) #t)) (: preserving ((Listof Symbol) InstructionSequence InstructionSequence -> InstructionSequence)) (define (preserving regs seq1 seq2) @@ -426,7 +421,7 @@ -(: append-instruction-sequence (InstructionSequence * -> InstructionSequence)) +(: append-instruction-sequences (InstructionSequence * -> InstructionSequence)) (define (append-instruction-sequences . seqs) (append-seq-list seqs))