Set Implicit Arguments.
Unset Strict Implicit.
Set Maximal Implicit Insertion.
Set Universe Polymorphism.
Section Subst.
Context {A val : Type} {Heq : RelDec (@eq A)}.
Context {R : ValNull val}.
Definition subst := A -> (A -> val) -> val.
Definition stack_subst (s: stack A val) (sub: subst) : stack A val :=
fun x => sub x s.
Definition apply_subst {B}
(e : (A -> val) -> B) (sub : subst) : (A -> val) -> B :=
fun s => e (stack_subst s sub).
Definition substlist := list (A * @expr A val).
(* The identity substitution *)
Definition subst0 : subst := fun x => stack_get x.
(* Substitution of one variable *)
Definition subst1 e x : subst :=
fun x' => if x' ?[ eq ] x then e else stack_get x'.
(* Truncating substitution of one variable *)
Definition subst1_trunc e x : subst :=
fun x' => if x' ?[ eq ] x then e else empty_open.
(* Simultaneous substitution of a finite list of variables *)
Fixpoint substl_aux (subs: substlist) : subst :=
match subs with
| nil => subst0
| cons (x,e) subs' => fun x' =>
if x' ?[ eq ] x then e else substl_aux subs' x'
end.
(* Truncating simultaneous substitution of a finite list of variables *)
Fixpoint substl_trunc_aux (subs: substlist) : subst :=
match subs with
| nil => fun _ => empty_open
| cons (x,e) subs' => fun x' =>
if x' ?[ eq ] x then e else substl_trunc_aux subs' x'
end.
Definition substl es v := substl_aux es v.
Definition substl_trunc es v := substl_trunc_aux es v.
End Subst.
(* Binds tighter than function application *)
(* We have the e at precedence level one less than the precedence of the infix // operator to make parsing work. *)
Notation "g [{ e // x }]" := (apply_subst g (subst1 e x)) (at level 9, e at level 39,
format "g [{ e // x }]") : open_scope.
Notation "g [{ e //! x }]" := (apply_subst g (subst1_trunc e x)) (at level 9, e at level 39,
format "g [{ e //! x }]") : open_scope.
Notation " g '//' es " := (apply_subst g (substl es)) (at level 40) : open_scope.
Notation " g '//!' es " := (apply_subst g (substl_trunc es)) (at level 40) : open_scope.
Section Properties.
Context {A val : Type} {Heq : RelDec (@eq A)} {HeqOk : RelDec_Correct Heq}.
Context {R : ValNull val}.

(* Specifications: *)
Lemma open_subst_stack {B} (m: @open A val B) (sub : subst) (s : @stack A val) :
(apply_subst m sub) s = m (stack_subst s sub).
Lemma subst1_stack (s: @stack A val) e x :
stack_subst s (subst1 e x) = stack_add x (e s) s.
Lemma substl_subst1 x e :
substl (val := val) (cons (x,e) nil) = subst1 e x.
Lemma substl_subst1_trunc x e :
substl_trunc (cons (x,e) nil) = subst1_trunc e x.