8 import Control.Applicative
10 import Control.Monad.State
12 import Text.Parsers.Simple.Core
14 :: In a b = (:.) infix 0 a b
19 | (-.) infixr 2 Gram Gram
20 | (|.) infixl 1 Gram Gram
23 Lits = foldr1 (|.) o map Lit
24 foldr1 f [x:xs] = foldr f x xs
32 parseFromGram :: Gram -> Parser String Gast
33 parseFromGram Int = INT o toInt <$> pSatisfy (\s->toString (toInt s) == s)
34 parseFromGram (Lit i) = LIT <$> pSatisfy ((==)i)
35 parseFromGram (?! g) = OPT <$> optional (parseFromGram g)
36 parseFromGram (*! g) = MANY <$> many (parseFromGram g)
37 parseFromGram (a -. b) = BIN <$> parseFromGram a <*> parseFromGram b
38 parseFromGram (a |. b) = parseFromGram a <|> parseFromGram b
40 //Start = runParser (parseFromGram gram) [".","."]
41 Start = printeval <$> parse (parseFromGram gram) ["4","*","2","*","1","*","(","3","^","3","^","3",")"]
44 let lit = Lit "(" -. expr -. Lit ")"
46 pow = lit -. ?! (Lit "^" -. pow)
47 fac = pow -. *! (Lits ["*","/"] -. pow)
48 expr = fac -. *! (Lits ["+","-","%"] -. fac)
51 printeval a = (eval a, print a)
53 eval :: Gast -> Maybe Int
54 eval (BIN (LIT "(") (BIN e (LIT ")"))) = eval e
56 eval (LIT _) = Nothing
57 eval (BIN l (OPT Nothing)) = eval l
58 eval (BIN l (OPT (Just a))) = eval (BIN l a)
59 //Right associative operators
60 eval (BIN l (BIN (LIT op) r)) = op2op op <*> eval l <*> eval r
61 //Left associative operators
62 eval (BIN l (MANY [])) = eval l
63 eval (BIN l (MANY [BIN (LIT op) r:rest]))
64 = eval (BIN (BIN l (BIN (LIT op) r)) (MANY rest))
65 eval e = abort ("eval: " +++ printToString e +++ "\n")
67 print :: Gast -> String
68 print (BIN (LIT "(") (BIN e (LIT ")"))) = "(" +++ print e +++ ")"
69 print (INT i) = toString i
71 print (BIN l (OPT Nothing)) = print l
72 print (BIN l (OPT (Just a))) = print (BIN l a)
73 //Right associative operators
74 print (BIN l (BIN (LIT op) r)) = "(" +++ print l +++ op +++ print r +++ ")"
75 //Left associative operators
76 print (BIN l (MANY [])) = print l
77 print (BIN l (MANY [BIN (LIT op) r:rest]))
78 = print (BIN (BIN l (BIN (LIT op) r)) (MANY rest))
79 print e = printToString e +++ "\n"
85 op2op "%" = Just (rem)
90 derive gPrint Gast, Maybe