{-# OPTIONS -fglasgow-exts #-}

class StackClass a b | b -> a where
    push   :: a -> b -> b
    pop    :: b -> b
    top    :: b -> a
    isNull :: b -> Bool 

instance StackClass a [a] where 
    push   = (:)
    top    = head
    pop    = tail
    isNull = null

instance StackClass a (Int, Int -> a) where
    push = \ x (max, fn) -> 
           (max+1, \i -> 
            if i == max then x else fn i)
    top  = \ (max, fn) -> fn (max - 1) 
    pop  = \ (max, fn) -> 
              ( max - 1, \i -> if i == max then error "empty" else fn i)
    isNull = \(x,_) -> x == 0

-- x :: (StackClass a b) => [b] -> b
x stacks = let y = top (head stacks) in push y (head stacks)


data Stack a = forall b. StackClass a b => NewStack b

instance StackClass a (Stack a) where
    push   = \a x -> case x of { NewStack s -> NewStack (push a s) }
    top    = \x -> case x of { NewStack s -> top s }
    pop    = \x -> case x of { NewStack s -> NewStack (pop s) }
    isNull = \x -> case x of { NewStack s -> isNull s }

instance Show a => Show (Stack a) where
	 show s = if isNull s then "[]"
				 else show (top s) ++ "@" ++ (show (pop s))

stacks :: [Stack Int]
stacks =  [NewStack [1,2,3], NewStack (3::Int, \(x::Int) -> 
                                           case x of 
                                             0 -> 5
                                             1 -> 6
                                             2 -> 7
                                             _ -> error "BUG")]


t = map top stacks