diff --git a/compile.rkt b/compile.rkt index bde614c..fdb634c 100644 --- a/compile.rkt +++ b/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)]) diff --git a/find-toplevel-variables.rkt b/find-toplevel-variables.rkt index 31b3878..24425cb 100644 --- a/find-toplevel-variables.rkt +++ b/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] diff --git a/lexical-env.rkt b/lexical-env.rkt index 54ae0f4..da44f4f 100644 --- a/lexical-env.rkt +++ b/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)) diff --git a/typed-structs.rkt b/typed-structs.rkt index 18a7fe2..c04afa4 100644 --- a/typed-structs.rkt +++ b/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)