conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Added with-exception-handler, raise, and raise-continuable.

This commit is contained in:
Abdulaziz Ghuloum 2007-10-23 23:34:11 -04:00
parent 239141717f
commit 5678066f0d
5 changed files with 57 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/Makefile.am
View File

@ -1,6 +1,6 @@
nodist_bin_SCRIPTS=ikarus.boot
EXTRA_DIST=ikarus.boot.orig ikarus.apply.ss ikarus.bytevectors.ss ikarus.cafe.ss ikarus.chars.ss ikarus.code-objects.ss ikarus.codecs.ss ikarus.collect.ss ikarus.command-line.ss ikarus.compiler.altcogen.ss ikarus.compiler.ss ikarus.control.ss ikarus.date-string.ss ikarus.fasl.ss ikarus.fasl.write.ss ikarus.fixnums.ss ikarus.guardians.ss ikarus.handlers.ss ikarus.hash-tables.ss ikarus.intel-assembler.ss ikarus.io-ports.ss ikarus.io-primitives.ss ikarus.io-primitives.unsafe.ss ikarus.io.input-files.ss ikarus.io.input-strings.ss ikarus.io.output-files.ss ikarus.io.output-strings.ss ikarus.lists.ss ikarus.load.ss ikarus.main.ss ikarus.multiple-values.ss ikarus.numerics.ss ikarus.pairs.ss ikarus.posix.ss ikarus.predicates.ss ikarus.pretty-print.ss ikarus.promises.ss ikarus.reader.ss ikarus.records.procedural.ss ikarus.conditions.ss ikarus.singular-objects.ss ikarus.sort.ss ikarus.strings.ss ikarus.structs.ss ikarus.symbols.ss ikarus.timer.ss ikarus.trace.ss ikarus.transcoders.ss ikarus.unicode-data.ss ikarus.vectors.ss ikarus.writer.ss makefile.ss pass-specify-rep-primops.ss pass-specify-rep.ss psyntax.builders.ss psyntax.compat.ss psyntax.config.ss psyntax.expander.ss psyntax.internal.ss psyntax.library-manager.ss r6rs-records.ss ikarus/code-objects.ss ikarus/compiler.ss ikarus/intel-assembler.ss ikarus/fasl/write.ss unicode/unicode-char-cases.ss unicode/unicode-charinfo.ss
EXTRA_DIST=ikarus.boot.orig ikarus.exceptions.ss ikarus.apply.ss ikarus.bytevectors.ss ikarus.cafe.ss ikarus.chars.ss ikarus.code-objects.ss ikarus.codecs.ss ikarus.collect.ss ikarus.command-line.ss ikarus.compiler.altcogen.ss ikarus.compiler.ss ikarus.control.ss ikarus.date-string.ss ikarus.fasl.ss ikarus.fasl.write.ss ikarus.fixnums.ss ikarus.guardians.ss ikarus.handlers.ss ikarus.hash-tables.ss ikarus.intel-assembler.ss ikarus.io-ports.ss ikarus.io-primitives.ss ikarus.io-primitives.unsafe.ss ikarus.io.input-files.ss ikarus.io.input-strings.ss ikarus.io.output-files.ss ikarus.io.output-strings.ss ikarus.lists.ss ikarus.load.ss ikarus.main.ss ikarus.multiple-values.ss ikarus.numerics.ss ikarus.pairs.ss ikarus.posix.ss ikarus.predicates.ss ikarus.pretty-print.ss ikarus.promises.ss ikarus.reader.ss ikarus.records.procedural.ss ikarus.conditions.ss ikarus.singular-objects.ss ikarus.sort.ss ikarus.strings.ss ikarus.structs.ss ikarus.symbols.ss ikarus.timer.ss ikarus.trace.ss ikarus.transcoders.ss ikarus.unicode-data.ss ikarus.vectors.ss ikarus.writer.ss makefile.ss pass-specify-rep-primops.ss pass-specify-rep.ss psyntax.builders.ss psyntax.compat.ss psyntax.config.ss psyntax.expander.ss psyntax.internal.ss psyntax.library-manager.ss r6rs-records.ss ikarus/code-objects.ss ikarus/compiler.ss ikarus/intel-assembler.ss ikarus/fasl/write.ss unicode/unicode-char-cases.ss unicode/unicode-charinfo.ss
all: $(nodist_bin_SCRIPTS)

BIN
scheme/ikarus.boot.orig
View File

Binary file not shown.

47
scheme/ikarus.exceptions.ss Normal file
View File

@ -0,0 +1,47 @@
(library (ikarus exceptions)
(export with-exception-handler raise raise-continuable)
(import
(only (rnrs) condition make-non-continuable-violation
make-message-condition)
(except (ikarus)
with-exception-handler raise raise-continuable))
(define (print-condition x)
(printf "CONDITION: ~s\n" x))
(define handlers
(make-parameter
(list
(lambda (x)
(printf "unhandled exception:\n")
(print-condition x)
(exit -1)))))
(define (with-exception-handler handler proc2)
(unless (procedure? handler)
(error 'with-exception-handler
"handler ~s is not a procedure" handler))
(unless (procedure? proc2)
(error 'with-exception-handler
"~s is not a procedure" proc2))
(parameterize ([handlers (cons handler (handlers))])
(proc2)))
(define (raise-continuable x)
(let ([h* (handlers)])
(let ([h (car h*)] [h* (cdr h*)])
(parameterize ([handlers h*])
(h x)))))
(define (raise x)
(let ([h* (handlers)])
(let ([h (car h*)] [h* (cdr h*)])
(parameterize ([handlers h*])
(h x)
(raise
(condition
(make-non-continuable-violation)
(make-message-condition "handler returned")))))))
)

1
scheme/makefile.ss
View File

@ -29,6 +29,7 @@
"ikarus.handlers.ss"
"ikarus.multiple-values.ss"
"ikarus.control.ss"
"ikarus.exceptions.ss"
"ikarus.collect.ss"
"ikarus.apply.ss"
"ikarus.predicates.ss"

16
scheme/todo-r6rs.ss
View File

@ -18,8 +18,12 @@
[ne (null-environment)]
[sr (rnrs sorting (6))]
[ls (rnrs lists (6))]
[ba (rnrs base (6))]
[ri (rnrs records inspection (6))]
[rp (rnrs records procedural (6))]
[rs (rnrs records syntactic (6))]
[co (rnrs conditions (6))]
[is (rnrs io simple (6))]
[ba (rnrs base (6))]
[bv (rnrs bytevectors (6))]
[uc (rnrs unicode (6))]
[ex (rnrs exceptions (6))]
@ -29,10 +33,6 @@
[ht (rnrs hashtables (6))]
[ip (rnrs io ports (6))]
[en (rnrs enums (6))]
[co (rnrs conditions (6))]
[ri (rnrs records inspection (6))]
[rp (rnrs records procedural (6))]
[rs (rnrs records syntactic (6))]
))
(define status-names
@ -489,9 +489,9 @@
[environment C ev]
[eval C ev se]
;;;
[raise S ex]
[raise-continuable S ex]
[with-exception-handler S ex]
[raise C ex]
[raise-continuable C ex]
[with-exception-handler C ex]
[guard S ex]
;;;
[binary-port? S ip]