-- <PRE>

data ObjType:: *1 where
 ArrT:: ObjType ~> ObjType ~> ObjType
 IntT:: ObjType
 ProdT::  ObjType ~> ObjType ~> ObjType

data Rel:: ObjType ~> *0 ~> *0 where
 IntR:: Rel IntT Int
 IntTo:: Rel b s -> Rel (ArrT IntT b) (Int -> s)
   -- First order functions only as constants

data Mode:: *1 where
 Exp:: Mode
 Val:: Mode

data E:: Mode ~> Row Tag ObjType ~> ObjType ~> *0  where
  Const:: Rel a b -> b -> E Val env a
  Var  :: Label s -> E Val (RCons s t env) t
  Shift:: E m env t -> E m (RCons s q env) t
  Lam  :: Label a -> E m (RCons a s env) t -> E Val env (ArrT s t)
  App  :: E m1 env (ArrT s t) -> E m2 env s -> E Exp env t
  Pair :: E m1 env t -> E m2 env s -> E Exp env (ProdT t s)


exp1 = Lam `f (Lam `y (App (Shift(Var `f)) (Var `y)))
int n = Const IntR n
oper x = Const (IntTo (IntTo IntR)) x

t3 = Shift (Lam `x (Pair (Var `x) (Shift (Var `y))))

one = int 1
plus = oper (+)

data Shifter:: Row Tag ObjType ~> Row Tag ObjType ~> *0 where
   Zs :: Shifter env env
   Sz :: Shifter (RCons a b e1) e2 -> Shifter e1 e2
   Bind:: Shifter e g -> Shifter (RCons s b e) (RCons s b g)
 deriving syntax(s) Nat(Zs,Sz)

-- (Shifter _e _g -> Shifter {_s=_b; _e}r {_s=v; w}r)

down:: Shifter e1 e2 -> E m e1 t -> E m e2 t
down d (App x y) = App (down d x) (down d y)
down d (Pair x y) = Pair (down d x) (down d y)
down d (t@(Shift x)) = down (Sz d) x
down d (Var c) = push d (Var c)
down d (Const p x) = Const p x
down d (t@(Lam c body)) = Lam c (down (Bind d) body)


push:: Shifter e1 e2 -> E Val e1 t -> E Val e2 t
push (d@Zs) (t@(Var c)) = Var c
push (d@Zs) (t@(Shift c)) = Shift c
push (Sz d) x = push d (Shift x)
push (d@(Bind n)) (t@(Var c)) = Var c
push (d@(Bind n)) (t@(Shift c)) = Shift(push n c)

bump x = down Zs x

-- </pre>