-- <PRE>

-- This file was inspired from our development of
-- SimpleTags.prg. We replace
-- Tag' and Label' by the builtin Tag and Label type.
-- In this file we explore the notion of substitution.


-- A Shape is a list or record structure in which
-- we use the built in Tag as labels.
-- The built in Tag types are constructed by using
-- the backquote on a variable like `a

data Shape:: *1 where
  E :: Shape
  P :: Tag ~> *0 ~> Shape ~> Shape
    deriving Record(s)


-- A count is a natural number, which is indexed
-- by shapes and types.

data Count:: Shape ~> Tag ~> *0 ~> *0 where
  Zero:: Count (P a t b) a t
  Succ:: Count sh nm ty -> (Count (P a ty2 sh)) nm ty
    deriving Nat(c)

-- A Term is indexed by a Shape which determines what
-- variables are used in the term, and what type those
-- variables have.

data Term:: Shape ~> *0 ~> *0 where
  Iconst :: Int -> Term sh Int
  Var:: Label a -> Count i a ty -> Term i ty
  Pair:: Term sh a -> Term sh b -> Term sh (a,b)
  Let:: Label a -> Term sh x -> Term (P a x sh) s -> Term sh s
     -- let a = 3 in (a,5)

-- Here are a few examples.
t1 = Let `x (Iconst 3) (Pair (Var `x 0c) (Iconst 5))
t2 = Let `x (Iconst 3) (Pair (Var `x 0c) (Var `y 1c))

-- First a quick side trip. What if we want to add Succ
-- to every variable in a term?  Term sh t -> Term (P c x sh) t

data Bumper:: Shape ~> Shape ~> *0 where
  Base:: Bumper sh (P c t sh)
  Step:: Bumper sh1 sh2 -> Bumper (P c t sh1) (P c t sh2)
 deriving Nat(b)

bumpV:: Bumper sh1 sh2 -> Count sh1 c t -> Count sh2 c t
bumpV Base v = Succ v
bumpV (Step m) Zero = Zero
bumpV (Step m) (Succ n) = Succ(bumpV m n)

bump:: (Bumper sh1 sh2) -> Term sh1 x -> Term sh2 x
bump f (Var x v) = Var x (bumpV f v)
bump f (Iconst n) = Iconst n
bump f (Pair x y) = Pair (bump f x) (bump f y)
bump f (Let v e1 e2) = Let v (bump f e1) (bump (Step f) e2)

add1:: Term sh t -> Term (P c x sh) t
add1 term = bump Base term

-- Substitution will replace the variable outer most
-- in the shape with a term of the same type.
-- The term being substituted into will have type: Term (P a x sh) s
-- The variable is 'a' and its type is 'x'
-- The term being substituted for 'a' will have type: Term sh x
-- Here is our first try.

subst:: Term sh x -> Term (P a x sh) s -> Term sh s
subst t (Var x 0c) = t
subst t (Var x (Succ c)) = Var x c
subst t (Iconst c) = Iconst c
subst t (Pair x y) = Pair (subst t x) (subst t y)
-- subst t (Let v e1 e2) = check Let v (subst t e1) (subst t e2)


-- The problem here is that the term 'e2' doesn't have the right shape.
-- In fact, subst replaces the variable with count Zero, but inside
-- 'e2' the new variable 'v' has Count Zero, so inside 'e2' we
-- want 't' to replace the variable with Count (Succ Zero)
-- If you remove the comment in the last line you can poke around
-- inside the 'check' and see for yourself that the shape isn't correct.

-- We need to count how many 'Let's we have walked under. And we
-- need to adjust the shape as we do it. Think of a Substitution as
-- a indicating both the starting and ending shape, and which encloses
-- the term to substitute for the variable.

data Substitution :: Shape ~> Shape ~> *0 ~> *0 where
  Top:: Term s t -> Substitution (P c t s) s t
  Next:: Substitution sh1 sh2 t2 -> Substitution (P c t3 sh1) (P c t3 sh2) t2

sub1 :: Substitution {a=Int; b}s b Int
sub1 = Top (Iconst 1)

sub2:: Substitution {a=b,c=Int; d}s {a=b; d}s Int
sub2 = Next sub1


subst2:: (Substitution sh1 sh2 t1) -> Term sh1 t2 -> Term sh2 t2
subst2 (Top t)  (Var x Zero) = t
subst2 (Next _) (Var x Zero) = Var x Zero
subst2 (Top t)  (Var x (Succ c)) = Var x c
subst2 (Next t) (Var x (Succ c)) = bump Base (subst2 t (Var x c))
subst2 t (Iconst c) = Iconst c
subst2 t (Pair x y) = Pair (subst2 t x) (subst2 t y)
subst2 t (x@(Let v e1 e2)) = Let v (subst2 t e1) (subst2 (Next t) e2)

-- One way to get around this is to add a new Constructor 'Bump' to terms
-- Encapsulating the bump operator


data TermB:: Shape ~> *0 ~> *0 where
  Iconst2 :: Int -> TermB sh Int
  Var2:: Label a -> Count i a ty -> TermB i ty
  Pair2:: TermB sh a -> TermB sh b -> TermB sh (a,b)
  Let2:: Label a -> TermB sh x -> TermB (P a x sh) s -> TermB sh s
  Bump:: TermB sh x -> TermB (P a t sh) x



data SubstitutionB :: Shape ~> Shape ~> *0 ~> *0 where
  TopB:: TermB s t -> SubstitutionB (P c t s) s t
  NextB:: SubstitutionB sh1 sh2 t2 -> SubstitutionB (P c t3 sh1) (P c t3 sh2) t2


substB:: (SubstitutionB sh1 sh2 t1) -> TermB sh1 t2 -> TermB sh2 t2
substB (TopB t)  (Var2 x Zero) = t
substB (NextB _) (Var2 x Zero) = Var2 x Zero
substB (TopB t)  (Var2 x (Succ c)) = Var2 x c
substB (NextB t) (Var2 x (Succ c)) = Bump (substB t (Var2 x c))
substB t (Iconst2 c) = Iconst2 c
substB t (Pair2 x y) = Pair2 (substB t x) (substB t y)
-- substB (TopB t) (Bump x) = check undefined
substB t (x@(Let2 v e1 e2)) = Let2 v (substB t e1) (substB (NextB t) e2)


--