{-# LANGUAGE GADTs, ExistentialQuantification #-}

module Interp3 where

-- No scoping errors for this interpreter
-- No typing errors 

data Var g t where
  Z   :: Var (g, t) t
  S   :: Var g t -> Var (g, t') t 

data Exp g t where 
  Var :: Var g (Value t) -> Exp g t
  Lit :: Int -> Exp g Int 
  Lam :: Exp (g, Value a) b -> Exp g (a -> b)
  App :: Exp g (a -> b) -> Exp g a -> Exp g b

instance Show (Exp g n) where
  show (Var lt)  = "Var"
  show (Lit i)   = "(Lit " ++ show i ++ ")"
  show (Lam t)   = "(Lam " ++ show t ++ ")"
  show (App t u) = "(App " ++ show t ++ " " ++ show u ++ ")"

data Value t where
  Const :: Int -> Value Int
  Clos  :: g -> Exp (g, Value a) b -> Value (a -> b)

instance Show (Value t) where
  show (Const i)  = show i
  show (Clos e t) = "Clos <env> " ++ show t ++ ")" 

sLookup :: Var g (Value t) -> g -> Value t
sLookup Z      (g,v) = v
sLookup (S x) (g, v) = sLookup x g

interp :: g -> Exp g t -> Value t
interp e (Var x)     = sLookup x e
interp e (Lit i)     = Const i
interp e (Lam t)     = Clos e t
interp e (App t1 t2) =
	 case interp e t1 of 
	    Clos e' t1' -> interp (e', interp e t2) t1'


t0 = interp () (App (Lam (Var Z)) (Lit 2))

-- doesn't type check
-- t1 = interp nil (Var (s z))

-- doesn't type check
-- t2 = interp () (App (Lit 2) (Lit 3))



-- Homework: 

-- (1) Get rid of Value type. We don't need it. 
-- i.e. implement this interpreter.
-- interp' :: g -> Exp g t -> t

-- (2) given this datatype:

data Ty =
  TInt | TArr Ty Ty

data UExp = 
  UVar Int | ULit Int  | ULam Ty UExp | UApp UExp UExp

data Type t where 
  RInt :: Type Int 
  RArr :: Type a -> Type b -> Type (a -> b)

data Typed g = forall t. Typed (Type t, Exp g t)

data TEnv g where
  TNil  :: TEnv ()
  TCons :: TEnv g -> Type a -> TEnv (g, Value a)

data AType where
  AType :: forall t. Type t -> AType

reify :: Ty -> AType
reify TInt = AType (RInt)
reify (TArr t1 t2) = 
    case (reify t1, reify t2) of 
      (AType t1', AType t2') -> AType (RArr t1' t2')


data Equal a b where
  Refl :: Equal a a

cmpTy :: Type a -> Type b -> Maybe (Equal a b)
cmpTy RInt RInt = Just Refl
cmpTy (RArr t1 t2) (RArr t3 t4) = do Refl <- cmpTy t1 t3
                                     Refl <- cmpTy t2 t4 
                                     return Refl
cmpTy _ _ = Nothing
-- write a typechecker. i.e a function that takes a UExp and 
-- either fails or returns an Exp.

tc :: UExp -> TEnv g -> Maybe (Typed g)
tc (UVar i) TNil = Nothing
tc (UVar 0) (TCons te t) = Just (Typed (t, Var Z))
tc (UVar n) (TCons te t) = 
     case (tc (UVar (n - 1)) te) of
       Nothing -> Nothing
       --- t' :: Type t0
       --- v  :: Var g' t0
       Just (Typed (t', Var v)) -> Just (Typed (t', Var (S v)))
       Just (Typed (t', _)) -> error "Bug"
tc (ULit i) g = Just (Typed (RInt, Lit i)) 
tc (ULam ty t) g =
    case (reify ty) of 
      AType t1 ->   
        case tc t (TCons g t1) of 
           Just (Typed (t2, t')) -> Just (Typed ((RArr t1 t2), Lam t'))
           Nothing -> Nothing
tc (UApp t1 t2) g =
   case (tc t1 g, tc t2 g) of 
     (Just (Typed (RArr a1 a2, t1')), Just (Typed (b1, t2'))) ->
         -- t1' :: Exp g (a1 -> a2)
         -- t2' :: Exp g b1
         case (cmpTy a1 b1) of 
            Just Refl -> Just (Typed (a2, App t1' t2'))
            _ -> Nothing
     (_,_) -> Nothing