Navigation Menu

Skip to content

Instantly share code, notes, and snippets.

@greghendershott
Created November 9, 2012 23:54
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save greghendershott/4049108 to your computer and use it in GitHub Desktop.
Save greghendershott/4049108 to your computer and use it in GitHub Desktop.
A "term sheet" is a light-weight, more casual version of a contract. :)
#lang racket
;; A term sheet is a light-weight, casual version of a contract. :)
;;
;; Seriously, `define/termsheet' takes the same form as
;; `define/contract', but uses the contract predicates as simple
;; checks. As a result, this runs much faster -- e.g. ~200x faster --
;; than a normal, chaperoned wrapped procedure.
;;
;; In other words it gives the declarative convenience of
;; define/contract, but with the speed as if you wrote checks by hand.
(require (for-syntax racket/list
racket/syntax
syntax/parse)
racket/stxparam)
(provide lambda/termsheet
define/termsheet
termsheet-check)
(define-syntax-parameter any ;suppress error about `any' used outside `->'
(lambda (stx)
#'(lambda _ #t)))
(define enabled? #t) ;an actual `parameter' not needed, too slow
(define termsheet-check ;but `provide' a parameter-like function
(case-lambda
[() enabled?]
[(v) (set! enabled? v)]))
(define (contract->predicate c)
(cond [(flat-contract? c) (flat-contract-predicate c)]
[(chaperone-contract? c) procedure?] ;; downgrade to check for proc
[else (error 'contract->predicate "don't know about ~a" c)]))
;; If pred-stx looks like a procedure contract, i.e. (-> ...), then
;; replace arg-stx with a lamba/termsheet, i.e. like a chaperone.
(define-for-syntax (maybe-wrap arg-stx pred-stx)
(syntax-case pred-stx (->)
[(-> x ...)
(with-syntax ([(arg ...) (generate-temporaries
(map (lambda (x) (datum->syntax arg-stx x))
(drop-right (syntax->list #'(x ...)) 1)))]
[func arg-stx]
[id arg-stx])
#'(lambda/termsheet id
(arg ...)
(-> x ...)
(func arg ...)))]
[_ arg-stx]))
(define-for-syntax (ord-str n)
(let ([suffix (case n
[(1) "st"]
[(2) "nd"]
[(3) "rd"]
[else "th"])])
(format "~a~a" n suffix)))
(define-syntax (lambda/termsheet stx)
(syntax-parse stx
[(_ id:id (arg:id ...) ((~datum ->) pred:expr ...) body ...+)
(unless (= (add1 (length (syntax->list #'(arg ...))))
(length (syntax->list #'(pred ...))))
(raise-syntax-error 'define/termsheet
"must supply a predicate for each argument plus one for the return value"
stx
#'(-> pred ...)
))
(with-syntax* ([(arg-pred ...)
(map (lambda (x)
(datum->syntax stx x))
(drop-right (syntax->list #'(pred ...)) 1))]
[rtn-pred
(car (take-right (syntax->list #'(pred ...)) 1))]
[(arg-pred-id ...)
(generate-temporaries #'(arg-pred ...))]
[(wrapped-arg ...)
(map maybe-wrap
(syntax->list #'(arg ...))
(syntax->list #'(arg-pred ...)))]
[(nth ...)
(for/list ([a (syntax->list #'(arg ...))]
[n (in-naturals)])
(ord-str (add1 n)))])
#'(let ([arg-pred-id (contract->predicate arg-pred)] ...)
(lambda (arg ...)
(let ([arg wrapped-arg] ...)
(when enabled?
(unless (arg-pred-id arg)
(raise-argument-error 'id
(format "~a argument to be ~a"
nth
(quote arg-pred))
arg)) ...)
(let ([rtn (begin body ...)])
(cond [(or (not enabled?)
(rtn-pred rtn))
rtn]
[else
(error 'id
"return value\nexpected: ~a\nreturned: ~a"
(quote rtn-pred)
rtn)]))))))]))
(define-syntax (define/termsheet stx)
(syntax-parse stx
[(_ (id:id arg:id ...) ((~datum ->) pred:expr ...) body ...+)
#'(define id
(lambda/termsheet id
(arg ...)
(-> pred ...)
body ...))]))
;;;
;;; benchmark
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 1: Single arg, return any
;; Only simple predicate
(define (f/raw x)
#t)
(define (f/checked x)
(unless (exact-nonnegative-integer? x)
(raise-argument-error 'f/checked
"exact-positive-integer?"
x))
#t)
(define/contract (f/contracted x)
(exact-nonnegative-integer? . -> . any)
#t)
(define/termsheet (f/termsheet x)
(exact-nonnegative-integer? . -> . any)
#t)
(define-syntax-rule (bench func)
(begin
(display (object-name func)) (display ": ")
(time (for ([i (in-range 1000000)])
(func i)))
(void)))
(bench f/raw)
(bench f/checked)
(bench f/termsheet)
(bench f/contracted)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 2: Three args various types, return any.
;; Check includes predicate-creator, `or/c'
(define (f2/raw x y z)
#t)
(define f2/checked
(let ([or/c-number-string? (or/c number? string?)])
(lambda (x y z)
(unless (exact-positive-integer? x)
(raise-argument-error 'f2/checked
"exact-positive-integer?"
x))
(unless (string? y)
(raise-argument-error 'f2/checked
"string?"
y))
(unless (or/c-number-string? z)
(raise-argument-error 'f2/checked
"number? or string?"
y))
#t)))
(define/contract (f2/contracted x y z)
(exact-positive-integer? string? (or/c number? string?) . -> . any)
#t)
(define/termsheet (f2/termsheet x y z)
(exact-positive-integer? string? (or/c number? string?) . -> . any)
#t)
(define-syntax-rule (bench2 func)
(begin
(display (object-name func)) (display ": ")
(time (for ([i (in-range 1000000)])
(func 1 "foo" "bar")))
(void)))
(bench2 f2/raw)
(bench2 f2/checked)
(bench2 f2/termsheet)
(bench2 f2/contracted)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 3: Three args various types, return boolean?
;; Check includes predicate-creator, `or/c'
(define (f3/raw x y z)
#t)
(define f3/checked
(let ([or/c-number-string? (or/c number? string?)])
(lambda (x y z)
(unless (exact-positive-integer? x)
(raise-argument-error 'f3/checked
"exact-positive-integer?"
x))
(unless (string? y)
(raise-argument-error 'f3/checked
"string?"
y))
(unless (or/c-number-string? z)
(raise-argument-error 'f3/checked
"number? or string?"
y))
(boolean? #t)
#t)))
(define/contract (f3/contracted x y z)
(exact-positive-integer? string? (or/c number? string?) . -> . boolean?)
#t)
(define/termsheet (f3/termsheet x y z)
(exact-positive-integer? string? (or/c number? string?) . -> . boolean?)
#t)
(define-syntax-rule (bench3 func)
(begin
(display (object-name func)) (display ": ")
(time (for ([i (in-range 1000000)])
(func 1 "foo" "bar")))
(void)))
(bench3 f3/raw)
(bench3 f3/checked)
(bench3 f3/termsheet)
(bench2 f3/contracted)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Example 4
;; Procedure contract
(define (f4/raw a f)
(f a))
(define/termsheet (f4/termsheet a f)
(boolean? (boolean? . -> . boolean?) . -> . any)
(f a))
(define/contract (f4/contract a f)
(boolean? (boolean? . -> . boolean?) . -> . any)
(f a))
(define-syntax-rule (bench4 func)
(begin
(display (object-name func)) (display ": ")
(time (for ([i (in-range 1000000)])
(func #t (lambda (x) x))))
(void)))
(bench4 f4/raw)
(bench4 f4/termsheet)
(bench4 f4/contract)
@greghendershott
Copy link
Author

Example results:

f/raw: cpu time: 10 real time: 10 gc time: 0
f/checked: cpu time: 11 real time: 10 gc time: 0
f/termsheet: cpu time: 15 real time: 15 gc time: 0
f/contracted: cpu time: 9221 real time: 9264 gc time: 199

f2/raw: cpu time: 9 real time: 10 gc time: 0
f2/checked: cpu time: 153 real time: 153 gc time: 0
f2/termsheet: cpu time: 156 real time: 155 gc time: 0
f2/contracted: cpu time: 13226 real time: 13300 gc time: 326

f3/raw: cpu time: 10 real time: 10 gc time: 0
f3/checked: cpu time: 152 real time: 152 gc time: 0
f3/termsheet: cpu time: 157 real time: 157 gc time: 0
f3/contracted: cpu time: 13546 real time: 13628 gc time: 575

@greghendershott
Copy link
Author

Latest results:

f/raw: cpu time: 10 real time: 10 gc time: 0
f/checked: cpu time: 11 real time: 11 gc time: 0
f/termsheet: cpu time: 20 real time: 20 gc time: 0
f/contracted: cpu time: 9601 real time: 9640 gc time: 345

f2/raw: cpu time: 10 real time: 11 gc time: 0
f2/checked: cpu time: 156 real time: 155 gc time: 0
f2/termsheet: cpu time: 66 real time: 67 gc time: 0
f2/contracted: cpu time: 13816 real time: 13884 gc time: 555

f3/raw: cpu time: 12 real time: 12 gc time: 0
f3/checked: cpu time: 167 real time: 167 gc time: 0
f3/termsheet: cpu time: 59 real time: 59 gc time: 0
f3/contracted: cpu time: 14086 real time: 14143 gc time: 562

f4/raw: cpu time: 13 real time: 13 gc time: 0
f4/termsheet: cpu time: 750 real time: 752 gc time: 16
f4/contract: cpu time: 17793 real time: 17871 gc time: 710

@greghendershott
Copy link
Author

Re the new procedure contract handling: The macro wraps these in an additional lambda/termsheet. This is much faster than real chaperone. However it's quite slow. Another approach I tried was to transform all procedure contracts into a simple procedure? predicate, which is much faster. Granted this loses the deeper checking. However in my experience that's of limited value, especially if the procedure being called already has its own contract (or termsheet). It will check its own input args. At most, it would be useful to check only that the procedure returns something expected.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment