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

expanding install-values to install mutliple values

Browse Source
This commit is contained in:
Danny Yoo 2011-04-28 13:29:27 -04:00
parent d2fa527872
commit 91e6172298
4 changed files with 27 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
compiler.rkt
View File

@ -1711,12 +1711,14 @@
[(InstallValue? exp)
(if (< (InstallValue-depth exp) skip)
(make-InstallValue (InstallValue-depth exp)
(make-InstallValue (InstallValue-count exp)
(InstallValue-depth exp)
(adjust-expression-depth (InstallValue-body exp)
n
skip)
(InstallValue-box? exp))
(make-InstallValue (ensure-natural (- (InstallValue-depth exp) n))
(make-InstallValue (InstallValue-count exp)
(ensure-natural (- (InstallValue-depth exp) n))
(adjust-expression-depth (InstallValue-body exp)
n
skip)

3
expression-structs.rkt
View File

@ -64,7 +64,8 @@
[body : Expression])
#:transparent)
(define-struct: InstallValue ([depth : Natural]
(define-struct: InstallValue ([count : Natural] ;; how many values to install
[depth : Natural] ;; how many slots to skip
[body : Expression]
[box? : Boolean])
#:transparent)

9
parse.rkt
View File

@ -143,7 +143,8 @@
;; extent of the set!-value.
(make-Seq (list (cond
[(EnvLexicalReference? address)
(make-InstallValue (EnvLexicalReference-depth address)
(make-InstallValue 1
(EnvLexicalReference-depth address)
(parse (set!-value exp) cenv #f)
#t)]
[(EnvPrefixReference? address)
@ -559,7 +560,8 @@
(make-LetVoid (length vars)
(seq (append
(map (lambda (var rhs index)
(make-InstallValue index
(make-InstallValue 1
index
(parameterize ([current-defined-name var])
(parse rhs rhs-cenv #f))
any-mutated?))
@ -606,7 +608,8 @@
(make-LetVoid (length vars)
(seq (append
(map (lambda (var rhs index)
(make-InstallValue (- n 1 index)
(make-InstallValue 1
(- n 1 index)
(parameterize ([current-defined-name var])
(parse rhs new-cenv #f))
#t))

30
test-parse.rkt
View File

@ -257,8 +257,8 @@
y))
(make-Top (make-Prefix '())
(make-LetVoid 2
(make-Seq (list (make-InstallValue 0 (make-Constant 3) #f)
(make-InstallValue 1 (make-Constant 4) #f)
(make-Seq (list (make-InstallValue 1 0 (make-Constant 3) #f)
(make-InstallValue 1 1 (make-Constant 4) #f)
(make-Seq (list (make-LocalRef 0 #f)
(make-LocalRef 1 #f)))))
#f)))
@ -271,11 +271,11 @@
y)))
(make-Top (make-Prefix '())
(make-LetVoid 2
(make-Seq (list (make-InstallValue 0 (make-Constant 3) #f)
(make-InstallValue 1 (make-Constant 4) #f)
(make-Seq (list (make-InstallValue 1 0 (make-Constant 3) #f)
(make-InstallValue 1 1 (make-Constant 4) #f)
(make-LetVoid 2
(make-Seq (list (make-InstallValue 0 (make-LocalRef 3 #f) #f)
(make-InstallValue 1 (make-LocalRef 2 #f) #f)
(make-Seq (list (make-InstallValue 1 0 (make-LocalRef 3 #f) #f)
(make-InstallValue 1 1 (make-LocalRef 2 #f) #f)
(make-Seq (list (make-LocalRef 0 #f)
(make-LocalRef 1 #f)))))
#f)))
@ -344,14 +344,14 @@
(make-LetVoid 2
(make-Seq
(list
(make-InstallValue 1
(make-InstallValue 1 1
(make-Lam 'x 1 #f (make-LocalRef 0 #f) '() 'lamEntry1)
#t)
(make-InstallValue 0
(make-InstallValue 1 0
(make-Lam 'y 1 #f (make-LocalRef 0 #f) '() 'lamEntry2)
#t)
;; stack layout: ??? x y
(make-Seq (list (make-Seq (list (make-InstallValue 1 (make-LocalRef 1 #t) #t)
(make-Seq (list (make-Seq (list (make-InstallValue 1 1 (make-LocalRef 1 #t) #t)
(make-Constant (void))))
(make-App (make-LocalRef 2 #t)
(list (make-LocalRef 1 #t)))))))
@ -389,14 +389,14 @@
(make-LetVoid 2
(make-Seq
(list
(make-InstallValue 0
(make-InstallValue 1 0
(make-Lam 'x 1 #f
(make-App (make-LocalRef 1 #t)
(list (make-LocalRef 2 #f)))
'(1)
'lamEntry1)
#t)
(make-InstallValue 1
(make-InstallValue 1 1
(make-Lam 'y 1 #f
(make-App (make-LocalRef 2 #f)
(list (make-LocalRef 1 #t)))
@ -416,7 +416,7 @@
(make-BoxEnv 0
(make-Lam #f 0 #f
(make-Seq (list (make-InstallValue
1
1 1
(make-App (make-ToplevelRef 1 0)
(list (make-LocalRef 2 #t)))
#t)
@ -433,12 +433,12 @@
(make-Top (make-Prefix `(,(make-ModuleVariable 'add1 '#%kernel)))
(make-LetVoid 2
(make-Seq (list
(make-InstallValue 0 (make-Constant 0) #t)
(make-InstallValue 1 (make-Constant 1) #t)
(make-InstallValue 1 0 (make-Constant 0) #t)
(make-InstallValue 1 1 (make-Constant 1) #t)
(make-Lam #f 0 #f
(make-Seq
(list (make-InstallValue
1
1 1
(make-App (make-ToplevelRef 1 0)
(list (make-LocalRef 2 #t)))
#t)