diff options
Diffstat (limited to 'module/hnh/util/object.scm')
| -rw-r--r-- | module/hnh/util/object.scm | 10 |
1 files changed, 9 insertions, 1 deletions
diff --git a/module/hnh/util/object.scm b/module/hnh/util/object.scm index 1ecacf8e..6a26336e 100644 --- a/module/hnh/util/object.scm +++ b/module/hnh/util/object.scm @@ -5,6 +5,8 @@ :use-module (hnh util) :export (define-type)) + + ;; If given a syntax list extract the first lexeme, if given a "symbol", return that. (define (syntax-first stx) (syntax-case stx () @@ -36,9 +38,15 @@ ;; DSL for specifying type predicates ;; Basically a procedure body, but the variable to test is implicit. (define-syntax build-validator-body - (syntax-rules (and or) + (syntax-rules (and or list-of) ((_ variable (and clauses ...)) (and (build-validator-body variable clauses) ...)) ((_ variable (or clauses ...)) (or (build-validator-body variable clauses) ...)) + ((_ variable (list-of (proc args ...))) + (and (list? variable) + (every (lambda (x) (build-validator-body x (proc args ...))) + variable))) + ((_ variable (list-of proc)) (and (list? variable) + (every proc variable))) ((_ variable (proc args ...)) (proc variable args ...)) ((_ variable proc) (proc variable)))) |