-module expr
-
-import StdEnv
-
-import Control.Applicative
-import Control.Monad
-import Data.Error
-import Data.Func
-import Data.Functor
-import Text.Parsers.Simple.Core
-import Text.Parsers.Simple.Chars
-
-class expr e where
- lit :: a -> e a | toString a
- (+.) infixl 6 :: (e a) (e a) -> e a | + a
-class div e where
- (/.) infixl 7 :: (e a) (e a) -> e a | /, ==, zero a
-class eq e where
- (==.) infix 4 :: (e a) (e a) -> e Bool | == a
-
-:: Print a = P String
-runPrint :: (Print a) -> String
-runPrint (P a) = a
-instance expr Print where
- lit a = P (toString a)
- (+.) (P a) (P b) = P (a +++ "+" +++ b)
-instance div Print where
- (/.) (P a) (P b) = P (a +++ "/" +++ b)
-instance eq Print where
- (==.) (P a) (P b) = P (a +++ "==" +++ b)
-
-:: Eval a = E a
-runEval :: (Eval a) -> a
-runEval (E a) = a
-instance expr Eval where
- lit a = E a
- (+.) (E a) (E b) = E (a + b)
-instance div Eval where
- (/.) (E a) (E b)
- | b == zero = E zero
- = E (a / b)
-instance eq Eval where
- (==.) (E a) (E b) = E (a == b)
-
-:: EvalM a :== MaybeError String a
-runEvalM :: (EvalM a) -> MaybeError String a
-runEvalM a = a
-instance expr (MaybeError String) where
- lit a = pure a
- (+.) l r = (+) <$> l <*> r
-instance div (MaybeError String) where
- (/.) l r = (/) <$> l <*> (r >>= \v->if (v == zero) (Error "div0") (pure v))
-instance eq (MaybeError String) where
- (==.) l r = (==) <$> l <*> r
-
-pToken c = pSatisfy ((==)c)
-class parseExpr a :: Parser Char a
-instance parseExpr a:: parseExpr
-parseExpr :: Parser Char (v a) | expr, div v & parsable, ==, +, /, zero, toString a
-parseExpr = foldr ($) parseBasic
- [ flip pChainl1 (pToken '+' $> (+.))
- , flip pChainl1 (pToken '/' $> (/.))
- ]
-where
- parseBasic = lit <$> parsable
-
-class parsable a :: Parser Char a
-instance parsable Int where parsable = foldl (\a b->10*a+digitToInt b) 0 <$> some pDigit
-
-Start :: Either [Error] (Print Int)
-Start = parse parseExpr ['42+42']
-/*Start = (runPrint e, runEval e, runEvalM e, parse )
-where
- e :: v Bool | expr, div, eq v
- e = lit 39 +. lit 3 /. lit 0 ==. lit 4
-*/