Section Completeness_Proof.
Hypothesis safe: Inter.ValidSafe.safe.
Hypothesis complete: complete.
(** A PTL is compatible with a stack if the top of the stack contains data representing to this PTL. *)
Fixpoint ptl_stack_compat {symbs word}
(stk0 : stack) (ptl : parse_tree_list symbs word) (stk : stack) : Prop :=
match ptl with
| Nil_ptl => stk0 = stk
| @Cons_ptl _ _ ptl sym _ pt =>
match stk with
| [] => False
| existT _ _ sem::stk =>
ptl_stack_compat stk0 ptl stk /\
exists e,
sem = eq_rect _ symbol_semantic_type (pt_sem pt) _ e
end
end.
Variable init: initstate.
(** In order to prove compleness, we first fix a word to be parsed together with the content of the parser at the end of the parsing. *)
Variable full_word: list token.
Variable buffer_end: buffer.
(** Completeness is proved by following the traversal of the parse tree which is performed by the parser. Each step of parsing correspond to one step of traversal. In order to represent the state of the traversal, we define the notion of "dotted" parse tree, which is a parse tree with one dot on one of its node. The place of the dot represents the place of the next action to be executed.  Such a dotted parse tree is decomposed into two part: a "regular" parse tree, which is the parse tree placed under the dot, and a "parse tree zipper", which is the part of the parse tree placed above the dot. Therefore, a parse tree zipper is a parse tree with a hole. Moreover, for easier manipulation, a parse tree zipper is represented "upside down". That is, the root of the parse tree is actually a leaf of the zipper, while the root of the zipper is the hole. *)
Inductive pt_zipper:
forall (hole_symb:symbol) (hole_word:list token), Type :=
| Top_ptz:
pt_zipper (NT (start_nt init)) full_word
| Cons_ptl_ptz:
forall {head_symbolsq:list symbol} {wordq:list token},
parse_tree_list head_symbolsq wordq ->
forall {head_symbolt:symbol} {wordt:list token},
ptl_zipper (head_symbolt::head_symbolsq) (wordq++wordt) ->
pt_zipper head_symbolt wordt
with ptl_zipper:
forall (hole_symbs:list symbol) (hole_word:list token), Type :=
| Non_terminal_pt_ptlz:
forall {p:production} {word:list token},
pt_zipper (NT (prod_lhs p)) word ->
ptl_zipper (prod_rhs_rev p) word
| Cons_ptl_ptlz:
forall {head_symbolsq:list symbol} {wordq:list token},
forall {head_symbolt:symbol} {wordt:list token},
parse_tree head_symbolt wordt ->
ptl_zipper (head_symbolt::head_symbolsq) (wordq++wordt) ->
ptl_zipper head_symbolsq wordq.
(** A dotted parse tree is the combination of a parse tree zipper with a parse tree. It can be intwo flavors, depending on which is the next action to be executed (shift or reduce). *)
Inductive pt_dot: Type :=
| Reduce_ptd: forall {prod word},
parse_tree_list (prod_rhs_rev prod) word ->
pt_zipper (NT (prod_lhs prod)) word ->
pt_dot
| Shift_ptd: forall (tok : token) {symbolsq wordq},
parse_tree_list symbolsq wordq ->
ptl_zipper (T (token_term tok)::symbolsq) (wordq++[tok]) ->
pt_dot.
(** We can compute the full semantic value of a parse tree when represented as a dotted ptd. *)
Fixpoint ptlz_sem {hole_symbs hole_word}
(ptlz:ptl_zipper hole_symbs hole_word) :
(forall A, arrows_right A (map symbol_semantic_type hole_symbs) -> A) ->
(symbol_semantic_type (NT (start_nt init))) :=
match ptlz with
| @Non_terminal_pt_ptlz prod _ ptz =>
fun k => ptz_sem ptz (k _ (prod_action prod))
| Cons_ptl_ptlz pt ptlz =>
fun k => ptlz_sem ptlz (fun _ f => k _ (f (pt_sem pt)))
end
with ptz_sem {hole_symb hole_word}
(ptz:pt_zipper hole_symb hole_word):
symbol_semantic_type hole_symb -> symbol_semantic_type (NT (start_nt init)) :=
match ptz with
| Top_ptz => fun sem => sem
| Cons_ptl_ptz ptl ptlz =>
fun sem => ptlz_sem ptlz (fun _ f => ptl_sem ptl (f sem))
end.
Definition ptd_sem (ptd : pt_dot) :=
match ptd with
| @Reduce_ptd prod _ ptl ptz =>
ptz_sem ptz (ptl_sem ptl (prod_action prod))
| Shift_ptd tok ptl ptlz =>
ptlz_sem ptlz (fun _ f => ptl_sem ptl (f (token_sem tok)))
end.
(** The buffer associated with a dotted parse tree corresponds to the buffer left to be read by the parser when at the state represented by the dotted parse tree. *)
Fixpoint ptlz_buffer {hole_symbs hole_word}
(ptlz:ptl_zipper hole_symbs hole_word): buffer :=
match ptlz with
| Non_terminal_pt_ptlz ptz =>
ptz_buffer ptz
| @Cons_ptl_ptlz _ _ _ wordt _ ptlz' =>
wordt ++ ptlz_buffer ptlz'
end
with ptz_buffer {hole_symb hole_word}
(ptz:pt_zipper hole_symb hole_word): buffer :=
match ptz with
| Top_ptz => buffer_end
| Cons_ptl_ptz _ ptlz =>
ptlz_buffer ptlz
end.
Definition ptd_buffer (ptd:pt_dot) :=
match ptd with
| Reduce_ptd _ ptz => ptz_buffer ptz
| @Shift_ptd tok _ wordq _ ptlz => (tok::ptlz_buffer ptlz)%buf
end.
(** We are now ready to define the main invariant of the proof of completeness: we need to specify when a stack is compatible with a dotted parse tree. Informally, a stack is compatible with a dotted parse tree when it is the concatenation stack fragments which are compatible with each of the partially recognized productions appearing in the parse tree zipper. Moreover, the head of each of these stack fragment contains a state which has an item predicted by the corresponding zipper.  More formally, the compatibility relation first needs the following auxiliary definitions: *)
Fixpoint ptlz_prod {hole_symbs hole_word}
(ptlz:ptl_zipper hole_symbs hole_word): production :=
match ptlz with
| @Non_terminal_pt_ptlz prod _ _ => prod
| Cons_ptl_ptlz _ ptlz' => ptlz_prod ptlz'
end.
Fixpoint ptlz_future {hole_symbs hole_word}
(ptlz:ptl_zipper hole_symbs hole_word): list symbol :=
match ptlz with
| Non_terminal_pt_ptlz _ => []
| @Cons_ptl_ptlz _ _ s _ _ ptlz' => s::ptlz_future ptlz'
end.
Fixpoint ptlz_lookahead {hole_symbs hole_word}
(ptlz:ptl_zipper hole_symbs hole_word) : terminal :=
match ptlz with
| Non_terminal_pt_ptlz ptz => token_term (buf_head (ptz_buffer ptz))
| Cons_ptl_ptlz _ ptlz' => ptlz_lookahead ptlz'
end.
Fixpoint ptz_stack_compat {hole_symb hole_word}
(stk : stack) (ptz : pt_zipper hole_symb hole_word) : Prop :=
match ptz with
| Top_ptz => stk = []
| Cons_ptl_ptz ptl ptlz =>
exists stk0,
state_has_future (state_of_stack init stk) (ptlz_prod ptlz)
(hole_symb::ptlz_future ptlz) (ptlz_lookahead ptlz) /\
ptl_stack_compat stk0 ptl stk /\
ptlz_stack_compat stk0 ptlz
end
with ptlz_stack_compat {hole_symbs hole_word}
(stk : stack) (ptlz : ptl_zipper hole_symbs hole_word) : Prop :=
match ptlz with
| Non_terminal_pt_ptlz ptz => ptz_stack_compat stk ptz
| Cons_ptl_ptlz _ ptlz => ptlz_stack_compat stk ptlz
end.
Definition ptd_stack_compat (ptd:pt_dot) (stk:stack): Prop :=
match ptd with
| @Reduce_ptd prod _ ptl ptz =>
exists stk0,
state_has_future (state_of_stack init stk) prod []
(token_term (buf_head (ptz_buffer ptz))) /\
ptl_stack_compat stk0 ptl stk /\
ptz_stack_compat stk0 ptz
| Shift_ptd tok ptl ptlz =>
exists stk0,
state_has_future (state_of_stack init stk) (ptlz_prod ptlz)
(T (token_term tok) :: ptlz_future ptlz) (ptlz_lookahead ptlz) /\
ptl_stack_compat stk0 ptl stk /\
ptlz_stack_compat stk0 ptlz
end.

Lemma ptz_stack_compat_cons_state_has_future {symbsq wordq symbt wordt} stk
(ptl : parse_tree_list symbsq wordq)
(ptlz : ptl_zipper (symbt :: symbsq) (wordq ++ wordt)) :
ptz_stack_compat stk (Cons_ptl_ptz ptl ptlz) ->
state_has_future (state_of_stack init stk) (ptlz_prod ptlz)
(symbt::ptlz_future ptlz) (ptlz_lookahead ptlz).