読者です 読者をやめる 読者になる 読者になる

(wat-aro)

無職から有職者にランクアップしました

define-curryを書いてみた

scheme

カリー化や部分適用の話が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 ...)] ;; 修正:引数が0個の手続きに対応
    [(_ (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

 
 
修正2

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

 
修正3

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