data Var = X | Y | Z deriving (Show, Eq) 

data Exc = E | H | K deriving (Show, Eq)


type State = [(Var, Integer)]

type EnvX  = [(Exc, Cont)]

lkp :: Var -> State -> Integer
lkp x [] = 0
lkp x ((y,z):s) = if x == y then z else lkp x s

lkpX :: Exc -> EnvX -> Cont
lkpX x [] = id
lkpX x ((y,z):s) = if x == y then z else lkpX x s


upd :: Eq a => a -> b -> [(a,b)] -> [(a,b)]
--upd x z s = (x,z):s 
upd x z [] = [(x,z)]
upd x z ((y,w):s) = if x == y then (x,z):s
                       else (y,w):upd x z s

init :: [(a,b)]
init = []


data AExp = N Integer | V Var 
          | AExp :+ AExp | AExp :- AExp | AExp :* AExp

aexp :: AExp -> State -> Integer
aexp (N z) _      = z
aexp (V x) s      = lkp x s
aexp (a0 :+ a1) s = aexp a0 s + aexp a1 s
aexp (a0 :- a1) s = aexp a0 s - aexp a1 s
aexp (a0 :* a1) s = aexp a0 s * aexp a1 s


data BExp = TT | FF | AExp :== AExp | AExp :<= AExp 
          | Not BExp | BExp :&& BExp | BExp :|| BExp

bexp :: BExp -> State -> Bool
bexp TT _ = True
bexp FF _ = False
bexp (a0 :== a1) s = aexp a0 s == aexp a1 s
bexp (a0 :<= a1) s = aexp a0 s <= aexp a1 s
bexp (Not b) s = not (bexp b s)
bexp (a0 :&& a1) s = bexp a0 s && bexp a1 s
bexp (a0 :|| a1) s = bexp a0 s || bexp a1 s


data Stmt = Skip | Stmt :\ Stmt 
          | Var := AExp
          | If BExp Stmt Stmt
          | While BExp Stmt
          | Handle Stmt Exc Stmt
          | Raise Exc

type Cont = State -> State

cond :: (State -> Bool) -> Cont -> Cont -> Cont
cond p c0 c1 s = if p s then c0 s else c1 s

fix :: ((Cont -> Cont) -> Cont -> Cont) -> Cont -> Cont
fix f = f (fix f) 


stmt :: Stmt -> State -> (Maybe Exc, State)

stmt Skip s = (Nothing, s)
stmt (stm0 :\ stm1) s  
       = case stmt stm0 s of
            (Nothing, s') -> stmt stm1 s'
            p@(Just _, _) -> p 
stmt (x := a) s = (Nothing, upd x (aexp a s) s)
stmt (If b stm0 stm1) s = 
       if bexp b s then stmt stm0 s else stmt stm1 s
stmt (While b stm0) s = 
       if bexp b s then   
         case stmt stm0 s of
            (Nothing, s') -> stmt (While b stm0) s'
            p@(Just _, _) -> p
       else (Nothing, s)
stmt (Handle stm0 exc stm1) s =
       case stmt stm0 s of
            p@(Nothing, s')   -> p
            p@(Just exc', s') -> 
                   if exc' == exc then stmt stm1 s'
                   else p   
stmt (Raise exc) s = (Just exc, s)


fac :: Stmt 
fac = (Y := N 1) :\ 
      (While (Not (N 1 :== V X))
        ((Y := (V Y :* V X)) :\
         (X := (V X :- N 1))
        )
      )



test0 = (X := N 17) :\ Raise E :\ (Y := N 43)

test1 = Handle (test0 :\ (Z := (V X :+ V Y))) 
                               E (X := (V X :+ N 100))
test2 = Handle test0 E (X := (V X :+ N 100))
                        :\ (Z := (V X :+ V Y))


test3 = Handle test0 E (X := (V X :+ N 100) :\ Raise E)
                        :\ (Z := (V X :+ V Y))

--test4 = (X := N 17) :\ Twice :\ (Y := (V Y :+ N 1))