From 1c50cc7d5bed951f4e39e01d179e35ebff50103f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 10 Jul 2022 23:34:18 +0200 Subject: Add of-type? to (hnh util type). --- module/hnh/util/type.scm | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'module/hnh') 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) -- cgit v1.2.3