トップ «前の日記(2015-02-07 (Sat)) 最新 次の日記(2015-03-14 (Sat))» 編集

uDiary

海野秀之(うんのひでゆき)の外部記憶

Twitter (twilog) / RSS / アンテナ / ぶくま

2006|07|08|09|10|11|12|
2007|01|02|03|04|05|06|07|08|09|10|11|12|
2008|01|02|03|04|05|06|07|08|09|10|11|12|
2009|01|02|03|04|05|06|08|
2010|01|02|03|05|06|07|10|11|
2011|03|08|
2012|02|04|07|08|10|
2013|01|02|03|05|06|08|11|12|
2014|01|02|05|06|07|08|09|12|
2015|01|02|03|04|

2015-02-24 (Tue)

[Haskell][Hand] サンプル入力

とりあえず これ が処理できるようなコンパイラを書きたいなと思ってたのが 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"

2006|07|08|09|10|11|12|
2007|01|02|03|04|05|06|07|08|09|10|11|12|
2008|01|02|03|04|05|06|07|08|09|10|11|12|
2009|01|02|03|04|05|06|08|
2010|01|02|03|05|06|07|10|11|
2011|03|08|
2012|02|04|07|08|10|
2013|01|02|03|05|06|08|11|12|
2014|01|02|05|06|07|08|09|12|
2015|01|02|03|04|
Categories 3imp | Card | Cutter | Dalvik | Euler | Football | GAE/J | Hand | Haskell | Re:View | Ruby | Scheme | TQD | Tiger | TigerBook読 | UikiTeXi | Verilog | Violin | Web | parconc | tDiary | お勉強 | エントロピー | ツン読 | | 将棋 | 政治について | | 模写してみよう | 確率論 | 設定など | 雑文 | 音声