Skip to content

@petermarks /expressions.hs
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Simple arithmetic expression language
module Expressions where
import Data.Maybe
import Text.Printf
import Control.Applicative
data Expr = Term Int | Op Operator Expr Expr | Var String
deriving (Show, Eq)
data Operator = Sum | Mult | Sub | Div
deriving (Show, Eq)
data Result a = Failure [String] | Success a
deriving (Show, Eq)
newtype Parser a = Parser {runParser :: String -> Maybe (a, String)}
anyCharP :: Parser Char
anyCharP = Parser p
where
p [] = Nothing
p (x : xs) = Just (x, xs)
charP :: Char -> Parser Char
charP c = Parser $ \inp -> case inp of
(x:xs) | x == c -> Just (c, xs)
_ -> Nothing
combP :: (a -> b -> c) -> Parser a -> Parser b -> Parser c
combP f pa pb = f <$> pa <*> pb
instance Functor Parser where
fmap f (Parser pa) = Parser $ \s -> case pa s of
Nothing -> Nothing
Just (a, s') -> Just (f a, s')
instance Applicative Parser where
pure x = Parser $ \s -> Just (x, s)
(Parser pf) <*> (Parser pa) = Parser $ \s -> case pf s of
Nothing -> Nothing
Just (f, s') -> case pa s' of
Nothing -> Nothing
Just (a, s'') -> Just (f a, s'')
foldExpr :: (Int -> a) -> (Operator -> a -> a -> a) -> (String -> a) -> Expr -> a
foldExpr ft _ _ (Term i) = ft i
foldExpr ft fo fv (Op o u v) = fo o (foldExpr ft fo fv u) (foldExpr ft fo fv v)
foldExpr ft fo fv (Var id) = fv id
eval :: [(String, Int)] -> Expr -> Result Int
eval env = foldExpr Success applyOp getV
where
getV x = maybe (Failure [x]) Success $ lookup x env
applyOp :: Operator -> Result Int -> Result Int -> Result Int
applyOp o x y = getOp o <$> x <*> y
getOp :: Operator -> Int -> Int -> Int
getOp o = case o of
Sum -> (+)
Mult -> (*)
Sub -> (-)
Div -> div
printExpr :: Expr -> String
printExpr = foldExpr show (flip (printf "(%s %s %s)") . printOp) id
printOp o = case o of
Sum -> "+"
Mult -> "*"
Sub -> "-"
Div -> "/"
countTerms :: Expr -> Int
countTerms = foldExpr (const 1) (const (+)) (const 1)
sample = Op Mult (Op Sum (Var "x") (Var "y")) (Term 4)
instance Functor Result where
fmap f (Success a) = Success (f a)
fmap _ (Failure es) = Failure es
instance Applicative Result where
pure v = Success v
(Success f) <*> (Success x) = Success (f x)
(Failure xs) <*> (Failure ys) = Failure $ xs ++ ys
(Failure xs) <*> _ = Failure xs
_ <*> (Failure ys) = Failure ys
@willtim

I had to change these lines:
26: printExpr = foldExpr show (\o u v -> printf "(%s %s %s)" u (printOp o) v)
35: countTerms = foldExpr (const 1) (_ -> (+))

@petermarks
Owner

Oops, that was slack. It seems we didn't actually compile that version in our haste at the end of the session. I've corrected it here now.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.