adding continuation-prompt-available? so we can do context checks.

whalesong/compiler/kernel-primitives.rkt

@@ -210,6 +210,7 @@
                                     'unsafe-car
                                     'unsafe-cdr
 
+                                    'continuation-prompt-available?
                                     'abort-current-continuation
                                     'call-with-continuation-prompt
                                     ))

whalesong/js-assembler/runtime-src/baselib-contmarks.js

@@ -84,22 +84,35 @@
 
     // A continuation prompt tag labels a prompt frame.
     var ContinuationPromptTag = function(name) {
-	this.name = name;         // String
+	this.name = name;         // (U String false)
 
     };
 
     ContinuationPromptTag.prototype.toDomNode = function(params) {
         var dom = document.createElement("span");
-        dom.appendChild(document.createTextNode('#<continuation-prompt-tag:' + this.name + '>'));
+        if (this.name) {
+            dom.appendChild(document.createTextNode('#<continuation-prompt-tag:' 
+                                                    + this.name + '>'));
+        } else {
+            dom.appendChild(document.createTextNode('#<continuation-prompt-tag>'));
+        }
         return dom;
     };
 
     ContinuationPromptTag.prototype.toWrittenString = function(cache) {
-        return '#<continuation-prompt-tag' + this.name + '>';
+        if (this.name) {
+            return '#<continuation-prompt-tag' + this.name + '>';
+        } else {
+            return '#<continuation-prompt-tag>';
+        }
     };
 
     ContinuationPromptTag.prototype.toDisplayedString = function(cache) {
-        return '#<continuation-prompt-tag' + this.name + '>';
+        if (this.name) {
+            return '#<continuation-prompt-tag' + this.name + '>';
+        } else {
+            return '#<continuation-prompt-tag>';
+        }
     };
 
 

whalesong/js-assembler/runtime-src/baselib-functions.js

@@ -225,7 +225,6 @@
                     "Not a procedure: ~e",
                     [proc]),
                 MACHINE.captureContinuationMarks()));
-
         }
 
         oldVal = MACHINE.v;

whalesong/js-assembler/runtime-src/baselib-primitives.js

@@ -2810,7 +2810,7 @@
                 sym = checkSymbol(M, "make-continuation-prompt-tag", 0);
                 return new baselib.contmarks.ContinuationPromptTag(sym.toString());
             }
-            return new baselib.contmarks.ContinuationPromptTag(void(0));
+            return new baselib.contmarks.ContinuationPromptTag(false);
         });
 
     installPrimitiveProcedure(
@@ -3164,6 +3164,28 @@
     };
 
 
+    // FIXME: we should be able to take in an arbitrary continuation
+    // as an optional second argument!
+    //
+   // I need to change the representation of continuations to be able to
+    // detect this at runtime.
+    installPrimitiveProcedure(
+        'continuation-prompt-available?',
+        1,
+        function(M) {
+            var promptTag = checkPromptTag(M, 'continuation-prompt-available?', 0);
+            var i;
+            for (i = 0; i < M.c.length; i++) {
+                var frame = M.c[i];
+                if (frame instanceof PromptFrame && frame.tag === promptTag) {
+                    return true;
+                }
+            }
+            return false;
+        });
+
+
+
     // The default abort prompt handler consumes a thunk and applies
     // it, in a context where a new prompt has been initialized.
     var defaultPromptHandler =
@@ -3185,7 +3207,7 @@
             // First, find the continuation prompt.
             while(true) {
                 frame = M.c.pop();
-                if (frame instanceof PromptFrame) {
+                if (frame instanceof PromptFrame && frame.tag === promptTag) {
                     break;
                 } else if (M.c.length === 0) {
                     raiseContractError(

whalesong/js-assembler/runtime-src/runtime.js

@@ -501,7 +501,7 @@
     };
     Machine.prototype.addPrompt = function(promptTag, abortHandlerClosure) {
         this.c.push(new PromptFrame(justReturn,
-                                    DEFAULT_CONTINUATION_PROMPT_TAG,
+                                    promptTag,
                                     this.e.length,
                                     abortHandlerClosure));
     };

whalesong/lang/kernel.rkt

@@ -228,7 +228,7 @@
          current-inexact-milliseconds
          current-seconds
          
-
+         continuation-prompt-available?
          abort-current-continuation
          call-with-continuation-prompt
 

whalesong/lang/private/call-ec.rkt

@@ -9,12 +9,16 @@
 
 
 (define (call-with-escape-continuation proc)
-  (define p (make-continuation-prompt-tag))
+  (define p (make-continuation-prompt-tag 'escape))
   (call-with-continuation-prompt
    (lambda ()
      (proc (lambda args
+             (unless (continuation-prompt-available? p) 
+               (error 'call-with-escape-continuation
+                      "escape continuation used out of context"))
              (abort-current-continuation p (lambda ()
-                                             (apply values args))))))))
+                                             (apply values args))))))
+   p))
 
 (define call/ec (procedure-rename call-with-escape-continuation 'call/ec))