From: Dmitry Bogatov <[email protected]>
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.