diff --git a/collects/scheme/function.ss b/collects/scheme/function.ss
index 5b4349dce8..ffe2962b95 100644
--- a/collects/scheme/function.ss
+++ b/collects/scheme/function.ss
@@ -6,40 +6,60 @@
   (unless (procedure? f) (raise-type-error 'negate "procedure" f))
   (let-values ([(arity) (procedure-arity f)]
                [(required-kws accepted-kws) (procedure-keywords f)])
-    (define negated
-      (if (and (null? required-kws) (null? accepted-kws))
-        ;; simple function
-        (if (equal? arity 1) ; optimize common case
-          (lambda (x) (not (f x)))
-          (lambda xs (not (apply f xs))))
-        ;; keyworded function
-        (make-keyword-procedure
-         (lambda (kws kw-args . rest)
-           (not (keyword-apply f kws kw-args rest))))))
-    negated))
+    (define negated ; simple version, optimize some cases
+      (case arity
+        [(0) (lambda () (not (f)))]
+        [(1) (lambda (x) (not (f x)))]
+        [(2) (lambda (x y) (not (f x y)))]
+        [else (lambda xs (not (apply f xs)))]))
+    (if (and (null? required-kws) (null? accepted-kws))
+      negated
+      ;; keyworded function
+      (make-keyword-procedure (lambda (kws kvs . args)
+                                (not (keyword-apply f kws kvs args)))
+                              negated))))
 
-(define (curry f . args)
-  (unless (procedure? f) (raise-type-error 'curry "procedure" f))
-  (let loop ([args args])
-    (define curried
-      (if (null? args) ; always at least one step
-        (lambda more (loop more))
-        (lambda more
-          (let ([args (append args more)])
-            (if (procedure-arity-includes? f (length args))
-              (apply f args)
-              (loop args))))))
-    curried))
+(define (make-curry right?)
+  ;; The real code is here
+  (define (curry* f args kws kvs)
+    (unless (procedure? f)
+      (raise-type-error (if right? 'curryr 'curry) "procedure" f))
+    (let* ([arity (procedure-arity f)]
+           [max-arity (cond [(integer? arity) arity]
+                            [(arity-at-least? arity) #f]
+                            [(ormap arity-at-least? arity) #f]
+                            [else (apply max arity)])]
+           [n (length args)])
+      (define (loop args n)
+        (cond
+          [(procedure-arity-includes? f n)
+           (if (null? kws) (apply f args) (keyword-apply f kws kvs args))]
+          [(and max-arity (n . > . max-arity))
+           (apply raise-arity-error f arity args)]
+          [else
+           (letrec [(curried
+                     (case-lambda
+                       [() curried] ; return itself on zero arguments
+                       [more (loop (if right?
+                                     (append more args) (append args more))
+                                   (+ n (length more)))]))]
+             curried)]))
+      ;; take at least one step if we can continue (there is a higher arity)
+      (if (equal? n max-arity)
+        (if (null? kws) (apply f args) (keyword-apply f kws kvs args))
+        (letrec ([curried
+                  (lambda more
+                    (let ([args (if right?
+                                  (append more args) (append args more))])
+                      (loop args (+ n (length more)))))])
+          curried))))
+  ;; curry is itself curried -- if we get args then they're the first step
+  (define curry
+    (case-lambda [(f) (define (curried . args) (curry* f args '() '()))
+                      curried]
+                 [(f . args) (curry* f args '() '())]))
+  (make-keyword-procedure (lambda (kws kvs f . args) (curry* f args kws kvs))
+                          curry))
 
-(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))
+(define curry  (make-curry #f))
+(define curryr (make-curry #t))
diff --git a/collects/scribblings/reference/procedures.scrbl b/collects/scribblings/reference/procedures.scrbl
index 82dabd1878..96404483ae 100644
--- a/collects/scribblings/reference/procedures.scrbl
+++ b/collects/scribblings/reference/procedures.scrbl
@@ -372,17 +372,26 @@ same arity as @scheme[proc].
 @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.
+additional arguments.  At least one such application step is required
+unless the current arguments are the most that @scheme[proc] can
+consume (which is always the case when @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.)
+If additional values are provided to the @scheme[curry] call (the
+second form), they are used as the first step.  (This means that
+@scheme[curry] itself is curried.)
+
+@scheme[curry] provides limited support for keyworded functions: only
+the @scheme[curry] call itself can receive keyworded arguments to be
+eventually handed to @scheme[proc].
 
 @fun-examples[
-(map ((curry +) 10) '(1 2 3))
-(map (curry + 10) '(1 2 3))
-(map (compose (curry * 2) (curry + 10)) '(1 2 3))
+  (map ((curry +) 10) '(1 2 3))
+  (map (curry + 10) '(1 2 3))
+  (map (compose (curry * 2) (curry + 10)) '(1 2 3))
+  (define foo (curry (lambda (x y z) (list x y z))))
+  (foo 1 2 3)
+  (((((foo) 1) 2)) 3)
 ]
 
 }
@@ -395,7 +404,7 @@ 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))
+  (map (curryr list 'foo) '(1 2 3))
 ]
 
 }
diff --git a/collects/tests/mzscheme/function.ss b/collects/tests/mzscheme/function.ss
index 54cee0681a..8f60fd65c7 100644
--- a/collects/tests/mzscheme/function.ss
+++ b/collects/tests/mzscheme/function.ss
@@ -3,8 +3,9 @@
 
 (Section 'function)
 
-(require mzlib/list)
-(require mzlib/etc)
+(require scheme/function mzlib/etc)
+
+;; stuff from scheme/base
 
 (test 0 (compose add1 sub1) 0)
 (test 2 (compose add1 (lambda () 1)))
@@ -25,63 +26,84 @@
 
 (arity-test compose 1 -1)
 
-(test '("a" "b" "c" "c" "d" "e" "f")
-      sort
-      '("d" "f" "e" "c" "a" "c" "b")
-      string<?)
+;; ---------- rec (from mzlib/etc) ----------
 (let ()
-  (define (car< x y) (< (car x) (car y)))
-  (define (random-list n range)
-    (let loop ([n n] [r '()])
-      (if (zero? n) r (loop (sub1 n) (cons (list (random range)) r)))))
-  (define (test-sort len times)
-    (or (zero? times)
-        (and (let* ([rand (random-list len (if (even? times) 1000000 10))]
-                    [orig< (lambda (x y) (memq y (cdr (memq x rand))))]
-                    [sorted (sort rand car<)]
-                    [l1 (reverse (cdr (reverse sorted)))]
-                    [l2 (cdr sorted)])
-               (and (= (length sorted) (length rand))
-                    (andmap (lambda (x1 x2)
-                              (and (not (car< x2 x1)) ; sorted?
-                                   (or (car< x1 x2) (orig< x1 x2)))) ; stable?
-                            l1 l2)))
-             (test-sort len (sub1 times)))))
-  (test #t test-sort    1  10)
-  (test #t test-sort    2  20)
-  (test #t test-sort    3  60)
-  (test #t test-sort    4 200)
-  (test #t test-sort    5 200)
-  (test #t test-sort   10 200)
-  (test #t test-sort  100 200)
-  (test #t test-sort 1000 200)
-  ;; test stability
-  (test '((1) (2) (3 a) (3 b) (3 c)) sort '((3 a) (1) (3 b) (2) (3 c)) car<)
-  ;; test short lists (+ stable)
-  (test '() sort '() car<)
-  (test '((1 1)) sort '((1 1)) car<)
-  (test '((1 2) (1 1)) sort '((1 2) (1 1)) car<)
-  (test '((1) (2)) sort '((2) (1)) car<)
-  (for-each (lambda (l) (test '((0 3) (1 1) (1 2)) sort l car<))
-            '(((1 1) (1 2) (0 3))
-              ((1 1) (0 3) (1 2))
-              ((0 3) (1 1) (1 2))))
-  (for-each (lambda (l) (test '((0 2) (0 3) (1 1)) sort l car<))
-            '(((1 1) (0 2) (0 3))
-              ((0 2) (1 1) (0 3))
-              ((0 2) (0 3) (1 1)))))
+  (test 3 (rec f (λ (x) 3)) 3)
+  (test 3 (rec f (λ (x) x)) 3)
+  (test 2 (rec f (λ (x) (if (= x 3) (f 2) x))) 3)
+  (test 3 (rec (f x) 3) 3)
+  (test 3 (rec (f x) x) 3)
+  (test 2 (rec (f x) (if (= x 3) (f 2) x)) 3)
+  (test 2 (rec (f x . y) (car y)) 1 2 3)
+  (test 2 'no-duplications
+        (let ([x 1]) (rec ignored (begin (set! x (+ x 1)) void)) x))
+  (test 'f object-name (rec (f x) x))
+  (test 'f object-name (rec (f x . y) x))
+  (test 'f object-name (rec  f (lambda (x) x)))
+  (test (list 2) (rec (f . x) (if (= (car x) 3) (f 2) x)) 3))
 
-(test 3 (rec f (λ (x) 3)) 3)
-(test 3 (rec f (λ (x) x)) 3)
-(test 2 (rec f (λ (x) (if (= x 3) (f 2) x))) 3)
-(test 3 (rec (f x) 3) 3)
-(test 3 (rec (f x) x) 3)
-(test 2 (rec (f x) (if (= x 3) (f 2) x)) 3)
-(test 2 (rec (f x . y) (car y)) 1 2 3)
-(test 2 'no-duplications (let ([x 1]) (rec ignored (begin (set! x (+ x 1)) void)) x))
-(test 'f object-name (rec (f x) x))
-(test 'f object-name (rec (f x . y) x))
-(test 'f object-name (rec  f (lambda (x) x)))
-(test (list 2) (rec (f . x) (if (= (car x) 3) (f 2) x)) 3)
+;; ---------- negate ----------
+(let ()
+  (define *not  (negate not))
+  (define *void (negate void))
+  (define *<    (negate <))
+  (test #t *not #t)
+  (test #f *not #f)
+  (test #t *not 12)
+  (test #f *void)
+  (test #t *< 12 3)
+  (test #t *< 12 12)
+  (test #f *< 11 12)
+  (test #t *< 14 13 12 11)
+  (test #f *< 11 12 13 14))
+
+;; ---------- curry/r ----------
+(let ()
+  (define foo0 (lambda () 0))
+  (define foo1 (lambda (x) x))
+  (define foo3 (lambda (x y z) (list x y z)))
+  (define foo2< (lambda (x y . r) (list* x y r)))
+  (define foo35 (case-lambda [(a b c) 3] [(a b c d e) 5]))
+  (define foo:x (lambda (#:x [x 1] n . ns) (* x (apply + n ns))))
+  (define *foo0  (curry foo0))
+  (define *foo1  (curry foo1))
+  (define *foo3  (curry foo3))
+  (define *foo2< (curry foo2<))
+  (define *foo35 (curry foo35))
+  (define *foo:x2 (curry foo:x #:x 2))
+  (define ++ (curry +))
+  (define-syntax-rule ((f x ...) . => . e2) (test e2 f x ...))
+  ;; see the docs for why these are expected
+  (((curry foo0)) . => . 0)
+  ((*foo0) . => . 0)
+  ((curry foo1 123) . => . 123)
+  ((*foo1 123) . => . 123)
+  (((*foo1) 123) . => . 123)
+  ((((*foo1)) 123) . => . 123)
+  ((curry foo3 1 2 3) . => . '(1 2 3))
+  ((*foo3 1 2 3) . => . '(1 2 3))
+  (((*foo3 1 2) 3) . => . '(1 2 3))
+  (((((((*foo3) 1)) 2)) 3) . => . '(1 2 3))
+  (((curry foo2< 1 2)) . => . '(1 2))
+  (((curry foo2< 1 2 3)) . => . '(1 2 3))
+  (((curry foo2< 1 2) 3) . => . '(1 2 3))
+  (((*foo2< 1 2)) . => . '(1 2))
+  (((*foo2< 1 2 3)) . => . '(1 2 3))
+  (((*foo2< 1 2) 3) . => . '(1 2 3))
+  (((curry + 1 2) 3) . => . 6)
+  (((++ 1 2) 3) . => . 6)
+  (((++) 1 2) . => . 3)
+  (((++)) . => . 0)
+  (((curry foo35 1 2) 3) . => . 3)
+  (((curry foo35 1 2 3)) . => . 3)
+  (((*foo35 1 2) 3) . => . 3)
+  (((*foo35 1 2 3)) . => . 3)
+  (((((*foo35 1 2 3 4))) 5) . => . 5)
+  (((((((((((*foo35)) 1)) 2)) 3 4))) 5) . => . 5)
+  ((*foo:x2 1 2 3) . => . 12)
+  ((map *foo:x2 '(1 2 3)) . => . '(2 4 6))
+  ((((curryr foo3 1) 2) 3) . => . '(3 2 1))
+  (((curryr list 1) 2 3) . => . '(2 3 1))
+  )
 
 (report-errs)