Implementing functional languages を頑張って読む.8日目

# 8日目

pApとpBinopの実装をした.pBinopは実際はpExpr1で,めっちゃ面倒くさかった.
Figure 1.3 のexpr4の減算とexpr5の除算の右辺が上のやつとちょっと違うのはいいんだろうか.
あー,いいのか.簡単のために1-2-3や3/2/1っていう式は作れないようにしたんだっけ.
でもこれ全部右結合じゃないかなあ.
まあ結合性(associativity)を満たす演算子,(+,*,&,|)に対してしか演算子の連続を認めてないから問題ないんだけど.
半群バンザイ!

```
--- corelang.hs 2016-03-01 19:02:54.603333356 +0900
+++ corelang1.hs        2016-03-01 19:02:54.616666690 +0900
@@ -241,16 +241,15 @@
     where mk_sc name arg _ expr = (name, arg, expr)
 
 pExpr :: Parser CoreExpr
-pExpr =     --pThen mk_ap pExpr pAexpr
-    --`pAlt`  pThen3 mk_binop pExpr (pApply pBinop EVar) pExpr
-    --`pAlt`
-    pThen4 mk_let (pLit "let") pDefns (pLit "in") pExpr
+pExpr =     pApply (pOneOrMore pAexpr) mk_ap
+    `pAlt`  pExpr1
+    `pAlt`  pThen4 mk_let (pLit "let") pDefns (pLit "in") pExpr
     `pAlt`  pThen4 mk_letrec (pLit "letrec") pDefns (pLit "in") pExpr
     `pAlt`  pThen4 mk_case (pLit "case") pExpr (pLit "of") pAlts
     `pAlt`  pThen4 mk_lam (pLit "\\") (pOneOrMore pVar) (pLit ".") pExpr
     `pAlt`  pAexpr
     where
-    mk_ap e a = EAp e a
+    mk_ap e = foldl1 EAp e
     mk_binop exp1 op exp2 = EAp (EAp op exp1) exp2
     mk_let _ defns _ e = ELet nonRecursive  defns  e
     mk_letrec _ defns _ e = ELet nonRecursive defns e
@@ -284,18 +283,9 @@
         mk_tag _ n _ = n
         mk_alter n v _ e = (n, v, e)
 
-pBinop :: Parser String
-pBinop = pArithop `pAlt` pRelop `pAlt` pBoolop
-
-pArithop :: Parser String
-pArithop = (pLit "+") `pAlt` (pLit "-") `pAlt` (pLit "*") `pAlt` (pLit "//")
-
 pRelop :: Parser String
 pRelop = (pLit "<") `pAlt` (pLit "<=") `pAlt` (pLit "==") `pAlt` (pLit "~=") `pAlt` (pLit ">=") `pAlt` (pLit ">")
 
-pBoolop :: Parser String
-pBoolop = (pLit "&") `pAlt` (pLit "|")
-
 syntax :: [Token] -> CoreProgram
 syntax = take_first_parse . pProgram
     where
@@ -306,9 +296,49 @@
 parse :: String -> CoreProgram
 parse = syntax . clex 1
 
+data PartialExpr = NoOp | FoundOp Name CoreExpr
+
+pExpr1c :: Parser PartialExpr
+pExpr1c = (pThen FoundOp (pLit "|") pExpr1) `pAlt` (pEmpty NoOp)
+
+pExpr1 :: Parser CoreExpr
+pExpr1 = pThen assembleOp pExpr2 pExpr1c
+
+pExpr2c :: Parser PartialExpr
+pExpr2c = (pThen FoundOp (pLit "&") pExpr2) `pAlt` (pEmpty NoOp)
+
+pExpr2 :: Parser CoreExpr
+pExpr2 = pThen assembleOp pExpr3 pExpr2c
+
+pExpr3c :: Parser PartialExpr
+pExpr3c = (pThen FoundOp pRelop pExpr4) `pAlt` (pEmpty NoOp)
+
+pExpr3 :: Parser CoreExpr
+pExpr3 = pThen assembleOp pExpr4 pExpr3c
+
+pExpr4c :: Parser PartialExpr
+pExpr4c = (pThen FoundOp (pLit "-") pExpr5) `pAlt` (pThen FoundOp (pLit "+") pExpr4) `pAlt` (pEmpty NoOp)
+
+pExpr4 :: Parser CoreExpr
+pExpr4 = pThen assembleOp pExpr5 pExpr4c
+
+pExpr5c :: Parser PartialExpr
+pExpr5c = (pThen FoundOp (pLit "/") pExpr6) `pAlt` (pThen FoundOp (pLit "*") pExpr5) `pAlt` (pEmpty NoOp)
+
+pExpr5 :: Parser CoreExpr
+pExpr5 = pThen assembleOp pExpr6 pExpr5c
+
+pExpr6 :: Parser CoreExpr
+pExpr6 = pApply (pOneOrMore pAexpr) (foldl1 EAp)
+
+assembleOp :: CoreExpr -> PartialExpr -> CoreExpr
+assembleOp e1 NoOp = e1
+assembleOp e1 (FoundOp op e2) = EAp (EAp (EVar op) e1) e2
+
 main :: IO ()
 --main = putStrLn $ iDisplay $ pprExpr (ELet nonRecursive [("att", ENum 2)] (EAp (EAp (EVar "+") (EVar "att")) (EVar "1")))
-main = putStrLn( pprint $ parse  "f=3;\ng x y = let z = x in z ;\nh x = case (let y = x in y) of\n<1> -> 2 ;\n<2> -> 5")
+main = putStrLn( pprint $ parse  "f=3;\ng x y = let z = x in z ;\nh x = case (let y = x in y) of\n<1> -> 2 ;\n<2> -> 5;\n i = g (1 + 2 * 3) (5 - 1 / 2)")
 --main = putStrLn $ show $ pOneOrMoreWithSep (pLit "x") (pLit ";") [(1,"x"),(1,";"),(1,"x") ,(1,";"),(2,"x"),(2,";"),(2,"x"),(2,";"),(2,"x") ]
 --main = putStrLn $ show $ pExpr [(2,"let"),(2,"z"),(2,"="),(2,"x"),(2,"in"),(2,"z")]
 --main = putStrLn $ pprint $ syntax [(1,"f"),(1,"="),(1,"3") ,(1,";"),(2,"g"),(2,"x"),(2,"y"),(2,"="), (2,"let"),(2,"z"),(2,"="),(2,"x"),(2,"in"),(2,"z"),(2,";"),(3,"h"),(3,"x"),(3,"="),(3,"case"),(3,"("),(3,"let"),(3,"y"),(3,"="),(3,"x"),(3,"in"),(3,"y"),(3,")"),(3,"of"),(4,"<"),(4,"1"),(4,">"),(4,"->"),(4,"2"),(4,";"),(5,"<"),(5,"2"),(5,">"),(5,"->"),(5,"5")]
+
```

```
> module Template where
> import Language
> import Utils
```

これどういう意味があるのかわからん


**チャプター1が終わった!!!**