Program Fixpoint pop_ptlz {hole_symbs hole_word hole_sems}
(ptl:parse_tree_list hole_symbs hole_word hole_sems)
(ptlz:ptl_zipper hole_symbs hole_word hole_sems):
{ word:_ & { sem:_ &
(pt_zipper (NT (prod_lhs (ptlz_prod ptlz))) word sem *
parse_tree (NT (prod_lhs (ptlz_prod ptlz))) word sem)%type } } :=
match ptlz in ptl_zipper hole_symbs hole_word hole_sems
return parse_tree_list hole_symbs hole_word hole_sems ->
{ word:_ & { sem:_ &
(pt_zipper (NT (prod_lhs (ptlz_prod ptlz))) word sem *
parse_tree (NT (prod_lhs (ptlz_prod ptlz))) word sem)%type } }
with
| @Non_terminal_pt_ptlz prod word sem ptz => fun ptl =>
let sem := uncurry (prod_action prod) sem in
existT _ word (existT _ sem (ptz, Non_terminal_pt ptl))
| Cons_ptl_ptlz pt ptlz' => fun ptl =>
pop_ptlz (Cons_ptl pt ptl) ptlz'
end ptl.

(* Specifications: *)
Lemma pop_ptlz_cost:
forall hole_symbs hole_word hole_sems
(ptl:parse_tree_list hole_symbs hole_word hole_sems)
(ptlz:ptl_zipper hole_symbs hole_word hole_sems),
let 'existT _ word (existT _ sem (ptz, pt)) := pop_ptlz ptl ptlz in
ptlz_cost ptlz = ptz_cost ptz.
Lemma pop_ptlz_buffer:
forall hole_symbs hole_word hole_sems
(ptl:parse_tree_list hole_symbs hole_word hole_sems)
(ptlz:ptl_zipper hole_symbs hole_word hole_sems),
let 'existT _ word (existT _ sem (ptz, pt)) := pop_ptlz ptl ptlz in
ptlz_buffer ptlz = ptz_buffer ptz.
Lemma pop_ptlz_pop_stack_compat_converter:
forall A hole_symbs hole_word hole_sems (ptlz:ptl_zipper hole_symbs hole_word hole_sems),
arrows_left (map symbol_semantic_type (rev (prod_rhs_rev (ptlz_prod ptlz)))) A =
arrows_left (map symbol_semantic_type hole_symbs)
(arrows_right A (map symbol_semantic_type (ptlz_past ptlz))).
Lemma pop_ptlz_pop_stack_compat:
forall hole_symbs hole_word hole_sems
(ptl:parse_tree_list hole_symbs hole_word hole_sems)
(ptlz:ptl_zipper hole_symbs hole_word hole_sems)
(stack:stack),
ptlz_stack_compat ptlz stack ->
let action' :=
eq_rect _ (fun x=>x) (prod_action (ptlz_prod ptlz)) _
(pop_ptlz_pop_stack_compat_converter _ _ _ _ _)
in
let 'existT _ word (existT _ sem (ptz, pt)) := pop_ptlz ptl ptlz in
match pop (ptlz_past ptlz) stack (uncurry action' hole_sems) with
| OK (stack', sem') =>
ptz_stack_compat ptz stack' /\ sem = sem'
| Err => True
end.