with-cont-mark parsing

parse-bytecode-5.1.1.rkt

@@ -481,7 +481,11 @@
 
 
 (define (parse-with-cont-mark expr)
-  (error 'fixme))
+  (match expr
+    [(struct with-cont-mark (key val body))
+     (make-WithContMark (parse-expr-seq-constant key)
+                        (parse-expr-seq-constant val)
+                        (parse-expr-seq-constant body))]))
 
 (define (parse-beg0 expr)
   (error 'fixmebeg0))
@@ -496,7 +500,10 @@
 
 
 (define (parse-apply-values expr)
-  (error 'fixmeapplyvalues))
+  (match expr
+    [(struct apply-values (proc args-expr))
+     (make-ApplyValues (parse-expr-seq-constant proc)
+                       (parse-expr-seq-constant args-expr))]))
 
 
 (define (parse-primval expr)

test-parse-bytecode-5.1.1.rkt

@@ -244,6 +244,24 @@
                         (make-ToplevelSet 0 0 (make-Constant 3.14)))) 
 
 
+
+
+(check-equal? (run-my-parse #'(call-with-values (lambda () (f)) g))
+              (make-Top (make-Prefix (list (make-GlobalBucket 'f)
+                                           (make-GlobalBucket 'g)))
+                        (make-ApplyValues (make-ToplevelRef 0 1)
+                                          (make-App (make-ToplevelRef 0 0) '()))))
+
+
+
+(check-equal? (run-my-parse #'(with-continuation-mark 'key 'value (current-continuation-marks)))
+              (make-Top 
+               (make-Prefix '())
+               (make-WithContMark (make-Constant 'key)
+                                  (make-Constant 'value)
+                                  (make-App (make-PrimitiveKernelValue 'current-continuation-marks) '()))))
+
+
 ;; make sure we don't see an infinite loop
 #;(run-zo-parse #'(letrec ([g (lambda () (g))])
                   (g)))