removing superfluous quote form. Also moved Top as an expression form that introduces an environment extension.

compile.rkt

@@ -3,7 +3,6 @@
 (require "typed-structs.rkt"
          "lexical-env.rkt"
          "helpers.rkt"
-         "find-toplevel-variables.rkt"
          racket/list)
 
 (provide compile-top)
@@ -11,27 +10,15 @@
 
 
 
-(: compile-top (ExpressionCore Target Linkage -> InstructionSequence))
-(define (compile-top exp target linkage)
-  (let*: ([names : (Listof Symbol) (find-toplevel-variables exp)]
-          [cenv : CompileTimeEnvironment (list (make-Prefix names))])
-        (append-instruction-sequences
-         (make-instruction-sequence 
-          `(,(make-AssignPrimOpStatement 'env
-                                         'extend-environment/prefix
-                                         (list (make-Const names)
-                                               (make-Reg 'env)))))
-         (compile exp cenv target linkage))))
-
 
 ;; compile: expression target linkage -> instruction-sequence
 (: compile (ExpressionCore CompileTimeEnvironment Target Linkage -> InstructionSequence))
 (define (compile exp cenv target linkage)
   (cond
+    [(Top? exp)
+     (compile-top exp cenv target linkage)]
     [(Constant? exp)
      (compile-constant exp cenv target linkage)]
-    [(Quote? exp)
-     (compile-quoted exp cenv target linkage)]
     [(Var? exp)
      (compile-variable exp cenv target linkage)]
     [(Def? exp)
@@ -50,6 +37,20 @@
 
 
 
+(: 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))])
+        (append-instruction-sequences
+         (make-instruction-sequence 
+          `(,(make-AssignPrimOpStatement 'env
+                                         'extend-environment/prefix
+                                         (list (make-Const names)
+                                               (make-Reg 'env)))))
+         (compile (Top-code top) cenv target linkage))))
+
+
+
 (: compile-linkage (CompileTimeEnvironment Linkage -> InstructionSequence))
 (define (compile-linkage cenv linkage)
   (cond
@@ -78,13 +79,6 @@
                     (make-instruction-sequence
                      `(,(make-AssignImmediateStatement target (make-Const (Constant-v exp)))))))
 
-(: compile-quoted (Quote CompileTimeEnvironment Target Linkage -> InstructionSequence))
-(define (compile-quoted exp cenv target linkage)
-  (end-with-linkage linkage
-                    cenv
-                    (make-instruction-sequence
-                     `(,(make-AssignImmediateStatement target (make-Const (Quote-text exp)))))))
-
 (: compile-variable (Var CompileTimeEnvironment Target Linkage -> InstructionSequence))
 (define (compile-variable exp cenv target linkage)
   (let ([lexical-pos (find-variable (Var-id exp) cenv)])

find-toplevel-variables.rkt

@@ -12,6 +12,9 @@
   (: loop (Expression -> (Listof Symbol)))
   (define (loop exp)
     (cond
+      [(Top? exp)
+       (list-difference (Prefix-names (Top-prefix exp))
+                        (loop (Top-code exp)))]
       [(Constant? exp)
        empty]
       

lexical-env.rkt

@@ -32,10 +32,15 @@
 
 
 
-(: extend-lexical-environment (CompileTimeEnvironment (Listof Symbol) -> CompileTimeEnvironment))
+(: extend-lexical-environment (CompileTimeEnvironment (U (Listof Symbol) Prefix) -> CompileTimeEnvironment))
 ;; Extends the lexical environment with procedure bindings.
 (define (extend-lexical-environment cenv names)
-  (cons names cenv))
+  (cond [(Prefix? names)
+         (cons names cenv)]
+        [(list? names)
+         (cons names cenv)]))
+
+
 
 
 (: lexical-environment-pop-depth (CompileTimeEnvironment -> Natural))

typed-structs.rkt

@@ -4,10 +4,12 @@
 
 ;; Expressions
 
-(define-type ExpressionCore (U Constant Quote Var Branch Def #;Lam Seq #;App))
+(define-type ExpressionCore (U Top Constant Var Branch Def #;Lam Seq #;App))
 (define-type Expression (U ExpressionCore #;Assign))
+
+(define-struct: Top ([prefix : Prefix]
+                     [code : ExpressionCore]) #:transparent)
 (define-struct: Constant ([v : Any]) #:transparent)
-(define-struct: Quote ([text : Any]) #:transparent)
 (define-struct: Var ([id : Symbol]) #:transparent)
 (define-struct: Assign ([variable : Symbol]
                         [value : Expression]) #:transparent)