(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Jacques-Henri Jourdan, INRIA Paris-Rocquencourt            *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the GNU General Public License as published by  *)
(*  the Free Software Foundation, either version 2 of the License, or  *)
(*  (at your option) any later version.  This file is also distributed *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)
Require Grammar.
Require Automaton.
Require Interpreter.
Module Make(Import A:Automaton.T) (Import Inter:Interpreter.T A).
(** * Correctness of the interpreter **)
(** We prove that, in any case, if the interpreter accepts returning a semantic value, then this is a semantic value of the input **)
Section Init.
Variable init:initstate.
(** [word_has_stack_semantics] relates a word with a state, stating that the word is a concatenation of words that have the semantic values stored in the stack. **)
Inductive word_has_stack_semantics:
forall (word:list token) (stack:stack), Prop :=
| Nil_stack_whss: word_has_stack_semantics [] []
| Cons_stack_whss:
forall (wordq:list token) (stackq:stack),
word_has_stack_semantics wordq stackq ->
forall (wordt:list token) (s:noninitstate)
(semantic_valuet:_),
inhabited (parse_tree (last_symb_of_non_init_state s) wordt semantic_valuet) ->
word_has_stack_semantics
(wordq++wordt) (existT noninitstate_type s semantic_valuet::stackq).

(** [pop] preserves the invariant **)
Lemma pop_invariant:
forall (symbols_to_pop symbols_popped:list symbol)
(stack_cur:stack)
(A:Type)
(action:arrows_left (map symbol_semantic_type (rev_append symbols_to_pop symbols_popped)) A),
forall word_stack word_popped,
forall sem_popped,
word_has_stack_semantics word_stack stack_cur ->
inhabited (parse_tree_list symbols_popped word_popped sem_popped) ->
let action' := eq_rect _ (fun x=>x) action _ (pop_invariant_converter _ _ _) in
match pop symbols_to_pop stack_cur (uncurry action' sem_popped) with
| OK (stack_new, sem) =>
exists word1res word2res sem_full,
(word_stack = word1res ++ word2res)%list /\
word_has_stack_semantics word1res stack_new /\
sem = uncurry action sem_full /\
inhabited (
parse_tree_list (rev_append symbols_to_pop symbols_popped) (word2res++word_popped) sem_full)
| Err => True
end.