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

changed to letvoid

Browse Source
This commit is contained in:
Danny Yoo 2011-03-20 20:33:07 -04:00
parent 488fe3f0a1
commit c72caa5857
5 changed files with 81 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
compile.rkt
View File

@ -602,22 +602,7 @@
after-letrec)))) after-letrec))))
(: adjust-target-depth (Target Natural -> Target))
(define (adjust-target-depth target n)
(cond
[(eq? target 'val)
target]
[(eq? target 'proc)
target]
[(EnvLexicalReference? target)
(make-EnvLexicalReference (+ n (EnvLexicalReference-depth target))
(EnvLexicalReference-unbox? target))]
[(EnvPrefixReference? target)
(make-EnvPrefixReference (+ n (EnvPrefixReference-depth target))
(EnvPrefixReference-pos target)
(EnvPrefixReference-name target))]
[(PrimitivesReference? target)
target]))
@ -644,3 +629,21 @@
(error 'ensure-natural "Not a natural: ~s\n" n))) (error 'ensure-natural "Not a natural: ~s\n" n)))
(: adjust-target-depth (Target Natural -> Target))
(define (adjust-target-depth target n)
(cond
[(eq? target 'val)
target]
[(eq? target 'proc)
target]
[(EnvLexicalReference? target)
(make-EnvLexicalReference (+ n (EnvLexicalReference-depth target))
(EnvLexicalReference-unbox? target))]
[(EnvPrefixReference? target)
(make-EnvPrefixReference (+ n (EnvPrefixReference-depth target))
(EnvPrefixReference-pos target)
(EnvPrefixReference-name target))]
[(PrimitivesReference? target)
target]))

20
expression-structs.rkt
View File

@ -9,7 +9,10 @@
ToplevelRef LocalRef ToplevelRef LocalRef
ToplevelSet ToplevelSet
Branch Lam Seq App Branch Lam Seq App
Let1 Let LetRec)) Let1
LetVoid
InstallValue
#;LetRec))
(define-struct: Top ([prefix : Prefix] (define-struct: Top ([prefix : Prefix]
[code : ExpressionCore]) #:transparent) [code : ExpressionCore]) #:transparent)
@ -43,16 +46,19 @@
(define-struct: Let1 ([rhs : ExpressionCore] (define-struct: Let1 ([rhs : ExpressionCore]
[body : ExpressionCore]) [body : ExpressionCore])
#:transparent) #:transparent)
(define-struct: Let ([count : Natural] (define-struct: LetVoid ([count : Natural]
[rhss : (Listof ExpressionCore)] [body : ExpressionCore])
[body : ExpressionCore])
#:transparent) #:transparent)
(define-struct: LetRec ([count : Natural] (define-struct: InstallValue ([depth : Natural]
[rhss : (Listof Lam)] [body : ExpressionCore])
[body : ExpressionCore])
#:transparent) #:transparent)
#;(define-struct: LetRec ([count : Natural]
[rhss : (Listof Lam)]
[body : ExpressionCore])
#:transparent)

18
lexical-env.rkt
View File

@ -10,7 +10,8 @@
extend-lexical-environment/placeholders extend-lexical-environment/placeholders
collect-lexical-references collect-lexical-references
lexical-references->compile-time-environment lexical-references->compile-time-environment
place-prefix-mask) place-prefix-mask
adjust-env-reference-depth)
;; Find where the variable is located in the lexical environment ;; Find where the variable is located in the lexical environment
@ -170,3 +171,18 @@
#f)] #f)]
[else n])) [else n]))
(Prefix-names a-prefix)))) (Prefix-names a-prefix))))
(: adjust-env-reference-depth (EnvReference Natural -> EnvReference))
(define (adjust-env-reference-depth target n)
(cond
[(EnvLexicalReference? target)
(make-EnvLexicalReference (+ n (EnvLexicalReference-depth target))
(EnvLexicalReference-unbox? target))]
[(EnvPrefixReference? target)
(make-EnvPrefixReference (+ n (EnvPrefixReference-depth target))
(EnvPrefixReference-pos target)
(EnvPrefixReference-name target))]
[(EnvWholePrefixReference? target)
(make-EnvWholePrefixReference (+ n (EnvWholePrefixReference-depth target)))]))

22
parse.rkt
View File

@ -286,10 +286,14 @@
(extend-lexical-environment/names cenv (list (first vars)))))] (extend-lexical-environment/names cenv (list (first vars)))))]
[else [else
(let ([rhs-cenv (extend-lexical-environment/placeholders cenv (length vars))]) (let ([rhs-cenv (extend-lexical-environment/placeholders cenv (length vars))])
(make-Let (length vars) (make-LetVoid (length vars)
(map (lambda (rhs) (parse rhs rhs-cenv)) rhss) (make-Seq (append
(parse `(begin ,@body) (map (lambda (rhs index)
(extend-lexical-environment/names cenv vars))))]))) (make-InstallValue index (parse rhs rhs-cenv)))
rhss
(build-list (length rhss) (lambda (i) i)))
(list (parse `(begin ,@body)
(extend-lexical-environment/names cenv vars)))))))])))
(define (parse-letrec exp cenv) (define (parse-letrec exp cenv)
(let ([vars (let-variables exp)] (let ([vars (let-variables exp)]
@ -300,9 +304,13 @@
(parse `(begin ,@body) cenv)] (parse `(begin ,@body) cenv)]
[else [else
(let ([new-cenv (extend-lexical-environment/names cenv vars)]) (let ([new-cenv (extend-lexical-environment/names cenv vars)])
(make-LetRec (length vars) (make-LetVoid (length vars)
(map (lambda (rhs) (parse rhs new-cenv)) rhss) (make-Seq (append
(parse `(begin ,@body) new-cenv)))]))) (map (lambda (rhs index)
(make-InstallValue index (parse rhs new-cenv)))
rhss
(build-list (length rhss (lambda (i) i))))
(list (parse `(begin ,@body) new-cenv))))))])))
(define (desugar-let* exp) (define (desugar-let* exp)

31
test-parse.rkt
View File

@ -209,11 +209,11 @@
x x
y)) y))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-Let 2 (make-LetVoid 2
(list (make-Constant 3) (make-Seq (list (make-InstallValue 0 (make-Constant 3))
(make-Constant 4)) (make-InstallValue 1 (make-Constant 4))
(make-Seq (list (make-LocalRef 0) (make-Seq (list (make-LocalRef 0)
(make-LocalRef 1)))))) (make-LocalRef 1))))))))
(test (parse '(let ([x 3] (test (parse '(let ([x 3]
[y 4]) [y 4])
@ -222,13 +222,14 @@
x x
y))) y)))
(make-Top (make-Prefix '()) (make-Top (make-Prefix '())
(make-Let 2 (make-LetVoid 2
(list (make-Constant 3) (make-Constant 4)) (make-Seq (list (make-InstallValue 0 (make-Constant 3))
(make-Let 2 (make-InstallValue 1 (make-Constant 4))
(list (make-LocalRef 3) (make-LetVoid 2
(make-LocalRef 2)) (make-Seq (list (make-InstallValue 0 (make-LocalRef 3))
(make-Seq (list (make-LocalRef 0) (make-InstallValue 1 (make-LocalRef 2))
(make-LocalRef 1))))))) (make-Seq (list (make-LocalRef 0)
(make-LocalRef 1)))))))))))
@ -262,7 +263,7 @@
(make-Top (make-Prefix '()) (make-Constant 42))) (make-Top (make-Prefix '()) (make-Constant 42)))
(test (parse '(letrec ([x (lambda (x) x)] ;#;(test (parse '(letrec ([x (lambda (x) x)]
[y (lambda (x) x)]))) ; [y (lambda (x) x)])))
(make-Top (make-Prefix '()) ; (make-Top (make-Prefix '())