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.

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 provides define-checked with a different signature:
(define-checked (hello (who symbol?) . rest) ...)
with values-checked to validate return values.

Summary

Typechecks from define-typed provide a type boundary that can help the compiler optimize 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 these 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.

But keep in mind that this does not actually provide static program analysis like while-you-write type checks. It’s simply 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. It may be useful for your next API definition.

License: LGPLv3 or later.