Curry using an arity-mask API

gistfile1.txt

#lang racket/base

(module curry-old racket/base
  (provide curry curryr)

  (define (make-curry right?)
    ;; The real code is here
    (define (curry* f args kws kvs)
      (unless (procedure? f)
        (raise-argument-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)
         (unless (procedure? f)
           (raise-argument-error (if right? 'curryr 'curry) "procedure?" 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 curry  (make-curry #f))
  (define curryr (make-curry #t)))

(module curry-new racket/base
  (require racket/list)

  (provide curry curryr)

  (define (make-curry right?)
    ; normalized-arity? -> (or/c exact-nonnegative-integer? +inf.0 #f)
    ;
    ; Calculates the maximum number of arguments a function with the given arity may be applied to. If
    ; an unbounded number of arguments are permitted, returns +inf.0. If no number of arguments is valid
    ; (that is, the procedure is uninvokable), returns #f.
    (define (normalized-arity-upper-bound arity)
      (cond
        [(null? arity) #f]
        [(exact-integer? arity) arity]
        [(arity-at-least? arity) +inf.0]
        [(list? arity) (normalized-arity-upper-bound (last arity))]))

    ; normalized-arity? exact-nonnegative-integer? -> normalized-arity?
    ;
    ; Calculates the positional argument arity for a function produced by `curry` that has already been
    ; applied to num-args-so-far arguments.
    (define (partially-applied-procedure-arity full-normalized-arity num-args-so-far)
      (cond
        ; If the procedure can't be applied at all, the arity doesn't change.
        [(null? full-normalized-arity)
         '()]
        ; If the procedure expects exactly n arguments, then the curried version accepts any number of
        ; arguments in the range [0, n - num-args-so-far].
        [(exact-integer? full-normalized-arity)
         (range 0 (add1 (- full-normalized-arity num-args-so-far)))]
        ; If the procedure accepts an unbounded number of arguments, subsequent curried applications can
        ; supply any number of arguments.
        [(arity-at-least? full-normalized-arity)
         (arity-at-least 0)]
        ; If the procedure can be called at multiple arities, use the greatest one, which will always be
        ; the last arity in the list if the arity is normalized.
        [(list? full-normalized-arity)
         (partially-applied-procedure-arity (last full-normalized-arity) num-args-so-far)]))

    (define who (if right? 'curryr 'curry))

    ;; the actual implementation of curry[r] is here
    (define (do-curry f)
      (unless (procedure? f)
        (raise-argument-error who "procedure?" f))
      (let*-values ([(name) (object-name f)]
                    [(curried-name) (if (symbol? name)
                                        (string->symbol (string-append "curried:"
                                                                       (symbol->string name)))
                                        'curried)]
                    [(arity) (procedure-arity f)]
                    [(max-arity) (normalized-arity-upper-bound arity)]
                    [(required-kws allowed-kws) (procedure-keywords f)])
        (cond
          ;; fast path for functions that don't accept any keywords
          [(null? allowed-kws)
           (define (reduce-arity/rename proc num-args-so-far)
             (procedure-rename
              (procedure-reduce-arity
               proc
               (partially-applied-procedure-arity arity num-args-so-far))
              curried-name))

           ; builds a curried version of f with the appropriate arity
           (define (make-curried args-so-far)
             (reduce-arity/rename
              (lambda args
                (step (if right?
                          (append args args-so-far)
                          (append args-so-far args))))
              (length args-so-far)))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step args-so-far)
             (if (procedure-arity-includes? f (length args-so-far))
                 (apply f args-so-far)
                 (make-curried args-so-far)))

           (reduce-arity/rename
            (lambda args
              (if (= (length args) max-arity)
                  (apply f args)
                  (make-curried args)))
            0)]

          ;; slow path for functions that accept keywords
          [else
           ; builds a curried version of f with the appropriate arity
           (define (make-curried kw+args-so-far pos-args-so-far first?)
             (define (incorporate-new-kw+args kw+args)
               (for/fold ([kw+args kw+args-so-far])
                         ([(kw arg) (in-hash kw+args)])
                 (if (hash-has-key? kw+args kw)
                     (raise-arguments-error
                      curried-name
                      "duplicate keyword for procedure"
                      "keyword" kw
                      "first value" (hash-ref kw+args kw)
                      "second value" arg)
                     (hash-set kw+args kw arg))))
             (define (incorporate-new-pos-args args)
               (append (if right? args (reverse args)) pos-args-so-far))

             (define curried
               (make-keyword-procedure
                (lambda (kws kw-args . args)
                  (step (let ([kw+args (make-immutable-hasheq (map cons kws kw-args))])
                          (incorporate-new-kw+args kw+args))
                        (incorporate-new-pos-args args)
                        first?))
                (lambda args
                  (step kw+args-so-far (incorporate-new-pos-args args) first?))))
             (define curried/reduced-arity
               (procedure-reduce-keyword-arity
                curried
                (partially-applied-procedure-arity arity (length pos-args-so-far))
                '()
                (and allowed-kws
                     (filter (lambda (kw) (not (hash-has-key? kw+args-so-far kw))) allowed-kws))))
             (procedure-rename curried/reduced-arity curried-name))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step kw+args-so-far pos-args-so-far first?)
             (if (if first?
                     (and (= (length pos-args-so-far) max-arity)
                          allowed-kws
                          (for/and ([allowed-kw (in-list allowed-kws)])
                            (hash-has-key? kw+args-so-far allowed-kw)))
                     (and (procedure-arity-includes? f (length pos-args-so-far) #t)
                          (for/and ([required-kw (in-list required-kws)])
                            (hash-has-key? kw+args-so-far required-kw))))
                 (let* ([sorted-kw+args (sort (hash->list kw+args-so-far) keyword<? #:key car)]
                        [kws (map car sorted-kw+args)]
                        [kw-args (map cdr sorted-kw+args)])
                   (keyword-apply f kws kw-args (if right? pos-args-so-far (reverse pos-args-so-far))))
                 (make-curried kw+args-so-far pos-args-so-far #f)))

           (make-curried #hasheq() '() #t)])))

    ;; curry itself is curried; if we get any args, immediately invoke the curried function with them
    (procedure-rename
     (make-keyword-procedure
      (lambda (kws kw-args f . args)
        (let ([curried (do-curry f)])
          (if (null? kws)
              (if (null? args)
                  curried
                  (apply curried args))
              (keyword-apply curried kws kw-args args))))
      (case-lambda
        [(f) (do-curry f)]
        [(f . args) (apply (do-curry f) args)]))
     who))

  (define curry  (make-curry #f))
  (define curryr (make-curry #t)))

(module curry-new/merge racket/base
  (require racket/list)

  (provide curry curryr)

  (define (make-curry right?)
    ; normalized-arity? -> (or/c exact-nonnegative-integer? +inf.0 #f)
    ;
    ; Calculates the maximum number of arguments a function with the given arity may be applied to. If
    ; an unbounded number of arguments are permitted, returns +inf.0. If no number of arguments is valid
    ; (that is, the procedure is uninvokable), returns #f.
    (define (normalized-arity-upper-bound arity)
      (cond
        [(null? arity) #f]
        [(exact-integer? arity) arity]
        [(arity-at-least? arity) +inf.0]
        [(list? arity) (normalized-arity-upper-bound (last arity))]))

    ; normalized-arity? exact-nonnegative-integer? -> normalized-arity?
    ;
    ; Calculates the positional argument arity for a function produced by `curry` that has already been
    ; applied to num-args-so-far arguments.
    (define (partially-applied-procedure-arity full-normalized-arity num-args-so-far)
      (cond
        ; If the procedure can't be applied at all, the arity doesn't change.
        [(null? full-normalized-arity)
         '()]
        ; If the procedure expects exactly n arguments, then the curried version accepts any number of
        ; arguments in the range [0, n - num-args-so-far].
        [(exact-integer? full-normalized-arity)
         (range 0 (add1 (- full-normalized-arity num-args-so-far)))]
        ; If the procedure accepts an unbounded number of arguments, subsequent curried applications can
        ; supply any number of arguments.
        [(arity-at-least? full-normalized-arity)
         (arity-at-least 0)]
        ; If the procedure can be called at multiple arities, use the greatest one, which will always be
        ; the last arity in the list if the arity is normalized.
        [(list? full-normalized-arity)
         (partially-applied-procedure-arity (last full-normalized-arity) num-args-so-far)]))

    (define who (if right? 'curryr 'curry))

    ;; the actual implementation of curry[r] is here
    (define (do-curry f)
      (unless (procedure? f)
        (raise-argument-error who "procedure?" f))
      (let*-values ([(name) (object-name f)]
                    [(curried-name) (if (symbol? name)
                                        (string->symbol (string-append "curried:"
                                                                       (symbol->string name)))
                                        'curried)]
                    [(arity) (procedure-arity f)]
                    [(max-arity) (normalized-arity-upper-bound arity)]
                    [(required-kws allowed-kws) (procedure-keywords f)])
        (cond
          ;; fast path for functions that don't accept any keywords
          [(null? allowed-kws)
           (define (reduce-arity/rename proc num-args-so-far)
             (procedure-reduce-arity
              proc
              (partially-applied-procedure-arity arity num-args-so-far)
              curried-name))

           ; builds a curried version of f with the appropriate arity
           (define (make-curried args-so-far)
             (reduce-arity/rename
              (lambda args
                (step (if right?
                          (append args args-so-far)
                          (append args-so-far args))))
              (length args-so-far)))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step args-so-far)
             (if (procedure-arity-includes? f (length args-so-far))
                 (apply f args-so-far)
                 (make-curried args-so-far)))

           (reduce-arity/rename
            (lambda args
              (if (= (length args) max-arity)
                  (apply f args)
                  (make-curried args)))
            0)]

          ;; slow path for functions that accept keywords
          [else
           ; builds a curried version of f with the appropriate arity
           (define (make-curried kw+args-so-far pos-args-so-far first?)
             (define (incorporate-new-kw+args kw+args)
               (for/fold ([kw+args kw+args-so-far])
                         ([(kw arg) (in-hash kw+args)])
                 (if (hash-has-key? kw+args kw)
                     (raise-arguments-error
                      curried-name
                      "duplicate keyword for procedure"
                      "keyword" kw
                      "first value" (hash-ref kw+args kw)
                      "second value" arg)
                     (hash-set kw+args kw arg))))
             (define (incorporate-new-pos-args args)
               (append (if right? args (reverse args)) pos-args-so-far))

             (define curried
               (make-keyword-procedure
                (lambda (kws kw-args . args)
                  (step (let ([kw+args (make-immutable-hasheq (map cons kws kw-args))])
                          (incorporate-new-kw+args kw+args))
                        (incorporate-new-pos-args args)
                        first?))
                (lambda args
                  (step kw+args-so-far (incorporate-new-pos-args args) first?))))
             (procedure-reduce-keyword-arity
              curried
              (partially-applied-procedure-arity arity (length pos-args-so-far))
              '()
              (and allowed-kws
                   (filter (lambda (kw) (not (hash-has-key? kw+args-so-far kw))) allowed-kws))
              curried-name))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step kw+args-so-far pos-args-so-far first?)
             (if (if first?
                     (and (= (length pos-args-so-far) max-arity)
                          allowed-kws
                          (for/and ([allowed-kw (in-list allowed-kws)])
                            (hash-has-key? kw+args-so-far allowed-kw)))
                     (and (procedure-arity-includes? f (length pos-args-so-far) #t)
                          (for/and ([required-kw (in-list required-kws)])
                            (hash-has-key? kw+args-so-far required-kw))))
                 (let* ([sorted-kw+args (sort (hash->list kw+args-so-far) keyword<? #:key car)]
                        [kws (map car sorted-kw+args)]
                        [kw-args (map cdr sorted-kw+args)])
                   (keyword-apply f kws kw-args (if right? pos-args-so-far (reverse pos-args-so-far))))
                 (make-curried kw+args-so-far pos-args-so-far #f)))

           (make-curried #hasheq() '() #t)])))

    ;; curry itself is curried; if we get any args, immediately invoke the curried function with them
    (procedure-rename
     (make-keyword-procedure
      (lambda (kws kw-args f . args)
        (let ([curried (do-curry f)])
          (if (null? kws)
              (if (null? args)
                  curried
                  (apply curried args))
              (keyword-apply curried kws kw-args args))))
      (case-lambda
        [(f) (do-curry f)]
        [(f . args) (apply (do-curry f) args)]))
     who))

  (define curry  (make-curry #f))
  (define curryr (make-curry #t)))

(module curry-new/mask racket/base
  (require racket/list)

  (provide curry curryr)

  (define (make-curry right?)
    ; mask? -> (or/c exact-nonnegative-integer? +inf.0 #f)
    ;
    ; Calculates the maximum number of arguments a function with the given arity may be applied to. If
    ; an unbounded number of arguments are permitted, returns +inf.0. If no number of arguments is valid
    ; (that is, the procedure is uninvokable), returns #f.
    (define (arity-upper-bound mask)
      (cond
        [(eqv? mask 0) #f]
        [(negative? mask) +inf.0]
        [else (integer-length (sub1 mask))]))

    ; mask? exact-nonnegative-integer? -> mask?
    ;
    ; Calculates the positional argument arity for a function produced by `curry` that has already been
    ; applied to num-args-so-far arguments.
    (define (partially-applied-procedure-arity-mask mask num-args-so-far)
      (if (negative? mask)
          -1
          (sub1 (arithmetic-shift 1 (- (integer-length mask) num-args-so-far)))))

    (define who (if right? 'curryr 'curry))

    ;; the actual implementation of curry[r] is here
    (define (do-curry f)
      (unless (procedure? f)
        (raise-argument-error who "procedure?" f))
      (let*-values ([(name) (object-name f)]
                    [(curried-name) (if (symbol? name)
                                        (string->symbol (string-append "curried:"
                                                                       (symbol->string name)))
                                        'curried)]
                    [(mask) (procedure-arity-mask f)]
                    [(max-arity) (arity-upper-bound mask)]
                    [(required-kws allowed-kws) (procedure-keywords f)])
        (cond
          ;; fast path for functions that don't accept any keywords
          [(null? allowed-kws)
           (define (reduce-arity/rename proc num-args-so-far)
             (procedure-reduce-arity-mask
              proc
              (partially-applied-procedure-arity-mask mask num-args-so-far)
              curried-name))

           ; builds a curried version of f with the appropriate arity
           (define (make-curried args-so-far)
             (reduce-arity/rename
              (lambda args
                (step (if right?
                          (append args args-so-far)
                          (append args-so-far args))))
              (length args-so-far)))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step args-so-far)
             (if (procedure-arity-includes? f (length args-so-far))
                 (apply f args-so-far)
                 (make-curried args-so-far)))

           (reduce-arity/rename
            (lambda args
              (if (= (length args) max-arity)
                  (apply f args)
                  (make-curried args)))
            0)]

          ;; slow path for functions that accept keywords
          [else
           ; builds a curried version of f with the appropriate arity
           (define (make-curried kw+args-so-far pos-args-so-far first?)
             (define (incorporate-new-kw+args kw+args)
               (for/fold ([kw+args kw+args-so-far])
                         ([(kw arg) (in-hash kw+args)])
                 (if (hash-has-key? kw+args kw)
                     (raise-arguments-error
                      curried-name
                      "duplicate keyword for procedure"
                      "keyword" kw
                      "first value" (hash-ref kw+args kw)
                      "second value" arg)
                     (hash-set kw+args kw arg))))
             (define (incorporate-new-pos-args args)
               (append (if right? args (reverse args)) pos-args-so-far))

             (define curried
               (make-keyword-procedure
                (lambda (kws kw-args . args)
                  (step (let ([kw+args (make-immutable-hasheq (map cons kws kw-args))])
                          (incorporate-new-kw+args kw+args))
                        (incorporate-new-pos-args args)
                        first?))
                (lambda args
                  (step kw+args-so-far (incorporate-new-pos-args args) first?))))
             (procedure-reduce-keyword-arity-mask
              curried
              (partially-applied-procedure-arity-mask mask (length pos-args-so-far))
              '()
              (and allowed-kws
                   (filter (lambda (kw) (not (hash-has-key? kw+args-so-far kw))) allowed-kws))
              curried-name))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step kw+args-so-far pos-args-so-far first?)
             (if (if first?
                     (and (= (length pos-args-so-far) max-arity)
                          allowed-kws
                          (for/and ([allowed-kw (in-list allowed-kws)])
                            (hash-has-key? kw+args-so-far allowed-kw)))
                     (and (procedure-arity-includes? f (length pos-args-so-far) #t)
                          (for/and ([required-kw (in-list required-kws)])
                            (hash-has-key? kw+args-so-far required-kw))))
                 (let* ([sorted-kw+args (sort (hash->list kw+args-so-far) keyword<? #:key car)]
                        [kws (map car sorted-kw+args)]
                        [kw-args (map cdr sorted-kw+args)])
                   (keyword-apply f kws kw-args (if right? pos-args-so-far (reverse pos-args-so-far))))
                 (make-curried kw+args-so-far pos-args-so-far #f)))

           (make-curried #hasheq() '() #t)])))

    ;; curry itself is curried; if we get any args, immediately invoke the curried function with them
    (procedure-rename
     (make-keyword-procedure
      (lambda (kws kw-args f . args)
        (let ([curried (do-curry f)])
          (if (null? kws)
              (if (null? args)
                  curried
                  (apply curried args))
              (keyword-apply curried kws kw-args args))))
      (case-lambda
        [(f) (do-curry f)]
        [(f . args) (apply (do-curry f) args)]))
     who))

  (define curry  (make-curry #f))
  (define curryr (make-curry #t)))

(module curry-new-no-rename racket/base
  (require racket/list)

  (provide curry curryr)

  (define (make-curry right?)
    ; normalized-arity? -> (or/c exact-nonnegative-integer? +inf.0 #f)
    ;
    ; Calculates the maximum number of arguments a function with the given arity may be applied to. If
    ; an unbounded number of arguments are permitted, returns +inf.0. If no number of arguments is valid
    ; (that is, the procedure is uninvokable), returns #f.
    (define (normalized-arity-upper-bound arity)
      (cond
        [(null? arity) #f]
        [(exact-integer? arity) arity]
        [(arity-at-least? arity) +inf.0]
        [(list? arity) (normalized-arity-upper-bound (last arity))]))

    ; normalized-arity? exact-nonnegative-integer? -> normalized-arity?
    ;
    ; Calculates the positional argument arity for a function produced by `curry` that has already been
    ; applied to num-args-so-far arguments.
    (define (partially-applied-procedure-arity full-normalized-arity num-args-so-far)
      (cond
        ; If the procedure can't be applied at all, the arity doesn't change.
        [(null? full-normalized-arity)
         '()]
        ; If the procedure expects exactly n arguments, then the curried version accepts any number of
        ; arguments in the range [0, n - num-args-so-far].
        [(exact-integer? full-normalized-arity)
         (range 0 (add1 (- full-normalized-arity num-args-so-far)))]
        ; If the procedure accepts an unbounded number of arguments, subsequent curried applications can
        ; supply any number of arguments.
        [(arity-at-least? full-normalized-arity)
         (arity-at-least 0)]
        ; If the procedure can be called at multiple arities, use the greatest one, which will always be
        ; the last arity in the list if the arity is normalized.
        [(list? full-normalized-arity)
         (partially-applied-procedure-arity (last full-normalized-arity) num-args-so-far)]))

    (define who (if right? 'curryr 'curry))

    ;; the actual implementation of curry[r] is here
    (define (do-curry f)
      (unless (procedure? f)
        (raise-argument-error who "procedure?" f))
      (let*-values ([(arity) (procedure-arity f)]
                    [(max-arity) (normalized-arity-upper-bound arity)]
                    [(required-kws allowed-kws) (procedure-keywords f)])
        (cond
          ;; fast path for functions that don't accept any keywords
          [(null? allowed-kws)
           (define (reduce-arity/rename proc num-args-so-far)
             (procedure-reduce-arity
              proc
              (partially-applied-procedure-arity arity num-args-so-far)))

           ; builds a curried version of f with the appropriate arity
           (define (make-curried args-so-far)
             (reduce-arity/rename
              (lambda args
                (step (if right?
                          (append args args-so-far)
                          (append args-so-far args))))
              (length args-so-far)))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step args-so-far)
             (if (procedure-arity-includes? f (length args-so-far))
                 (apply f args-so-far)
                 (make-curried args-so-far)))

           (reduce-arity/rename
            (lambda args
              (if (= (length args) max-arity)
                  (apply f args)
                  (make-curried args)))
            0)]

          ;; slow path for functions that accept keywords
          [else (error)])))

    ;; curry itself is curried; if we get any args, immediately invoke the curried function with them
    (procedure-rename
     (make-keyword-procedure
      (lambda (kws kw-args f . args)
        (let ([curried (do-curry f)])
          (if (null? kws)
              (if (null? args)
                  curried
                  (apply curried args))
              (keyword-apply curried kws kw-args args))))
      (case-lambda
        [(f) (do-curry f)]
        [(f . args) (apply (do-curry f) args)]))
     who))

  (define curry  (make-curry #f))
  (define curryr (make-curry #t)))

(module curry-new-only-rename racket/base
  (require racket/list)

  (provide curry curryr)

  (define (make-curry right?)
    ; normalized-arity? -> (or/c exact-nonnegative-integer? +inf.0 #f)
    ;
    ; Calculates the maximum number of arguments a function with the given arity may be applied to. If
    ; an unbounded number of arguments are permitted, returns +inf.0. If no number of arguments is valid
    ; (that is, the procedure is uninvokable), returns #f.
    (define (normalized-arity-upper-bound arity)
      (cond
        [(null? arity) #f]
        [(exact-integer? arity) arity]
        [(arity-at-least? arity) +inf.0]
        [(list? arity) (normalized-arity-upper-bound (last arity))]))

    ; normalized-arity? exact-nonnegative-integer? -> normalized-arity?
    ;
    ; Calculates the positional argument arity for a function produced by `curry` that has already been
    ; applied to num-args-so-far arguments.
    (define (partially-applied-procedure-arity full-normalized-arity num-args-so-far)
      (cond
        ; If the procedure can't be applied at all, the arity doesn't change.
        [(null? full-normalized-arity)
         '()]
        ; If the procedure expects exactly n arguments, then the curried version accepts any number of
        ; arguments in the range [0, n - num-args-so-far].
        [(exact-integer? full-normalized-arity)
         (range 0 (add1 (- full-normalized-arity num-args-so-far)))]
        ; If the procedure accepts an unbounded number of arguments, subsequent curried applications can
        ; supply any number of arguments.
        [(arity-at-least? full-normalized-arity)
         (arity-at-least 0)]
        ; If the procedure can be called at multiple arities, use the greatest one, which will always be
        ; the last arity in the list if the arity is normalized.
        [(list? full-normalized-arity)
         (partially-applied-procedure-arity (last full-normalized-arity) num-args-so-far)]))

    (define who (if right? 'curryr 'curry))

    ;; the actual implementation of curry[r] is here
    (define (do-curry f)
      (unless (procedure? f)
        (raise-argument-error who "procedure?" f))
      (let*-values ([(name) (object-name f)]
                    [(curried-name) (if (symbol? name)
                                        (string->symbol (string-append "curried:"
                                                                       (symbol->string name)))
                                        'curried)]
                    [(arity) (procedure-arity f)]
                    [(max-arity) (normalized-arity-upper-bound arity)]
                    [(required-kws allowed-kws) (procedure-keywords f)])
        (cond
          ;; fast path for functions that don't accept any keywords
          [(null? allowed-kws)
           (define (reduce-arity/rename proc num-args-so-far)
             (procedure-rename proc curried-name))

           ; builds a curried version of f with the appropriate arity
           (define (make-curried args-so-far)
             (reduce-arity/rename
              (lambda args
                (step (if right?
                          (append args args-so-far)
                          (append args-so-far args))))
              (length args-so-far)))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step args-so-far)
             (if (procedure-arity-includes? f (length args-so-far))
                 (apply f args-so-far)
                 (make-curried args-so-far)))

           (reduce-arity/rename
            (lambda args
              (if (= (length args) max-arity)
                  (apply f args)
                  (make-curried args)))
            0)]

          ;; slow path for functions that accept keywords
          [else
           ; builds a curried version of f with the appropriate arity
           (define (make-curried kw+args-so-far pos-args-so-far first?)
             (define (incorporate-new-kw+args kw+args)
               (for/fold ([kw+args kw+args-so-far])
                         ([(kw arg) (in-hash kw+args)])
                 (if (hash-has-key? kw+args kw)
                     (raise-arguments-error
                      curried-name
                      "duplicate keyword for procedure"
                      "keyword" kw
                      "first value" (hash-ref kw+args kw)
                      "second value" arg)
                     (hash-set kw+args kw arg))))
             (define (incorporate-new-pos-args args)
               (append (if right? args (reverse args)) pos-args-so-far))

             (define curried
               (make-keyword-procedure
                (lambda (kws kw-args . args)
                  (step (let ([kw+args (make-immutable-hasheq (map cons kws kw-args))])
                          (incorporate-new-kw+args kw+args))
                        (incorporate-new-pos-args args)
                        first?))
                (lambda args
                  (step kw+args-so-far (incorporate-new-pos-args args) first?))))
             (define curried/reduced-arity
               (procedure-reduce-keyword-arity
                curried
                (partially-applied-procedure-arity arity (length pos-args-so-far))
                '()
                (and allowed-kws
                     (filter (lambda (kw) (not (hash-has-key? kw+args-so-far kw))) allowed-kws))))
             (procedure-rename curried/reduced-arity curried-name))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step kw+args-so-far pos-args-so-far first?)
             (if (if first?
                     (and (= (length pos-args-so-far) max-arity)
                          allowed-kws
                          (for/and ([allowed-kw (in-list allowed-kws)])
                            (hash-has-key? kw+args-so-far allowed-kw)))
                     (and (procedure-arity-includes? f (length pos-args-so-far) #t)
                          (for/and ([required-kw (in-list required-kws)])
                            (hash-has-key? kw+args-so-far required-kw))))
                 (let* ([sorted-kw+args (sort (hash->list kw+args-so-far) keyword<? #:key car)]
                        [kws (map car sorted-kw+args)]
                        [kw-args (map cdr sorted-kw+args)])
                   (keyword-apply f kws kw-args (if right? pos-args-so-far (reverse pos-args-so-far))))
                 (make-curried kw+args-so-far pos-args-so-far #f)))

           (make-curried #hasheq() '() #t)])))

    ;; curry itself is curried; if we get any args, immediately invoke the curried function with them
    (procedure-rename
     (make-keyword-procedure
      (lambda (kws kw-args f . args)
        (let ([curried (do-curry f)])
          (if (null? kws)
              (if (null? args)
                  curried
                  (apply curried args))
              (keyword-apply curried kws kw-args args))))
      (case-lambda
        [(f) (do-curry f)]
        [(f . args) (apply (do-curry f) args)]))
     who))

  (define curry  (make-curry #f))
  (define curryr (make-curry #t)))

(module curry-new-neither racket/base
  (require racket/list)

  (provide curry curryr)

  (define (make-curry right?)
    ; normalized-arity? -> (or/c exact-nonnegative-integer? +inf.0 #f)
    ;
    ; Calculates the maximum number of arguments a function with the given arity may be applied to. If
    ; an unbounded number of arguments are permitted, returns +inf.0. If no number of arguments is valid
    ; (that is, the procedure is uninvokable), returns #f.
    (define (normalized-arity-upper-bound arity)
      (cond
        [(null? arity) #f]
        [(exact-integer? arity) arity]
        [(arity-at-least? arity) +inf.0]
        [(list? arity) (normalized-arity-upper-bound (last arity))]))

    ; normalized-arity? exact-nonnegative-integer? -> normalized-arity?
    ;
    ; Calculates the positional argument arity for a function produced by `curry` that has already been
    ; applied to num-args-so-far arguments.
    (define (partially-applied-procedure-arity full-normalized-arity num-args-so-far)
      (cond
        ; If the procedure can't be applied at all, the arity doesn't change.
        [(null? full-normalized-arity)
         '()]
        ; If the procedure expects exactly n arguments, then the curried version accepts any number of
        ; arguments in the range [0, n - num-args-so-far].
        [(exact-integer? full-normalized-arity)
         (range 0 (add1 (- full-normalized-arity num-args-so-far)))]
        ; If the procedure accepts an unbounded number of arguments, subsequent curried applications can
        ; supply any number of arguments.
        [(arity-at-least? full-normalized-arity)
         (arity-at-least 0)]
        ; If the procedure can be called at multiple arities, use the greatest one, which will always be
        ; the last arity in the list if the arity is normalized.
        [(list? full-normalized-arity)
         (partially-applied-procedure-arity (last full-normalized-arity) num-args-so-far)]))

    (define who (if right? 'curryr 'curry))

    ;; the actual implementation of curry[r] is here
    (define (do-curry f)
      (unless (procedure? f)
        (raise-argument-error who "procedure?" f))
      (let*-values ([(arity) (procedure-arity f)]
                    [(max-arity) (normalized-arity-upper-bound arity)]
                    [(required-kws allowed-kws) (procedure-keywords f)])
        (cond
          ;; fast path for functions that don't accept any keywords
          [(null? allowed-kws)
           (define accumulate-args
             (if right?
                 (λ (args-so-far new-args) (append new-args args-so-far))
                 (λ (args-so-far new-args) (append args-so-far new-args))))

           ; builds a curried version of f with the appropriate arity
           (define (make-curried args-so-far)
             (lambda args
               (step (accumulate-args args-so-far args))))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step args-so-far)
             (if (procedure-arity-includes? f (length args-so-far))
                 (apply f args-so-far)
                 (make-curried args-so-far)))

           (lambda args
             (if (= (length args) max-arity)
                 (apply f args)
                 (make-curried args)))]

          ;; slow path for functions that accept keywords
          [else (error "no keywords allowed in neither impl")])))

    ;; curry itself is curried; if we get any args, immediately invoke the curried function with them
    (make-keyword-procedure
     (lambda (kws kw-args f . args)
       (let ([curried (do-curry f)])
         (if (null? kws)
             (if (null? args)
                 curried
                 (apply curried args))
             (keyword-apply curried kws kw-args args))))
     (case-lambda
       [(f) (do-curry f)]
       [(f . args) (apply (do-curry f) args)])))

  (define curry  (make-curry #f))
  (define curryr (make-curry #t)))

(module curry-new-custom-reduce racket/base
  (require racket/list)

  (provide curry curryr)

  (define (make-curry right?)
    ; normalized-arity? -> (or/c exact-nonnegative-integer? +inf.0 #f)
    ;
    ; Calculates the maximum number of arguments a function with the given arity may be applied to. If
    ; an unbounded number of arguments are permitted, returns +inf.0. If no number of arguments is valid
    ; (that is, the procedure is uninvokable), returns #f.
    (define (normalized-arity-upper-bound arity)
      (cond
        [(null? arity) #f]
        [(exact-integer? arity) arity]
        [(arity-at-least? arity) +inf.0]
        [(list? arity) (normalized-arity-upper-bound (last arity))]))

    ; normalized-arity? exact-nonnegative-integer? -> normalized-arity?
    ;
    ; Calculates the positional argument arity for a function produced by `curry` that has already been
    ; applied to num-args-so-far arguments.
    (define (partially-applied-procedure-arity full-normalized-arity num-args-so-far)
      (cond
        ; If the procedure can't be applied at all, the arity doesn't change.
        [(null? full-normalized-arity)
         '()]
        ; If the procedure expects exactly n arguments, then the curried version accepts any number of
        ; arguments in the range [0, n - num-args-so-far].
        [(exact-integer? full-normalized-arity)
         (range 0 (add1 (- full-normalized-arity num-args-so-far)))]
        ; If the procedure accepts an unbounded number of arguments, subsequent curried applications can
        ; supply any number of arguments.
        [(arity-at-least? full-normalized-arity)
         (arity-at-least 0)]
        ; If the procedure can be called at multiple arities, use the greatest one, which will always be
        ; the last arity in the list if the arity is normalized.
        [(list? full-normalized-arity)
         (partially-applied-procedure-arity (last full-normalized-arity) num-args-so-far)]))

    (define (num-args-matches-arity? num-args arity)
      (cond
        [(exact-integer? arity)
         (= num-args arity)]
        [(arity-at-least? arity)
         (>= num-args (arity-at-least-value arity))]
        [(list? arity)
         (ormap (λ (arity) (num-args-matches-arity? num-args arity)) arity)]))

    (define (procedure-reduce-arity proc arity)
      (lambda args
        (unless (num-args-matches-arity? (length args) arity)
          (error (object-name proc) "wrong number of arguments"))
        (apply proc args)))

    (define who (if right? 'curryr 'curry))

    ;; the actual implementation of curry[r] is here
    (define (do-curry f)
      (unless (procedure? f)
        (raise-argument-error who "procedure?" f))
      (let*-values ([(name) (object-name f)]
                    [(curried-name) (if (symbol? name)
                                        (string->symbol (string-append "curried:"
                                                                       (symbol->string name)))
                                        'curried)]
                    [(arity) (procedure-arity f)]
                    [(max-arity) (normalized-arity-upper-bound arity)]
                    [(required-kws allowed-kws) (procedure-keywords f)])
        (cond
          ;; fast path for functions that don't accept any keywords
          [(null? allowed-kws)
           (define (reduce-arity/rename proc num-args-so-far)
             (procedure-rename
              (procedure-reduce-arity
               proc
               (partially-applied-procedure-arity arity num-args-so-far))
              curried-name))

           ; builds a curried version of f with the appropriate arity
           (define (make-curried args-so-far)
             (reduce-arity/rename
              (lambda args
                (step (if right?
                          (append args args-so-far)
                          (append args-so-far args))))
              (length args-so-far)))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step args-so-far)
             (if (procedure-arity-includes? f (length args-so-far))
                 (apply f args-so-far)
                 (make-curried args-so-far)))

           (reduce-arity/rename
            (lambda args
              (if (= (length args) max-arity)
                  (apply f args)
                  (make-curried args)))
            0)]

          ;; slow path for functions that accept keywords
          [else
           ; builds a curried version of f with the appropriate arity
           (define (make-curried kw+args-so-far pos-args-so-far first?)
             (define (incorporate-new-kw+args kw+args)
               (for/fold ([kw+args kw+args-so-far])
                         ([(kw arg) (in-hash kw+args)])
                 (if (hash-has-key? kw+args kw)
                     (raise-arguments-error
                      curried-name
                      "duplicate keyword for procedure"
                      "keyword" kw
                      "first value" (hash-ref kw+args kw)
                      "second value" arg)
                     (hash-set kw+args kw arg))))
             (define (incorporate-new-pos-args args)
               (append (if right? args (reverse args)) pos-args-so-far))

             (define curried
               (make-keyword-procedure
                (lambda (kws kw-args . args)
                  (step (let ([kw+args (make-immutable-hasheq (map cons kws kw-args))])
                          (incorporate-new-kw+args kw+args))
                        (incorporate-new-pos-args args)
                        first?))
                (lambda args
                  (step kw+args-so-far (incorporate-new-pos-args args) first?))))
             (define curried/reduced-arity
               (procedure-reduce-keyword-arity
                curried
                (partially-applied-procedure-arity arity (length pos-args-so-far))
                '()
                (and allowed-kws
                     (filter (lambda (kw) (not (hash-has-key? kw+args-so-far kw))) allowed-kws))))
             (procedure-rename curried/reduced-arity curried-name))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step kw+args-so-far pos-args-so-far first?)
             (if (if first?
                     (and (= (length pos-args-so-far) max-arity)
                          allowed-kws
                          (for/and ([allowed-kw (in-list allowed-kws)])
                            (hash-has-key? kw+args-so-far allowed-kw)))
                     (and (procedure-arity-includes? f (length pos-args-so-far) #t)
                          (for/and ([required-kw (in-list required-kws)])
                            (hash-has-key? kw+args-so-far required-kw))))
                 (let* ([sorted-kw+args (sort (hash->list kw+args-so-far) keyword<? #:key car)]
                        [kws (map car sorted-kw+args)]
                        [kw-args (map cdr sorted-kw+args)])
                   (keyword-apply f kws kw-args (if right? pos-args-so-far (reverse pos-args-so-far))))
                 (make-curried kw+args-so-far pos-args-so-far #f)))

           (make-curried #hasheq() '() #t)])))

    ;; curry itself is curried; if we get any args, immediately invoke the curried function with them
    (procedure-rename
     (make-keyword-procedure
      (lambda (kws kw-args f . args)
        (let ([curried (do-curry f)])
          (if (null? kws)
              (if (null? args)
                  curried
                  (apply curried args))
              (keyword-apply curried kws kw-args args))))
      (case-lambda
        [(f) (do-curry f)]
        [(f . args) (apply (do-curry f) args)]))
     who))

  (define curry  (make-curry #f))
  (define curryr (make-curry #t)))

(module curry-new-custom-reduce-no-rename racket/base
  (require racket/list)

  (provide curry curryr)

  (define (make-curry right?)
    ; normalized-arity? -> (or/c exact-nonnegative-integer? +inf.0 #f)
    ;
    ; Calculates the maximum number of arguments a function with the given arity may be applied to. If
    ; an unbounded number of arguments are permitted, returns +inf.0. If no number of arguments is valid
    ; (that is, the procedure is uninvokable), returns #f.
    (define (normalized-arity-upper-bound arity)
      (cond
        [(null? arity) #f]
        [(exact-integer? arity) arity]
        [(arity-at-least? arity) +inf.0]
        [(list? arity) (normalized-arity-upper-bound (last arity))]))

    ; normalized-arity? exact-nonnegative-integer? -> normalized-arity?
    ;
    ; Calculates the positional argument arity for a function produced by `curry` that has already been
    ; applied to num-args-so-far arguments.
    (define (partially-applied-procedure-arity full-normalized-arity num-args-so-far)
      (cond
        ; If the procedure can't be applied at all, the arity doesn't change.
        [(null? full-normalized-arity)
         '()]
        ; If the procedure expects exactly n arguments, then the curried version accepts any number of
        ; arguments in the range [0, n - num-args-so-far].
        [(exact-integer? full-normalized-arity)
         (range 0 (add1 (- full-normalized-arity num-args-so-far)))]
        ; If the procedure accepts an unbounded number of arguments, subsequent curried applications can
        ; supply any number of arguments.
        [(arity-at-least? full-normalized-arity)
         (arity-at-least 0)]
        ; If the procedure can be called at multiple arities, use the greatest one, which will always be
        ; the last arity in the list if the arity is normalized.
        [(list? full-normalized-arity)
         (partially-applied-procedure-arity (last full-normalized-arity) num-args-so-far)]))

    (define (num-args-matches-arity? num-args arity)
      (cond
        [(exact-integer? arity)
         (= num-args arity)]
        [(arity-at-least? arity)
         (>= num-args (arity-at-least-value arity))]
        [(list? arity)
         (ormap (λ (arity) (num-args-matches-arity? num-args arity)) arity)]))

    (define (procedure-reduce-arity proc arity)
      (lambda args
        (unless (num-args-matches-arity? (length args) arity)
          (error (object-name proc) "wrong number of arguments"))
        (apply proc args)))

    (define who (if right? 'curryr 'curry))

    ;; the actual implementation of curry[r] is here
    (define (do-curry f)
      (unless (procedure? f)
        (raise-argument-error who "procedure?" f))
      (let*-values ([(arity) (procedure-arity f)]
                    [(max-arity) (normalized-arity-upper-bound arity)]
                    [(required-kws allowed-kws) (procedure-keywords f)])
        (cond
          ;; fast path for functions that don't accept any keywords
          [(null? allowed-kws)
           (define (reduce-arity/rename proc num-args-so-far)
             (procedure-reduce-arity
              proc
              (partially-applied-procedure-arity arity num-args-so-far)))

           ; builds a curried version of f with the appropriate arity
           (define (make-curried args-so-far)
             (reduce-arity/rename
              (lambda args
                (step (if right?
                          (append args args-so-far)
                          (append args-so-far args))))
              (length args-so-far)))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step args-so-far)
             (if (procedure-arity-includes? f (length args-so-far))
                 (apply f args-so-far)
                 (make-curried args-so-far)))

           (reduce-arity/rename
            (lambda args
              (if (= (length args) max-arity)
                  (apply f args)
                  (make-curried args)))
            0)]

          ;; slow path for functions that accept keywords
          [else (error)])))

    ;; curry itself is curried; if we get any args, immediately invoke the curried function with them
    (procedure-rename
     (make-keyword-procedure
      (lambda (kws kw-args f . args)
        (let ([curried (do-curry f)])
          (if (null? kws)
              (if (null? args)
                  curried
                  (apply curried args))
              (keyword-apply curried kws kw-args args))))
      (case-lambda
        [(f) (do-curry f)]
        [(f . args) (apply (do-curry f) args)]))
     who))

  (define curry  (make-curry #f))
  (define curryr (make-curry #t)))

(module curry-new-optimized-reduce-no-rename racket/base
  (require racket/list)

  (provide curry curryr)

  (define (make-curry right?)
    ; normalized-arity? -> (or/c exact-nonnegative-integer? +inf.0 #f)
    ;
    ; Calculates the maximum number of arguments a function with the given arity may be applied to. If
    ; an unbounded number of arguments are permitted, returns +inf.0. If no number of arguments is valid
    ; (that is, the procedure is uninvokable), returns #f.
    (define (normalized-arity-upper-bound arity)
      (cond
        [(null? arity) #f]
        [(exact-integer? arity) arity]
        [(arity-at-least? arity) +inf.0]
        [(list? arity) (normalized-arity-upper-bound (last arity))]))

    ; normalized-arity? exact-nonnegative-integer? -> normalized-arity?
    ;
    ; Calculates the positional argument arity for a function produced by `curry` that has already been
    ; applied to num-args-so-far arguments.
    (define (partially-applied-procedure-arity full-normalized-arity num-args-so-far)
      (cond
        ; If the procedure can't be applied at all, the arity doesn't change.
        [(null? full-normalized-arity)
         '()]
        ; If the procedure expects exactly n arguments, then the curried version accepts any number of
        ; arguments in the range [0, n - num-args-so-far].
        [(exact-integer? full-normalized-arity)
         (range 0 (add1 (- full-normalized-arity num-args-so-far)))]
        ; If the procedure accepts an unbounded number of arguments, subsequent curried applications can
        ; supply any number of arguments.
        [(arity-at-least? full-normalized-arity)
         (arity-at-least 0)]
        ; If the procedure can be called at multiple arities, use the greatest one, which will always be
        ; the last arity in the list if the arity is normalized.
        [(list? full-normalized-arity)
         (partially-applied-procedure-arity (last full-normalized-arity) num-args-so-far)]))

    (define (num-args-matches-arity? num-args arity)
      (cond
        [(exact-integer? arity)
         (= num-args arity)]
        [(arity-at-least? arity)
         (>= num-args (arity-at-least-value arity))]
        [(list? arity)
         (ormap (λ (arity) (num-args-matches-arity? num-args arity)) arity)]))

    (define (procedure-reduce-arity proc arity)
      (if (exact-integer? arity)
          (cond
            [(= 0 arity)
             (lambda () (proc))]
            [(= 1 arity)
             (lambda (a) (proc a))]
            [(= 2 arity)
             (lambda (a b) (proc a b))]
            [(= 3 arity)
             (lambda (a b c) (proc a b c))]
            [else
             (lambda args
               (unless (= (length args) arity)
                 (error (object-name proc) "wrong number of arguments"))
               (apply proc args))])
          (lambda args
            (unless (num-args-matches-arity? (length args) arity)
              (error (object-name proc) "wrong number of arguments"))
            (apply proc args))))

    (define who (if right? 'curryr 'curry))

    ;; the actual implementation of curry[r] is here
    (define (do-curry f)
      (unless (procedure? f)
        (raise-argument-error who "procedure?" f))
      (let*-values ([(arity) (procedure-arity f)]
                    [(max-arity) (normalized-arity-upper-bound arity)]
                    [(required-kws allowed-kws) (procedure-keywords f)])
        (cond
          ;; fast path for functions that don't accept any keywords
          [(null? allowed-kws)
           (define (reduce-arity/rename proc num-args-so-far)
             (procedure-reduce-arity
              proc
              (partially-applied-procedure-arity arity num-args-so-far)))

           ; builds a curried version of f with the appropriate arity
           (define (make-curried args-so-far)
             (reduce-arity/rename
              (lambda args
                (step (if right?
                          (append args args-so-far)
                          (append args-so-far args))))
              (length args-so-far)))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step args-so-far)
             (if (procedure-arity-includes? f (length args-so-far))
                 (apply f args-so-far)
                 (make-curried args-so-far)))

           (reduce-arity/rename
            (lambda args
              (if (= (length args) max-arity)
                  (apply f args)
                  (make-curried args)))
            0)]

          ;; slow path for functions that accept keywords
          [else (error)])))

    ;; curry itself is curried; if we get any args, immediately invoke the curried function with them
    (procedure-rename
     (make-keyword-procedure
      (lambda (kws kw-args f . args)
        (let ([curried (do-curry f)])
          (if (null? kws)
              (if (null? args)
                  curried
                  (apply curried args))
              (keyword-apply curried kws kw-args args))))
      (case-lambda
        [(f) (do-curry f)]
        [(f . args) (apply (do-curry f) args)]))
     who))

  (define curry  (make-curry #f))
  (define curryr (make-curry #t)))

(module curry-old-optimized racket/base
  (require racket/list)

  (provide curry curryr)

  (define (make-curry right?)
    ; normalized-arity? -> (or/c exact-nonnegative-integer? +inf.0 #f)
    ;
    ; Calculates the maximum number of arguments a function with the given arity may be applied to. If
    ; an unbounded number of arguments are permitted, returns +inf.0. If no number of arguments is valid
    ; (that is, the procedure is uninvokable), returns #f.
    (define (normalized-arity-upper-bound arity)
      (cond
        [(null? arity) #f]
        [(exact-integer? arity) arity]
        [(arity-at-least? arity) +inf.0]
        [(list? arity) (normalized-arity-upper-bound (last arity))]))

    (define who (if right? 'curryr 'curry))

    ;; the actual implementation of curry[r] is here
    (define (do-curry f)
      (unless (procedure? f)
        (raise-argument-error who "procedure?" f))
      (let ([max-arity (normalized-arity-upper-bound (procedure-arity f))])
        ; builds a curried version of f with the appropriate arity
        (define ((make-curried pos-args-so-far) . args)
          (step (append (if right? args (reverse args)) pos-args-so-far)))

        ; handles a curried application and applies f if enough arguments have been accumulated,
        ; otherwise produces a new curried function
        (define (step pos-args-so-far)
          (if (procedure-arity-includes? f (length pos-args-so-far))
              (apply f (if right? pos-args-so-far (reverse pos-args-so-far)))
              (make-curried pos-args-so-far)))

        (lambda args
          (if (= (length args) max-arity)
              (apply f args)
              (make-curried args)))))

    ;; curry itself is curried; if we get any args, immediately invoke the curried function with them
    (case-lambda
      [(f) (do-curry f)]
      [(f . args) (apply (do-curry f) args)]))

  (define curry  (make-curry #f))
  (define curryr (make-curry #t)))

(module curry-new-optimized racket/base
  (require racket/list)

  (provide curry curryr)

  (define (make-curry right?)
    ; normalized-arity? -> (or/c exact-nonnegative-integer? +inf.0 #f)
    ;
    ; Calculates the maximum number of arguments a function with the given arity may be applied to. If
    ; an unbounded number of arguments are permitted, returns +inf.0. If no number of arguments is valid
    ; (that is, the procedure is uninvokable), returns #f.
    (define (normalized-arity-upper-bound arity)
      (cond
        [(null? arity) #f]
        [(exact-integer? arity) arity]
        [(arity-at-least? arity) +inf.0]
        [(list? arity) (normalized-arity-upper-bound (last arity))]))

    ; normalized-arity? exact-nonnegative-integer? -> normalized-arity?
    ;
    ; Calculates the positional argument arity for a function produced by `curry` that has already been
    ; applied to num-args-so-far arguments.
    (define (partially-applied-procedure-arity full-normalized-arity num-args-so-far)
      (cond
        ; If the procedure can't be applied at all, the arity doesn't change.
        [(null? full-normalized-arity)
         '()]
        ; If the procedure expects exactly n arguments, then the curried version accepts any number of
        ; arguments in the range [0, n - num-args-so-far].
        [(exact-integer? full-normalized-arity)
         (range 0 (add1 (- full-normalized-arity num-args-so-far)))]
        ; If the procedure accepts an unbounded number of arguments, subsequent curried applications can
        ; supply any number of arguments.
        [(arity-at-least? full-normalized-arity)
         (arity-at-least 0)]
        ; If the procedure can be called at multiple arities, use the greatest one, which will always be
        ; the last arity in the list if the arity is normalized.
        [(list? full-normalized-arity)
         (partially-applied-procedure-arity (last full-normalized-arity) num-args-so-far)]))

    (define who (if right? 'curryr 'curry))

    ;; the actual implementation of curry[r] is here
    (define (do-curry f)
      (unless (procedure? f)
        (raise-argument-error who "procedure?" f))
      (let*-values ([(name) (object-name f)]
                    [(curried-name) (if (symbol? name)
                                        (string->symbol (string-append "curried:"
                                                                       (symbol->string name)))
                                        'curried)]
                    [(arity) (procedure-arity f)]
                    [(max-arity) (normalized-arity-upper-bound arity)]
                    [(required-kws allowed-kws) (procedure-keywords f)])
        (cond
          ;; fast path for functions that don't accept any keywords
          [(null? allowed-kws)
           ; builds a curried version of f with the appropriate arity
           (define ((make-curried pos-args-so-far) . args)
             (step (append (if right? args (reverse args)) pos-args-so-far)))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step pos-args-so-far)
             (if (procedure-arity-includes? f (length pos-args-so-far))
                 (apply f (if right? pos-args-so-far (reverse pos-args-so-far)))
                 (make-curried pos-args-so-far)))

           (lambda args
             (if (= (length args) max-arity)
                 (apply f args)
                 (make-curried args)))]

          ;; slow path for functions that accept keywords
          [else
           ; builds a curried version of f with the appropriate arity
           (define (make-curried kw+args-so-far pos-args-so-far first?)
             (define (incorporate-new-kw+args kw+args)
               (for/fold ([kw+args kw+args-so-far])
                         ([(kw arg) (in-hash kw+args)])
                 (if (hash-has-key? kw+args kw)
                     (raise-arguments-error
                      curried-name
                      "duplicate keyword for procedure"
                      "keyword" kw
                      "first value" (hash-ref kw+args kw)
                      "second value" arg)
                     (hash-set kw+args kw arg))))
             (define (incorporate-new-pos-args args)
               (append (if right? args (reverse args)) pos-args-so-far))

             (define curried
               (make-keyword-procedure
                (lambda (kws kw-args . args)
                  (step (let ([kw+args (make-immutable-hasheq (map cons kws kw-args))])
                          (incorporate-new-kw+args kw+args))
                        (incorporate-new-pos-args args)
                        first?))
                (lambda args
                  (step kw+args-so-far (incorporate-new-pos-args args) first?))))
             (define curried/reduced-arity
               (procedure-reduce-keyword-arity
                curried
                (partially-applied-procedure-arity arity (length pos-args-so-far))
                '()
                (and allowed-kws
                     (filter (lambda (kw) (not (hash-has-key? kw+args-so-far kw))) allowed-kws))))
             (procedure-rename curried/reduced-arity curried-name))

           ; handles a curried application and applies f if enough arguments have been accumulated,
           ; otherwise produces a new curried function
           (define (step kw+args-so-far pos-args-so-far first?)
             (if (if first?
                     (and (= (length pos-args-so-far) max-arity)
                          allowed-kws
                          (for/and ([allowed-kw (in-list allowed-kws)])
                            (hash-has-key? kw+args-so-far allowed-kw)))
                     (and (procedure-arity-includes? f (length pos-args-so-far) #t)
                          (for/and ([required-kw (in-list required-kws)])
                            (hash-has-key? kw+args-so-far required-kw))))
                 (let* ([sorted-kw+args (sort (hash->list kw+args-so-far) keyword<? #:key car)]
                        [kws (map car sorted-kw+args)]
                        [kw-args (map cdr sorted-kw+args)])
                   (keyword-apply f kws kw-args (if right? pos-args-so-far (reverse pos-args-so-far))))
                 (make-curried kw+args-so-far pos-args-so-far #f)))

           (make-curried #hasheq() '() #t)])))

    ;; curry itself is curried; if we get any args, immediately invoke the curried function with them
    (procedure-rename
     (make-keyword-procedure
      (lambda (kws kw-args f . args)
        (let ([curried (do-curry f)])
          (if (null? kws)
              (if (null? args)
                  curried
                  (apply curried args))
              (keyword-apply curried kws kw-args args))))
      (case-lambda
        [(f) (do-curry f)]
        [(f . args) (apply (do-curry f) args)]))
     who))

  (define curry  (make-curry #f))
  (define curryr (make-curry #t)))

(require (prefix-in old: 'curry-old)
         (prefix-in old-optimized: 'curry-old-optimized)
         (prefix-in new: 'curry-new)
         (prefix-in new/mask: 'curry-new/mask)
         (prefix-in new/merge: 'curry-new/merge)
         (prefix-in new-optimized: 'curry-new-optimized)
         (prefix-in only-rename: 'curry-new-only-rename)
         (prefix-in neither: 'curry-new-neither)
         (prefix-in custom-reduce: 'curry-new-custom-reduce)
         (prefix-in no-rename: 'curry-new-no-rename)
         (prefix-in custom-reduce+no-rename: 'curry-new-custom-reduce-no-rename)
         (prefix-in optimized-reduce+no-rename: 'curry-new-optimized-reduce-no-rename))

(require benchmark
         plot)

(define (pos a b) (void))
(define (pos-opt a b [c #f]) (void))
(define (pos-any a b . cs) (void))
(define (pos-many a b c d e f g h i j k) (void))

(define (results)
  (run-benchmarks
   #:extract-time 'delta-time
   #:num-trials 100
   (list 'pos 'pos-opt 'pos-any 'pos-many)
   (list (list 'old #;'old-optimized 'new 'new/no-reduce 'new/no-rename 'new/neither 'new/custom-reduce 'new/custom-reduce+no-rename 'new/optimized-reduce+no-rename 'new/mask 'new/merge #;'new-no-reduce-arity) (list 1000))
   (lambda (op impl iters)
     (let ([curry (case impl
                    [(old) old:curry]
                    [(new) new:curry]
                    [(new/mask) new/mask:curry]
                    [(new/merge) new/merge:curry]
                    [(new/no-reduce) only-rename:curry]
                    [(new/no-rename) no-rename:curry]
                    [(new/neither) neither:curry]
                    [(new/custom-reduce) custom-reduce:curry]
                    [(new/custom-reduce+no-rename) custom-reduce+no-rename:curry]
                    [(new/optimized-reduce+no-rename) optimized-reduce+no-rename:curry]
                    [(old-optimized) old-optimized:curry]
                    [(new-no-reduce-arity) new-optimized:curry])])
       (case op
         [(direct)
          (for ([i (in-range iters)])
            (pos 1 2))]
         [(pos)
          (for ([i (in-range iters)])
            ((curry pos 1) 2))]
         [(pos-opt)
          (for ([i (in-range iters)])
            ((curry pos-opt 1 2) 3))]
         [(pos-any)
          (for ([i (in-range iters)])
            ((curry pos-any 1 2) 3 4))]
         [(pos-many)
          (for ([i (in-range iters)])
            (((((((((((curry pos-many 1) 2) 3) 4) 5) 6) 7) 8) 9) 10) 11))])))))

(void (results)) ; warm

(define warmed-results (results))

(parameterize ([plot-x-ticks no-ticks]
               [plot-font-size 16])
  (plot-file
   #:x-label #f
   #:y-label "average running time (μs)"
   #:width 600
   #:height 600
   (render-benchmark-alts
    #:normalize? #f
    ; default options
    (list 'new 1000)
    warmed-results
    ; format options so we can omit the index in the size list
    #:format-opts (lambda (opts) (format "~a" (car opts)))
    )
   "bench-curry.png"))