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

continuing to fix the parsing

Browse Source
This commit is contained in:
Danny Yoo 2011-03-20 21:06:28 -04:00
parent c72caa5857
commit 2d05a3b8ad
4 changed files with 120 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
expression-structs.rkt
View File

@ -11,8 +11,7 @@
Branch Lam Seq App
Let1
LetVoid
InstallValue
#;LetRec))
InstallValue))
(define-struct: Top ([prefix : Prefix]
[code : ExpressionCore]) #:transparent)
@ -23,7 +22,8 @@
[pos : Natural])
#:transparent)
(define-struct: LocalRef ([depth : Natural])
(define-struct: LocalRef ([depth : Natural]
[unbox? : Boolean])
#:transparent)
(define-struct: ToplevelSet ([depth : Natural]
@ -37,7 +37,7 @@
(define-struct: Lam ([num-parameters : Natural]
[body : ExpressionCore]
[closure-map : (Listof EnvReference)]) #:transparent)
[closure-map : (Listof Natural)]) #:transparent)
(define-struct: Seq ([actions : (Listof ExpressionCore)]) #:transparent)
(define-struct: App ([operator : ExpressionCore]
@ -47,18 +47,15 @@
[body : ExpressionCore])
#:transparent)
(define-struct: LetVoid ([count : Natural]
[body : ExpressionCore])
[body : ExpressionCore]
[boxes? : Boolean])
#:transparent)
(define-struct: InstallValue ([depth : Natural]
[body : ExpressionCore])
[body : ExpressionCore]
[boxes? : Boolean])
#:transparent)
#;(define-struct: LetRec ([count : Natural]
[rhss : (Listof Lam)]
[body : ExpressionCore])
#:transparent)

12
lexical-env.rkt
View File

@ -11,7 +11,8 @@
collect-lexical-references
lexical-references->compile-time-environment
place-prefix-mask
adjust-env-reference-depth)
adjust-env-reference-depth
env-reference-depth)
;; Find where the variable is located in the lexical environment
@ -186,3 +187,12 @@
(EnvPrefixReference-name target))]
[(EnvWholePrefixReference? target)
(make-EnvWholePrefixReference (+ n (EnvWholePrefixReference-depth target)))]))
(: env-reference-depth (EnvReference -> Natural))
(define (env-reference-depth a-ref)
(cond
[(EnvLexicalReference? a-ref)
(EnvLexicalReference-depth a-ref)]
[(EnvWholePrefixReference? a-ref)
(EnvWholePrefixReference-depth a-ref)]))

19
parse.rkt
View File

@ -38,7 +38,8 @@
(let ([address (find-variable exp cenv)])
(cond
[(EnvLexicalReference? address)
(make-LocalRef (EnvLexicalReference-depth address))]
(make-LocalRef (EnvLexicalReference-depth address)
(EnvLexicalReference-unbox? address))]
[(EnvPrefixReference? address)
(make-ToplevelRef (EnvPrefixReference-depth address)
(EnvPrefixReference-pos address))]))]
@ -80,7 +81,7 @@
(if (= (length lam-body) 1)
(first lam-body)
(make-Seq lam-body))
closure-references)))]
(map env-reference-depth closure-references))))]
[(begin? exp)
(let ([actions (map (lambda (e)
@ -289,11 +290,12 @@
(make-LetVoid (length vars)
(make-Seq (append
(map (lambda (rhs index)
(make-InstallValue index (parse rhs rhs-cenv)))
(make-InstallValue index (parse rhs rhs-cenv) #f))
rhss
(build-list (length rhss) (lambda (i) i)))
(list (parse `(begin ,@body)
(extend-lexical-environment/names cenv vars)))))))])))
(extend-lexical-environment/names cenv vars)))))
#f))])))
(define (parse-letrec exp cenv)
(let ([vars (let-variables exp)]
@ -303,14 +305,15 @@
[(= 0 (length vars))
(parse `(begin ,@body) cenv)]
[else
(let ([new-cenv (extend-lexical-environment/names cenv vars)])
(let ([new-cenv (extend-lexical-environment/boxed-names cenv vars)])
(make-LetVoid (length vars)
(make-Seq (append
(map (lambda (rhs index)
(make-InstallValue index (parse rhs new-cenv)))
(make-InstallValue index (parse rhs new-cenv) #t))
rhss
(build-list (length rhss (lambda (i) i))))
(list (parse `(begin ,@body) new-cenv))))))])))
(build-list (length rhss) (lambda (i) i)))
(list (parse `(begin ,@body) new-cenv))))
#t))])))
(define (desugar-let* exp)

140
test-parse.rkt
View File

@ -88,36 +88,37 @@
(test (parse '(lambda (x y z) x))
(make-Top (make-Prefix '())
(make-Lam 3 (make-LocalRef 0) '())))
(make-Lam 3 (make-LocalRef 0 #f) '())))
(test (parse '(lambda (x y z) y))
(make-Top (make-Prefix '())
(make-Lam 3 (make-LocalRef 1) '())))
(make-Lam 3 (make-LocalRef 1 #f) '())))
(test (parse '(lambda (x y z) z))
(make-Top (make-Prefix '())
(make-Lam 3 (make-LocalRef 2) '())))
(make-Lam 3 (make-LocalRef 2 #f) '())))
(test (parse '(lambda (x y z) x y z))
(make-Top (make-Prefix '())
(make-Lam 3 (make-Seq (list (make-LocalRef 0)
(make-LocalRef 1)
(make-LocalRef 2)))
(make-Lam 3 (make-Seq (list (make-LocalRef 0 #f)
(make-LocalRef 1 #f)
(make-LocalRef 2 #f)))
'())))
(test (parse '(lambda (x y z) k))
(make-Top (make-Prefix '(k))
(make-Lam 3 (make-ToplevelRef 0 0 )
(list (make-EnvWholePrefixReference 0)))))
(make-Lam 3
(make-ToplevelRef 0 0 )
'(0))))
(test (parse '(lambda (x y z) k x y z))
(make-Top (make-Prefix '(k))
(make-Lam 3 (make-Seq (list (make-ToplevelRef 0 0 )
(make-LocalRef 1)
(make-LocalRef 2)
(make-LocalRef 3)))
(list (make-EnvWholePrefixReference 0)))))
(make-LocalRef 1 #f)
(make-LocalRef 2 #f)
(make-LocalRef 3 #f)))
'(0))))
(test (parse '(lambda (x)
(lambda (y)
@ -131,18 +132,16 @@
(make-Lam 1
(make-Lam 1
(make-Seq (list
(make-LocalRef 1)
(make-LocalRef 2)
(make-LocalRef 3)
(make-LocalRef 1 #f)
(make-LocalRef 2 #f)
(make-LocalRef 3 #f)
(make-ToplevelRef 0 0)))
(list (make-EnvWholePrefixReference 0) ;; w
(make-EnvLexicalReference 1 #f) ;; x
(make-EnvLexicalReference 2 #f) ;; y
))
(list (make-EnvWholePrefixReference 0) ;; w
(make-EnvLexicalReference 1 #f) ;; x
))
(list (make-EnvWholePrefixReference 0)))))
'(0 1 2) ;; w x y
)
'(0 1) ;; w x
)
'(0))))
(test (parse '(lambda (x)
(lambda (y)
@ -150,8 +149,8 @@
(make-Top (make-Prefix '())
(make-Lam 1
(make-Lam 1
(make-LocalRef 0)
(list (make-EnvLexicalReference 0 #f)))
(make-LocalRef 0 #f)
'(0))
(list))))
(test (parse '(lambda (x)
@ -160,7 +159,7 @@
(make-Top (make-Prefix '())
(make-Lam 1
(make-Lam 1
(make-LocalRef 0)
(make-LocalRef 0 #f)
(list))
(list))))
@ -175,9 +174,9 @@
(make-Top (make-Prefix '(+))
(make-Lam 1
(make-App (make-ToplevelRef 2 0)
(list (make-LocalRef 3)
(make-LocalRef 3)))
(list (make-EnvWholePrefixReference 0)))))
(list (make-LocalRef 3 #f)
(make-LocalRef 3 #f)))
'(0))))
(test (parse '(lambda (x)
(+ (* x x) x)))
@ -188,10 +187,10 @@
(list
;; stack layout: [???, ???, ???, ???, prefix, x]
(make-App (make-ToplevelRef 4 0)
(list (make-LocalRef 5)
(make-LocalRef 5)))
(make-LocalRef 3)))
(list (make-EnvWholePrefixReference 0)))))
(list (make-LocalRef 5 #f)
(make-LocalRef 5 #f)))
(make-LocalRef 3 #f)))
'(0))))
(test (parse '(let ()
x))
@ -202,7 +201,7 @@
x))
(make-Top (make-Prefix '())
(make-Let1 (make-Constant 3)
(make-LocalRef 0))))
(make-LocalRef 0 #f))))
(test (parse '(let ([x 3]
[y 4])
@ -210,10 +209,11 @@
y))
(make-Top (make-Prefix '())
(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))))))))
(make-Seq (list (make-InstallValue 0 (make-Constant 3) #f)
(make-InstallValue 1 (make-Constant 4) #f)
(make-Seq (list (make-LocalRef 0 #f)
(make-LocalRef 1 #f)))))
#f)))
(test (parse '(let ([x 3]
[y 4])
@ -223,13 +223,15 @@
y)))
(make-Top (make-Prefix '())
(make-LetVoid 2
(make-Seq (list (make-InstallValue 0 (make-Constant 3))
(make-InstallValue 1 (make-Constant 4))
(make-Seq (list (make-InstallValue 0 (make-Constant 3) #f)
(make-InstallValue 1 (make-Constant 4) #f)
(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)))))))))))
(make-Seq (list (make-InstallValue 0 (make-LocalRef 3 #f) #f)
(make-InstallValue 1 (make-LocalRef 2 #f) #f)
(make-Seq (list (make-LocalRef 0 #f)
(make-LocalRef 1 #f)))))
#f)))
#f)))
@ -251,11 +253,11 @@
(make-App
;; stack layout: [???, ???, x_0, prefix]
(make-ToplevelRef 3 0) (list (make-LocalRef 2)))
(make-ToplevelRef 3 0) (list (make-LocalRef 2 #f)))
;; stack layout [???, x_1, x_0, prefix]
(make-App (make-ToplevelRef 3 0)
(list (make-LocalRef 1)))))))
(list (make-LocalRef 1 #f)))))))
(test (parse '(let* ()
@ -263,7 +265,45 @@
(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)])
(x y)))
(make-Top (make-Prefix '())
(make-LetVoid 2
(make-Seq
(list
(make-InstallValue 0
(make-Lam 1 (make-LocalRef 0 #f) '())
#t)
(make-InstallValue 1
(make-Lam 1 (make-LocalRef 0 #f) '())
#t)
;; stack layout: ??? x y
(make-App (make-LocalRef 1 #t)
(list (make-LocalRef 2 #t)))))
#t)))
(test (parse '(letrec ([x (lambda (x) (y x))]
[y (lambda (x) (x y))])
(x y)))
(make-Top (make-Prefix '())
(make-LetVoid 2
(make-Seq
(list
(make-InstallValue 0
(make-Lam 1
(make-App (make-LocalRef 1 #t)
(list (make-LocalRef 2 #f)))
'(1))
#t)
(make-InstallValue 1
(make-Lam 1
(make-App (make-LocalRef 2 #f)
(list (make-LocalRef 1 #t)))
'(1))
#t)
;; stack layout: ??? x y
(make-App (make-LocalRef 1 #t)
(list (make-LocalRef 2 #t)))))
#t)))