Move thunk' from unstable/function' into `racket/function'.

Actually, the new `thunk' is a nullary function, which I think is very
popular expectation for the name.  Since there are possible uses for the
any-arity version, it's added too, as `thunk*'.
This commit is contained in:
Eli Barzilay 2011-06-06 12:41:34 -04:00
parent a70ef57f02
commit 17b6ffa731
5 changed files with 53 additions and 38 deletions

View File

@ -1,6 +1,8 @@
#lang scheme/base
#lang racket/base
(provide identity const negate curry curryr)
(require (for-syntax racket/base syntax/name))
(provide identity const thunk thunk* negate curry curryr)
(define (identity x) x)
@ -8,6 +10,23 @@
(define (const . _) c)
(make-keyword-procedure const const))
(define-syntax (thunk stx)
(syntax-case stx ()
[(_ body0 body ...) (syntax/loc stx (lambda () body0 body ...))]))
(define-syntax (thunk* stx)
(syntax-case stx ()
[(_ body0 body ...)
(with-syntax ([proc (syntax-property
(syntax/loc stx
;; optimize 0- and 1-argument cases
(case-lambda [() body0 body ...]
[(x) (th)] [xs (th)]))
'inferred-name (syntax-local-infer-name stx))])
(syntax/loc stx
(letrec ([th proc])
(make-keyword-procedure (lambda (_1 _2 . _3) (th)) proc))))]))
(define (negate f)
(unless (procedure? f) (raise-type-error 'negate "procedure" f))
(let-values ([(arity) (procedure-arity f)]

View File

@ -495,6 +495,25 @@ Returns a procedure that accepts any arguments and returns @scheme[v].
((const 'foo))
]}
@deftogether[(@defform[(thunk body ...+)]
@defform[(thunk* body ...+)])]{
@scheme[thunk] creates a nullary function that evaluates the given body.
@scheme[thunk*] is similar, except that the resulting function accepts
any number of inputs and keyword arguments.
@defexamples[
#:eval the-eval
(define th1 (thunk (define x 1) (printf "~a\n" x)))
(th1)
(th1 'x)
(th1 #:y 'z)
(define th2 (thunk* (define x 1) (printf "~a\n" x)))
(th2)
(th2 'x)
(th2 #:y 'z)
]}
@defproc[(negate [proc procedure?]) procedure?]{
Returns a procedure that is just like @scheme[proc], except that it

View File

@ -56,6 +56,19 @@
(test 'foo (const 'foo) 1)
(test 'foo (const 'foo) 1 2 3 4 5))
;; ---------- thunk ----------
(let ([th1 (thunk 'foo)] [th2 (thunk* 'bar)])
(test #t procedure? th1)
(test #t procedure? th2)
(test 0 procedure-arity th1)
(test (arity-at-least 0) procedure-arity th2)
(test 'foo th1)
(err/rt-test (th1 1))
(test 'bar th2)
(test 'bar th2 1)
(test 'bar th2 1 2 3)
(test 'bar th2 1 #:x 2 3 #:y 4 5))
;; ---------- negate ----------
(let ()
(define *not (negate not))

View File

@ -85,26 +85,6 @@
(let* ([name (case-lambda keyword-clause)]) name)
(let* ([name (case-lambda* positional-clause ...)]) name)))]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Degenerate Functions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax (thunk stx)
(syntax-case stx ()
[(thunk body ...)
(syntax/loc stx
(make-keyword-thunk (lambda () body ...)))]))
(define (make-keyword-thunk f)
(make-intermediate-procedure
'thunk-function
[(x ... 8) (f)]
[xs (f)]
#:keyword
[(ks vs . xs) (f)]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Higher-Order Boolean Operations
@ -363,7 +343,6 @@
(provide
;; functions
thunk
conjoin disjoin
curryn currynr papply papplyr call
;; macros

View File

@ -14,21 +14,6 @@ This module provides tools for higher-order programming and creating functions.
@section{Simple Functions}
@defform[(thunk body ...)]{
Creates a function that ignores its inputs and evaluates the given body. Useful
for creating event handlers with no (or irrelevant) arguments.
@defexamples[
#:eval the-eval
(define f (thunk (define x 1) (printf "~a\n" x)))
(f)
(f 'x)
(f #:y 'z)
]
}
@section{Higher Order Predicates}
@defproc[((negate [f (-> A ... boolean?)]) [x A] ...) boolean?]{