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 Branch Lam Seq App
Let1 Let1
LetVoid LetVoid
InstallValue InstallValue))
#;LetRec))
(define-struct: Top ([prefix : Prefix] (define-struct: Top ([prefix : Prefix]
[code : ExpressionCore]) #:transparent) [code : ExpressionCore]) #:transparent)
@ -23,7 +22,8 @@
[pos : Natural]) [pos : Natural])
#:transparent) #:transparent)
(define-struct: LocalRef ([depth : Natural]) (define-struct: LocalRef ([depth : Natural]
[unbox? : Boolean])
#:transparent) #:transparent)
(define-struct: ToplevelSet ([depth : Natural] (define-struct: ToplevelSet ([depth : Natural]
@ -37,7 +37,7 @@
(define-struct: Lam ([num-parameters : Natural] (define-struct: Lam ([num-parameters : Natural]
[body : ExpressionCore] [body : ExpressionCore]
[closure-map : (Listof EnvReference)]) #:transparent) [closure-map : (Listof Natural)]) #:transparent)
(define-struct: Seq ([actions : (Listof ExpressionCore)]) #:transparent) (define-struct: Seq ([actions : (Listof ExpressionCore)]) #:transparent)
(define-struct: App ([operator : ExpressionCore] (define-struct: App ([operator : ExpressionCore]
@ -47,18 +47,15 @@
[body : ExpressionCore]) [body : ExpressionCore])
#:transparent) #:transparent)
(define-struct: LetVoid ([count : Natural] (define-struct: LetVoid ([count : Natural]
[body : ExpressionCore]) [body : ExpressionCore]
[boxes? : Boolean])
#:transparent) #:transparent)
(define-struct: InstallValue ([depth : Natural] (define-struct: InstallValue ([depth : Natural]
[body : ExpressionCore]) [body : ExpressionCore]
[boxes? : Boolean])
#:transparent) #: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 collect-lexical-references
lexical-references->compile-time-environment lexical-references->compile-time-environment
place-prefix-mask place-prefix-mask
adjust-env-reference-depth) adjust-env-reference-depth
env-reference-depth)
;; Find where the variable is located in the lexical environment ;; Find where the variable is located in the lexical environment
@ -186,3 +187,12 @@
(EnvPrefixReference-name target))] (EnvPrefixReference-name target))]
[(EnvWholePrefixReference? target) [(EnvWholePrefixReference? target)
(make-EnvWholePrefixReference (+ n (EnvWholePrefixReference-depth 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)]) (let ([address (find-variable exp cenv)])
(cond (cond
[(EnvLexicalReference? address) [(EnvLexicalReference? address)
(make-LocalRef (EnvLexicalReference-depth address))] (make-LocalRef (EnvLexicalReference-depth address)
(EnvLexicalReference-unbox? address))]
[(EnvPrefixReference? address) [(EnvPrefixReference? address)
(make-ToplevelRef (EnvPrefixReference-depth address) (make-ToplevelRef (EnvPrefixReference-depth address)
(EnvPrefixReference-pos address))]))] (EnvPrefixReference-pos address))]))]
@ -80,7 +81,7 @@
(if (= (length lam-body) 1) (if (= (length lam-body) 1)
(first lam-body) (first lam-body)
(make-Seq lam-body)) (make-Seq lam-body))
closure-references)))] (map env-reference-depth closure-references))))]
[(begin? exp) [(begin? exp)
(let ([actions (map (lambda (e) (let ([actions (map (lambda (e)
@ -289,11 +290,12 @@
(make-LetVoid (length vars) (make-LetVoid (length vars)
(make-Seq (append (make-Seq (append
(map (lambda (rhs index) (map (lambda (rhs index)
(make-InstallValue index (parse rhs rhs-cenv))) (make-InstallValue index (parse rhs rhs-cenv) #f))
rhss rhss
(build-list (length rhss) (lambda (i) i))) (build-list (length rhss) (lambda (i) i)))
(list (parse `(begin ,@body) (list (parse `(begin ,@body)
(extend-lexical-environment/names cenv vars)))))))]))) (extend-lexical-environment/names cenv vars)))))
#f))])))
(define (parse-letrec exp cenv) (define (parse-letrec exp cenv)
(let ([vars (let-variables exp)] (let ([vars (let-variables exp)]
@ -303,14 +305,15 @@
[(= 0 (length vars)) [(= 0 (length vars))
(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/boxed-names cenv vars)])
(make-LetVoid (length vars) (make-LetVoid (length vars)
(make-Seq (append (make-Seq (append
(map (lambda (rhs index) (map (lambda (rhs index)
(make-InstallValue index (parse rhs new-cenv))) (make-InstallValue index (parse rhs new-cenv) #t))
rhss rhss
(build-list (length rhss (lambda (i) i)))) (build-list (length rhss) (lambda (i) i)))
(list (parse `(begin ,@body) new-cenv))))))]))) (list (parse `(begin ,@body) new-cenv))))
#t))])))
(define (desugar-let* exp) (define (desugar-let* exp)

140
test-parse.rkt
View File

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