From: "Dr. Arne Babenhauserheide" <arne_bab@web.de>
To: guile-user@gnu.org,
Zelphir Kaltstahl <zelphirkaltstahl@posteo.de>,
guile-devel@gnu.org
Subject: Re: define-typed: checking values on proc entry and exit
Date: Wed, 15 May 2024 02:10:10 +0200 [thread overview]
Message-ID: <87r0e4szod.fsf@web.de> (raw)
In-Reply-To: <87v83huq87.fsf@web.de> (Arne Babenhauserheide's message of "Tue, 14 May 2024 03:39:04 +0200")
[-- Attachment #1: Type: text/plain, Size: 4346 bytes --]
"Dr. Arne Babenhauserheide" <arne_bab@web.de> writes:
> Zelphir Kaltstahl <zelphirkaltstahl@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
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 1125 bytes --]
next parent reply other threads:[~2024-05-15 0:10 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <871q6axg4s.fsf@web.de>
[not found] ` <97402bb8-b4e9-44a1-9955-23e95eda6f5d@posteo.de>
[not found] ` <87v83huq87.fsf@web.de>
2024-05-15 0:10 ` Dr. Arne Babenhauserheide [this message]
2024-05-21 2:30 ` define-typed: checking values on proc entry and exit Linas Vepstas
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87r0e4szod.fsf@web.de \
--to=arne_bab@web.de \
--cc=guile-devel@gnu.org \
--cc=guile-user@gnu.org \
--cc=zelphirkaltstahl@posteo.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).