Skip to content

Instantly share code, notes, and snippets.

/RPN.hs
Created Dec 23, 2015

Embed
What would you like to do?
RPN calculator in Haskell, using the Free Monad.
{-# LANGUAGE DeriveFunctor #-}
import Control.Monad.Free (Free (..), liftF)
data RPNOperator k = Push Int k
| Add k
| Sub k
| Mul k
| Dup k
| End
deriving (Show, Functor)
type RPN = Free RPNOperator
push :: Int -> RPN ()
push x = liftF $ Push x ()
add :: RPN ()
add = liftF $ Add ()
sub :: RPN ()
sub = liftF $ Sub ()
mul :: RPN ()
mul = liftF $ Mul ()
dup :: RPN ()
dup = liftF $ Dup ()
end :: RPN ()
end = liftF End
incr :: RPN ()
incr = do
push 1
add
data RPNError = StackUnderflow
| MissingEnd
| NonEmptyStackOnEnd
deriving (Show)
runRPN :: RPN k -> Either RPNError Int
runRPN prog = rpn [] prog
where
rpn stack (Free (Push x k)) = rpn (x:stack) k
rpn (x:y:stack) (Free (Add k)) = rpn (x+y:stack) k
rpn (x:y:stack) (Free (Sub k)) = rpn (x-y:stack) k
rpn (x:y:stack) (Free (Mul k)) = rpn (x*y:stack) k
rpn (x:stack) (Free (Dup k)) = rpn (x:x:stack) k
rpn _ (Free (Add {})) = Left StackUnderflow
rpn _ (Free (Sub {})) = Left StackUnderflow
rpn _ (Free (Mul {})) = Left StackUnderflow
rpn _ (Free (Dup {})) = Left StackUnderflow
rpn [] (Free End) = Left StackUnderflow
rpn [x] (Free End) = Right x
rpn _ (Free End) = Left NonEmptyStackOnEnd
rpn _ (Pure {}) = Left MissingEnd
-- example
exp = do
push 1
push 2
add
end
runRPN exp -- returns Right 3
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.