From 91e6172298aa02853d3b96cfea65a346e6b98cc2 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Thu, 28 Apr 2011 13:29:27 -0400 Subject: [PATCH] expanding install-values to install mutliple values --- compiler.rkt | 6 ++++-- expression-structs.rkt | 3 ++- parse.rkt | 9 ++++++--- test-parse.rkt | 30 +++++++++++++++--------------- 4 files changed, 27 insertions(+), 21 deletions(-) diff --git a/compiler.rkt b/compiler.rkt index 7dbd6f4..7ca9597 100644 --- a/compiler.rkt +++ b/compiler.rkt @@ -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) diff --git a/expression-structs.rkt b/expression-structs.rkt index d622277..034662d 100644 --- a/expression-structs.rkt +++ b/expression-structs.rkt @@ -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) diff --git a/parse.rkt b/parse.rkt index a6a312f..33cd0cc 100644 --- a/parse.rkt +++ b/parse.rkt @@ -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)) diff --git a/test-parse.rkt b/test-parse.rkt index 824902c..f57fc0f 100644 --- a/test-parse.rkt +++ b/test-parse.rkt @@ -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)