some testing on letrec
This commit is contained in:
Danny Yoo
parent
c75385278c
commit
32e1f1a5dc
14
assemble.rkt
14
assemble.rkt
|
|
@ -156,6 +156,8 @@ EOF
|
|||
[(RestoreEnvironment!? op)
|
||||
empty]
|
||||
[(RestoreControl!? op)
|
||||
empty]
|
||||
[(FixClosureShellMap!? op)
|
||||
empty]))
|
||||
|
||||
(unique/eq?
|
||||
|
|
@ -440,7 +442,17 @@ EOF
|
|||
[(RestoreEnvironment!? op)
|
||||
"MACHINE.env = MACHINE.env[MACHINE.env.length - 2].slice(0);"]
|
||||
[(RestoreControl!? op)
|
||||
"MACHINE.control = MACHINE.env[MACHINE.env.length - 1].slice(0);"]))
|
||||
"MACHINE.control = MACHINE.env[MACHINE.env.length - 1].slice(0);"]
|
||||
[(FixClosureShellMap!? op)
|
||||
(format "MACHINE.env[MACHINE.env.length - 1 - ~a].closedVals = [~a]"
|
||||
(FixClosureShellMap!-depth op)
|
||||
(string-join (map assemble-env-reference/closure-capture
|
||||
;; The closure values are in reverse order
|
||||
;; to make it easier to push, in bulk, into
|
||||
;; the environment (which is also in reversed order)
|
||||
;; during install-closure-values.
|
||||
(reverse (FixClosureShellMap!-closed-vals op)))
|
||||
", "))]))
|
||||
|
||||
|
||||
(: assemble-input (OpArg -> String))
|
||||
|
|
|
|||
|
|
@ -455,8 +455,10 @@
|
|||
;; Semantics: allocate a closure shell for each lambda form in procs.
|
||||
;; Install them in reverse order, so that the closure shell for the last element
|
||||
;; in procs is at stack position 0.
|
||||
(make-LetRec (map (lambda (rhs) (parse rhs new-cenv))
|
||||
rhss)
|
||||
(make-LetRec (map (lambda (rhs name) (parameterize ([current-defined-name name])
|
||||
(parse rhs new-cenv)))
|
||||
rhss
|
||||
vars)
|
||||
(parse `(begin ,@body) new-cenv)))]
|
||||
[else
|
||||
(let ([new-cenv (extend-lexical-environment/boxed-names cenv (reverse vars))])
|
||||
|
|
|
|||
|
|
@ -713,6 +713,26 @@
|
|||
'(()()))
|
||||
|
||||
|
||||
(let ([op (open-output-string)])
|
||||
(parameterize ([current-simulated-output-port op])
|
||||
(test
|
||||
'(letrec ([a (lambda (x)
|
||||
(display "a") (display x) (c (add1 x)))]
|
||||
[b (lambda (k)
|
||||
(display "b") (display k) (e (add1 k)))]
|
||||
[c (lambda (y)
|
||||
(display "c") (display y) (b (add1 y)))]
|
||||
[d (lambda (z)
|
||||
(display "d") (display z) z)]
|
||||
[e (lambda (x)
|
||||
(display "e") (display x) (d (add1 x)))])
|
||||
(a 0))
|
||||
4))
|
||||
(unless (string=? "a0c1b2e3d4" (get-output-string op))
|
||||
(error 'letrec-failed)))
|
||||
|
||||
|
||||
|
||||
#;(test (read (open-input-file "tests/conform/program0.sch"))
|
||||
(port->string (open-input-file "tests/conform/expected0.txt")))
|
||||
|
||||
|
|
|
|||
|
|
@ -278,50 +278,76 @@
|
|||
(make-Top (make-Prefix '()) (make-Constant 42)))
|
||||
|
||||
|
||||
|
||||
|
||||
(test (parse '(letrec ([omega (lambda () (omega))])
|
||||
(omega)))
|
||||
(make-Top (make-Prefix '())
|
||||
(make-LetRec (list (make-Lam 'omega 0 (make-App (make-LocalRef 0 #f)
|
||||
(list)) '(0) 'lamEntry1))
|
||||
(make-App (make-LocalRef 0 #f) (list)))))
|
||||
|
||||
|
||||
|
||||
(test (parse '(letrec ([a (lambda () (b))]
|
||||
[b (lambda () (c))]
|
||||
[c (lambda () (a))])
|
||||
(a)))
|
||||
(make-Top (make-Prefix '())
|
||||
(make-LetRec (list (make-Lam 'a 0 (make-App (make-LocalRef 0 #f) '()) '(1) 'lamEntry1)
|
||||
(make-Lam 'b 0 (make-App (make-LocalRef 0 #f) '()) '(0) 'lamEntry2)
|
||||
(make-Lam 'c 0 (make-App (make-LocalRef 0 #f) '()) '(2) 'lamEntry3))
|
||||
(make-App (make-LocalRef 2 #f) '()))))
|
||||
|
||||
|
||||
|
||||
(test (parse '(letrec ([x (lambda (x) x)]
|
||||
[y (lambda (x) x)])
|
||||
(set! x x)
|
||||
(x y)))
|
||||
(make-Top (make-Prefix '())
|
||||
(make-LetVoid 2
|
||||
(make-Seq
|
||||
(list
|
||||
(make-InstallValue 0
|
||||
(make-InstallValue 1
|
||||
(make-Lam 'x 1 (make-LocalRef 0 #f) '() 'lamEntry1)
|
||||
#t)
|
||||
(make-InstallValue 1
|
||||
(make-InstallValue 0
|
||||
(make-Lam 'y 1 (make-LocalRef 0 #f) '() 'lamEntry2)
|
||||
#t)
|
||||
;; stack layout: ??? x y
|
||||
(make-App (make-LocalRef 1 #t)
|
||||
(list (make-LocalRef 2 #t)))))
|
||||
(make-Seq (list (make-Seq (list (make-InstallValue 1 (make-LocalRef 1 #t) #t)
|
||||
(make-Constant (void))))
|
||||
(make-App (make-LocalRef 2 #t)
|
||||
(list (make-LocalRef 1 #t)))))))
|
||||
#t)))
|
||||
|
||||
|
||||
(test (parse '(letrec ([x (lambda (x) (y x))]
|
||||
#;(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 'x 1
|
||||
(make-App (make-LocalRef 1 #t)
|
||||
(list (make-LocalRef 2 #f)))
|
||||
'(1)
|
||||
'lamEntry1)
|
||||
#t)
|
||||
(make-InstallValue 1
|
||||
(make-Lam 'y 1
|
||||
(make-App (make-LocalRef 2 #f)
|
||||
(list (make-LocalRef 1 #t)))
|
||||
'(1)
|
||||
'lamEntry2)
|
||||
#t)
|
||||
;; stack layout: ??? x y
|
||||
(make-App (make-LocalRef 1 #t)
|
||||
(list (make-LocalRef 2 #t)))))
|
||||
#t)))
|
||||
(x y)))
|
||||
(make-Top (make-Prefix '())
|
||||
(make-LetVoid 2
|
||||
(make-Seq
|
||||
(list
|
||||
(make-InstallValue 0
|
||||
(make-Lam 'x 1
|
||||
(make-App (make-LocalRef 1 #t)
|
||||
(list (make-LocalRef 2 #f)))
|
||||
'(1)
|
||||
'lamEntry1)
|
||||
#t)
|
||||
(make-InstallValue 1
|
||||
(make-Lam 'y 1
|
||||
(make-App (make-LocalRef 2 #f)
|
||||
(list (make-LocalRef 1 #t)))
|
||||
'(1)
|
||||
'lamEntry2)
|
||||
#t)
|
||||
;; stack layout: ??? x y
|
||||
(make-App (make-LocalRef 1 #t)
|
||||
(list (make-LocalRef 2 #t)))))
|
||||
#t)))
|
||||
|
||||
(test (parse '(let ([x 0])
|
||||
(lambda ()
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user