5 import Control.Applicative
10 import Text.Parsers.Simple.Core
11 import Text.Parsers.Simple.Chars
14 lit :: a -> e a | toString a
15 (+.) infixl 6 :: (e a) (e a) -> e a | + a
17 (/.) infixl 7 :: (e a) (e a) -> e a | /, ==, zero a
19 (==.) infix 4 :: (e a) (e a) -> e Bool | == a
22 runPrint :: (Print a) -> String
24 instance expr Print where
25 lit a = P (toString a)
26 (+.) (P a) (P b) = P (a +++ "+" +++ b)
27 instance div Print where
28 (/.) (P a) (P b) = P (a +++ "/" +++ b)
29 instance eq Print where
30 (==.) (P a) (P b) = P (a +++ "==" +++ b)
33 runEval :: (Eval a) -> a
35 instance expr Eval where
37 (+.) (E a) (E b) = E (a + b)
38 instance div Eval where
42 instance eq Eval where
43 (==.) (E a) (E b) = E (a == b)
45 :: EvalM a :== MaybeError String a
46 runEvalM :: (EvalM a) -> MaybeError String a
48 instance expr (MaybeError String) where
50 (+.) l r = (+) <$> l <*> r
51 instance div (MaybeError String) where
52 (/.) l r = (/) <$> l <*> (r >>= \v->if (v == zero) (Error "div0") (pure v))
53 instance eq (MaybeError String) where
54 (==.) l r = (==) <$> l <*> r
56 pToken c = pSatisfy ((==)c)
57 class parseExpr v a | expr, div v
59 parseExpr :: Parser Char (v a)
60 instance parseExpr v Int | expr, div v where
62 instance parseExpr v Real | expr, div v where
64 //instance parseExpr (v Real) where
67 parseE :: Parser Char (v a) | expr, div v & parsable, ==, +, /, zero, toString a
68 parseE = foldr ($) parseBasic
69 [ flip pChainl1 (pToken '+' $> (+.))
70 , flip pChainl1 (pToken '/' $> (/.))
73 parseBasic = lit <$> parsable
75 class parsable a :: Parser Char a
76 instance parsable Int where parsable = foldl (\a b->10*a+digitToInt b) 0 <$> some pDigit
77 instance parsable Real where parsable = foldl (\a b->10*a+digitToInt b) 0 <$> some pDigit
79 Start :: Either [Error] (Print Int)
80 Start = parse parseExpr ['42+42']
81 /*Start = (runPrint e, runEval e, runEvalM e, parse )
83 e :: v Bool | expr, div, eq v
84 e = lit 39 +. lit 3 /. lit 0 ==. lit 4