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

レガシーコード生産ガイド

私に教えられることなら

ParenscriptとCommonLispで関数の部分適用

JavaScript Ninjaの例を複数引数に対応するようにちょっと拡張して、Parenscriptで作ってみる。argumentsは配列のインスタンスではないので、Array.prototype.slice.callで変換してやらないと使えない。それからParenscriptでchain-caseがcamelCaseに変換されるの、||で囲めばそのまま使えた。(追記:リファレンスマニュアル見たら、*arrayArrayに、*array*ARRAYになるっぽい)

  (defun args-to-array (args)
    ((@ |Array| prototype slice call) args))

  (setf (@ |Function| prototype partial)
        (lambda ()
          (defvar before-args (args-to-array arguments))
          (defvar fn this)
          (lambda ()
            (defvar after-args (args-to-array arguments))
            (defvar args ((@ before-args concat) after-args))
            ((@ fn apply) this args))))

  ;; テスト用
  (defun plus (a b c) (+ a b c)) 

単純にpartial時の引数、呼び出し時の引数を配列にして連結し、applyで渡す。

Chromeのコンソールで試してみる。

plus.partial(1)(2, 3)
// => 6
plus.partial(1,2)(3)
// => 6
plus.partial(1).partial(2)(3)
// => 6

次はCommon Lispでの例。

(defun partial (fn &rest before)
  (lambda (&rest after)
    (apply fn (append before after))))

めちゃ短い。さすがだ。

CL-USER> (funcall (partial (lambda (a b c) (+ a b c)) 3) 4 5)
12
CL-USER> (funcall (partial (partial (lambda (a b c) (+ a b c)) 3) 4) 5)
12

呼び出しはJavaScriptの方がシンプルで好きだ。後でどうにかしてみよう。

さて、せっかくCommon Lispなので、JavaScriptにはできないことをしたい。今作ったpartialは前からしか部分適用できないけど、好きな位置に適用できないだろうか?こう書いてみたい。

(defun minuses (a b c) (- a b c))
(partial #'minuses ? 3 ?)

この?の位置に引数を渡せる、2引数関数を生成できるようにしよう。

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun replace-list-by-list (test-fn replacee replacer)
    "replaceeの各要素について、test-fnが真の場合、replacerの先頭から順に取り出して置き換えていく"
    (cond
      ((null replacee) nil)
      ((null replacer) replacee)
      ((funcall test-fn (car replacee))
       (cons (car replacer)
             (replace-list-by-list test-fn (cdr replacee) (cdr replacer))))
      (t
       (cons (car replacee)
             (replace-list-by-list test-fn (cdr replacee) replacer)))))

  (defun test-and-build-list (test-fn elm-fn targets)
    "targetsの各要素についてtest-fnが真の場合にその要素をelm-fnで評価した値のリストを作る"
    (reduce 
     (lambda (target acc)
       (if (funcall test-fn target)
           (cons (funcall elm-fn target) acc) acc))
     targets :from-end t :initial-value ()))
  )

(defmacro partial (fn &rest before)
  (let ((args 
         (test-and-build-list 
          (lambda (a) (eq a '?)) 
          (lambda (_) (declare (ignorable _)) (gensym)) 
          before)))
    `(lambda ,args
       (funcall ,fn ,@(replace-list-by-list (lambda (a) (eq '? a)) before args)))))

補助関数、どちらもいい名前が浮かばなかった。特にtest-and-build-listはもっといい名前あるはず…。どこかのユーティリティに同じような動きをする関数ありそうだから、探して参考にしてみよう。

で、試してみる。

CL-USER> (defun minuses (a b c) (- a b c))
MINUSES
CL-USER> (partial #'minuses ? 1 ?) ; 2引数関数を返す
#<FUNCTION (LAMBDA (#:G1 #:G0)) {1005A6E88B}>
CL-USER> (funcall (partial #'minuses ? 1 ?) 1 2) ; 1 - 1 - 2 = -2
-2
CL-USER> (funcall (partial #'minuses ? ? ?) 2 1 3) ; 2 - 1 - 3 = -2
-2

できた!

もうちょっと読みやすい適用できないかな…とマクロ使おうかと思ったけど、Haskellみたいに自動で部分適用になって$で繋げていける、ぐらいじゃないと普通にdefunした方が読みやすそうだ。

広告を非表示にする