still need to work on procedure application

compile.rkt

@@ -38,7 +38,7 @@
      (compile-definition exp cenv target linkage)]
     [(Branch? exp)
      (compile-branch exp cenv target linkage)]
-    #;[(Lam? exp)
+    [(Lam? exp)
      (compile-lambda exp cenv target linkage)]
     [(Seq? exp)
      (compile-sequence (Seq-actions exp)
@@ -156,7 +156,7 @@
                                        (make-instruction-sequence
                                         `(,(make-TestStatement 'false? 'val)
                                           ,(make-BranchLabelStatement f-branch)))
-                                       (parallel-instruction-sequences
+                                       (append-instruction-sequences
                                         (append-instruction-sequences t-branch c-code)
                                         (append-instruction-sequences f-branch a-code))
                                        after-if))))))
@@ -170,8 +170,8 @@
                                     (compile-sequence (rest-exps seq) cenv target linkage))))
 
 
-#;(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence))
+(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence))
-#;(define (compile-lambda exp cenv target linkage) 
+(define (compile-lambda exp cenv target linkage) 
   (let ([proc-entry (make-label 'entry)]
         [after-lambda (make-label 'afterLambda)])
     (let ([lambda-linkage
@@ -179,8 +179,9 @@
                after-lambda
                linkage)])
       (append-instruction-sequences
-       (tack-on-instruction-sequence
+       (append-instruction-sequences
         (end-with-linkage lambda-linkage
+                          cenv
                           (make-instruction-sequence 
                            `(,(make-AssignPrimOpStatement target
                                                           'make-compiled-procedure
@@ -196,21 +197,19 @@
                              proc-entry))
        after-lambda))))
 
-#;(: compile-lambda-body (Lam CompileTimeEnvironment Linkage -> InstructionSequence))
+(: compile-lambda-body (Lam CompileTimeEnvironment Linkage -> InstructionSequence))
-#;(define (compile-lambda-body exp cenv proc-entry)
+(define (compile-lambda-body exp cenv proc-entry)
   (let* ([formals (Lam-parameters exp)]
          [extended-cenv (extend-lexical-environment cenv formals)])
     (append-instruction-sequences
      (make-instruction-sequence 
       `(,proc-entry
+        ;; FIXME: not right: we need to install the closure values here,
+        ;; instead of replacing the environment altogether.
         ,(make-AssignPrimOpStatement 'env 
                                      'compiled-procedure-env
-                                     (list (make-Reg 'proc)))
+                                     (list (make-Reg 'proc)))))
-        ,(make-AssignPrimOpStatement 'env
+     (compile (Lam-body exp) extended-cenv 'val 'return))))
-                'extend-environment
-                (list (make-Reg 'argl)
-                      (make-Reg 'env)))))
-     (compile-sequence (Lam-body exp) extended-cenv 'val 'return))))
 
 #;(: compile-application (App CompileTimeEnvironment Target Linkage -> InstructionSequence))
 #;(define (compile-application exp cenv target linkage) 
@@ -220,7 +219,10 @@
   (let ([proc-code (compile (App-operator exp) cenv 'proc 'next)]
         [operand-codes (map (lambda: ([operand : Expression])
                               (compile operand cenv 'val 'next))
-                            (App-operands exp))])
+                            (App-operands exp))])   
+    ;; FIXME: at procedure entry, the arguments need to be installed
+    ;; in the environment.  We need to install 
+    ;; the closure's values now.
     (append-instruction-sequences
      proc-code
      (append-instruction-sequences
@@ -330,15 +332,3 @@
       empty-instruction-sequence
       (append-2-sequences (car seqs)
                           (append-seq-list (cdr seqs)))))
-
-
-
-
-(: tack-on-instruction-sequence (InstructionSequence InstructionSequence -> InstructionSequence))
-(define (tack-on-instruction-sequence seq body-seq)
-  (make-instruction-sequence (append (statements seq) (statements body-seq))))
-
-(: parallel-instruction-sequences (InstructionSequence InstructionSequence -> InstructionSequence))
-(define (parallel-instruction-sequences seq1 seq2)
-  (make-instruction-sequence (append (statements seq1) (statements seq2))))
-

lexical-env.rkt

@@ -32,13 +32,14 @@
 
 
 
-;; extend-lexical-environment: lexical-environment (listof symbol) -> lexical-envrionment
 (: extend-lexical-environment (CompileTimeEnvironment (Listof Symbol) -> CompileTimeEnvironment))
+;; Extends the lexical environment with procedure bindings.
 (define (extend-lexical-environment cenv names)
   (cons names cenv))
 
 
 (: lexical-environment-pop-depth (CompileTimeEnvironment -> Natural))
+;; Computes how many environments we need to pop till we clear the procedure arguments.
 (define (lexical-environment-pop-depth cenv)
   (cond [(empty? cenv)
          (error 'lexical-environment-pop-depth "Empty environment")]

typed-structs.rkt

@@ -17,7 +17,7 @@
 (define-struct: Def ([variable : Symbol] 
                      [value : Expression]) #:transparent)
 (define-struct: Lam ([parameters : (Listof Symbol)]
-                     [body : (Listof Expression)]) #:transparent)
+                     [body : Expression]) #:transparent)
 (define-struct: Seq ([actions : (Listof Expression)]) #:transparent)
 (define-struct: App ([operator : Expression]
                      [operands : (Listof Expression)]) #:transparent)
@@ -52,8 +52,8 @@
                                  BranchLabelStatement
                                  PopEnv
                                  PopControl
-                                 #;SaveStatement
+                                 PushEnv
-                                 #;RestoreStatement))
+                                 PushControl))
 (define-type Statement (U UnlabeledStatement
                           Symbol  ;; label
                           ))
@@ -77,8 +77,12 @@
 
 (define-type OpArg (U Const Label Reg TopControlProcedure))
 
-(define-struct: PopEnv ([n : Natural]))
+(define-struct: PopEnv ([n : Natural]) #:transparent)
-(define-struct: PopControl ())
+(define-struct: PopControl () #:transparent)
+
+(define-struct: PushEnv () #:transparent)
+(define-struct: PushControl () #:transparent)
+
 
 (define-struct: GotoStatement ([target : (U Label Reg)]) 
   #:transparent)
@@ -89,8 +93,6 @@
 (define-struct: TestStatement ([op : TestOperator]
                                [register-rand : RegisterSymbol]) #:transparent)
 (define-struct: BranchLabelStatement ([label : Symbol]) #:transparent)
-#;(define-struct: SaveStatement ([reg : RegisterSymbol]) #:transparent)
-#;(define-struct: RestoreStatement ([reg : RegisterSymbol]) #:transparent)