define-typed: efficient typechecks for Guile Scheme

Wissen Software Politik Anderes Kreatives Rollenspiel

To add typechecks to Guile Scheme, you can use guile-define-typed which follows the format by sph-sc, a Scheme to C compiler. It declares types after the function definition like this:

(define (hello typed-world) (string? string?)
  typed-world)

That’s simple enough that a plain hygienic syntax-rule can support it.

The implementation in guile-define-typed and in this article additionally provides a version that marks the return type with ->, closer to the typical gradual typing options in other languages:

(define (hello typed-world) (string? -> string?)
  typed-world)

PDF (drucken)

Usage

Example 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)
;; =>((argument-types #<procedure string? (_)>)
;;    (return-type . #<procedure string? (_)>)
;;    (name . hello) (documentation . "typed") (props))
(hello "typed")
;; type error: return value ~a does not match ~a (1337) #<procedure string? (_)>

Optional and required keyword arguments:

(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

Multiple return values:

;; fixed return values
(define-typed
  (multiple-values/fixed num)
  ((number? number?) number?)
  (values (* 2 (abs num)) num))
(multiple-values/fixed -3)
;; => 6
;; => -3
;; check return values via procedure
(define-inlinable (all-numbers? args)
  (not (member #f (map number? args))))
(define-typed
  (multiple-values/proc num)
  ((all-numbers?) number?)
  (values (* 2 (abs num)) num))
(multiple-values/proc -3)
;; => 6
;; => -3
;; check return values via lambda
(define-typed
  (multiple-values/lambda num)
  (((λ(vals) (apply > vals))) number?)
  (values (* 2 (abs num)) num))
(multiple-values/lambda -3)
;; => 6
;; => -3

There are eight different ways to check (or not check) the return types:

;; check a single return value
(define-typed (magnitude x y) (float? float? float?) ...)

;; check all return values via procedure that receives them as list
(define-typed (magnitude x y) ((all-float?) float? float?) ...)

;; require a fixed number of return values (2)
(define-typed (magnitude x y) ((float? float?) float? float?) ...)

;; check a single return value with -> to mark the return type
(define-typed (magnitude x y) (float? float? -> float?) ...)

;; check all return values via procedure with -> to mark the return type
(define-typed (magnitude x y) (float? float? -> (all-float?)) ...)

;; require a fixed number of return values (2) with -> to mark the return types
(define-typed (magnitude x y) (float? float? -> (float? float?)) ...)

;; do not check return value(-s): #f as return type skips the check
(define-typed (magnitude x y) (#f float? float?) ...)

;; do not check return value(-s): leaving out the return type  skips the check
(define-typed (magnitude x y) (float? float?) ...)

Checking multiple return values has a negative impact on performance in the current implementation. Checking a single value or skipping the check does not have a significant impact.

Implementation

For performance reasons, the following defines define-typed and define-typed*, where define-typed* supports #:keyword arguments.

Big thanks to David Thompson and his article Optimizing Guile Scheme!

You can get this as package from hg.sr.ht/~arnebab/guile-define-typed.

(define-module (define-typed) #:export (define-typed* define-typed))

(import (srfi :11 let-values))

;; common procedures
(define-inlinable (takes-single-value? proc)
  (equal? '(1 0 #f) (procedure-minimum-arity proc)))

(define-inlinable (call-and-check-return-type proc ret?)
  (if ret? ;; #f means: do not check
      ;; get the result
      (let ((res (proc)))
        ;; typecheck the result
        (unless (ret? res)
          (error "type error: return value ~a does not match ~a"
                 res ret?))
        ;; return the result
        res)
      (proc)))

(define-inlinable
  (call-and-check-return-type/proc proc check-values)
  ;; get the result
  (let-values ((res (proc)))
    ;; typecheck the result
    (unless (check-values res)
      (error "type error: return values ~a do not match ~a"
             res check-values))
    ;; return the result
    (apply values res)))

(define-inlinable
  (call-and-check-return-type/multiple proc return-checkers)
  ;; get the result
  (let-values ((res (proc)))
    ;; typecheck the result
    (let loop ((check return-checkers) (r res))
      (when (pair? check)
        (unless ((car check) (car r))
          (error "type error: return values ~a do not match ~a"
                 res return-checkers))
        (loop (cdr check) (cdr r))))
    ;; return the result
    (apply values res)))

(define-inlinable (check-argument-and-type-count args types)
  (let loop ((a args) (t types))
    (unless (equal? (pair? a) (pair? t))
      ;; (when (and (pair? a) (not (pair? (cdr a))))
      ;; a is one element longer than t ⇒ no return type
      ;; TODO: move such a check ^ into a guard of a syntax rule.
      (error "argument error: number of arguments ~a and types ~a differs"
             args types))
    (when (pair? a)
      (loop (cdr a) (cdr t)))))

(define (add-properties! proc name from-proc ret? types)
  ;; add procedure properties via an inner procedure
  (set-procedure-properties! proc (procedure-properties from-proc))
  ;; record the types
  (set-procedure-property! proc 'return-type ret?)
  (set-procedure-property! proc 'argument-types types)
  ;; preserve the name
  (set-procedure-property! proc 'name name))


;; specific to define-typed
(define-syntax check-types
  (syntax-rules ()
    ((_ (type? types? ...) (argument arguments ...))
     (begin
       (unless (type? argument)
         (error "type error ~a ~a" type? argument))
       (check-types (types? ...) (arguments ...))))
    ((_ () ()) #f)))


(define-syntax-rule (define-typed/base procname
                      (args ...) (types ...)
                      ret-proc ret-values
                      def lamb check ;; define or define*, ...
                      body ...)
  (begin
    (define properties-helper (lamb (args ...) body ...))
    (def (procname args ...)
         ;; create a sub-procedure to run after typecheck
         (define (inner)
           body ...)
         ;; typecheck the arguments
         (check (types ...) (args ...))
         ;; get and check the result
         (ret-proc inner ret-values))
    (check-argument-and-type-count
     (quote (args ...)) (quote (types ...)))
    ;; add properties and return the inner procedure
    (add-properties! procname 'procname properties-helper
                     ret-values (list types ...))))

;; helper without keyword support
(define-syntax-rule (define-typed/helper procname
                      (args ...) (types ...)
                      ret-proc ret-values
                      body ...)
  (define-typed/base procname
    (args ...) (types ...)
    ret-proc ret-values
    define lambda check-types ;; without keywords
    body ...))

;; helper to distinguish between first type being ret? and first type
;; being first argument
(define-syntax define-typed/compat
  (syntax-rules (copied-> reversed->)
    ((_ helper (procname copied-> a ... reversed-> ())
        (ret? copied-> t ... reversed-> ())
        body ...)
     (helper procname (a ...) (t ...)
       call-and-check-return-type
       ret?
       body ...))
    ;; transfer one argument and type each from reversed to copied; if
    ;; len args = len types, ret? is a return type check
    ((_ helper (procname copied-> a ... reversed-> (aa aa* ...))
        (ret? copied-> t ... reversed-> (tt tt* ...))
        body ...)
     (define-typed/compat helper (procname copied-> aa a ... reversed-> (aa* ...))
       (ret? copied-> tt t ... reversed-> (tt* ...))
        body ...))
    ;; one type less than arguments: ret? is a type check FIXME:
    ;; infinite loop?
    ((_ helper (procname copied-> a ... reversed-> (aa))
        (ret? copied-> t ... reversed-> ())
        body ...)
     (define-typed/compat helper (procname copied-> aa a ... reversed-> ())
       (#f copied-> ret? t ... reversed-> ())
        body ...))
    ;; re-reverse arguments into copied-> to be able to add ret? as
    ;; the last type if needed
    ((_ helper (procname copied-> a ... reversed-> (aa aa* ...))
        (ret? copied-> t ... reversed-> (tt tt* ...))
        body ...)
     (define-typed/compat helper (procname copied-> aa a ... reversed-> (aa* ...))
       (ret? copied-> tt t ... reversed-> (tt* ...))
        body ...))
    ;; reverse all arguments into reversed-> (treat arguments and
    ;; types separately because the number may be different)
    ((_ helper (procname a args ... copied-> reversed-> (aa* ...))
        (ret? types ... copied-> reversed-> (tt* ...))
        body ...)
     (define-typed/compat helper (procname args ... copied-> reversed-> (a aa* ...))
       (ret? types ... copied-> reversed-> (tt* ...))
        body ...))
    ((_ helper (procname args ... copied-> reversed-> (aa* ...))
        (ret? t types ... copied-> reversed-> (tt* ...))
        body ...)
     (define-typed/compat helper (procname args ... copied-> reversed-> (aa* ...))
       (ret? types ... copied-> reversed-> (t tt* ...))
        body ...))
    ;; entry point for multiple arguments: first start reversing the arguments
    ((_ helper (procname a args ...)
        (ret? t types ...)
        body ...)
     (define-typed/compat helper (procname args ... copied-> reversed-> (a))
       (ret? types ... copied-> reversed-> (t))
        body ...))
    ;; shortcut: ret? is #f
    ((_ helper (procname args ...) (#f types ...)
        body ...)
     (define-typed/compat helper (procname copied-> args ... reversed-> ())
       (#f copied-> types ... reversed-> ())
        body ...))
    ;; shortcut: one argument, no type: ret? is a type check
    ((_ helper (procname a)
        (ret?)
        body ...)
     (define-typed/compat helper (procname copied-> a reversed-> ())
       (#f copied-> ret? reversed-> ())
        body ...))
    ;; neither types nor arguments: ret? is the return type.
    ((_ helper (procname) (ret?)
        body ...)
     (define-typed/compat helper (procname copied-> reversed-> ())
       (ret? copied-> reversed-> ())
        body ...))))



;; Define a procedure with typechecks.
(define-syntax define-typed
  (syntax-rules (->)
    ;; syntax with -> ret
    ;; single -> checker: check all returned values via procedure
    ((_ (procname args ...)
        (types ... -> (ret?))
        body ...)
     (define-typed (procname args ...)
       ((ret?) types ...)
        body ...))
    ;; two or more return checkers: one per value (fixed number of
    ;; return values!)
    ((_ (procname args ...)
        (types ... -> (ret1? ret2* ret*? ...))
        body ...)
     (define-typed (procname args ...)
       ((ret1? ret2* ret*? ...) types ...)
       body ...))
    ;; alternate single return value syntax with -> ret
    ((_ (procname args ...)
        (types ... -> ret?)
        body ...)
     (define-typed/helper procname (args ...)
       (types ...)
       call-and-check-return-type
       ret?
       body ...))
    ;; single checker: check all returned values via procedure
    ((_ (procname args ...)
        ((ret?) types ...)
        body ...)
     (define-typed/helper procname (args ...)
       (types ...)
       call-and-check-return-type/proc
       ret?
       body ...))
    ;; two or more return checkers: one per value (fixed number of
    ;; return values!)
    ((_ (procname args ...)
        ((ret1? ret2* ret*? ...) types ...)
        body ...)
     (begin
       (define return-checkers (list ret1? ret2* ret*? ...))
       (define-typed/helper procname (args ...)
         (types ...)
         call-and-check-return-type/multiple
         return-checkers
         body ...)))
    ;; alternate single return syntax with -> ret
    ((_ (procname args ...)
        (types ... -> ret?)
        body ...)
     (define-typed/helper procname (args ...)
       (types ...)
       call-and-check-return-type
       ret?
       body ...))
    ;; single return checker: only check one value, further values are
    ;; discarded except if ret? is #f: then do not check, keep all
    ;; values
    ;; Compat for return type delimited by ->: if there is one arg
    ;; more than types, then ret? is treated as type.
    ((_ (procname args ...) (ret? types ...)
        body ...)
     (define-typed/compat define-typed/helper (procname args ...)
       (ret? types ...)
       body ...))))



;; specific to define-typed*
(define-syntax check-types*
  (syntax-rules ()
    ((_ (type? types? ...) (argument arguments ...))
     (begin
       (if (and (keyword? type?)
                (keyword? argument))
           (unless (equal? type? argument)
             (error "Keywords in arguments and types differ ~a ~a"
                    type? argument))
           (unless (type? argument)
             (error "type error ~a ~a" type? argument)))
       (check-types* (types? ...) (arguments ...))))
    ((_ () ()) #f)))


;; helper with keyword support
(define-syntax-rule (define-typed*/helper procname
                      (args ...) (types ...)
                      ret-proc ret-values
                      body ...)
  (define-typed/base procname
    (args ...) (types ...)
    ret-proc ret-values
    define* lambda* check-types* ;; with keywords
    body ...))

;; Define a procedure with typecheck, taking keywords into acount like
;; define*.
(define-syntax define-typed*
  (syntax-rules (->)
    ;; syntax with -> ret
    ;; single -> checker: check all returned values via procedure
    ((_ (procname args ...) (types ... -> (ret?))
        body ...)
     (define-typed* (procname args ...) ((ret?) types ...)
        body ...))
    ;; two or more return checkers: one per value (fixed number of
    ;; return values!)
    ((_ (procname args ...) (types ... -> (ret1? ret2* ret*? ...))
        body ...)
     (define-typed* (procname args ...) ((ret1? ret2* ret*? ...) types ...)
       body ...))
    ;; alternate single return value syntax with -> ret
    ((_ (procname args ...) (types ... -> ret?)
        body ...)
     (define-typed*/helper procname (args ...) (types ...)
       call-and-check-return-type
       ret?
       body ...))
    ;; single checker: check all returned values via procedure
    ((_ (procname args ...) ((ret?) types ...)
        body ...)
     (define-typed*/helper procname (args ...) (types ...)
       call-and-check-return-type/proc
       ret?
       body ...))
    ;; two or more return checkers: one per value (fixed number of
    ;; return values!)
    ((_ (procname args ...) ((ret1? ret2* ret*? ...) types ...)
        body ...)
     (begin
       (define return-checkers (list ret1? ret2* ret*? ...))
       (define-typed*/helper procname (args ...) (types ...)
         call-and-check-return-type/multiple
         return-checkers
         body ...)))
    ;; single return checker: only check one value, further values are
    ;; discarded except if ret? is #f: then do not check, keep all
    ;; values
    ((_ (procname args ...) (ret? types ...)
        body ...)
     (define-typed/compat define-typed*/helper (procname args ...)
       (ret? types ...)
       body ...))))

This supports most features of regular define like docstrings, procedure properties, multiple values (thanks to Vivien!), and so forth.

define-typed* also supports keyword-arguments (thanks to Zelphir Kaltstahl’s contracts), but is slower.

Benchmark

define-typed automates some of the guards of Optimizing Guile Scheme, so the compiler can optimize more (i.e. if you check for real?) but keep in mind that these checks are not free: use typechecks outside tight loops, except where they provably provide an improvement.

#!/usr/bin/env bash
exec guile -L . "$0"
; !#
(import (define-typed) (statprof))

(define-inlinable (float? x)
  (and (real? x) (inexact? x)))
(define-inlinable (all-float? args)
  (not (member #f (map float? args))))

(define (magnitude x y) (sqrt (+ (* x x) (* y y))))
(define (magnitude-handtyped x y)
  (unless (and (float? x) (float? y))
    (error "expected floats" x y))
  (sqrt (+ (* x x) (* y y))))

(define-typed
  (magnitude-typed/no-return-check x y)
  (#f float? float?)
  (sqrt (+ (* x x) (* y y))))

(define-typed
  (magnitude-typed/no-return-check-by-missing-type x y)
  (float? float?)
  (sqrt (+ (* x x) (* y y))))

(define-typed
  (magnitude-typed/return x y)
  (float? float? float?)
  (sqrt (+ (* x x) (* y y))))

(define-typed
  (magnitude-typed/return-multiple x y)
  ((float? float?) float? float?)
  (values 1.0 (sqrt (+ (* x x) (* y y)))))

(define-typed
  (magnitude-typed/return-proc x y)
  ((all-float?) float? float?)
  (values 1.0 (sqrt (+ (* x x) (* y y)))))

(define-typed
  (magnitude-typed/return-lambda x y)
  (((λ (vals) (apply > vals))) number? number?)
  (values (sqrt (+ (* x x) (* y y))) x))

(define-typed
  (magnitude-typed/return-> x y)
  (float? float? -> float?)
  (sqrt (+ (* x x) (* y y))))

(define-typed
  (magnitude-typed/return-multiple-> x y)
  (float? float? -> (float? float?))
  (values 1.0 (sqrt (+ (* x x) (* y y)))))

(define-typed
  (magnitude-typed/return-proc-> x y)
  (float? float? -> (all-float?))
  (values 1.0 (sqrt (+ (* x x) (* y y)))))

(define-typed
  (magnitude-typed/return-lambda-> x y)
  (number? number? -> ((λ (vals) (apply > vals))))
  (values (sqrt (+ (* x x) (* y y))) x))

(define-typed*
  (magnitude-typed*/no-return-check x y #:key foo)
  (#f float? float? #:key not)
  (sqrt (+ (* x x) (* y y))))

(define-typed*
  (magnitude-typed*/no-return-check-by-missing-type x y #:key foo)
  (float? float? #:key not)
  (sqrt (+ (* x x) (* y y))))

(define-typed*
  (magnitude-typed*/return x y #:key foo)
  (float? float? float? #:key not)
  (sqrt (+ (* x x) (* y y))))

(define-typed*
  (magnitude-typed*/return-multiple x y #:key foo)
  ((float? float?) float? float? #:key not)
  (values 1.0 (sqrt (+ (* x x) (* y y)))))

(define-typed*
  (magnitude-typed*/return-proc x y #:key foo)
  ((all-float?) float? float? #:key not)
  (values 1.0 (sqrt (+ (* x x) (* y y)))))

(define-typed*
  (magnitude-typed*/return-> x y #:key foo)
  (float? float? #:key not -> float?)
  (sqrt (+ (* x x) (* y y))))

(define-typed*
  (magnitude-typed*/return-multiple-> x y #:key foo)
  (float? float? #:key not -> (float? float?))
  (values 1.0 (sqrt (+ (* x x) (* y y)))))

(define-typed*
  (magnitude-typed*/return-proc-> x y #:key foo)
  (float? float? #:key not -> (all-float?))
  (values 1.0 (sqrt (+ (* x x) (* y y)))))

(define-typed*
  (magnitude-typed*/return-lambda-> x y)
  (number? number? -> ((λ (vals) (apply > vals))))
  (values (sqrt (+ (* x x) (* y y))) x))

(define (benchmark proc)
  (display proc)(newline)
  (statprof
    (λ _
      (let lp ((i 0))
        (when (< i 20000000)
          (proc 3.0 4.0)
          (lp (+ i 1)))))))

(for-each benchmark
  (list
    magnitude
    magnitude-handtyped
    magnitude-typed/no-return-check
    magnitude-typed/no-return-check-by-missing-type
    magnitude-typed/return
    magnitude-typed/return-multiple
    magnitude-typed/return-proc
    magnitude-typed/return-lambda
    magnitude-typed/return->
    magnitude-typed/return-multiple->
    magnitude-typed/return-proc->
    magnitude-typed/return-lambda->
    magnitude-typed*/no-return-check
    magnitude-typed*/no-return-check-by-missing-type
    magnitude-typed*/return
    magnitude-typed*/return-multiple
    magnitude-typed*/return-proc
    magnitude-typed*/return->
    magnitude-typed*/return-multiple->
    magnitude-typed*/return-proc->))

Results:

#<procedure magnitude (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
 98.15      2.70      2.70  <current input>:8:0:magnitude
  1.85      2.75      0.05  <current input>:112:4
---
Sample count: 54
Total time: 2.754742566 seconds (2.434051541 seconds in GC)
#<procedure magnitude-handtyped (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
100.00      0.77      0.77  <current input>:9:0:magnitude-handtyped
  0.00      0.77      0.00  <current input>:112:4
---
Sample count: 22
Total time: 0.768693247 seconds (0.610164412 seconds in GC)
#<procedure magnitude-typed/no-return-check (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
100.00      0.76      0.76  <current input>:14:0:magnitude-typed/no-return-check
  0.00      0.76      0.00  <current input>:112:4
---
Sample count: 22
Total time: 0.757842337 seconds (0.598824347 seconds in GC)
#<procedure magnitude-typed/no-return-check-by-missing-type (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
100.00      0.78      0.78  <current input>:19:0:magnitude-typed/no-return-check-by-missing-type
  0.00      0.78      0.00  <current input>:112:4
---
Sample count: 23
Total time: 0.781806219 seconds (0.621609544 seconds in GC)
#<procedure magnitude-typed/return (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
100.00      0.90      0.90  <current input>:24:0:magnitude-typed/return
  0.00      0.90      0.00  <current input>:112:4
---
Sample count: 26
Total time: 0.897591341 seconds (0.626036994 seconds in GC)
#<procedure magnitude-typed/return-multiple (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
 51.47      1.56      1.18  <current input>:29:0:magnitude-typed/return-multiple
 32.35      2.30      0.74  <current input>:112:4
 14.71      0.34      0.34  <current input>:3:0:#{% float?-procedure}#
  1.47      0.03      0.03  %after-gc-thunk
  0.00      0.03      0.00  anon #x1c9b9070
---
Sample count: 68
Total time: 2.302047137 seconds (1.724137942 seconds in GC)
#<procedure magnitude-typed/return-proc (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
 25.60      3.59      1.07  <current input>:34:0:magnitude-typed/return-proc
 20.80      2.45      0.87  <current input>:5:0:#{% all-float?-procedure}#
 16.80      1.58      0.70  ice-9/boot-9.scm:236:5:map1
 14.40      4.19      0.60  <current input>:112:4
  9.60      0.60      0.40  ice-9/boot-9.scm:231:2:map
  6.40      0.27      0.27  <current input>:3:0:#{% float?-procedure}#
  4.80      0.20      0.20  list?
  1.60      0.07      0.07  %after-gc-thunk
  0.00      0.07      0.00  anon #x1c9b9070
---
Sample count: 125
Total time: 4.192126038 seconds (2.944465984 seconds in GC)
#<procedure magnitude-typed/return-lambda (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
 50.91      2.96      1.93  <current input>:39:0:magnitude-typed/return-lambda
 22.73      0.86      0.86  >
 21.82      3.78      0.83  <current input>:112:4
  4.55      0.17      0.17  %after-gc-thunk
  0.00      0.17      0.00  anon #x1c9b9070
---
Sample count: 110
Total time: 3.784803797 seconds (2.949967398 seconds in GC)
#<procedure magnitude-typed/return-> (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
 91.67      0.68      0.62  <current input>:44:0:magnitude-typed/return->
  4.17      0.03      0.03  %after-gc-thunk
  4.17      0.03      0.03  <current input>:3:0:#{% float?-procedure}#
  0.00      0.68      0.00  <current input>:112:4
  0.00      0.03      0.00  anon #x1c9b9070
---
Sample count: 24
Total time: 0.680940325 seconds (0.399746506 seconds in GC)
#<procedure magnitude-typed/return-multiple-> (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
 58.73      1.12      1.01  <current input>:49:0:magnitude-typed/return-multiple->
 34.92      1.72      0.60  <current input>:112:4
  6.35      0.11      0.11  <current input>:3:0:#{% float?-procedure}#
---
Sample count: 63
Total time: 1.718973114 seconds (1.144199812 seconds in GC)
#<procedure magnitude-typed/return-proc-> (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
 23.44      3.42      0.91  <current input>:54:0:magnitude-typed/return-proc->
 18.75      2.45      0.73  <current input>:5:0:#{% all-float?-procedure}#
 17.19      1.84      0.66  ice-9/boot-9.scm:236:5:map1
 11.72      3.87      0.45  <current input>:112:4
 10.16      0.39      0.39  <current input>:3:0:#{% float?-procedure}#
  9.38      0.66      0.36  ice-9/boot-9.scm:231:2:map
  7.81      0.30      0.30  list?
  1.56      0.06      0.06  %after-gc-thunk
  0.00      0.06      0.00  anon #x1c9b9070
---
Sample count: 128
Total time: 3.868986212 seconds (2.639325688 seconds in GC)
#<procedure magnitude-typed/return-lambda-> (x y)>
%     cumulative   self             
time   seconds     seconds  procedure
 54.10      3.12      2.34  <current input>:59:0:magnitude-typed/return-lambda->
 27.87      4.32      1.20  <current input>:112:4
 18.03      0.78      0.78  >
---
Sample count: 122
Total time: 4.321639667 seconds (3.454352861 seconds in GC)
#<procedure magnitude-typed*/no-return-check (x y #:key foo)>
%     cumulative   self             
time   seconds     seconds  procedure
 95.59      2.84      2.76  <current input>:64:0:magnitude-typed*/no-return-check
  2.94      0.08      0.08  %after-gc-thunk
  1.47      2.88      0.04  <current input>:112:4
  0.00      0.08      0.00  anon #x1c9b9070
---
Sample count: 68
Total time: 2.882801783 seconds (2.445546006 seconds in GC)
#<procedure magnitude-typed*/no-return-check-by-missing-type (x y #:key foo)>
%     cumulative   self             
time   seconds     seconds  procedure
 93.85      2.81      2.67  <current input>:69:0:magnitude-typed*/no-return-check-by-missing-type
  4.62      0.13      0.13  %after-gc-thunk
  1.54      2.85      0.04  <current input>:112:4
  0.00      0.13      0.00  anon #x1c9b9070
---
Sample count: 65
Total time: 2.849856971 seconds (2.399153375 seconds in GC)
#<procedure magnitude-typed*/return (x y #:key foo)>
%     cumulative   self             
time   seconds     seconds  procedure
 86.08      2.89      2.62  <current input>:74:0:magnitude-typed*/return
  5.06      3.05      0.15  <current input>:112:4
  5.06      0.15      0.15  <current input>:3:0:#{% float?-procedure}#
  3.80      0.12      0.12  %after-gc-thunk
  0.00      0.12      0.00  anon #x1c9b9070
---
Sample count: 79
Total time: 3.046113625 seconds (2.48964774 seconds in GC)
#<procedure magnitude-typed*/return-multiple (x y #:key foo)>
%     cumulative   self             
time   seconds     seconds  procedure
 63.56      3.28      2.79  <current input>:79:0:magnitude-typed*/return-multiple
 25.42      4.39      1.12  <current input>:112:4
 10.17      0.45      0.45  <current input>:3:0:#{% float?-procedure}#
  0.85      0.04      0.04  %after-gc-thunk
  0.00      0.04      0.00  anon #x1c9b9070
---
Sample count: 118
Total time: 4.393898983 seconds (3.502124434 seconds in GC)
#<procedure magnitude-typed*/return-proc (x y #:key foo)>
%     cumulative   self             
time   seconds     seconds  procedure
 37.78      5.58      2.34  <current input>:84:0:magnitude-typed*/return-proc
 15.00      2.51      0.93  ice-9/boot-9.scm:236:5:map1
 13.89      3.06      0.86  <current input>:5:0:#{% all-float?-procedure}#
 11.67      0.72      0.72  <current input>:3:0:#{% float?-procedure}#
 10.00      6.20      0.62  <current input>:112:4
  6.67      0.52      0.41  ice-9/boot-9.scm:231:2:map
  2.78      0.17      0.17  %after-gc-thunk
  1.67      0.10      0.10  list?
  0.56      0.03      0.03  member
  0.00      0.17      0.00  anon #x1c9b9070
---
Sample count: 180
Total time: 6.195123834 seconds (4.711574272 seconds in GC)
#<procedure magnitude-typed*/return-> (x y #:key foo)>
%     cumulative   self             
time   seconds     seconds  procedure
 91.03      2.92      2.73  <current input>:89:0:magnitude-typed*/return->
  5.13      0.15      0.15  %after-gc-thunk
  2.56      3.00      0.08  <current input>:112:4
  1.28      0.04      0.04  <current input>:3:0:#{% float?-procedure}#
  0.00      0.15      0.00  anon #x1c9b9070
---
Sample count: 78
Total time: 2.999101112 seconds (2.470859466 seconds in GC)
#<procedure magnitude-typed*/return-multiple-> (x y #:key foo)>
%     cumulative   self             
time   seconds     seconds  procedure
 64.17      3.51      2.78  <current input>:94:0:magnitude-typed*/return-multiple->
 19.17      4.34      0.83  <current input>:112:4
 15.00      0.65      0.65  <current input>:3:0:#{% float?-procedure}#
  1.67      0.07      0.07  %after-gc-thunk
  0.00      0.07      0.00  anon #x1c9b9070
---
Sample count: 120
Total time: 4.338945054 seconds (3.487095436 seconds in GC)
#<procedure magnitude-typed*/return-proc-> (x y #:key foo)>
%     cumulative   self             
time   seconds     seconds  procedure
 35.63      5.11      2.19  <current input>:99:0:magnitude-typed*/return-proc->
 16.67      6.13      1.02  <current input>:112:4
 16.09      2.89      0.99  <current input>:5:0:#{% all-float?-procedure}#
 14.94      2.19      0.92  ice-9/boot-9.scm:236:5:map1
  7.47      0.60      0.46  ice-9/boot-9.scm:231:2:map
  5.17      0.32      0.32  <current input>:3:0:#{% float?-procedure}#
  2.30      0.14      0.14  list?
  1.15      0.07      0.07  member
  0.57      0.04      0.04  %after-gc-thunk
  0.00      0.04      0.00  anon #x1c9b9070
---
Sample count: 174
Total time: 6.132436593 seconds (4.58668115 seconds in GC)

define-typed reaches the performance of the hand-optimized procedure magnitude-handtyped while define-typed* is as fast as an untyped procedure in this case where constraining types provides a big benefit.

Alternatives

SRFI 253: define-checked

SRFI 253 provides define-checked with a different signature:

(define-checked (hello (who symbol?) . rest) ...)

along with with the helper function values-checked to validate return values.

It was submitted three months after I presented define-typed in guile-user, but I was not part of the discussions about SRFI 253 and didn’t have time to dig into it when the SRFI announcement came in.

I personally prefer the define-typed approach (though define-checked is the better name), because that keeps the main procedure definition shorter.

I’m personally also no fan of putting annotations directly on the arguments of functions, because those tend to become OveryLongVerySpecificDeclarations that make the function header harder to read for me.

I’ve seen that happen in Python and Typescript by now.

And I prefer that define-typed has the return type at the top of the procedure, similar to guile-doctests: A quick glance at the first few lines shows the contract of the procedure.

That said: if your procedure has many arguments (when you usually won’t treat the definition header as a single line to read anyway) the SRFI 253 approach should scale better, because then you’ll write one argument with its type per line. define-typed becomes less elegant at 5 arguments, when matching types to argument becomes harder and the the argument list plus the type declaration likely breaks the 72 letter width, and unwieldy at about 9 arguments, when the types alone are likely longer than 72 letters. But procedures with 9 or more parameters are commonly seen as code smell, so they should be rare.

Summary

Typechecks from define-typed provide a type boundary that can help the compiler optimize. It adds runtime guarantees instead of compile-time checked static typing.

You can do more advanced checks by providing your own test procedures and validating your API elegantly, but complex checks may not help the compiler produce faster code.

define-typed: a static type syntax-rules macro for Guile to create API contracts and help the JIT compiler create more optimized code.

You can use the procedure-properties to get the defined types at runtime, so by connecting a REPL to your editor, you can check your code at edit-time (instead of only at runtime) by applying the type checking procedures against the arguments you use, but that’s not implemented in any editor yet.

Keep in mind that define-typed is not static program analysis at compile time. It’s syntactic sugar for a boundary through which only allowed values can pass. Thanks to program flow analysis by the just-in-time compiler, it can make your code faster, but that’s not guaranteed.

That said: define-typed may be useful for your next API definition.

License: LGPLv3 or later.