From: Dmitry Bogatov <kact...@gnu.org> With this renaming validation function is allowed to throw excection by itself to more accurately describe violated assumption.
By convention, predicates never throws. --- module/system/foreign/declarative.scm | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/module/system/foreign/declarative.scm b/module/system/foreign/declarative.scm index 4177bf7..5a5d688 100644 --- a/module/system/foreign/declarative.scm +++ b/module/system/foreign/declarative.scm @@ -28,7 +28,7 @@ encode-proc decode-proc type - predicate-proc + validate-proc clone-proc free-proc) foreign-type? @@ -36,7 +36,7 @@ (encode-proc ft-encode-proc) (decode-proc ft-decode-proc) (type ft-type) - (predicate-proc ft-predicate-proc) + (validate-proc ft-validate-proc) (clone-proc ft-clone-proc) (free-proc ft-free-proc)) @@ -49,7 +49,7 @@ encode-proc decode-proc (type '*) - (predicate-proc (lambda (x) #t)) + (validate-proc (lambda (x) #t)) clone-proc free-proc) (define-syntax-rule (default <arg> <def>) @@ -68,7 +68,7 @@ encode-proc decode-proc type - predicate-proc + validate-proc clone-proc free-proc)) @@ -81,7 +81,7 @@ ((_ prim <?> pred) (with-syntax ((ft (datum->syntax x (symbol-append (syntax->datum #'prim) ':)))) - #'(mirror-primitive-type prim ft #:predicate-proc pred))) + #'(mirror-primitive-type prim ft #:validate-proc pred))) ((_ prim ft rest* ...) #'(define-foreign-type ft #:encode-proc (lambda (x) x) @@ -106,7 +106,7 @@ (mirror-primitive-type uint64 <?> integer?) (mirror-primitive-type float <?> real?) (mirror-primitive-type double <?> real?) -(mirror-primitive-type '* *: #:predicate-proc pointer?) +(mirror-primitive-type '* *: #:validate-proc pointer?) (define-record-type <foreign-argument> (%make-foreign-argument type) @@ -151,13 +151,13 @@ (map %make-foreign-argument (list type ...)))) (frontend-function (lambda (arg-name ...) - (let ((predicate? (ft-predicate-proc type))) - (unless (predicate? arg-name) + (let ((validate (ft-validate-proc type))) + (unless (validate arg-name) (throw 'wrong-type-arg 'function-name - "Wrong type argument named `~A' (failed to satisfy predicate `~A'): ~S" - (list 'arg-name (procedure-name predicate?) arg-name) + "Wrong type argument named `~A' (failed to satisfy validator `~A'): ~S" + (list 'arg-name (procedure-name validate) arg-name) (list arg-name)))) ... (backend-function arg-name ...)))) -- I may be not subscribed. Please, keep me in carbon copy.