From 15c682281667c4a3dcf0c7d65f392554ac152bfb Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Sun, 20 Mar 2011 21:55:51 -0400 Subject: [PATCH] working on compile --- compile.rkt | 290 ++++++++++++++++------------------------- expression-structs.rkt | 2 +- lexical-env.rkt | 6 +- lexical-structs.rkt | 3 +- parse.rkt | 2 +- 5 files changed, 115 insertions(+), 188 deletions(-) diff --git a/compile.rkt b/compile.rkt index 943a575..38c947e 100644 --- a/compile.rkt +++ b/compile.rkt @@ -3,8 +3,6 @@ (require "expression-structs.rkt" "lexical-structs.rkt" "il-structs.rkt" - "lexical-env.rkt" - "find-toplevel-variables.rkt" racket/list) (provide (rename-out [-compile compile]) @@ -17,24 +15,17 @@ (: current-defined-name (Parameterof (U Symbol False))) (define current-defined-name (make-parameter #f)) - -;(provide compile-top) - (: -compile (ExpressionCore Target Linkage -> (Listof Statement))) (define (-compile exp target linkage) (statements - (let ([end (make-label 'end)]) - (append-instruction-sequences - (compile (make-Top (make-Prefix (find-toplevel-variables exp)) - exp) - (list) - target - linkage))))) + (compile exp + 0 + target + linkage))) - -(: compile (ExpressionCore CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile (ExpressionCore Natural Target Linkage -> InstructionSequence)) ;; Compiles an expression into an instruction sequence. (define (compile exp cenv target linkage) (cond @@ -42,10 +33,12 @@ (compile-top exp cenv target linkage)] [(Constant? exp) (compile-constant exp cenv target linkage)] - [(Var? exp) - (compile-variable exp cenv target linkage)] - [(Def? exp) - (compile-definition exp cenv target linkage)] + [(LocalRef? exp) + (compile-local-reference exp cenv target linkage)] + [(ToplevelRef? exp) + (compile-toplevel-reference exp cenv target linkage)] + [(ToplevelSet? exp) + (compile-toplevel-set exp cenv target linkage)] [(Branch? exp) (compile-branch exp cenv target linkage)] [(Lam? exp) @@ -59,33 +52,32 @@ (compile-application exp cenv target linkage)] [(Let1? exp) (compile-let1 exp cenv target linkage)] - [(Let? exp) - (compile-let exp cenv target linkage)] - [(LetRec? exp) - (compile-letrec exp cenv target linkage)])) + [(LetVoid? exp) + (compile-let-void exp cenv target linkage)] + [(InstallValue? exp) + (compile-install-value exp cenv target linkage)])) -(: compile-top (Top CompileTimeEnvironment Target Linkage -> InstructionSequence)) + +(: compile-top (Top Natural Target Linkage -> InstructionSequence)) (define (compile-top top cenv target linkage) - (let*: ([cenv : CompileTimeEnvironment (extend-lexical-environment cenv (Top-prefix top))] - [names : (Listof (U Symbol False)) (Prefix-names (Top-prefix top))]) + (let*: ([names : (Listof (U Symbol False)) (Prefix-names (Top-prefix top))]) (append-instruction-sequences (make-instruction-sequence `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! names)))) - (compile (Top-code top) cenv target linkage)))) + (compile (Top-code top) (add1 cenv) target linkage)))) ;; Add linkage for expressions. -(: end-with-linkage (Linkage CompileTimeEnvironment InstructionSequence -> - InstructionSequence)) +(: end-with-linkage (Linkage Natural InstructionSequence -> InstructionSequence)) (define (end-with-linkage linkage cenv instruction-sequence) (append-instruction-sequences instruction-sequence (compile-linkage cenv linkage))) -(: end-with-compiled-application-linkage (Linkage CompileTimeEnvironment InstructionSequence -> +(: end-with-compiled-application-linkage (Linkage Natural InstructionSequence -> InstructionSequence)) ;; Add linkage for applications; we need to specialize this to preserve tail calls. (define (end-with-compiled-application-linkage linkage cenv instruction-sequence) @@ -94,14 +86,14 @@ -(: compile-linkage (CompileTimeEnvironment Linkage -> InstructionSequence)) +(: compile-linkage (Natural Linkage -> InstructionSequence)) (define (compile-linkage cenv linkage) (cond [(eq? linkage 'return) (make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel)) ,(make-PopEnvironment - (lexical-environment-pop-depth cenv linkage) + cenv 0) ,(make-PopControlFrame) ,(make-GotoStatement (make-Reg 'proc))))] @@ -111,87 +103,76 @@ (make-instruction-sequence `(,(make-GotoStatement (make-Label linkage))))])) -(: compile-application-linkage (CompileTimeEnvironment Linkage -> InstructionSequence)) +(: compile-application-linkage (Natural Linkage -> InstructionSequence)) ;; Like compile-linkage, but the special case for 'return linkage already assumes ;; the stack has been appropriately popped. (define (compile-application-linkage cenv linkage) (cond [(eq? linkage 'return) - (make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc - (make-GetControlStackLabel)) + (make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel)) ,(make-PopControlFrame) ,(make-GotoStatement (make-Reg 'proc))))] [(eq? linkage 'next) - (make-instruction-sequence `(,(make-PopEnvironment (lexical-environment-pop-depth cenv linkage) - 0)))] + (make-instruction-sequence `(,(make-PopEnvironment cenv 0)))] [(symbol? linkage) - (make-instruction-sequence `(,(make-PopEnvironment (lexical-environment-pop-depth cenv linkage) - 0) + (make-instruction-sequence `(,(make-PopEnvironment cenv 0) ,(make-GotoStatement (make-Label linkage))))])) - -(: lexical-environment-pop-depth (CompileTimeEnvironment Linkage -> Natural)) -;; Computes how much of the environment we need to pop. -(define (lexical-environment-pop-depth cenv linkage) - (length cenv)) - - - - -(: compile-constant (Constant CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-constant (Constant Natural Target Linkage -> InstructionSequence)) (define (compile-constant exp cenv target linkage) (end-with-linkage linkage cenv (make-instruction-sequence `(,(make-AssignImmediateStatement target (make-Const (Constant-v exp))))))) -(: compile-variable (Var CompileTimeEnvironment Target Linkage -> InstructionSequence)) -(define (compile-variable exp cenv target linkage) - (let ([lexical-pos (find-variable (Var-id exp) cenv)]) - (cond - [(EnvLexicalReference? lexical-pos) - (end-with-linkage linkage - cenv - (make-instruction-sequence - `(,(make-AssignImmediateStatement - target - lexical-pos))))] - [(EnvPrefixReference? lexical-pos) - (end-with-linkage linkage - cenv - (make-instruction-sequence - `(,(make-PerformStatement (make-CheckToplevelBound! - (EnvPrefixReference-depth lexical-pos) - (EnvPrefixReference-pos lexical-pos) - (EnvPrefixReference-name lexical-pos))) - ,(make-AssignImmediateStatement - target - lexical-pos))))]))) -(: compile-definition (Def CompileTimeEnvironment Target Linkage -> InstructionSequence)) -(define (compile-definition exp cenv target linkage) - (let* ([var (Def-variable exp)] - [lexical-pos (find-variable var cenv)]) - (cond - [(EnvLexicalReference? lexical-pos) - (error 'compile-definition "Defintion not at toplevel")] - [(EnvPrefixReference? lexical-pos) - (let ([get-value-code - (parameterize ([current-defined-name var]) - (compile (Def-value exp) cenv lexical-pos - 'next))]) - (end-with-linkage - linkage - cenv - (append-instruction-sequences - get-value-code - (make-instruction-sequence `(,(make-AssignImmediateStatement target (make-Const 'ok)))))))]))) +(: compile-local-reference (LocalRef Natural Target Linkage -> InstructionSequence)) +(define (compile-local-reference exp cenv target linkage) + (end-with-linkage linkage + cenv + (make-instruction-sequence + `(,(make-AssignImmediateStatement + target + (make-EnvLexicalReference (LocalRef-depth exp) + (LocalRef-unbox? exp))))))) -(: compile-branch (Branch CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-toplevel-reference (ToplevelRef Natural Target Linkage -> InstructionSequence)) +(define (compile-toplevel-reference exp cenv target linkage) + (end-with-linkage linkage + cenv + (make-instruction-sequence + `(,(make-PerformStatement (make-CheckToplevelBound! + (ToplevelRef-depth exp) + (ToplevelRef-pos exp))) + ,(make-AssignImmediateStatement + target + (make-EnvPrefixReference (ToplevelRef-depth exp) + (ToplevelRef-pos exp))))))) + + +(: compile-toplevel-set (ToplevelSet Natural Target Linkage -> InstructionSequence)) +(define (compile-toplevel-set exp cenv target linkage) + (let* ([var (ToplevelSet-name exp)] + [lexical-pos (make-EnvPrefixReference (ToplevelSet-depth exp) + (ToplevelSet-pos exp) + (ToplevelSet-name exp))]) + (let ([get-value-code + (parameterize ([current-defined-name var]) + (compile (Def-value exp) cenv lexical-pos + 'next))]) + (end-with-linkage + linkage + cenv + (append-instruction-sequences + get-value-code + (make-instruction-sequence `(,(make-AssignImmediateStatement target (make-Const 'ok))))))))) + + +(: compile-branch (Branch Natural Target Linkage -> InstructionSequence)) (define (compile-branch exp cenv target linkage) (let ([t-branch (make-label 'trueBranch)] [f-branch (make-label 'falseBranch)] @@ -216,7 +197,7 @@ after-if)))))) -(: compile-sequence ((Listof Expression) CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-sequence ((Listof Expression) Natural Target Linkage -> InstructionSequence)) (define (compile-sequence seq cenv target linkage) ;; All but the last will use 'next linkage. (if (last-exp? seq) @@ -225,7 +206,7 @@ (compile-sequence (rest-exps seq) cenv target linkage)))) -(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-lambda (Lam Natural Target Linkage -> InstructionSequence)) ;; Write out code for lambda expressions. ;; The lambda will close over the free variables. (define (compile-lambda exp cenv target linkage) @@ -234,94 +215,34 @@ [lambda-linkage : Linkage (if (eq? linkage 'next) after-lambda - linkage)] - [free-vars : (Listof Symbol) (find-toplevel-variables exp)] - [lexical-addresses : (Listof LexicalAddress) - (map (lambda: ([var : Symbol]) - (find-variable var cenv)) - free-vars)] - [lexical-references : (Listof EnvReference) - (collect-lexical-references lexical-addresses)]) + linkage)]) (append-instruction-sequences (end-with-linkage lambda-linkage cenv (make-instruction-sequence - `(,(make-AssignPrimOpStatement target - (make-MakeCompiledProcedure proc-entry - (length (Lam-parameters exp)) - lexical-references - (current-defined-name)))))) - (compile-lambda-body exp cenv - lexical-references - free-vars - proc-entry) + `(,(make-AssignPrimOpStatement + target + (make-MakeCompiledProcedure proc-entry + (Lam-num-parameters exp) + (map make-Const (Lam-closure-map exp)) + (current-defined-name)))))) + (compile-lambda-body exp proc-entry) after-lambda))) - - - - -(: compile-lambda-body (Lam CompileTimeEnvironment - (Listof EnvReference) - (Listof Symbol) - Linkage - -> - InstructionSequence)) +(: compile-lambda-body (Lam Linkage -> InstructionSequence)) ;; Compiles the body of the lambda in the appropriate environment. -(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 - '() - formals)] - [extended-cenv : CompileTimeEnvironment - (lexical-references->compile-time-environment - lexical-references cenv extended-cenv - free-variables)]) - (append-instruction-sequences - (make-instruction-sequence - `(,proc-entry - ,(make-PerformStatement (make-InstallClosureValues!)))) - (compile (Lam-body exp) extended-cenv 'val 'return)))) - - - -#;(: compile-letrec (Letrec CompileTimeEnvironment Target Linkage -> InstructionSequence)) -#;(define (compile-letrec exp cenv target linkage) - (let* ([after-let (make-label 'afterLet)] - [let-linkage (if (eq? linkage 'next) - after-let - linkage)] - [extended-cenv : CompileTimeEnvironment - (extend-lexical-environment/names - '() - (reverse (Letrec-names exp)))] - [lam-codes : (Listof InstructionSequence) - (let: ([n : Natural (length (Letrec-procs exp))]) - (map (lambda: ([lam : Lam] - [target : Target]) - (compile-lambda lam extended-cenv target 'next)) - (Letrec-procs exp) - (build-list (length (Letrec-procs exp)) - (lambda: ([i : Natural]) - (make-EnvLexicalReference (- n 1 i))))))] - [body-code : InstructionSequence - (compile (Letrec-body exp) extended-cenv target let-linkage)] - (append-instruction-sequences - (end-with-linkage let-linkage cenv - (make-instruction-sequence `(;; create space for the lambdas - ,(make-PushEnvironment n) - ;; install each one of them in place - (apply append-instruction-sequences lam-codes) - ;; mutate each of the lambda's shells so they're correct - - ;; evaluate the body - body-code - ;; pop the temporary space - ))) - after-let)))) +(define (compile-lambda-body exp proc-entry) + (append-instruction-sequences + (make-instruction-sequence + `(,proc-entry + ,(make-PerformStatement (make-InstallClosureValues!)))) + (compile (Lam-body exp) + (+ (Lam-num-parameters exp) + (length (Lam-closure-map exp))) + 'val + 'return))) @@ -329,9 +250,9 @@ ;; FIXME: I need to implement important special cases. ;; 1. We may be able to open-code if the operator is primitive ;; 2. We may have a static location to jump to if the operator is lexically scoped. -(: compile-application (App CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(: compile-application (App Natural Target Linkage -> InstructionSequence)) (define (compile-application exp cenv target linkage) - (let* ([extended-cenv (extend-lexical-environment/placeholders cenv (length (App-operands exp)))] + (let* ([extended-cenv (+ cenv (length (App-operands exp)))] [proc-code (compile (App-operator exp) extended-cenv (if (empty? (App-operands exp)) @@ -354,7 +275,8 @@ (make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f))) proc-code (juggle-operands operand-codes) - (compile-procedure-call cenv extended-cenv + (compile-procedure-call cenv + extended-cenv (length (App-operands exp)) target linkage)))) @@ -388,10 +310,10 @@ -(: compile-procedure-call (CompileTimeEnvironment CompileTimeEnvironment - Natural Target Linkage - -> - InstructionSequence)) +(: compile-procedure-call (Natural Natural + Natural Target Linkage + -> + InstructionSequence)) ;; Assumes the procedure value has been loaded into the proc register. ;; n is the number of arguments passed in. ;; cenv is the compile-time enviroment before arguments have been shifted in. @@ -518,8 +440,8 @@ -(: compile-let (Let CompileTimeEnvironment Target Linkage -> InstructionSequence)) -(define (compile-let exp cenv target linkage) +(: compile-let-void (LetVoid CompileTimeEnvironment Target Linkage -> InstructionSequence)) +(define (compile-let-void exp cenv target linkage) (let*: ([n : Natural (length (Let-rhss exp))] [rhs-codes : (Listof InstructionSequence) (map (lambda: ([rhs : ExpressionCore] @@ -603,6 +525,14 @@ +(: compile-install-value (InstallValue Natural Target Linkage -> InstructionSequence)) +(define (compile-install-value exp cenv target linkage) + (compile (InstallValue-body exp) + cenv + (make-EnvLexicalReference (InstallValue-depth exp) (InstallValue-box? exp)) + linkage)) + + @@ -622,6 +552,7 @@ (append-2-sequences (car seqs) (append-seq-list (cdr seqs))))) + (: ensure-natural (Integer -> Natural)) (define (ensure-natural n) (if (>= n 0) @@ -630,7 +561,6 @@ - (: adjust-target-depth (Target Natural -> Target)) (define (adjust-target-depth target n) (cond diff --git a/expression-structs.rkt b/expression-structs.rkt index dfcb452..bf9b47f 100644 --- a/expression-structs.rkt +++ b/expression-structs.rkt @@ -53,7 +53,7 @@ (define-struct: InstallValue ([depth : Natural] [body : ExpressionCore] - [boxes? : Boolean]) + [box? : Boolean]) #:transparent) diff --git a/lexical-env.rkt b/lexical-env.rkt index 14f13ec..4fe5048 100644 --- a/lexical-env.rkt +++ b/lexical-env.rkt @@ -36,8 +36,7 @@ [(Prefix? elt) (cond [(member name (Prefix-names elt)) (make-EnvPrefixReference depth - (find-pos name (Prefix-names elt)) - name)] + (find-pos name (Prefix-names elt)))] [else (loop (rest cenv) (add1 depth))])] @@ -183,8 +182,7 @@ (EnvLexicalReference-unbox? target))] [(EnvPrefixReference? target) (make-EnvPrefixReference (+ n (EnvPrefixReference-depth target)) - (EnvPrefixReference-pos target) - (EnvPrefixReference-name target))] + (EnvPrefixReference-pos target))] [(EnvWholePrefixReference? target) (make-EnvWholePrefixReference (+ n (EnvWholePrefixReference-depth target)))])) diff --git a/lexical-structs.rkt b/lexical-structs.rkt index 758fb5e..b5652c1 100644 --- a/lexical-structs.rkt +++ b/lexical-structs.rkt @@ -37,8 +37,7 @@ #:transparent) (define-struct: EnvPrefixReference ([depth : Natural] - [pos : Natural] - [name : Symbol]) + [pos : Natural]) #:transparent) (define-struct: EnvWholePrefixReference ([depth : Natural]) diff --git a/parse.rkt b/parse.rkt index d699151..7b8b99a 100644 --- a/parse.rkt +++ b/parse.rkt @@ -52,7 +52,7 @@ [(EnvPrefixReference? address) (make-ToplevelSet (EnvPrefixReference-depth address) (EnvPrefixReference-pos address) - (EnvPrefixReference-name address) + (definition-variable exp) (parse (definition-value exp) cenv))]))] [(if? exp)