"Dr. Arne Babenhauserheide" <arne_...@web.de> writes: > Zelphir Kaltstahl <zelphirkaltst...@posteo.de> writes: >> https://codeberg.org/ZelphirKaltstahl/guile-examples/src/commit/0e231c289596cb4c445efb30168105914a8539a5/macros/contracts
> And the *-versions are ominous: optional and keyword arguments may be > the next frontier. > > I’m not sure how to keep those simple. I now have a solution: https://www.draketo.de/software/guile-snippets#define-typed ┌──── │ (import (srfi :11 let-values)) │ (define-syntax-rule (define-typed (procname args ...) (ret? types ...) body ...) │ (begin │ (define* (procname args ...) │ ;; create a sub-procedure to run after typecheck │ (define (helper) │ body ...) │ ;; use a typecheck prefix for the arguments │ (map (λ (type? argument) │ (let ((is-keyword? (and (keyword? type?) │ (keyword? argument)))) │ (when (and is-keyword? (not (equal? type? argument))) │ (error "Keywords in arguments and types are not equal ~a ~a" │ type? argument)) │ (unless (or is-keyword? (type? argument)) │ (error "type error ~a ~a" type? argument)))) │ (list types ...) (list args ...)) │ ;; get the result │ (let-values ((res (helper))) │ ;; typecheck the result │ (unless (apply ret? res) │ (error "type error: return value ~a does not match ~a" │ res ret?)) │ ;; return the result │ (apply values res))) │ (unless (equal? (length (quote (args ...))) (length (quote (types ...)))) │ (error "argument error: argument list ~a and type list ~a have different size" │ (quote (args ...)) (quote (types ...)))) │ ;; add procedure properties via an inner procedure │ (let ((helper (lambda* (args ...) body ...))) │ (set-procedure-properties! procname (procedure-properties helper)) │ ;; preserve the name │ (set-procedure-property! procname 'name 'procname)))) └──── This supports most features of regular define like docstrings, procedure properties, multiple values (thanks to Vivien!), keyword-arguments (thanks to Zelphir Kaltstahl’s [contracts]), and so forth. Basic usage: ┌──── │ (define-typed (hello typed-world) (string? string?) │ typed-world) │ (hello "typed") │ ;; => "typed" │ (hello 1337) │ ;; => type error ~a ~a #<procedure string? (_)> 1337 │ (define-typed (hello typed-world) (string? string?) │ "typed" ;; docstring │ #((props)) ;; more properties │ 1337) ;; wrong return type │ (procedure-documentation hello) │ ;; => "typed" │ (procedure-properties hello) │ ;; => ((name . hello) (documentation . "typed") (props)) │ (hello "typed") │ ;; type error: return value ~a does not match ~a (1337) #<procedure string? (_)> └──── Multiple Values and optional and required keyword arguments: ┌──── │ (define-typed (multiple-values num) ((λ(a b) (> a b)) number?) │ (values (* 2 (abs num)) num)) │ (multiple-values -3) │ ;; => 6 │ ;; => -3 │ (define-typed (hello #:key typed-world) (string? #:key string?) "typed" #((props)) typed-world) │ (hello #:typed-world "foo") │ ;; => "foo" │ ;; unused keyword arguments are always boolean #f as input │ (hello) │ ;; => type error ~a ~a #<procedure string? (_)> #f │ ;; typing optional keyword arguments │ (define (optional-string? x) (or (not x) (string? x))) │ (define-typed (hello #:key typed-world) (string? #:key optional-string?) │ (or typed-world "world")) │ (hello) │ ;; => "world" │ (hello #:typed-world "typed") │ ;; => "typed" │ (hello #:typed-world #t) │ ;; => type error ~a ~a #<procedure optional-string? (x)> #t │ ;; optional arguments │ (define-typed (hello #:optional typed-world) (string? #:optional optional-string?) │ (or typed-world "world")) │ (hello) │ ;; => "world" │ (hello "typed") │ ;; => "typed" │ (hello #t) │ ;; => type error ~a ~a #<procedure optional-string? (x)> #t └──── Best wishes, Arne
signature.asc
Description: PGP signature