X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=parserParser%2Ftest.icl;h=fb2eafa16d00f92f8721353db5af8608e9f8907d;hb=557bc82b39e6a96de08324a3c040e35dd0224f02;hp=5eb04d63cad902b621e7b385429e6f6aedf2b9f2;hpb=85be4012fc8ee04ef900d0586f84a00af8aa7862;p=clean-tests.git

diff --git a/parserParser/test.icl b/parserParser/test.icl
index 5eb04d6..fb2eafa 100644
--- a/parserParser/test.icl
+++ b/parserParser/test.icl
@@ -2,6 +2,8 @@ module test
 
 import StdEnv
 
+import Data.Maybe
+import Data.Either
 import Data.Functor
 import Control.Applicative
 import Control.Monad
@@ -12,34 +14,77 @@ import Text.Parsers.Simple.Core
 :: In a b = (:.) infix 0 a b
 
 :: Gram
-	= Def (Gram -> In Gram Gram)
-	| Def2 ((Gram,Gram) -> In (Gram, Gram) Gram)
-	| Lit String
+	= Lit String
 	| Int
 	| (-.) infixr 2 Gram Gram
-	| (|.) infix 1 Gram Gram
+	| (|.) infixl 1 Gram Gram
+	| *! Gram
+	| ?! Gram
+Lits = foldr1 (|.) o map Lit
+foldr1 f [x:xs] = foldr f x xs
 :: Gast
 	= INT Int
 	| LIT String
 	| BIN Gast Gast
+	| OPT (Maybe Gast)
+	| MANY [Gast]
 
 parseFromGram :: Gram -> Parser String Gast
-parseFromGram (Def g)  = let (body :. gram) = g body in parseFromGram gram
 parseFromGram  Int     = INT o toInt <$> pSatisfy (\s->toString (toInt s) == s)
 parseFromGram (Lit i)  = LIT <$> pSatisfy ((==)i)
+parseFromGram (?! g)   = OPT <$> optional (parseFromGram g)
+parseFromGram (*! g)   = MANY <$> many (parseFromGram g)
 parseFromGram (a -. b) = BIN <$> parseFromGram a <*> parseFromGram b
 parseFromGram (a |. b) = parseFromGram a <|> parseFromGram b
 
 //Start = runParser (parseFromGram gram) [".","."]
-Start = parse (parseFromGram gram) ["5"]
+Start = printeval <$> parse (parseFromGram gram) ["4","*","2","*","1","*","(","3","^","3","^","3",")"]
 where
 	gram =
-		Def \lit =  Int
-		         |. Lit "(" -. expr -. Lit ")"
-		Def \fac =  lit -. Lit "*" -. fac
-		         |. lit -. Lit "/" -. fac
-		         |. lit :.
-		Def \expr=  fac -. Lit "+" -. expr
-		         |. fac -. Lit "-" -. expr
-		         |. fac :.
-		expr
+		let lit  =  Lit "(" -. expr -. Lit ")"
+		         |. Int
+		    pow  =  lit -. ?! (Lit "^" -. pow)
+		    fac  =  pow -. *! (Lits ["*","/"] -. pow)
+		    expr =  fac -. *! (Lits ["+","-","%"] -. fac)
+		in  expr
+
+	printeval a = (eval a, print a)
+	
+	eval :: Gast -> Maybe Int
+	eval (BIN (LIT "(") (BIN e (LIT ")"))) = eval e
+	eval (INT i) = Just i
+	eval (LIT _) = Nothing
+	eval (BIN l (OPT Nothing)) = eval l
+	eval (BIN l (OPT (Just a))) = eval (BIN l a)
+	//Right associative operators
+	eval (BIN l (BIN (LIT op) r)) = op2op op <*> eval l <*> eval r
+	//Left associative operators
+	eval (BIN l (MANY [])) = eval l
+	eval (BIN l (MANY [BIN (LIT op) r:rest]))
+		= eval (BIN (BIN l (BIN (LIT op) r)) (MANY rest))
+	eval e = abort ("eval: " +++ printToString e +++ "\n")
+
+	print :: Gast -> String
+	print (BIN (LIT "(") (BIN e (LIT ")"))) = "(" +++ print e +++ ")"
+	print (INT i) = toString i
+	print (LIT l) = l
+	print (BIN l (OPT Nothing)) = print l
+	print (BIN l (OPT (Just a))) = print (BIN l a)
+	//Right associative operators
+	print (BIN l (BIN (LIT op) r)) = "(" +++ print l +++ op +++ print r +++ ")"
+	//Left associative operators
+	print (BIN l (MANY [])) = print l
+	print (BIN l (MANY [BIN (LIT op) r:rest]))
+		= print (BIN (BIN l (BIN (LIT op) r)) (MANY rest))
+	print e = printToString e +++ "\n"
+
+	op2op "+" = Just (+)
+	op2op "-" = Just (-)
+	op2op "*" = Just (*)
+	op2op "/" = Just (/)
+	op2op "%" = Just (rem)
+	op2op "^" = Just (^)
+	op2op _ = Nothing
+
+import Text.GenPrint
+derive gPrint Gast, Maybe