old/exprparse/test.icl

   1 module test
   2
   3 import StdEnv
   4 import Data.Maybe
   5 import Data.Functor
   6 import Data.Tuple
   7 import Data.List
   8 import Control.Applicative
   9 import Control.Monad
  10
  11 import Text.Parsers.Simple.ParserCombinators
  12
  13 operators :: [[Char]]
  14 operators =
  15         [ ['+-']
  16         , ['*/']
  17         , ['^']
  18         ]
  19
  20 preprocess :: [[Char]] [Char] -> [Char]
  21 preprocess ops c = rep '(' maxb (foldr prep (rep ')' maxb []) c)
  22 where
  23         maxb = length ops + 1
  24
  25         rep :: Char Int [Char] -> [Char]
  26         rep c 0 r = r
  27         rep c i r = [c:rep c (i-1) r]
  28
  29         prep '(' cs = rep '(' maxb cs
  30         prep ')' cs = rep ')' maxb cs
  31         prep c cs = maybe [c:cs] (\(_, s)->rep ')' s [c:rep '(' s cs])
  32                 (find (isMember c o fst) (zip2 ops [maxb-1,maxb-2..0]))
  33
  34 :: Expr = BinOp Expr Char Expr | Lit Int | Var [Char]
  35
  36 parseExpr :: Parser Char Expr
  37 parseExpr = flip pChainl1 (flip BinOp <$> pOneOf ['+^-/*'])
  38         (   Lit o toInt o toString <$> some pDigit
  39         <|> Var <$> some pAlpha
  40         <|> pToken '(' *> parseExpr <* pToken ')'
  41         )
  42
  43 //Start = parse parseExpr (preprocess ['a'])
  44 //Start = preprocess operators ['a*1']
  45 Start = runParser parseExpr (preprocess operators ['5+5*5'])