import StdEnv
+import Data.Maybe
+import Data.Either
import Data.Functor
import Control.Applicative
import Control.Monad
:: 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