suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Danny Yoo 2011-03-01 11:43:03 -05:00
parent 81b1637a10
commit 4368fbc99d
4 changed files with 30 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
compile.rkt
View File

@ -3,7 +3,6 @@
(require "typed-structs.rkt" (require "typed-structs.rkt"
"lexical-env.rkt" "lexical-env.rkt"
"helpers.rkt" "helpers.rkt"
"find-toplevel-variables.rkt"
racket/list) racket/list)
(provide compile-top) (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: expression target linkage -> instruction-sequence
(: compile (ExpressionCore CompileTimeEnvironment Target Linkage -> InstructionSequence)) (: compile (ExpressionCore CompileTimeEnvironment Target Linkage -> InstructionSequence))
(define (compile exp cenv target linkage) (define (compile exp cenv target linkage)
(cond (cond
[(Top? exp)
(compile-top exp cenv target linkage)]
[(Constant? exp) [(Constant? exp)
(compile-constant exp cenv target linkage)] (compile-constant exp cenv target linkage)]
[(Quote? exp)
(compile-quoted exp cenv target linkage)]
[(Var? exp) [(Var? exp)
(compile-variable exp cenv target linkage)] (compile-variable exp cenv target linkage)]
[(Def? exp) [(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)) (: compile-linkage (CompileTimeEnvironment Linkage -> InstructionSequence))
(define (compile-linkage cenv linkage) (define (compile-linkage cenv linkage)
(cond (cond
@ -78,13 +79,6 @@
(make-instruction-sequence (make-instruction-sequence
`(,(make-AssignImmediateStatement target (make-Const (Constant-v exp))))))) `(,(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)) (: compile-variable (Var CompileTimeEnvironment Target Linkage -> InstructionSequence))
(define (compile-variable exp cenv target linkage) (define (compile-variable exp cenv target linkage)
(let ([lexical-pos (find-variable (Var-id exp) cenv)]) (let ([lexical-pos (find-variable (Var-id exp) cenv)])

3
find-toplevel-variables.rkt
View File

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

9
lexical-env.rkt
View File

@ -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. ;; Extends the lexical environment with procedure bindings.
(define (extend-lexical-environment cenv names) (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)) (: lexical-environment-pop-depth (CompileTimeEnvironment -> Natural))

6
typed-structs.rkt
View File

@ -4,10 +4,12 @@
;; Expressions ;; 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-type Expression (U ExpressionCore #;Assign))
(define-struct: Top ([prefix : Prefix]
[code : ExpressionCore]) #:transparent)
(define-struct: Constant ([v : Any]) #:transparent) (define-struct: Constant ([v : Any]) #:transparent)
(define-struct: Quote ([text : Any]) #:transparent)
(define-struct: Var ([id : Symbol]) #:transparent) (define-struct: Var ([id : Symbol]) #:transparent)
(define-struct: Assign ([variable : Symbol] (define-struct: Assign ([variable : Symbol]
[value : Expression]) #:transparent) [value : Expression]) #:transparent)