Hi Ricardo et al,
On +2020-06-25 12:04:27 +0200, Ricardo Wurmus wrote:
>
> Hi Maxim,
>
> here’s what I did in the REPL:
>
> --8<---cut here---start->8---
> scheme@(guile-user)> ,m (ice-9 exceptions)
> scheme@(ice-9 exceptions)> (define (my/guile-system-error-converter key args)
> (apply (case-lambda
> ((subr msg-args msg errno . rest)
>;; XXX TODO we should return a more specific error
>;; (usually an I/O error) as expected by R6RS programs.
>;; Unfortunately this often requires the 'filename' (or
>;; other?) which is not currently provided by the native
>;; Guile exceptions.
> (make-exception
> (make-external-error)
> (make-exception-with-origin subr)
> (apply make-exception-with-message msg)
> (make-exception-with-irritants msg-args)))
> (_ (guile-external-error-converter key args)))
> args))
> scheme@(ice-9 exceptions)> (set! guile-exception-converters (acons
> 'system-error my/guile-system-error-converter guile-exception-converters))
> scheme@(ice-9 exceptions)> ,m (guile-user)
> scheme@(guile-user)> (guard (c ((message-condition? c)
> (format #t "message: ~a~%" (condition-message c
> (canonicalize-path "/doesntexist"))
> message: No such file or directory
> $11 = #t
> scheme@(guile-user)>
> --8<---cut here---end--->8---
>
> --
> Ricardo
What do you think of using (ice-9 match) to make a universal throwage-formatter,
with the idea of making readable top level code for how exceptions become
messages on screen?
I started a hack to explore the (throw 'whatever any ...) space, beginning like
--8<---cut here---start->8---
(use-modules (ice-9 match))
(define (make-exception-message key rest)
(begin
(let*((l (cons key rest)))
(match l
(('system-error subr message args data ...)
;; e.g. thrown with key 'system-error: ("open-fdes" "~A" ("No
such file or directory") (2))
(format #f (string-append "match-1: subr ~s threw '~s " message "
sterror: ~s") subr key args (strerror (car (car data)
(('signal any ...)
;; not yet implemented
(format #f "match-2: any: ~s" any))
(('keyword-argument-error subr message args data)
;; with-crossed-fingers...
(format #f (string-append "match-3: subr ~s threw '~s " message)
subr key args))
;; FIXME: string-append formats NAGI not a good idea, see a fix example below
(('wrong-type-arg subr message (args ...) (data ...))
;; E.g., thrown with key 'wrong-type-arg: ("sqrt" "Wrong type
argument in position ~A: ~S" (1 x) (x))
(format #f "match-4: subr ~s threw '~s: ~s" subr key (format #f
message args data)))
(('out-of-range subr message (lo hi bad1) ((bad2)))
;; E.g., thrown with key 'out-of-range: (#f "Value out of range
~S to ~S: ~S" (0 3 4) (4))
(format #f "match-5: (internal) threw '~s: ~s" 'out-of-range
(format #f message lo hi bad2)))
(('unbound-variable #f message args data)
;; E.g. thrown with key 'unbound-variable: (#f "Unbound variable:
~S" (foo) #f)
(format #f (string-append "match-6: subr ~s threw '~s " message)
#f key args)) ;; data))
;; FIXME: string-append formats NAGI
[...]
--8<---cut here---end--->8---
I made a guile hack that I could call from bash so I could type a line and
(eval-string it) as a source of exceptions,
and found that I could get secondary exceptions from make-exception-message, so
I wrapped that with a (catch ...)
something like
--8<---cut here---start->8---
(define verbose-exception-handler (lambda (k . rest )
(begin
(format #t "thrown with key '~s: ~s\n" k rest)
(format #t "catch return=~a\n" (catch #t
(lambda () (make-exception-message k
rest))
(lambda (inner-key . inner-rest)
(format #t "caught by inner handler:
thrown with key '~s: ~s\n" inner-key inner-rest
;; (format #t "thrown with key '~s: ~s\n" k rest)
(newline)
[...]
--8<---cut here---end--->8---
And using that like
--8<---cut here---start->8---
(define (wrap-main args)
(begin
(display (catch #t
(lambda () (apply main-defaults args))
verbose-exception-handler
--8<---cut
