aspの詳細はここ
https://github.com/yallop/ocaml-asp
asp is a typed, algebraic parser combinator library
PLDIの論文はこれ
https://www.cl.cam.ac.uk/~jdy22/papers/a-typed-algebraic-approach-to-parsing.pdf
次のようにして動作環境を用意して，
opam switch 4.07.1+BER
eval $(opam env)
opam remote add metaocaml git+https://github.com/metaocaml/metaocaml-opam.git
opam install asp
benchmarksにある以下２つの構文に対するstaged parserを参考に，型式のパーサを実装する．
(ステージ化は https://qiita.com/moatom/items/1ceaa0758f5b87d89404 を参照）
###整数式のパーサ
https://github.com/yallop/ocaml-asp/blob/master/benchmarks/intexp/intexp_staged_combinator_parser.ml
exp ::= x
let x = exp in exp
int
exp operator exp
if exp then exp else exp
( exp )
operator ::= + | - | * | =
(with appropriate precedence for operators)
###S式のパーサ
https://github.com/yallop/ocaml-asp/blob/master/benchmarks/sexp/sexp_staged_combinator_parser.ml
sexp ::= atom
( sexp * )
atom ::= [a-zA-Z][a-zA-Z0-9]*
(whitespace ignored)
#概要
実装の流れは次のようになるみたい．
- unstagedなトークンの定義
- stagedなトークンの定義(unstaged版のlifting)
- 文字集合上のパーサ(lexer)とトークン上のパーサ(parser)を用意
- lexerとparserを組み合わせた次のstaged_completeを構築 <--- 完成！！
let staged_complete : string -> int =
fun s -> staged_parser (staged_lexer_stream s)
Yaccのセマンティックアクションでは構文解析の結果を$?で取り出すが，aspではfst側にネストした順序対(継続の引数)に対するパターンマッチングで取り出すことになる．具体的に整数式のパーサで言うと，下記のコードではxが変数名，e，e'が各々bind部，body部のexpに相当する．
let letexp =
(tok LET >>> tok ID >>> tok EQUAL >>> exp >>> tok IN >>> exp) $
(fun p -> .< let (((((_,x),_),e),_),e') = .~p in
fun env -> e' ((x,e env) :: env) >.) in
パーサコンビネータというとHaskellのparsecが有名だが，これとaspとでは若干書き心地が異なる．なぜならAPIのスタイルが異なるから．
This API is basically the same as the one introduced by Swierstra and Duponcheel [1996], with the main difference
that our API is in the "monoidal" style (we give sequencing the type seq : 'a t -> 'b t -> ('a * 'b) t), while theirs is in
the "applicative" style (i.e., seq : ('a -> 'b) t -> 'a t -> 'b t).
- Krishnaswami and Yallop [2019]
parsecはapplicative(monadic)な方に属する．しかし，これだけでは違いがよくわからん．Swierstra and Duponcheel [1996]を見たところ，
let (<*>) = seq
let (<$>) f p = empty f <*> p
let if_e = (fun i c tp ep -> ...) <$> token "IF" <*> cond_e <*> then_e <*> else_e
こんな感じに<$>を使って先頭にセマンティックアクションを配置してifのパーサを書けるのがapplicativeで，
let (>>>) = seq
let ($) : 'a t -> ('a v -> 'b v) -> 'b t = ...
let if_e = token "IF" >>> cond_e >>> then_e >>> else_e $
(fun (((i,c),tp),ep) -> ...)
二項演算の結果をタプルにまとめ上げることからセマンティックアクションへの引数をネストした順序対で受け取らざるを得ないのがmonoidalっぽい？ちとaspの方が面倒っぽいが平坦なタプルだったらuncurry4できるわけで，同様な関数を定義しておけばもうちょいmonoidalの書き心地が良くなる気がする．
module Pair
type ('a,'b) t = 'a * 'b
let uncurry4 : ('a -> 'b -> 'c -> 'd -> 'e) -> ((('a,'b) t,'c) t,'d) t -> 'e =
fun f -> fun (((a,b),c),d) -> f a b c d
end
このように定義しておけば，上述のmonoidalは次のmonoidal2のように書けて幸せだなぁ〜...と思うじゃん？
let if_e = token "IF" >>> cond_e >>> then_e >>> else_e $
(Pair.uncurry4 @@ fun i c tp ep ->
...)
ところがパーサを逐次合成した結果は('a code * 'b code)ではなく('a * 'b) codeにステージ化されるので，staged parserにこの関数を直接は使えない．まあCSPを利用して次のようにするとよいだろう．
let if_e = token "IF" >>> cond_e >>> then_e >>> else_e $
(fun p -> .< Pair.uncurry4 (fun i c tp ep ->
...) .~p >.
いずれにせよ，ネストしたタプルを扱うオーバーヘッドがステージ化してもランタイムに残留してしまうことが分かる．現状aspは(ocaml)yacc/lexよりも2倍程度高速で十分すごいのだが，この辺りの問題が上手く解決されるともっと良くなるはず．
#型式のパーサ
使用感を見たところで早速型式のパーサの実装にとりかかる．型式の構文は次のように定義する．
exp ::= var | "int" | "bool" | "unit" | "flot" | "string" | ...
exp "ref" | exp "list" | exp "array" | ...
exp "->" exp | exp "*" exp | ...
"(" exp ")"
var ::= '[a-zA-Z0-9][a-zA-Z0-9_']*
ただしこの構文は演算子の規則で左再帰を含むので，aspでは扱えない．特に2項演算子はinfix関数を使えるので問題ないのだが，単項の後置演算子を左再帰を用いずに扱うのは難しい．勿論左再帰の除去自体は規則的な操作で求めることはできるのだが，少なくともWikipedia記載のアルゴリズムから生成される規則はコンビネータの制約から使用できない．証明していないので本当に正しいかは分からないが，取り敢えずそれっぽいBNFを思いついたので本稿ではこれを使用する(図Sytanx'に示す)．
var ::= '[a-zA-Z0-9][a-zA-Z0-9_']*
atom ::= var | "int" | "bool" | "unit" | "flot" | "string" | ...
postfix_exp ::= (atom | "(" exp ")")("ref" | "list" | "array")*
exp ::= postfix_exp "->" postfix_exp | postfix_exp "*" postfix_exp | ...
そして，完成したのがこれ．
https://github.com/moatom/asp-trial
次にparser部分だけを抜粋して載せる．
let atom = ((tok VAR) $ fun p -> .< Type.Var .~p >.)
<|> ((tok INT) $ fun _ -> .< Type.Int >.)
<|> ((tok BOOL) $ fun _ -> .< Type.Bool >.)
<|> ((tok UNIT) $ fun _ -> .< Type.Unit >.)
<|> ((tok FLOAT) $ fun _ -> .< Type.Float >.)
<|> ((tok STRING) $ fun _ -> .< Type.String >.)
let postfix_exp exp = any [atom; paren exp] >>> star (any [
((tok REF) $ fun _ -> .< fun e -> Type.Ref e >.);
((tok LIST) $ fun _ -> .< fun e -> Type.List e >.);
((tok ARRAY) $ fun _ -> .< fun e -> Type.Array e >.)
]) $ fun p -> .< (function (e, ops) -> List.fold_left (fun z f -> f z) e ops) .~p >.
let exp = fix (fun exp ->
(infix mkop (postfix_exp exp) [
Left, (tok TIMES $ fun _ -> .< fun x y -> Type.Tuple (x, y) >.);
Right, (tok RARROW $ fun _ -> .< fun x y -> Type.Fun (x, y) >.)
]))
Lexerや構文木(Type.t)で手を抜いたので若干不適切な部分はあるが，基本的にきちんと動く模様．次のように結合性も優先順位もバッチリ．
rlwrap metaocaml
#require "asp";;
#load "my_parser.cma";;
My_parser.Parser.staged_complete "int -> (bool -> bool) ref ref -> int*(bool -> int) ref list";;
- : Type.t =
Type.Fun (Type.Int,
Type.Fun (Type.Ref (Type.Ref (Type.Fun (Type.Bool, Type.Bool))),
Type.Tuple (Type.Int,
Type.List (Type.Ref (Type.Fun (Type.Bool, Type.Int))))))
My_parser.Parser.staged_complete "(int list * 'a * int -> string) array -> 'b ref ref list";;
- : Type.t =
Type.Fun
(Type.Array
(Type.Fun
(Type.Tuple (Type.Tuple (Type.List Type.Int, Type.Var "'a"), Type.Int),
Type.String)),
Type.List (Type.Ref (Type.Ref (Type.Var "'b"))))
#使ってみた感想
困ったのはinfix関数の使い方を理解するのに手間取ったり，後置演算子で左再帰が使えないことにハマったぐらいで，誤った実装を誤魔化さずに型検査で静的に弾いてくれるわ速いわで，非常に便利なのでは？といった感じ．といっても普通の人が使うにはライブラリレベルでステージ化を隠蔽しないとかなり厳しそう．またuncurry云々と文句を言っていたが，思ったよりも連接(seq)を扱う場合は多くないので実際には問題なさそう．