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

letrec boxenv installvalue

Browse Source
This commit is contained in:
Danny Yoo 2011-05-10 00:00:36 -04:00
parent e3d8a253fe
commit 0666c9d389
2 changed files with 38 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
parse-bytecode-5.1.1.rkt
View File

@ -407,7 +407,11 @@
(define (parse-install-value expr)
(error 'fixmeinstallvalue))
(match expr
[(struct install-value (count pos boxes? rhs body))
(make-Seq (list (make-InstallValue count pos (parse-expr-seq-constant rhs) boxes?)
(parse-expr-seq-constant body)))]))
(define (parse-let-rec expr)
(match expr
@ -417,7 +421,10 @@
(parse-expr-seq-constant body))]))
(define (parse-boxenv expr)
(error 'fixmeboxenv))
(match expr
[(struct boxenv (pos body))
(make-BoxEnv pos (parse-expr-seq-constant body))]))
(define (parse-localref expr)
(match expr

38
test-parse-bytecode-5.1.1.rkt
View File

@ -206,17 +206,37 @@
'() 'lamEntry1)
'()))))
(run-my-parse #'(letrec ([e (lambda (y)
(if (= y 0)
#t
(o (sub1 y))))]
[o (lambda (y)
(if (= y 0)
#f
(e sub1 y)))])
e))
;; FIXME: make this a real test.
(begin
(reset-lam-label-counter!/unit-testing)
(void (run-my-parse #'(letrec ([e (lambda (y)
(if (= y 0)
#t
(o (sub1 y))))]
[o (lambda (y)
(if (= y 0)
#f
(e sub1 y)))])
e))))
(check-equal? (run-my-parse #'(let ([x 3])
(set! x (add1 x))
x))
(make-Top (make-Prefix '())
(make-Let1
(make-Constant 3)
(make-BoxEnv 0
(make-Seq
(list
(make-InstallValue
1 0
(make-App (make-PrimitiveKernelValue 'add1)
(list (make-LocalRef 1 #t)))
#t)
(make-LocalRef 0 #t)))))))
;; make sure we don't see an infinite loop