Sunday, January 28, 2007

Format4Blog

This utility, Format4Blog, has been after me to be written almost since the day I started to learn Scheme. It is starting to show signs of maturity, being that I've now used it on one of my blog articles as the main formatting tool. Still, there are some gaps in what it can do and what I would like it to do.

What it can do is format a Scheme source file for use on a blog, or any web page for that matter. It really needs to have the source file marked up in block comments between text and code, so that the code has been marked as <pre>formatted and the text in the comments has been marked up with any css style in my blog's stylesheet, which is a subset of my website's stylesheet. For my style of documentation this adds very little extra work, as I am in the habit of documenting my source files extensively with XML inside of block comments. When I create a source that is destined to be a blog article I merely switch to coding with HTML for markup, rather than XML for content.

What happens with the source file is that it is parsed by a rather thorough Scheme lexer which emits different classes of tokens. There's a class for symbols, constants, strings (including here strings), comments (including block comments), builtin identifiers, and a growing list of what I call library identifiers. Library identifiers end up being roughly anything that isn't R5RS Scheme, but wasn't defined by the programmer. So, it includes PLT extensions to the language as well as functions found in SRFI's. I say growing list, because the lexer makes this distinction based on a list of R5RS Scheme identifiers, and another list which stores the names of all the other identifiers. As you can imagine, there are quite a number of library identifiers, and so far I've been adding them on an as needed basis. One of my release criteria is that I utilize a dictionary built from DrScheme source files to attempt to complete the list of library identifiers using match heuristics against the dictionary. A direct correlation is made between these lexeme classes and css classes, so that the output of the HTML is finely grained syntax directed stylized text, most notably color, but any text attribute can be unique within a class.

The lexer began life in the syntax-color library of DrScheme, but was modified in several areas. There were two big changes that had to be made, and several add-ons' to functionality. The first of the two was that the original lexer, like most good lexers, ignored white space, and for my purposes where code would be marked up as <pre>formatted it was essential that the white space be maintained. The other big change was that, again, in the tradition of normal lexing, it chose to skip completely over block comments, as if they where white space. This had to be fixed, since it is in those block comments that the text and HTML markup lives, hardly something one could simply toss away as white space. The additional functionality came in separating the original lexeme symbol class up into symbol, builtin, and library as discussed above. But there were other things I couldn't live without, namely, glyphs, and the lambda glyph in particular. So, there is now a pretty stable set of glyphs for lambda and arrows and such that make expository writing about Scheme so much nicer when you have them.

The big find was ASCIIMathML. Its an opensource MathML implementation handled in javascript, and works on modern browsers, as well as some more dated browsers with the help of a plugin called MathPlayer. The minute I found out about it I knew I wanted its rich expressive power in my blog pages. So it is possible to write a MathML expression inside block comments to illustrate what your talking about symbolically, and it will faithfully reproduce the expression in the HTML of the blog.

Once its soup you'll find out about it here or my web site, and the package will likely be made available on PlaneT as well as my web site.

Have fun!

--kyle

Thursday, January 25, 2007

Odd and Ends

Delimited Continuations in MzScheme

A Tour - Part 1

Prompts
  1. Prompts - their interaction with Dynamic Wind
  2. An Introduction to the Primitives
  3. Going further with the Primitives
  4. Odds and Ends

We almost left the primitives without demonstrating their interaction with dynamic-wind, which dates back to the first post in this series. I also have a fun little function to share before we move on. As usual we'll setup our helper syntax first.

It's been my habit to simply skip over this helper syntax, because it's either something we've worked on together in a previous post or I believe it to be comprehensible to my likely audience. If you are reading the post, and something doesn't seem to come together for you, it may be that a) I've made a mistake, and no one else has bothered to tell me about it, or b) you are an eager reader for whom I didn't lay the proper ground work. In either case, I'd loved to here from you about anything that doesn't sit well with you, or just plain doesn't make sense. I'll do my best to either correct my mistake, with credit given to the commenter on the next post, or I'll see if I can't make the code more accessible on a one on one basis to any eager readers I might have lurking around, but have been too timid to ask. Please ask!

Also, a point about style. I'm quite fond of the lambda glyph `λ" used in place of the full word lambda. At first, in order to make the code available to as many as would want to try it, I refrained from using the λ glyph. However, it occurs to me, that during this series at least, the only folks that could run the code are those that run it on DrScheme, and DrScheme gladly accepts the λ glyph as a first class replacement for lambda. So, as long as my post topic is DrScheme specific I will use the λ glyph in palce of lambda; it looks nice, takes less screen real-estate, and I've recently completed the first draft of Format4Blog, my automatic blog post formater and syntax-coloring tool, which I made sure also accepts the λ glyph. So, you've been warned.

|#
(module support mzscheme
  
  (provide (all-defined)
           (all-from (lib "78.ss" "srfi")))
  
  (require (lib "78.ss" "srfi"))
  
  ;(call-with-continuation-prompt
  ;thunk [prompt-tag handler-proc-or-false]
  (define call/cc/prompt
    call-with-continuation-prompt)

  ;(default-continuation-prompt-tag)
  (define default/prompt/tag
    default-continuation-prompt-tag)

  ;(make-continuation-prompt-tag
  ;[symbol]
  (define make/prompt/tag
    make-continuation-prompt-tag)

  ;(abort-current-continuation
  ;prompt-tag obj ...) 
  (define abort/cc
    abort-current-continuation)

  ;call-with-composable-continuation
  ;proc [prompt-tag])
  (define call/wcc
    call-with-composable-continuation)

  ;(continuation-prompt-available?
  ;prompt-tag [cont])
  (define prompt/available?
    continuation-prompt-available?)
  
  
  (define-syntax let/wcc
    (λ (stx)
      (syntax-case stx ()
        ((_ k tag . body )
         #'(call-with-composable-continuation
            (λ (k) . body) tag)))))
  
  (define-syntax @@
    (λ (stx)
      (syntax-case stx ()
        ((_ tag handler . body)
         #'(call-with-continuation-prompt
            (λ () . body) tag handler)))))
  
  (define-syntax !!
    (λ (stx)
      (syntax-case stx ()
        ((_ tag . args)
         #'(abort-current-continuation tag . args)))))  
  
  (define-syntax @
    (λ (stx)
      (syntax-case stx ()
        ((_ )
         #'(default-continuation-prompt-tag)))))
  
  (define-syntax cout
    (λ (stx)
      (syntax-case stx ()
        ((_ e1 e2 ...)
         #'(begin (printf "~s " e1) (cout e2 ...)))
        ((_ e1 ) #'(printf "~s~n" e1))
        ((x ) (identifier? #'x) #'(newline)))))
  
  (define-syntax couta
    (λ (stx)
      (syntax-case stx ()
        ((_ e1 e2 ...)
         #'(begin (printf "~a " e1) (couta e2 ...)))
        ((_ e1 ) #'(printf "~a~n" e1))
        ((x ) (identifier? #'x) #'(newline)))))
  
  (define (hr)
    (cout '______________________________________________))
  
  (define-syntax cp
    (λ (stx)
      (syntax-case stx ()
        ((_ str e)
         (with-syntax
             ([val (datum->syntax-object stx 'val)])
           #'(let ([val e])
               (cout str val)
               val))))))
  
  (define-syntax display->result/string
    (λ (stx)
      (syntax-case stx ()
        ((_ e1 e2 ...)
         #'(parameterize ((current-output-port
                           (open-output-string)))
             (values ((λ () e1 e2 ...))
                     (get-output-string
                      (current-output-port))))))))
  
  (define-syntax test-case/result
    (λ (stx)
      (syntax-case stx (=>)
        ((_ test-name (c1 c2 ...) =>
            expected-value => display-value)
         #'(begin (printf "~n~a~n" test-name)
                  (let-values
                      ([(result display-result)
                        (display->result/string (c1 c2 ...))])
                    (check result => expected-value)
                    (check display-result => display-value)
                    (couta display-result '=> result)
                    (hr))))
        ((_ test-name (c1 c2 ...) => expected)
         #'(begin (printf "~n~a~n" test-name)
                  (let ([result (c1 c2 ...)])
                    (check result => expected)
                    (couta result)(hr)))))))
  
  (define-syntax %%
    (syntax-rules ()
      ((_ tag . body)
       (call-with-continuation-prompt
        (λ () . body) tag (lambda (r k) r)))))
  
  (define (fc tag f)
    (call-with-composable-continuation
     (λ (k)
       (abort-current-continuation tag f k)) tag))
  )
(require support)
(require-for-syntax support)

(let ()
  (check-set-mode! 'report-failed)
  #|

To get us started I thought we would revisit dynamic-wind, using the same example as in the very first post, but this time escape out and back in to the value-thunk with the use of continuations derived from our new tools. This go around the examples will be more precise, and demonstrate in isolation, first escaping and second re-entry into the value-thunk (without every having escaped out.) Our first example is a routine escape via let/ec's continuation.

|#
  (test-case/result "Escape by means of let/ec"
    (let ([v (let/ec out
               (dynamic-wind
                (λ () (couta "pre-thunk")) 
                (λ ()
                  (couta "value-thunk/before out")
                  (out 'terminate)
                  (couta "value-thunk/after out"))
                (λ () (couta "post-thunk"))))])
      (couta "inside let v=" v)
      v)
    => 'terminate
    =>
"pre-thunk 
value-thunk/before out 
post-thunk 
inside let v= terminate 
")
#|
______________________________________________

This result is precisely the behavior dynamic-wind was designed to produce. In the event of an early escape from the value-thunk, in this case from the continuation of a let/ec, dynamic-wind guarantees that post-thunk will be called to clean up before the escape can proceed. That way any files that my have been opened will be closed, and any partially constructed data structures can be dealt with in an appropriate manner.

Now lets arrange to demonstrate dynamic-winds other guarantee, against escapes into the value-thunk.

 
|#
  (test-case/result "Rentry by means of call/cc"
    (let ([v (let/ec out
               (dynamic-wind
                (λ () (couta "pre-thunk")) 
                (λ ()
                  (couta "value-thunk/before call/cc")
                  (begin0
                    (call/cc (λ (k) (λ () out k)))
                    (couta "value-thunk/after call/cc")))
                (λ () (couta "post-thunk"))))])
      (couta "inside let v=" v)
      (and (procedure? v)
           (couta "procedure arity=" (procedure-arity v))
           ((v) 'rentry))
      v)
    => 'rentry
    =>
"pre-thunk 
value-thunk/before call/cc 
value-thunk/after call/cc 
post-thunk 
inside let v= #<procedure> 
procedure arity= 0 
pre-thunk 
value-thunk/after call/cc 
post-thunk 
inside let v= rentry 
")
#|
______________________________________________

In this example we arranged for the value thunk to sneak off with the continuation of let/ec, namely out. We did this by capturing the continuation inside a thunk, embedded within the receiving lambda form of a call/cc within the value-thunk. At the time call/cc is up to all this mischief, the continuation, bound to out, is part way through completing the value-thunk, and only needs to complete the post-thunk to finish and hand over its value to the let-bound variable v. Thus `pre-thunk" and `value-thunk/before call/cc" have already been displayed. Since we used begin0 to surround the later part of the value-thunk, the value of the value-thunk becomes the evaluation of the call/cc expression, which gives us the thunk, and that is what is returned as the value of the dynamic-wind expression and in turn is bound to v. Because no escape was made from dynamic-wind, the sequence is as shown, displaying `value-thunk/after call/cc", `post-thunk", and then `inside let v= #<procedure>". Now, we get to the `and" clause, which is guarded by a procedure? predicate, which v passes through, and `procedure arity= 0" is displayed, verifying we have a thunk in v. v is then executed with an argument of 'rentry. The execution of v produces a another procedure?, but this procedure is a continuation which can take the argument 'rentry.

Now we get to see in isolation the continuation of dynamic-wind, because assigning a value to the continuation in v should send us back into the value-thunk. Instead, because the value thunk is protected against direct entry to it via a continuation, control passes first to the pre-thunk, and `pre-thunk" is displayed. Next control is delivered to the point in the value-thunk just after the point at which the continuation we are re-entering was initially captured, thus `value-thunk/after call/cc" is displayed, followed by `post-thunk", and now the new value of the value-thunk, namely 'rentry, is bound to v and we enter the let clause where is fails the procedure? predicate and goes on to display `inside let v= rentry".

So in two (2) examples, which were modified from the first post to isolate the protection mechanisms, embodied in dynamic-winds continuation more completely than we had done before, we're back up to speed. It's time to try these same examples, but this time we'll use the delimited continuation primitives instead, and see what trouble we can get ourselves into.

 
|# 
  (test-case/result "Escape by means of let/wcc"
    (let ([v (@@ (@) (λ (k x) (k x)) 
                 (let/wcc out (@)
                   (dynamic-wind
                    (λ () (couta "pre-thunk")) 
                    (λ ()
                      (couta "value-thunk/before out")
                      (!! (@) out 'terminate)
                      (couta "value-thunk/after out"))
                    (λ () (couta "post-thunk")))))])
      (couta "inside let v=" v)
      v)
    => 'terminate
    =>
"pre-thunk 
value-thunk/before out 
post-thunk 
inside let v= terminate 
")
#|
______________________________________________

We'll after installing a custom handler we can mimic the behavior of the first example using just the default prompt-tag, Note that to replace the functionality of let/ec we have to use call-with-continuation-prompt (@@ ..) call-with-composable-continuation (let/wcc ..) and since we can't merely apply the continuation provided by let/wcc, we needed (!! ..) to abort from the continuation. What would happen if we had simply applied the continuation in out to 'terminate?

|#
  (test-case/result "Escape by means of let/wcc"
    (let ([v (@@ (@) (λ (k x) (k x))
                 (cout 'let-clause)
                 (let/wcc out (@)
                   (dynamic-wind
                    (λ () (couta "pre-thunk")) 
                    (λ ()
                      (couta "value-thunk/before out")
                      (begin0
                        (out 'terminate)
                        (couta "value-thunk/after out")))
                    (λ () (couta "post-thunk")))))])
      (couta "inside let v=" v)
      v)
    => 'terminate
    =>
"let-clause 
pre-thunk 
value-thunk/before out 
value-thunk/after out 
post-thunk 
inside let v= terminate 
")   
#|
______________________________________________

Note that we did not escape from the dynamic wind expression. The only clue that anything happened at all comes in our last diagnostic message which reveals that v was, indeed, bound to 'terminate. But the flow of control, in as much as we can tell from those same diagnostic messages appears unaltered in the slightest.

The astute reader will be perplexed. We have added an expression to display 'let-clause between the default prompt and let/wcc. We have come to expect that when the continuation of a let/wcc statement is applied to a value, let/wcc's continuation will backtrack to its referenced prompt, and only then proceed forward. What we got was an immediate move forward through the code with the expected outcome from then onward. The display of 'let-clause occurs only once on entry, not a second time as we would expect had let/wcc backtracked to its referenced prompt. This is the first time our model of let/wcc behavior has failed us, and it is in the context of dynamic-wind. There will be more said about this shortly.

We'll you're no doubt saying this is much to do about nothing since we can get the desired behavior in a much leaner piece of code just by using let/ec. You are right, of course, but let me point out two things. First, we have shown we can replicate the behavior of let/ec in the environment of dynamic-wind with the primitives. This is an accomplishment from the stand point of the expressive power of the primitives. You would hope that they could do the same job, even if it took more code, given that they are, well, primitive.

Second, we haven't begun to shuffle the deck yet. You see that prompt is where it is, and the let/wcc is where it is, by purposeful design to attempt to recreate similar behavior to that of let/ec. But they can be separated from one another, unlike let/ec, which is atomic. And thats without mentioning the fact that we also have a custom handler that we can craft to do our bidding. Which is a good thing, because we'll need both in our next example.

To mimic our second example using the primitives, we're going to have to separate call-with-continuation-prompt (@@) from call-with-composable-continuation (let/wcc), because we're going to need to squirrel away a continuation that will bring us back into the value-thunk within the continuation of dynamic-wind, and from which we can abort within the body of the let clause. Will do this by placing a default prompt just outside of the let-clause, as before, but will place the let/wcc within the value-thunk. And, as usual, will tuck our continuation away inside the value bound to v, in a lambda form that can later be applied against a value, in this case the symbol 'rentry. Note, that if we were simply to place the prompt immediately behind the let/wcc, the continuation captured by call-with-composable-continuation would only be obliged to finish the value-thunk, and we would not succeed in mimicking the behavior we are after.

|#
  (test-case/result "Rentry by means of primitives"
    (@@ (@) (λ (k x) (k x))
        (cout 'let-clause)
        (let ([v (dynamic-wind
                  (λ () (couta "pre-thunk")) 
                  (λ ()
                    (couta "value-thunk/before let/wcc")
                    (begin0
                      (let/wcc k (@)
                        (λ (in) (couta "(k in)") (k in)))
                      (couta "value-thunk/after let/wcc")))
                  (λ () (couta "post-thunk")))])
          (couta "inside let v=" v)
          (and (procedure? v)
               (couta "procedure arity=" (procedure-arity v))
               (!! (@) v 'rentry))
          v)
        )
    => 'rentry
    =>
"let-clause 
pre-thunk 
value-thunk/before let/wcc 
value-thunk/after let/wcc 
post-thunk 
inside let v= #<procedure> 
procedure arity= 1 
(k in) 
pre-thunk 
value-thunk/after let/wcc 
post-thunk 
inside let v= rentry 
"
)
#|
______________________________________________

We'll we've done it, by gosh and by golly. It may not be pretty, but it mimics the behavior of our second example of isolated escapes into the value-thunk of a dynamic-wind expression. The reader will again notice, however, that it does not redisplay `let-clause", or `value-thunk/before let/wcc", and thus could not have executed its typical behavior of going back to the reference prompt-tag, and executing forward before continuing. The logical reason being that it is within dynamic-winds continuation and is thus constrained. If otherwise, then it would be possible to break dynamic winds promise to protect the value-thunk. The reader may also note that in both mimics we installed the same custom prompt. This was necessary to achieve the mimicry we were after, because we had to use an abort-current-continuation to force the v to be rebound and then sent back into the let-clause body again.

Notice that in both of our mimics, it was necessary to employ abort-current-continuation (!!) to achieve the original behavior of our first two examples, which employed let/ec and call/cc. The application of a let/ec or call/cc continuation to a value does an implicit abort of the current continuation, where-as the application of a continuation captured by let/wcc only interrupts the current continuation, and then resumes exactly where it left off. I proved this to myself on many failed attempts at mimicking the original behavior of our first two examples.

Before we leave dynamic-wind behind us for the time being, let me challenge you to break dynamic-winds contract to protect the value-thunk by utilizing the primitives. If you succeed it would be of great interest to the author, as this would represent a back-door through which to exploit dynamic-wind, and may very well be regarded as a bug. I'm not entirely certain that I didn't come close to doing just that in one of my failed attempts at mimicry, and only afterward, when the code had long been deleted did I posit upon their import.

And now for something completely different.

|#
  (let ()
    (define (double f data init)
      (call/cc/prompt
       (λ ()
         (f data
            (call/wcc
             (λ (k)
               (k init)))))))
#|  

This little piece of whimsical code does exactly what its name implies. It applies the function f, first to data and init, and then again to data. You can of course write this in more traditional means, but I thought it would be fun to play around with this as a break from our usual more serious ventures out with the primitives.

First of all, it should look similar in form to the functions we were working our way through during the previous installment. Only this time, instead of multiplying a fixed integer, we are applying a named function. So, the way it works is let/wcc's continuation, bound to k, is applied to init, which causes the expression let/wcc to take on the value of init, and then f is applied to its two arguments data and init, because of the backtracking of let/wcc. Next, having reached its referenced prompt it returns, with let/wcc now equal to `(f data init)", and f is applied again yielding `(f data (f data init))". So, all that's left to do is find some suitable binary functions along with appropriate initial values for whatever it is your trying to do. Here are a few silly functions as examples.

|#
    (define (sqr x) (double * x 1))
    
    (check (double cons 'di '(dah)) => '(di di dah))
    (check (sqr (sqr 3)) => 81)
    (check (double map sqr '(1 2 3)) => '(1 16 81))
#|

Note, in the last example, that the argument data need not be data in the traditional sense. In keeping with the true Schemeness of things, procedures? serve equally well, as long as the airity and types work out.

With that little bit of levity, that about wraps it's up, having finally finished Part 1 of the Tour of Delimited Continuations. I'll sleep better at night now knowing we finally addressed dynamic-wind in a proper fashion. And hey, if it wasn't that important to you personally, you can take solace in the thought that it was a short read for once.

Part II of the Tour will begin with Dorai Sitaram's 1993 paper, "Handling Control." As I mentioned in the last installment it will be well worth your time to pre-read the paper if you get the chance. He also has a section on engines in his book "Teach Yourself Scheme in FIXNUM Days", available in the Help Desk of DrScheme. And as Sitaram merely stipulates an interface to a global clock, I may very well use Dybvig's clock mechanism of TSPL, 3rd ed. All are available online, so take advantage of these extraordinary resources.

Part I has been great fun bringing to you, and I look forward to Part II which will be somewhat more structured (I expect), given that it will be based on existing literature. For Part I there was not so much as a single example from the documentation in the Help Desk to guide us along, so if it turns out that I have taken us of course, the blame is all mine. Still, it was quite a bit of fun working up examples and counter examples, not all of which made to these pages for your own sanity. The primitives, being new to DrScheme, were every bit as new to me as they may have been to you when Part I began. I hope I've managed to enlighten more than confuse.

Part II will likely come out a bit slower than Part I, as I plan to interject posts on some of my on going projects. Once polished off, you can look forward to a discussion on the making of Format4Blog, that I mentioned earlier. While a humble project in its own right, its a perfect segue into two other projects of more formidable scope, namely, ActiveComments and keyScheme. Leaving ActiveComments aside, as I have posted on this topic previously, keyScheme is to be a new Scheme. To differentiate it from other efforts I like the phrase, "An Expository Scheme", as a description for its primary design goal. You can follow its road to life on this blog, and as code becomes available, at my website, www.keyscheme.net. In short, a keyScheme source file will be seamlessly integrated with an XML document, making a utility like Format4Blog unnecessary. As of now, my best bet is that it will emerge as a language option of DrScheme; unless I run into a real show stopper, there is nothing to be gained be reinventing the wheel, and everything to gained from taking advantage of the extraordinarily feature rich environment of DrScheme and its underlying powerhouse, MzScheme.

Well, I think that's as big a tease as a dare venture at this point. See you next time.

|#
    )
  )
(let ([n 13])
  (printf "~nPassed all ~a tests? ~a" n (check-passed? n)))

(check-report)
#|

Passed all 13 tests? #t ; *** checks *** : 13 correct, 0 failed.

Have fun!

--kyle

|#

Friday, January 05, 2007

Going Further with the Primitives

#|

Delimited Continuations in MzScheme

A Tour - Part 1

Prompts
  1. Going further with the Primitives

Our journey continues into the deep waters of delimited continuations. The last time we talked on this matter we saw some interesting behavior exhibited from the code of our very last example. You may remember that I mentioned at the time that this behavior came about because we had put our primitive operators together in such a way as to resemble that of the operators on which PLT's delimited continuations are modeled, which exhibit similar behavior. You should expect to learn the names of these higher level abstraction operators by the end of this post as well as the name of their author. However, for bonus points, if you take a look at ../PLT/collects/mzlib/control.ss, you already have enough knowledge to figure out which operators we were mimicking on the last example of the previous post on this tour. That file, control.ss, is the file that defines all the higher level abstraction operators; the ones published in journal articles. If you are adventurous, and I suspect you are or you wouldn't be reading my blog, when you look at control.ss you should notice that these higher level abstraction operators are all defined in terms of the primitive operators. That is precisely why we are going to spend this post, revisiting those primitives, since we hardly did more than get introduced in the last installment, and see what other gems of insight are laying around for the picking for anyone who will spend a little time experimenting with them. There is another reason to have the primitives well established in our tool box, as will see today; you are simply more flexible and have more options if you know, and aren't afraid to use, the primitive operators. So, with this as prelude, lets do some experiments.

First off, lets setup our support syntax, so that you can simply cut and paste this entire post to try out the code from this post by yourself in DrScheme. Speaking of DrScheme, it will be imperative that you have up to the minute versions of DrScheme to ensure that this code runs as advertised. You may pickup the latest binary installers from PLT Nightly Builds. This is because DrScheme has just made some fairly exhaustive changes to their system to further integrate delimited continuations into the REPL among other changes. I'm afraid if you don't use the most current version of DrScheme you'll be disappointed when you attempt to run the code from this post and especially from future posts, where I will intentionally rely on this integration to be available for the examples to work.

|#
(module support mzscheme

 (provide (all-defined)
          (all-from (lib "78.ss" "srfi")))

 (require (lib "78.ss" "srfi"))

 ;(call-with-continuation-prompt
 ;thunk [prompt-tag handler-proc-or-false]
 (define call/cc/prompt
   call-with-continuation-prompt)
 ;(default-continuation-prompt-tag)
 (define default/prompt/tag
   default-continuation-prompt-tag)
 ;(make-continuation-prompt-tag
 ;[symbol]
 (define make/prompt/tag
   make-continuation-prompt-tag)
 ;(abort-current-continuation
 ;prompt-tag obj ...)
 (define abort/cc
   abort-current-continuation)
 ;call-with-composable-continuation
 ;proc [prompt-tag])
 (define call/wcc
   call-with-composable-continuation)
 ;(continuation-prompt-available?
 ;prompt-tag [cont])
 (define prompt/available?
   continuation-prompt-available?)


 (define-syntax let/wcc
  (lambda (stx)
   (syntax-case stx ()
    ((_ k tag . body )
     #'(call-with-composable-continuation
        (lambda (k) . body) tag)))))

 (define-syntax @@
  (lambda (stx)
   (syntax-case stx ()
    ((_ tag handler . body)
     #'(call-with-continuation-prompt
        (lambda () . body) tag handler)))))

 (define-syntax !!
  (lambda (stx)
   (syntax-case stx ()
    ((_ tag . args)
     #'(abort-current-continuation tag . args))))) 

 (define-syntax @
  (lambda (stx)
   (syntax-case stx ()
    ((_ )
     #'(default-continuation-prompt-tag)))))

 (define-syntax cout
  (lambda (stx)
   (syntax-case stx ()
    ((_ e1 e2 ...)
     #'(begin (printf "~s " e1) (cout e2 ...)))
    ((_ e1 ) #'(printf "~s~n" e1))
    ((x ) (identifier? #'x) #'(newline)))))

 (define-syntax couta
  (lambda (stx)
   (syntax-case stx ()
    ((_ e1 e2 ...)
     #'(begin (printf "~a " e1) (couta e2 ...)))
    ((_ e1 ) #'(printf "~a~n" e1))
    ((x ) (identifier? #'x) #'(newline)))))

 (define (hr)
   (cout '______________________________________________))

 (define-syntax cp
  (lambda (stx)
   (syntax-case stx ()
    ((_ str e)
     (with-syntax
         ([val (datum->syntax-object stx 'val)])
                    #'(let ([val e])
                        (cout str val)
                        val))))))

 (define-syntax display->result/string
  (lambda (stx)
   (syntax-case stx ()
    ((_ e1 e2 ...)
     #'(parameterize ((current-output-port
                       (open-output-string)))
       (values ((lambda () e1 e2 ...))
       (get-output-string (current-output-port))))))))

 (define-syntax test-case/result
  (lambda (stx)
   (syntax-case stx (=>)
    ((_ test-name (c1 c2 ...) =>
     expected-value => display-value)
     #'(begin (printf "~n~a~n" test-name)
     (let-values ([(result display-result)
                   (display->result/string (c1 c2 ...))])
                   (check result => expected-value)
                   (check display-result => display-value)
                   (couta display-result '=> result)
                   (hr))))
    ((_ test-name (c1 c2 ...) => expected)
     #'(begin (printf "~n~a~n" test-name)
           (let ([result (c1 c2 ...)])
             (check result => expected)
             (couta result)(hr)))))))
 )
(require support)
(require-for-syntax support)

(check-set-mode! 'report-failed)
#|

Lets start right off with that last example from the previous installment. The code has been changed to allow more tests to be run on the same core code, which is essentially what we had before. Except now the prompts have been parameterized, and the function passed to the default handler has been designed to display the availability of all three prompt tags within the handler. This gives us better insight into why control flow is the way it is.

|#
(let ([tag1 (make/prompt/tag '=1)]
     [tag2 (make/prompt/tag '=2)]
     [tag3 (make/prompt/tag '=3)]
     [let/wcc-tag (make-parameter 0)]
     [target-tag (make-parameter 0)])

 (define (display/available?)
   (cout 'tag1-avail? (prompt/available? tag1))
   (cout 'tag2-avail? (prompt/available? tag2))
   (cout 'tag3-avail? (prompt/available? tag3)))     

 (define (handler x)
   (@@ (@) handler (x)))

 (define (triple-tag)
  (@@ (@) #f
   (cp tag1
    (* 32
     (@@ tag1 #f
      (cp tag2
       (* 16
        (@@ tag2 #f
         (cp tag3
          (* 8
           (@@ tag3 #f
            (cp 'let/wcc
             (* 4
              (let/wcc k (let/wcc-tag)
               (!! (target-tag)
                (lambda () (display/available?) (k 2))
                )))))))))))))))

 (test-case/result 'tag1
                   (parameterize ([let/wcc-tag tag3]
                                  [target-tag tag1])
                     (triple-tag))
                   => 256
                   => "tag1-avail? #t
tag2-avail? #f
tag3-avail? #f
let/wcc 8
#<continuation-prompt-tag:=1> 256
")


 (test-case/result 'tag2
                   (parameterize ([let/wcc-tag tag3]
                                  [target-tag tag2])
                     (triple-tag))
                   => 4096
                   => "tag1-avail? #t
tag2-avail? #t
tag3-avail? #f
let/wcc 8
#<continuation-prompt-tag:=2> 128
#<continuation-prompt-tag:=1> 4096
")
 (test-case/result 'tag3
                   (parameterize ([let/wcc-tag tag3]
                                  [target-tag tag3])
                     (triple-tag))
                   => 32768
                   => "tag1-avail? #t
tag2-avail? #t
tag3-avail? #t
let/wcc 8
#<continuation-prompt-tag:=3> 64
#<continuation-prompt-tag:=2> 1024
#<continuation-prompt-tag:=1> 32768
")
#|

What happens is that when a prompt is targeted, all the prompts proximal to the targeted prompt become unavailable, and consequently the continuation does not include the code enclosed by those no-longer available prompts. In our example above, when tag1 is targeted, the default handler calls our thunk, which is arranged to display the available tags first and then apply the continuation from the let/wcc (call-with-composable-continuation) to the number two (2.) This results in the value two (2) being returned as the value of the let/wcc expression, and it is then multiplied by four (4) to give us eight (8). Then it prints let/wcc 8. Now, since the next available prompt tag is tag1, it does a jump to the prompt tagged with tag1, where it is multiplied by 32 to give us 256 and it displays continuation-prompt-tag:=1 256. Similarly, when tag2 is targeted, let/wcc takes the value of two (2) and then is multiplied by four (4) to give us eight (8), and let/wcc 8 is displayed. This time prompt tag1 and tag2 are available, so the continuation takes us to the prompt tagged with tag2, where it is multiplied by 16 and it displays continuation-prompt-tag:=2 128. It then continues through prompt tag1 being multiplied by 32 to yield 4096, and it displays continuation-prompt-tag:=1 4096. Finally, when tag3 is targeted, all tags are available, and the process goes right up being multiplied at each step to finally yield (* 2 4 8 16 32) = 32768, and it displays continuation-prompt-tag:= 32768.

Note that regardless of which tag was available, it always passed through the multiplication between prompt tag3 and let/wcc. That is it always executed the body of the most proximal tag. The jumps are made to the prompts themselves, and not their bodies. Lets see what happens when we change the tag specified in the let/wcc statement.

|#
 (test-case/result 'tag1->tag1
                   (parameterize ([let/wcc-tag tag1]
                                  [target-tag tag1])
                     (triple-tag))
                   => 32768
                   => "tag1-avail? #t
tag2-avail? #f
tag3-avail? #f
let/wcc 8
#<continuation-prompt-tag:=3> 64
#<continuation-prompt-tag:=2> 1024
#<continuation-prompt-tag:=1> 32768
")
 (test-case/result 'tag2->tag1
                   (parameterize ([let/wcc-tag tag2]
                                  [target-tag tag1])
                     (triple-tag))
                   => 2048
                   => "tag1-avail? #t
tag2-avail? #f
tag3-avail? #f
let/wcc 8
#<continuation-prompt-tag:=3> 64
#<continuation-prompt-tag:=1> 2048
")
 (test-case/result 'tag2->tag2
                   (parameterize ([let/wcc-tag tag2]
                                  [target-tag tag2])
                     (triple-tag))
                   => 32768
                   => "tag1-avail? #t
tag2-avail? #t
tag3-avail? #f
let/wcc 8
#<continuation-prompt-tag:=3> 64
#<continuation-prompt-tag:=2> 1024
#<continuation-prompt-tag:=1> 32768
")
#|

In both cases we targeted tag1, but in the first case we had let/wcc reference tag1, and in the second it referenced tag2. You can see that nothing changed with regard to what prompts are available, given that tag1 is targeted, i.e., only tag1 is available. However, the continuation of let/wcc has been changed dramatically by changing which tag it references. When it references tag2, the second case, the continuation takes the computation through prompt tag3, even though it is not available. The tag referenced in let/wcc is in effect setting a lower-upper bound, while the targeted tag of the abort (!!) sets the upper-lower bound of the functional geography. Thus when in the last case we set both to tag2 the lower-upper bound takes us all the way up to tag2 and the upper-lower bound takes us to tag2 and beyond, yielding 32768. The same thing occurs when we set both to tag1. And we have previously shown the case where both were set to tag3.

Now what would happen if we were to reference and/or target the default prompt tag. Lets try some new scenario's.

|#
 (test-case/result '@->@
                   (parameterize ([let/wcc-tag (@)]
                                  [target-tag (@)])
                     (triple-tag))
                   => 32768
                   => "tag1-avail? #f
tag2-avail? #f
tag3-avail? #f
let/wcc 8
#<continuation-prompt-tag:=3> 64
#<continuation-prompt-tag:=2> 1024
#<continuation-prompt-tag:=1> 32768
")
 (test-case/result 'tag1->@
                   (parameterize ([let/wcc-tag tag1]
                                  [target-tag (@)])
                     (triple-tag))
                   => 1024
                   => "tag1-avail? #f
tag2-avail? #f
tag3-avail? #f
let/wcc 8
#<continuation-prompt-tag:=3> 64
#<continuation-prompt-tag:=2> 1024
")
 (test-case/result 'tag2->@
                   (parameterize ([let/wcc-tag tag2]
                                  [target-tag (@)])
                     (triple-tag))
                   => 64
                   => "tag1-avail? #f
tag2-avail? #f
tag3-avail? #f
let/wcc 8
#<continuation-prompt-tag:=3> 64
")
 (test-case/result 'tag3->@
                   (parameterize ([let/wcc-tag tag3]
                                  [target-tag (@)])
                     (triple-tag))
                   => 8
                   => "tag1-avail? #f
tag2-avail? #f
tag3-avail? #f
let/wcc 8
")
#|

This is behavior we haven't seen before, but we can still explain it with our lower-upper bound and upper-lower bound terminology, while taking into account which prompts are available. In the first case, we are referencing and targeting the default prompt tag. Not surprisingly, given our previous results where we have referenced and targeted the same tag, we get a single full execution of the functional topography, yielding 32768. Now for those still with me, I have a special bit of information to pass along. You may have noticed that triple-tag, the parameterized function we've been using throughout this installment has four (4) tags. It has tag1, tag2 and tag3, which are all we've talked about so far, but it also starts of by installing a default tag. We'll the reason we haven't mentioned the default tag until now, is that while writing this post, up until this part in the post, there wasn't a default tag installed at the start of triple-tag. It was only after referencing a named tag while targeting the default tag that the requirement for a default tag to be installed at the beginning of the function became apparent. At first thought, since there is always a default tag around, it hadn't seemed necessary to explicitly install one. But the code would prove me wrong. Without it, the strangest things started to happen: it would execute a tag1->@ (reference tag1->target default) function call and the next thing you know it's executing code a page down in the source file. I never really did figure out what was going on, I just inferred that the function needed to have a more proximal default prompt installed, and thus we now have a default prompt installed at the beginning of triple-tag (I didn't bother renaming it to quarto-tag, since only three are named. and I'm a lazy typist.) That's all it took, and the behavior becoming steady and predictable once again. The other thing to note is that absolutely nothing in the results changed as a result of installing the default prompt tag at the beginning of the function. I was very glad that I am in the habit of using test-cases on everything I post at that point, because that meant nothing I had said earlier had to be changed, since the data was identical.

Let's start with the tag1->@ case. In this case, as in all three of these examples where we target the default prompt, none of the named tags are available. So that leaves us with only the continuation created by the referenced tag in the let/wcc statement, which serves as a lower-upper bound on how far up the computational tree we will execute before jumping to the targeted tag. In the case of tag1->@ our lower-upper bound is tag1, so it's going to take two (2) and multiply it by 4, 8 and 16 to yield 1024. For the case of tag2->@, tag2 is our lower-upper bound, so the product will be (* 2 4 8) to yield 64. And finally, in the case of tag3->@ we get a product of (* 2 4) to yield 8. Since no computation occurs beyond the default prompt tag installed at the beginning of the function, in all three cases, despite jumping to the default prompt tag at the end, the result of the application is determined completely by the computation done during the initial backtracking due to the continuation of let/wcc.

We get a bit more interesting behavior when we reference the default prompt tag and target a named tag, as in @->tag3, our first example below.

|#
 (test-case/result '@->tag3
                   (parameterize ([let/wcc-tag (@)]
                                  [target-tag tag3])
                     (triple-tag))
                   => 134217728
                   => "tag1-avail? #t
tag2-avail? #t
tag3-avail? #t
let/wcc 8
#<continuation-prompt-tag:=3> 64
#<continuation-prompt-tag:=2> 1024
#<continuation-prompt-tag:=1> 32768
#<continuation-prompt-tag:=3> 262144
#<continuation-prompt-tag:=2> 4194304
#<continuation-prompt-tag:=1> 134217728
")
 (test-case/result '@->tag2
                   (parameterize ([let/wcc-tag (@)]
                                  [target-tag tag2])
                     (triple-tag))
                   => 16777216
                   => "tag1-avail? #t
tag2-avail? #t
tag3-avail? #f
let/wcc 8
#<continuation-prompt-tag:=3> 64
#<continuation-prompt-tag:=2> 1024
#<continuation-prompt-tag:=1> 32768
#<continuation-prompt-tag:=2> 524288
#<continuation-prompt-tag:=1> 16777216
")
 (test-case/result '@->tag1
                   (parameterize ([let/wcc-tag (@)]
                                  [target-tag tag1])
                     (triple-tag))
                   => 1048576
                   => "tag1-avail? #t
tag2-avail? #f
tag3-avail? #f
let/wcc 8
#<continuation-prompt-tag:=3> 64
#<continuation-prompt-tag:=2> 1024
#<continuation-prompt-tag:=1> 32768
#<continuation-prompt-tag:=1> 1048576
")
) 
#| 

This all fits within our model of the continuation being structured by a lower-upper bound from the referenced prompt tag, and the upper-lower bound coming from the targeted tag. In all three of these cases we are referencing the default prompt tag, but it is installed at the very beginning of the function, so our lower-upper bound is the beginning of the function itself. Thus, in each case, regardless of the targeted tag, we get an initial computation of 32768 from backtracking all the way to the top of the function. Then depending on the individual case, the targeted tag determines how far back up we go before we recommence with the computation.

Starting with the case of @->tag3 we start off with 32768 from our referenced tag, and proceed through the entire computational tree once again, because all prompts are available. So we get the product (* 32768 8 16 32) => 134217728. And likewise for the next two examples, for @->tag2 we have (* 32768 16 32) => 16777216. and finally for @->tag1 (* 32768 32) => 1048576. It would seem that our computational model of the interplay between referenced and targeted tags is sound, having been born out in all combinations of our functional prototype. Still, when dealing with first class continuations, your intuition can often be wrong, so we would prefer formal mathematical proof. Actually, that's a paraphrase of a quote from the very gifted Oleg Kiselyov, as he set out to prove (call/cc call/cc) was self-application, or put another way, the fixed-point of call/cc is (lambda (x) (x x)). I had actually spent some time at trying to see if the fixed point of (@@ (@) let/wcc k), which roughly behaves as call/cc, would turn out to be the same. The function I actually tested was (define (call/cc% f) (call-with-continuation-prompt (lambda () (call-with-composable-continuation f) I can report that it was an ill conceived venture from the beginning. Hopefully, by the end of this installment it will be clear why the continuation of call/wcc could never mimic that of call/cc. For your reference, the paper is at http://okmij.org/ftp/Scheme/callcc-calc-page.html, "Normal-order direct-style beta-evaluator with syntax-rules, and the repeated applications of call/cc", The presentation at the Workshop ``Daniel P. Friedman: A Celebration.'' December 4, 2004. Bloomington, IN.

There are just a couple other things I'd like to demonstrate in this installment before we close. We've been working with let/wcc hand-in-hand with !!. That is, in our prototype function, we have always been aborting the continuation with abort-current-continuation immediately after capturing it with call-with-composable-continuation. This need not be the case. After all, let/wcc provides us with a perfectly fine working continuation in a manner similar to call/cc, and we can go about exploiting that continuation all on its own, without ever resorting to calling abort-current-contination. In these next examples we leave triple-tag behind us and explore just this topic. Read carefully and you'll catch the difference that doomed my attempt at mimicking call/cc that I mentioned above.

|#

(let ()

 (define (dhandler x)
   (@@ (@) dhandler (x)))

 (test-case/result 'let/wcc-k-tag1
  (cp 'expr=
   (let ([d 2])
    (let ([tag1 (make/prompt/tag '=1)])
     (* 16
      (cp tag1
       (@@ tag1 dhandler
        (cp 'inside-tag1
         (* 4
          (cp 'let/wcc=
           (let/wcc k tag1
            (* 1 (k d) 3)))))))))))
                   => 1536
                   => "let/wcc= 2
inside-tag1 8
let/wcc= 24
inside-tag1 96
#<continuation-prompt-tag:=1> 96
expr= 1536
") 
#|

In this example we have a single prompt tag1. This time, however, when we get to the let/wcc statement, which incidentally is referencing our single prompt tag1, it is not followed by an abort, but rather by an expression, part of which applies the continuation, in k, to the variable d, which has been bound to the number two (2) in a let statement enclosing the whole application. We see that upon k being applied to 2, the control transfers immediately back to the let/wcc clause which assumes that value, and let/wcc= 2 is displayed. It continues, being multiplied by four (4) and inside-tag1 8 is displayed. This is really beautiful how it shows the natural continuation of let/wcc (call-with-composable-continuation), because the next thing it does is return to finish the expression inside the let/wcc body, having encountered the referenced tag1. Here the 8 is multiplied by three (3) to yield 24 and let/wcc= 24 is displayed. Here we have let/wcc in isolation of abort-current-continuation faithfully executing on that lower-upper bound paradigm we established while working with triple-tag. Now it simply continues up the computation unimpeded by a targeted tag, with the product (* 24 4 16) => 1536 yielding the result of the application.

|#
(test-case/result 'let/wcc-k-@
(let ([d 2])
 (let ([tag1 (make/prompt/tag '=1)])
  (cp tag1
   (* 16
    (@@ tag1 dhandler
     (cp 'inside-tag1
      (* 4
       (@@ (@) dhandler
        (cp 'let/wcc=
         (let/wcc k (@)
          (* 1 (k 2) 4)))))))))))
     => 512
     => "let/wcc= 2
let/wcc= 8
inside-tag1 32
#<continuation-prompt-tag:=1> 512
")
#|

Here we are referencing the default tag once again, and it was indeed necessary to explicitly set a default prompt tag, this time directly behind the let/wcc statement. I think you have the gist of this by now. K is applied to 2 and let/wcc= 2 is displayed. We have reached our referenced tag, so control returns to complete the expression where it is multiplied by 4 and we have let/wcc= 8 displayed. Finally, the product (* 8 4 16) => 512 is displayed as the value of the entire application.

|#
(test-case/result 'let/cc-k
(let ([d 2])
 (let ([tag1 (make/prompt/tag '=1)])
  (cp tag1
   (* 16
    (@@ tag1 dhandler
     (cp 'inside-tag1
      (* 4
       (cp 'let/cc=
        (let/cc k
         (* 1 (k d) 5))))))))))
 => 128
 => "let/cc= 2
inside-tag1 8
#<continuation-prompt-tag:=1> 128
")
#|

This example is simply to differentiate the behavior of let/cc from let/wcc. We see k is applied to two (2) and let/cc= 2 is displayed, but unlike let/wcc, let/cc has abandoned the expression from which it first jumped out of completely and merely completes the product (* 2 4 16) => 128.

|#
 (test-case/result 'let/wcc-k-tag2
  (let ([d 2])
   (let ([tag1 (make/prompt/tag '=1)]
         [tag2 (make/prompt/tag '=2)])
         (cp tag2
          (@@ tag2 dhandler
           (* 16
            (cp tag1
             (@@ tag1 dhandler
              (cp 'inside-tag1
               (* 4
                (cp 'let/wcc=
                 (let/wcc k tag2
                  (* 1 (k d) 6))))))))))))
     => 49152
     => "let/wcc= 2
inside-tag1 8
#<continuation-prompt-tag:=1> 8
let/wcc= 768
inside-tag1 3072
#<continuation-prompt-tag:=1> 3072
#<continuation-prompt-tag:=2> 49152
")
#|

There is nothing particularly different about this example, except we're using two (2) prompt tags. I'll leave this one for you to work through.

|#
 (test-case/result 'let/wcc-k-@
  (let ([d 2])
   (cp '@-outer
    (@@ (@) dhandler
     (* 16
      (cp '@-inner
       (@@ (@) dhandler
        (cp 'inside-inner-@
         (* 4
          (cp 'let/wcc=
           (let/wcc k (@)
            (* 1 (k d) 7)))))))))))
     => 3584
     => "let/wcc= 2
inside-inner-@ 8
let/wcc= 56
inside-inner-@ 224
@-inner 224
@-outer 3584
")
#|

We've not seen this before. We've got two (2) default prompt tags installed in this application. So, really, it's all about what happens in a situation where we are referencing a tag which has been installed more than once in the application. Your intuition, is probably like mine, in that it will use the most proximal, that is the first encountered referenced tag as its lower-upper bound. Lets see. We have k applied to 2 and let/wcc= 2 is displayed. There is nothing in the way so it clearly must be multiplied by four (4) yielding 8, and inside-inner-@ 8 is displayed. Next, just as we assumed, it encounters the referenced tag and returns to complete the expression, being multiplied by seven and let/wcc= 56 is displayed. Now, with no targeted tags to worry about it just completes the product (* 56 4 16) => 3584 to yield the final value of the application.

I'm sure by now you feel confident that you could predict and explain the behavior of the primitive functions in similar settings without much difficulty. Without formal proof, I would say we have pretty good evidence that our working paradigm on how the continuations of call-with-composable-continuation and abort-current-continuation work is a reliable model on which to base the assessment of code. However, I should warn you, and remind you of Oleg's comment about first class continuations. There are interactions with continuations at all levels of DrScheme or MzScheme, error handlers being one of them. You have to be willing to accept that not all that is known about these functions has been revealed, and more importantly, not all that these functions are capable of may yet be known. Keep it in your mind the example I gave today about running into trouble with default prompts which were not explicitly installed, and the weird behavior that came from that simple problem. Another warning is that the behavior of these functions relies heavily on the definition of any custom handler, as you will see below. Finally, if you do run into anything that seems beyond explanation, please forward it on to me, as I am trying to build my own database of areas to avoid or investigate further. With that let me make good on my promise at the beginning of the post and introduce you to one of the derived, or non-primitive, sets of operators on which the delimited continuations of DrScheme are said to have been based.

This is the definition of Sitaram's % operator, think (@@ (@) #f f), pronounced, prompt, as put forward in the library file, control.ss. Note, % can take a custom prompt tag and handler, or if not specified will use the default-prompt-tag and default-handler. This would be a useful feature except that fcontrol, think (let/wcc k (@) (!! (@) f k), as written in control.ss, has no way of specifying a thunk as an argument to %'s handler, which, if you remember, the default handler requires.

 (define-syntax %
   (syntax-rules ()
     [(_ expr handler)
      (call-with-continuation-prompt
       (lambda () expr)
       (default-continuation-prompt-tag) handler)]
     [(_ expr)
      (call-with-continuation-prompt
      (lambda () expr))])) 

This is the definition of Sitaram's fcontrol operator as put forward in the library file control.ss. Notice that the continuation from call/wcc is being passed back as an argument to the function f. This could not be used with the default prompt handler, which expects a thunk.

 (define (fcontrol f)
   (call-with-composable-continuation
    (lambda (k)
    (abort-current-continuation
     (default-continuation-prompt-tag) f k))))

These are my alternate definitions of Sitaram's % and fcontrol operators, named %% and fc respectively. We need these alternate definitions because the ones defined in control.ss, while correct if used with the right custom handler, will not work with the default handler, so we remove that option, and install the handler that Sitaram used in his paper.

|#
(let ([tag1 (make/prompt/tag '=1)])
   (define-syntax %%
     (syntax-rules ()
       ((_ tag . body)
        (call-with-continuation-prompt
         (lambda () . body) tag (lambda (r k) r)))))
  
   (define (fc tag f)
     (call-with-composable-continuation
      (lambda (k)
        (abort-current-continuation tag f k)) tag))
#| 

What follows is the final example of the post, and represents a simple non-local exit use of continuations for which we are all familiar, and would normally use let/ec to handle the task. let/ec is still the answer to this type of problem, by the way. The example only gives you a simple taste of what is in store for the next post when we go over some very interesting examples, and where delimited continuations really come into their own as a unique set of tools no one should be without.

|#
   (define product
     (lambda (s)
       (%% tag1
         (let loop ([s s])
           (if (null? s)
               1
              (let ([a (car s)])
               (display a)
               (if (= a 0)
                   (fc tag1 0)
                   (* a (loop (cdr s)))))))
           (lambda (r k) r))))
  
   (test-case/result 'product
                     (product '(1 2 3 4 0 6 7 8 9 20))
                     => 0
                     => "12340")
)
)

(let ([n 38])
 (printf "~nPassed all ~a tests? ~a" n (check-passed? n)))

(check-report)
#|
Passed all 38 tests? #t
; *** checks *** : 38 correct, 0 failed.

And we get the expected result on this use of fcontrol to execute a simple escape from a loop. BTW, this example is a modified version of an example from Dorai Sitaram's, "Handling Control", 1993. The only change is that I'm using the prompt enabled versions of the functions, that I defined earlier. In fairness to Sitaram, he saw the need for a hierarchy of prompts years before this paper, and works with prompted versions of his functions later on in the paper itself. This would be a good paper for you to read, because the next installment will feature a couple of non-trivial examples from his paper, and the more you are familiar with the algorithms the better. The examples involve working with concurrency through the use of delimited continuations. One example looks at nested engines. This is definitely a topic worthy of some self study before the next installment. I can suggest, in addition to reading Sitaram's paper, that you look at the final problem in "The Scheme Programming Language" 3rd ed., Kent Dybvig. I also believe Sitaram devotes some time to this topic in his book, Teach Yourself Scheme in FIXNUM Days.

Have fun.

--kyle