Re: [Chicken-users] catching exceptions

[F. Wittenberger]

Am Dienstag, den 29.07.2008, 14:55 +0200 schrieb Jörg F. Wittenberger:
> Am Dienstag, den 29.07.2008, 05:26 -0700 schrieb Elf:
> > furthermore, srfi-34 can be written entirely in terms of srfi-12, while the
> > reverse is not true.
> 
> Great!
> 
> So far I have neither an idea how that could be done

Being unable to solve a little programming task is something, which eats
deeply into my self-respect. ...

I'm NOT yet sure that the following is the correct solution to the
problem.  Please chicken friends: verify.

At least it behaves as specified in those cases, where the srfi-34.egg
failed this morning.

However I'm still somewhat puzzled over the result!  It happens not to
redefine 'raise' now.  How it comes that my raised objects are no longer
replaced with some condition-object?  I can't tell.  As much as I
couldn't tell why they where before.



(define-syntax guard
  (syntax-rules ()
    ((guard (var clause ...) e1 e2 ...)
     ((call-with-current-continuation
       (lambda (guard-k)
         (let ((oldh (current-exception-handler)))
           (with-exception-handler
            (lambda (condition)
              (with-exception-handler
               oldh
               (call-with-current-continuation
                (lambda (handler-k)
                  (guard-k
                   (lambda ()
                     (let ((var condition))      ; clauses may SET! var
                       (guard-aux (handler-k (lambda ()
                                                  (raise condition)))
                                     clause ...))))))))
            (lambda ()
              (call-with-values
                  (lambda () e1 e2 ...)
                (lambda args
                  (guard-k (lambda ()
                             (apply values args))))))))))))))

(define-syntax guard-aux
  (syntax-rules (else =>)
    ((guard-aux reraise (else result1 result2 ...))
     (begin result1 result2 ...))
    ((guard-aux reraise (test => result))
     (let ((temp test))
       (if temp 
           (result temp)
           reraise)))
    ((guard-aux reraise (test => result) clause1 clause2 ...)
     (let ((temp test))
       (if temp
           (result temp)
           (guard-aux reraise clause1 clause2 ...))))
    ((guard-aux reraise (test))
     test)
    ((guard-aux reraise (test) clause1 clause2 ...)
     (let ((temp test))
       (if temp
           temp
           (guard-aux reraise clause1 clause2 ...))))
    ((guard-aux reraise (test result1 result2 ...))
     (if test
         (begin result1 result2 ...)
         reraise))
    ((guard-aux reraise (test result1 result2 ...) clause1 clause2 ...)
     (if test
         (begin result1 result2 ...)
         (guard-aux reraise clause1 clause2 ...)))))