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

20
lexical-env.rkt
View File

@ -10,7 +10,8 @@
extend-lexical-environment/placeholders
collect-lexical-references
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
@ -169,4 +170,19 @@
n
#f)]
[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)))))]
[else
(let ([rhs-cenv (extend-lexical-environment/placeholders cenv (length vars))])
(make-Let (length vars)
(map (lambda (rhs) (parse rhs rhs-cenv)) rhss)
(parse `(begin ,@body)
(extend-lexical-environment/names cenv vars))))])))
(make-LetVoid (length vars)
(make-Seq (append
(map (lambda (rhs index)
(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)
(let ([vars (let-variables exp)]
@ -300,9 +304,13 @@
(parse `(begin ,@body) cenv)]
[else
(let ([new-cenv (extend-lexical-environment/names cenv vars)])
(make-LetRec (length vars)
(map (lambda (rhs) (parse rhs new-cenv)) rhss)
(parse `(begin ,@body) new-cenv)))])))
(make-LetVoid (length vars)
(make-Seq (append
(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)

31
test-parse.rkt
View File

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