Changeset 15265 in project


Ignore:
Timestamp:
07/26/09 18:38:46 (10 years ago)
Author:
sjamaan
Message:

Import chicken 4 port of srfi-34, courtesy of C-Keen

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

Legend:

Unmodified
Added
Removed
  • release/4/srfi-34/trunk/srfi-34.meta

    r7237 r15265  
    99 (license "SRFI")
    1010 (category misc)
    11  (needs syntax-case)
    1211 (author "ben")
    1312 (synopsis "SRFI-34: Exception Handling for Programs"))
  • release/4/srfi-34/trunk/srfi-34.scm

    r11434 r15265  
    88;;; slight modifications to be a chicken egg.
    99
    10 (require-extension syntax-case)
    11 (require-extension srfi-18)
     10(module srfi-34
     11   (*current-exception-handlers*
     12    with-exception-handlers
     13    with-exception-handler
     14    raise
     15    guard)
     16(import (except chicken with-exception-handler) scheme)
     17
     18(define *current-exception-handlers*
     19  (list (lambda (condition)
     20          (error "unhandled exception" condition))))
     21
     22(define (with-exception-handlers new-handlers thunk)
     23  (let ((previous-handlers *current-exception-handlers*))
     24    (dynamic-wind
     25      (lambda ()
     26        (set! *current-exception-handlers* new-handlers))
     27      thunk
     28      (lambda ()
     29        (set! *current-exception-handlers* previous-handlers)))))
     30
     31(define (with-exception-handler handler thunk)
     32  (with-exception-handlers (cons handler *current-exception-handlers*)
     33                           thunk))
     34
     35(define (raise obj)
     36  (let ((handlers *current-exception-handlers*))
     37    (with-exception-handlers (cdr handlers)
     38      (lambda ()
     39        ((car handlers) obj)
     40        (error "handler returned"
     41               (car handlers)
     42               obj)))))
     43
    1244;(require-extension ports)
    1345
     
    6395     (if test
    6496         (begin result1 result2 ...)
    65          (guard-aux reraise clause1 clause2 ...)))))
     97         (guard-aux reraise clause1 clause2 ...))))) )
  • release/4/srfi-34/trunk/srfi-34.setup

    r11434 r15265  
    11;;; srfi-34.setup
    22
    3 ;;;; changelog:  26072008 [elf]  Removed the building of the 'base' module,
    4 ;;;;                             which cleverly destroyed all of the system
    5 ;;;;                             error and condition handling.  Check before
    6 ;;;;                             exporting in the future, please.
    7 ;;;;
    8 #|
    9 ;;;(make ((TARGET (DEPEND ...) COMMAND ...) ...) ARGV)
    10 (make (("srfi-34-base.so" ("srfi-34-base.scm")
    11         (compile -s -O2 -d1
    12                  -emit-exports srfi-34-base.emit-exports
    13                  srfi-34-base.scm))
    14        ("srfi-34-base.o" ("srfi-34-base.scm")
    15         (compile -c -O2 -d1
    16                  srfi-34-base
    17                  ;;; -emit-exports srfi-34-base.emit-exports
    18                  -unit srfi-34-base)) )
    19   '("srfi-34-base.so" "srfi-34-base.o" ) )
     3(compile -s -O2 srfi-34.scm -j srfi-34)
     4(compile -s -O2 srfi-34.import.scm)
    205
    216(install-extension
    227 'srfi-34
    23  '("srfi-34.scm"
    24    "srfi-34-base.so"
    25    "srfi-34-base.o"
    26    "tests/run.scm"
    27    "examples/srfi-34-examples.scm")
    28  '((version "0.1")
    29    (syntax)
    30    (require-at-runtime srfi-34-base)
    31    (exports "srfi-34-base.emit-exports")
    32    (static "srfi-34-base.o")))
    33 |#
     8 '("srfi-34.so" "srfi-34.import.so"
     9   "srfi-34.html" "srfi-34.setup")
     10 '((version "0.3")
     11   (docs-from-wiki)))
    3412
    35 (install-extension
    36  'srfi-34
    37  '("srfi-34.scm"
    38    "tests/run.scm"
    39    "examples/srfi-34-examples.scm")
    40  '((version "0.2")
    41    (syntax)))
    4213
Note: See TracChangeset for help on using the changeset viewer.