module Example where

-- A interpreter for a simple expression language.

data Exp = Zero | Succ Exp | Plus Exp Exp | Fun (Exp->Exp) | App Exp Exp 

-- We use meta-variables (i.e. Haskell variables) to represent variables
-- in our object language.
-- That is, we're using Higher-Order Abstract Syntax (HOAS)

-- We define our own Show instance

instance Show Exp where
   show Zero = show 0                                  -- show zero as "0"
   show (Succ e) =  show (((read (show e))::Int) + 1)  
                    -- we show e --> somestring
                    -- (read somestring)::Int yields the integer interpretation of the string
                    -- we add one, and show again
   show (Plus e1 e2) = "Plus" ++ show e1 ++ show e2
   show (Fun f) = show f
   show (App e1 e2) = "App " ++ show e1 ++ " " ++ show e2

instance Show (Exp -> Exp) where
      show f = "Functions!"

eval :: Exp -> Exp
eval Zero = Zero
eval (Succ e) = Succ (eval e)
eval (Plus Zero e) = eval e
eval (Plus (Succ e1) e2) = Succ (eval (Plus e1 e2))
eval (Fun f) = Fun f 
eval (App f e) = case (eval f) of 
                  Fun f' -> eval (f' (eval e))

e1 :: Exp
e1 = App (Fun (\x-> Plus Zero x)) (Succ Zero)


-- a stack implemenation

data Stack a = forall s. Stack s           -- self
                               (a->s->s)   -- push
                               (s->s)      -- pop
                               (s->a)      -- top
                               (s->Bool)   -- empty


push :: a -> Stack a -> Stack a
push x (Stack s push' pop top empty) = Stack (push' x s) push' pop top empty

pop :: Stack a -> Stack a
pop (Stack s push pop' top empty) = Stack (pop' s) push pop' top empty

top :: Stack a -> a
top (Stack s push pop top' empty) = top' s

empty :: Stack a -> Bool
empty (Stack s push pop top empty') = empty' s


-- examples
mkListStack :: [a] -> Stack a
mkListStack xs = Stack xs (:) tail head null

s1 = mkListStack [1::Int]
s2 = push 2 s1


-- stack using type classes with existential types


class StackM s a | s -> a where
    pushM  :: a->s->s
    popM   :: s->s
    topM   :: s->a
    emptyM :: s->Bool


data Stack2 a = forall s. StackM s a => Stack2 s   


push2 :: a -> Stack2 a -> Stack2 a
push2 x (Stack2 s) = Stack2 (pushM x s) 

pop2 :: Stack2 a -> Stack2 a
pop2 (Stack2 s) = Stack2 (popM s) 

top2 :: Stack2 a -> a
top2 (Stack2 s) = topM s

empty2 :: Stack2 a -> Bool
empty2 (Stack2 s) = emptyM s


-- examples
instance StackM [a] a where
   pushM  = (:)
   popM   = tail
   topM   = head
   emptyM = null


mkListStack2 :: [a] -> Stack2 a
mkListStack2 xs = Stack2 xs 

s3 = mkListStack2 [1::Int]
s4 = push2 2 s3