old/parserParser/testclass.icl

   1 module testclass
   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.Chars
  13 import Text.Parsers.Simple.Core
  14
  15 class parsable a ~b :: a -> Parser Char b
  16
  17 instance parsable IntParse Int where
  18         parsable IntParse = foldl (\a d->a*10 + digitToInt d) 0 <$> some pDigit
  19
  20 instance parsable (AltParse a) b | parsable a b where
  21         parsable (l |. r) = parsable l <|> parsable r
  22
  23 :: IntParse = IntParse
  24 :: AltParse a = (|.) infixl 1 a a
  25
  26 Start = 42
  27
  28
  29 //:: In a b = (:.) infix 0 a b
  30 //
  31 //:: Gram
  32 //      = Lit String
  33 //      | Int
  34 //      | (-.) infixr 2 Gram Gram
  35 //      | (|.) infixl 1 Gram Gram
  36 //      | *! Gram
  37 //      | ?! Gram
  38 //Lits = foldr1 (|.) o map Lit
  39 //foldr1 f [x:xs] = foldr f x xs
  40 //:: Gast
  41 //      = INT Int
  42 //      | LIT String
  43 //      | BIN Gast Gast
  44 //      | OPT (Maybe Gast)
  45 //      | MANY [Gast]
  46 //
  47 //parseFromGram :: Gram -> Parser String Gast
  48 //parseFromGram  Int     = INT o toInt <$> pSatisfy (\s->toString (toInt s) == s)
  49 //parseFromGram (Lit i)  = LIT <$> pSatisfy ((==)i)
  50 //parseFromGram (?! g)   = OPT <$> optional (parseFromGram g)
  51 //parseFromGram (*! g)   = MANY <$> many (parseFromGram g)
  52 //parseFromGram (a -. b) = BIN <$> parseFromGram a <*> parseFromGram b
  53 //parseFromGram (a |. b) = parseFromGram a <|> parseFromGram b
  54 //
  55 ////Start = runParser (parseFromGram gram) [".","."]
  56 //Start = printeval <$> parse (parseFromGram gram) ["4","*","2","*","1","*","(","3","^","3","^","3",")"]
  57 //where
  58 //      gram =
  59 //              let lit  =  Lit "(" -. expr -. Lit ")"
  60 //                       |. Int
  61 //                  pow  =  lit -. ?! (Lit "^" -. pow)
  62 //                  fac  =  pow -. *! (Lits ["*","/"] -. pow)
  63 //                  expr =  fac -. *! (Lits ["+","-","%"] -. fac)
  64 //              in  expr
  65 //
  66 //      printeval a = (eval a, print a)
  67 //
  68 //      eval :: Gast -> Maybe Int
  69 //      eval (BIN (LIT "(") (BIN e (LIT ")"))) = eval e
  70 //      eval (INT i) = Just i
  71 //      eval (LIT _) = Nothing
  72 //      eval (BIN l (OPT Nothing)) = eval l
  73 //      eval (BIN l (OPT (Just a))) = eval (BIN l a)
  74 //      //Right associative operators
  75 //      eval (BIN l (BIN (LIT op) r)) = op2op op <*> eval l <*> eval r
  76 //      //Left associative operators
  77 //      eval (BIN l (MANY [])) = eval l
  78 //      eval (BIN l (MANY [BIN (LIT op) r:rest]))
  79 //              = eval (BIN (BIN l (BIN (LIT op) r)) (MANY rest))
  80 //      eval e = abort ("eval: " +++ printToString e +++ "\n")
  81 //
  82 //      print :: Gast -> String
  83 //      print (BIN (LIT "(") (BIN e (LIT ")"))) = "(" +++ print e +++ ")"
  84 //      print (INT i) = toString i
  85 //      print (LIT l) = l
  86 //      print (BIN l (OPT Nothing)) = print l
  87 //      print (BIN l (OPT (Just a))) = print (BIN l a)
  88 //      //Right associative operators
  89 //      print (BIN l (BIN (LIT op) r)) = "(" +++ print l +++ op +++ print r +++ ")"
  90 //      //Left associative operators
  91 //      print (BIN l (MANY [])) = print l
  92 //      print (BIN l (MANY [BIN (LIT op) r:rest]))
  93 //              = print (BIN (BIN l (BIN (LIT op) r)) (MANY rest))
  94 //      print e = printToString e +++ "\n"
  95 //
  96 //      op2op "+" = Just (+)
  97 //      op2op "-" = Just (-)
  98 //      op2op "*" = Just (*)
  99 //      op2op "/" = Just (/)
 100 //      op2op "%" = Just (rem)
 101 //      op2op "^" = Just (^)
 102 //      op2op _ = Nothing
 103 //
 104 //import Text.GenPrint
 105 //derive gPrint Gast, Maybe