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

a little cleanup

Browse Source
This commit is contained in:
Danny Yoo 2011-03-21 23:54:41 -04:00
parent 2c99b067e5
commit 656d950846
2 changed files with 4 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
compile.rkt
View File

@ -406,8 +406,7 @@
(compile (Let1-rhs exp) (compile (Let1-rhs exp)
(add1 cenv) (add1 cenv)
(make-EnvLexicalReference 0 #f) (make-EnvLexicalReference 0 #f)
'next) 'next)]
#;(parameterize ([current-defined-name (Let1-name exp)]) ...)]
[after-let1 : Symbol (make-label 'afterLetOne)] [after-let1 : Symbol (make-label 'afterLetOne)]
[after-body-code : Symbol (make-label 'afterLetBody)] [after-body-code : Symbol (make-label 'afterLetBody)]
[extended-cenv : Natural (add1 cenv)] [extended-cenv : Natural (add1 cenv)]
@ -462,49 +461,6 @@
(make-instruction-sequence `(,(make-PopEnvironment n 0))) (make-instruction-sequence `(,(make-PopEnvironment n 0)))
after-let)))) after-let))))
#;(: compile-letrec (LetRec CompileTimeEnvironment Target Linkage -> InstructionSequence))
#;(define (compile-letrec exp cenv target linkage)
(let*: ([n : Natural (length (LetRec-rhss exp))]
[rhs-codes : (Listof InstructionSequence)
(map (lambda: ([rhs : ExpressionCore]
[i : Natural]
[name : Symbol])
(parameterize ([current-defined-name name])
(compile rhs
(extend-lexical-environment/boxed-names cenv
(LetRec-names exp))
(make-EnvLexicalReference i #t)
'next)))
(LetRec-rhss exp)
(build-list n (lambda: ([i : Natural]) i))
(LetRec-names exp))]
[after-letrec : Symbol (make-label 'afterLetRec)]
[after-body-code : Symbol (make-label 'afterLetBody)]
[extended-cenv : CompileTimeEnvironment
(extend-lexical-environment/boxed-names cenv (LetRec-names exp))]
[let-linkage : Linkage
(cond
[(eq? linkage 'next)
'next]
[(eq? linkage 'return)
'return]
[(symbol? linkage)
after-body-code])]
[body-target : Target (adjust-target-depth target n)]
[body-code : InstructionSequence
(compile (LetRec-body exp) extended-cenv body-target let-linkage)])
(end-with-linkage
linkage
extended-cenv
(append-instruction-sequences
(make-instruction-sequence `(,(make-PushEnvironment n #t)))
(apply append-instruction-sequences rhs-codes)
body-code
after-body-code
(make-instruction-sequence `(,(make-PopEnvironment n 0)))
after-letrec))))
(: compile-install-value (InstallValue Natural Target Linkage -> InstructionSequence)) (: compile-install-value (InstallValue Natural Target Linkage -> InstructionSequence))
(define (compile-install-value exp cenv target linkage) (define (compile-install-value exp cenv target linkage)

4
parse.rkt
View File

@ -374,7 +374,9 @@
,(loop (cdr clauses))))]))) ,(loop (cdr clauses))))])))
;;
;; Fixme: see if the parameter is mutated. If so, box it.
;;
(define (parse-let exp cenv) (define (parse-let exp cenv)
(let ([vars (let-variables exp)] (let ([vars (let-variables exp)]
[rhss (let-rhss exp)] [rhss (let-rhss exp)]