|
Minimal foreign error API
Lassi Kortela
(28 Jul 2020 10:28 UTC)
|
|
Re: Minimal foreign error API
hga@xxxxxx
(28 Jul 2020 11:31 UTC)
|
|
Re: Minimal foreign error API
Lassi Kortela
(28 Jul 2020 12:05 UTC)
|
|
Re: Minimal foreign error API
Lassi Kortela
(28 Jul 2020 12:26 UTC)
|
|
Re: Minimal foreign error API
Lassi Kortela
(28 Jul 2020 12:30 UTC)
|
|
Re: Minimal foreign error API Lassi Kortela (28 Jul 2020 13:02 UTC)
|
|
Re: Minimal foreign error API
hga@xxxxxx
(28 Jul 2020 17:56 UTC)
|
|
Abstract or concrete data type for foreign error object?
Lassi Kortela
(31 Jul 2020 16:18 UTC)
|
|
Re: Abstract or concrete data type for foreign error object?
Shiro Kawai
(31 Jul 2020 18:29 UTC)
|
|
Re: Abstract or concrete data type for foreign error object?
hga@xxxxxx
(31 Jul 2020 19:04 UTC)
|
|
Re: Abstract or concrete data type for foreign error object?
Lassi Kortela
(01 Aug 2020 20:10 UTC)
|
|
Re: Minimal foreign error API
John Cowan
(28 Jul 2020 14:39 UTC)
|
|
Re: Minimal foreign error API
hga@xxxxxx
(28 Jul 2020 15:59 UTC)
|
The following is a full sample implementation of the SRFI with the
changes discussed in this thread. There are probably subtle bugs. I left
out `raise-continuable-foreign-error` and `foreign-error->string`.
(define-library (srfi 198)
(export make-foreign-error raise-foreign-error
foreign-error? foreign-error-ref)
(import (scheme base) (srfi 69))
(begin
(define-record-type foreign-error
(%make-foreign-error table)
foreign-error?
(table %foreign-error-table))
(define (make-foreign-error . plist)
(let ((table (make-hash-table)))
(let loop ((tail plist))
(cond ((null? tail)
(%make-foreign-error table))
((and (pair? tail) (symbol? (car tail)) (pair? (cdr tail)))
(hash-table-set! table (car tail) (cadr tail))
(loop (cddr tail)))
(else (error "Malformed property list" plist))))))
(define (raise-foreign-error . plist)
(raise (apply make-foreign-error plist)))
(define (foreign-error-ref ferr property . args)
(let* ((table (%foreign-error-table ferr))
(value (hash-table-ref/default table property #f)))
(if (procedure? value) (apply value args) value)))))