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

call/cc looks like it's starting to work.

Browse Source
This commit is contained in:
Danny Yoo 2011-03-11 19:24:57 -05:00
parent fc866634cf
commit aecc0ad896
3 changed files with 8 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compile.rkt
View File

@ -599,9 +599,9 @@
;; abandon the current continuation, initialize the control and environment, and then jump. ;; abandon the current continuation, initialize the control and environment, and then jump.
(make-instruction-sequence `(,call/cc-closure-entry (make-instruction-sequence `(,call/cc-closure-entry
,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0)) ,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0))
,(make-PerformStatement (make-InstallClosureValues!))
,(make-PerformStatement (make-RestoreControl!)) ,(make-PerformStatement (make-RestoreControl!))
,(make-PerformStatement (make-RestoreEnvironment!)) ,(make-PerformStatement (make-RestoreEnvironment!))
,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel)) ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
,(make-PopControlFrame) ,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc)))))) ,(make-GotoStatement (make-Reg 'proc))))))

1
simulator.rkt
View File

@ -198,6 +198,7 @@
[(RestoreEnvironment!? op) [(RestoreEnvironment!? op)
(set-machine-env! m (CapturedEnvironment-vals (ensure-CapturedEnvironment (env-ref m 1)))) (set-machine-env! m (CapturedEnvironment-vals (ensure-CapturedEnvironment (env-ref m 1))))
(set-machine-stack-size! m (length (machine-env m)))
'ok]))) 'ok])))

9
test-compiler.rkt
View File

@ -26,6 +26,7 @@
#'stx)) #'stx))
(unless (= (machine-stack-size a-machine) 1) (unless (= (machine-stack-size a-machine) 1)
(raise-syntax-error #f (format "Stack is not back to the prefix as expected!") (raise-syntax-error #f (format "Stack is not back to the prefix as expected!")
#'stx)) #'stx))
(unless (null? (machine-control a-machine)) (unless (null? (machine-control a-machine))
(raise-syntax-error #f (format "Control is not empty as expected!") (raise-syntax-error #f (format "Control is not empty as expected!")
@ -536,11 +537,11 @@
32) 32)
(test (let ([x 16]) (test (add1 (let ([x 16])
(call/cc (lambda (k) (call/cc (lambda (k)
(k "escape!") (k 0)
(+ x x)))) (+ x x)))))
"escape!") 1)
;(simulate (compile (parse '42) 'val 'next)) ;(simulate (compile (parse '42) 'val 'next))