[bitc-dev] Error in specification of DO

Jonathan S. Shapiro shap at eros-os.com
Thu Jul 10 21:26:22 CDT 2008

On Thu, 2008-07-10 at 19:45 -0400, Kevin Reid wrote:
> On Jul 10, 2008, at 14:57, Jonathan S. Shapiro wrote:
> >  (define (f x)
> >    (block myBlock expr))  =>
> >
> >  (define (f x)
> >    (let ((myBlock-armed #t)))
> >      (defexception myBlock '#a)
> >      (try
> >          ...body...
> >       (catch id
> >          ((myBlock exitValue)
> >             (if myBlock-armed
> >                 exitValue
> >                 (throw DynamicLabelExtentViolation))))))
> >      (set! myBlock-armed #f)))
> It seems to me that one of these is the case:
> 1. myBlock-armed will never be seen to be false, in that if the throw  
> occurs outside after myBlock-armed is set to #f, it is outside the  
> catch as well.
> 2. You meant (defexception myBlock '#a) as a "static" (as in the C  
> storage class) definition rather than a lexical one; in which case  
> your implementation is incorrect anyway, as this example demonstrates:
> (define (call-with-return f)
>    (block myBlock
>      (f (lambda (x) (return-from myBlock x)))))
> (call-with-return (lambda (b1)
>    (call-with-return (lambda (b2)
>      (b1 "ok")))
>    "broken"))

I definitely did not mean [2]. DEFEXCEPTION is a type declarator, not a
value declarator. Regardless, Swaroop has since clarified that there is
no problem with polymorphic exception fields, in which case that
DEFEXCEPTION can be lifted to top level after unique renaming. The
requirement is only that the exception name must be unique to the block
that it guards.

You are right that my example is completely broken, and after we fix it
your statement [1] will no longer be correct. Here is the (hopefully)
corrected version:

  (define (f x)
    (block myBlock ...body...)) =>

  (define (f x)
    (let ((myBlock-armed #t)))
      (defexception myBlock value:'a)  ;; hoisted to top level after renaming
          (set! myBlock-armed #f)
        (catch id
          (myBlock ;; first raise
            (set! myBlock-armed #f)
          (default ;; re-propagate other exceptions after disarm
            (set! myBlock-armed #f)
            (throw id))))))

Within the body:

  (return-from myBlock value) =>
  (if myBlock-armed
      (throw (myBlock value))
      (throw DynamicLabelExtentViolation))

In the corrected form, you can see that both the value and the state
change on /myBlock-armed/ are witnessed within the body. The whole point
was to cause the arming variable to be captured by anything that
escaped. Unfortunately, I messed up the example enough that this wasn't

> Evaluating this with a correct (per CL) lexically scoped BLOCK  
> operator will yield "ok". Your implementation above, /if/ there is  
> only one exception type, will yield "broken" since b2's catch is the  
> nearest exception handler.

Yes. But I think that my corrected rewrite yields "ok". If not, then it
is probably still broken. :-)

Very nice counter-example, by the way.


More information about the bitc-dev mailing list