Scalaのfor-comprehensionのパチモンをCommon Lispで実装した（多値使って）

何言ってるんだという感じですがこういう感じです。

(defun find-user (username)
  (if (string= username "windymelt")
      (return-left :windymelt)
      (return-right "User Not Found")))

(defun check-passwd (user passwd)
  (if (and (eq user :windymelt)
           (string= passwd "123456"))
      (return-left t)
      (return-right "Password authentication failed")))

(defun get-user-age (user)
  (if (eq user :windymelt)
      (return-left 26)
      (return-right "User Age Not Found")))

(defun ensure-adult (age)
  (if (< age 20)
      (return-right "Should be adult")
      (return-left t)))

(defun purchase-beer (user)
  (declare (ignorable user))
  (print "beer!"))

(defun beer-controller (user-name passwd)
  (for-comprehension (user         <- (find-user user-name))
                     (passwd-guard <- (check-passwd user passwd))
                     (age          <- (get-user-age user))
                     (adult-guard  <- (ensure-adult age))
                     (_            <- (purchase-beer user))))

こういうのが書けます。Maybeしか実装してないのでfor-comprehension実装したというのはちょっと盛りすぎかも。

実際に動作させるとこういう感じで，ちゃんとMaybeな挙動になっています。

CL-USER> (beer-controller "windymelt" "")
NIL
"Password authentication failed"
CL-USER> (beer-controller "windymel" "")
NIL
"User Not Found"
CL-USER> (beer-controller "windymelt" "123456")

"beer!" 
"beer!"
NIL

パチモンなのでちゃんとはしていないのですが，より詳しく仕組みを解説してみます。

for comprehension is 何

Scalaの面白機能だと思ってたけどHaskellとかにもあるはず。

hakobe932.hatenablog.com

モナドとかをがっちゃんこするのに便利なやつですが，詳しくはここでは説明しません。

多値

コード上でMaybeをどうやって表現するかというと，まあ素朴にやったらリストとか構造体を使うと思うんですが，今回は練習を兼ねて多値を使うことにしました。

多値 is 何

Golangのおかげで浸透してきたような気がする概念ですが，ようするに一度に複数の値を返せるという機能です。タプル返すのとは別物です。詳しくは↓見てください。

keens.github.io

Common Lispではvaluesを呼ぶことで多値を返すことができ，multiple-value-bindなどを使って多値を受け取ることができます。 うまくやるとレジスタに値が全部載るらしいので高速でエコになるはずです。リストは作った瞬間にメモリ確保が発生したりします。Common Lispで速度を重視する場合，いかにリスト作成によるメモリ確保（コンシングconsingと呼ばれたりします）を減らすかが勝負です（たぶん）。軽量に動くMaybeモナド，ちょっと欲しかったので作ってしまったというわけです。

多値でMaybeモナド

Maybeモナドを多値で表現しましょう。最初に返される値をleft，2番目の値をrightとしましょう。これは見た目からして自然な定義です。

leftとrightで包んだ値を返せるreturn-leftとreturn-rightは，以下のように書けますね。今気付いたけどマクロじゃなくて良かった気がする。

(defmacro return-left (x)
  `(values ,x nil))

(defmacro return-right (x)
  `(values nil ,x))

動かしてみます。

CL-USER> (return-left  12)
12
NIL
CL-USER> (return-right  34)
NIL
34

関数が複数の値を返していますね。これが多値です。

Maybe多値を連鎖させる

モナドがあったらチェインさせたい（ことわざ）

flatmapを実装しましょう。

(defmacro flatmap (f xform)
      `(multiple-value-bind (left right) ,xform
         ;; left projection
         (if left
             ,f
             (return-right right))))

flatmapは第2引数のフォームから多値を受け取り，leftがあるならばfを呼び出します。さもなければ，rightを返してしまいます。

ところでこれ本当にflatmapなのでしょうか。不安になってきましたがパチモンなので可とします。

mapも作りましょう。やってることはほぼ一緒ですが返り値がMaybeにならずに値がそのまま得られる。

(defmacro maybe-map (f xform)
      `(multiple-value-bind (left right) ,xform
         ;; left projection
         (if left
             ,f
             right)))

本当にこれでいいのか不安です。

for-comprehension

さて，scalaのfor-comprehensionはflatmapとfilterとmapとに分解できることが知られています。というかそのシュガーシンタックスです。したがって，今回はfor-comprehensionな式を受け取って，それをがっちょんがっちょんしてflatmapとmapとに組み変えてしまえばいいわけです。filterは面倒だったのでさぼりました。

作戦

紆余曲折あったのですがこういう作戦で実装しています。for-comprehension自体は計算を行わず，マクロによる式変形に留めるスタイルです。

;; 参考
(for-comprehension
  (a <- (f)) ; 1段目
  (b <- (g a)) ; 2段目
  (c <- (h a b))) ; 3段目

1. まず最も上の段から，flatmapにくるんで呼ぶコードを生成する。これをcodeとする。
2. 次の段に移り，またflatmapにくるんで呼ぶコードを生成する。このときflatmapの引数としてcodeを渡す。生成されたコードでcodeを上書きする。
3. 段がある限りcodeを更新しつつflatmapでくるんでいく。

ま要するにflatmapを使う形式に変換しているだけです。ただテクいこともやっていて，a,b,cといった変数のスコープがhandler-bindの外側に及ばない（当然）のでいったん上層にシンボルを用意し，そのplistに保管したりしています。

説明するのが面倒になってきたのでコードを出します。

(ql:quickload '(:iterate :alexandria))
(use-package :iterate)
(use-package :alexandria)

;; 段の値がおさまった変数は，まとめて1つのシンボルのプロパティに格納するようにしている。
;; このため段の変数を参照する箇所を置換する
(defun sanitize-variables-for-for-comprehension (form var)
  (mapcar #'(lambda (x) (etypecase x
                          (list (sanitize-variables-for-for-comprehension x var))
                          (t (if (eq x var)
                                 `(get *for-comprehension-variables* ,(make-keyword (concatenate 'string "%" (string var)))) ;; 名前をそのまま使うと衝突するのでシンボルに%をつける
                                 x))))
          form))

(defmacro for-comprehension (&rest clauses)
  (iter (for c :in clauses)
    (with vars) ;; ここに「どういう変数に代入された？」かが収められる。あとで使う
    (for code
         :first ;; codeの初期値を決める
         (ecase (second c) ;; '<-' or '='
           (<-
            (progn
              (push (first c) vars) ;; 変数名シンボルを退避する
              `(multiple-value-bind (left right) (flatmap ,(third c) t) ;; flatmapするが，1段目なので特になにも渡さなくてよい。ダミーでtを渡す形式にする
                 (setf (get *for-comprehension-variables* ,(make-keyword (concatenate 'string "%" (string (first c))))) (if left left right)) ;; 得られた値をより大域な変数に退避させる
                 (values left right))))) ;; 退避させた後はなにごともなく元の多値を返す
         :then ;; 2段目以降はここが呼ばれる
         (if (eq (first c) 'yield) ;; yieldだったらmap呼ぶ
             `(maybe-map ,(second c) ,code)
             (ecase (second c)
               (<-
                (progn
                  (push (first c) vars)
                  `(multiple-value-bind (left right) (flatmap ,(third c) ,code) ;; 前段で生成されたcodeに対してflatmapするという形式に変換する
                     (setf (get *for-comprehension-variables* ,(make-keyword (concatenate 'string "%" (string (first c))))) (if left left right))
                     (values left right)))))))
    (finally (return
               `(progn
                  (let ((*for-comprehension-variables* nil)) ;; ここにflatmapした結果を詰め込んでおいて，変数名を使って参照できるようにしている
                    ,(progn
                       (dolist (v vars) (setf code (sanitize-variables-for-for-comprehension code v))) ;; 変数名で参照している箇所は↑の変数からの読み込みに置換する
                       code)))))))

これでMaybeモナドもどきが実装できましたね。flatmapの実装をいじったらOptionとかに対応したり，right projectionにできると思います。

なんでright projectionじゃなくてleft projectionなの

デフォでは，普通の関数が多値を受け取ると1つ目の値を受け取るようになっているので，それとの整合性を優先しました。

CL-USER> (identity  (values 1 2 3 4 5))
1

たぶん欲しい値は1番目にあるのが普通だろう，というわけです。

なんでリスト使わなかったの

リストでいいと思います。

まとめ

なんとなく便利そうなのができた。

めでたし