Re: define-typed: checking values on proc entry and exit

[Dr. Arne Babenhauserheide]

Vivien Kraus <vivien@planete-kraus.eu> 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
Description: PGP signature