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 //      = Def (Gram -> In Gram Gram)
  18 //      | Def2 ((Gram,Gram) -> In (Gram, Gram) Gram)
  19         = Lit String
  20         | Int
  21         | (-.) infixr 2 Gram Gram
  22         | (|.) infixl 1 Gram Gram
  23         | *! Gram
  24 :: Gast
  25         = INT Int
  26         | LIT String
  27         | BIN Gast Gast
  28         | MANY [Gast]
  29
  30 parseFromGram :: Gram -> Parser String Gast
  31 parseFromGram  Int     = INT o toInt <$> pSatisfy (\s->toString (toInt s) == s)
  32 parseFromGram (Lit i)  = LIT <$> pSatisfy ((==)i)
  33 parseFromGram (*! g)   = MANY <$> many (parseFromGram g)
  34 parseFromGram (a -. b) = BIN <$> parseFromGram a <*> parseFromGram b
  35 parseFromGram (a |. b) = parseFromGram a <|> parseFromGram b
  36
  37 //Start = runParser (parseFromGram gram) [".","."]
  38 Start = printeval <$> parse (parseFromGram gram) ["4","-","2","-","1"]
  39 where
  40         gram =
  41                 let lit  =  Lit "(" -. expr -. Lit ")"
  42                          |. Int
  43                     pow  =  lit -. Lit "^" -. pow
  44                          |. lit
  45                     fac  =  pow -. *! (Lit "*" -. pow)
  46                          |. pow
  47                     expr =  fac -. *! (Lit "-" -. fac)
  48                          |. 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         //Right associative operators
  58         eval (BIN l (BIN (LIT op) r)) = op2op op <*> eval l <*> eval r
  59         //Left associative operators
  60         eval (BIN l (MANY [])) = eval l
  61         eval (BIN l (MANY [BIN (LIT op) r:rest]))
  62                 = eval (BIN (BIN l (BIN (LIT op) r)) (MANY rest))
  63         eval e = abort ("eval: " +++ printToString e +++ "\n")
  64
  65         print :: Gast -> String
  66         print (BIN (LIT "(") (BIN e (LIT ")"))) = "(" +++ print e +++ ")"
  67         print (INT i) = toString i
  68         print (LIT l) = l
  69         //Right associative operators
  70         print (BIN l (BIN (LIT op) r)) = "(" +++ print l +++ op +++ print r +++ ")"
  71         //Left associative operators
  72         print (BIN l (MANY [])) = print l
  73         print (BIN l (MANY [BIN (LIT op) r:rest]))
  74                 = print (BIN (BIN l (BIN (LIT op) r)) (MANY rest))
  75         print e = printToString e +++ "\n"
  76
  77         op2op "+" = Just (+)
  78         op2op "-" = Just (-)
  79         op2op "*" = Just (*)
  80         op2op "^" = Just (^)
  81         op2op _ = Nothing
  82
  83 import Text.GenPrint
  84 derive gPrint Gast, Maybe