gistfile1.hs

{-# LANGUAGE GADTs, FlexibleInstances #-}

data Stack a where
  Empty :: () -> Stack ()
  Push :: b -> Stack a -> Stack (b,Stack a)

instance Show (Stack ()) where
  show (Empty ()) = "()"

instance (Show a, Show b) => Show (Stack (a,b)) where
  show (Push m ms) = "(" ++ show m ++ " . " ++ show ms ++ ")"


-- pushTwice :: a -> Stack s -> Stack (a, Stack (a, Stack s))
-- pushTwice x s =
--   Push x (Push x s)

-- popTwice :: Stack (a, Stack (a, Stack s)) -> (a, Stack s)
-- popTwice s =
--   case s of Push m1 (Push m2 ms) -> (m1, ms)

pop :: Stack (a, Stack s) -> (a, Stack s)
pop (Push a s) = (a, s)

push :: a -> Stack s -> Stack (a, Stack s)
push a b = Push a b

data LParen = LParen
data RParen = RParen
data Intgr = Intgr
data Star = Star

s1tos2 :: Stack (LParen, Stack ())
          -> Stack (Intgr, Stack (LParen, Stack ()))
s1tos2 s = Push Intgr s

s2tos3 :: Stack(Intgr, Stack a)
          -> Stack(Star, Stack(Intgr, Stack a))
s2tos3 s = Push Star s

s3tos4 :: Stack(Star, Stack(Intgr, Stack a))
          -> Stack(Intgr, Stack(Star, Stack(Intgr, Stack a)))
s3tos4 s = Push Intgr s

r1 :: Stack(Intgr, Stack(Star, Stack(Intgr, Stack a))) ->
      Stack a
r1 s =
  let (int1,s1) = pop s
  in let (star,s2) = pop s1
     in let (int2,s3) = pop s2
        in s3