diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-03 12:35:01 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-07 21:25:23 +0200 |
commit | 2d73d445be2ada75746b55dea831b5e0a3764410 (patch) | |
tree | d51ecff94354037ae47775ec320142c5da50758f /module/hnh/util | |
parent | Change date/time interface. (diff) | |
download | calp-2d73d445be2ada75746b55dea831b5e0a3764410.tar.gz calp-2d73d445be2ada75746b55dea831b5e0a3764410.tar.xz |
Extend object type system to allow list-of.
Diffstat (limited to 'module/hnh/util')
-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)))) |