Here's I think a nicer version. I omitted the error checking and
renaming, and used a hash table mapping positions (starting from 0) to
values to be supplied for that argument. It's rather inefficient but
could be easily optimized.

#lang racket

(define (reduce-arity f h)
  (λ args
    (define h* (for/fold ([h h]) ([a args])
                (hash-set h (next-index h) a)))
    (define sorted (sort (hash-map h* cons) < #:key car))

    (apply f (map cdr sorted))))

(define (next-index h)
  (for/first ([i (in-naturals)] #:unless (hash-has-key? h i)) i))

(require rackunit)

(define f (λ (a b c d) (list a b c d)))
(define g (reduce-arity f (hash 0 1 2 3)))
(check-equal? (f 1 2 3 4) (g 2 4))
On Fri, Oct 12, 2018 at 10:50 AM Matthew Butterick <m...@mbtype.com> wrote:
>
> I know about `curry` and `curryr`, of course. But is there a way to 
> accomplish arbitrary currying at run time (not just at the ends of the 
> argument list)? (Or is it called partial application?)
>
> Let's suppose we have `f`:
>
> (define f (λ (a b c d) (+ a b c d)))
> (f 1 2 3 4) ; 10
>
> And we want to reduce the arity of `f` by supplying 1 as the first arugment 
> and 3 as the third. Maybe we write this like so:
>
> (define g (reduce-arity f '(1 b 3 d)))
>
> Where the '(1 b 3 d) notation matches the arity of `f`, and denotes "use 1 
> for the first argument, 3 for the third argument, and then leave the other 
> two arguments alone." (This is not ideal notation because it precludes the 
> use of symbols as applied value, but let's leave that aside.)
>
> So `g` would end up as a 2-arity function:
>
> (define g (λ (b d) (f 1 b 3 d))
> (g 2 4) ; 10
>
>
> I came up with the idea below, but it seems brutal, even by my standards.
>
>
> #lang racket
> (require rackunit)
>
> (define (reduce-arity proc pattern)
>   (unless (= (length pattern) (procedure-arity proc))
>     (raise-argument-error 'reduce-arity (format "list of length ~a, same as 
> procedure arity" (procedure-arity proc)) pattern))
>   (define reduced-arity-name (string->symbol (format "reduced-arity-~a" 
> (object-name proc))))
>   (define-values (id-names vals) (partition symbol? pattern))
>   (define new-arity (length id-names))
>   (procedure-rename
>    (λ xs
>      (unless (= (length xs) new-arity)
>        (apply raise-arity-error reduced-arity-name new-arity xs))
>      (apply proc (for/fold ([acc empty]
>                             [xs xs]
>                             [vals vals]
>                             #:result (reverse acc))
>                            ([pat-item (in-list pattern)])
>                    (if (symbol? pat-item)
>                        (values (cons (car xs) acc) (cdr xs) vals)
>                        (values (cons (car vals) acc) xs (cdr vals))))))
>    reduced-arity-name))
>
> (define f (λ (a b c d) (+ a b c d)))
> (define g (reduce-arity f '(1 b 3 d)))
> (check-equal? (f 1 2 3 4) (g 2 4))
>
> --
> You received this message because you are subscribed to the Google Groups 
> "Racket Users" group.
> To unsubscribe from this group and stop receiving emails from it, send an 
> email to racket-users+unsubscr...@googlegroups.com.
> For more options, visit https://groups.google.com/d/optout.

-- 
You received this message because you are subscribed to the Google Groups 
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email 
to racket-users+unsubscr...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

Reply via email to