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

still need to work on procedure application

Browse Source
This commit is contained in:
Danny Yoo 2011-03-01 02:48:38 -05:00
parent 4f90538722
commit fb0fb941e3
3 changed files with 27 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
compile.rkt
View File

@ -38,7 +38,7 @@
(compile-definition exp cenv target linkage)]
[(Branch? exp)
(compile-branch exp cenv target linkage)]
#;[(Lam? exp)
[(Lam? exp)
(compile-lambda exp cenv target linkage)]
[(Seq? exp)
(compile-sequence (Seq-actions exp)
@ -156,7 +156,7 @@
(make-instruction-sequence
`(,(make-TestStatement 'false? 'val)
,(make-BranchLabelStatement f-branch)))
(parallel-instruction-sequences
(append-instruction-sequences
(append-instruction-sequences t-branch c-code)
(append-instruction-sequences f-branch a-code))
after-if))))))
@ -170,8 +170,8 @@
(compile-sequence (rest-exps seq) cenv target linkage))))
#;(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence))
#;(define (compile-lambda exp cenv target linkage)
(: compile-lambda (Lam CompileTimeEnvironment Target Linkage -> InstructionSequence))
(define (compile-lambda exp cenv target linkage)
(let ([proc-entry (make-label 'entry)]
[after-lambda (make-label 'afterLambda)])
(let ([lambda-linkage
@ -179,8 +179,9 @@
after-lambda
linkage)])
(append-instruction-sequences
(tack-on-instruction-sequence
(append-instruction-sequences
(end-with-linkage lambda-linkage
cenv
(make-instruction-sequence
`(,(make-AssignPrimOpStatement target
'make-compiled-procedure
@ -196,21 +197,19 @@
proc-entry))
after-lambda))))
#;(: compile-lambda-body (Lam CompileTimeEnvironment Linkage -> InstructionSequence))
#;(define (compile-lambda-body exp cenv proc-entry)
(: compile-lambda-body (Lam CompileTimeEnvironment Linkage -> InstructionSequence))
(define (compile-lambda-body exp cenv proc-entry)
(let* ([formals (Lam-parameters exp)]
[extended-cenv (extend-lexical-environment cenv formals)])
(append-instruction-sequences
(make-instruction-sequence
`(,proc-entry
;; FIXME: not right: we need to install the closure values here,
;; instead of replacing the environment altogether.
,(make-AssignPrimOpStatement 'env
'compiled-procedure-env
(list (make-Reg 'proc)))
,(make-AssignPrimOpStatement 'env
'extend-environment
(list (make-Reg 'argl)
(make-Reg 'env)))))
(compile-sequence (Lam-body exp) extended-cenv 'val 'return))))
(list (make-Reg 'proc)))))
(compile (Lam-body exp) extended-cenv 'val 'return))))
#;(: compile-application (App CompileTimeEnvironment Target Linkage -> InstructionSequence))
#;(define (compile-application exp cenv target linkage)
@ -220,7 +219,10 @@
(let ([proc-code (compile (App-operator exp) cenv 'proc 'next)]
[operand-codes (map (lambda: ([operand : Expression])
(compile operand cenv 'val 'next))
(App-operands exp))])
(App-operands exp))])
;; FIXME: at procedure entry, the arguments need to be installed
;; in the environment. We need to install
;; the closure's values now.
(append-instruction-sequences
proc-code
(append-instruction-sequences
@ -330,15 +332,3 @@
empty-instruction-sequence
(append-2-sequences (car seqs)
(append-seq-list (cdr seqs)))))
(: tack-on-instruction-sequence (InstructionSequence InstructionSequence -> InstructionSequence))
(define (tack-on-instruction-sequence seq body-seq)
(make-instruction-sequence (append (statements seq) (statements body-seq))))
(: parallel-instruction-sequences (InstructionSequence InstructionSequence -> InstructionSequence))
(define (parallel-instruction-sequences seq1 seq2)
(make-instruction-sequence (append (statements seq1) (statements seq2))))

3
lexical-env.rkt
View File

@ -32,13 +32,14 @@
;; extend-lexical-environment: lexical-environment (listof symbol) -> lexical-envrionment
(: extend-lexical-environment (CompileTimeEnvironment (Listof Symbol) -> CompileTimeEnvironment))
;; Extends the lexical environment with procedure bindings.
(define (extend-lexical-environment cenv names)
(cons names cenv))
(: lexical-environment-pop-depth (CompileTimeEnvironment -> Natural))
;; Computes how many environments we need to pop till we clear the procedure arguments.
(define (lexical-environment-pop-depth cenv)
(cond [(empty? cenv)
(error 'lexical-environment-pop-depth "Empty environment")]

16
typed-structs.rkt
View File

@ -17,7 +17,7 @@
(define-struct: Def ([variable : Symbol]
[value : Expression]) #:transparent)
(define-struct: Lam ([parameters : (Listof Symbol)]
[body : (Listof Expression)]) #:transparent)
[body : Expression]) #:transparent)
(define-struct: Seq ([actions : (Listof Expression)]) #:transparent)
(define-struct: App ([operator : Expression]
[operands : (Listof Expression)]) #:transparent)
@ -52,8 +52,8 @@
BranchLabelStatement
PopEnv
PopControl
#;SaveStatement
#;RestoreStatement))
PushEnv
PushControl))
(define-type Statement (U UnlabeledStatement
Symbol ;; label
))
@ -77,8 +77,12 @@
(define-type OpArg (U Const Label Reg TopControlProcedure))
(define-struct: PopEnv ([n : Natural]))
(define-struct: PopControl ())
(define-struct: PopEnv ([n : Natural]) #:transparent)
(define-struct: PopControl () #:transparent)
(define-struct: PushEnv () #:transparent)
(define-struct: PushControl () #:transparent)
(define-struct: GotoStatement ([target : (U Label Reg)])
#:transparent)
@ -89,8 +93,6 @@
(define-struct: TestStatement ([op : TestOperator]
[register-rand : RegisterSymbol]) #:transparent)
(define-struct: BranchLabelStatement ([label : Symbol]) #:transparent)
#;(define-struct: SaveStatement ([reg : RegisterSymbol]) #:transparent)
#;(define-struct: RestoreStatement ([reg : RegisterSymbol]) #:transparent)