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

Added a system library (ikarus system interrupts) that exports: 

make-interrupted-condition and interrupted-condition?
This commit is contained in:
Abdulaziz Ghuloum 2007-11-19 16:50:31 -05:00
parent be8123f8b6
commit c6b66f8661
4 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.orig
View File

Binary file not shown.

7
scheme/ikarus.conditions.ss
View File

@ -50,6 +50,7 @@
i/o-encoding-error? i/o-encoding-error-char
no-infinities-violation? make-no-infinities-violation
no-nans-violation? make-no-nans-violation
interrupted-condition? make-interrupted-condition
&condition-rtd &condition-rcd &message-rtd &message-rcd
&warning-rtd &warning-rcd &serious-rtd &serious-rcd
@ -70,7 +71,7 @@
&i/o-decoding-rtd &i/o-decoding-rcd &i/o-encoding-rtd
&i/o-encoding-rcd &no-infinities-rtd &no-infinities-rcd
&no-nans-rtd &no-nans-rcd
&interrupted-rtd &interrupted-rcd
)
(import
(rnrs records inspection)
@ -328,6 +329,10 @@
(define-condition-type &no-nans &implementation-restriction
make-no-nans-violation no-nans-violation?)
;;; ikarus-specific conditions
(define-condition-type &interrupted &condition
make-interrupted-condition interrupted-condition?)
(define print-condition
(let ()
(define (print-simple-condition x p)

3
scheme/ikarus.handlers.ss
View File

@ -45,8 +45,7 @@
(define interrupt-handler
(make-parameter
(lambda ()
(define-condition-type &interrupted &condition
make-interrupted-condition interrupted-condition?)
(import (ikarus system interrupts))
(set-port-output-index! (console-output-port) 0)
(raise-continuable
(condition

8
scheme/makefile.ss
View File

@ -196,7 +196,8 @@
[&i/o-decoding ($core-rtd . (&i/o-decoding-rtd &i/o-decoding-rcd))]
[&i/o-encoding ($core-rtd . (&i/o-encoding-rtd &i/o-encoding-rcd))]
[&no-infinities ($core-rtd . (&no-infinities-rtd &no-infinities-rcd ))]
[&no-nans ($core-rtd . (&no-nans-rtd &no-nans-rcd ))]
[&no-nans ($core-rtd . (&no-nans-rtd &no-nans-rcd))]
[&interrupted ($core-rtd . (&interrupted-rtd &interrupted-rcd))]
))
(define library-legend
@ -254,6 +255,7 @@
[$arg-list (ikarus system $arg-list) #f #t]
[$stack (ikarus system $stack) #f #t]
[$interrupts (ikarus system $interrupts) #f #t]
[interrupts (ikarus system interrupts) #f #t]
[$all (psyntax system $all) #f #t]
[$boot (psyntax system $bootstrap) #f #t]
))
@ -539,6 +541,8 @@
[$make-values-procedure $stack]
[$interrupted? $interrupts]
[$unset-interrupted! $interrupts]
[interrupted-condition? interrupts]
[make-interrupted-condition interrupts]
[$apply-nonprocedure-error-handler ]
[$incorrect-args-error-handler ]
[$multiple-values-error ]
@ -1342,6 +1346,8 @@
[&no-infinities-rcd]
[&no-nans-rtd]
[&no-nans-rcd]
[&interrupted-rtd]
[&interrupted-rcd]
))
(define (macro-identifier? x)