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:
parent
a70ef57f02
commit
17b6ffa731
|
@ -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)]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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?]{
|
||||
|
|
Loading…
Reference in New Issue
Block a user