mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 13:30:26 +02:00
Move exception-handling routines after records in boot-9
* module/ice-9/boot-9.scm: Move down definitions of catch, throw, and so on until they are after records.
This commit is contained in:
Andy Wingo
parent
f9b594c482
commit
fc7a0a854f
1 changed files with 261 additions and 258 deletions
|
|
@ -719,264 +719,6 @@ information is unavailable."
|
|||
(define (abort-to-prompt tag . args)
|
||||
(abort-to-prompt* tag args))
|
||||
|
||||
;; Define catch and with-throw-handler, using some common helper routines and a
|
||||
;; shared fluid. Hide the helpers in a lexical contour.
|
||||
|
||||
(define with-throw-handler #f)
|
||||
(let ((%eh (module-ref (current-module) '%exception-handler)))
|
||||
(define (make-exception-handler catch-key prompt-tag pre-unwind)
|
||||
(vector catch-key prompt-tag pre-unwind))
|
||||
(define (exception-handler-catch-key handler) (vector-ref handler 0))
|
||||
(define (exception-handler-prompt-tag handler) (vector-ref handler 1))
|
||||
(define (exception-handler-pre-unwind handler) (vector-ref handler 2))
|
||||
|
||||
(define %running-pre-unwind (make-fluid #f))
|
||||
(define (pre-unwind-handler-running? handler)
|
||||
(let lp ((depth 0))
|
||||
(let ((running (fluid-ref* %running-pre-unwind depth)))
|
||||
(and running
|
||||
(or (eq? running handler) (lp (1+ depth)))))))
|
||||
|
||||
(define (dispatch-exception depth key args)
|
||||
(cond
|
||||
((fluid-ref* %eh depth)
|
||||
=> (lambda (handler)
|
||||
(let ((catch-key (exception-handler-catch-key handler)))
|
||||
(if (or (eqv? catch-key #t) (eq? catch-key key))
|
||||
(let ((prompt-tag (exception-handler-prompt-tag handler))
|
||||
(pre-unwind (exception-handler-pre-unwind handler)))
|
||||
(cond
|
||||
((and pre-unwind
|
||||
(not (pre-unwind-handler-running? handler)))
|
||||
;; Prevent errors from within the pre-unwind
|
||||
;; handler's invocation from being handled by this
|
||||
;; handler.
|
||||
(with-fluid* %running-pre-unwind handler
|
||||
(lambda ()
|
||||
;; FIXME: Currently the "running" flag only
|
||||
;; applies to the pre-unwind handler; the
|
||||
;; post-unwind handler is still called if the
|
||||
;; error is explicitly rethrown. Instead it
|
||||
;; would be better to cause a recursive throw to
|
||||
;; skip all parts of this handler. Unfortunately
|
||||
;; that is incompatible with existing semantics.
|
||||
;; We'll see if we can change that later on.
|
||||
(apply pre-unwind key args)
|
||||
(dispatch-exception depth key args))))
|
||||
(prompt-tag
|
||||
(apply abort-to-prompt prompt-tag key args))
|
||||
(else
|
||||
(dispatch-exception (1+ depth) key args))))
|
||||
(dispatch-exception (1+ depth) key args)))))
|
||||
((eq? key 'quit)
|
||||
(primitive-exit (cond
|
||||
((not (pair? args)) 0)
|
||||
((integer? (car args)) (car args))
|
||||
((not (car args)) 1)
|
||||
(else 0))))
|
||||
(else
|
||||
(format (current-error-port) "guile: uncaught throw to ~a: ~a\n"
|
||||
key args)
|
||||
(primitive-exit 1))))
|
||||
|
||||
(define (throw key . args)
|
||||
"Invoke the catch form matching @var{key}, passing @var{args} to the
|
||||
@var{handler}.
|
||||
|
||||
@var{key} is a symbol. It will match catches of the same symbol or of @code{#t}.
|
||||
|
||||
If there is no handler at all, Guile prints an error and then exits."
|
||||
(unless (symbol? key)
|
||||
(throw 'wrong-type-arg "throw" "Wrong type argument in position ~a: ~a"
|
||||
(list 1 key) (list key)))
|
||||
(dispatch-exception 0 key args))
|
||||
|
||||
(define* (catch k thunk handler #:optional pre-unwind-handler)
|
||||
"Invoke @var{thunk} in the dynamic context of @var{handler} for
|
||||
exceptions matching @var{key}. If thunk throws to the symbol
|
||||
@var{key}, then @var{handler} is invoked this way:
|
||||
@lisp
|
||||
(handler key args ...)
|
||||
@end lisp
|
||||
|
||||
@var{key} is a symbol or @code{#t}.
|
||||
|
||||
@var{thunk} takes no arguments. If @var{thunk} returns
|
||||
normally, that is the return value of @code{catch}.
|
||||
|
||||
Handler is invoked outside the scope of its own @code{catch}.
|
||||
If @var{handler} again throws to the same key, a new handler
|
||||
from further up the call chain is invoked.
|
||||
|
||||
If the key is @code{#t}, then a throw to @emph{any} symbol will
|
||||
match this call to @code{catch}.
|
||||
|
||||
If a @var{pre-unwind-handler} is given and @var{thunk} throws
|
||||
an exception that matches @var{key}, Guile calls the
|
||||
@var{pre-unwind-handler} before unwinding the dynamic state and
|
||||
invoking the main @var{handler}. @var{pre-unwind-handler} should
|
||||
be a procedure with the same signature as @var{handler}, that
|
||||
is @code{(lambda (key . args))}. It is typically used to save
|
||||
the stack at the point where the exception occurred, but can also
|
||||
query other parts of the dynamic state at that point, such as
|
||||
fluid values.
|
||||
|
||||
A @var{pre-unwind-handler} can exit either normally or non-locally.
|
||||
If it exits normally, Guile unwinds the stack and dynamic context
|
||||
and then calls the normal (third argument) handler. If it exits
|
||||
non-locally, that exit determines the continuation."
|
||||
(define (wrong-type-arg n val)
|
||||
(scm-error 'wrong-type-arg "catch"
|
||||
"Wrong type argument in position ~a: ~a"
|
||||
(list n val) (list val)))
|
||||
(unless (or (symbol? k) (eqv? k #t))
|
||||
(wrong-type-arg 1 k))
|
||||
(unless (procedure? handler)
|
||||
(wrong-type-arg 3 handler))
|
||||
(unless (or (not pre-unwind-handler) (procedure? pre-unwind-handler))
|
||||
(wrong-type-arg 4 pre-unwind-handler))
|
||||
(let ((tag (make-prompt-tag "catch")))
|
||||
(call-with-prompt
|
||||
tag
|
||||
(lambda ()
|
||||
(with-fluid* %eh (make-exception-handler k tag pre-unwind-handler)
|
||||
thunk))
|
||||
(lambda (cont k . args)
|
||||
(apply handler k args)))))
|
||||
|
||||
(define (with-throw-handler k thunk pre-unwind-handler)
|
||||
"Add @var{handler} to the dynamic context as a throw handler
|
||||
for key @var{k}, then invoke @var{thunk}."
|
||||
(if (not (or (symbol? k) (eqv? k #t)))
|
||||
(scm-error 'wrong-type-arg "with-throw-handler"
|
||||
"Wrong type argument in position ~a: ~a"
|
||||
(list 1 k) (list k)))
|
||||
(with-fluid* %eh (make-exception-handler k #f pre-unwind-handler)
|
||||
thunk))
|
||||
|
||||
(hashq-remove! (%get-pre-modules-obarray) '%exception-handler)
|
||||
(define! 'catch catch)
|
||||
(define! 'with-throw-handler with-throw-handler)
|
||||
(define! 'throw throw))
|
||||
|
||||
|
||||
|
||||
|
||||
;;;
|
||||
;;; Extensible exception printing.
|
||||
;;;
|
||||
|
||||
(define set-exception-printer! #f)
|
||||
;; There is already a definition of print-exception from backtrace.c
|
||||
;; that we will override.
|
||||
|
||||
(let ((exception-printers '()))
|
||||
(define (print-location frame port)
|
||||
(let ((source (and=> frame frame-source)))
|
||||
;; source := (addr . (filename . (line . column)))
|
||||
(if source
|
||||
(let ((filename (or (cadr source) "<unnamed port>"))
|
||||
(line (caddr source))
|
||||
(col (cdddr source)))
|
||||
(format port "~a:~a:~a: " filename (1+ line) col))
|
||||
(format port "ERROR: "))))
|
||||
|
||||
(set! set-exception-printer!
|
||||
(lambda (key proc)
|
||||
(set! exception-printers (acons key proc exception-printers))))
|
||||
|
||||
(set! print-exception
|
||||
(lambda (port frame key args)
|
||||
(define (default-printer)
|
||||
(format port "Throw to key `~a' with args `~s'." key args))
|
||||
|
||||
(when frame
|
||||
(print-location frame port)
|
||||
;; When booting, false-if-exception isn't defined yet.
|
||||
(let ((name (catch #t
|
||||
(lambda () (frame-procedure-name frame))
|
||||
(lambda _ #f))))
|
||||
(when name
|
||||
(format port "In procedure ~a:\n" name))))
|
||||
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(let ((printer (assq-ref exception-printers key)))
|
||||
(if printer
|
||||
(printer port key args default-printer)
|
||||
(default-printer))))
|
||||
(lambda (k . args)
|
||||
(format port "Error while printing exception.")))
|
||||
(newline port)
|
||||
(force-output port))))
|
||||
|
||||
;;;
|
||||
;;; Printers for those keys thrown by Guile.
|
||||
;;;
|
||||
(let ()
|
||||
(define (scm-error-printer port key args default-printer)
|
||||
;; Abuse case-lambda as a pattern matcher, given that we don't have
|
||||
;; ice-9 match at this point.
|
||||
(apply (case-lambda
|
||||
((subr msg args . rest)
|
||||
(if subr
|
||||
(format port "In procedure ~a: " subr))
|
||||
(apply format port msg (or args '())))
|
||||
(_ (default-printer)))
|
||||
args))
|
||||
|
||||
(define (syntax-error-printer port key args default-printer)
|
||||
(apply (case-lambda
|
||||
((who what where form subform . extra)
|
||||
(format port "Syntax error:\n")
|
||||
(if where
|
||||
(let ((file (or (assq-ref where 'filename) "unknown file"))
|
||||
(line (and=> (assq-ref where 'line) 1+))
|
||||
(col (assq-ref where 'column)))
|
||||
(format port "~a:~a:~a: " file line col))
|
||||
(format port "unknown location: "))
|
||||
(if who
|
||||
(format port "~a: " who))
|
||||
(format port "~a" what)
|
||||
(if subform
|
||||
(format port " in subform ~s of ~s" subform form)
|
||||
(if form
|
||||
(format port " in form ~s" form))))
|
||||
(_ (default-printer)))
|
||||
args))
|
||||
|
||||
(define (keyword-error-printer port key args default-printer)
|
||||
(let ((message (cadr args))
|
||||
(faulty (car (cadddr args)))) ; I won't do it again, I promise.
|
||||
(format port "~a: ~s" message faulty)))
|
||||
|
||||
(define (getaddrinfo-error-printer port key args default-printer)
|
||||
(format port "In procedure getaddrinfo: ~a" (gai-strerror (car args))))
|
||||
|
||||
(set-exception-printer! 'goops-error scm-error-printer)
|
||||
(set-exception-printer! 'host-not-found scm-error-printer)
|
||||
(set-exception-printer! 'keyword-argument-error keyword-error-printer)
|
||||
(set-exception-printer! 'misc-error scm-error-printer)
|
||||
(set-exception-printer! 'no-data scm-error-printer)
|
||||
(set-exception-printer! 'no-recovery scm-error-printer)
|
||||
(set-exception-printer! 'null-pointer-error scm-error-printer)
|
||||
(set-exception-printer! 'out-of-memory scm-error-printer)
|
||||
(set-exception-printer! 'out-of-range scm-error-printer)
|
||||
(set-exception-printer! 'program-error scm-error-printer)
|
||||
(set-exception-printer! 'read-error scm-error-printer)
|
||||
(set-exception-printer! 'regular-expression-syntax scm-error-printer)
|
||||
(set-exception-printer! 'signal scm-error-printer)
|
||||
(set-exception-printer! 'stack-overflow scm-error-printer)
|
||||
(set-exception-printer! 'system-error scm-error-printer)
|
||||
(set-exception-printer! 'try-again scm-error-printer)
|
||||
(set-exception-printer! 'unbound-variable scm-error-printer)
|
||||
(set-exception-printer! 'wrong-number-of-args scm-error-printer)
|
||||
(set-exception-printer! 'wrong-type-arg scm-error-printer)
|
||||
|
||||
(set-exception-printer! 'syntax-error syntax-error-printer)
|
||||
|
||||
(set-exception-printer! 'getaddrinfo-error getaddrinfo-error-printer))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -1494,6 +1236,7 @@ VALUE."
|
|||
|
||||
|
||||
|
||||
|
||||
;;; {Parameters}
|
||||
;;;
|
||||
|
||||
|
|
@ -1655,6 +1398,266 @@ written into the port is returned."
|
|||
|
||||
|
||||
|
||||
;; Define catch and with-throw-handler, using some common helper routines and a
|
||||
;; shared fluid. Hide the helpers in a lexical contour.
|
||||
|
||||
(define with-throw-handler #f)
|
||||
(let ((%eh (module-ref (current-module) '%exception-handler)))
|
||||
(define (make-exception-handler catch-key prompt-tag pre-unwind)
|
||||
(vector catch-key prompt-tag pre-unwind))
|
||||
(define (exception-handler-catch-key handler) (vector-ref handler 0))
|
||||
(define (exception-handler-prompt-tag handler) (vector-ref handler 1))
|
||||
(define (exception-handler-pre-unwind handler) (vector-ref handler 2))
|
||||
|
||||
(define %running-pre-unwind (make-fluid #f))
|
||||
(define (pre-unwind-handler-running? handler)
|
||||
(let lp ((depth 0))
|
||||
(let ((running (fluid-ref* %running-pre-unwind depth)))
|
||||
(and running
|
||||
(or (eq? running handler) (lp (1+ depth)))))))
|
||||
|
||||
(define (dispatch-exception depth key args)
|
||||
(cond
|
||||
((fluid-ref* %eh depth)
|
||||
=> (lambda (handler)
|
||||
(let ((catch-key (exception-handler-catch-key handler)))
|
||||
(if (or (eqv? catch-key #t) (eq? catch-key key))
|
||||
(let ((prompt-tag (exception-handler-prompt-tag handler))
|
||||
(pre-unwind (exception-handler-pre-unwind handler)))
|
||||
(cond
|
||||
((and pre-unwind
|
||||
(not (pre-unwind-handler-running? handler)))
|
||||
;; Prevent errors from within the pre-unwind
|
||||
;; handler's invocation from being handled by this
|
||||
;; handler.
|
||||
(with-fluid* %running-pre-unwind handler
|
||||
(lambda ()
|
||||
;; FIXME: Currently the "running" flag only
|
||||
;; applies to the pre-unwind handler; the
|
||||
;; post-unwind handler is still called if the
|
||||
;; error is explicitly rethrown. Instead it
|
||||
;; would be better to cause a recursive throw to
|
||||
;; skip all parts of this handler. Unfortunately
|
||||
;; that is incompatible with existing semantics.
|
||||
;; We'll see if we can change that later on.
|
||||
(apply pre-unwind key args)
|
||||
(dispatch-exception depth key args))))
|
||||
(prompt-tag
|
||||
(apply abort-to-prompt prompt-tag key args))
|
||||
(else
|
||||
(dispatch-exception (1+ depth) key args))))
|
||||
(dispatch-exception (1+ depth) key args)))))
|
||||
((eq? key 'quit)
|
||||
(primitive-exit (cond
|
||||
((not (pair? args)) 0)
|
||||
((integer? (car args)) (car args))
|
||||
((not (car args)) 1)
|
||||
(else 0))))
|
||||
(else
|
||||
(format (current-error-port) "guile: uncaught throw to ~a: ~a\n"
|
||||
key args)
|
||||
(primitive-exit 1))))
|
||||
|
||||
(define (throw key . args)
|
||||
"Invoke the catch form matching @var{key}, passing @var{args} to the
|
||||
@var{handler}.
|
||||
|
||||
@var{key} is a symbol. It will match catches of the same symbol or of @code{#t}.
|
||||
|
||||
If there is no handler at all, Guile prints an error and then exits."
|
||||
(unless (symbol? key)
|
||||
(throw 'wrong-type-arg "throw" "Wrong type argument in position ~a: ~a"
|
||||
(list 1 key) (list key)))
|
||||
(dispatch-exception 0 key args))
|
||||
|
||||
(define* (catch k thunk handler #:optional pre-unwind-handler)
|
||||
"Invoke @var{thunk} in the dynamic context of @var{handler} for
|
||||
exceptions matching @var{key}. If thunk throws to the symbol
|
||||
@var{key}, then @var{handler} is invoked this way:
|
||||
@lisp
|
||||
(handler key args ...)
|
||||
@end lisp
|
||||
|
||||
@var{key} is a symbol or @code{#t}.
|
||||
|
||||
@var{thunk} takes no arguments. If @var{thunk} returns
|
||||
normally, that is the return value of @code{catch}.
|
||||
|
||||
Handler is invoked outside the scope of its own @code{catch}.
|
||||
If @var{handler} again throws to the same key, a new handler
|
||||
from further up the call chain is invoked.
|
||||
|
||||
If the key is @code{#t}, then a throw to @emph{any} symbol will
|
||||
match this call to @code{catch}.
|
||||
|
||||
If a @var{pre-unwind-handler} is given and @var{thunk} throws
|
||||
an exception that matches @var{key}, Guile calls the
|
||||
@var{pre-unwind-handler} before unwinding the dynamic state and
|
||||
invoking the main @var{handler}. @var{pre-unwind-handler} should
|
||||
be a procedure with the same signature as @var{handler}, that
|
||||
is @code{(lambda (key . args))}. It is typically used to save
|
||||
the stack at the point where the exception occurred, but can also
|
||||
query other parts of the dynamic state at that point, such as
|
||||
fluid values.
|
||||
|
||||
A @var{pre-unwind-handler} can exit either normally or non-locally.
|
||||
If it exits normally, Guile unwinds the stack and dynamic context
|
||||
and then calls the normal (third argument) handler. If it exits
|
||||
non-locally, that exit determines the continuation."
|
||||
(define (wrong-type-arg n val)
|
||||
(scm-error 'wrong-type-arg "catch"
|
||||
"Wrong type argument in position ~a: ~a"
|
||||
(list n val) (list val)))
|
||||
(unless (or (symbol? k) (eqv? k #t))
|
||||
(wrong-type-arg 1 k))
|
||||
(unless (procedure? handler)
|
||||
(wrong-type-arg 3 handler))
|
||||
(unless (or (not pre-unwind-handler) (procedure? pre-unwind-handler))
|
||||
(wrong-type-arg 4 pre-unwind-handler))
|
||||
(let ((tag (make-prompt-tag "catch")))
|
||||
(call-with-prompt
|
||||
tag
|
||||
(lambda ()
|
||||
(with-fluid* %eh (make-exception-handler k tag pre-unwind-handler)
|
||||
thunk))
|
||||
(lambda (cont k . args)
|
||||
(apply handler k args)))))
|
||||
|
||||
(define (with-throw-handler k thunk pre-unwind-handler)
|
||||
"Add @var{handler} to the dynamic context as a throw handler
|
||||
for key @var{k}, then invoke @var{thunk}."
|
||||
(if (not (or (symbol? k) (eqv? k #t)))
|
||||
(scm-error 'wrong-type-arg "with-throw-handler"
|
||||
"Wrong type argument in position ~a: ~a"
|
||||
(list 1 k) (list k)))
|
||||
(with-fluid* %eh (make-exception-handler k #f pre-unwind-handler)
|
||||
thunk))
|
||||
|
||||
(hashq-remove! (%get-pre-modules-obarray) '%exception-handler)
|
||||
(define! 'catch catch)
|
||||
(define! 'with-throw-handler with-throw-handler)
|
||||
(define! 'throw throw))
|
||||
|
||||
|
||||
|
||||
;;;
|
||||
;;; Extensible exception printing.
|
||||
;;;
|
||||
|
||||
(define set-exception-printer! #f)
|
||||
;; There is already a definition of print-exception from backtrace.c
|
||||
;; that we will override.
|
||||
|
||||
(let ((exception-printers '()))
|
||||
(define (print-location frame port)
|
||||
(let ((source (and=> frame frame-source)))
|
||||
;; source := (addr . (filename . (line . column)))
|
||||
(if source
|
||||
(let ((filename (or (cadr source) "<unnamed port>"))
|
||||
(line (caddr source))
|
||||
(col (cdddr source)))
|
||||
(format port "~a:~a:~a: " filename (1+ line) col))
|
||||
(format port "ERROR: "))))
|
||||
|
||||
(set! set-exception-printer!
|
||||
(lambda (key proc)
|
||||
(set! exception-printers (acons key proc exception-printers))))
|
||||
|
||||
(set! print-exception
|
||||
(lambda (port frame key args)
|
||||
(define (default-printer)
|
||||
(format port "Throw to key `~a' with args `~s'." key args))
|
||||
|
||||
(when frame
|
||||
(print-location frame port)
|
||||
;; When booting, false-if-exception isn't defined yet.
|
||||
(let ((name (catch #t
|
||||
(lambda () (frame-procedure-name frame))
|
||||
(lambda _ #f))))
|
||||
(when name
|
||||
(format port "In procedure ~a:\n" name))))
|
||||
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(let ((printer (assq-ref exception-printers key)))
|
||||
(if printer
|
||||
(printer port key args default-printer)
|
||||
(default-printer))))
|
||||
(lambda (k . args)
|
||||
(format port "Error while printing exception.")))
|
||||
(newline port)
|
||||
(force-output port))))
|
||||
|
||||
;;;
|
||||
;;; Printers for those keys thrown by Guile.
|
||||
;;;
|
||||
(let ()
|
||||
(define (scm-error-printer port key args default-printer)
|
||||
;; Abuse case-lambda as a pattern matcher, given that we don't have
|
||||
;; ice-9 match at this point.
|
||||
(apply (case-lambda
|
||||
((subr msg args . rest)
|
||||
(if subr
|
||||
(format port "In procedure ~a: " subr))
|
||||
(apply format port msg (or args '())))
|
||||
(_ (default-printer)))
|
||||
args))
|
||||
|
||||
(define (syntax-error-printer port key args default-printer)
|
||||
(apply (case-lambda
|
||||
((who what where form subform . extra)
|
||||
(format port "Syntax error:\n")
|
||||
(if where
|
||||
(let ((file (or (assq-ref where 'filename) "unknown file"))
|
||||
(line (and=> (assq-ref where 'line) 1+))
|
||||
(col (assq-ref where 'column)))
|
||||
(format port "~a:~a:~a: " file line col))
|
||||
(format port "unknown location: "))
|
||||
(if who
|
||||
(format port "~a: " who))
|
||||
(format port "~a" what)
|
||||
(if subform
|
||||
(format port " in subform ~s of ~s" subform form)
|
||||
(if form
|
||||
(format port " in form ~s" form))))
|
||||
(_ (default-printer)))
|
||||
args))
|
||||
|
||||
(define (keyword-error-printer port key args default-printer)
|
||||
(let ((message (cadr args))
|
||||
(faulty (car (cadddr args)))) ; I won't do it again, I promise.
|
||||
(format port "~a: ~s" message faulty)))
|
||||
|
||||
(define (getaddrinfo-error-printer port key args default-printer)
|
||||
(format port "In procedure getaddrinfo: ~a" (gai-strerror (car args))))
|
||||
|
||||
(set-exception-printer! 'goops-error scm-error-printer)
|
||||
(set-exception-printer! 'host-not-found scm-error-printer)
|
||||
(set-exception-printer! 'keyword-argument-error keyword-error-printer)
|
||||
(set-exception-printer! 'misc-error scm-error-printer)
|
||||
(set-exception-printer! 'no-data scm-error-printer)
|
||||
(set-exception-printer! 'no-recovery scm-error-printer)
|
||||
(set-exception-printer! 'null-pointer-error scm-error-printer)
|
||||
(set-exception-printer! 'out-of-memory scm-error-printer)
|
||||
(set-exception-printer! 'out-of-range scm-error-printer)
|
||||
(set-exception-printer! 'program-error scm-error-printer)
|
||||
(set-exception-printer! 'read-error scm-error-printer)
|
||||
(set-exception-printer! 'regular-expression-syntax scm-error-printer)
|
||||
(set-exception-printer! 'signal scm-error-printer)
|
||||
(set-exception-printer! 'stack-overflow scm-error-printer)
|
||||
(set-exception-printer! 'system-error scm-error-printer)
|
||||
(set-exception-printer! 'try-again scm-error-printer)
|
||||
(set-exception-printer! 'unbound-variable scm-error-printer)
|
||||
(set-exception-printer! 'wrong-number-of-args scm-error-printer)
|
||||
(set-exception-printer! 'wrong-type-arg scm-error-printer)
|
||||
|
||||
(set-exception-printer! 'syntax-error syntax-error-printer)
|
||||
|
||||
(set-exception-printer! 'getaddrinfo-error getaddrinfo-error-printer))
|
||||
|
||||
|
||||
|
||||
|
||||
;; Load `posix.scm' even when not (provided? 'posix) so that we get the
|
||||
;; `stat' accessors.
|
||||
(primitive-load-path "ice-9/posix")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue