diff --git a/collects/scheme/function.ss b/collects/scheme/function.ss index fc9981a321..5b4349dce8 100644 --- a/collects/scheme/function.ss +++ b/collects/scheme/function.ss @@ -1,6 +1,6 @@ #lang scheme/base -(provide negate curry) +(provide negate curry curryr) (define (negate f) (unless (procedure? f) (raise-type-error 'negate "procedure" f)) @@ -21,7 +21,7 @@ (define (curry f . args) (unless (procedure? f) (raise-type-error 'curry "procedure" f)) (let loop ([args args]) - (define curry + (define curried (if (null? args) ; always at least one step (lambda more (loop more)) (lambda more @@ -29,4 +29,17 @@ (if (procedure-arity-includes? f (length args)) (apply f args) (loop args)))))) - curry)) + curried)) + +(define (curryr f . args) + (unless (procedure? f) (raise-type-error 'curry "procedure" f)) + (let loop ([args args]) + (define curried-right + (if (null? args) ; always at least one step + (lambda more (loop more)) + (lambda more + (let ([args (append more args)]) + (if (procedure-arity-includes? f (length args)) + (apply f args) + (loop args)))))) + curried-right)) diff --git a/collects/scheme/main.ss b/collects/scheme/main.ss index 822ec40adf..ae056276c9 100644 --- a/collects/scheme/main.ss +++ b/collects/scheme/main.ss @@ -10,6 +10,7 @@ scheme/tcp scheme/udp scheme/list + scheme/function scheme/path scheme/file scheme/cmdline @@ -30,6 +31,7 @@ scheme/tcp scheme/udp scheme/list + scheme/function scheme/path scheme/file scheme/cmdline diff --git a/collects/scribblings/reference/pairs.scrbl b/collects/scribblings/reference/pairs.scrbl index c2ab5370ca..7e664d4376 100644 --- a/collects/scribblings/reference/pairs.scrbl +++ b/collects/scribblings/reference/pairs.scrbl @@ -42,8 +42,8 @@ "Returns " (to-element 'equiv)))))])) -@(define list-eval (make-base-eval)) -@interaction-eval[#:eval list-eval (require scheme/list)] +@(begin (define list-eval (make-base-eval)) + (interaction-eval #:eval list-eval (require scheme/list))) @title[#:tag "pairs"]{Pairs and Lists} diff --git a/collects/scribblings/reference/procedures.scrbl b/collects/scribblings/reference/procedures.scrbl index 73d56fd680..82dabd1878 100644 --- a/collects/scribblings/reference/procedures.scrbl +++ b/collects/scribblings/reference/procedures.scrbl @@ -346,3 +346,56 @@ by @scheme[arity]). For most primitives, this procedure returns @scheme[1], since most primitives return a single value when applied.} +@; ---------------------------------------- +@section{Additional Procedure Functions} + +@note-lib[scheme/function] +@(begin (define fun-eval (make-base-eval)) + (fun-eval '(require scheme/function)) + (define-syntax fun-examples + (syntax-rules () + [(_ e ...) (examples #:eval fun-eval e ...)]))) + +@defproc[(negate [proc procedure?]) procedure?]{ + +Returns a procedure that is just like @scheme[proc], except that it +returns the negation of the result. The resulting procedure has the +same arity as @scheme[proc]. + +@fun-examples[ +(filter (negate symbol?) '(1 a 2 b 3 c)) +]} + +@defproc*[([(curry [proc procedure?]) procedure?] + [(curry [proc procedure?] [v any/c] ...+) procedure?])]{ + +@scheme[(curry proc)] returns a procedure that is a curried version of +@scheme[proc]. When the resulting procedure is applied on an +insufficient number of arguments, it returns a procedure that expects +additional arguments. However, at least one such application step is +required in any case, even if the @scheme[proc] consumes any number of +arguments. + +If additional values are provided to @scheme[curry], they are used as +the first step. (This means that @scheme[curry] itself is curried.) + +@fun-examples[ +(map ((curry +) 10) '(1 2 3)) +(map (curry + 10) '(1 2 3)) +(map (compose (curry * 2) (curry + 10)) '(1 2 3)) +] + +} + +@defproc*[([(curryr [proc procedure?]) procedure?] + [(curryr [proc procedure?] [v any/c] ...+) procedure?])]{ + +Like @scheme[curry], except that the arguments are collected in the +opposite direction: the first step collects the rightmost group of +arguments, and following steps add arguments to the left of these. + +@fun-examples[ +(map (curryr list 'foo) '(1 2 3)) +] + +}