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

|#