From 53a9889822d8633c3e83c58d453db68a432aacd5 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Wed, 13 Apr 2011 17:06:29 -0400
Subject: [PATCH] working on continuation mark stuff

---
 simulator-helpers.rkt    |  6 +++++-
 simulator-primitives.rkt | 10 +++++-----
 simulator-structs.rkt    |  3 ++-
 test-compiler.rkt        |  4 ++--
 4 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/simulator-helpers.rkt b/simulator-helpers.rkt
index f0c3975..3e8b148 100644
--- a/simulator-helpers.rkt
+++ b/simulator-helpers.rkt
@@ -40,6 +40,8 @@
        v]
       [(vector? v)
        v]
+      [(ContinuationMarkSet? v)
+       v]
       [else
        (error 'ensure-primitive-value "~s" v)])))
 
@@ -80,7 +82,9 @@
      (apply vector (map PrimitiveValue->racket (vector->list v)))]
     [(MutablePair? v)
      (cons (PrimitiveValue->racket (MutablePair-h v))
-           (PrimitiveValue->racket (MutablePair-t v)))]))
+           (PrimitiveValue->racket (MutablePair-t v)))]
+   [(ContinuationMarkSet? v)
+    v]))
 
 
 (define (racket->PrimitiveValue v)
diff --git a/simulator-primitives.rkt b/simulator-primitives.rkt
index 311e8a1..47bb816 100644
--- a/simulator-primitives.rkt
+++ b/simulator-primitives.rkt
@@ -143,14 +143,14 @@
                                (cond
                                  [(empty? frames)
                                   empty]
-                                 [(eq? tag (frame-tag (first frames)))
-                                  empty]
                                  [else
                                   (append (hash-map (frame-marks (first frames))
                                                     cons)
-                                          (loop (rest frames)))])))])])
-    (make-primitive-proc (lambda args (apply f args))
-                         '(1 2)
+                                          (if (eq? tag (frame-tag (first frames)))
+                                              empty
+                                              (loop (rest frames))))])))])])
+    (make-primitive-proc (lambda (machine . args) (apply f machine args))
+                         '(0 1)
                          'current-continuation-marks)))
                         
 
diff --git a/simulator-structs.rkt b/simulator-structs.rkt
index a3d8db2..acb8f6f 100644
--- a/simulator-structs.rkt
+++ b/simulator-structs.rkt
@@ -15,7 +15,8 @@
                                                    
                                                    (Vectorof PrimitiveValue)
                                                    MutablePair
-                                                   
+
+                                                   ContinuationMarkSet
                                                    )))
 (define-type SlotValue (U PrimitiveValue 
                           (Boxof PrimitiveValue)
diff --git a/test-compiler.rkt b/test-compiler.rkt
index a339338..21ef3eb 100644
--- a/test-compiler.rkt
+++ b/test-compiler.rkt
@@ -1083,8 +1083,8 @@
 
 
 (test '(with-continuation-mark 'name "danny" 
-         (continuation-mark-set->list (current-continuation-marks)))
-      '("danny"))
+         (current-continuation-marks))
+      (make-ContinuationMarkSet (list (cons 'name "danny"))))
 
 
 #;(test (read (open-input-file "tests/conform/program0.sch"))