a10

[clean-tests.git] / afp / a7 / a7.icl

diff --git a/afp/a7/a7.icl b/afp/a7/a7.icl
index e3442ab..b3d3c88 100644 (file)
--- a/afp/a7/a7.icl
+++ b/afp/a7/a7.icl
@@ -64,18 +64,18 @@ getGram n = Parse \s->('Map'.get n s.store, s)
 
 parse :: Gram -> Parse TREE
 parse (Lit s) = LIT <$> ((==)s) ? next
-parse Idn = IDN <$> next
+parse Idn = IDN <$> (\s->isAlpha s.[0]) ? next
 parse Int = INT o toInt <$> (\s->toString (toInt s) == s) ? next
 parse (Seq gs) = SEQ <$> sequence (map parse gs)
 parse (Alt as) = foldr (<|>) empty (map parse as)
 parse (Def n g1 g2) = setGram n g1 *> parse g2
-parse (Var n) = join (parse <$> getGram n)
+parse (Var n) = getGram n >>= parse
 parse _ = empty
 
 run :: Gram [String] -> Maybe TREE
 run g t = fst (runParse (parse g) {store='Map'.newMap,input=t})
 
-Start = (run listIntGram listIntInput, run arithGram arithInput)
+Start = (evalList <$> run listIntGram listIntInput, evalArith <$> run arithGram arithInput)
 where
        listIntInput = ["mylist","=","[","7",":","[","42",":","[]","]","]"]
        arithInput = ["12","*","2","+","4","*","3","*","2","-","6"]
@@ -90,3 +90,19 @@ arithGram
        = Def "fac" (Alt [Seq [Int, Lit "*", Var "fac"], Int])
        $ Def "exp" (Alt [Seq [Var "fac", Lit "+", Var "exp"], Var "fac"])
        $ Var "exp"
+
+evalList :: TREE -> Maybe [Int]
+evalList (LIT "[]") = Just []
+evalList (SEQ [LIT "[", INT i, LIT ":", r, LIT "]"]) = evalList r >>= \r->pure [i:r]
+evalList (SEQ [IDN _, LIT "=", l]) = evalList l
+evalList _ = Nothing
+
+evalArith :: TREE -> Maybe Int
+evalArith (INT i) = Just i
+evalArith (SEQ [a, LIT op, b]) = toOp op <*> evalArith a <*> evalArith b
+where
+       toOp :: String -> Maybe (Int Int -> Int)
+       toOp "+" = Just (+)
+       toOp "*" = Just (*)
+       toOp _ = Nothing
+evalArith _ = Nothing