old/parseclass/expr.icl

   1 module expr
   2
   3 import StdEnv
   4
   5 import Control.Applicative
   6 import Control.Monad
   7 import Data.Error
   8 import Data.Func
   9 import Data.Functor
  10 import Text.Parsers.Simple.Core
  11 import Text.Parsers.Simple.Chars
  12
  13 class expr e where
  14         lit :: a -> e a | toString a
  15         (+.) infixl 6 :: (e a) (e a) -> e a | + a
  16 class div e where
  17         (/.) infixl 7 :: (e a) (e a) -> e a | /, ==, zero a
  18 class eq e where
  19         (==.) infix 4 :: (e a) (e a) -> e Bool | == a
  20
  21 :: Print a = P String
  22 runPrint :: (Print a) -> String
  23 runPrint (P a) = a
  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)
  31
  32 :: Eval a = E a
  33 runEval :: (Eval a) -> a
  34 runEval (E a) = a
  35 instance expr Eval where
  36         lit a = E a
  37         (+.) (E a) (E b) = E (a + b)
  38 instance div Eval where
  39         (/.) (E a) (E b)
  40                 | b == zero = E zero
  41                 = E (a / b)
  42 instance eq Eval where
  43         (==.) (E a) (E b) = E (a == b)
  44
  45 :: EvalM a :== MaybeError String a
  46 runEvalM :: (EvalM a) -> MaybeError String a
  47 runEvalM a = a
  48 instance expr (MaybeError String) where
  49         lit a = pure a
  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
  55
  56 pToken c = pSatisfy ((==)c)
  57 class parseExpr v a | expr, div v
  58 where
  59         parseExpr :: Parser Char (v a)
  60 instance parseExpr v Int | expr, div v where
  61         parseExpr = parseE
  62 instance parseExpr v Real | expr, div v where
  63         parseExpr = parseE
  64 //instance parseExpr (v Real) where
  65 //      parseExpr
  66
  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 '/' $> (/.))
  71         ]
  72 where
  73         parseBasic = lit <$> parsable
  74
  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
  78
  79 Start :: Either [Error] (Print Int)
  80 Start = parse parseExpr ['42+42']
  81 /*Start = (runPrint e, runEval e, runEvalM e, parse  )
  82 where
  83         e :: v Bool | expr, div, eq v
  84         e = lit 39 +. lit 3 /. lit 0 ==. lit 4
  85 */