import Data.Char import Data.Maybe import Test.QuickCheck import Text.Parse -- cabal install polyparse ------------------------------------------------------------------------- -- the expression datatype data Expr = Num Int | Add Expr Expr | Mul Expr Expr deriving ( Eq ) ------------------------------------------------------------------------- -- parsing numbers num :: TextParser Expr num = do n <- parseByRead "" return (Num n) ------------------------------------------------------------------------- -- expr and term {- * an expression is a '+'-chain of terms * a term is a '*'-chain of factors -} expr, term :: TextParser Expr expr = chain term '+' Add term = chain factor '*' Mul --{- --chain p op f s1 parsers a "chain" of things. --The things are parsed by the parser p. --The things are separated by the symbol op. --The things are combined by the function f. --For example, -- 12+23+1+172 --is a chain of numbers, separated by the symbol '+'. ---} chain :: TextParser a -> Char -> (a -> a -> a) -> TextParser a chain p op f = do a <- p more a <|> return a where more a = do satisfy (==op) b <- chain p op f return (f a b) ------------------------------------------------------------------------- -- factor factor :: TextParser Expr factor = parentheses expr <|> num parentheses :: TextParser a -> TextParser a parentheses p = do satisfy (=='(') a <- p satisfy (==')') return a ------------------------------------------------------------------------- -- reading expressions readExpr :: String -> Maybe Expr readExpr s = case readByParse expr s of [(a,"")] -> Just a _ -> Nothing ------------------------------------------------------------------------- -- testing the parser showExpr :: Expr -> String showExpr (Num n) = show n showExpr (Add a b) = showExpr a ++ "+" ++ showExpr b showExpr (Mul a b) = showFactor a ++ "*" ++ showFactor b showFactor :: Expr -> String showFactor (Add a b) = "(" ++ showExpr (Add a b) ++ ")" showFactor e = showExpr e instance Show Expr where show = showExpr ----------------------------------------------------------------------- instance Arbitrary Expr where arbitrary = sized arbExpr arbExpr :: Int -> Gen Expr arbExpr s = frequency [ (1, do n <- arbitrary return (Num n)) , (s, do a <- arbExpr s' b <- arbExpr s' return (Add a b)) , (s, do a <- arbExpr s' b <- arbExpr s' return (Mul a b)) ] where s' = s `div` 2 ----------------------------------------------------------------------- prop_ShowReadEval a = fmap eval (readExpr (show a)) == Just (eval a) eval :: Expr -> Int eval (Num n) = n eval (Add a b) = eval a + eval b eval (Mul a b) = eval a * eval b ----------------------------------------------------------------------- prop_ShowReadAssoc a = readExpr (show a) == Just (assoc a) assoc :: Expr -> Expr assoc (Add (Add a b) c) = assoc (Add a (Add b c)) assoc (Add a b) = Add (assoc a) (assoc b) assoc (Mul (Mul a b) c) = assoc (Mul a (Mul b c)) assoc (Mul a b) = Mul (assoc a) (assoc b) assoc a = a -----------------------------------------------------------------------