public
Created

Expression parser

  • Download Gist
gistfile1.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
import Data.Maybe
import Text.Printf
import Data.Char
import Control.Monad
 
data Expr = Term Int | Op Operator Expr Expr | Var String
deriving (Show, Eq)
 
data Operator = Sum | Mult | Sub | Div
deriving (Show, Eq)
sampleStr = "2 + a * 4 - b"
 
newtype Parser a = Parser {runParser :: String -> Maybe (a, String)}
 
predP :: (Char -> Bool) -> Parser Char
predP pred = Parser p
where
p (x : xs) | pred x = Just (x, xs)
p _ = Nothing
 
anyCharP :: Parser Char
anyCharP = predP (const True)
 
charP :: Char -> Parser Char
charP c = predP (==c)
 
combP :: (a -> b -> c) -> Parser a -> Parser b -> Parser c
combP f pa pb = do
a <- pa
b <- pb
return $ f a b
 
instance Monad Parser where
return x = Parser $ \s -> Just (x, s)
(Parser a) >>= f = Parser $ \s -> do
(x, s') <- a s
runParser (f x) s'
-- or:
-- (Parser a) >>= f = Parser $ maybe Nothing (\(x, s') -> runParser (f x) s') . a
 
instance MonadPlus Parser where
mzero = Parser $ \s -> Nothing
(Parser a) `mplus` (Parser b) = Parser $ \s -> a s `mplus` b s
 
digitP :: Parser Char
digitP = predP isDigit
 
symbolCharP :: Parser Char
symbolCharP = predP isAlphaNum
 
operatorP :: Parser Operator
operatorP = msum
[ charP '*' >> return Mult
, charP '/' >> return Div
, charP '+' >> return Sum
, charP '-' >> return Sub
]
 
some :: Parser a -> Parser [a]
some pa = do
a <- pa
as <- some pa `mplus` return []
return $ a : as
termP :: Parser Expr
termP = some digitP >>= return . Term . read
 
varP :: Parser Expr
varP = some symbolCharP >>= return . Var
 
opP :: Parser Expr
opP = do
charP '('
a <- exprP
o <- operatorP
b <- exprP
charP ')'
return $ Op o a b
 
exprP :: Parser Expr
exprP = msum [termP, varP, opP]
 
parseExpr :: String -> Maybe Expr
parseExpr s = maybe Nothing (Just . fst) (runParser exprP (filter (/=' ') s))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.