---------------------------------------------------------------------- -- Parsing arithmetic expressions using monadic parser combinators -- ---------------------------------------------------------------------- module Monadic_AE_Parser where import Char import Monad -- a = Tokentyp, b= Ergebnistyp newtype Parser a b = P ([a] -> [(b,[a])]) instance Monad (Parser a ) where return = result (>>=) = bind fail _ = zero -- basic parsers result :: b -> Parser a b result x = P (\s -> [(x,s)]) zero :: Parser a b zero = P \$ \_ -> [] item :: Parser a a item = P \$ \l -> case l of [] -> [] (a:as) -> [(a,as)] bind :: Parser a b -> (b-> Parser a c) -> Parser a c bind (P p) f = P \$ \s -> concat [q inp | (v,inp) <- p s, let P q = f v ] instance MonadPlus (Parser a) where mzero = zero mplus = plus plus :: Parser a b -> Parser a b -> Parser a b plus (P p) (P q) = P \$ \s -> p s ++ q s infixr 4 ||| (|||) :: Parser a b -> Parser a b -> Parser a b (|||) = mplus checkChar :: Char -> Parser Char Char checkChar c = P \$ \ cs -> case cs of [] -> [] (a:as) -> if c == a then [(c,as)] else [] tok :: Eq a => [a] -> Parser a [a] tok s = P \$ \cs -> loop s cs where loop [] cs = [(s,cs)] loop (s:ss) (c:cs) | s==c = loop ss cs loop _ _ = [] ---------------------------------------------------------- -- Translation of Grammar Rules into Parser Functions -- ---------------------------------------------------------- {- -- E -> TH expr :: Parser Char [Int] expr = term >>= \lt -> hexpr >>= \le -> return (1:lt++le) -- H -> +TH | eps hexpr = (checkChar '+' >>= \c -> term >>= \lt -> hexpr >>= \le -> result (2:lt++le)) ||| result [3] -- T -> FG term = factor >>= \lf -> hterm >>= \lt -> result (4:lf++lt) -- G -> *FG | eps hterm = (checkChar '*' >>= \c -> factor >>= \lf -> hterm >>= \lt -> result (5:lf++lt)) ||| result [6] -- F -> (E) | a factor = (checkChar '(' >>= \c -> expr >>= \le -> checkChar ')' >>= \c -> result (7:le)) ||| (checkChar 'a' >>= \ c -> result [8]) -} parseRD :: String -> [Int] parseRD s = let (P parse_expr) = expr in case parse_expr s of ((l,""):xs) -> l _ -> error "syntax error in expression" ---------------------------------------------------------- -- Parser Functions Using do notation -- ---------------------------------------------------------- -- E -> TH expr :: Parser Char [Int] expr = do lt <- term le <- hexpr return (1:lt++le) -- H -> +TH | eps hexpr = (do c <- checkChar '+' lt <- term le <- hexpr return (2:lt++le)) ||| return [3] -- T -> FG term = do lf <- factor lt <- hterm return (4:lf++lt) -- G -> *FG | eps hterm = (do c <- checkChar '*' lf <- factor lt <- hterm return (5:lf++lt)) ||| return [6] -- F -> (E) | a factor = (do c <- checkChar '(' le <- expr c <- checkChar ')' return (7:le)) ||| (do c <- checkChar 'a' return [8]) ---------------------------------------------------------- -- Parser Functions producing abstract syntax tree ---------------------------------------------------------- data Expr = Plus Expr Expr | Mult Expr Expr | Factor | Empty deriving Show empty :: Expr -> Bool empty Empty = True empty _ = False -- E -> TH expr3 :: Parser Char Expr expr3 = do lt <- term3 le <- hexpr3 return (if empty le then lt else Plus lt le) -- H -> +TH | eps hexpr3 = (do c <- checkChar '+' lt <- term3 le <- hexpr3 return (if empty le then lt else Plus lt le)) ||| return Empty -- T -> FG term3 = do lf <- factor3 lt <- hterm3 return (if empty lt then lf else Mult lf lt) -- G -> *FG | eps hterm3 = (do c <- checkChar '*' lf <- factor3 lt <- hterm3 return (if empty lt then lf else Mult lf lt)) ||| return Empty -- F -> (E) | a factor3 = (do c <- checkChar '(' le <- expr3 c <- checkChar ')' return le) ||| (do c <- checkChar 'a' return Factor) parseRD3 :: String -> Expr parseRD3 s = let (P parse_expr) = expr3 in case parse_expr s of ((l,""):xs) -> l _ -> error "syntax error in expression"