(* *********************************************************************)
(*                                                                     *)
(*              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 Automaton.
Module Make(Import A:Automaton.T).
(** We instantiate some sets/map. **)
Module TerminalComparableM <: ComparableM.
Definition t := terminal.
Instance tComparable : Comparable t := _.
End TerminalComparableM.
Module TerminalOrderedType := OrderedType_from_ComparableM TerminalComparableM.
Module StateProdPosComparableM <: ComparableM.
Definition t := (state*production*nat)%type.
Instance tComparable : Comparable t := _.
End StateProdPosComparableM.
Module StateProdPosOrderedType :=
OrderedType_from_ComparableM StateProdPosComparableM.
Module TerminalSet := FSetAVL.Make TerminalOrderedType.
Module StateProdPosMap := FMapAVL.Make StateProdPosOrderedType.
(** Nullable predicate for symbols and list of symbols. **)
Definition nullable_symb (symbol:symbol) :=
match symbol with
| NT nt => nullable_nterm nt
| _ => false
end.
Definition nullable_word (word:list symbol) :=
forallb nullable_symb word.
(** First predicate for non terminal, symbols and list of symbols, given as FSets. **)
Definition first_nterm_set (nterm:nonterminal) :=
fold_left (fun acc t => TerminalSet.add t acc)
(first_nterm nterm) TerminalSet.empty.
Definition first_symb_set (symbol:symbol) :=
match symbol with
| NT nt => first_nterm_set nt
| T t => TerminalSet.singleton t
end.
Fixpoint first_word_set (word:list symbol) :=
match word with
| [] => TerminalSet.empty
| t::q =>
if nullable_symb t then
TerminalSet.union (first_symb_set t) (first_word_set q)
else
first_symb_set t
end.
(** Small helper for finding the part of an item that is after the dot. **)
Definition future_of_prod prod dot_pos : list symbol :=
(fix loop n lst :=
match n with
| O => lst
| S x => match loop x lst with [] => [] | _::q => q end
end)
dot_pos (rev' (prod_rhs_rev prod)).
(** We build a fast map to store all the items of all the states. **)
Definition items_map (_:unit): StateProdPosMap.t TerminalSet.t :=
fold_left (fun acc state =>
fold_left (fun acc item =>
let key := (state, prod_item item, dot_pos_item item) in
let data := fold_left (fun acc t => TerminalSet.add t acc)
(lookaheads_item item) TerminalSet.empty
in
let old :=
match StateProdPosMap.find key acc with
| Some x => x | None => TerminalSet.empty
end
in
StateProdPosMap.add key (TerminalSet.union data old) acc
) (items_of_state state) acc
) all_list (StateProdPosMap.empty TerminalSet.t).
(** Accessor. **)
Definition find_items_map items_map state prod dot_pos : TerminalSet.t :=
match StateProdPosMap.find (state, prod, dot_pos) items_map with
| None => TerminalSet.empty
| Some x => x
end.
Definition state_has_future state prod (fut:list symbol) (lookahead:terminal) :=
exists dot_pos:nat,
fut = future_of_prod prod dot_pos /\
TerminalSet.In lookahead (find_items_map (items_map ()) state prod dot_pos).
(** Iterator over items. **)
Definition forallb_items items_map (P:state -> production -> nat -> TerminalSet.t -> bool): bool:=
StateProdPosMap.fold (fun key set acc =>
match key with (st, p, pos) => (acc && P st p pos set)%bool end
) items_map true.

(* Specifications: *)
Lemma forallb_items_spec :
forall p, forallb_items (items_map ()) p = true ->
forall st prod fut lookahead, state_has_future st prod fut lookahead ->
forall P:state -> production -> list symbol -> terminal -> Prop,
(forall st prod pos set lookahead,
TerminalSet.In lookahead set -> p st prod pos set = true ->
P st prod (future_of_prod prod pos) lookahead) ->
P st prod fut lookahead.