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

in the middle of the optimization

Browse Source
This commit is contained in:
Danny Yoo 2011-03-31 12:45:40 -04:00
parent 588855e5ab
commit 51b1db2620
1 changed files with 32 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
compile.rkt
View File

@ -1010,12 +1010,12 @@
(make-EnvWholePrefixReference (ensure-natural (+ n (EnvWholePrefixReference-depth arg))))])) (make-EnvWholePrefixReference (ensure-natural (+ n (EnvWholePrefixReference-depth arg))))]))
(: adjust-expression-depth (Expression Integer -> Expression)) (: adjust-expression-depth (Expression Integer Natural -> Expression))
(define (adjust-expression-depth exp n) (define (adjust-expression-depth exp n skip)
(cond (cond
[(Top? exp) [(Top? exp)
(make-Top (Top-prefix exp) (make-Top (Top-prefix exp)
(adjust-expression-depth (Top-code exp) n))] (adjust-expression-depth (Top-code exp) n skip))]
[(Constant? exp) [(Constant? exp)
exp] exp]
@ -1031,12 +1031,12 @@
(make-ToplevelSet (ensure-natural (+ n (ToplevelSet-depth exp))) (make-ToplevelSet (ensure-natural (+ n (ToplevelSet-depth exp)))
(ToplevelSet-pos exp) (ToplevelSet-pos exp)
(ToplevelSet-name exp) (ToplevelSet-name exp)
(adjust-expression-depth (ToplevelSet-value exp) n))] (adjust-expression-depth (ToplevelSet-value exp) n skip))]
[(Branch? exp) [(Branch? exp)
(make-Branch (adjust-expression-depth (Branch-predicate exp) n) (make-Branch (adjust-expression-depth (Branch-predicate exp) n skip)
(adjust-expression-depth (Branch-consequent exp) n) (adjust-expression-depth (Branch-consequent exp) n skip)
(adjust-expression-depth (Branch-alternative exp) n))] (adjust-expression-depth (Branch-alternative exp) n skip))]
[(Lam? exp) [(Lam? exp)
(make-Lam (Lam-name exp) (make-Lam (Lam-name exp)
@ -1045,21 +1045,41 @@
(map (lambda: ([d : Natural]) (ensure-natural (+ n d))) (map (lambda: ([d : Natural]) (ensure-natural (+ n d)))
(Lam-closure-map exp)) (Lam-closure-map exp))
(Lam-entry-label exp))] (Lam-entry-label exp))]
[(Seq? exp) [(Seq? exp)
(make-Seq (map (lambda: ([action : Expression]) (make-Seq (map (lambda: ([action : Expression])
(adjust-expression-depth action n)) (adjust-expression-depth action n skip))
(Seq-actions exp)))] (Seq-actions exp)))]
[(App? exp) [(App? exp)
...] (make-App (adjust-expression-depth (App-operator exp) n)
(map (lambda: ([operand : Expression])
(adjust-expression-depth operand n skip))
(App-operands exp)))]
[(Let1? exp) [(Let1? exp)
...] (make-Let1 (adjust-expression-depth (Let1-rhs exp) n (add1 skip))
(adjust-expression-depth (Let1-body exp) n) (add1 skip))]
[(LetVoid? exp) [(LetVoid? exp)
...] (make-LetVoid (LetVoid-count exp)
(adjust-expression-depth (LetVoid-body exp) (+ (LetVoid-count exp) n))
(LetVoid-boxes? exp))]
[(LetRec? exp) [(LetRec? exp)
...] (make-LetRec (map (lambda: ([proc : Lam])
(adjust-expression-depth
proc n
(+ (length (LetRec-procs exp))
skip)))
(LetRec-procs exp))
(adjust-expression-depth (LetRec-body exp) n
(+ (length (LetRec-procs exp))
skip)))]
[(InstallValue? exp) [(InstallValue? exp)
...] ...]
[(BoxEnv? exp) [(BoxEnv? exp)
...])) ...]))