Re: define-typed: checking values on proc entry and exit
"Dr. Arne Babenhauserheide" <[email protected]>
| Newsgroups | gmane.lisp.guile.user |
|---|---|
| Message-ID | <[email protected]> |
Vivien Kraus <[email protected]> writes: > Hello! > > This is an interesting approach, thank you. > > Le vendredi 10 mai 2024 à 09:47 +0200, Dr. Arne Babenhauserheide a > écrit : >> │ ;; get the result >> │ (let ((res (helper))) >> │ ;; typecheck the result >> │ (unless (ret? res) >> │ (error "type error: return value ~a does not match ~a" >> │ res ret?)) >> │ ;; return the result >> │ res)) > > A nice improvement would be to support multiple return values, for > instance by using call-with-values, and checking the return value with > (apply ret? res) instead of (ret? res). > > What do you think? That’s a nice idea! With some experimentation I got it working: ┌──── │ (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) │ (unless (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))) │ ;; 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!), and so forth. ┌──── │ (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" │ #((props)) │ typed-world) │ (procedure-properties hello) │ ;; => ((name . hello) (documentation . "typed") (props)) │ (define-typed (multiple-values num) ((λ(a b) (> a b)) number?) │ (values (* 2 (abs num)) num)) │ (multiple-values -3) │ ;; => 6 │ ;; => -3 └──── Best wishes, Arne
signature.asc
(application/pgp-signature, 1.1 KB)
-----BEGIN PGP SIGNATURE----- iQJEBAEBCAAuFiEE801qEjXQSQPNItXAE++NRSQDw+sFAmZCv7YQHGFybmVfYmFi QHdlYi5kZQAKCRAT741FJAPD6/DcD/4lO/rdjSLEthIwu1/fgJnfv3gmLQhaYSBq CgFdk7ib+JwRs/EUDXV7qU82DuYNUGLbqhOPYPDLA+gcK9BaNdsDTwZ6vQe33cf+ kp8KLrUlXTVP4hwOyx5XE8PTlDKsGF5SdaouiGJRted5OLIl0jVpxtxxivoZqH3l FA8eWffyAN/nRxszBghldZ2KYEFx0Ah+qvIU4LkRIytOj/qLipEA6aJiDrAs+cjF NNP3iAJhfRymhk9L91Bcx3SwTuE8KfPoPZb5nJQYY6H8KqHQNmgJIOZpbzhkBsFs SvT4Lttw9V6WrAt1GMVGj50YmGIGpRfOmzyF+SetYF6ptBo9uteVE7DJddjtbgh+ syy/1r56D7NzRilGBT+jurWPVQIAS9ST0vURbVhbVd7rHWRObjOyRcIFhkP2Zovc x1cWtUwyWEgzRP0ZsVqjfqkJSBBFqQpzbRPGfFCFo0uhtm3RktfTPox10uiqw7OF hc/6QBBSyXjYz3LU5advCTGaLfV/7Jtv+aqWheppRhWgKFJbS+yduzcBQGhNoxVZ yWiEEaOgddnkIHvxiEbugkDdEO8ncemylcnKWzTMPMKqsmloEqL4ru+/zUdXSrjQ cIBfw4AdIIJvq9TIX84HCMqDsZP8cA59bSOUrWCcKHBIX2GJMQYympc2lIZK+Frw eLu8T+B2q4jEBAEBCAAuFiEE3Si95tmHXKvOSosd3M8NswvBBUgFAmZCv7YQHGFy bmVfYmFiQHdlYi5kZQAKCRDczw2zC8EFSAUlA/9wzaDMobRtXEzqxdOP9bhV/SHG MpFGE49phK63JncvPPJfI8yTK6Ml94feJuB+bs8wKKqQt15JTkIDKU2O437Go7t9 UlXGXu5iqvjLR/851HjJpZscPfA/ZVCJ6cWLJOzeKbQIFmDfDcsnHzkb8sQCsmGM BYCUZyR9q8nvuUgJWQ== =pxUs -----END PGP SIGNATURE-----