Syntax highlighter

2016-01-06

Schemeで部分適用

Twitterでカリー化マクロを書いたブログ記事を見かけたので部分適用の方も書いてみた。ネタ元はこちら:define-curryを書いてみた
真面目に読んでなかった+カリー化を複数手続きを取る手続きを1引数を取る手続きを返す手続きにするみたいな理解していたので完全ネタが被ってた。別解ということでひとつ・・・

部分適用に関して厳密な定義を実は知らないのだが、複数引数を取る手続きに要求する引数より少ない数の引数を与えた際に残りの引数を受け取る手続きを返すもの、という理解でいる。コードで書くとこんな理解:
(define (foo a b c) (+ a b c))

(foo 1) ;; -> (lambda (b c) (+ 1 b c)) ;; ≶ 1 is given by caller
これがカリー化だと返された手続きの呼び出しが以下のようになる。
(let ((foo1 (foo 1))
  ;; foo1 = (lambda (b) (lambda (c) (+ 1 b c)))
  ((foo1 2) 3))
いいけど、面倒。ということで部分適用っぽく見えるようなマクロを書いてみた。
(import (rnrs))

(define-syntax lambda-partial-applicable
  (syntax-rules ()
    ((_ "case" () (arity ...) ((args body) ...) fun)
     (case-lambda (args body) ...))
    ((_ "case" (a arg ...) (arity ...) ((args body) ...) fun)
     (lambda-partial-applicable "case" 
                                (arg ...)
                                (arity ... a)
                                ((args body) ... ((arity ... a) (fun a)))
                                (fun a)))
    ((_ "partial" (arg ...) body)
     (let ((fun body))
       (lambda-partial-applicable "case" (arg ...) () ((() fun)) fun)))

    ((_ "curry" () (arg ...) body)
     (lambda-partial-applicable "partial" (arg ...) body))
    ((_ "curry" (a arg ...) (back ...)  body)
     (lambda-partial-applicable "curry" (arg ...) (a back ...)
                                (lambda (a) body)))

    ((_ "reverse" () (arg ...) (body ...))
     (lambda-partial-applicable "curry" (arg ...) () (begin body ...)))
    ((_ "reverse" (a rest ...) (arg ...) (body ...))
     (lambda-partial-applicable "reverse" (rest ...) (a arg ...) (body ...)))

    ((_ (args ...) body ...)
     (lambda-partial-applicable "reverse" (args ...) () (body ...)))))
    

(define-syntax define-partial-applicable
  (syntax-rules ()
    ((_ (name args ...) body ...)
     (define name (lambda-partial-applicable (args ...) body ...)))))
こんな感じで使う。
(define (print . args) (for-each display args) (newline))
(define-partial-applicable (foo a b) (+ a b))

(let ((&2+ (foo 2)))
   (&2+ 3))
;; -> 5

(define-partial-applicable (bar a b c) (+ a b c))

(bar 2 3 4)
;; -> 9

(let* ((&2+ (bar 2))
       (&2+3+ (&2+ 3)))
  (&2+3+ 4))
;; -> 9
いろいろやり方はあると思うけど、考えるのが面倒なのでカリー化の先に部分適用を持ってくることにした。さらにいろいろ面倒なのでオプショナル引数については全く考慮してない。

朝の15分くらいで書いたものなので変なことをすると変な挙動をするかもしれないが、そこはご愛嬌ということで…

No comments:

Post a Comment