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

maintaining static information. Calls to let1 and letrec-bound bodies can be done with fewer primitive tests. Cool.

Browse Source
This commit is contained in:
Danny Yoo 2011-03-25 20:11:59 -04:00
parent b8d37d3325
commit fab12bcc83
1 changed files with 22 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
compile.rkt
View File

@ -81,7 +81,7 @@
(append (loop (Let1-rhs exp) (append (loop (Let1-rhs exp)
(cons '? cenv)) (cons '? cenv))
(loop (Let1-body exp) (loop (Let1-body exp)
(cons (extract-static-knowledge (Let1-rhs exp)) (cons (extract-static-knowledge (Let1-rhs exp) (cons '? cenv))
cenv)))] cenv)))]
[(LetVoid? exp) [(LetVoid? exp)
(loop (LetVoid-body exp) (loop (LetVoid-body exp)
@ -92,7 +92,13 @@
[(BoxEnv? exp) [(BoxEnv? exp)
'()] '()]
[(LetRec? exp) [(LetRec? exp)
(let ([new-cenv (append (map extract-static-knowledge (reverse (LetRec-procs exp))) (let ([new-cenv (append (map (lambda: ([p : Lam])
(extract-static-knowledge
p
(append (build-list (length (LetRec-procs exp))
(lambda: ([i : Natural]) '?))
cenv)))
(reverse (LetRec-procs exp)))
cenv)]) cenv)])
(append (apply append (append (apply append
(map (lambda: ([lam : Lam]) (map (lambda: ([lam : Lam])
@ -549,12 +555,14 @@
(error 'compile "return linkage, target not val: ~s" target)])) (error 'compile "return linkage, target not val: ~s" target)]))
(: extract-static-knowledge (ExpressionCore -> CompileTimeEnvironmentEntry)) (: extract-static-knowledge (ExpressionCore CompileTimeEnvironment -> CompileTimeEnvironmentEntry))
(define (extract-static-knowledge exp) (define (extract-static-knowledge exp cenv)
(cond (cond
[(Lam? exp) [(Lam? exp)
(make-StaticallyKnownLam (Lam-entry-label exp) (make-StaticallyKnownLam (Lam-entry-label exp)
(Lam-num-parameters exp))] (Lam-num-parameters exp))]
[(LocalRef? exp)
(list-ref cenv (LocalRef-depth exp))]
[else [else
'?])) '?]))
@ -568,7 +576,9 @@
'next)] 'next)]
[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 : CompileTimeEnvironment (cons (extract-static-knowledge (Let1-rhs exp)) cenv)] [extended-cenv : CompileTimeEnvironment (cons (extract-static-knowledge (Let1-rhs exp)
(cons '? cenv))
cenv)]
[let-linkage : Linkage [let-linkage : Linkage
(cond (cond
[(eq? linkage 'next) [(eq? linkage 'next)
@ -626,7 +636,13 @@
(: compile-let-rec (LetRec CompileTimeEnvironment Target Linkage -> InstructionSequence)) (: compile-let-rec (LetRec CompileTimeEnvironment Target Linkage -> InstructionSequence))
(define (compile-let-rec exp cenv target linkage) (define (compile-let-rec exp cenv target linkage)
(let*: ([extended-cenv : CompileTimeEnvironment (append (map extract-static-knowledge (let*: ([extended-cenv : CompileTimeEnvironment (append (map (lambda: ([p : Lam])
(extract-static-knowledge
p
(append (build-list (length (LetRec-procs exp))
(lambda: ([i : Natural])
'?))
cenv)))
(reverse (LetRec-procs exp))) (reverse (LetRec-procs exp)))
cenv)] cenv)]
[n : Natural (length (LetRec-procs exp))] [n : Natural (length (LetRec-procs exp))]