Last active
August 29, 2015 14:22
-
-
Save edne/aef278f82ce85a6bd1dd to your computer and use it in GitHub Desktop.
Principles of Programming Languages homework
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
import Control.Monad.State -- to use get and put | |
main :: IO () | |
main = do | |
print $ test $ DoubleStack [1,2,3] [4,5,6] | |
print $ test $ DoubleStack [] [4,5,6] | |
where | |
-- the test function | |
test :: DoubleStack Integer -> Maybe Integer | |
test = evalState $ do | |
push 7 | |
move | |
move | |
pop | |
pop | |
-- 2 list or an invalid stack | |
data DoubleStack a = DoubleStack [a] [a] | InvalidStack | |
-- pop a value from the second stack | |
pop :: State (DoubleStack a) (Maybe a) | |
pop = do | |
stack <- get | |
let (new_stack, out) = pop' stack | |
put new_stack | |
return out | |
where | |
-- returns the (new-stack, popped-value) tuple | |
pop' :: DoubleStack a -> (DoubleStack a, Maybe a) | |
pop' (DoubleStack xs (y:ys)) = (DoubleStack xs ys, Just y) | |
pop' (DoubleStack _ []) = (InvalidStack, Nothing) | |
pop' InvalidStack = (InvalidStack, Nothing) | |
-- push a value on the first stack | |
push :: a -> State (DoubleStack a) () | |
push value = do | |
stack <- get | |
put (push' value stack) | |
return () | |
where | |
-- returns the updated stack, or Invalid | |
push' :: a -> DoubleStack a -> DoubleStack a | |
push' x (DoubleStack xs ys) = DoubleStack (x:xs) ys | |
push' x InvalidStack = InvalidStack | |
-- move a value from the first stack to the second one | |
move :: State (DoubleStack a) () | |
move = do | |
stack <- get | |
put $ move' stack | |
return () | |
where | |
-- returns the updated stack, or Invalid | |
move' :: DoubleStack a -> DoubleStack a | |
move' (DoubleStack (x:xs) ys) = DoubleStack xs (x:ys) | |
move' (DoubleStack [] _) = InvalidStack | |
move' InvalidStack = InvalidStack |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment