* working through the handlers library
This commit is contained in:
parent
90ae8b65fb
commit
a97798b598
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -17,6 +17,26 @@
|
||||||
[(v) (set! x (guard v))])])))
|
[(v) (set! x (guard v))])])))
|
||||||
|
|
||||||
|
|
||||||
|
(library (ikarus system handlers)
|
||||||
|
(export interrupt-handler
|
||||||
|
$apply-nonprocedure-error-handler)
|
||||||
|
(import (except (ikarus) interrupt-handler))
|
||||||
|
|
||||||
|
(define interrupt-handler
|
||||||
|
(make-parameter
|
||||||
|
(lambda ()
|
||||||
|
(flush-output-port (console-output-port))
|
||||||
|
(error #f "interrupted"))
|
||||||
|
(lambda (x)
|
||||||
|
(if (procedure? x)
|
||||||
|
x
|
||||||
|
(error 'interrupt-handler "~s is not a procedure" x)))))
|
||||||
|
|
||||||
|
(define $apply-nonprocedure-error-handler
|
||||||
|
(lambda (x)
|
||||||
|
(error 'apply "~s is not a procedure" x)))
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
(library (ikarus handlers)
|
(library (ikarus handlers)
|
||||||
(export)
|
(export)
|
||||||
|
@ -28,19 +48,7 @@
|
||||||
(lambda args
|
(lambda args
|
||||||
(foreign-call "ik_error" args)))
|
(foreign-call "ik_error" args)))
|
||||||
|
|
||||||
(primitive-set! 'interrupt-handler
|
|
||||||
(make-parameter
|
|
||||||
(lambda ()
|
|
||||||
(flush-output-port (console-output-port))
|
|
||||||
(error #f "interrupted"))
|
|
||||||
(lambda (x)
|
|
||||||
(if (procedure? x)
|
|
||||||
x
|
|
||||||
(error 'interrupt-handler "~s is not a procedure" x)))))
|
|
||||||
|
|
||||||
(primitive-set! '$apply-nonprocedure-error-handler
|
|
||||||
(lambda (x)
|
|
||||||
(error 'apply "~s is not a procedure" x)))
|
|
||||||
|
|
||||||
(primitive-set! '$incorrect-args-error-handler
|
(primitive-set! '$incorrect-args-error-handler
|
||||||
(lambda (p n)
|
(lambda (p n)
|
||||||
|
|
|
@ -502,6 +502,7 @@
|
||||||
[library-spec s i]
|
[library-spec s i]
|
||||||
[current-library-collection s i]
|
[current-library-collection s i]
|
||||||
[invoke-library s i]
|
[invoke-library s i]
|
||||||
|
[$apply-nonprocedure-error-handler s]
|
||||||
))
|
))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue