From 5d232f374884f31e0306d99b7b103da1c0381630 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Wed, 13 Jun 2012 16:32:06 -0400
Subject: [PATCH] racket/control: add aliases and update %/fcontrol

Added alises for call-with-continuation-prompt,
abort-current-continuation, and call-with-composable-continuation.
Also allow % and fcontrol to take an optional prompt tag argument.
---
 collects/mzlib/control.rkt                    | 25 +++++++++---
 .../scribblings/reference/control-lib.scrbl   | 38 +++++++++++++++++--
 collects/tests/racket/control.rktl            | 10 +++++
 3 files changed, 64 insertions(+), 9 deletions(-)

diff --git a/collects/mzlib/control.rkt b/collects/mzlib/control.rkt
index c01433d871..92c240dbb0 100644
--- a/collects/mzlib/control.rkt
+++ b/collects/mzlib/control.rkt
@@ -1,6 +1,10 @@
-(module control mzscheme
+(module control racket/base
 
-  (provide abort
+  (require (for-syntax racket/base))
+
+  (provide call/prompt call/comp abort/cc
+
+           abort
            
            fcontrol %
 
@@ -20,6 +24,12 @@
 
   ;; ----------------------------------------
 
+  (define call/prompt call-with-continuation-prompt)
+  (define call/comp call-with-composable-continuation)
+  (define abort/cc abort-current-continuation)
+
+  ;; ----------------------------------------
+
   (define (abort . vals)
     (abort-current-continuation 
      (default-continuation-prompt-tag)
@@ -30,16 +40,21 @@
   ;;  The `%' here is compable with Sitaram & Felleisen, LSC'90,
   ;;  since we make the handler optional.
 
-  (define (fcontrol f)
+  (define (fcontrol f #:tag [prompt-tag (default-continuation-prompt-tag)])
     (call-with-composable-continuation
      (lambda (k)
        (abort-current-continuation
-        (default-continuation-prompt-tag)
-        f 
+        prompt-tag
+        f
         k))))
 
   (define-syntax % 
     (syntax-rules ()
+      [(_ expr handler #:tag prompt-tag)
+       (call-with-continuation-prompt
+        (lambda () expr)
+        prompt-tag
+        handler)]
       [(_ expr handler)
        (call-with-continuation-prompt
         (lambda () expr)
diff --git a/collects/scribblings/reference/control-lib.scrbl b/collects/scribblings/reference/control-lib.scrbl
index 44d79e4764..eff70d06e0 100644
--- a/collects/scribblings/reference/control-lib.scrbl
+++ b/collects/scribblings/reference/control-lib.scrbl
@@ -1,7 +1,7 @@
 #lang scribble/doc
 @(require (except-in "mz.rkt" set) (for-label racket/control))
 
-@title{Classical Control Operators}
+@title{Additional Control Operators}
 
 @note-lib-only[racket/control]
 
@@ -20,6 +20,31 @@ work sensibly together. Many are redundant; for example,
  
 @; ----------------------------------------------------------------------
 
+@defproc[(call/prompt
+          [proc procedure?]
+          [prompt-tag continuation-prompt-tag? (default-continuation-prompt-tag)]
+          [handler (or/c procedure? #f) #f]
+          [arg any/c] ...)
+         any]{
+The @racket[call/prompt] binding is an alias for @racket[call-with-continuation-prompt].
+}
+
+@defproc[(abort/cc
+          [prompt-tag any/c]
+          [v any/c] ...+)
+         any]{
+The @racket[abort/cc] binding is an alias for @racket[abort-current-continuation].
+}
+
+@defproc[(call/comp
+          [proc (continuation? . -> . any)]
+          [prompt-tag continuation-prompt-tag? (default-continuation-prompt-tag)])
+         any]{
+The @racket[call/comp] binding is an alias for @racket[call-with-composable-continuation].
+}
+
+@; ----------------------------------------------------------------------
+
 @defproc[(abort [v any/c] ...) any]{
 
 Returns the @racket[v]s to a prompt using the default continuation
@@ -43,8 +68,12 @@ That is, @racket[(abort v ...)] is equivalent to
 
 @deftogether[(
 @defform*[[(% expr)
-           (% expr handler-expr)]]
-@defproc[(fcontrol [v any/c]) any]
+           (% expr handler-expr)
+           (% expr handler-expr #:tag tag-expr)]]
+@defproc[(fcontrol
+          [v any/c]
+          [#:tag prompt-tag (default-continuation-prompt-tag)])
+         any]
 )]{
 
 
@@ -59,7 +88,8 @@ The essential reduction rules are:
 ]
 
 When @racket[handler-expr] is omitted, @racket[%] is the same as 
-@racket[prompt].
+@racket[prompt]. If @racket[prompt-tag] is provided, @racket[%]
+uses specific prompt tags like @racket[prompt-at].
 
 @examples[#:eval control-eval
 (% (+ 2 (fcontrol 5))
diff --git a/collects/tests/racket/control.rktl b/collects/tests/racket/control.rktl
index b955b7e49f..480a5130f1 100644
--- a/collects/tests/racket/control.rktl
+++ b/collects/tests/racket/control.rktl
@@ -178,6 +178,16 @@
 (ctest (all-prefixes '(1 2 3 4))
       '((1) (1 2) (1 2 3) (1 2 3 4)))
 
+;; ----------------------------------------
+;; fcontrol/% with prompt tags
+
+(ctest (let ([pt (make-continuation-prompt-tag)])
+         (* 2 (% (% (fcontrol 5 #:tag pt)
+                    (lambda (v k) (k v)))
+                 (lambda (v k) (k (add1 v)))
+                 #:tag pt)))
+       12)
+
 ;; ------------------------------------------------------------
 ;; spawn
 ;;  example from Queinnec & Serpete, POPL'91