(* Autor(s): Andrej Dudenhefner (1) Affiliation(s): (1) Saarland University, Saarbrücken, Germany *)
(* Facts on: Confluent Simple Stack Machines *)
(* uniform boundedness of deterministic simple stack machines *)
From Undecidability.StackMachines.Util Require Import Facts.
(* width of a configuration *)
Definition width : config -> nat := fun '(A, B, _) => length A + length B.
(* joinability of configurations *)
Definition equiv (X Y: config) := exists (Z: config), reachable M X Z /\ reachable M Y Z.
(* list all states occurring in M' *)
Fixpoint enum_states (M': ssm) : list state :=
match M' with
| [] => []
| (x, y, _, _, _) :: M' => x :: y :: enum_states M'
end.
Definition get_state : config -> state :=
fun '(_,  _, x) => x.
(* list all configurations with stack lengths lA and lB *)
Definition enum_configs (lA lB: nat) : list config :=
list_prod (list_prod (enum_stacks lA) (enum_stacks lB)) (enum_states M).
(* space X is an overapproximation of reachable states from X *)
Definition space (X: config) : list config :=
X :: flat_map (fun i => enum_configs i (width X - i)) (seq 0 (width X + 1)).
Definition get_left : config -> stack :=
fun '(A, _, _) => A.
Definition get_right : config -> stack :=
fun '(_, B, _) => B.
(* reachability in at most n steps *)
Inductive reachable_n : nat -> config -> config -> Prop :=
| rn_refl n X : reachable_n n X X
| rn_step n X Y Z: reachable_n n X Y -> step M Y Z -> reachable_n (1+n) X Z.
(* X is narrow iff X ~ A|x|ϵ *)
Definition narrow (X: config) := exists (x: state) (A: stack), equiv X (A, [], x).
(* bound on size of the right stack for narrow configurations with empty left stack *)
Definition bounded' (n: nat) : Prop := forall (c: config) (x y: state) (A B: stack),
reachable M (A, [], x) c -> reachable M ([], B, y) c -> length B <= n.

(* a configuration X either explores its full space or has a redundint suffix on one of the stacks *)
Theorem reachable_suffixes (X: config) :
(exists A x y B, reachable M X (A, [], x) /\ reachable M X ([], B, y)) \/
(exists AX a, get_left X = AX ++ [a] /\ forall Y, reachable M X Y -> exists AY, get_left Y = AY ++ [a] /\
reachable M (AX, get_right X, get_state X) (AY, get_right Y, get_state Y)) \/
(exists BX b, get_right X = BX ++ [b] /\ forall Y, reachable M X Y -> exists BY, get_right Y = BY ++ [b] /\
reachable M (get_left X, BX, get_state X) (get_left Y, BY, get_state Y)).