pruned unstable/function
This commit is contained in:
Ryan Culpepper
parent
e4e89b0bc9
commit
bc7401d4d9
|
|
@ -2,21 +2,9 @@
|
|||
(require rackunit rackunit/text-ui unstable/function
|
||||
"helpers.rkt")
|
||||
|
||||
(define list/kw (make-keyword-procedure list))
|
||||
|
||||
(run-tests
|
||||
(test-suite "function.rkt"
|
||||
|
||||
(test-suite "Simple Functions"
|
||||
|
||||
(test-suite "thunk"
|
||||
(test-case "unique symbol"
|
||||
(let* ([count 0]
|
||||
[f (thunk (set! count (+ count 1)) count)])
|
||||
(check = count 0)
|
||||
(check = (f) 1)
|
||||
(check = count 1)))))
|
||||
|
||||
(test-suite "Higher Order Predicates"
|
||||
|
||||
(test-suite "conjoin"
|
||||
|
|
@ -38,96 +26,4 @@
|
|||
(check-true ((disjoin integer? exact?) 1/2)))
|
||||
(test-case "false"
|
||||
(check-false ((disjoin integer? exact?) 0.5)))))
|
||||
|
||||
(test-suite "Currying and (Partial) Application"
|
||||
|
||||
(test-suite "call"
|
||||
(test-case "string-append"
|
||||
(check-equal? (call string-append "a" "b" "c") "abc")))
|
||||
|
||||
(test-suite "papply"
|
||||
(test-case "list"
|
||||
(check-equal? ((papply list 1 2) 3 4) (list 1 2 3 4)))
|
||||
(test-case "sort"
|
||||
(check-equal?
|
||||
((papply sort '((1 a) (4 d) (2 b) (3 c)) #:cache-keys? #f)
|
||||
< #:key car)
|
||||
'((1 a) (2 b) (3 c) (4 d)))))
|
||||
|
||||
(test-suite "papplyr"
|
||||
(test-case "list"
|
||||
(check-equal? ((papplyr list 1 2) 3 4) (list 3 4 1 2)))
|
||||
(test-case "sort"
|
||||
(check-equal?
|
||||
((papplyr sort < #:key car)
|
||||
'((1 a) (4 d) (2 b) (3 c)) #:cache-keys? #f)
|
||||
'((1 a) (2 b) (3 c) (4 d)))))
|
||||
|
||||
(test-suite "curryn"
|
||||
(test-case "1"
|
||||
(check-equal? (curryn 0 list/kw 1) '(() () 1)))
|
||||
(test-case "1 / 2"
|
||||
(check-equal? ((curryn 1 list/kw 1) 2) '(() () 1 2)))
|
||||
(test-case "1 / 2 / 3"
|
||||
(check-equal? (((curryn 2 list/kw 1) 2) 3) '(() () 1 2 3)))
|
||||
(test-case "1 a"
|
||||
(check-equal? (curryn 0 list/kw 1 #:a "a")
|
||||
'((#:a) ("a") 1)))
|
||||
(test-case "1 a / 2 b"
|
||||
(check-equal? ((curryn 1 list/kw 1 #:a "a") 2 #:b "b")
|
||||
'((#:a #:b) ("a" "b") 1 2)))
|
||||
(test-case "1 a / 2 b / 3 c"
|
||||
(check-equal? (((curryn 2 list/kw 1 #:a "a") 2 #:b "b") 3 #:c "c")
|
||||
'((#:a #:b #:c) ("a" "b" "c") 1 2 3))))
|
||||
|
||||
(test-suite "currynr"
|
||||
(test-case "1"
|
||||
(check-equal? (currynr 0 list/kw 1) '(() () 1)))
|
||||
(test-case "1 / 2"
|
||||
(check-equal? ((currynr 1 list/kw 1) 2) '(() () 2 1)))
|
||||
(test-case "1 / 2 / 3"
|
||||
(check-equal? (((currynr 2 list/kw 1) 2) 3) '(() () 3 2 1)))
|
||||
(test-case "1 a"
|
||||
(check-equal? (currynr 0 list/kw 1 #:a "a")
|
||||
'((#:a) ("a") 1)))
|
||||
(test-case "1 a / 2 b"
|
||||
(check-equal? ((currynr 1 list/kw 1 #:a "a") 2 #:b "b")
|
||||
'((#:a #:b) ("a" "b") 2 1)))
|
||||
(test-case "1 a / 2 b / 3 c"
|
||||
(check-equal? (((currynr 2 list/kw 1 #:a "a") 2 #:b "b") 3 #:c "c")
|
||||
'((#:a #:b #:c) ("a" "b" "c") 3 2 1)))))
|
||||
|
||||
(test-suite "Eta Expansion"
|
||||
(test-suite "eta"
|
||||
(test-ok (define f (eta g))
|
||||
(define g add1)
|
||||
(check-equal? (f 1) 2)))
|
||||
(test-suite "eta*"
|
||||
(test-ok (define f (eta* g x))
|
||||
(define g add1)
|
||||
(check-equal? (f 1) 2))
|
||||
(test-bad (define f (eta* g x))
|
||||
(define g list)
|
||||
(f 1 2))))
|
||||
|
||||
(test-suite "Parameter Arguments"
|
||||
|
||||
(test-suite "lambda/parameter"
|
||||
(test-case "provided"
|
||||
(let* ([p (make-parameter 0)])
|
||||
(check = ((lambda/parameter ([x #:param p]) x) 1) 1)))
|
||||
(test-case "not provided"
|
||||
(let* ([p (make-parameter 0)])
|
||||
(check = ((lambda/parameter ([x #:param p]) x)) 0)))
|
||||
(test-case "argument order / provided"
|
||||
(let* ([p (make-parameter 3)])
|
||||
(check-equal? ((lambda/parameter (x [y 2] [z #:param p])
|
||||
(list x y z))
|
||||
4 5 6)
|
||||
(list 4 5 6))))
|
||||
(test-case "argument order / not provided"
|
||||
(let* ([p (make-parameter 3)])
|
||||
(check-equal? ((lambda/parameter (x [y 2] [z #:param p])
|
||||
(list x y z))
|
||||
1)
|
||||
(list 1 2 3))))))))
|
||||
))
|
||||
|
|
|
|||
|
|
@ -1,12 +1,65 @@
|
|||
#lang racket/base
|
||||
(require racket/match
|
||||
(for-syntax racket/base racket/list))
|
||||
(provide conjoin
|
||||
disjoin)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; HIGHER ORDER TOOLS
|
||||
;; Higher-Order Boolean Operations
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; ryanc: adjusted limit of inner cases from 8 to 2
|
||||
;; All uses so far seem to be predicates, so more cases seem
|
||||
;; unnecessary. Also, all uses so far are first-order, so
|
||||
;; outer case-lambda* might be better replaced with macro.
|
||||
|
||||
(define conjoin
|
||||
(case-lambda*
|
||||
[(f ... 8)
|
||||
(make-intermediate-procedure
|
||||
'conjoined
|
||||
[(x (... ...) 2) (and (f x (... ...)) ...)]
|
||||
[xs (and (apply f xs) ...)]
|
||||
#:keyword
|
||||
[(keys vals . args)
|
||||
(and (keyword-apply f keys vals args) ...)])]
|
||||
[fs
|
||||
(make-intermediate-procedure
|
||||
'conjoined
|
||||
[(x ... 2) (andmap (lambda (f) (f x ...)) fs)]
|
||||
[xs (andmap (lambda (f) (apply f xs)) fs)]
|
||||
#:keyword
|
||||
[(keys vals . args)
|
||||
(andmap (lambda (f) (keyword-apply f keys vals args)) fs)])]))
|
||||
|
||||
(define disjoin
|
||||
(case-lambda*
|
||||
[(f ... 8)
|
||||
(make-intermediate-procedure
|
||||
'disjoined
|
||||
[(x (... ...) 2) (or (f x (... ...)) ...)]
|
||||
[xs (or (apply f xs) ...)]
|
||||
#:keyword
|
||||
[(keys vals . args)
|
||||
(or (keyword-apply f keys vals args) ...)])]
|
||||
[fs
|
||||
(make-intermediate-procedure
|
||||
'disjoined
|
||||
[(x ... 2) (ormap (lambda (f) (f x ...)) fs)]
|
||||
[xs (ormap (lambda (f) (apply f xs)) fs)]
|
||||
#:keyword
|
||||
[(keys vals . args)
|
||||
(ormap (lambda (f) (keyword-apply f keys vals args)) fs)])]))
|
||||
|
||||
(define-syntax (make-intermediate-procedure stx)
|
||||
(syntax-case stx [quote]
|
||||
[(_ (quote name) positional-clause ... #:keyword keyword-clause)
|
||||
(syntax/loc stx
|
||||
(make-keyword-procedure
|
||||
(let* ([name (case-lambda keyword-clause)]) name)
|
||||
(let* ([name (case-lambda* positional-clause ...)]) name)))]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
|
|
@ -76,275 +129,3 @@
|
|||
(syntax->list #'(body ...)))])
|
||||
(syntax/loc stx
|
||||
(case-lambda [pattern body] ...)))]))
|
||||
|
||||
(define-syntax (make-intermediate-procedure stx)
|
||||
(syntax-case stx [quote]
|
||||
[(_ (quote name) positional-clause ... #:keyword keyword-clause)
|
||||
(syntax/loc stx
|
||||
(make-keyword-procedure
|
||||
(let* ([name (case-lambda keyword-clause)]) name)
|
||||
(let* ([name (case-lambda* positional-clause ...)]) name)))]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; Higher-Order Boolean Operations
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define conjoin
|
||||
(case-lambda*
|
||||
[(f ... 8)
|
||||
(make-intermediate-procedure
|
||||
'conjoined
|
||||
[(x (... ...) 8) (and (f x (... ...)) ...)]
|
||||
[xs (and (apply f xs) ...)]
|
||||
#:keyword
|
||||
[(keys vals . args)
|
||||
(and (keyword-apply f keys vals args) ...)])]
|
||||
[fs
|
||||
(make-intermediate-procedure
|
||||
'conjoined
|
||||
[(x ... 8) (andmap (lambda (f) (f x ...)) fs)]
|
||||
[xs (andmap (lambda (f) (apply f xs)) fs)]
|
||||
#:keyword
|
||||
[(keys vals . args)
|
||||
(andmap (lambda (f) (keyword-apply f keys vals args)) fs)])]))
|
||||
|
||||
(define disjoin
|
||||
(case-lambda*
|
||||
[(f ... 8)
|
||||
(make-intermediate-procedure
|
||||
'disjoined
|
||||
[(x (... ...) 8) (or (f x (... ...)) ...)]
|
||||
[xs (or (apply f xs) ...)]
|
||||
#:keyword
|
||||
[(keys vals . args)
|
||||
(or (keyword-apply f keys vals args) ...)])]
|
||||
[fs
|
||||
(make-intermediate-procedure
|
||||
'disjoined
|
||||
[(x ... 8) (ormap (lambda (f) (f x ...)) fs)]
|
||||
[xs (ormap (lambda (f) (apply f xs)) fs)]
|
||||
#:keyword
|
||||
[(keys vals . args)
|
||||
(ormap (lambda (f) (keyword-apply f keys vals args)) fs)])]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; Function Invocation (partial or indirect)
|
||||
;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-syntax-rule (cons2 one two rest)
|
||||
(let*-values ([(ones twos) rest])
|
||||
(values (cons one ones) (cons two twos))))
|
||||
|
||||
(define merge-keywords
|
||||
(match-lambda*
|
||||
[(or (list _ '() '() keys vals)
|
||||
(list _ keys vals '() '()))
|
||||
(values keys vals)]
|
||||
[(list name
|
||||
(and keys1* (cons key1 keys1)) (and vals1* (cons val1 vals1))
|
||||
(and keys2* (cons key2 keys2)) (and vals2* (cons val2 vals2)))
|
||||
(cond
|
||||
[(keyword<? key1 key2)
|
||||
(cons2 key1 val1 (merge-keywords name keys1 vals1 keys2* vals2*))]
|
||||
[(keyword<? key2 key1)
|
||||
(cons2 key2 val2 (merge-keywords name keys1* vals1* keys2 vals2))]
|
||||
[else
|
||||
(error name
|
||||
"duplicate values for ~s: ~s and ~s"
|
||||
key1 val1 val2)])]))
|
||||
|
||||
(define curryn
|
||||
(make-intermediate-procedure
|
||||
'curryn
|
||||
[(n f x ... 8)
|
||||
(if (<= n 0)
|
||||
(f x ...)
|
||||
(make-intermediate-procedure
|
||||
'curried
|
||||
[(y (... ...) 8) (curryn (sub1 n) f x ... y (... ...))]
|
||||
[ys (curryn (sub1 n) f x ... ys)]
|
||||
#:keyword
|
||||
[(ks vs . ys)
|
||||
(keyword-apply curryn ks vs (sub1 n) f x ... ys)]))]
|
||||
[(n f . xs)
|
||||
(if (<= n 0)
|
||||
(apply f xs)
|
||||
(make-intermediate-procedure
|
||||
'curried
|
||||
[ys (apply curryn (sub1 n) f (append xs ys))]
|
||||
#:keyword
|
||||
[(ks vs . ys)
|
||||
(keyword-apply curryn ks vs (sub1 n) f (append xs ys))]))]
|
||||
#:keyword
|
||||
[(ks vs n f . xs)
|
||||
(if (<= n 0)
|
||||
(keyword-apply f ks vs xs)
|
||||
(make-intermediate-procedure
|
||||
'curried
|
||||
[ys (keyword-apply curryn ks vs (sub1 n) f (append xs ys))]
|
||||
#:keyword
|
||||
[(ks* vs* . ys)
|
||||
(let*-values ([(keys vals) (merge-keywords 'curryn ks vs ks* vs*)])
|
||||
(keyword-apply curryn keys vals (sub1 n) f (append xs ys)))]))]))
|
||||
|
||||
(define currynr
|
||||
(make-intermediate-procedure
|
||||
'currynr
|
||||
[(n f x ... 8)
|
||||
(if (<= n 0)
|
||||
(f x ...)
|
||||
(make-intermediate-procedure
|
||||
'curried
|
||||
[(y (... ...) 8) (currynr (sub1 n) f y (... ...) x ...)]
|
||||
[ys (currynr (sub1 n) f (append ys (list x ...)))]
|
||||
#:keyword
|
||||
[(ks vs . ys)
|
||||
(keyword-apply currynr ks vs (sub1 n) f (append ys (list x ...)))]))]
|
||||
[(n f . xs)
|
||||
(if (<= n 0)
|
||||
(apply f xs)
|
||||
(make-intermediate-procedure
|
||||
'curried
|
||||
[ys (apply currynr (sub1 n) f (append ys xs))]
|
||||
#:keyword
|
||||
[(ks vs . ys)
|
||||
(keyword-apply currynr ks vs (sub1 n) f (append ys xs))]))]
|
||||
#:keyword
|
||||
[(ks vs n f . xs)
|
||||
(if (<= n 0)
|
||||
(keyword-apply f ks vs xs)
|
||||
(make-intermediate-procedure
|
||||
'curried
|
||||
[ys (keyword-apply currynr ks vs (sub1 n) f (append ys xs))]
|
||||
#:keyword
|
||||
[(ks* vs* . ys)
|
||||
(let*-values ([(keys vals) (merge-keywords 'currynr ks vs ks* vs*)])
|
||||
(keyword-apply currynr keys vals (sub1 n) f (append ys xs)))]))]))
|
||||
|
||||
(define papply
|
||||
(make-intermediate-procedure
|
||||
'papply
|
||||
[(f x ... 8)
|
||||
(make-intermediate-procedure
|
||||
'partially-applied
|
||||
[(y (... ...) 8) (f x ... y (... ...))]
|
||||
[ys (apply f x ... ys)]
|
||||
#:keyword
|
||||
[(ks vs . ys) (keyword-apply f ks vs x ... ys)])]
|
||||
[(f . xs)
|
||||
(make-intermediate-procedure
|
||||
'partially-applied
|
||||
[ys (apply f (append xs ys))]
|
||||
#:keyword
|
||||
[(ks vs . ys) (keyword-apply f ks vs (append xs ys))])]
|
||||
#:keyword
|
||||
[(ks vs f . xs)
|
||||
(make-intermediate-procedure
|
||||
'partially-applied
|
||||
[ys (keyword-apply f ks vs (append xs ys))]
|
||||
#:keyword
|
||||
[(ks* vs* . ys)
|
||||
(let*-values ([(keys vals) (merge-keywords 'papply ks vs ks* vs*)])
|
||||
(keyword-apply f keys vals (append xs ys)))])]))
|
||||
|
||||
(define papplyr
|
||||
(make-intermediate-procedure
|
||||
'papplyr
|
||||
[(f x ... 8)
|
||||
(make-intermediate-procedure
|
||||
'partially-applied
|
||||
[(y (... ...) 8) (f y (... ...) x ...)]
|
||||
[ys (apply f (append ys (list x ...)))]
|
||||
#:keyword
|
||||
[(ks vs . ys) (keyword-apply f ks vs (append ys (list x ...)))])]
|
||||
[(f . xs)
|
||||
(make-intermediate-procedure
|
||||
'partially-applied
|
||||
[ys (apply f (append ys xs))]
|
||||
#:keyword
|
||||
[(ks vs . ys) (keyword-apply f ks vs (append ys xs))])]
|
||||
#:keyword
|
||||
[(ks vs f . xs)
|
||||
(make-intermediate-procedure
|
||||
'partially-applied
|
||||
[ys (keyword-apply f ks vs (append ys xs))]
|
||||
#:keyword
|
||||
[(ks* vs* . ys)
|
||||
(let*-values ([(keys vals) (merge-keywords 'papplyr ks vs ks* vs*)])
|
||||
(keyword-apply f keys vals (append ys xs)))])]))
|
||||
|
||||
(define call
|
||||
(make-intermediate-procedure
|
||||
'call
|
||||
[(f x ... 8) (f x ...)]
|
||||
[(f . xs) (apply f xs)]
|
||||
#:keyword
|
||||
[(ks vs f . xs) (keyword-apply f ks vs xs)]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Eta expansion
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-syntax eta*
|
||||
(syntax-rules ()
|
||||
[(_ f arg ...) (lambda (arg ...) (f arg ...))]
|
||||
[(_ f arg ... . rest) (lambda (arg ... . rest) (apply f arg ... rest))]))
|
||||
|
||||
(define-syntax-rule (eta f) (make-eta-expansion (lambda () f)))
|
||||
|
||||
(define (make-eta-expansion f*)
|
||||
(make-intermediate-procedure
|
||||
'eta
|
||||
[(x ... 8) ((f*) x ...)]
|
||||
[xs (apply (f*) xs)]
|
||||
#:keyword
|
||||
[(ks vs . xs) (keyword-apply (f*) ks vs xs)]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Parameter arguments
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define-for-syntax (strip-param orig p-arg)
|
||||
(syntax-case p-arg ()
|
||||
[(id #:param param)
|
||||
(values (syntax/loc p-arg (id (param)))
|
||||
(syntax/loc p-arg [param id]))]
|
||||
[_ (values p-arg #f)]))
|
||||
|
||||
(define-for-syntax (strip-params orig p-args)
|
||||
(syntax-case p-args ()
|
||||
[(key p-arg . rest)
|
||||
(keyword? #'key)
|
||||
(let*-values ([(arg param) (strip-param orig #'p-arg)]
|
||||
[(args params) (strip-params orig #'rest)])
|
||||
(values (cons #'key (cons arg args))
|
||||
(if param (cons param params) params)))]
|
||||
[(p-arg . rest)
|
||||
(let*-values ([(arg param) (strip-param orig #'p-arg)]
|
||||
[(args params) (strip-params orig #'rest)])
|
||||
(values (cons arg args)
|
||||
(if param (cons param params) params)))]
|
||||
[_ (values p-args null)]))
|
||||
|
||||
(define-syntax (lambda/parameter stx)
|
||||
(syntax-case stx ()
|
||||
[(_ p-args . body)
|
||||
(let*-values ([(args params) (strip-params stx #'p-args)])
|
||||
(quasisyntax/loc stx
|
||||
(lambda #,args (parameterize #,params . body))))]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Exports
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(provide
|
||||
;; functions
|
||||
conjoin disjoin
|
||||
curryn currynr papply papplyr call
|
||||
;; macros
|
||||
eta eta*
|
||||
lambda/parameter)
|
||||
|
|
|
|||
|
|
@ -12,25 +12,8 @@
|
|||
|
||||
This module provides tools for higher-order programming and creating functions.
|
||||
|
||||
@section{Simple Functions}
|
||||
|
||||
@section{Higher Order Predicates}
|
||||
|
||||
@defproc[((negate [f (-> A ... boolean?)]) [x A] ...) boolean?]{
|
||||
|
||||
Negates the results of @racket[f]; equivalent to @racket[(not (f x ...))].
|
||||
|
||||
This function is reprovided from @racketmodname[scheme/function].
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(define f (negate exact-integer?))
|
||||
(f 1)
|
||||
(f 'one)
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@defproc[((conjoin [f (-> A ... boolean?)] ...) [x A] ...) boolean?]{
|
||||
|
||||
Combines calls to each function with @racket[and]. Equivalent to
|
||||
|
|
@ -63,191 +46,4 @@ Combines calls to each function with @racket[or]. Equivalent to
|
|||
|
||||
}
|
||||
|
||||
@section{Currying and (Partial) Application}
|
||||
|
||||
@defproc[(call [f (-> A ... B)] [x A] ...) B]{
|
||||
|
||||
Passes @racket[x ...] to @racket[f]. Keyword arguments are allowed. Equivalent
|
||||
to @racket[(f x ...)]. Useful for application in higher-order contexts.
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(map call
|
||||
(list + - * /)
|
||||
(list 1 2 3 4)
|
||||
(list 5 6 7 8))
|
||||
(define count 0)
|
||||
(define (inc)
|
||||
(set! count (+ count 1)))
|
||||
(define (reset)
|
||||
(set! count 0))
|
||||
(define (show)
|
||||
(printf "~a\n" count))
|
||||
(for-each call (list inc inc show reset show))
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@deftogether[(
|
||||
@defproc[(papply [f (A ... B ... -> C)] [x A] ...) (B ... -> C)]
|
||||
@defproc[(papplyr [f (A ... B ... -> C)] [x B] ...) (A ... -> C)]
|
||||
)]{
|
||||
|
||||
The @racket[papply] and @racket[papplyr] functions partially apply @racket[f] to
|
||||
@racket[x ...], which may include keyword arguments. They obey the following
|
||||
equations:
|
||||
|
||||
@racketblock[
|
||||
((papply f x ...) y ...) = (f x ... y ...)
|
||||
((papplyr f x ...) y ...) = (f y ... x ...)
|
||||
]
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(define reciprocal (papply / 1))
|
||||
(reciprocal 3)
|
||||
(reciprocal 4)
|
||||
(define halve (papplyr / 2))
|
||||
(halve 3)
|
||||
(halve 4)
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@deftogether[(
|
||||
@defproc[(curryn [n exact-nonnegative-integer?]
|
||||
[f (A0 ... A1 ... ooo An ... -> B)]
|
||||
[x A0] ...)
|
||||
(A1 ... -> ooo -> An ... -> B)]
|
||||
@defproc[(currynr [n exact-nonnegative-integer?]
|
||||
[f (A1 ... ooo An ... An+1 ... -> B)]
|
||||
[x An+1] ...)
|
||||
(An ... -> ooo -> A1 ... -> B)]
|
||||
)]{
|
||||
|
||||
@emph{Note:} The @racket[ooo] above denotes a loosely associating ellipsis.
|
||||
|
||||
The @racket[curryn] and @racket[currynr] functions construct a curried version
|
||||
of @racket[f], specialized at @racket[x ...], that produces a result after
|
||||
@racket[n] further applications. Arguments at any stage of application may
|
||||
include keyword arguments, so long as no keyword is duplicated. These curried
|
||||
functions obey the following equations:
|
||||
|
||||
@racketblock[
|
||||
(curryn 0 f x ...) = (f x ...)
|
||||
((curryn (+ n 1) f x ...) y ...) = (curryn n f x ... y ...)
|
||||
|
||||
(currynr 0 f x ...) = (f x ...)
|
||||
((currynr (+ n 1) f x ...) y ...) = (currynr n f y ... x ...)
|
||||
]
|
||||
|
||||
The @racket[call], @racket[papply], and @racket[papplyr] utilities are related
|
||||
to @racket[curryn] and @racket[currynr] in the following manner:
|
||||
|
||||
@racketblock[
|
||||
(call f x ...) = (curryn 0 f x ...) = (currynr 0 f x ...)
|
||||
(papply f x ...) = (curryn 1 f x ...)
|
||||
(papplyr f x ...) = (currynr 1 f x ...)
|
||||
]
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
|
||||
(define reciprocal (curryn 1 / 1))
|
||||
(reciprocal 3)
|
||||
(reciprocal 4)
|
||||
|
||||
(define subtract-from (curryn 2 -))
|
||||
(define from-10 (subtract-from 10))
|
||||
(from-10 5)
|
||||
(from-10 10)
|
||||
(define from-0 (subtract-from 0))
|
||||
(from-0 5)
|
||||
(from-0 10)
|
||||
|
||||
(define halve (currynr 1 / 2))
|
||||
(halve 3)
|
||||
(halve 4)
|
||||
|
||||
(define subtract (currynr 2 -))
|
||||
(define minus-10 (subtract 10))
|
||||
(minus-10 5)
|
||||
(minus-10 10)
|
||||
(define minus-0 (subtract 0))
|
||||
(minus-0 5)
|
||||
(minus-0 10)
|
||||
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@section{Eta Expansion}
|
||||
|
||||
@defform[(eta f)]{
|
||||
|
||||
Produces a function equivalent to @racket[f], except that @racket[f] is
|
||||
evaluated every time it is called.
|
||||
|
||||
This is useful for function expressions that may be run, but not called, before
|
||||
@racket[f] is defined. The @racket[eta] expression will produce a function
|
||||
without evaluating @racket[f].
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(define f (eta g))
|
||||
f
|
||||
(define g (lambda (x) (+ x 1)))
|
||||
(f 1)
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@defform[(eta* f x ...)]{
|
||||
|
||||
Produces a function equivalent to @racket[f], with argument list @racket[x ...].
|
||||
In simple cases, this is equivalent to @racket[(lambda (x ...) (f x ...))].
|
||||
Optional (positional or keyword) arguments are not allowed.
|
||||
|
||||
This macro behaves similarly to @racket[eta], but produces a function with
|
||||
statically known arity which may improve efficiency and error reporting.
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(define f (eta* g x))
|
||||
f
|
||||
(procedure-arity f)
|
||||
(define g (lambda (x) (+ x 1)))
|
||||
(f 1)
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@section{Parameter Arguments}
|
||||
|
||||
@defform/subs[
|
||||
(lambda/parameter (param-arg ...) body ...)
|
||||
([param-arg param-arg-spec (code:line keyword param-spec)]
|
||||
[param-arg-spec id [id default-expr] [id #:param param-expr]])
|
||||
]{
|
||||
|
||||
Constructs a function much like @racket[lambda], except that some optional
|
||||
arguments correspond to the value of a parameter. For each clause of the form
|
||||
@racket[[id #:param param-expr]], @racket[param-expr] must evaluate to a value
|
||||
@racket[param] satisfying @racket[parameter?]. The default value of the
|
||||
argument @racket[id] is @racket[(param)]; @racket[param] is bound to @racket[id]
|
||||
via @racket[parameterize] during the function call.
|
||||
|
||||
@defexamples[
|
||||
#:eval the-eval
|
||||
(define p (open-output-string))
|
||||
(define hello-world
|
||||
(lambda/parameter ([port #:param current-output-port])
|
||||
(display "Hello, World!")
|
||||
(newline port)))
|
||||
(hello-world p)
|
||||
(get-output-string p)
|
||||
]
|
||||
|
||||
}
|
||||
|
||||
@(close-eval the-eval)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user