diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-10 23:34:18 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-07-10 23:34:18 +0200 |
| commit | 1c50cc7d5bed951f4e39e01d179e35ebff50103f (patch) | |
| tree | a4241f8bc027e260b648499b9f919a999e892b99 | |
| parent | work (diff) | |
| download | calp-1c50cc7d5bed951f4e39e01d179e35ebff50103f.tar.gz calp-1c50cc7d5bed951f4e39e01d179e35ebff50103f.tar.xz | |
Add of-type? to (hnh util type).
| -rw-r--r-- | module/hnh/util/type.scm | 8 |
1 files changed, 8 insertions, 0 deletions
diff --git a/module/hnh/util/type.scm b/module/hnh/util/type.scm index f35f7839..1ea09af5 100644 --- a/module/hnh/util/type.scm +++ b/module/hnh/util/type.scm @@ -2,6 +2,7 @@ :use-module ((srfi srfi-1) :select (every)) :export (build-validator-body list-of pair-of + of-type? typecheck current-procedure-name)) @@ -33,6 +34,13 @@ ;; 1 since make-stack is at top of stack (frame-procedure-name (stack-ref (make-stack #t) 1))) +(define-syntax of-type? + (syntax-rules () + ((_ variable type-spec) + (build-validator-body variable type-spec)) + ((_ type-spec) + (lambda (x) (build-validator-body x type-spec))))) + (define-syntax typecheck (syntax-rules () ((_ variable type-clause) |