core.logicを使ってインデントされたS式を出力する

公開:2020/10/18
更新:2020/10/18
8 min読了の目安(約7700字TECH技術記事

インデントされたS式を出力したい

Schemeとかでは欲しい場面がある。

  • 自作ツールで整形されたS式を出力する
  • マクロの展開結果をインデントした状態で見たい

それから、きれいにインデントされるだけでなく、ある程度インデント幅や好みのスタイルを変更できるたり、ユーザ定義のマクロもうまくインデントされて出力できるようなツールが欲しい。

適切にインデントされたS式を出力する方法

ルールを設定して、条件を満たすものを出力すれば求めているものができそう。

・ 1行は80行まで
・ let式のbinding部のインデントをそろえる
・ cond等のペアグループで空白をいれる(ペアグループのbody部が改行されている場合)

こういったルールをKanrenとかのlogic programming系のDSLを使って記述して、条件に合致するパターンを解かせる。

Kanrenファミリー

miniKanrenというScheme用のlogic proramming言語(prologみたいなの)がある。
「The Reasoned Schemer」の題材に使われており、miniKanrenの公式ページを見ると、いろいろな言語に移植されている。
今回扱うcore.logicもClojureに移植された、Kanrenファミリーの1つ。
他にも、microKanrenという最小限の部分だけで構成された40行足らずの小さいScheme向け実装も存在する。

core.logicの簡単な例

  • xは1と等しい。xの値は? (当然1)
(run* [x] (== x 1)) ; → (1)

run*は与えられた制約を満たす、変数の値を返してくれる。
[x]は、返して欲しい制約の変数。
(== x 1)は、xと1が等しいという制約。

結果の1がリストに囲まれて返ってきているが、この理由は次の例で説明する。

  • xとyは0,1,2のどれか。xとyは等しくない。xとyの値は?
(run* [x y]
  (membero x [0 1 2]);xは0,1,2のどれか
  (membero y [0 1 2]);yは0,1,2のどれか
  (!= x y));xとyは等しくない
;→ ([0 1][1 0][0 2][2 0][1 2][2 1])

結果を見ると分かるが、core.logicは制約を満たす変数の値を全部列挙してくれる。(1つ前の例がリストなのはこれが理由)

core.logicはClojureと連携できる

core.logicを使って記述している部分の変数は、core.logic用のclojure.core.logic.LVarオブジェクトが格納されていることがある(パターンマッチとかで使ったりした場合) ため、project構文を使ってLVarオブジェクトの実体(Clojureオブジェクト)が取り出す必要がある。
LVarオブジェクトの中身はClojureオブジェクトなので、projectを使ってClojureの関数に渡すことができる。

(defne piyo [a res]
    ([[f . rests] _]
      ; fは <varf__6120> といったLVarオブジェクト
      (project [f] (== res (inc f)))))
     
(run* [res]
  (piyo [1 2 3] res)) ; → (2)

(これは例のために作った。普通あまり書かなさそうなコード)

今回やること

  • 定数は文字列と数値だけの、vectorで書かれたS式を対象に改行や空白を挿入する。
  • また、ターゲットのS式の構文の種類は、関数適用だけ
    • 関数適用の書き方のパターンが割とあるので試作としてはなかなか良さそう

関数適用インデントパターンの例

;改行なし
(fn arg1 arg2 arg3)

;1つめの引数は改行なしで、以降の引数をそれにあわせる
(fn arg1
    arg2
    arg3)
    
;全部改行
(fn
  arg1
  arg2
  arg3)
  
;途中で1回改行
(fn arg1 arg2 arg3 arg4
    arg5 arg6 arg7 arg8)

今回できていないこと

  • 条件を満たすものが複数出てきたときに最適なものを選択すること
    今度頑張る。

与えたルール

これをcore.logicを使って書く。

  • 1行80文字以内
  • 関数適用の引数は次のどれか
    1: インデント幅2で改行
    2: 手前の引数のいずれかと同じ位置になるように改行
    3: 改行しない

内部表現

改行、空白挿入の表現方法

  • 対応するオブジェクトをmapオブジェクトに対応付ける。
  • 対応するすべてのmapオブジェクトは、newlineとindent要素を持つ。
  • 出力する場合は、newlineを持っている場合は改行して、indentの分だけ空白を挿入する。(それ以外はそのまま)
  • オブジェクトがvectorの場合、body要素として、子要素の内部表現をvectorに入れて持たせる。

内部表現の一例。(今回の試作品では出てこないパターン)

(fn arg1 arg2
    arg3
          arg4 arg5)

;;インデントや改行の表現
{:newline false
 :body [{:newline false}
        {:newline false}
	{:newline true :indent 4}
	{:newline true :indent 9}
	{:newline false}]}

結果

最適なものを選択する機能の追加の必要はありそうだが、期待通りの結果を出すものはできた。

;;入力
["HELLO" "ARG1" "ARG2"]

;;結果
["HELLO" "ARG1" "ARG2"]
["HELLO"
   "ARG1" "ARG2"]
["HELLO" "ARG1"
         "ARG2"]
["HELLO"
   "ARG1"
   "ARG2"]
["HELLO" "ARG1"
   "ARG2"]
  • 長い引数を渡すと、80文字ルールのため、全部改行するだけのパターンだけが返ってくる
;;入力
["HELLO" "LOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOONG" "ARG2"]

;;結果
["HELLO"
   "LOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOONG" 
   "ARG2"]
  • 少しネストを深くしたパターン
;;入力
["HELLO" ["HELLO2" "ARG1" "ARG2"] ["HELLO3" "ARG4"]]

;; 結果は多すぎるので省略 (50個出てきた)
(count (solve ["HELLO" ["HELLO2" "ARG1" "ARG2"] ["HELLO3" "ARG4"]]))
;;→ 50

;;結果の一例(変なの)
["HELLO" ["HELLO2" "ARG1"
            "ARG2"]
   ["HELLO3"
      "ARG4"]]

おしまい

  • 複数の候補から最適なものを選択するのはこれからやる。
  • もう少しユーザーがインデントパターンを変更しやすいものを提供したいので、core.logicをwrapしたDSLを更に作る?
  • これをminiKanrenでやれば、Schemeでも同じことができる。

ソースコード

core.logicを覚えながら書いたのであまり良くはない。
次はうまくやる。

(use '[clojure.core.logic])

(defne apply-funcall [expression index start prev-indents last-right res]
  ([[] _ _ _ _ _]
   (== res nil)
   (== last-right start))
  ([[f . rests] 0 _ _ _ _]
   (fresh [next-res current-res current-right inc-right]
          (apply-rule f start current-right false current-res)
          (project [current-right start]
                   (apply-funcall rests 1 (inc current-right)
                                  [(+ start 2)] last-right next-res))
          (project [current-res]
                   (== res (lcons (assoc current-res :first true)
                                  next-res)))))

  ([[f . rests] _ _ _ _ _]
   (project [index] (== (pos? index) true))
   (fresh [next-res current-res current-right inc-right]
          (or*
           [(fresh []
                   (apply-rule f start current-right false current-res)
                   (project [current-right index]
                            (== (< current-right 80) true))
                   (project [current-right index prev-indents]
                            (apply-funcall rests (inc index)
                                           (inc current-right)
                                           (cons start prev-indents)
                                           last-right next-res))
                   (== res (lcons current-res
                                  next-res)))
            (fresh [new-start]
                   (membero new-start prev-indents)
                   (apply-rule f new-start current-right true current-res)
                   (project [current-right] (== (< current-right 80) true))
                   (project [current-right index]
                            (apply-funcall rests
                                           (inc index)
                                           (inc current-right) prev-indents
                                           last-right next-res))
                   (== res (lcons current-res next-res)))]))))

(defne apply-rule [expression start right newl res]
  ([[_ . _] _ _ _ _]
   (fresh [funcall-res last-right]
          (project [start]
                   (apply-funcall expression 0 (inc start)
                                  [] last-right funcall-res))
          (project [expression start]
                   (== right last-right))
          (== res {:body funcall-res
                   :right last-right
                   :indent start
                   :newline newl})))
  ([_ _ _ _ _]
   (project [expression]
            (== (number? expression) true))
   (project [expression start]
            (== right (+ start expression)))
   (project [expression start]
            (== res {:atom true
                     :indent start
                     :newline newl
                     :right (+ start expression)}))))

(defn- serialisp->lencode [expression]
  (cond
    (vector? expression) (mapv serialisp->lencode expression)
    (string? expression) (+ (count expression) 2)
    (number? expression) (count (str expression))
    :else 0))

(defn solve [expression]
  (run* [res]
        (fresh [_right]
               (apply-rule (serialisp->lencode expression)
                           0
                           _right
                           false
                           res))))

(defn- encode* [expression {:keys [newline indent body] :as info}]
  (let [res (if newline
              (->> (iterate (fn [_] " ") " ")
                   (take indent)
                   (cons "\n")
                   vec)
              [])]
    (cond
      (vector? expression)
      (concat res
              ["["]
              (mapcat #(concat (when-not  (or (:first %2) (:newline %2)) [" "])
                               (encode* %1 %2)) expression body) ["]"])

      (string? expression) (conj res (str "\"" expression "\""))
      :else (conj res (str expression)))))

(defn encodes [expression indent-info-list]
  (map #(apply str (encode* expression %))
       indent-info-list))

(defn view [expression]
  (let [indent-info-list (solve expression)]
    (encodes expression indent-info-list)))

;実行方法
;(doseq [x (view ["HELLO" "ARG1" "ARG2"])] (print x) (newline) (newline))