海野秀之(うんのひでゆき)の外部記憶
Twitter (twilog) / RSS / アンテナ / ぶくま
shift/reduce conflicts: 128 → 72
reduce/reduce conflicts: 151 → 57
ずいぶん減らしたけど、まだまだあるなぁ。
自分でてきとうに書いた文法を LALR(1) に書き直すのは大変っぽかったので、
自分で一度かいたら読めるようになった GHC の Parser.y を有難く参考にさせていただくことにした。
おかげさまで、↓このとおり。ありがたい!
$ happy -i src/Parser.y
shift/reduce conflicts: 12
どうしてこう書くとよいのか、こう書かねばならないのかは、おいおい理解したい。
んでもって、このままではレイアウト規則の最後の1ピースがはまっていないので、構文エラーになる。
$ src/Parser < testcases/test1.hs
Left "parseError: TVCCurly (AlexPn 588 17 1)"
でもって、エラートークンがきたらコンテキストを pop するようにしてやると、
-- Layout ---------------------------------------------------------------------
close: vccurly {}
| error {% popCtx }
…
$ src/Parser < testcases/test1.hs
Right ()
よしよし。スバラシイ。
この調子で、今週中に抽象構文木をつくるところまではいってしまおう。
ふふふ。次はいよいよ型推論(または型再構築)であーる。
@<m>{}
のなかで {, } を気軽に書きたかったので改造。互換性上、プルリクは無理そうなのがわかったけど、自分はこれが使いたいので勝手に使いつづけよう。
現状の改造版では、次のように書ける。
@<m>{\sigma_{2} = \\{ 5/x \\} \cup \sigma_{1}}
\{
, \}
はカウントされないので、対応とれてない場合に使う。エスケープされて {, } になる。\{
が書きたいときには \\{
と書く必要がある。オプション部分の解析を自前にしたので、一番外側の括弧を選べるようにしてもいいかなとも思ったけど、どっちみち互換性むちゃくちゃなので、ま、凝らなくていいような気がした。
互換性を維持するために、新しいインラインコマンド記法を追加して、その場合には新規の文法が有効になるとかにしないといけないんだな、きっと。
ちなみに、既存の仕様に適応しようかとはおもったのだけど、$ \sigma_{2} = \{ 5/x \} \cup \sigma_{1} $
を得るためにどう書けばいいのか、わかんなかった。
とりあえず これ が処理できるようなコンパイラを書きたいなと思ってたのが 2012 年 10 月だったらしいので、2年以上たってる!
ようやく、これを構文解析できるところまではいった。
$ sample/parser_sample < testcases/tqd.hs
Right (Module {modid = Nothing, exports = Nothing, body = ([],[ValDecl (FunAppExp (VarExp (Name {name_base = "qsort", name_qual = "", name_pos = (2,1)})) (VarExp (Name {name_base = "[]", name_qual = "", name_pos = (2,7)}))) (UnguardedRhs (VarExp (Name {name_base = "[]", name_qual = "", name_pos = (2,16)})) []),ValDecl (FunAppExp (VarExp (Name {name_base = "qsort", name_qual = "", name_pos = (3,1)})) (ParExp (InfixExp (VarExp (Name {name_base = "x", name_qual = "", name_pos = (3,8)})) (Name {name_base = ":", name_qual = "", name_pos = (3,9)}) (VarExp (Name {name_base = "xs", name_qual = "", name_pos = (3,10)}))))) (UnguardedRhs (InfixExp (InfixExp (FunAppExp (VarExp (Name {name_base = "qsort", name_qual = "", name_pos = (3,16)})) (VarExp (Name {name_base = "smaller", name_qual = "", name_pos = (3,22)}))) (Name {name_base = "++", name_qual = "", name_pos = (3,30)}) (ListExp [VarExp (Name {name_base = "x", name_qual = "", name_pos = (3,34)})])) (Name {name_base = "++", name_qual = "", name_pos = (3,37)}) (FunAppExp (VarExp (Name {name_base = "qsort", name_qual = "", name_pos = (3,40)})) (VarExp (Name {name_base = "larger", name_qual = "", name_pos = (3,46)})))) [ValDecl (VarExp (Name {name_base = "smaller", name_qual = "", name_pos = (5,18)})) (UnguardedRhs (ListCompExp (VarExp (Name {name_base = "a", name_qual = "", name_pos = (5,29)})) [BindStmt (VarExp (Name {name_base = "a", name_qual = "", name_pos = (5,33)})) (VarExp (Name {name_base = "xs", name_qual = "", name_pos = (5,38)})),ExpStmt (InfixExp (VarExp (Name {name_base = "a", name_qual = "", name_pos = (5,42)})) (Name {name_base = "<=", name_qual = "", name_pos = (5,44)}) (VarExp (Name {name_base = "x", name_qual = "", name_pos = (5,47)})))]) []),ValDecl (VarExp (Name {name_base = "larger", name_qual = "", name_pos = (6,18)})) (UnguardedRhs (ListCompExp (VarExp (Name {name_base = "b", name_qual = "", name_pos = (6,29)})) [BindStmt (VarExp (Name {name_base = "b", name_qual = "", name_pos = (6,33)})) (VarExp (Name {name_base = "xs", name_qual = "", name_pos = (6,38)})),ExpStmt (InfixExp (VarExp (Name {name_base = "b", name_qual = "", name_pos = (6,42)})) (Name {name_base = ">", name_qual = "", name_pos = (6,44)}) (VarExp (Name {name_base = "x", name_qual = "", name_pos = (6,46)})))]) [])]),TypeSigDecl [Name {name_base = "main", name_qual = "", name_pos = (8,1)}] (Nothing,AppTy (Tycon (Name {name_base = "IO", name_qual = "", name_pos = (8,9)})) (Tycon (Name {name_base = "()", name_qual = "", name_pos = (8,12)}))),ValDecl (VarExp (Name {name_base = "main", name_qual = "", name_pos = (9,1)})) (UnguardedRhs (DoExp [LetStmt [ValDecl (VarExp (Name {name_base = "helo", name_qual = "", name_pos = (10,10)})) (UnguardedRhs (LitExp (LitString "Hello, World!" (10,17))) [])],ExpStmt (FunAppExp (VarExp (Name {name_base = "putStrLn", name_qual = "", name_pos = (11,6)})) (VarExp (Name {name_base = "helo", name_qual = "", name_pos = (11,15)}))),ExpStmt (InfixExp (InfixExp (VarExp (Name {name_base = "putStrLn", name_qual = "", name_pos = (12,6)})) (Name {name_base = "", name_qual = ".", name_pos = (12,14)}) (VarExp (Name {name_base = "show", name_qual = "", name_pos = (12,15)}))) (Name {name_base = "$", name_qual = "", name_pos = (12,20)}) (FunAppExp (VarExp (Name {name_base = "qsort", name_qual = "", name_pos = (12,22)})) (ListExp [LitExp (LitInteger 3 (12,29)),LitExp (LitInteger 1 (12,32)),LitExp (LitInteger 4 (12,35)),LitExp (LitInteger 1 (12,38)),LitExp (LitInteger 5 (12,41)),LitExp (LitInteger 9 (12,44)),LitExp (LitInteger 2 (12,47)),LitExp (LitInteger 6 (12,50)),LitExp (LitInteger 5 (12,53))]))),ExpStmt (InfixExp (InfixExp (VarExp (Name {name_base = "putStrLn", name_qual = "", name_pos = (13,6)})) (Name {name_base = "$", name_qual = "", name_pos = (13,15)}) (VarExp (Name {name_base = "show", name_qual = "", name_pos = (13,17)}))) (Name {name_base = "$", name_qual = "", name_pos = (13,22)}) (FunAppExp (VarExp (Name {name_base = "qsort", name_qual = "", name_pos = (13,24)})) (VarExp (Name {name_base = "helo", name_qual = "", name_pos = (13,30)}))))]) [])])})
Typing Haskell in Haskell をみながら書いた型推論器もいちおうもうあるので、構文木を加工して型推論にかけられるように加工する部分(Desugar 的な)を書いてやればよいはず。
ちなみに、今日これを Parse しようとして、layout まわりのバグをみつけた。do の直後の let がうまく処理されていなかったという。
この例には明に型付けされた束縛と、明に型付けされていない束縛が1つづつあって、defaulting も行われるので、型推論の最初の動作確認にはちょうどよさそう。依存解析はまだ省ける。
$ runhaskell -Wall tqd.hs
tqd.hs:2:1: Warning:
Top-level binding with no type signature:
qsort :: forall a. Ord a => [a] -> [a]
tqd.hs:12:29: Warning:
Defaulting the following constraint(s) to type `Integer'
(Num a0) arising from the literal `3' at tqd.hs:12:29
(Ord a0) arising from a use of `qsort' at tqd.hs:12:22-26
(Show a0) arising from a use of `show' at tqd.hs:12:15-18
In the expression: 3
In the first argument of `qsort', namely `[3, 1, 4, 1, ....]'
In the second argument of `($)', namely `qsort [3, 1, 4, 1, ....]'
Hello, World!
[1,1,2,3,4,5,5,6,9]
" !,HWdellloor"