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

working on continuation mark stuff

Browse Source
This commit is contained in:
Danny Yoo 2011-04-13 17:06:29 -04:00
parent 4f2e6f8546
commit 53a9889822
4 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
simulator-helpers.rkt
View File

@ -40,6 +40,8 @@
v] v]
[(vector? v) [(vector? v)
v] v]
[(ContinuationMarkSet? v)
v]
[else [else
(error 'ensure-primitive-value "~s" v)]))) (error 'ensure-primitive-value "~s" v)])))
@ -80,7 +82,9 @@
(apply vector (map PrimitiveValue->racket (vector->list v)))] (apply vector (map PrimitiveValue->racket (vector->list v)))]
[(MutablePair? v) [(MutablePair? v)
(cons (PrimitiveValue->racket (MutablePair-h v)) (cons (PrimitiveValue->racket (MutablePair-h v))
(PrimitiveValue->racket (MutablePair-t v)))])) (PrimitiveValue->racket (MutablePair-t v)))]
[(ContinuationMarkSet? v)
v]))
(define (racket->PrimitiveValue v) (define (racket->PrimitiveValue v)

10
simulator-primitives.rkt
View File

@ -143,14 +143,14 @@
(cond (cond
[(empty? frames) [(empty? frames)
empty] empty]
[(eq? tag (frame-tag (first frames)))
empty]
[else [else
(append (hash-map (frame-marks (first frames)) (append (hash-map (frame-marks (first frames))
cons) cons)
(loop (rest frames)))])))])]) (if (eq? tag (frame-tag (first frames)))
(make-primitive-proc (lambda args (apply f args)) empty
'(1 2) (loop (rest frames))))])))])])
(make-primitive-proc (lambda (machine . args) (apply f machine args))
'(0 1)
'current-continuation-marks))) 'current-continuation-marks)))

3
simulator-structs.rkt
View File

@ -15,7 +15,8 @@
(Vectorof PrimitiveValue) (Vectorof PrimitiveValue)
MutablePair MutablePair
ContinuationMarkSet
))) )))
(define-type SlotValue (U PrimitiveValue (define-type SlotValue (U PrimitiveValue
(Boxof PrimitiveValue) (Boxof PrimitiveValue)

4
test-compiler.rkt
View File

@ -1083,8 +1083,8 @@
(test '(with-continuation-mark 'name "danny" (test '(with-continuation-mark 'name "danny"
(continuation-mark-set->list (current-continuation-marks))) (current-continuation-marks))
'("danny")) (make-ContinuationMarkSet (list (cons 'name "danny"))))
#;(test (read (open-input-file "tests/conform/program0.sch")) #;(test (read (open-input-file "tests/conform/program0.sch"))