trying to fix the popenv stuff

compile.rkt

@@ -249,7 +249,9 @@
 (define (compile-lambda-body exp cenv lexical-references proc-entry)
   (let*: ([formals : (Listof Symbol) (Lam-parameters exp)]
           [extended-cenv : CompileTimeEnvironment 
-                         (extend-lexical-environment '() formals)]
+                         (extend-lexical-environment 
+                          '() 
+                          (make-FunctionExtension formals))]
           [extended-cenv : CompileTimeEnvironment 
                          (lexical-references->compile-time-environment 
                           lexical-references cenv extended-cenv)])
@@ -355,8 +357,7 @@
                          (make-instruction-sequence 
                           `(,(make-AssignPrimOpStatement 
                               target
-                              (make-ApplyPrimitiveProcedure n))
+                              (make-ApplyPrimitiveProcedure n)))))
-                            ,(make-PopEnvironment n 0))))
        after-call))))
 
 

lexical-env.rkt

@@ -30,44 +30,81 @@
               [else
                (let: ([elt : CompileTimeEnvironmentEntry (first cenv)])
                  (cond
-                   [(eq? #f elt)
-                    (loop (rest cenv) (add1 depth))]
                    [(Prefix? elt)
                     (cond [(member name (Prefix-names elt))
                            (make-PrefixAddress depth (find-pos name (Prefix-names elt)) name)]
                           [else
                            (loop (rest cenv) (add1 depth))])]
-                   [(symbol? elt)
+                   
+                   [(FunctionExtension? elt)
+                    (let: ([index : (U #f Natural) (list-index name (FunctionExtension-names elt))])
                           (cond
-                      [(eq? name elt)
+                            [(boolean? index)
-                       (make-LocalAddress depth)]
+                             (loop (rest cenv) (+ depth (length (FunctionExtension-names elt))))]
                             [else
-                       (loop (rest cenv) (add1 depth))])]))])))
+                             (make-LocalAddress (+ depth index))]))]
+                   
+                   [(LocalExtension? elt)
+                    (let: ([index : (U #f Natural) (list-index name (LocalExtension-names elt))])
+                          (cond 
+                            [(boolean? index)
+                             (loop (rest cenv) (+ depth (length (LocalExtension-names elt))))]
+                            [else
+                             (make-LocalAddress (+ depth index))]))]
+
+                   [(TemporaryExtension? elt)
+                    (loop (rest cenv) 
+                          (+ depth (TemporaryExtension-n elt)))]))])))
+
+(: list-index (All (A) A (Listof A) -> (U #f Natural)))
+(define (list-index x l)
+  (let loop ([i 0]
+             [l l])
+    (cond
+      [(empty? l)
+       #f]
+      [(eq? x (first l))
+       i]
+      [else
+       (loop (add1 i) (rest l))])))
 
 
-
+(: extend-lexical-environment 
-(: extend-lexical-environment (CompileTimeEnvironment (U (Listof Symbol) Prefix) -> CompileTimeEnvironment))
+   (CompileTimeEnvironment CompileTimeEnvironmentEntry -> CompileTimeEnvironment))
 ;; Extends the lexical environment with procedure bindings.
-(define (extend-lexical-environment cenv names)
+(define (extend-lexical-environment cenv extension)
-  (cond [(Prefix? names)
+  (cons extension cenv))
-         (cons names cenv)]
-        [(list? names)
-         (append names cenv)]))
 
 
-(: extend-lexical-environment/placeholders (CompileTimeEnvironment Natural -> CompileTimeEnvironment))
+(: extend-lexical-environment/placeholders
+   (CompileTimeEnvironment Natural -> CompileTimeEnvironment))
 ;; Add placeholders to the lexical environment (This represents what happens during procedure application.)
 (define (extend-lexical-environment/placeholders cenv n)
-  (cond [(= n 0)
+  (cons (make-TemporaryExtension n)
-         cenv]
+        cenv))
-        [else
-         (extend-lexical-environment/placeholders (cons #f cenv) (sub1 n))]))
   
 
 (: 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)
-  (length cenv))
+  (cond
+    [(empty? cenv)
+     0]
+    [else
+     (let: ([entry : CompileTimeEnvironmentEntry (first cenv)])
+           (cond
+             [(Prefix? entry)
+              (+ (length (Prefix-names entry))
+                 (lexical-environment-pop-depth (rest cenv)))]
+             [(FunctionExtension? entry)
+              (length (FunctionExtension-names entry))]
+             [(LocalExtension? entry)
+              (+ (length (LocalExtension-names entry))
+                 (lexical-environment-pop-depth (rest cenv)))]
+             [(TemporaryExtension? entry)
+              (+ (TemporaryExtension-n entry)
+                 (lexical-environment-pop-depth (rest cenv)))]))]))
+
 
 
 

lexical-structs.rkt

@@ -6,19 +6,27 @@
 
 ;;  Lexical environments
 
+
 ;; A toplevel prefix contains a list of toplevel variables.
 (define-struct: Prefix ([names : (Listof Symbol)])
   #:transparent)
 
+(define-struct: FunctionExtension ([names : (Listof Symbol)])
+  #:transparent)
+
+(define-struct: LocalExtension ([names : (Listof Symbol)])
+  #:transparent)
+
+(define-struct: TemporaryExtension ([n : Natural])
+  #:transparent)
 
 
+(define-type CompileTimeEnvironmentEntry (U Prefix ;; a prefix
+                                            FunctionExtension
+                                            LocalExtension
+                                            TemporaryExtension))
 
 
-(define-type CompileTimeEnvironmentEntry (U False  ;; placeholder for temporary space
-                                            Symbol ;; lexically bound local identiifer
-                                            Prefix ;; a prefix
-                                            ))
-
 ;; 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 CompileTimeEnvironmentEntry))