Proof with eauto.
intros.
unfold reduce_step.
pose proof (pop_invariant (prod_rhs_rev prod) [] stack (symbol_semantic_type (NT (prod_lhs prod)))).
revert H0.
generalize (pop_invariant_converter (symbol_semantic_type (NT (prod_lhs prod))) (prod_rhs_rev prod) []).
rewrite <- rev_alt.
intros.
specialize (H0 (prod_action prod) _ [] () H (inhabits Nil_ptl)).
match goal with H0:let action' := ?a in _ |- _ => replace a with (prod_action' prod) in H0 end.
simpl in H0.
destruct (pop (prod_rhs_rev prod) stack (prod_action' prod)) as [|[]]; intuition.
destruct H0 as [word1res [word2res [sem_full]]]; intuition.
destruct H4; apply Non_terminal_pt, inhabits in X.
match goal with X:inhabited (parse_tree _ _ ?u) |- _ => replace u with s0 in X end.
clear sem_full H2.
simpl; destruct (goto_table (state_of_stack init s) (prod_lhs prod)) as [[]|]; intuition; subst.
rewrite app_nil_r in X; revert s0 X; rewrite e0; intro; simpl.
constructor...
destruct s; intuition.
destruct (compare_eqdec (prod_lhs prod) (start_nt init)); intuition.
rewrite app_nil_r in X.
rewrite <- e0.
inversion H0.
destruct X; constructor...
apply JMeq_eq.
etransitivity.
apply JMeq_eqrect with (P:=(fun x => x)).
symmetry.
apply JMeq_eqrect with (P:=(fun x => x)).
Qed.

(** [step] preserves the invariant **)
Lemma step_invariant (stack:stack) (buffer:Stream token):
forall buffer_tmp,
(exists word_old,
buffer = word_old ++ buffer_tmp /\
word_has_stack_semantics word_old stack) ->
match step init stack buffer_tmp with
| OK (Accept_sr sem buffer_new) =>
exists word_new,
buffer = word_new ++ buffer_new /\
inhabited (parse_tree (NT (start_nt init)) word_new sem)
| OK (Progress_sr stack_new buffer_new) =>
exists word_new,
buffer = word_new ++ buffer_new /\
word_has_stack_semantics word_new stack_new
| Err | OK Fail_sr => True
end.