On Scheme

Thoughts on Scheme and teaching Scheme

Archive for March 15th, 2006

More on Exceptions

Posted by Peter on March 15, 2006

I have finished writing the exception macro. It implements all the features that were in the desired result I outlined yesterday, the ability to have multiple catch statements, un-caught exceptions re-thrown, and a finally clause that always executes. (brief summary: the throw function takes one argument and can raise an exception at any point, try begins a body of code followed by any number of catch statements. The thrown error can be accessed by the name err in the body of any catch block. The statement catch pred? is the same as catch (pred? err). A catch else block catches any exceptions that have not previously been handled. Unless you want to really catch all exceptions is usually a good idea to throw out of it. Lastly a finally block always executes, and it does so after the body of the try and after any handler code, but before the entire try statement exists (in any fashion). Again: (try body+ [catch statement body+]* [catch else body+] [finally body+]), where [] represent optional statements, + means one or more, and * means zero or more)

One major change from yesterday is that throw is now implemented as a global function. This is necessary so that any function can throw values, not just from directly within the try block. I used fluid-let to manipulate the global value of throw. fluid-let is especially important when writing macros, because it allows you to create functions and data that can be exposed to all parts of the program, while at the same time letting the macros be nested inside each other. Additionally I found out that fluid-let is protected from continuations, meaning that if you leave the body via a continuation instead of the normal exit the values protected by the fluid-let are still reset to their previous values appropriately.

Also, you may notice some of the code in the continuation for an uncaught throw refers to exceptions; this code integrates the outermost handler with my formalized exception type system, so that if one of these types is thrown and not handled the appropriate information will be given. I will describe that system in the next installment. If you want to use the try blocks, but without my exception system simply remove the (if (and (procedure? err) … statement (right below the definition of throw) and everything should work perfectly.

The implementation:

(define throw (lambda (x) x))

(call/cc (lambda (outer)
           (let ((err (call/cc (lambda (inner)
                      (set! throw inner)
                       (outer)))))
           (display "uncaught exception: ") (display err) (newline)
           (if (and (procedure? err) (= 2 (procedure-arity err)))
               (begin (display "possibly a structured exception: ") (newline)
                      (display "type: ") (display (exception-type err)) (newline)
                      (display "value: ") (display (exception-value err)) (newline)))
               )))

(define-syntax try
    (lambda (x)
      (letrec (
               (before-catch
                (lambda (x)
                  (cond ((null? x) '())
                        ((eq? (car x) 'catch) '())
                        ((eq? (car x) 'finally) '())
                        (else (cons (car x) (before-catch (cdr x))))
                        )))
               (after-catch
                (lambda (x capt newstatement clause seenelse)
                  (cond ((null? x)
                         (append
                          (if (not (null? clause))
                             (list clause)
                             '())
                          (if seenelse '() '((else (throw err))) )))
                        ((eq? (car x) 'finally)
                         (append
                          (if (not (null? clause))
                              (list clause)
                              '())
                          (if seenelse '() '((else (throw err))) )))
                        ((eq? (car x) 'catch)
                         (if seenelse
                             (error "There may be no more catch clauses after a catch else clause")
                             (if newstatement
                                 (error "The catch keyword may not follow catch")
                                 (if (null? clause)
                                     (after-catch (cdr x) #t #t '() seenelse)
                                     (cons clause (after-catch (cdr x) #t #t '() seenelse))))))
                        ((not capt) (after-catch (cdr x) #f #f '() seenelse))
                        (newstatement
                         (if (pair? (car x))
                             (after-catch (cdr x) #t #f (list (car x)) seenelse)
                             (if (eq? (car x) 'else)
                                 (after-catch (cdr x) #t #f (list 'else) #t)
                                 (after-catch (cdr x) #t #f (list (list (car x) 'err)) seenelse)))
                         )
                        (else (after-catch (cdr x) #t #f (append clause (list (car x))) seenelse))
                        )))
               (after-finally
                (lambda (x capt)
                  (cond ((null? x) '())
                        ((eq? (car x) 'catch)
                         (if capt
                             (syntax-error "There may be no catch clauses after a finally clause")
                             (after-finally (cdr x) #f)))
                        ((eq? (car x) 'finally) 
                         (if (not capt) (after-finally (cdr x) #t) (syntax-error "There may be only one finally clause")))
                        ((not capt) (after-finally (cdr x) #f))
                        (else (cons (car x) (after-finally (cdr x) #t)))
                        )))
               (main-transformer
                (lambda (x)
                  (let (
                        (bc (before-catch x))
                        (ac (after-catch x #f #f '() #f))
                        (af (after-finally x #f))
                        )
                    (let (
                          (execbody (if (null? bc) '(values) `(begin ,@bc)))
                          (exceptbody (if (null? ac) '(values) `(cond ,@ac)))
                          (finallybody (if (null? af) '((values)) af))
                          )
                      `(dynamic-wind
                        (lambda () ())
                        (lambda () (call/cc
                                    (lambda (outer)
                                      (let
                                          ((exception-handler (lambda (err)
                                                                ,exceptbody
                                                                )))
                                        (exception-handler
                                         (call/cc
                                          (lambda (exception-entry)
                                            (fluid-let ((throw exception-entry))
                                              (outer
                                               ,execbody
                                               )
                                              )
                                            )))
                                        ))))
                        (lambda () ,@finallybody))
                      ))))
               )
       (datum->syntax-object x (main-transformer (cdr (syntax-object->datum x)))))))

Next time: The exception type system.

Advertisements

Posted in Exploring Scheme | Leave a Comment »