Module Make(Import A:Automaton.T).
(** The singleton predicate for states **)
Definition singleton_state_pred (state:state) :=
(fun state' => match compare state state' with Eq => true |_ => false end).
(** [past_state_of_non_init_state], extended for all states. **)
Definition past_state_of_state (state:state) :=
match state with
| Init _ => []
| Ninit nis => past_state_of_non_init_state nis
end.
(** Concatenations of last and past **)
Definition head_symbs_of_state (state:state) :=
match state with
| Init _ => []
| Ninit s =>
last_symb_of_non_init_state s::past_symb_of_non_init_state s
end.
Definition head_states_of_state (state:state) :=
singleton_state_pred state::past_state_of_state state.
(** * Validation for correctness **)
(** Prefix predicate between two lists of symbols. **)
Inductive prefix: list symbol -> list symbol -> Prop :=
| prefix_nil: forall l, prefix [] l
| prefix_cons: forall l1 l2 x, prefix l1 l2 -> prefix (x::l1) (x::l2).
Fixpoint is_prefix (l1 l2:list symbol) :=
match l1, l2 with
| [], _ => true
| t1::q1, t2::q2 => (compare_eqb t1 t2 && is_prefix q1 q2)%bool
| _::_, [] => false
end.
Instance prefix_is_validator l1 l2 : IsValidator (prefix l1 l2) (is_prefix l1 l2).
(** If we shift, then the known top symbols of the destination state is a prefix of the known top symbols of the source state, with the new symbol added. **)
Definition shift_head_symbs :=
forall s,
match action_table s with
| Lookahead_act awp => forall t,
match awp t with
| Shift_act s2 _ =>
prefix (past_symb_of_non_init_state s2) (head_symbs_of_state s)
| _ => True
end
| _ => True
end.
(** When a goto happens, then the known top symbols of the destination state is a prefix of the known top symbols of the source state, with the new symbol added. **)
Definition goto_head_symbs :=
forall s nt,
match goto_table s nt with
| Some (exist _ s2 _) =>
prefix (past_symb_of_non_init_state s2) (head_symbs_of_state s)
| None => True
end.
(** We have to say the same kind of checks for the assumptions about the states stack. However, theses assumptions are predicates. So we define a notion of "prefix" over predicates lists, that means, basically, that an assumption entails another **)
Inductive prefix_pred: list (state->bool) -> list (state->bool) -> Prop :=
| prefix_pred_nil: forall l, prefix_pred [] l
| prefix_pred_cons: forall l1 l2 f1 f2,
(forall x, implb (f2 x) (f1 x) = true) ->
prefix_pred l1 l2 -> prefix_pred (f1::l1) (f2::l2).

(** [prefix_pred] is transitive **)
Lemma prefix_pred_trans:
forall (l1 l2 l3:list (state->bool)),
prefix_pred l1 l2 -> prefix_pred l2 l3 -> prefix_pred l1 l3.