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.
(** We now want to define what is the next dotted parse tree which is to be handled after one action. Such dotted parse is built in two steps: Not only we have to perform the action by completing the parse tree, but we also have to prepare for the following step by moving the dot down to place it in front of the next action to be performed. *)
Fixpoint build_pt_dot_from_pt {symb word}
(pt : parse_tree symb word) (ptz : pt_zipper symb word)
: pt_dot :=
match pt in parse_tree symb word
return pt_zipper symb word -> pt_dot
with
| Terminal_pt tok =>
fun ptz =>
let X :=
match ptz in pt_zipper symb word
return match symb with T term => True | NT _ => False end ->
{ symbsq : list symbol &
{ wordq : list token &
(parse_tree_list symbsq wordq *
ptl_zipper (symb :: symbsq) (wordq ++ word))%type } }
with
| Top_ptz => fun F => False_rect _ F
| Cons_ptl_ptz ptl ptlz => fun _ =>
existT _ _ (existT _ _ (ptl, ptlz))
end I
in
Shift_ptd tok (fst (projT2 (projT2 X))) (snd (projT2 (projT2 X)))
| Non_terminal_pt prod ptl => fun ptz =>
let is_notnil :=
match ptl in parse_tree_list w _
return option (match w return Prop with [] => False | _ => True end)
with
| Nil_ptl => None
| _ => Some I
end
in
match is_notnil with
| None => Reduce_ptd ptl ptz
| Some H => build_pt_dot_from_pt_rec ptl H (Non_terminal_pt_ptlz ptz)
end
end ptz
with build_pt_dot_from_pt_rec {symbs word}
(ptl : parse_tree_list symbs word)
(Hsymbs : match symbs with [] => False | _ => True end)
(ptlz : ptl_zipper symbs word)
: pt_dot :=
match ptl in parse_tree_list symbs word
return match symbs with [] => False | _ => True end ->
ptl_zipper symbs word ->
pt_dot
with
| Nil_ptl => fun Hsymbs _ => False_rect _ Hsymbs
| Cons_ptl ptl' pt => fun _ =>
match ptl' in parse_tree_list symbsq wordq
return parse_tree_list symbsq wordq ->
ptl_zipper (_ :: symbsq) (wordq ++ _) ->
pt_dot
with
| Nil_ptl => fun _ ptlz =>
build_pt_dot_from_pt pt (Cons_ptl_ptz Nil_ptl ptlz)
| _ => fun ptl' ptlz =>
build_pt_dot_from_pt_rec ptl' I (Cons_ptl_ptlz pt ptlz)
end ptl'
end Hsymbs ptlz.
Definition build_pt_dot_from_ptl {symbs word}
(ptl : parse_tree_list symbs word)
(ptlz : ptl_zipper symbs word)
: pt_dot :=
match ptlz in ptl_zipper symbs word
return parse_tree_list symbs word -> pt_dot
with
| Non_terminal_pt_ptlz ptz => fun ptl =>
Reduce_ptd ptl ptz
| Cons_ptl_ptlz pt ptlz => fun ptl =>
build_pt_dot_from_pt pt (Cons_ptl_ptz ptl ptlz)
end ptl.
Definition next_ptd (ptd:pt_dot) : option pt_dot :=
match ptd with
| Shift_ptd tok ptl ptlz =>
Some (build_pt_dot_from_ptl (Cons_ptl ptl (Terminal_pt tok)) ptlz)
| Reduce_ptd ptl ptz =>
match ptz in pt_zipper symb word
return parse_tree symb word -> _
with
| Top_ptz => fun _ => None
| Cons_ptl_ptz ptl' ptlz => fun pt =>
Some (build_pt_dot_from_ptl (Cons_ptl ptl' pt) ptlz)
end (Non_terminal_pt _ ptl)
end.
Fixpoint next_ptd_iter (ptd:pt_dot) (log_n_steps:nat) : option pt_dot :=
match log_n_steps with
| O => next_ptd ptd
| S log_n_steps =>
match next_ptd_iter ptd log_n_steps with
| None => None
| Some ptd => next_ptd_iter ptd log_n_steps
end
end.

Lemma ptd_stack_compat_build_from_ptl {symbs word}
(ptl : parse_tree_list symbs word) (ptlz : ptl_zipper symbs word)
(stk stk0: stack) :
ptlz_stack_compat stk0 ptlz ->
ptl_stack_compat stk0 ptl stk ->
state_has_future (state_of_stack init stk) (ptlz_prod ptlz)
(ptlz_future ptlz) (ptlz_lookahead ptlz) ->
ptd_stack_compat (build_pt_dot_from_ptl ptl ptlz) stk.