Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
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

This comment has been minimized.

Copy link
Owner Author

@greghendershott greghendershott commented Nov 12, 2012

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

This comment has been minimized.

Copy link
Owner Author

@greghendershott greghendershott commented Nov 13, 2012

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

This comment has been minimized.

Copy link
Owner Author

@greghendershott greghendershott commented Nov 13, 2012

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
You can’t perform that action at this time.