Module Import ValidSafe := Validator_safe.Make A.
(** A few helpers for dependent types. *)
(** Decidable propositions. *)
Class Decidable (P : Prop) := decide : {P} + {~P}.
Arguments decide _ {_}.
(** A [Comparable] type has decidable equality. *)
Instance comparable_decidable_eq T `{ComparableLeibnizEq T} (x y : T) :
Decidable (x = y).
(** [step_result] represents the result of one step of the automaton : it can fail, accept or progress. [Fail_sr] means that the input is incorrect. [Accept_sr] means that this is the last step of the automaton, and it returns the semantic value of the input word. [Progress_sr] means that some progress has been made, but new steps are needed in order to accept a word.  For [Accept_sr] and [Progress_sr], the result contains the new input buffer.  [Fail_sr] means that the input word is rejected by the automaton. It is different to [Err] (from the error monad), which mean that the automaton is bogus and has perfomed a forbidden action. **)
Inductive step_result :=
| Fail_sr: step_result
| Accept_sr: symbol_semantic_type (NT (start_nt init)) -> buffer -> step_result
| Progress_sr: stack -> buffer -> step_result.
(** [reduce_step] does a reduce action : - pops some elements from the stack - execute the action of the production - follows the goto for the produced non terminal symbol **)
Definition reduce_step stk prod (buffer : buffer)
(Hval : thunkP (valid_for_reduce (state_of_stack stk) prod))
(Hi : thunkP (stack_invariant stk))
: step_result.
refine
((let '(stk', sem) as ss := pop (prod_rhs_rev prod) stk _ (prod_action prod)
return thunkP (state_valid_after_pop (state_of_stack (fst ss)) _
(head_states_of_state (state_of_stack stk))) -> _
in fun Hval' =>
match goto_table (state_of_stack stk') (prod_lhs prod) as goto
return (thunkP (goto = None ->
match state_of_stack stk' with
| Init i => prod_lhs prod = start_nt i
| Ninit _ => False
end)) -> _
with
| Some (exist _ state_new e) => fun _ =>
let sem := eq_rect _ _ sem _ e in
Progress_sr (existT noninitstate_type state_new sem::stk') buffer
| None => fun Hval =>
let sem := cast symbol_semantic_type _ sem in
Accept_sr sem buffer
end (fun _ => _))
(fun _ => pop_state_valid _ _ _ _ _ _ _)).
(** One step of parsing. **)
Definition step stk buffer (Hi : thunkP (stack_invariant stk)): step_result :=
match action_table (state_of_stack stk) as a return
thunkP
match a return Prop with
| Default_reduce_act prod => _
| Lookahead_act awt => forall t : terminal,
match awt t with
| Reduce_act p => _
| _ => True
end
end -> _
with
| Default_reduce_act prod => fun Hv =>
reduce_step stk prod buffer Hv Hi
| Lookahead_act awt => fun Hv =>
match buf_head buffer with
| tok =>
match awt (token_term tok) as a return
thunkP match a return Prop with Reduce_act p => _ | _ => _ end -> _
with
| Shift_act state_new e => fun _ =>
let sem_conv := eq_rect _ symbol_semantic_type (token_sem tok) _ e in
Progress_sr (existT noninitstate_type state_new sem_conv::stk)
(buf_tail buffer)
| Reduce_act prod => fun Hv =>
reduce_step stk prod buffer Hv Hi
| Fail_act => fun _ =>
Fail_sr
end (fun _ => Hv I (token_term tok))
end
end (fun _ => reduce_ok _).

Lemma step_stack_invariant_preserved stk buffer Hi stk' buffer':
step stk buffer Hi = Progress_sr stk' buffer' ->
stack_invariant stk'.