define-curryを書いてみた

カリー化や部分適用の話がTwitterで流れてきたのでマクロの練習として書いてみました．

;; lambda式を引数に取り，カリー化されたlambda式を返す
;; いらなかった
;; (define-syntax curry
;;   (syntax-rules (lambda) ;; 修正
;;     [(_ (lambda (arg) body ...))
;;      (lambda (arg) body ...)]
;;     [(_ (lambda (first rest ...) body ...))
;;      (lambda (first) (curry (lambda (rest ...) body ...)))]))

(define-syntax lambda-curry
  (syntax-rules ()
    [(_ () body ...)
     (lambda () body ...)] ;; 修正：引数が０個の手続きに対応
    [(_ (arg) body ...)
     (lambda (arg) body ...)]
    [(_ (first rest ...) body ...)
     (letrec ((func (case-lambda
                     [() func]
                     [(arg) ((lambda (first) (lambda-curry (rest ...) body ...)) arg)]
                     [args ((lambda (first)
                              (apply (lambda-curry (rest ...) body ...) (cdr args)))
                            (car args))])))
       func)])) ;;このfuncがなくてもなぜか動く．

(define-syntax define-curry
  (syntax-rules ()
    ;; lambda-curryが0引数に対応したのでいらない
    ;; [(_ (func-name) body ...)
    ;;  (define (func-name) body ...)]
    [(_ (func-name args ...) body ...)
     (define func-name (lambda-curry (args ...) body ...))]
    [(_ var val)
     (define var val)]))

　
清書

(define-syntax lambda-curry
  (syntax-rules ()
    ((_ () b0 b1 ...)
     (lambda () b0 b1 ...))
    ((_ (arg) b0 b1 ...)
     (lambda (arg) b0 b1 ...))
    ((_ (first rest ...) b0 b1 ...)
     (letrec ((func (case-lambda
                     (() func)
                     ((arg) ((lambda (first) (lambda-curry (rest ...) b0 b1 ...)) arg))
                     (args ((lambda (first)
                              (apply (lambda-curry (rest ...) b0 b1 ...) (cdr args)))
                            (car args))))))
       func)))) ;;このfuncがなくてもなぜか動く．

(define-syntax define-curry
  (syntax-rules ()
    ((_ (func-name args ...) b0 b1 ...)
     (define func-name (lambda-curry (args ...) b0 b1 ...)))
    ((_ var val)
     (define var val))))

test

gosh> (define f (lambda-curry (a b) (/ a b)))
f
gosh> (f 1 2)
1/2
gosh> (define g (lambda-curry (a b c) (+ a b c)))
g
gosh> (g 1 2 3)
6
gosh> #<undef>
gosh> (define f (lambda-curry (a b) (/ a b)))
f
gosh> (f 1 2)
1/2
gosh> #<undef>
gosh> (define-curry (f a b) (/ a b))
f
gosh> (f 1)
#<closure (#f #f)>
gosh> ((f 1) 2)
1/2
gosh> (f 1 2)
1/2
gosh> (define-curry (g a b c) (+ a b c))
g
gosh> (g 1)
#<closure (#f #f)>
gosh> ((g 1) 2)
#<closure (#f #f #f)>
gosh> (((g 1) 2 ) 3)
6
gosh> ((g 1) 2 3)
6
gosh> ((g 1 2) 3)
6
gosh> (g 1 2 3)
6

修正1

curry の定義は (syntax-rules (lambda) ...) にしないと (curry (foo (x) x)) とかでも動いてしましそう https://t.co/DUJHFogOQg
— でこれき (@dico_leque) January 6, 2016

　
　
修正2

引数がゼロ個の手続きはこのマクロでは作れないな。 (lambda-curry () (* 1 2)) みたいなの。それができたからといって使いどころもないけど。
— 齊藤敦志 (@SaitoAtsushi) January 6, 2016

gosh> (lambda-curry () (+ 1 2))
#<closure #f>
gosh> ((lambda-curry () (+ 1 2)))
3

　
修正3

lambda-curryのletrecは要らない気がする。define-curryの最初のパターンもlambda-curryが0引数対応したなら要らない気がする。 https://t.co/h4ClDCC5ev
— Kei (@tk_riple) January 6, 2016

gosh> (define f (lambda-curry (a b) (/ a b)))
f
gosh> (f 1 2)
1/2
gosh> ((f 3) 4)
3/4
gosh> (define-curry (f) (+ 1 1))
f
gosh> (f)
2

(wat-aro)

生きてます

define-curryを書いてみた