correcting bug with my implementation of lexical scope

assemble.rkt

@@ -387,12 +387,14 @@ EOF
              )]
     
     [(ExtendEnvironment/Prefix!? op)
-     (let: ([names : (Listof Symbol) (ExtendEnvironment/Prefix!-names op)])
+     (let: ([names : (Listof (U Symbol False)) (ExtendEnvironment/Prefix!-names op)])
            (format "MACHINE.env.push([~a]);"
-                   (string-join (map (lambda: ([n : Symbol])
+                   (string-join (map (lambda: ([n : (U Symbol False)])
-                                              (format "MACHINE.params.currentNamespace[~s] || Primitives[~s]"
+                                              (if (symbol? n)
-                                                      (symbol->string n) 
+                                                  (format "MACHINE.params.currentNamespace[~s] || Primitives[~s]"
-                                                      (symbol->string n)))
+                                                          (symbol->string n) 
+                                                          (symbol->string n))
+                                                  "false"))
                                      names)
                                 ",")))]
     

compile.rkt

@@ -70,7 +70,7 @@
 (: compile-top (Top CompileTimeEnvironment Target Linkage -> InstructionSequence))
 (define (compile-top top cenv target linkage)
   (let*: ([cenv : CompileTimeEnvironment (extend-lexical-environment cenv (Top-prefix top))]
-          [names : (Listof Symbol) (Prefix-names (Top-prefix top))])
+          [names : (Listof (U Symbol False)) (Prefix-names (Top-prefix top))])
          (append-instruction-sequences
           (make-instruction-sequence 
            `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! names))))
@@ -258,6 +258,7 @@
                                                                        lexical-references)))))
           (compile-lambda-body exp cenv
                                lexical-references
+                               free-vars
                                proc-entry)
           after-lambda)))
 
@@ -268,11 +269,12 @@
 
 (: compile-lambda-body (Lam CompileTimeEnvironment 
                             (Listof EnvReference)
+                            (Listof Symbol)
                             Linkage 
                             -> 
                             InstructionSequence))
 ;; Compiles the body of the lambda in the appropriate environment.
-(define (compile-lambda-body exp cenv lexical-references proc-entry)
+(define (compile-lambda-body exp cenv lexical-references free-variables proc-entry)
   (let*: ([formals : (Listof Symbol) (Lam-parameters exp)]
           [extended-cenv : CompileTimeEnvironment 
                          (extend-lexical-environment/names
@@ -280,7 +282,8 @@
                           formals)]
           [extended-cenv : CompileTimeEnvironment 
                          (lexical-references->compile-time-environment 
-                          lexical-references cenv extended-cenv)])
+                          lexical-references cenv extended-cenv
+                          free-variables)])
          (append-instruction-sequences
           (make-instruction-sequence 
            `(,proc-entry

find-toplevel-variables.rkt

@@ -15,7 +15,7 @@
     (cond
       [(Top? exp)
        (list-difference (loop (Top-code exp))
-                        (Prefix-names (Top-prefix exp)))]
+                        (filter symbol? (Prefix-names (Top-prefix exp))))]
       [(Constant? exp)
        empty]
             

il-structs.rkt

@@ -191,7 +191,7 @@
 
 ;; Extends the environment with a prefix that holds
 ;; lookups to the namespace.
-(define-struct: ExtendEnvironment/Prefix! ([names : (Listof Symbol)])
+(define-struct: ExtendEnvironment/Prefix! ([names : (Listof (U Symbol False))])
   #:transparent)
 
 ;; Adjusts the environment by pushing the values in the

lexical-env.rkt

@@ -10,14 +10,15 @@
          extend-lexical-environment/boxed-names
          extend-lexical-environment/placeholders
          collect-lexical-references
-         lexical-references->compile-time-environment)
+         lexical-references->compile-time-environment
+         place-prefix-mask)
 
 
 ;; find-variable: symbol compile-time-environment -> lexical-address
 ;; Find where the variable should be located.
 (: find-variable (Symbol CompileTimeEnvironment -> LexicalAddress))
 (define (find-variable name cenv)
-  (: find-pos (Symbol (Listof Symbol) -> Natural))
+  (: find-pos (Symbol (Listof (U Symbol False)) -> Natural))
   (define (find-pos sym los)
     (cond
       [(eq? sym (car los))
@@ -125,9 +126,10 @@
 
 
 (: lexical-references->compile-time-environment ((Listof EnvReference) CompileTimeEnvironment CompileTimeEnvironment
+                                                                     (Listof Symbol)
                                                                        -> CompileTimeEnvironment))
 ;; Creates a lexical environment containing the closure's bindings.
-(define (lexical-references->compile-time-environment refs cenv new-cenv)
+(define (lexical-references->compile-time-environment refs cenv new-cenv symbols-to-keep)
   (let: loop : CompileTimeEnvironment ([refs : (Listof EnvReference) (reverse refs)]
                                        [new-cenv : CompileTimeEnvironment new-cenv])
         (cond
@@ -142,5 +144,27 @@
                                 new-cenv))]
                    [(EnvWholePrefixReference? a-ref)
                     (loop (rest refs)
-                          (cons (list-ref cenv (EnvWholePrefixReference-depth a-ref))
+                          (cons (place-prefix-mask 
+                                 (ensure-Prefix (list-ref cenv (EnvWholePrefixReference-depth a-ref)))
+                                 symbols-to-keep)
                                 new-cenv))]))])))
+
+(: ensure-Prefix (Any -> Prefix))
+(define (ensure-Prefix x)
+  (if (Prefix? x)
+      x
+      (error 'ensure-Prefix "~s" x)))
+
+
+
+(: place-prefix-mask (Prefix (Listof Symbol) -> Prefix))
+;; Masks elements of the prefix off.
+(define (place-prefix-mask a-prefix symbols-to-keep)
+  (make-Prefix
+   (map (lambda: ([n : (U Symbol False)])
+                 (cond [(symbol? n)
+                        (if (member n symbols-to-keep)
+                            n
+                            #f)]
+                       [else n]))
+        (Prefix-names a-prefix))))

lexical-structs.rkt

@@ -7,8 +7,9 @@
 ;;  Lexical environments
 
 
-;; A toplevel prefix contains a list of toplevel variables.
+;; A toplevel prefix contains a list of toplevel variables.  Some of the
-(define-struct: Prefix ([names : (Listof Symbol)])
+;; names may be masked out by #f.
+(define-struct: Prefix ([names : (Listof (U Symbol False))])
   #:transparent)
 
 

simulator.rkt

@@ -197,7 +197,10 @@
           
           [(ExtendEnvironment/Prefix!? op)
            (env-push! m 
-                      (make-toplevel (map lookup-primitive 
+                      (make-toplevel (map (lambda: ([id/false : (U Symbol False)])
+                                                   (if (symbol? id/false)
+                                                       (lookup-primitive id/false)
+                                                       #f))
                                           (ExtendEnvironment/Prefix!-names op))))]
           
           [(InstallClosureValues!? op)

test-all.rkt

@@ -4,5 +4,6 @@
          "test-simulator.rkt"
          "test-compiler.rkt"
          "test-assemble.rkt"
-         #;"test-browser-evaluate.rkt"
+         "test-browser-evaluate.rkt"
-         #;"test-package.rkt")
+         "test-package.rkt"
+         #;"test-conform.rkt")

test-browser-evaluate.rkt

@@ -144,5 +144,5 @@
 
 
 
-(test (read (open-input-file "tests/conform/program0.sch"))
+#;(test (read (open-input-file "tests/conform/program0.sch"))
       (port->string (open-input-file "tests/conform/expected0.txt")))