X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=afp%2Fa7%2Fa7.icl;h=b3d3c88643dc7b061dddd448d8cf3d4abc47bad3;hb=95e99be6bdd04513688b88f1afaefac360eeff1d;hp=e3442ab26979ca8db7300a38de3a0137c955cc0b;hpb=fb9157079d01fefff13b09fafdc190b5c6e4aa42;p=clean-tests.git

diff --git a/afp/a7/a7.icl b/afp/a7/a7.icl
index e3442ab..b3d3c88 100644
--- 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