old/parserParser/test.icl

   1 module test
   2
   3 import StdEnv
   4
   5 import Data.Maybe
   6 import Data.Either
   7 import Data.Functor
   8 import Control.Applicative
   9 import Control.Monad
  10 import Control.Monad.State
  11
  12 import Text.Parsers.Simple.Core
  13
  14 :: In a b = (:.) infix 0 a b
  15
  16 :: Gram
  17         = Lit String
  18         | Int
  19         | (-.) infixr 2 Gram Gram
  20         | (|.) infixl 1 Gram Gram
  21         | *! Gram
  22         | ?! Gram
  23 Lits = foldr1 (|.) o map Lit
  24 foldr1 f [x:xs] = foldr f x xs
  25 :: Gast
  26         = INT Int
  27         | LIT String
  28         | BIN Gast Gast
  29         | OPT (Maybe Gast)
  30         | MANY [Gast]
  31
  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
  39
  40 //Start = runParser (parseFromGram gram) [".","."]
  41 Start = printeval <$> parse (parseFromGram gram) ["4","*","2","*","1","*","(","3","^","3","^","3",")"]
  42 where
  43         gram =
  44                 let lit  =  Lit "(" -. expr -. Lit ")"
  45                          |. Int
  46                     pow  =  lit -. ?! (Lit "^" -. pow)
  47                     fac  =  pow -. *! (Lits ["*","/"] -. pow)
  48                     expr =  fac -. *! (Lits ["+","-","%"] -. fac)
  49                 in  expr
  50
  51         printeval a = (eval a, print a)
  52
  53         eval :: Gast -> Maybe Int
  54         eval (BIN (LIT "(") (BIN e (LIT ")"))) = eval e
  55         eval (INT i) = Just i
  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")
  66
  67         print :: Gast -> String
  68         print (BIN (LIT "(") (BIN e (LIT ")"))) = "(" +++ print e +++ ")"
  69         print (INT i) = toString i
  70         print (LIT l) = l
  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"
  80
  81         op2op "+" = Just (+)
  82         op2op "-" = Just (-)
  83         op2op "*" = Just (*)
  84         op2op "/" = Just (/)
  85         op2op "%" = Just (rem)
  86         op2op "^" = Just (^)
  87         op2op _ = Nothing
  88
  89 import Text.GenPrint
  90 derive gPrint Gast, Maybe