adding call/ec

whalesong/lang/base.rkt

@@ -15,11 +15,13 @@
          (all-from-out "list.rkt")
          (all-from-out "private/map.rkt")
          (all-from-out "private/hash.rkt")
+         (all-from-out "private/call-ec.rkt")
          quasiquote)
          
 (require "private/list.rkt"
          "private/map.rkt"
          "private/hash.rkt"
+         "private/call-ec.rkt"
          "list.rkt"
          (only-in "private/qq-and-or.rkt" quasiquote))
 

whalesong/lang/private/call-ec.rkt

@@ -0,0 +1,27 @@
+#lang s-exp "../kernel.rkt"
+
+(require (for-syntax racket/base
+                     syntax/parse))
+
+(provide call-with-escape-continuation
+         call/ec
+         let/ec)
+
+
+(define (call-with-escape-continuation proc)
+  (define p (make-continuation-prompt-tag))
+  (call-with-continuation-prompt
+   (lambda ()
+     (proc (lambda args
+             (abort-current-continuation p (lambda ()
+                                             (apply values args))))))))
+
+(define call/ec (procedure-rename call-with-escape-continuation 'call/ec))
+
+
+(define-syntax (let/ec stx)
+  (syntax-parse stx
+    [(_ name:id body:expr ...+)
+     (syntax/loc stx
+       (call-with-escape-continuation (lambda (name)
+                                        body ...)))]))

whalesong/lang/whalesong.rkt

@@ -12,6 +12,7 @@
 (require "base.rkt"
          "private/traced-app.rkt"
          "private/shared.rkt"
+         "private/call-ec.rkt"
          "check-expect/check-expect.rkt"
          "bool.rkt"
          "posn.rkt"