高階 Fix で作る拡張可能な AST
これは PureScript Advent Calendar 11 日目の記事です。
僕が運営している PureScript JP Discord 鯖もよろしくお願いします (早く Haskell JP みたいにロギング機能作んないと)
これは何？
AST の木構造を後から拡張可能にします。ただの Fix ではなく高階の Fix を使うことで、例えば式と文など、複数のノードの種類がある AST に関しても問題なく拡張できます。データ構造にあとからメタデータなどを注入できて便利(本当に？)。
コードはここ
モチベーション
TypeScript を触っていると、Language Server が頭良いな～と感じることが多々あります。例えば、1 ファイル内に構文エラーがあっても、その場所を飛ばして他のパースを再開する機能が挙げられます。
というのも、TypeScript では
const x ===== 1;
const t = 2;
と書いても、問題なく t の型は 2 であると推論されます。
この機能を実装するには、AST の特定のブランチにパースエラー起きたのでパースを飛ばしたよ、という情報を乗っけたいです。
しかし、AST の構造に、その様なパース時の都合を乗っけるのは微妙です。ここで、この記事を見かけました
短くいうと、これを PureScript で再実装したまでです。それだけではナンなので、ついでに色々と遊んでみました。
実装
まずは FixH の定義です。
data FixH :: forall k. ((k -> Type) -> k -> Type) -> k -> Type
data FixH f p = InH (f (FixH f) p)
roll :: forall f p. f (FixH f) p -> FixH f p
roll = InH
unroll :: forall f p. FixH f p -> f (FixH f) p
unroll (InH x) = x
FixH は "分岐の構造" f :: (k -> Type) -> k -> Type を取って、その分岐によって構成される木を表す型です。k は分岐の構造の種類を表す型です。
例えば、二分木なら 1 種類しかないので k は適当に Unit でも入れてれば OK です。
data BinBranch r a = Leaf Int | Node (r Unit) (r Unit)
type BinTree = FixH BinBranch Unit
しかし、例えば If 文を含むような式木などは、式に型をつけながら構成すると便利です。(Intrinsically typed と呼ばれる)
data ExprBranch r a =
Lit a
| Add (r Int) (r Int) (a ~ Int)
| Mul (r Int) (r Int) (a ~ Int)
| Eq (r Int) (r Int) (a ~ Boolean)
| If (r Boolean) (r a) (r a)
type ExprTree = FixH ExprBranch Int
ここで a ~ Int は a が Int と等しいことを保証する値で、PureScript では Data.Leibniz から import しています。(Haskell では GADTs を使うと省ける)
お気持ち的にはこの定義は二つのデータ構造を Union したものと見ることが出来ます。
すなわち分岐の種類は 2 種類 (Int と Boolean) で、Int の場合は a に Int を入れたもの
data ExprBranchInt r =
Lit Int
| Add (r Int) (r Int)
| Mul (r Int) (r Int)
| If (r Boolean) (r Int) (r Int)
Boolean の場合は a に Boolean を入れたもの
data ExprBranchBoolean r =
Lit Boolean
| Eq (r Int) (r Int)
| If (r Boolean) (r Boolean) (r Boolean)
です。
これらを一つにまとめることで、FixH の引数として渡すことができます。
さて、この木構造上の fold を考えましょう
class HFunctor :: forall k1 k2. ((k1 -> Type) -> k2 -> Type) -> Constraint
class HFunctor f where
hmap :: forall g h p. (forall a. g a -> h a) -> f g p -> f h p
foldFix :: forall f g p. HFunctor f => (forall q. f g q -> g q) -> FixH f p -> g p
foldFix alg x = alg $ hmap (foldFix alg) (unroll x)
いきなり HFunctor クラスが出てきましたが、これは Functor の高階版です。Fix を畳み込むのに Functor が必要なのと同様に、FixH を畳み込むのに HFunctor が必要です。
foldFix は第一引数に分岐を畳み込む関数をとって、それらを再帰的に木に適用して畳み込む関数です。
次に、このブログにおいて大事な、ブランチの拡張のための定義をしていきます。
data ProductH :: forall k. ((k -> Type) -> k -> Type) -> ((k -> Type) -> k -> Type) -> (k -> Type) -> k -> Type
data ProductH f g h p = ProductH (f h p) (g h p)
infixr 5 type ProductH as :*:
instance (HFunctor f, HFunctor g) => HFunctor (ProductH f g) where
hmap f = case _ of
ProductH x y -> ProductH (hmap f x) (hmap f y)
data CoproductH :: forall k. ((k -> Type) -> k -> Type) -> ((k -> Type) -> k -> Type) -> (k -> Type) -> k -> Type
data CoproductH f g h p = InLH (f h p) | InRH (g h p)
infixr 5 type CoproductH as :+:
instance (HFunctor f, HFunctor g) => HFunctor (CoproductH f g) where
hmap f = case _ of
InLH x -> InLH $ hmap f x
InRH y -> InRH $ hmap f y
ブランチの拡張方法は 2 通りあります。2 つのブランチを並列に並べる Product と、2 つのブランチを選択肢として持つ Coproduct です。ここではそれぞれ高階版を定義し、:*: と :+: で書けるようにしました。
例えば、先ほどの二分木の定義を思い出してみましょう。
data BinBranch r a = Leaf Int | Node (r Unit) (r Unit)
type BinTree = FixH BinBranch Unit
これを拡張して、分岐が 3 個あるノードも許容したいと思います。そのためには子が三個のブランチを用意してあげて……
data TernBranch r a = Node (r Unit) (r Unit) (r Unit)
次のように BinBranch と結合してあげれば OK です。
type BinTernTree = FixH (BinBranch :+: TernBranch) Unit
このような拡張は BinaryTree の普通の定義
data BinaryTree' a = Leaf a | Node (BinaryTree' a) (BinaryTree' a)
ではできません。便利そうだぞ！(本当に？)
使ってみる
簡単な言語を作ってみましょう。次のように、数式をセミコロンで区切ったものはどうでしょうか。
1 + 2; 2 * (3 + 4); 2 * 3;
実行時はそれぞれの値を表示するだけです
3
14
6
簡単ですが、この AST には Expression と Program の 2 種類の木が必要です。FixH を使わない定義は次のようになります。
data Op = Add | Mul
data Expr = Lit Int | Op Op Expr Expr
data Program = Empty | Seq Expr Program
これを FixH を使って書き換えると次のようになります。
data ASTF r p
=
-- Expression
ExpLitF Int (p ~ ExpressionP)
| ExpOpF Op (r ExpressionP) (r ExpressionP) (p ~ ExpressionP)
-- Program
| EmptyF (p ~ ProgramP)
| SeqF (r ExpressionP) (r ProgramP) (p ~ ProgramP)
type AST = FixH ASTF
適当に HFunctor にもしておきます (リポジトリ参照)
この ASTF の定義にはメタデータもエラーブランチも含まれていないことに注意してください。
次にメタデータ(位置)のブランチも定義します。
data MetadataF :: (Type -> Type) -> Type -> Type
data MetadataF r p = Metadata Position
ParseError も同様に定義
data ParseErrorF :: (Type -> Type) -> Type -> Type
data ParseErrorF r p = ErrorInExpF ParseError (p ~ ExpressionP)
これらを合成した新しい AST を作ります。
type AST' = FixH ((ASTF :+: ParseErrorF) :*: MetadataF)
これは、全てのブランチにメタデータが含まれていて、分岐は AST の通りかもしくはエラーであることを表しています。このように簡単に AST を拡張することができますね！
後は適当にパーサーを作って (ここが一番面倒くさい)、特に、特定の式のパースでエラーが発生しても、セミコロンまで飛ばして次の式をパースするようにしましょう。
parseProgramWithErr :: Parser String (AST' ProgramP)
parseProgramWithErr = withMeta do
alt
do
stmt <- catchError
( do
stmt <- parseExpression
void $ tokenParser.semi
pure stmt
)
\e -> do
skipToSemi
withMetaErr $ pure $ ErrorInExpF e identity
prog <- parseProgramWithErr
pure $ SeqF stmt prog identity
(一部抜粋)
これは AST に ParseError のブランチを付けたことで可能になっています。
後は適当にインタプリタを作って (ここが一番面倒くさい 2) 、実行してみましょう
正常なプログラムはもちろん正常に動きますし……
1 + 2; 2 * (3 + 4); 2 * 3;
↓
(Right 3)
(Right 14)
(Right 6)
途中でエラーがあっても、それを飛ばして次の式を実行できます！
1 + 2; 2 ** (3 + 4); 2 * 3;
↓
(Right 3)
(Left "Error in expression (Position { column: 22, index: 21, line: 1 })")
(Right 6)
まとめ
今回は高階 Fix を使って AST を拡張可能にする方法を紹介しました。コレを使えば変な依存関係を持たないまま機能追加が出来そうです。
現状の問題点として、パーサーとインタプリタは全く拡張可能でない事が挙げられます。(この例だと拡張前 AST と拡張後 AST' それぞれにパーサーを用意してあげなければいけません。)
インタプリタ側の拡張は比較的簡単に解決できそうですが、パーサーの拡張は未知数です。今後時間があったらここら辺も考えてみます。
以上です。ありがとうございました。
Discussion