Section machine.
Variables pc state : Type.
Inductive propX (i := pc) (j := state) : list Type -> Type :=
| Inj : forall G, Prop -> propX G
| ExistsX : forall G A, propX (A :: G) -> propX G.
Arguments Inj [G].
Definition PropX := propX nil.
Fixpoint last (G : list Type) : Type.
exact (match G with
| nil => unit
| T :: nil => T
| _ :: G' => last G'
end).
Defined.
Fixpoint eatLast (G : list Type) : list Type.
exact (match G with
| nil => nil
| _ :: nil => nil
| x :: G' => x :: eatLast G'
end).
Defined.
Fixpoint subst G (p : propX G) : (last G -> PropX) -> propX (eatLast G) :=
match p with
| Inj _ P => fun _ => Inj P
| ExistsX G A p1 => fun p' =>
match G return propX (A :: G) -> propX (eatLast (A :: G)) -> propX (eatLast G) with
| nil => fun p1 _ => ExistsX p1
| _ :: _ => fun _ rc => ExistsX rc
end p1 (subst p1 (match G return (last G -> PropX) -> last (A :: G) -> PropX with
| nil => fun _ _ => Inj True
| _ => fun p' => p'
end p'))
end.
Definition spec := state -> PropX.
Definition codeSpec := pc -> option spec.
Inductive valid (specs : codeSpec) (G : list PropX) : PropX -> Prop := Env : forall P, In P G -> valid specs G P.
Definition interp specs := valid specs nil.
End machine.
Notation "'ExX' : A , P" := (ExistsX (A := A) P) (at level 89) : PropX_scope.
Bind Scope PropX_scope with PropX propX.
Variables pc state : Type.
Inductive subs : list Type -> Type :=
| SNil : subs nil
| SCons : forall T Ts, (last (T :: Ts) -> PropX pc state) -> subs (eatLast (T :: Ts)) -> subs (T :: Ts).
Fixpoint SPush G T (s : subs G) (f : T -> PropX pc state) : subs (T :: G) :=
match s in subs G return subs (T :: G) with
| SNil => SCons _ nil f SNil
| SCons T' Ts f' s' => SCons T (T' :: Ts) f' (SPush s' f)
end.
Fixpoint Substs G (s : subs G) : propX pc state G -> PropX pc state :=
match s in subs G return propX pc state G -> PropX pc state with
| SNil => fun p => p
| SCons _ _ f s' => fun p => Substs s' (subst p f)
end.
Variable specs : codeSpec pc state.

Lemma simplify_fwd_ExistsX : forall G A s (p : propX pc state (A :: G)),
interp specs (Substs s (ExX  : A, p))
-> exists a, interp specs (Substs (SPush s a) p).