uDiary

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

とりあえず これ が処理できるようなコンパイラを書きたいなと思ってたのが 2012 年 10 月だったらしいので、２年以上たってる！

ようやく、これを構文解析できるところまではいった。

$ 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 がうまく処理されていなかったという。

この例には明に型付けされた束縛と、明に型付けされていない束縛が１つづつあって、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"