(* *********************************************************************)
(*                                                                     *)
(*              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).

(* Specifications: *)
Lemma pop_invariant_converter:
forall A symbols_to_pop symbols_popped,
arrows_left (map symbol_semantic_type (rev_append symbols_to_pop symbols_popped)) A =
arrows_left (map symbol_semantic_type symbols_popped)
(arrows_right A (map symbol_semantic_type symbols_to_pop)).
(** [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.
(** [reduce_step] preserves the invariant **)
Lemma reduce_step_invariant (stack:stack) (prod:production):
forall word buffer, word_has_stack_semantics word stack ->
match reduce_step init stack prod buffer with
| OK (Accept_sr sem buffer_new) =>
buffer = buffer_new /\
inhabited (parse_tree (NT (start_nt init)) word sem)
| OK (Progress_sr stack_new buffer_new) =>
buffer = buffer_new /\
word_has_stack_semantics word stack_new
| Err | OK Fail_sr => True
end.