【Haskell】Point-freeスタイルのすすめ

## はじめに

こちらはCA26卒内定者がお届けする、[CyberAgent 26th Fresh Engineer's Advent Calendar](https://qiita.com/advent-calendar/2024/ca-26th) 2024の21日目の記事になります。

内定者バイト期間中はGoばかり書いていて、Haskellが読めない、やばい...！！という事態に陥ってしまったため、久々にコードリーディングをしていきたいと思います。

今回はHaskellプログラムをpoint-freeスタイルに変換してくれるツール、[bmillwood/pointfree](https://github.com/bmillwood/pointfree)パッケージのコードを読んでいきます。

## point-freeスタイルとは

point-freeスタイルとは関数の引数を明に書かないプログラミングのパラダイムのことで、
tacit programmingとも呼ばれています:
[Tacit programming - Wikipedia](https://en.wikipedia.org/wiki/Tacit_programming)

具体例としては、

```Haskell
process xs = xs'''
  where
	xs'   = map (\x -> x * 2) xs
	xs''  = filter (\x -> x > 0) xs'
	xs''' = sort xs''
```

上のように引数を明記するのではなく、

```haskell
process = sort . filter (> 0) . map (* 2)
```

のようにカリー化された関数を合成するようなスタイルで、
引数のやり取りによるテンプレをなくし、関数を主体とした考え方でプログラミングができるようになります。

この程度であればわかりやすいですが、中にはトリッキーなものも存在していて、

たとえば

```haskell
foldMap' f g e = foldr f e . map g
```

を以下のように書いたり、

```haskell
foldMap' f g e = foldr (f . g) e
```

さらには

```haskell
elem' x xs = any (== x) xs
```

を以下のように書いたりすることもできてしまいます。

```haskell
elem' = any . (==)
```

最初の`foldMap'`では、`->`が右結合なことに注意すると

* `g :: a -> b`
* `f :: b -> (c -> c)`
* `f . g :: a -> (c -> c)`

となり、

`b`がマップ後のリストの要素、`c`がアキュムレータの型であることから、`f . g`はリスト要素に`g`を適用し、さらにフォールドする関数であることが確認できます。

注意点として、`foldl`の場合`f`の型が`f :: c -> (b -> c)`となるため、`foldr`のみ使えるトリックとなります。
~~ここまでくるともはや難読化ですね。~~

また二つ目の`elem'`でも、`->`が右結合であることに注意すると

* `(==) :: a -> (a -> Bool)`
* `any :: (a -> Bool) -> ([a] -> Bool)` 
* `any . (==) :: a -> ([a] -> Bool)`

となり、確かに正しい変換であることがわかります。

## point-freeなのにpointがたくさんある件

point-freeスタイルでは、

```Haskell
process = sort . filter (> 0) . map (* 2)
```

のように関数合成の演算子 `.` を多用するので、

「point(点)-free なはずなのに`.`(点)がたくさん出てくる...？？」

というツッコミを入れたくなる人もいるかもしれません。

ただこれにはちゃんとした由来があるようで、
ホモトピー型理論 (Homotopy type theory/HoTT) が元になっているそうです。

HoTTは全く理解していないので適当なことしか言えませんが、

* 型$A$ ↔ 位相空間$A$
* 項$a:A$ ↔ 点$a\in A$

のように同型対応させるもののことです
(詳しい方補足お願いいたします...):
[Homotopy type theory - Wikipedia](https://en.wikipedia.org/wiki/Homotopy_type_theory#%22Propositions_as_types%22)

つまり、引数が省略され具体的な項 (point) を意識することがなくなるため、point-freeという訳です。

## point-freeスタイルに自動変換してくれるツール

世の中にはすごい人たちがいるもので、
任意のHaskellプログラムをpoint-freeスタイルに自動変換してくれる~~変態的な~~ツールが存在します。

このツールはこちらの[Pointfree.io](https://pointfree.io/)というサイトで公開されていて、

このサイトの裏側で動いているのがこちらの[bmillwood/pointfree](https://github.com/bmillwood/pointfree)パッケージで、今回コードリーディングしていくコードになります。

試しに以下のプログラムを入力してみると、

```haskell
sum xs = foldr (+) 0 xs
```

```console
$ cabal run pointfree -- --stdin
Up to date
sum xs = foldr (+) 0 xs
sum = foldr (+) 0
```

このように、正しく `sum = fold (+) 0`が得られていることが確認できます。

### ディレクトリ構成

これからコードリーディングをしていく訳ですが、その前に軽くディレクトリ構成を紹介しておきたいと思います。

```console
$ tree -P "*.hs" --prune
├── Main.hs
├── Pointfree.hs
├── Plugin
│   └── Pl
│       ├── Common.hs
│       ├── Optimize.hs
│       ├── Parser.hs
│       ├── PrettyPrinter.hs
│       ├── Rules.hs
│       └── Transform.hs
└── test
    └── Test.hs
...
```

主なファイルとしては、

* `Main.hs` → CLI用のコード
* `Pointfree.hs` → エントリーポイント
* `Parser.hs` → 入力プログラムのパーサー
* `PrettyPrinter.hs` → 変換後のASTを文字列として出力
* `Transform.hs` → point-freeスタイルに変換するメインロジック
* `Optimize.hs` → `Transform.hs`の後に式書き換えを行うロジック

となっています。

### `Pointfree.hs`

`Main.hs`はCLIのテンプレコードなので、まずは`Pointfree.hs`から見ていきましょう。

以下の`pointfree`関数がエントリーポイントになります:

```haskell
pointfree :: String -> [String]
pointfree
  = either
    (const [])
    (map prettyTopLevel . mapTopLevel' optimize . mapTopLevel transform)
  . parsePF
```

`parsePF`は入力プログラムをパースする関数で、ASTとして`Expr`を返します。

`prettyTopLevel`は`Expr`を文字列として出力する関数です。
一度`Expr`を`SExpr`に変換してから、`SExpr`を再帰的に走査し`show`する実装になっています。
特に面白いわけではないので詳細は割愛します。

`mapTopLevel`と`mapTopLevel'`はトップレベルの定義に対して変換を適用する関数です。

主な変換のロジックは`transform`と`optimize`に集約されています:

* `transform` → ラムダ式の抽象化 (Abstraction/$\lambda x.M$) を関数モナドによって取り除くロジック
* `optimize` → 項書き換え (Term rewriting system/TRS) によってよりイディオマティックなpoint-freeスタイルに変換するロジック

### `Common.hs`

最初に変換の対象となるAST、`Expr`の定義を見ていきましょう。

```haskell
data Expr
  = Var Fixity String
  | Lambda Pattern Expr
  | App Expr Expr
  | Let [Decl] Expr
  deriving (Eq, Ord, Show)

data Pattern
  = PVar String 
  | PCons Pattern Pattern
  | PTuple Pattern Pattern
  deriving (Eq, Ord, Show)

data Decl = Define { 
  declName :: String, 
  declExpr :: Expr
} deriving (Eq, Ord, Show)

data Fixity = Pref | Inf deriving Show

data TopLevel = TLD Bool Decl | TLE Expr deriving (Eq, Ord, Show)
```

If文が存在していませんが、これは標準ライブラリの `if' :: Bool -> a -> a -> a` 関数で表現することができるため必要ないようです:
[Data.Bool.HT (haskell.org)](https://hackage.haskell.org/package/utility-ht-0.0.17.2/docs/Data-Bool-HT.html#v:if-39-)

`Fixity`は`Pref` (前置記法) もしくは`Inf` (中置記法) を指定するEnumです。
`App`内ではなく、`Var`内に`Fixty`があることに多少違和感を覚えますが、これは文字列出力時に演算子の位置を復元するだけでなく、[`LeftSection`/`RightSection`の区別](https://github.com/bmillwood/pointfree/blob/43d98f176b44580bc3a10473f5051045cb397f12/Plugin/Pl/PrettyPrinter.hs#L60-L65)にも用いられているためのようです。

また`Common.hs`には変換に用いられるASTノードが事前に定義されています:

```haskell
comp, flip', id', const', scomb, cons, nil, fix', if' :: Expr
comp   = Var Inf  "."
flip'  = Var Pref "flip"
id'    = Var Pref "id"
const' = Var Pref "const"
scomb  = Var Pref "ap"
cons   = Var Inf  ":"
nil    = Var Pref "[]"
fix'   = Var Pref "fix"
if'    = Var Pref "if'"
```

特に、

* `comp`/`scomb`/`flip'`
* `id'`/`const'`/`fix'`

などは`Transform.hs`で使われるので覚えておいてください。

### `Parser.hs`

次にパーサーを見ていきましょう。
これは単純にHaskell標準ライブラリ`HSE`のパーサーを利用しています:
[Language.Haskell.Exts](https://hackage.haskell.org/package/haskell-src-exts-1.23.1/docs/Language-Haskell-Exts.html)

```haskell
import qualified Language.Haskell.Exts as HSE

todo :: (Functor e, Show (e ())) => e a -> r
todo thing = error ("pointfree: not supported: " ++ show (fmap (const ()) thing))

hseToExpr :: HSE.Exp a -> Expr
hseToExpr expr = case expr of
  HSE.Var _ qn -> uncurry Var (qnameString qn)
  HSE.IPVar{} -> todo expr
  HSE.Con _ qn -> uncurry Var (qnameString qn)
  HSE.Lit _ l -> case l of
    HSE.String _ _ s -> list (map (Var Pref . show) s)
    _ -> Var Pref (HSE.prettyPrint l)
  HSE.InfixApp _ p op q -> apps (Var Inf (snd (opString op))) [p,q]
  HSE.App _ f x -> hseToExpr f `App` hseToExpr x
  HSE.NegApp _ e -> Var Pref "negate" `App` hseToExpr e
  HSE.Lambda _ ps e -> foldr (Lambda . hseToPattern) (hseToExpr e) ps
  HSE.Let _ bs e -> case bs of
    HSE.BDecls _ ds -> Let (map hseToDecl ds) (hseToExpr e)
    HSE.IPBinds _ ips -> todo ips
  HSE.If _ b t f -> apps if' [b,t,f]
  HSE.Case{} -> todo expr
  HSE.Do{} -> todo expr
  HSE.MDo{} -> todo expr
  HSE.Tuple _ HSE.Boxed es -> apps (Var Inf (replicate (length es - 1) ','))  es
  HSE.TupleSection{} -> todo expr
  HSE.List _ xs -> list (map hseToExpr xs)
  HSE.Paren _ e -> hseToExpr e
  HSE.LeftSection _ l op -> Var Inf (snd (opString op)) `App` hseToExpr l
  HSE.RightSection _ op r -> flip' `App` Var Inf (snd (opString op)) `App` hseToExpr r
  HSE.RecConstr{} -> todo expr
  HSE.RecUpdate{} -> todo expr
  HSE.EnumFrom _ x -> apps (Var Pref "enumFrom") [x]
  HSE.EnumFromTo _ x y -> apps (Var Pref "enumFromTo") [x,y]
  HSE.EnumFromThen _ x y -> apps (Var Pref "enumFromThen") [x,y]
  HSE.EnumFromThenTo _ x y z -> apps (Var Pref "enumFromThenTo") [x,y,z]
  _ -> todo expr

...

parsePF :: String -> Either String TopLevel
parsePF inp = case HSE.parseExpWithMode parseMode inp of
  HSE.ParseOk e -> Right (TLE (hseToExpr e))
  HSE.ParseFailed _ expParseErr -> case HSE.parseDeclWithMode parseMode inp of
    HSE.ParseOk d -> Right (TLD True (hseToDecl d))
    HSE.ParseFailed _ declParseErr -> Left jointErrorMessage where
      jointErrorMessage = join
        [ "Parsing input as an expression failed with \"", expParseErr,  "\""
        , "\n"
        , "Parsing input as an declaration failed with \"", declParseErr, "\""
        ]
```

実装を見るとHaskellのASTが`Expr`型に落とし込まれているのがわかります。
いくつか名前からわかりづらいものとしては、

* `IPVar` → 暗黙的引数 (implicit parameter)
* `IPBinds` → Let式における暗黙的引数束縛 (implicit parameter bindings)
* `BDecls` → Let式における普通の引数束縛 (binding declarations)
* `MDo` → 再帰的Do記法 (recursive do-notation)
* `LeftSectoion` → 左セクション (e.g. `(x +)`)
* `RightSection` → 右セクション (e.g. `(+ x)`)
* `EnumFromThenTo` → リスト数列表記 (e.g. `[1,3..10]`)

などがあります。

またパターンには列挙されていませんが、リスト内包表記は`ListComp`に対応するようです。

せっかくなので幾つかレア？な構文についても解説していきましょう。

暗黙的引数とは以下の`?cmp`のように、Let式の中で暗黙的に引き継がれるパラメータのことです。
ユースケースとしてはReaderモナドと似ていますね。

```haskell
{-# LANGUAGE ImplicitParams #-}

sortBy' :: (?cmp :: a -> a -> Ordering) => [a] -> [a]
sortBy' = sortBy ?cmp

sort :: Ord a => [a] -> [a]
sort = let ?cmp = compare in sortBy'
```

`MDo`は (相互) 再帰的に束縛変数を参照するDo構文を可能にするもので、
再帰的な参照がある箇所に`rec`を挿入し、`mfix`で不動点をとる、というように実現されています。

```haskell
{-# LANGUAGE RecursiveDo #-}

justOnes = mdo
	xs <- Just (1:xs)
	return (map negate xs)

justOnes' = do
	rec xs <- Just (1:xs)
	return (map negate xs)

justOnes'' = do
	xs <- mfix (\~xs -> do { xs' <- Just (1:xs); return xs' })
	return (map negate xs)

class Monad m => MonadFix m where
   mfix :: (a -> m a) -> m a
```

最後に、以上の実装を見るとわかると思うのですが
全ての構文がサポートされてるわけはないようで、例えば`do`構文などは`todo`になっており未対応でした:

```haskell
main = do { input <- getLine; putStrLn $ "you entered: " ++ input }
```

```console
$ cabal run pointfree -- --stdin
Up to date
main = do { input <- getLine; putStrLn $ "you entered: " ++ input }
pointfree: pointfree: not supported: Do () [Generator () (PVar () (Ident () "input")) (Var () (UnQual () (Ident () "getLine"))),Qualifier () (InfixApp () (Var () (UnQual () (Ident () "putStrLn"))) (QVarOp () (UnQual () (Symbol () "$"))) (InfixApp () (Lit () (String () "you entered: " "you entered: ")) (QVarOp () (UnQual () (Symbol () "++"))) (Var () (UnQual () (Ident () "input")))))]
CallStack (from HasCallStack):
  error, called at ./Plugin/Pl/Parser.hs:8:14 in main:Plugin.Pl.Parser
zsh: exit 1     cabal run pointfree -- --stdin
```

`do`構文などもpoint-freeスタイル化できるよう拡張してみるのも楽しそうですね。

### `Transform.hs`

それでは、今回の変換のメインロジックを見ていきましょう。

```haskell
transform :: Expr -> Expr
transform = transform' . alphaRename . unLet
```

`Transform.hs`のエントリーポイントは`transform`関数で、
`unLet` → `alphaRename` → `transform'`という三段階の変換によって構成されていることがわかります。

どれも面白いので一つ一つ解説していきます。

---

`unLet`は文字通りLet式を代入によって取り除く役割を持ちます。
ただ代入のみであれば単純なのですが、Let式の束縛が以下の例のように:

```haskell
let x = y
    y = x
in x + y
```

相互再帰的な依存をする可能性を考えなければならず、意外と面白い実装になっています:

```haskell
import Data.Graph (stronglyConnComp, flattenSCC, flattenSCCs)

tuple :: [Expr] -> Expr
tuple es  = foldr1 (\x y -> Var Inf "," `App` x `App` y) es

tupleP :: [String] -> Pattern
tupleP vs = foldr1 PTuple $ PVar `map` vs

dependsOn :: [Decl] -> Decl -> [Decl]
dependsOn ds d = [d' | d' <- ds, declName d' `isFreeIn` declExpr d]

unLet :: Expr -> Expr
unLet (App e1 e2) = App (unLet e1) (unLet e2)
unLet (Let [] e) = unLet e
unLet (Let ds e) = unLet $
  (Lambda (tupleP $ declName `map` dsYes) (Let dsNo e)) `App`
    (fix' `App` (Lambda (tupleP $ declName `map` dsYes)
                        (tuple  $ declExpr `map` dsYes)))
    where
  comps = stronglyConnComp [(d',d',dependsOn ds d') | d' <- ds]
  dsYes = flattenSCC $ head comps
  dsNo = flattenSCCs $ tail comps
unLet (Lambda v e) = Lambda v (unLet e)
unLet (Var f x) = Var f x
```

まず初めに、`unLet (Let ds e) = ...`のWhere句で、
Let式を頂点+依存関係 `dependsOn` を辺としたグラフを構築し、強連結成分 (Strongly connected component/SCC) を `stronglyConnComp`によって求めています。

`stronglyConnComp`はSCCのリストをトポロジカルソートの逆順で返すため、`dsYes = flattenSCC $ head comps`は他のSCCには依存関係の無いSCCの頂点 (グラフの葉の部分)、`dsNo = flattenSCCs $ tail comps`には残りのSCCの頂点が入ることになります。

そして`fix' ...`の部分でこの他のSCCに一切依存しない`dsYes`の不動点をランタイムで求めるようにASTを構築しています。出力後のプログラムだとこんな感じになるのではないでしょうか:

```haskell
fix $ \(dsYesName1, desYesName2, ...) -> (dsYesExpr1, dsYesExpr2, ...)
```

この不動点が求まると`dsYes`に束縛される値が確定するわけですね。
あとはこの確定した値を`dsNo`に代入して、残りのSCCに対しても再帰的に`unLet`を適用する、といった寸法です。

個人的には全ての`ds`に対して不動点を求めてしまっても良い気がしていて、
SCCごとに求めるのは正当性 (correctness) の問題ではなく、最適化・可読性による理由だと考えています。
(間違っていたらすみません...)

イメージとしては、`x`/`y`と`p`はそれぞれ独立したSCCになり、`p`を毎回更新する必要はない、といった感じでしょうか:

```haskell
let x = y
	y = x
	p = 57
in x + y + p
```

---

`alphaRename`は$\alpha$-同値関係 ($\alpha$-equivalence) によって、
ルートから$i$-番目のラムダ式の束縛変数を`$i`に改名する関数です:

```haskell
import qualified Data.Map as M

type Env = (M.Map String String, Int)

alphaRename :: Expr -> Expr
alphaRename e = alpha e `evalState` (M.empty, 0) where
  alpha :: Expr -> State Env Expr
  alpha (Var f v) = do (fm, _) <- get; return $ Var f $ maybe v id (M.lookup v fm)
  alpha (App e1 e2) = liftM2 App (alpha e1) (alpha e2)
  alpha (Let _ _) = assert False bt
  alpha (Lambda v e') = inEnv $ liftM2 Lambda (alphaPat v) (alpha e')

  -- act like a reader monad
  inEnv :: State s a -> State s a
  inEnv f = gets $ evalState f

  alphaPat (PVar v) = do
    (fm, i) <- get
    let v' = "$" ++ show i
    put (M.insert v v' fm, i+1)
    return $ PVar v'
  alphaPat (PTuple p1 p2) = liftM2 PTuple (alphaPat p1) (alphaPat p2)
  alphaPat (PCons p1 p2) = liftM2 PCons (alphaPat p1) (alphaPat p2)
```

`unLet`によってLet式は無くなっているはずなので、
`alpha (Let _ _) = `のパターンにヒットした場合は例外を発生させています。
`bt` (bottom) は単純に`undefined`のことで、`Commoh.hs`に定義されています:

```haskell
bt :: a
bt = undefined
```

`alpha`と`alphaPat`は書き換えの対応を記録する`Env`を状態にもつ`State`モナドです。
自由変数を`Env`に基づいて置き換え、新たな束縛引数に遭遇するたびに`Env`を更新しています。

`inEnv`は`State`モナド`f`を引数としてとり、それを評価した結果を値`a`としてもつ新たな`State`モナドを作り出す関数です。`Env`を現在の`Lambda`のスコープ内で隔離する役割があり、最終的な値`Expr`のみ取り出せるようになっています。

イメージとしては、

```haskell
\x ->
 if x == 0
	 then \y -> x + y 
	 else \z -> x + z
```

のようなラムダ式があった場合、

```haskell
\$0 ->
 if $0 == 0
	 then \$1 -> $0 + $1
	 else \$1 -> $0 + $1
```

のように入れ子関係にないラムダ式に関しては束縛引数の名前を分ける必要がないため、
同じ名前`$1`が割り当てられるようになるわけです。

---

最後に、変換の肝である`transform`関数を見ていきましょう。

```haskell
transform' :: Expr -> Expr
transform' exp = go exp
  where
    -- Explicit sharing for readability
    vars = names exp

    go (Let {}) =
      assert False bt
    go (Var f v) =
      Var f v
    go (App e1 e2) =
      App (go e1) (go e2)
    go (Lambda (PTuple p1 p2) e) =
      go $
        Lambda (PVar var) $ (Lambda p1 . Lambda p2 $ e) `App` f `App` s
      where
        var   = fresh vars
        f     = Var Pref "fst" `App` Var Pref var
        s     = Var Pref "snd" `App` Var Pref var
    go (Lambda (PCons p1 p2) e) =
      go $
        Lambda (PVar var) $ (Lambda p1 . Lambda p2 $ e) `App` f `App` s
      where
        var = fresh vars
        f   = Var Pref "head" `App` Var Pref var
        s   = Var Pref "tail" `App` Var Pref var
    go (Lambda (PVar v) e) =
      go $ getRidOfV e
      where
        getRidOfV (Var f v') | v == v'   = id'
                             | otherwise = const' `App` Var f v'
        getRidOfV l@(Lambda pat _) =
          assert (not $ v `occursP` pat) $ getRidOfV $ go l
        getRidOfV (Let {}) = assert False bt
        getRidOfV e'@(App e1 e2)
          | fr1 && fr2 = scomb `App` getRidOfV e1 `App` getRidOfV e2
          | fr1 = flip' `App` getRidOfV e1 `App` e2
          | Var _ v' <- e2, v' == v = e1
          | fr2 = comp `App` e1 `App` getRidOfV e2
          | True = const' `App` e'
          where
            fr1 = v `isFreeIn` e1
            fr2 = v `isFreeIn` e2
```

`go (Lambda (PTuple p1 p2) e) = ...`と
`go (Lambda (PCons p1 p2) e) = ...`のパターンは束縛引数にパターンマッチングが現れないよう変換する処理を行っていて、

具体的には、

```haskell
--- Before:
\(x, y) -> x + y 
--- After:
\p -> (\x -> (\y -> x + y)) (fst p) (snd p)
```

```haskell
--- Before:
\(x:xs) -> x `elem` xs
--- After:
\l -> (\x -> (\xs -> x `elem` xs)) (head l) (tail l)
```

のように変換を行います。

そして最後に、
`go (Lambda (PVar v) e) = ...`のパターンで登場する`getRidOfV`関数が肝中の肝となっています。

基本的な考え方としては、point-freeスタイルではラムダ式`\x -> ...`の引数`x`を使うことができないので、
代わりに`x`に依存するという文脈を持つ関数モナド`(r ->)`の合成を行なっていきます。

例えば、以下のパターンでは、

```haskell
getRidOfV (Var f v') | v == v'   = id'
					 | otherwise = const' `App` Var f v'
```

* ラムダ式の引数`v`と変数`v'`が同じ場合 → `v`に依存する文脈を持ち、値`v`を返す関数モナド`id`
* ラムダ式の引数`v`と変数`v'`が異なる場合 → `v`に依存する文脈を持つが、値`v`に関係なく`v'`を返す関数モナド`const`

となり、
また以下のパターンでは、

```haskell
getRidOfV e'@(App e1 e2)
  | fr1 && fr2 = scomb `App` getRidOfV e1 `App` getRidOfV e2
  | fr1 = flip' `App` getRidOfV e1 `App` e2
  | Var _ v' <- e2, v' == v = e1
  | fr2 = comp `App` e1 `App` getRidOfV e2
  | True = const' `App` e'
  where
	fr1 = v `isFreeIn` e1
	fr2 = v `isFreeIn` e2
```

* ラムダ式の引数`v`が`e1`/`e2`ともに使われている場合 → `e1`/`e1`ともに関数モナドに変換して、関数モナド同士をApplicative `ap :: m (a -> b) -> m a -> m b` (`scomb`) によって合成
* ラムダ式の引数`v`が`e1`でのみ使われている場合 → `e1`のみ関数モナドに変換して、`e2`は関数モナドではないので`flip :: (r -> b -> c) -> b -> r -> c`によって先に適用
* ラムダ式の引数`v`が`e2`でのみ使われている場合
	* `e2`が単純な変数`v'`かつラムダ式の引数`v`と同じ場合 → `e2`を適用しても`e1`は変わらないので`e1`を返す
	* それ以外の場合 → `e1`のみ関数モナドに変換して、そのまま`(.) :: (b -> c) -> (a -> b) -> a -> c` (`comb`) によって適用
* ラムダ式の引数`v`が`e1`/`e2`ともに使われていない場合 → 文脈に依存しない関数モナド`const`

といったロジックになっています。

また`getRidOfV`中に新たなラムダ式に遭遇した場合は再帰的に`go`を適用するのですが、
この際`alphaRename`によって`pat`の中に`v`が存在しない状態になっていることをアサートしています:

```haskell
getRidOfV l@(Lambda pat _) =
  assert (not $ v `occursP` pat) $ getRidOfV $ go l
```

### `Optimize.hs`

`Transform.hs`の解説がやはり長くなってしまいました...
最後に`Optimize.hs`について軽く解説して終わりたいと思います。

`Optimize.hs`の主な役割としては、式書き換え (TRS) によって`Transform.hs`で変換されたプログラムをよりイディオマティックなpoint-freeスタイルに変換する、というものになります。

式書き換えの仕組みとしては、`MExpr`という穴 (Hole) つき文脈 (Context) を用意し、
その穴の中にマッチするパターンがあれば書き換える、といった形になっています。
(ラムダ式の評価文脈 $C[]$と同じですね)

```haskell
data MExpr
  = MApp !MExpr !MExpr
  | Hole !Int
  | Quote !Expr
  deriving Eq
```

以下に幾つか書き換えルールの例を挙げておきたいと思います:

```haskell
data RewriteRule 
  = RR Rewrite Rewrite
  | ...

rr0 :: RewriteC a => a -> a -> RewriteRule
rr0 r1 r2 = RR r1' r2' where
  r1' = getRewrite r1
  r2' = getRewrite r2

simplifies :: RewriteRule
simplifies = Or [
  -- (f . g) x --> f (g x)
  rr0 (\f g x -> (f `c` g) `a` x)
      (\f g x -> f `a` (g `a` x)),
  -- id x --> x
  rr0 (\x -> idE `a` x)
      (\x -> x),
  -- flip id x . f --> flip f x
  rr0 (\f x -> (flipE `a` idE `a` x) `c` f)
      (\f x -> flipE `a` f `a` x),
  -- id . f --> f
  rr0 (\f -> idE `c` f)
      (\f -> f),
  -- f . id --> f
  rr0 (\f -> f `c` idE)
      (\f -> f),
...
```

もっとトリッキーなものだと

* `(.) . flip id --> flip flip`
* `uncurry ((. g) . (,) . f) --> f *** g`
* `uncurry ((. g) . (,)) --> second g`

のようなものもありました。
Arrow初心者なので`***`とか見るともうやめてくれ...って感じですね。

これら書き換えルールの適用ロジックは`optimize`関数にまとまっているのですが、
正直言って完全に理解していないので、また暇があったらじっくり読んで解説の方も更新したいと思います。

## さいごに

やっぱりHaskellは楽しいですね。
特に`unLet`と`transform'`が天才的でした。先人すごい。

point-freeスタイルはHaskell/Ocaml以外だと使う印象がありませんが (~~というか使うべきではない~~)、高階関数/カリー化がサポートされている言語であれば可能だと思うので、Scala/Python/JavaScriptあたりでも実践できるのではないでしょうか。

みなさんもぜひpoint-freeなプログラミングライフを！