I'm a haskell beginner so the following code might not meet haskell coding standards. I think that it is a correct O(1) implementation. Sorry if i simply recoded an already posted solution that i did not understand correctly. --- code --------- module Main where data Col a = Red a | Blue a data RBStack a = RBS [Col Int] -- order [a] -- blues [a] -- reds empty = RBS [] [] [] push (Blue e) (RBS [] [] []) = RBS [Blue 1] [e] [] push (Blue e) (RBS ((Blue n):ns) bs rs) = RBS ((Blue (n+1)):ns) (e:bs) rs push (Blue e) (RBS ns bs rs) = RBS ((Blue 1):ns) (e:bs) rs push (Red e) (RBS [] [] []) = RBS [Red 1] [] [e] push (Red e) (RBS ((Red n):ns) bs rs) = RBS ((Red (n+1)):ns) bs (e:rs) push (Red e) (RBS ns bs rs) = RBS ((Red 1):ns) bs (e:rs) popBlue (RBS [] _ _) = error "no blue, empty stack" popBlue (RBS [Red _] _ _) = error "no blue" popBlue (RBS ((Red nr):(Blue 1):[]) [b] rs) = RBS [Red nr] [] rs popBlue (RBS ((Red nr):(Blue 1):(Red nr'):s) (b:bs) rs) = RBS ((Red (nr+nr')):s) bs rs popBlue (RBS ((Red nr) :(Blue nb):s) (b:bs) rs) = RBS ((Red nr):(Blue (nb-1)):s) bs rs popBlue (RBS ((Blue 1):s) (b:bs) rs) = RBS s bs rs popBlue (RBS ((Blue nb):s) (b:bs) rs) = RBS (Blue (nb-1):s) bs rs popRed (RBS [] _ _) = error "no red, empty stack" popRed (RBS [Blue _] _ _) = error "no red" popRed (RBS ((Blue nb):(Red 1):[]) bs [r]) = RBS [Blue nb] bs [] popRed (RBS ((Blue nb):(Red 1):(Blue nb'):s) bs (r:rs)) = RBS ((Blue (nb+nb')):s) bs rs popRed (RBS ((Blue nb):(Red nr):s) bs (r:rs)) = RBS ((Blue nb):(Red (nr-1)):s) bs rs popRed (RBS ((Red 1):s) bs (r:rs)) = RBS s bs rs popRed (RBS ((Red nr):s) bs (r:rs)) = RBS (Red (nr-1):s) bs rs pop (RBS [] _ _) = error "empty stack" pop rbs@(RBS ((Red _):_) _ _) = popRed rbs pop rbs@(RBS ((Blue _):_) _ _) = popBlue rbs pp (RBS [] [] []) = "" pp (RBS ((Red 1):s) bs (r:rs)) = "r " ++ (pp (RBS s bs rs)) pp (RBS ((Red n):s) bs (r:rs)) = "r " ++ (pp (RBS ((Red (n-1)):s) bs rs)) pp (RBS ((Blue 1):s) (b:bs) rs) = "b " ++ (pp (RBS s bs rs)) pp (RBS ((Blue n):s) (b:bs) rs) = "b " ++ (pp (RBS ((Blue (n-1)):s) bs rs)) altPushRed 0 = empty altPushRed n = push (Red n) (altPushBlue (n-1)) altPushBlue 0 = empty altPushBlue n = push (Blue n) (altPushRed (n-1)) main = do let s = altPushRed 4 s1 = popBlue $ popBlue $ s s2 = popRed $ popRed $ s s3 = pop $ pop $ s putStrLn ("s = " ++ (pp s)) putStrLn ("s1 = " ++ (pp s1)) putStrLn ("s2 = " ++ (pp s2)) putStrLn ("s3 = " ++ (pp s3))