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.

9
scheme/ikarus.conditions.ss
View File

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

3
scheme/ikarus.handlers.ss
View File

@ -45,8 +45,7 @@
(define interrupt-handler (define interrupt-handler
(make-parameter (make-parameter
(lambda () (lambda ()
(define-condition-type &interrupted &condition (import (ikarus system interrupts))
make-interrupted-condition interrupted-condition?)
(set-port-output-index! (console-output-port) 0) (set-port-output-index! (console-output-port) 0)
(raise-continuable (raise-continuable
(condition (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-decoding ($core-rtd . (&i/o-decoding-rtd &i/o-decoding-rcd))]
[&i/o-encoding ($core-rtd . (&i/o-encoding-rtd &i/o-encoding-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-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 (define library-legend
@ -254,6 +255,7 @@
[$arg-list (ikarus system $arg-list) #f #t] [$arg-list (ikarus system $arg-list) #f #t]
[$stack (ikarus system $stack) #f #t] [$stack (ikarus system $stack) #f #t]
[$interrupts (ikarus system $interrupts) #f #t] [$interrupts (ikarus system $interrupts) #f #t]
[interrupts (ikarus system interrupts) #f #t]
[$all (psyntax system $all) #f #t] [$all (psyntax system $all) #f #t]
[$boot (psyntax system $bootstrap) #f #t] [$boot (psyntax system $bootstrap) #f #t]
)) ))
@ -539,6 +541,8 @@
[$make-values-procedure $stack] [$make-values-procedure $stack]
[$interrupted? $interrupts] [$interrupted? $interrupts]
[$unset-interrupted! $interrupts] [$unset-interrupted! $interrupts]
[interrupted-condition? interrupts]
[make-interrupted-condition interrupts]
[$apply-nonprocedure-error-handler ] [$apply-nonprocedure-error-handler ]
[$incorrect-args-error-handler ] [$incorrect-args-error-handler ]
[$multiple-values-error ] [$multiple-values-error ]
@ -1342,6 +1346,8 @@
[&no-infinities-rcd] [&no-infinities-rcd]
[&no-nans-rtd] [&no-nans-rtd]
[&no-nans-rcd] [&no-nans-rcd]
[&interrupted-rtd]
[&interrupted-rcd]
)) ))
(define (macro-identifier? x) (define (macro-identifier? x)