Changeset 20666 in project


Ignore:
Timestamp:
10/06/10 11:41:51 (11 years ago)
Author:
felix winkelmann
Message:

srfi-34 fixes by JW

Location:
release/4/srfi-34
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/srfi-34/tags/0.5/srfi-34.scm

    r15265 r20666  
    99
    1010(module srfi-34
    11    (*current-exception-handlers*
    12     with-exception-handlers
     11   (with-exception-handlers
    1312    with-exception-handler
    1413    raise
    1514    guard)
     15
    1616(import (except chicken with-exception-handler) scheme)
    1717
    18 (define *current-exception-handlers*
    19   (list (lambda (condition)
    20           (error "unhandled exception" condition))))
     18(define current-exception-handlers
     19 (make-parameter
     20  (list ##sys#current-exception-handler)))
    2121
    2222(define (with-exception-handlers new-handlers thunk)
    23   (let ((previous-handlers *current-exception-handlers*))
     23  (let ((previous-handlers (current-exception-handlers))
     24         [oldh ##sys#current-exception-handler])
    2425    (dynamic-wind
    25       (lambda ()
    26         (set! *current-exception-handlers* new-handlers))
    27       thunk
    28       (lambda ()
    29         (set! *current-exception-handlers* previous-handlers)))))
     26         (lambda ()
     27           (set! ##sys#current-exception-handler new-handlers)
     28           (current-exception-handlers new-handlers))
     29         thunk
     30         (lambda ()
     31           (set! ##sys#current-exception-handler oldh)
     32           (current-exception-handlers previous-handlers)))))
    3033
    3134(define (with-exception-handler handler thunk)
    32   (with-exception-handlers (cons handler *current-exception-handlers*)
     35  (with-exception-handlers (cons handler (current-exception-handlers))
    3336                           thunk))
    3437
    3538(define (raise obj)
    36   (let ((handlers *current-exception-handlers*))
     39  (let ((handlers (current-exception-handlers)))
    3740    (with-exception-handlers (cdr handlers)
    3841      (lambda ()
     
    9598     (if test
    9699         (begin result1 result2 ...)
    97          (guard-aux reraise clause1 clause2 ...))))) )
     100         (guard-aux reraise clause1 clause2 ...)))))
     101
     102 )
  • release/4/srfi-34/tags/0.5/srfi-34.setup

    r16974 r20666  
    11;;; srfi-34.setup
    22
    3 (compile -s -O2 -d1 srfi-34.scm -j srfi-34)
    4 (compile -s -O2 -d0 srfi-34.import.scm)
    5 (compile -c -O2 -d1 srfi-34.scm -j srfi-34)
     3(compile -s -O3 -d1 srfi-34.scm -j srfi-34)
     4(compile -s -O3 -d0 srfi-34.import.scm)
     5(compile -c -O3 -d1 srfi-34.scm -j srfi-34)
    66
    77(install-extension
    88 'srfi-34
    9  '("srfi-34.so" "srfi-34.import.so" "srfi-34.setup")
    10  '((version "0.4")
    11    (static "srfi-34.o")
    12    (documentation "srfi-34.html")))
     9 '("srfi-34.so" "srfi-34.import.so")
     10 '((version "0.5")
     11   (static "srfi-34.o")))
    1312 
    1413 
  • release/4/srfi-34/trunk/srfi-34.scm

    r15265 r20666  
    99
    1010(module srfi-34
    11    (*current-exception-handlers*
    12     with-exception-handlers
     11   (with-exception-handlers
    1312    with-exception-handler
    1413    raise
    1514    guard)
     15
    1616(import (except chicken with-exception-handler) scheme)
    1717
    18 (define *current-exception-handlers*
    19   (list (lambda (condition)
    20           (error "unhandled exception" condition))))
     18(define current-exception-handlers
     19 (make-parameter
     20  (list ##sys#current-exception-handler)))
    2121
    2222(define (with-exception-handlers new-handlers thunk)
    23   (let ((previous-handlers *current-exception-handlers*))
     23  (let ((previous-handlers (current-exception-handlers))
     24         [oldh ##sys#current-exception-handler])
    2425    (dynamic-wind
    25       (lambda ()
    26         (set! *current-exception-handlers* new-handlers))
    27       thunk
    28       (lambda ()
    29         (set! *current-exception-handlers* previous-handlers)))))
     26         (lambda ()
     27           (set! ##sys#current-exception-handler new-handlers)
     28           (current-exception-handlers new-handlers))
     29         thunk
     30         (lambda ()
     31           (set! ##sys#current-exception-handler oldh)
     32           (current-exception-handlers previous-handlers)))))
    3033
    3134(define (with-exception-handler handler thunk)
    32   (with-exception-handlers (cons handler *current-exception-handlers*)
     35  (with-exception-handlers (cons handler (current-exception-handlers))
    3336                           thunk))
    3437
    3538(define (raise obj)
    36   (let ((handlers *current-exception-handlers*))
     39  (let ((handlers (current-exception-handlers)))
    3740    (with-exception-handlers (cdr handlers)
    3841      (lambda ()
     
    9598     (if test
    9699         (begin result1 result2 ...)
    97          (guard-aux reraise clause1 clause2 ...))))) )
     100         (guard-aux reraise clause1 clause2 ...)))))
     101
     102 )
  • release/4/srfi-34/trunk/srfi-34.setup

    r16974 r20666  
    11;;; srfi-34.setup
    22
    3 (compile -s -O2 -d1 srfi-34.scm -j srfi-34)
    4 (compile -s -O2 -d0 srfi-34.import.scm)
    5 (compile -c -O2 -d1 srfi-34.scm -j srfi-34)
     3(compile -s -O3 -d1 srfi-34.scm -j srfi-34)
     4(compile -s -O3 -d0 srfi-34.import.scm)
     5(compile -c -O3 -d1 srfi-34.scm -j srfi-34)
    66
    77(install-extension
    88 'srfi-34
    9  '("srfi-34.so" "srfi-34.import.so" "srfi-34.setup")
    10  '((version "0.4")
    11    (static "srfi-34.o")
    12    (documentation "srfi-34.html")))
     9 '("srfi-34.so" "srfi-34.import.so")
     10 '((version "0.5")
     11   (static "srfi-34.o")))
    1312 
    1413 
Note: See TracChangeset for help on using the changeset viewer.