(** * Every parse tree has a corresponding minimal parse tree *)
Require Import Coq.Strings.String Coq.Lists.List Coq.Program.Program Coq.Classes.RelationClasses Coq.Classes.Morphisms Coq.Setoids.Setoid Coq.Arith.Compare_dec.
Require Import Coq.omega.Omega.
Require Import Coq.Program.Wf Coq.Arith.Wf_nat.
Require Import Fiat.Parsers.ContextFreeGrammar.Core Fiat.Parsers.ContextFreeGrammar.Properties Fiat.Parsers.WellFoundedParse.
Require Import Fiat.Parsers.CorrectnessBaseTypes Fiat.Parsers.BaseTypes.
Require Import Fiat.Parsers.StringLike.Properties.
Require Import Fiat.Parsers.BaseTypesLemmas.
Require Export Fiat.Parsers.MinimalParse.
Require Export Fiat.Parsers.WellFoundedParseProperties.
Require Import Fiat.Common Fiat.Common.Le Fiat.Common.Wf.

Set Implicit Arguments.
Local Open Scope string_like_scope.

Local Notation "f ∘ g" := (fun x => f (g x)).

Section cfg.
  Context {Char} {HSLM : StringLikeMin Char} {HSL : StringLike Char} {HSLP : StringLikeProperties Char} {G : grammar Char}.
  Context {predata : @parser_computational_predataT Char}
          {rdata' : @parser_removal_dataT' _ G predata}.
  Context (nonterminals_listT_R_respectful : forall x y,
                                        sub_nonterminals_listT x y
                                        -> x <> y
                                        -> nonterminals_listT_R x y).

  Lemma strle_from_min_parse_of_production {len0 valid strs pats}
        (p1 : minimal_parse_of_production (G := G) len0 valid strs pats)
  : length strs <= len0.
  Proof.
    destruct p1; omega.
  Qed.

  Definition parse_of_item_nonterminal__of__minimal_parse_of_nonterminal'
             (parse_of__of__minimal_parse_of
              : forall len0 valid str prods,
                  minimal_parse_of (G := G) len0 valid str prods
                  -> parse_of G str prods)
             {len0 valid str nonterminal} (p : minimal_parse_of_nonterminal (G := G) len0 valid str nonterminal)
  : parse_of_item G str (NonTerminal nonterminal)
    := let p'
           := (@parse_of__of__minimal_parse_of
                 _ _ _ _
                 (match p as p in (@MinimalParse.minimal_parse_of_nonterminal _ _ _ _ _ len0 valid str nonterminal)
                        return minimal_parse_of (match p with
                                                   | MinParseNonTerminalStrLt _ _ _ _ _ _ _ => _
                                                   | MinParseNonTerminalStrEq _ _ _ _ _ _ _ _ => _
                                                 end)
                                                (match p with
                                                   | MinParseNonTerminalStrLt _ _ _ _ _ _ _ => _
                                                   | MinParseNonTerminalStrEq _ _ _ _ _ _ _ _ => _
                                                 end)
                                                str (Lookup G nonterminal) with
                    | MinParseNonTerminalStrLt len0 valid nonterminal str pf pf' p' => p'
                    | MinParseNonTerminalStrEq len0 str valid nonterminal pf H H' p' => p'
                  end)) in
       let pf := (match p in (@MinimalParse.minimal_parse_of_nonterminal _ _ _ _ _ len0 valid str nonterminal)
                        return (is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal))
                  with
                    | MinParseNonTerminalStrLt _ _ _ _ _ pf _ => pf
                    | MinParseNonTerminalStrEq _ _ _ _ _ pf _ _ => pf
                  end) in
       (ParseNonTerminal
          nonterminal
          (proj1 (initial_nonterminals_correct _) pf)
          p').

  Definition parse_of_item__of__minimal_parse_of_item'
             (parse_of__of__minimal_parse_of
              : forall len0 valid str prods,
                  minimal_parse_of (G := G) len0 valid str prods
                  -> parse_of G str prods)
             {len0 valid str it} (p : minimal_parse_of_item (G := G) len0 valid str it)
  : parse_of_item G str it
    := match p in (MinimalParse.minimal_parse_of_item len0 valid str it)
             return parse_of_item G str it
       with
         | MinParseTerminal len0 valid str ch P pf1 pf2
           => ParseTerminal G str ch P pf1 pf2
         | MinParseNonTerminal len0 valid _ _ p'
           => @parse_of_item_nonterminal__of__minimal_parse_of_nonterminal' (@parse_of__of__minimal_parse_of) _ _ _ _ p'
       end.

  Fixpoint parse_of__of__minimal_parse_of {len0 valid str pats} (p : minimal_parse_of (G := G) len0 valid str pats)
  : parse_of G str pats
    := match p with
         | MinParseHead len0 valid str pat pats p'
           => let p'' := (parse_of_production__of__minimal_parse_of_production p') in
              ParseHead pats p''
         | MinParseTail len0 valid str pat pats p'
           => let p'' := (parse_of__of__minimal_parse_of p') in
              ParseTail pat p''
       end
  with parse_of_production__of__minimal_parse_of_production {len0 valid str pat} (p : minimal_parse_of_production (G := G) len0 valid str pat)
       : parse_of_production G str pat
       := match p with
            | MinParseProductionNil len0 valid str pf
              => ParseProductionNil _ _ pf
            | MinParseProductionCons len0 valid str strs pat pats pf p' p''
              => let p0 := (parse_of_item__of__minimal_parse_of_item' (@parse_of__of__minimal_parse_of) p') in
                 let p1 := (parse_of_production__of__minimal_parse_of_production p'') in
                 ParseProductionCons _ _ p0 p1
          end.

  Definition parse_of_item_nonterminal__of__minimal_parse_of_nonterminal
  : forall {len0 valid str nonterminal} (p : minimal_parse_of_nonterminal (G := G) len0 valid str nonterminal),
      parse_of_item G str (NonTerminal nonterminal)
    := @parse_of_item_nonterminal__of__minimal_parse_of_nonterminal' (@parse_of__of__minimal_parse_of).

  Definition parse_of_item__of__minimal_parse_of_item
  : forall {len0 valid str it},
      minimal_parse_of_item (G := G) len0 valid str it
      -> parse_of_item G str it
    := @parse_of_item__of__minimal_parse_of_item' (@parse_of__of__minimal_parse_of).

  (** Re-add this so rewrite works *)
  Global Add Parametric Morphism : remove_nonterminal
  with signature sub_nonterminals_listT ==> eq ==> sub_nonterminals_listT
    as remove_nonterminal_mor.
  Proof.
    intros; apply (@remove_nonterminal_mor _ G); try assumption; reflexivity.
  Qed.

  Local Ltac clear_not_beq
    := repeat match goal with
                | [ H : ?T |- _ ]
                  => match T with
                       | beq _ _ => fail 1
                       | _ < _ => fail 1
                       | _ ≤s _ => fail 1
                       | _ = _ => fail 1
                       | _ <= _ => fail 1
                       | _ ~= [ _ ] => fail 1
                       | StringLikeProperties _ => fail 1
                       | _ => clear H
                     end
              end.

  Local Ltac solve_by_subst tac :=
    repeat subst;
    match goal with
      | [ |- beq _ _ ] => idtac
      | [ |- beq _ _ \/ _ ] => idtac
      | [ |- _ \/ beq _ _ ] => idtac
      | [ |- _ = _ \/ _ ] => idtac
      | [ |- _ \/ _ = _ ] => idtac
      | [ |- _ < _ ] => idtac
      | [ |- _ <= _ ] => idtac
      | [ |- _ = _ ] => idtac
      | [ |- _ ≤s _ ] => idtac
      | [ |- False ] => idtac
    end;
    clear_not_beq;
    repeat match goal with
             | [ H : @beq ?string ?SLM ?SL _ _ |- _ ] => setoid_subst_rel (@beq string SLM SL)
           end;
    solve [ assumption | reflexivity | left; reflexivity | right; reflexivity | tac ].

  Section expand.
    Local Notation Hlen0T len0 len0' str str'
      := (len0 <= len0'
          \/ (length str < len0 /\ length str' < len0')
          \/ (length str = len0%nat /\ length str' = len0'%nat)) (only parsing).

    Definition expand_minimal_parse_of_nonterminal'
               (expand_minimal_parse_of
                : forall {len0 len0' valid valid' str str' prods}
                         (Hlen0 : Hlen0T len0 len0' str str')
                         (H : sub_nonterminals_listT valid valid')
                         (Hinit : len0 = len0' \/ sub_nonterminals_listT valid' initial_nonterminals_data)
                         (Hstr : str =s str')
                         (p : minimal_parse_of (G := G) len0 valid str prods),
                    minimal_parse_of (G := G) len0' valid' str' prods)
               {len0 len0' valid valid' str str' nonterminal}
               (Hlen0 : Hlen0T len0 len0' str str')
               (H : sub_nonterminals_listT valid valid')
               (Hinit : len0 = len0' \/ sub_nonterminals_listT valid' initial_nonterminals_data)
               (Hstr : str =s str')
               (p : minimal_parse_of_nonterminal (G := G) len0 valid str nonterminal)
    : minimal_parse_of_nonterminal (G := G) len0' valid' str' nonterminal.
    Proof.
      destruct p;
      first [ apply MinParseNonTerminalStrLt;
              destruct_head or;
              destruct_head and; repeat subst;
              solve [ rewrite <- Hstr; omega
                    | assumption
                    | eapply expand_minimal_parse_of; [ .. | eassumption ];
                      solve [ reflexivity
                            | left; rewrite Hstr; reflexivity
                            | rewrite Hstr; reflexivity ] ]
            | idtac ];
      [].
      { destruct (lt_eq_lt_dec len0 len0') as [[Hlen0'|Hlen0']|Hlen0'];
        [ apply MinParseNonTerminalStrLt
        | apply MinParseNonTerminalStrEq
        | destruct (lt_eq_lt_dec (length str') len0') as [[Hlen0''|Hlen0'']|Hlen0''];
          [ apply MinParseNonTerminalStrLt
          | apply MinParseNonTerminalStrEq
          | exfalso ] ];
        solve [ assumption
              | apply H; assumption
              | solve_by_subst idtac
              | eapply expand_minimal_parse_of; [ .. | eassumption ];
                solve [ reflexivity
                      | rewrite !H;
                        eauto using sub_nonterminals_listT_remove;
                        reflexivity
                      | solve_by_subst idtac
                      | destruct Hinit as [Hinit|Hinit];
                        [ exfalso; clear_not_beq; setoid_subst_rel beq; omega
                        | ];
                        rewrite ?H, !Hinit;
                        eauto using sub_nonterminals_listT_remove;
                        reflexivity
                      | destruct_head or; destruct_head and; repeat subst; omega ]
              | destruct_head or; destruct_head and; repeat subst; omega
              | setoid_subst_rel beq; subst; assumption ]. }
    Defined.

    Definition expand_minimal_parse_of_item'
               (expand_minimal_parse_of
                : forall {len0 len0' valid valid' str str' prods}
                         (Hlen0 : Hlen0T len0 len0' str str')
                         (H : sub_nonterminals_listT valid valid')
                         (Hinit : len0 = len0' \/ sub_nonterminals_listT valid' initial_nonterminals_data)
                         (Hstr : str =s str')
                         (p : minimal_parse_of (G := G) len0 valid str prods),
                    minimal_parse_of (G := G) len0' valid' str' prods)
               {len0 len0' valid valid' str str' it}
               (Hlen0 : Hlen0T len0 len0' str str')
               (H : sub_nonterminals_listT valid valid')
               (Hinit : len0 = len0' \/ sub_nonterminals_listT valid' initial_nonterminals_data)
               (Hstr : str =s str')
               (p : minimal_parse_of_item (G := G) len0 valid str it)
    : minimal_parse_of_item (G := G) len0' valid' str' it.
    Proof.
      destruct p.
      { eapply MinParseTerminal; setoid_subst_rel beq; trivial; eassumption. }
      { apply MinParseNonTerminal; [].
        eapply expand_minimal_parse_of_nonterminal'; [..| eassumption ];
        try assumption. }
    Defined.

    Lemma expand_helper_1 {len0 len0' str str'}
          (pf : length str <= len0)
          (Hlen0 : Hlen0T len0 len0' str str')
          (Hstr : str =s str')
    : length str' <= len0'.
    Proof.
      setoid_subst_rel beq.
      destruct_head or; omega.
    Qed.

    Lemma Hlen0_take {len0 len0' str str' n}
          (Hlen0 : Hlen0T len0 len0' str str')
          (Hstr : str =s str')
    : Hlen0T len0 len0' (take n str) (take n str').
    Proof.
      setoid_subst str'.
      rewrite take_length.
      apply Min.min_case_strong; omega.
    Qed.

    Lemma Hlen0_drop {len0 len0' str str' n}
          (Hlen0 : Hlen0T len0 len0' str str')
          (Hstr : str =s str')
    : Hlen0T len0 len0' (drop n str) (drop n str').
    Proof.
      setoid_subst str'.
      rewrite drop_length.
      omega.
    Qed.

    Fixpoint expand_minimal_parse_of
             {len0 len0' valid valid' str str' pats}
             (Hlen0 : Hlen0T len0 len0' str str')
             (H : sub_nonterminals_listT valid valid')
             (Hinit : len0 = len0' \/ sub_nonterminals_listT valid' initial_nonterminals_data)
             (Hstr : str =s str')
             (p : minimal_parse_of (G := G) len0 valid str pats)
    : minimal_parse_of (G := G) len0' valid' str' pats
      := match p in (MinimalParse.minimal_parse_of len0 valid str pats)
               return ((Hlen0T len0 len0' str str')
                       -> sub_nonterminals_listT valid valid'
                       -> len0 = len0' \/ sub_nonterminals_listT valid' initial_nonterminals_data
                       -> str =s str'
                       -> minimal_parse_of (G := G) len0' valid' str' pats)
         with
           | MinParseHead len0 valid str pat pats p'
             => fun Hlen0 H Hinit Hstr => MinParseHead pats (@expand_minimal_parse_of_production _ _ _ _ _ _ _ Hlen0 H Hinit Hstr p')
           | MinParseTail len0 valid str pat pats p'
             => fun Hlen0 H Hinit Hstr => MinParseTail pat (@expand_minimal_parse_of _ _ _ _ _ _ _ Hlen0 H Hinit Hstr p')
         end Hlen0 H Hinit Hstr
    with expand_minimal_parse_of_production
           {len0 len0' valid valid' str str' pat}
           (Hlen0 : Hlen0T len0 len0' str str')
           (H : sub_nonterminals_listT valid valid')
           (Hinit : len0 = len0' \/ sub_nonterminals_listT valid' initial_nonterminals_data)
           (Hstr : str =s str')
           (p : minimal_parse_of_production (G := G) len0 valid str pat)
         : minimal_parse_of_production (G := G) len0' valid' str' pat
         := match p in (MinimalParse.minimal_parse_of_production len0 valid str pats)
                  return (Hlen0T len0 len0' str str'
                          -> sub_nonterminals_listT valid valid'
                          -> len0 = len0' \/ sub_nonterminals_listT valid' initial_nonterminals_data
                          -> str =s str'
                          -> minimal_parse_of_production len0' valid' str' pats)
            with
              | MinParseProductionNil len0 valid str pf
                => fun _ _ _ Hstr => MinimalParse.MinParseProductionNil _ _ str' (transitivity (symmetry ((_ : Proper (beq ==> eq) length) _ _ Hstr))  pf)
              | MinParseProductionCons len0 valid str n pat pats pf p' p''
                => fun Hlen0 H Hinit Hstr
                   => MinParseProductionCons
                        _
                        n
                        (expand_helper_1 pf Hlen0 Hstr)
                        (expand_minimal_parse_of_item' (@expand_minimal_parse_of) (Hlen0_take Hlen0 Hstr) H Hinit ((_ : Proper (eq ==> beq ==> beq) take) _ _ eq_refl _ _ Hstr) p')
                        (@expand_minimal_parse_of_production _ _ _ _ _ _ _ (Hlen0_drop Hlen0 Hstr) H Hinit ((_ : Proper (eq ==> beq ==> beq) drop) _ _ eq_refl _ _ Hstr) p'')
            end Hlen0 H Hinit Hstr.

    Definition expand_minimal_parse_of_nonterminal
    : forall {len0 len0' valid valid' str str' nonterminal}
             (Hlen0 : Hlen0T len0 len0' str str')
             (H : sub_nonterminals_listT valid valid')
             (Hinit : len0 = len0' \/ sub_nonterminals_listT valid' initial_nonterminals_data)
             (Hstr : str =s str')
             (p : minimal_parse_of_nonterminal (G := G) len0 valid str nonterminal),
        minimal_parse_of_nonterminal (G := G) len0' valid' str' nonterminal
      := @expand_minimal_parse_of_nonterminal' (@expand_minimal_parse_of).

    Definition expand_minimal_parse_of_item
    : forall {len0 len0' valid valid' str str' it}
             (Hlen0 : Hlen0T len0 len0' str str')
             (H : sub_nonterminals_listT valid valid')
             (Hinit : len0 = len0' \/ sub_nonterminals_listT valid' initial_nonterminals_data)
             (Hstr : str =s str')
             (p : minimal_parse_of_item (G := G) len0 valid str it),
        minimal_parse_of_item (G := G) len0' valid' str' it
      := @expand_minimal_parse_of_item' (@expand_minimal_parse_of).
  End expand.

  Section expand_beq.
    Definition expand_minimal_parse_of_beq
             {len0 valid str str' pats}
             (Hstr : str =s str')
             (p : minimal_parse_of (G := G) len0 valid str pats)
    : minimal_parse_of (G := G) len0 valid str' pats.
    Proof.
      eapply expand_minimal_parse_of; try (eassumption || reflexivity || left; reflexivity).
    Defined.

    Definition expand_minimal_parse_of_production_beq
               {len0 valid str str' pat}
               (Hstr : str =s str')
               (p : minimal_parse_of_production (G := G) len0 valid str pat)
    : minimal_parse_of_production (G := G) len0 valid str' pat.
    Proof.
      eapply expand_minimal_parse_of_production; try (eassumption || reflexivity || left; reflexivity).
    Defined.

    Definition expand_minimal_parse_of_nonterminal_beq
               {len0 valid str str' nonterminal}
               (Hstr : str =s str')
               (p : minimal_parse_of_nonterminal (G := G) len0 valid str nonterminal)
    : minimal_parse_of_nonterminal (G := G) len0 valid str' nonterminal.
    Proof.
      eapply expand_minimal_parse_of_nonterminal; try (eassumption || reflexivity || left; reflexivity).
    Defined.

    Definition expand_minimal_parse_of_item_beq
               {len0 valid str str' it}
               (Hstr : str =s str')
               (p : minimal_parse_of_item (G := G) len0 valid str it)
    : minimal_parse_of_item (G := G) len0 valid str' it.
    Proof.
      eapply expand_minimal_parse_of_item; try (eassumption || reflexivity || left; reflexivity).
    Defined.
  End expand_beq.

  Section contract.
    Local Hint Constructors MinimalParse.minimal_parse_of_nonterminal.

    Definition contract_minimal_parse_of_nonterminal_lt
               {len0 str valid valid' nonterminal}
               (Hlt : length str < len0)
               (p : minimal_parse_of_nonterminal (G := G) len0 valid str nonterminal)
    : minimal_parse_of_nonterminal (G := G) len0 valid' str nonterminal.
    Proof.
      destruct p.
      { constructor (assumption). }
      { exfalso; clear_not_beq; setoid_subst_rel beq; omega. }
    Defined.

    Definition contract_minimal_parse_of_item_lt
               {len0 str valid valid' it}
               (Hlt : length str < len0)
               (p : minimal_parse_of_item (G := G) len0 valid str it)
    : minimal_parse_of_item (G := G) len0 valid' str it.
    Proof.
      destruct p as [p|p].
      { econstructor; trivial; eassumption. }
      { constructor (eapply contract_minimal_parse_of_nonterminal_lt; eassumption). }
    Defined.

    Definition contract_minimal_parse_of_production_lt
               {len0 str valid valid' pat}
               (Hlt : length str < len0)
               (p : minimal_parse_of_production (G := G) len0 valid str pat)
    : minimal_parse_of_production (G := G) len0 valid' str pat.
    Proof.
      induction p.
      { constructor; trivial. }
      { apply (MinParseProductionCons _ n); trivial;
        try first [ eapply contract_minimal_parse_of_item_lt; try eassumption
                  | eapply IHp; try eassumption
                  | assumption ];
        clear -Hlt HSLP;
        abstract (rewrite ?str_le_take, ?str_le_drop; assumption). }
    Defined.

    Definition contract_minimal_parse_of_lt
               {len0 str valid valid' pats}
               (Hlt : length str < len0)
               (p : minimal_parse_of (G := G) len0 valid str pats)
    : minimal_parse_of (G := G) len0 valid' str pats.
    Proof.
      induction p.
      { constructor (eapply contract_minimal_parse_of_production_lt; eassumption). }
      { constructor (eapply IHp; assumption). }
    Defined.

    Section contract_eq.
      Lemma parse_of_contract_minimal_parse_of_item_lt
            {len0} {str : String} {valid valid' : nonterminals_listT}
            {Hlt : length str < len0}
            {it}
            (p : minimal_parse_of_item (G := G) len0 valid str it)
      : parse_of_item__of__minimal_parse_of_item
          (contract_minimal_parse_of_item_lt (valid' := valid') Hlt p)
        = parse_of_item__of__minimal_parse_of_item p.
      Proof.
        destruct_head @MinimalParse.minimal_parse_of_item; simpl; try reflexivity.
        destruct_head @MinimalParse.minimal_parse_of_nonterminal; try reflexivity.
        unfold False_rect.
        match goal with
          | [ |- appcontext[match ?e with end] ] => destruct e
        end.
      Qed.

      Lemma parse_of_contract_minimal_parse_of_production_lt
            {len0} {str : String} {valid valid' : nonterminals_listT}
            {Hlt : length str < len0}
            {pat}
            (p : minimal_parse_of_production (G := G) len0 valid str pat)
      : parse_of_production__of__minimal_parse_of_production
          (contract_minimal_parse_of_production_lt (valid' := valid') Hlt p)
        = parse_of_production__of__minimal_parse_of_production p.
      Proof.
        induction p; simpl; try reflexivity.
        rewrite IHp, parse_of_contract_minimal_parse_of_item_lt.
        reflexivity.
      Qed.

      Lemma parse_of_contract_minimal_parse_of_lt
            {len0} {str : String} {valid valid' : nonterminals_listT}
            {Hlt : length str < len0}
            {pats}
            (p : minimal_parse_of (G := G) len0 valid str pats)
      : parse_of__of__minimal_parse_of
          (contract_minimal_parse_of_lt (valid' := valid') Hlt p)
        = parse_of__of__minimal_parse_of p.
      Proof.
        induction p; simpl;
        progress rewrite ?IHp, ?parse_of_contract_minimal_parse_of_production_lt;
        reflexivity.
      Qed.
    End contract_eq.
  End contract.

  Section minimize.
    Let alt_option h valid str
      := { nonterminal : _ & (is_valid_nonterminal valid (of_nonterminal nonterminal) = false /\ is_valid_nonterminal initial_nonterminals_data (of_nonterminal nonterminal))
                      * { p : parse_of G str (Lookup G nonterminal)
                        | size_of_parse p < h } }%type.

    Lemma not_alt_all {h str} (ps : alt_option h initial_nonterminals_data str)
    : False.
    Proof.
      destruct ps as [ ? [ H' _ ] ].
      revert H'; clear; intros [? ?].
      congruence.
    Qed.

    Definition alt_all_elim {h str T} (ps : T + alt_option h initial_nonterminals_data str)
    : T.
    Proof.
      destruct ps as [|ps]; [ assumption | exfalso ].
      eapply not_alt_all; eassumption.
    Defined.

    Definition expand_alt_option' {h h' str str' valid valid'}
               (H : h <= h') (H' : sub_nonterminals_listT valid' valid) (H'' : str =s str')
    : alt_option h valid str -> alt_option h' valid' str'.
    Proof.
      hnf in H'; unfold alt_option.
      repeat match goal with
               | [ |- sigT _ -> _ ] => intros_destruct
               | [ |- sig _ -> _ ] => intros_destruct
               | [ |- prod _ _ -> _ ] => intros_destruct
               | [ |- and _ _ -> _ ] => intros_destruct
               | _ => intro
               | _ => progress subst
               | _ => rewrite <- size_of_parse_respectful
               | [ H : beq ?str ?str', p : parse_of ?G ?str ?n
                   |- { p' : parse_of ?G ?str' ?n | _ } ]
                 => exists (parse_of_respectful H (reflexivity _) p)
               | [ |- sigT _ ] => esplit
               | [ |- prod _ _ ] => split
               | [ |- and _ _ ] => split
               | [ H : _ = false |- _ = false ]
                 => apply Bool.not_true_iff_false in H;
                   apply Bool.not_true_iff_false;
                   intro; apply H
               | _ => eapply H'; eassumption
               | _ => assumption
               | [ |- _ < _ ] => eapply Lt.lt_trans; eassumption
               | [ |- _ < _ ] => eapply Lt.lt_le_trans; eassumption
             end.
    Defined.

    Definition expand_alt_option {h h' str str' valid valid'}
               (H : h < h') (H' : sub_nonterminals_listT valid' valid) (H'' : str =s str')
    : alt_option h valid str -> alt_option h' valid' str'.
    Proof.
      apply expand_alt_option'; try assumption.
      apply Lt.lt_le_weak; assumption.
    Defined.

    Section wf_parts.
      Let of_parse_item_T' h
          {len0} {str : String} (pf : length str <= len0)
          (valid : nonterminals_listT) {it : item Char}
          (p : parse_of_item G str it)
        := forall (p_small : size_of_parse_item p < h),
             sub_nonterminals_listT valid initial_nonterminals_data
             -> ({ p' : minimal_parse_of_item (G := G) len0 valid str it
                 | size_of_parse_item (parse_of_item__of__minimal_parse_of_item p') <= size_of_parse_item p })%type
                + alt_option (size_of_parse_item p) valid str.

      Let of_parse_item_T len0 h
        := forall str pf valid it p, @of_parse_item_T' h len0 str pf valid it p.

      Let of_parse_production_T' h
          {len0} {str : String} (pf : length str <= len0)
          (valid : nonterminals_listT) {pat : production Char}
          (p : parse_of_production G str pat)
        := forall (p_small : size_of_parse_production p < h),
             sub_nonterminals_listT valid initial_nonterminals_data
             -> ({ p' : minimal_parse_of_production (G := G) len0 valid str pat
                 | size_of_parse_production (parse_of_production__of__minimal_parse_of_production p') <= size_of_parse_production p })%type
                + alt_option (size_of_parse_production p) valid str.

      Let of_parse_production_T len0 h
        := forall str pf valid pat p, @of_parse_production_T' h len0 str pf valid pat p.

      Let of_parse_T' h
          {len0} {str : String} (pf : length str <= len0)
          (valid : nonterminals_listT) {pats : productions Char}
          (p : parse_of G str pats)
        := forall (p_small : size_of_parse p < h),
             sub_nonterminals_listT valid initial_nonterminals_data
             -> ({ p' : minimal_parse_of (G := G) len0 valid str pats
                 | (size_of_parse (parse_of__of__minimal_parse_of p') <= size_of_parse p) })%type
                + alt_option (size_of_parse p) valid str.

      Let of_parse_T len0 h
        := forall str pf valid pats p, @of_parse_T' h len0 str pf valid pats p.

      Let of_parse_nonterminal_T {len0 str valid nonterminal} (p : parse_of G str (Lookup G nonterminal)) h
        := forall Hvalid : List.In nonterminal (Valid_nonterminals G),
             size_of_parse_item (ParseNonTerminal _ Hvalid p) < h
             -> length str <= len0
             -> sub_nonterminals_listT valid initial_nonterminals_data
             -> ({ p' : minimal_parse_of_nonterminal (G := G) len0 valid str nonterminal
                 | size_of_parse_item (parse_of_item__of__minimal_parse_of_item (MinParseNonTerminal p')) <= size_of_parse_item (ParseNonTerminal _ Hvalid p) })%type
                + alt_option (size_of_parse_item (ParseNonTerminal _ Hvalid p)) valid str.

      Section item.
        Context {len0 : nat} {str : String} {valid : nonterminals_listT}.

        Definition minimal_parse_of_item__of__parse_of_item'
                   h
                   (minimal_parse_of_nonterminal__of__parse_of_nonterminal
                    : forall h' (pf : h' < S (S h)) {len0 str valid nonterminal}
                             (p : parse_of G str (Lookup G nonterminal)),
                        @of_parse_nonterminal_T len0 str valid nonterminal p h')
        : of_parse_item_T len0 h.
        Proof.
          intros str' pf valid' pats p H_h Hinit'.
          destruct h as [|h']; [ exfalso; omega | ].
          destruct p as [ ch P pf0 pf0' |nonterminal' ? p'].
          { left.
            eexists (MinimalParse.MinParseTerminal _ _ _ _ _ pf0 pf0');
              simpl; constructor. }
          { edestruct (fun pf => @minimal_parse_of_nonterminal__of__parse_of_nonterminal (S h') pf len0 _ valid' _ p') as [ [p'' H''] | p'' ];
            try solve [ repeat (apply Lt.lt_n_Sn || apply Lt.lt_S)
                      | exact Hinit'
                      | exact H_h
                      | exact H_forall
                      | exact pf ];
            [|];
            [ left | right ].
            { exists (MinParseNonTerminal p'').
              simpl in *.
              exact H''. }
            { exact p''. } }
        Defined.
      End item.

      Section production.
        Context {len0 : nat} {str : String} {valid : nonterminals_listT}.

        Local Ltac min_parse_prod_t' :=
          idtac;
          match goal with
            | _ => assumption
            | [ |- ?R ?x ?x ]
              => reflexivity
            | _ => progress destruct_head prod
            | [ H : False |- _ ]
              => solve [ destruct H ]
            | _ => progress simpl
            | _ => progress subst
            | _ => progress rewrite ?parse_of_contract_minimal_parse_of_item_lt, ?parse_of_contract_minimal_parse_of_production_lt, ?parse_of_contract_minimal_parse_of_lt
            | [ |- context G[size_of_parse_production (ParseProductionCons ?s ?n ?a ?b)] ]
              => let G' := context G[S (size_of_parse_item a + size_of_parse_production b)] in
                 change G'
            | [ H : alt_option _ initial_nonterminals_data _ |- _ ]
              => apply not_alt_all in H
            | [ p0 : minimal_parse_of_item ?ns' ?v (take ?n ?s) ?pat,
                     p1 : minimal_parse_of_production ?ns' ?v (drop ?n ?s) ?pats,
                          H : length ?s <= ?ns'
                |- ({ p' : minimal_parse_of_production ?ns' ?v ?s (?pat :: ?pats) | _ } + _)%type ]
              => left; exists (MinParseProductionCons _ n H p0 p1)
            | [ p0 : minimal_parse_of_item ?ns' _ (take ?n ?s) ?pat,
                     p1 : minimal_parse_of_production ?ns' ?v (drop ?n ?s) ?pats,
                          H : length ?s <= ?ns'
                |- ({ p' : minimal_parse_of_production ?ns' ?v ?s (?pat :: ?pats) | _ } + _)%type ]
              => let H' := fresh in
                 assert (H' : length (take n s) < ns')
                   by (rewrite <- H, ?take_short_length by omega; omega);
                   left; exists (MinParseProductionCons
                                   _
                                   n
                                   H
                                   (contract_minimal_parse_of_item_lt (valid' := v) H' p0)
                                   p1)
            | [ p0 : minimal_parse_of_item ?ns' ?v (take ?n ?s) ?pat,
                     p1 : minimal_parse_of_production ?ns' _ (drop ?n ?s) ?pats,
                          H : length ?s <= ?ns'
                |- ({ p' : minimal_parse_of_production ?ns' ?v ?s (?pat :: ?pats) | _ } + _)%type ]
              => let H' := fresh in
                 assert (H' : length (drop n s) < ns')
                   by (rewrite <- H, drop_length; omega);
                   left; exists (MinParseProductionCons
                                   _
                                   n
                                   H
                                   p0
                                   (contract_minimal_parse_of_production_lt (valid' := v) H' p1))
            | [ p0 : minimal_parse_of_item ?ns' _ (take ?n ?s) ?pat,
                     p1 : minimal_parse_of_production ?ns' _ (drop ?n ?s) ?pats,
                          H : length ?s <= ?ns',
                              H' : ?n < length ?s,
                                   H'' : 0 < ?n
                |- ({ p' : minimal_parse_of_production ?ns' ?v ?s (?pat :: ?pats) | _ } + _)%type ]
              => let H0' := fresh in
                 let H1' := fresh in
                 assert (H1' : length (drop n s) < ns')
                   by (rewrite <- H, drop_length; omega);
                   assert (H0' : length (take n s) < ns')
                   by (rewrite <- H, ?take_short_length by omega; omega);
                   left; eexists (MinParseProductionCons
                                    _
                                    n
                                    H
                                    (contract_minimal_parse_of_item_lt (valid' := v) H0' p0)
                                    (contract_minimal_parse_of_production_lt (valid' := v) H1' p1))
            | [ |- (_ * _)%type ]
              => split
            | [ H : _ <= _ |- _ <= _ ] => apply H
            | _ => apply Le.le_n_S
            | _ => apply Plus.plus_le_compat
            | [ H0 : Forall_parse_of_item _ _,
                     H1 : Forall_parse_of_production _ _
                |- Forall_parse_of_production _ _ ]
              => exact (H0, H1)
            | [ H : alt_option _ ?v (drop 0 ?x)
                |- (_ + alt_option _ ?v ?x)%type ]
              => right; eapply expand_alt_option'; [ .. | exact H ]
            | [ H : alt_option _ ?v (drop ?n ?x), H' : length ?x <= ?n
                |- (_ + alt_option _ ?v ?x)%type ]
              => right; eapply expand_alt_option'; [ .. | exact H ]
            | [ H : alt_option _ ?v (take ?n ?x), H' : length ?x = ?n
                |- (_ + alt_option _ ?v ?x)%type ]
              => right; eapply expand_alt_option'; [ .. | exact H ]
            | [ H : alt_option _ ?v (take ?n ?x), H' : length ?x <= ?n
                |- (_ + alt_option _ ?v ?x)%type ]
              => right; eapply expand_alt_option'; [ .. | exact H ]
            | [ H : length ?s = 0 |- beq _ ?s ] => apply bool_eq_empty
            | [ H : length ?s = 0 |- beq ?s _ ] => apply bool_eq_empty
            | _ => rewrite take_short_length by assumption
            | _ => rewrite take_long by assumption
            | [ H : context[min _ _] |- _ ] => rewrite min_l in H by assumption
            | [ H : context[min _ _] |- _ ] => rewrite min_r in H by assumption
            | [ H : context[min _ _] |- _ ] => rewrite min_l in H by omega
            | [ H : context[min _ _] |- _ ] => rewrite min_r in H by omega
            | _ => rewrite drop_length
            | _
              => solve [ eauto using le_S, Le.le_trans, Plus.le_plus_l, Plus.le_plus_r, drop_0, take_long, NPeano.Nat.eq_le_incl, bool_eq_empty, drop_length, (fun x y => proj2 (NPeano.Nat.sub_0_le x y)) with nocore ]
          end.
        Local Ltac min_parse_prod_t := repeat min_parse_prod_t'.

        (** This is the proof where we pay the proof for conceptual
            mismatch.  We are, conceptually, simultaneously
            "minimizing parse trees" and "producing parse traces".  It
            is marginally nicer(!!) to contain the ugliness in this
            single proof, rather than have it infect everything.  So
            we must conceptually minimize the passed parse tree while
            in fact building a trace of the parse algorithm.  To do
            this, in the cons case, we need to figure out how we're
            decreasing.  According with conceptual minimization, when
            we have parsed [s0 ++ s1] as a cons of [p0] and [p1],
            having a smaller parse tree for, say [s0], with any other
            pattern, does us no good, unless [s1] is empty (and [s0 =
            s0 ++ s1]), when we can simply pass that smaller parse up
            the function call tree.  So we must eliminate the
            "alternate" option, by expanding the valid list to the
            initial data.  Luckily(?!), in the case where [s1] is
            non-empty, [s0] is strictly smaller than [s0 ++ s1], and
            thus we can rebuild the minimal parse tree to contract it.
            This, finally, allows us to either build a minimal parse
            tree for the thing we are asked about (or to contract the
            "alternate option" parse tree, passing it back up?). *)

        Fixpoint minimal_parse_of_production__of__parse_of_production'
                 h
                 (minimal_parse_of_nonterminal__of__parse_of_nonterminal
                  : forall h' (pf : h' < S (S h)) {len0 str valid nonterminal}
                           (p : parse_of G str (Lookup G nonterminal)),
                      @of_parse_nonterminal_T len0 str valid nonterminal p h')
                 {struct h}
        : of_parse_production_T len0 h.
        Proof.
          intros str' pf valid' pats p H_h Hinit'.
          destruct h as [|h']; [ exfalso; omega | ].
          destruct p as [ pf0' | n pat' pats' p0' p1' ].
          { clear minimal_parse_of_production__of__parse_of_production'.
            left.
            eexists (@MinimalParse.MinParseProductionNil _ _ _ _ _ _ _ _ pf0');
              repeat (reflexivity || esplit). }
          { specialize (fun h' pf
                        => @minimal_parse_of_nonterminal__of__parse_of_nonterminal
                             h' (transitivity pf (Lt.lt_n_Sn _))).
            change (S ((size_of_parse_item p0')
                       + (size_of_parse_production p1'))
                    < S h') in H_h.
            apply Lt.lt_S_n in H_h.
            pose proof (Lt.le_lt_trans _ _ _ (Plus.le_plus_l _ _) H_h) as H_h0.
            pose proof (Lt.le_lt_trans _ _ _ (Plus.le_plus_r _ _) H_h) as H_h1.
            clear H_h.
            assert (pf0' : length (take n str') <= length str')
              by (rewrite take_length; apply Min.min_case_strong; omega).
            assert (pf1' : length (drop n str') <= length str')
              by (rewrite drop_length; omega).
            pose proof (fun valid Hinit => @minimal_parse_of_item__of__parse_of_item' _ h'  minimal_parse_of_nonterminal__of__parse_of_nonterminal _ (transitivity pf0' pf) valid _ p0' H_h0 Hinit) as p_it.
            pose proof (fun valid Hinit => @minimal_parse_of_production__of__parse_of_production' h' minimal_parse_of_nonterminal__of__parse_of_nonterminal _ (transitivity pf1' pf) valid _ p1' H_h1 Hinit) as p_prod.
            clear pf0' pf1'.
            destruct (le_lt_dec (length str') n) as [ Hle | Hle ], (zerop (min n (length str'))) as [Hstr' | Hstr' ].
            { (* empty, empty *)
              rewrite Min.min_r in Hstr' by assumption.
              specialize (p_it valid' Hinit'); specialize (p_prod valid' Hinit').
              destruct p_it as [ [ p0'' H0''] |], p_prod as [ [ p1'' H1'' ] |];
                [ | | | ];
                min_parse_prod_t. }
            { (* nonempty, empty *)
              specialize (p_it valid' Hinit'); specialize (p_prod initial_nonterminals_data (reflexivity _)).
              destruct p_it as [ [ p0'' H0''] |], p_prod as [ [ p1'' H1'' ] |];
                [ | | | ];
                min_parse_prod_t. }
            { (* empty, nonempty *)
              specialize (p_it initial_nonterminals_data (reflexivity _)); specialize (p_prod valid' Hinit').
              destruct p_it as [ [ p0'' H0''] |], p_prod as [ [ p1'' H1'' ] |];
                [ | | | ];
                min_parse_prod_t. }
            { (* nonempty, nonempty *)
              specialize (p_it initial_nonterminals_data (reflexivity _)); specialize (p_prod initial_nonterminals_data (reflexivity _)).
              destruct p_it as [ [ p0'' H0''] |], p_prod as [ [ p1'' H1'' ] |];
                [ | | | ];
                min_parse_prod_t. } }
        Defined.
      End production.

      Section productions.
        Context {len0 : nat} {str : String} {valid : nonterminals_listT}.

        Fixpoint minimal_parse_of_productions__of__parse_of_productions'
                 h
                 (minimal_parse_of_nonterminal__of__parse_of_nonterminal
                  : forall h' (pf : h' < S h) {len0 str valid nonterminal}
                           (p : parse_of G str (Lookup G nonterminal)),
                      @of_parse_nonterminal_T len0 str valid nonterminal p h')
                 {struct h}
        : of_parse_T len0 h.
        Proof.
          intros str' pf valid' pats p H_h Hinit'.
          destruct h as [|h']; [ exfalso; omega | ].
          destruct p as [pat pats p' | pat pats p'].
          { clear minimal_parse_of_productions__of__parse_of_productions'.
            edestruct (@minimal_parse_of_production__of__parse_of_production' _ h' minimal_parse_of_nonterminal__of__parse_of_nonterminal _ pf valid' _ p') as [ [p'' p''H] | [nonterminal' H'] ];
            try solve [ exact (Lt.lt_S_n _ _ H_h)
                      | exact H_forall
                      | exact Hinit' ];
            [|].
            { left.
              exists (MinParseHead pats p'').
              simpl.
              exact (Le.le_n_S _ _ p''H). }
            { right.
              exists nonterminal'.
              split;
                try solve [ exact (fst H') ];
                [].
              exists (proj1_sig (snd H')).
              exact (Lt.lt_S _ _ (proj2_sig (snd H'))). } }
          { specialize (fun h' pf
                        => @minimal_parse_of_nonterminal__of__parse_of_nonterminal
                             h' (transitivity pf (Lt.lt_n_Sn _))).
            edestruct (minimal_parse_of_productions__of__parse_of_productions' h'  minimal_parse_of_nonterminal__of__parse_of_nonterminal _ pf valid' _ p') as [ [p'' p''H] | [nonterminal' H'] ];
            try solve [ exact (Lt.lt_S_n _ _ H_h)
                      | exact Hinit'
                      | exact H_forall ];
            [|].
            { left.
              exists (MinParseTail pat p'').
              simpl.
              exact (Le.le_n_S _ _ p''H). }
            { right.
              exists nonterminal'.
              split;
                try solve [ exact (fst H') ];
                [].
              exists (proj1_sig (snd H')).
              exact (Lt.lt_S _ _ (proj2_sig (snd H'))). } }
        Defined.
      End productions.

      Section nonterminal.
        Section step.
          Definition minimal_parse_of_nonterminal__of__parse_of_nonterminal_step
                     h
                     (minimal_parse_of_nonterminal__of__parse_of_nonterminal
                      : forall h' (pf : h' < h) {len0 str valid nonterminal}
                               (p : parse_of G str (Lookup G nonterminal)),
                          @of_parse_nonterminal_T len0 str valid nonterminal p h')
                     {len0 str valid nonterminal}
                     (p : parse_of G str (Lookup G nonterminal))
          : @of_parse_nonterminal_T len0 str valid nonterminal p h.
          Proof.
            destruct h as [|h]; [ clear; repeat intro; exfalso; omega | ].
            intros Hvalid' pf Hstr Hinit'.
            let H := match goal with H : length str <= len0 |- _ => constr:(H) end in

            destruct (le_lt_eq_dec _ _ H) as [pf_lt|pf_eq].
            { (** [str] got smaller, so we reset the valid nonterminals list *)
              destruct (@minimal_parse_of_productions__of__parse_of_productions' (length str) h minimal_parse_of_nonterminal__of__parse_of_nonterminal str (reflexivity _) initial_nonterminals_data (Lookup G nonterminal) p (Lt.lt_S_n _ _ pf) (reflexivity _)) as [p'|p'].
              { left.
                exists (MinParseNonTerminalStrLt valid _ pf_lt (proj2 (initial_nonterminals_correct _) Hvalid') (proj1_sig p'));
                  simpl.
                simpl in *.
                exact (Le.le_n_S _ _ (proj2_sig p')). }
              { simpl.
                right; eapply expand_alt_option; [..| exact p' ];
                solve [ apply Lt.lt_n_Sn
                      | assumption
                      | reflexivity ]. } }
            { (** [str] didn't get smaller, so we cache the fact that we've hit this nonterminal already *)
              destruct (Sumbool.sumbool_of_bool (is_valid_nonterminal valid (of_nonterminal nonterminal))) as [ Hvalid | Hinvalid ].
              { destruct (@minimal_parse_of_productions__of__parse_of_productions' len0 h minimal_parse_of_nonterminal__of__parse_of_nonterminal str Hstr (remove_nonterminal valid (of_nonterminal nonterminal)) (Lookup G nonterminal) p (Lt.lt_S_n _ _ pf) (transitivity (R := sub_nonterminals_listT) (@sub_nonterminals_listT_remove _ _ _ _ _ _) Hinit')) as [p'|p'].
                { left.
                  exists (@MinimalParse.MinParseNonTerminalStrEq _ _ _ _ _ _ _ _ _ pf_eq (proj2 (initial_nonterminals_correct _) Hvalid') Hvalid (proj1_sig p')).
                  simpl in *.
                  exact (Le.le_n_S _ _ (proj2_sig p')). }
                { destruct p' as [nonterminal' p'].
                  destruct (string_dec nonterminal nonterminal') as [|n].
                  { subst nonterminal; simpl in *.
                    edestruct (@minimal_parse_of_nonterminal__of__parse_of_nonterminal (S (size_of_parse p)) pf len0 _ valid nonterminal' (proj1_sig (snd p'))) as [p''|p''];
                    try solve [ apply Lt.lt_n_S, (proj2_sig (snd p'))
                              | subst; reflexivity
                              | assumption
                              | split; [ exact (proj2 (fst p'))
                                       | exact (snd (proj2_sig (snd p'))) ] ];
                    [|].
                    { left.
                      exists (proj1_sig p'').
                      etransitivity;
                        [ exact (proj2_sig p'')
                        | exact (Lt.lt_le_weak _ _ (Lt.lt_n_S _ _ (proj2_sig (snd p')))) ]. }
                    { right.
                      exists (projT1 p'').
                      split;
                        [ exact (fst (projT2 p''))
                        | ].
                      exists (proj1_sig (snd (projT2 p''))).
                      etransitivity;
                        [ exact (proj2_sig (snd (projT2 p'')))
                        | exact (Lt.lt_n_S _ _ (proj2_sig (snd p'))) ]. } }
                  { right.
                    exists nonterminal'.
                    destruct p' as [p'H p'p].
                    split.
                    { rewrite remove_nonterminal_5
                        in p'H
                        by repeat match goal with
                                    | _ => assumption
                                    | _ => progress subst
                                    | [ H : ?x <> ?x |- _ ] => destruct (H eq_refl)
                                    | _ => progress destruct_head' and
                                    | _ => intro
                                    | [ H : of_nonterminal _ = of_nonterminal _ |- _ ]
                                      => let H' := fresh in
                                         pose proof (f_equal to_nonterminal H) as H';
                                           progress
                                             (rewrite !to_of_nonterminal
                                               in H'
                                               by (apply initial_nonterminals_correct;
                                                   first [ assumption
                                                         | rewrite <- H; assumption
                                                         | rewrite -> H; assumption ]));
                                           clear H
                                  end.
                      exact p'H. }
                    { exists (proj1_sig p'p).
                      exact (Lt.lt_S _ _ (proj2_sig p'p)). } } } }
              { (** oops, we already saw this nonterminal in the past.  ABORT! *)
                right.
                exists nonterminal.
                pose proof (proj2 (initial_nonterminals_correct _) Hvalid').
                split; [ split; assumption
                       | ].
                exists p.
                apply Lt.lt_n_Sn. } }
          Defined.
        End step.

        Section wf.
          Definition minimal_parse_of_nonterminal__of__parse_of_nonterminal'
          : forall h
                   {len0 str valid nonterminal}
                   (p : parse_of G str (Lookup G nonterminal)),
              @of_parse_nonterminal_T len0 str valid nonterminal p h
            := @Fix
                 _ lt lt_wf
                 (fun h => forall {len0 str valid nonterminal}
                                  (p : parse_of G str (Lookup G nonterminal)),
                             @of_parse_nonterminal_T len0 str valid nonterminal p h)
                 (@minimal_parse_of_nonterminal__of__parse_of_nonterminal_step).
        End wf.
      End nonterminal.
    End wf_parts.

    Definition minimal_parse_of_item__of__parse_of_item
               {str : String}
               {it : item Char}
               (p : parse_of_item G str it)
    : { p' : minimal_parse_of_item (G := G) (length str) initial_nonterminals_data str it
      | (size_of_parse_item (parse_of_item__of__minimal_parse_of_item p') <= size_of_parse_item p) }%type.
    Proof.
      eapply alt_all_elim, minimal_parse_of_item__of__parse_of_item';
      hnf; intros; try (assumption || reflexivity); [].
      eapply minimal_parse_of_nonterminal__of__parse_of_nonterminal'; try assumption.
      hnf; reflexivity.
    Defined.

    Definition minimal_parse_of_production__of__parse_of_production
               {str : String}
               {its : production Char}
               (p : parse_of_production G str its)
    : { p' : minimal_parse_of_production (G := G) (length str) initial_nonterminals_data str its
      | size_of_parse_production (parse_of_production__of__minimal_parse_of_production p') <= size_of_parse_production p }%type.
    Proof.
      eapply alt_all_elim, minimal_parse_of_production__of__parse_of_production';
      hnf; intros; try (assumption || reflexivity); [].
      eapply minimal_parse_of_nonterminal__of__parse_of_nonterminal'; try assumption.
      hnf; reflexivity.
    Defined.

    Definition minimal_parse_of_productions__of__parse_of_productions
               {str : String}
               {ps : productions Char}
               (p : parse_of G str ps)
    : { p' : minimal_parse_of (G := G) (length str) initial_nonterminals_data str ps
      | size_of_parse (parse_of__of__minimal_parse_of p') <= size_of_parse p }%type.
    Proof.
      eapply alt_all_elim, minimal_parse_of_productions__of__parse_of_productions';
      hnf; intros; try (assumption || reflexivity); [].
      eapply minimal_parse_of_nonterminal__of__parse_of_nonterminal'; try assumption.
      hnf; reflexivity.
    Defined.

    Definition minimal_parse_of_nonterminal__of__parse_of_nonterminal
               {str : String}
               {nonterminal : String.string}
               (Hvalid : In nonterminal (Valid_nonterminals G))
               (p : parse_of G str (Lookup G nonterminal))
    : { p' : minimal_parse_of_nonterminal (G := G) (length str) initial_nonterminals_data str nonterminal
      | size_of_parse_item (parse_of_item__of__minimal_parse_of_item (MinParseNonTerminal p')) <= size_of_parse_item (ParseNonTerminal nonterminal Hvalid p) }%type.
    Proof.
      eapply alt_all_elim, minimal_parse_of_nonterminal__of__parse_of_nonterminal';
      hnf; intros; try (assumption || reflexivity).
    Defined.

    Definition minimal_parse_of_nonterminal__of__parse_of_item_nonterminal_helper
               {str : String}
               {nonterminal : String.string}
               its
               (Hits : NonTerminal nonterminal = its)
               (p : parse_of_item G str its)
    : { p' : minimal_parse_of_nonterminal (G := G) (length str) initial_nonterminals_data str nonterminal
      | size_of_parse_item (parse_of_item__of__minimal_parse_of_item (MinParseNonTerminal p')) <= size_of_parse_item p }%type.
    Proof.
      destruct p.
      { exfalso; clear -Hits.
        abstract inversion Hits. }
      { inversion Hits; subst.
        apply minimal_parse_of_nonterminal__of__parse_of_nonterminal; assumption. }
    Defined.

    Definition minimal_parse_of_nonterminal__of__parse_of_item_nonterminal
               {str : String}
               {nonterminal : String.string}
               (p : parse_of_item G str (NonTerminal nonterminal))
    : { p' : minimal_parse_of_nonterminal (G := G) (length str) initial_nonterminals_data str nonterminal
      | size_of_parse_item (parse_of_item__of__minimal_parse_of_item (MinParseNonTerminal p')) <= size_of_parse_item p }%type.
    Proof.
      apply minimal_parse_of_nonterminal__of__parse_of_item_nonterminal_helper.
      { reflexivity. }
    Defined.
  End minimize.
End cfg.


Require Import Coq.Lists.ListSet.
Require Import compcert.common.AST.
Require Import compcert.common.Values.
Require Import compcert.common.Memory.
Require Import compcert.common.Globalenvs.
Require Import compcert.lib.Maps.

(** External function specifications and linking *)

Definition PTree_injective {A} (t: PTree.t A) : Prop :=
  forall id1 id2 b, t ! id1 = Some b -> t ! id2 = Some b -> id1 = id2.

Definition injective_PTree A := sig (@PTree_injective A).

Structure external_specification (M E Z : Type) :=
  { ext_spec_type : E -> Type
  ; ext_spec_pre: forall e: E,
    ext_spec_type e -> injective_PTree block -> list typ -> list val -> Z -> M -> Prop
  ; ext_spec_post: forall e: E,
    ext_spec_type e -> injective_PTree block -> rettype -> option val -> Z -> M ->  Prop
  ; ext_spec_exit: option val -> Z -> M ->  Prop }.

Arguments ext_spec_type {M E Z} _ _.
Arguments ext_spec_pre {M E Z} _ _ _ _ _ _ _ _.
Arguments ext_spec_post {M E Z} _ _ _ _ _ _ _ _.
Arguments ext_spec_exit {M E Z} _ _ _ _.

Definition ext_spec := external_specification mem external_function.

Lemma extfunct_eqdec (ef1 ef2 : external_function) : {ef1=ef2} + {~ef1=ef2}.
Proof.
repeat decide equality; try apply Integers.Int.eq_dec.
Defined.

Set Implicit Arguments.

Definition ef_ext_spec (M Z : Type) :=
  external_specification M AST.external_function Z.

Definition spec_of
  (M Z : Type) (ef : AST.external_function) (spec : ef_ext_spec M Z) :=
  (ext_spec_pre spec ef, ext_spec_post spec ef).

Definition oval_inject j (v tv : option val) :=
  match v, tv with
    | None, None => True
    | Some v', Some tv' => Val.inject j v' tv'
    | _, _ => False
  end.

Module ExtSpecProperties.

Definition det (M E Z : Type) (spec : external_specification M E Z) :=
  forall ef (x x' : ext_spec_type spec ef) ge tys z vals m
         oty' ov' z' m' oty'' ov'' z'' m'',
  ext_spec_pre spec ef x ge tys vals z m ->
  ext_spec_post spec ef x ge oty' ov' z' m' ->
  ext_spec_pre spec ef x' ge tys vals z m ->
  ext_spec_post spec ef x' ge oty'' ov'' z'' m'' ->
  oty'=oty'' /\ ov'=ov'' /\ z'=z'' /\ m'=m''.

Record closed (Z : Type) (spec : ext_spec Z) :=
  { P_closed :
      forall ef (x : ext_spec_type spec ef) ge j tys vals z m tvals tm,
      ext_spec_pre spec ef x ge tys vals z m ->
      Val.inject_list j vals tvals ->
      Mem.inject j m tm ->
      ext_spec_pre spec ef x ge tys tvals z tm
  ; Q_closed :
      forall ef (x : ext_spec_type spec ef) ge j oty ov z m otv tm,
      ext_spec_post spec ef x ge oty ov z m ->
      oval_inject j ov otv ->
      Mem.inject j m tm ->
      ext_spec_post spec ef x ge oty otv z tm
  ; exit_closed :
      forall j ov z m otv tm,
      ext_spec_exit spec ov z m ->
      oval_inject j ov otv ->
      Mem.inject j m tm ->
      ext_spec_exit spec otv z tm }.

End ExtSpecProperties.


Require Import Coq.omega.Omega.
(* Structured programming (module construction) *)

Require Import Coq.Bool.Bool Coq.NArith.NArith Coq.Strings.String Coq.Lists.List.

Require Import Bedrock.Nomega Bedrock.PropX Bedrock.PropXTac Bedrock.Word Bedrock.LabelMap Bedrock.IL Bedrock.XCAP Bedrock.Structured.
Require Import Bedrock.StringSet.

Set Implicit Arguments.

Local Open Scope N_scope.

Import DefineStructured.

Section module.
  Definition import := (string * string * assert)%type.

  Variable imports : list import.
  (* Which functions from outside this module do we need? *)

  Variable modName : string.
  (* New module name *)

  Definition function := (string * assert * forall imports, importsGlobal imports -> cmd imports modName)%type.

  Variable functions : list function.
  (* All functions in this module. *)

  (* Build the full list of imports for the commands, including both external and internal functions.
   * First, we build a version for only the external functions. *)

  Definition importsMap : LabelMap.t assert :=
    List.fold_left (fun m p => let '(modl, f, pre) := p in
      LabelMap.add (modl, Global f) pre m) imports (LabelMap.empty _).

  Lemma importsMapGlobal' : forall (im : list import) m,
    importsGlobal m
    -> importsGlobal (List.fold_left (fun m p => let '(modl, f, pre) := p in
      LabelMap.add (modl, Global f) pre m) im m).
    unfold importsGlobal; induction im as [ | [ ] ]; simpl; intuition.
    apply IHim in H0; auto.
    intros.
    apply LabelFacts.add_mapsto_iff in H1; intuition; subst; simpl; eauto.
  Qed.

  Theorem importsMapGlobal : importsGlobal importsMap.
    apply importsMapGlobal'; red; intros.
    destruct (LabelMap.empty_1 H).
  Qed.

  Definition fullImports : LabelMap.t assert :=
    List.fold_left (fun m p => let '(f, pre, _) := p in
      LabelMap.add (modName, Global f) pre m) functions importsMap.

  Lemma fullImportsGlobal' : forall (fs : list function) m,
    importsGlobal m
    -> importsGlobal (List.fold_left (fun m p => let '(f, pre, _) := p in
      LabelMap.add (modName, Global f) pre m) fs m).
    induction fs as [ | [ ] ]; simpl; intuition.
    apply IHfs; red; intros.
    apply LabelFacts.add_mapsto_iff in H0; intuition; subst; simpl; eauto.
  Qed.

  Theorem fullImportsGlobal : importsGlobal fullImports.
    apply fullImportsGlobal'; apply importsMapGlobal.
  Qed.

  (* Now we are ready to generate a module out of the functions. *)

  Definition buildLocals (bls : list (assert * block)) Base := snd (List.fold_left (fun b_m p => let '(b, m) := b_m in
    (Nsucc b, LabelMap.add (modName, Local b) p m)) bls (Base, LabelMap.empty _)).

  Fixpoint blocks (fs : list function) (Base : N) : LabelMap.t (assert * block) :=
    match fs with
      | nil => LabelMap.empty _
      | (f, pre, c) :: fs' =>
        let cout := c fullImports fullImportsGlobal pre in
        let cg := Generate cout (Nsucc Base) Base in
        LabelMap.add (modName, Global f) (pre, (nil, Uncond (RvLabel (modName, Local (Nsucc Base + Entry cg)))))
          (LabelMap.add (modName, Local Base) (Postcondition cout, (nil, Uncond (RvLabel (modName, Local Base))))
            (union (buildLocals (Blocks cg) (Nsucc Base))
              (blocks fs' (Nsucc Base + N_of_nat (length (Blocks cg))))))
    end.

  Fixpoint exps (fs : list function) : LabelMap.t assert :=
    match fs with
      | nil => LabelMap.empty _
      | (f, pre, _) :: fs' => LabelMap.add (modName, Global f) pre (exps fs')
    end.

  Definition bmodule_ : module := {|
    Imports := importsMap;
    XCAP.Blocks := blocks functions 1;
    Exports := exps functions;
    Modules := StringSet.singleton modName
  |}.

  Lemma Forall_MapsTo : forall A (P : _ * A -> Prop) m,
    (forall k v, LabelMap.MapsTo k v m -> P (k, v))
    -> List.Forall P (LabelMap.elements m).
    intros.
    generalize (fun k v H' => H k v (LabelMap.elements_2 H')); clear H; intro H.
    induction (LabelMap.elements m); simpl in *; intuition.
    constructor; auto.
    destruct a.
    apply H.
    constructor; hnf; auto.
  Qed.

  Hypothesis NoSelfImport :
    List.fold_left (fun b p => let '(m, _, _) := p in
      b || if string_dec m modName then true else false) imports false = false.

  Theorem importsNotThis : forall l, LabelMap.In (elt:=assert) (modName, l) importsMap -> False.
    intros.
    assert (forall k v, LabelMap.MapsTo k v (LabelMap.empty assert) -> k <> (modName, l)).
    intros.
    apply LabelMap.empty_1 in H0; tauto.
    destruct H.
    unfold importsMap in *.
    generalize dependent (LabelMap.empty assert).
    generalize NoSelfImport; clear NoSelfImport.
    generalize false at 2.
    induction imports; simpl in *; intuition.
    apply H0 in H; auto.
    destruct a as [ [ ] ]; simpl in *.
    eapply IHl0 in NoSelfImport.
    auto.
    eauto.
    intros; subst.
    apply LabelFacts.add_mapsto_iff in H1; intuition; subst; [ | eauto ].
    destruct (string_dec s modName); subst; try congruence.
    replace (b || true) with true in NoSelfImport by (destruct b; auto).
    generalize NoSelfImport; clear.
    induction l0; simpl; intuition.
    destruct a as [ [ ] ]; intuition.
  Qed.

  Hint Immediate importsNotThis.

  Theorem importsNotThis' : forall l v, LabelMap.MapsTo (elt:=assert) (modName, l) v importsMap -> False.
    intros; eapply importsNotThis.
    hnf.
    eauto.
  Qed.

  Hint Resolve importsNotThis'.

  Lemma Forall_nth_error : forall A (P : A -> Prop) x ls,
    List.Forall P ls
    -> forall n, nth_error ls n = Some x
      -> P x.
    induction 1; destruct n; simpl; intuition; try discriminate.
    injection H1; congruence.
    eauto.
  Qed.

  Hypothesis NoDupFunc :
    match (List.fold_left (fun mOpt p => let '(modl, _, _) := p in
      match mOpt with
        | None => None
        | Some m => let k := (modl, Local 0) in
          if LabelMap.mem k m then None
          else Some (LabelMap.add k tt m)
      end) functions (Some (LabelMap.empty unit))) with
      | None => False
      | Some _ => True
    end.

  Fixpoint makeVcs (fs : list function) : list Prop :=
    match fs with
      | nil => nil
      | f :: fs' =>
        let '(_, pre, c) := f in
          let cout := c fullImports fullImportsGlobal pre in
            (forall stn_st specs, ~interp specs (Postcondition cout stn_st))
            :: VerifCond cout
            ++ makeVcs fs'
    end.

  Hypothesis BlocksGood : vcs (makeVcs functions).

  Lemma BlocksGood' : List.Forall (fun f : function => let '(_, pre, c) := f in
    let cout := c fullImports fullImportsGlobal pre in
    (forall stn_st specs, ~interp specs (Postcondition cout stn_st))
    /\ vcs (VerifCond cout)) functions.
    generalize BlocksGood; clear.
    induction functions; simpl; intuition.
    destruct a as [ [ ] ].
    inversion BlocksGood; subst; intuition.
    constructor; intuition.
    eapply vcs_app_bwd1; eauto.
    apply IHl; eapply vcs_app_bwd2; eauto.
  Qed.

  Theorem buildLocals_notImport' : forall k v Base bls Base',
    LabelMap.MapsTo k v (buildLocals bls Base')
    -> Base' >= Base
    -> exists l, k = (modName, Local l) /\ l >= Base /\ l < Base' + N_of_nat (length bls).
    unfold buildLocals; intros.
    assert (LabelMap.MapsTo k v (LabelMap.empty (assert * block)) -> exists l, k = (modName, Local l) /\ l >= Base /\ l < Base' + N_of_nat (length bls))
      by (intro uhoh; destruct (LabelMap.empty_1 uhoh)).
    generalize dependent (LabelMap.empty (assert * block)).
    generalize dependent Base'; clear; induction bls; simpl; intuition.
    assert (Nsucc Base' >= Base) by nomega.
    destruct (IHbls _ H2 _ H); clear IHbls; intuition.
    apply LabelFacts.add_mapsto_iff in H3; intuition; subst; eauto.
    repeat esplit.
    auto.
    nomega.
    destruct H4; intuition.
    repeat esplit; eauto.
    nomega.
    repeat esplit; eauto.
    nomega.
  Qed.

  Theorem buildLocals_notImport : forall k v Base bls,
    LabelMap.MapsTo k v (buildLocals bls Base)
    -> exists l, k = (modName, Local l) /\ l >= Base /\ l < Base + N_of_nat (length bls).
    intros; eapply buildLocals_notImport'; eauto; nomega.
  Qed.

  Lemma getLocal : forall v bls Base Entry,
    nth_error bls (nat_of_N Entry) = Some v
    -> LabelMap.MapsTo (modName, Local (Base + Entry)) v (buildLocals bls Base).
    unfold buildLocals; intros.
    generalize (LabelMap.empty (assert * block)).
    generalize dependent Base.
    generalize dependent Entry.
    induction bls; simpl; intuition.
    elimtype False.
    destruct (nat_of_N Entry); discriminate.
    destruct (N_eq_dec Entry 0); subst; simpl in *.
    injection H; clear H; intros; subst.
    replace (Base + 0) with Base by nomega.
    assert (LabelMap.MapsTo (modName, Local Base) (a0, b) (LabelMap.add (modName, Local Base) (a0, b) t))
      by (apply LabelMap.add_1; auto).
    generalize H; clear.
    generalize (LabelMap.add (modName, Local Base) (a0, b) t).
    assert (Base < Nsucc Base) by nomega.
    generalize dependent (Nsucc Base).
    induction bls; simpl; intuition; eauto.
    apply IHbls.
    nomega.
    apply LabelMap.add_2; eauto.

    replace (Base + Entry) with (Nsucc Base + (Entry - 1)) by nomega.
    apply IHbls.
    autorewrite with N; simpl.
    assert (nat_of_N Entry <> O).
    nomega.
    destruct (nat_of_N Entry); simpl in *.
    tauto.
    replace (n0 - 0)%nat with n0 by omega; auto.
  Qed.

  Lemma ungetLocal' : forall A k v bls Base (m : LabelMap.t A),
    LabelMap.MapsTo k v (snd (List.fold_left (fun b_m p => let '(b, m) := b_m in
      (Nsucc b, LabelMap.add (modName, Local b) p m)) bls (Base, m)))
    -> LabelMap.MapsTo k v m
    \/ exists n, nth_error bls n = Some v /\ k = (modName, Local (Base + N_of_nat n)).
    clear; induction bls; simpl; intuition.
    apply IHbls in H; clear IHbls; intuition.
    apply LabelFacts.add_mapsto_iff in H0; intuition; subst.
    right; exists O; intuition.
    do 2 f_equal; nomega.
    destruct H0; intuition; subst.
    right; exists (S x); intuition.
    do 2 f_equal; nomega.
  Qed.

  Lemma ungetLocal : forall k v bls Base,
    LabelMap.MapsTo k v (buildLocals bls Base)
    -> exists n, nth_error bls n = Some v /\ k = (modName, Local (Base + N_of_nat n)).
    unfold buildLocals; intros.
    apply ungetLocal' in H; intuition.
    destruct (LabelMap.empty_1 H0).
  Qed.

  Hint Extern 1 (_ >= _) => nomega.

  Lemma MapsTo_blocks : forall k v fs Base,
    LabelMap.MapsTo k v (blocks fs Base)
    -> exists f, exists pre, exists c, In (f, pre, c) fs
      /\ exists Base', Base' >= Base /\
        let cout := c fullImports fullImportsGlobal pre in
        let cg := Generate (c fullImports fullImportsGlobal pre) (Nsucc Base') Base' in
          (forall n v', nth_error (Blocks cg) n = Some v'
            -> LabelMap.MapsTo (modName, Local (Nsucc Base' + N_of_nat n)) v' (blocks fs Base))
          /\ (exists bl, LabelMap.MapsTo (modName, Local Base') (Postcondition cout, bl) (blocks fs Base))
          /\ ((k = (modName, Global f)
            /\ v = (pre, (nil, Uncond (RvLabel (modName, Local (Nsucc Base' + Entry cg))))))
          \/ (k = (modName, Local Base') /\ v = (Postcondition cout, (nil, Uncond (RvLabel (modName, Local Base')))))
          \/ exists n, k = (modName, Local (Nsucc Base' + N_of_nat n)) /\ nth_error (Blocks cg) n = Some v).
    clear; induction fs as [ | [ [ ] ] ]; simpl; intuition.
    destruct (LabelMap.empty_1 H).
    apply LabelFacts.add_mapsto_iff in H; intuition; subst.

    do 4 esplit.
    eauto.
    exists Base; intuition.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_2; [ intro Ho; injection Ho; nomega | ].
    apply MapsTo_union1.
    apply getLocal; autorewrite with N; auto.
    eexists.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_1; auto.

    apply LabelFacts.add_mapsto_iff in H1; intuition; subst.

    do 4 esplit.
    eauto.
    exists Base; intuition.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_2; [ intro Ho; injection Ho; nomega | ].
    apply MapsTo_union1.
    apply getLocal; autorewrite with N; auto.
    eexists.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_1; auto.

    apply MapsTo_union in H2; intuition.

    apply ungetLocal in H0; destruct H0; intuition; subst.
    do 4 esplit.
    eauto.
    exists Base; intuition.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_2; [ intro Ho; injection Ho; nomega | ].
    apply MapsTo_union1.
    apply getLocal; autorewrite with N; auto.
    eexists.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_1; auto.
    eauto 10.

    apply IHfs in H0; clear IHfs; intuition.
    destruct H0 as [? [? [? [ ] ] ] ].
    destruct H2; intuition; subst.

    do 4 esplit.
    right; eauto.
    exists x2; intuition.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_2; [ intro Ho; injection Ho; nomega | ].
    apply MapsTo_union2; intuition.
    apply ungetLocal in H6; destruct H6; intuition.
    elimtype False; injection H8; intros.
    apply nth_error_bound in H7.
    nomega.
    destruct H4.
    eexists.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_2; [ intro Ho; injection Ho; nomega | ].
    apply MapsTo_union2; eauto.
    intros.
    apply ungetLocal in H5; destruct H5; intuition.
    elimtype False; injection H7; intros.
    apply nth_error_bound in H6.
    nomega.

    do 4 esplit.
    right; eauto.
    exists x2; intuition.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_2; [ intro Ho; injection Ho; nomega | ].
    apply MapsTo_union2; intuition.
    apply ungetLocal in H6; destruct H6; intuition.
    elimtype False; injection H8; intros.
    apply nth_error_bound in H7.
    nomega.
    destruct H4.
    eexists.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_2; [ intro Ho; injection Ho; nomega | ].
    apply MapsTo_union2; eauto.
    intros.
    apply ungetLocal in H5; destruct H5; intuition.
    elimtype False; injection H7; intros.
    apply nth_error_bound in H6.
    nomega.

    destruct H6; intuition; subst.
    do 4 esplit.
    right; eauto.
    exists x2; intuition eauto.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_2; [ intro Ho; injection Ho; nomega | ].
    apply MapsTo_union2; intuition.
    apply ungetLocal in H6; destruct H6; intuition.
    elimtype False; injection H9; intros.
    apply nth_error_bound in H8.
    nomega.
    destruct H4.
    eexists.
    apply LabelMap.add_2; [ congruence | ].
    apply LabelMap.add_2; [ intro Ho; injection Ho; nomega | ].
    apply MapsTo_union2; eauto.
    intros.
    apply ungetLocal in H5; destruct H5; intuition.
    apply nth_error_bound in H6.
    elimtype False; injection H8; intros.
    nomega.
  Qed.

  Lemma skipImports : forall m l p bls,
    LabelMap.MapsTo (modName, Local l) (p, bls) m
    -> LabelMap.MapsTo (modName, Local l) p
    (LabelMap.fold
      (fun (l : LabelMap.key) (x : assert * block) (m : LabelMap.t assert) =>
        LabelMap.add l (fst x) m) m importsMap).
    clear NoDupFunc BlocksGood.
    unfold importsMap.
    generalize NoSelfImport; clear NoSelfImport.
    generalize false at 2.
    intros; assert (forall v, ~LabelMap.MapsTo (modName, Local l) v (LabelMap.empty assert)).
    do 2 intro.
    apply LabelMap.empty_1 in H0; tauto.
    apply LabelMap.elements_1 in H.
    generalize (LabelMap.elements_3w m).
    generalize dependent (LabelMap.empty assert).
    induction imports; simpl in *; intuition.
    rewrite LabelMap.fold_1.
    generalize dependent t.
    induction (LabelMap.elements m); simpl; intuition.

    inversion H.
    inversion H1; clear H1; subst.
    inversion H; clear H; subst.
    hnf in H2; simpl in H2; intuition.
    destruct a; simpl in *; subst; simpl in *.
    generalize H4; clear.
    assert (LabelMap.MapsTo (modName, Local l) p (LabelMap.add (modName, Local l) p t)).
    apply LabelMap.add_1; auto.
    generalize dependent (LabelMap.add (modName, Local l) p t).
    induction l0; simpl; intuition; simpl.
    apply IHl0; auto.
    apply LabelMap.add_2.
    intro; subst.
    apply H4.
    constructor; hnf; auto.
    auto.

    intuition.
    apply H1; clear H1.
    intros.
    apply LabelFacts.add_mapsto_iff in H; intuition.
    destruct a as [ [ ] ]; simpl in *; subst; simpl in *.
    injection H; clear H; intros; subst.
    generalize H2 H4; clear.
    induction 1; simpl; intuition.
    apply H4.
    constructor.
    hnf in H; hnf; simpl in *; tauto.
    eauto.

    destruct a as [ [ ] ]; simpl in *.
    apply IHl0; auto.

    generalize NoSelfImport; clear.
    match goal with
      | [ |- context[?E || ?F] ] =>
        assert (E || F = false -> E = false) by (destruct b; auto);
          generalize dependent (E || F); generalize dependent E
    end.
    induction l0; simpl; intuition.
    destruct a as [ [ ] ]; simpl in *.
    eapply IHl0; [ | eassumption ].
    destruct b0; destruct b; simpl in *; intuition congruence.

    intros.
    apply LabelFacts.add_mapsto_iff in H2; intuition; subst.
    congruence.
    eauto.
  Qed.

  Lemma imps_cases : forall k v ims exit post bls base,
    LabelMap.MapsTo k v (imps ims modName bls base exit post)
    -> (k = (modName, Local exit) /\ v = post)
    \/ LabelMap.MapsTo k v ims
    \/ exists n, exists bl, nth_error bls n = Some (v, bl) /\ k = (modName, Local (base + N_of_nat n)).
    induction bls; simpl; intuition.

    apply LabelFacts.add_mapsto_iff in H; intuition.

    apply LabelFacts.add_mapsto_iff in H; intuition; subst.

    do 2 right; exists O; exists b; intuition.
    do 2 f_equal; nomega.

    apply IHbls in H1; intuition.
    destruct H1 as [ ? [ ] ]; intuition.
    do 2 right; exists (S x); exists x0; intuition.
    rewrite H2; do 2 f_equal; nomega.
  Qed.

  Lemma MapsTo_fullImports : forall k v,
    LabelMap.MapsTo k v fullImports
    -> LabelMap.MapsTo k v importsMap
    \/ (exists f, k = (modName, Global f) /\ exists c, In (f, v, c) functions).
    clear; unfold fullImports; do 2 intro; generalize importsMap.
    induction functions as [ | [ [ ] ] ]; simpl; intuition.
    apply IHl in H; clear IHl; intuition.
    apply LabelFacts.add_mapsto_iff in H0; intuition; subst.
    eauto 10.
    destruct H0; intuition; subst.
    destruct H1; eauto 10.
  Qed.

  Lemma importsMap_global' : forall l pre imps (acc : LabelMap.t assert),
    (forall l' pre', LabelMap.MapsTo l' pre' acc
      -> exists g, snd l' = Global g)
    -> LabelMap.MapsTo l pre (fold_left (fun m p => let '(modl, f, pre) := p in
      LabelMap.add (modl, Global f) pre m) imps acc)
    -> exists g, snd l = Global g.
    clear; induction imps; simpl; intuition eauto.
    eapply IHimps; [ | eauto ].
    intros.
    destruct (LabelKey.eq_dec l' (a, Global b0)).
    hnf in e; subst; simpl; eauto.
    eapply LabelMap.add_3 in H1.
    eauto.
    auto.
  Qed.

  Lemma importsMap_global : forall l pre,
    LabelMap.MapsTo l pre importsMap -> exists g, snd l = Global g.
    intros; apply importsMap_global' with pre imports (LabelMap.empty _).
    intros.
    apply LabelMap.empty_1 in H0; tauto.
    assumption.
  Qed.

  Lemma MapsTo_func : forall A (m : LabelMap.t A) k v v',
    LabelMap.MapsTo k v m
    -> LabelMap.MapsTo k v' m
    -> v = v'.
    intros.
    apply LabelMap.find_1 in H.
    apply LabelMap.find_1 in H0.
    congruence.
  Qed.

  Lemma blocks_exps : forall (mn g : string) (pre : assert) (bl : block)
    funcs start,
    LabelMap.MapsTo (mn, Global g) (pre, bl) (blocks funcs start) ->
    LabelMap.MapsTo (mn, Global g) pre (exps funcs).
    clear; induction funcs; simpl; intuition.
    apply LabelMap.empty_1 in H; tauto.
    destruct a as [ [ ] ].
    destruct (LabelKey.eq_dec (modName, Global s) (mn, Global g)).
    generalize e; intro e'.
    eapply LabelMap.add_1 in e'.

    hnf in e.
    rewrite <- e in *.
    eapply MapsTo_func in e'.
    2: apply H.
    injection e'; clear e'; intros; subst.
    eauto.

    apply LabelMap.add_3 in H; [ | assumption ].
    apply LabelMap.add_3 in H; [ | lomega ].
    apply MapsTo_union in H; intuition.
    apply buildLocals_notImport in H0; destruct H0; intuition congruence.

    eauto.
  Qed.

  Lemma exps_blocks : forall (mn g : string) (pre : assert)
    funcs start,
    LabelMap.MapsTo (mn, Global g) pre (exps funcs)
    -> exists bl, LabelMap.MapsTo (mn, Global g) (pre, bl) (blocks funcs start).
    induction funcs; simpl; intuition.
    apply LabelMap.empty_1 in H; tauto.
    destruct a as [ [ ] ].
    destruct (LabelKey.eq_dec (modName, Global s) (mn, Global g)).
    generalize e; intro e'.
    eapply LabelMap.add_1 in e'.
    hnf in e.
    rewrite <- e in *.
    eapply MapsTo_func in e'.
    2: apply H.
    subst.
    eauto.

    apply LabelMap.add_3 in H; [ | assumption ].
    eapply IHfuncs in H; destruct H.
    exists x.
    apply LabelMap.add_2; auto.
    apply LabelMap.add_2; auto.
    apply MapsTo_union2.
    eauto.
    intros.
    apply buildLocals_notImport in H0; destruct H0; intuition congruence.
  Qed.

  Lemma blocks_modName : forall mn l pre_bl funcs start,
    LabelMap.MapsTo (mn, l) pre_bl (blocks funcs start)
    -> modName = mn.
    clear; induction funcs; simpl; intuition.
    apply LabelMap.empty_1 in H; tauto.
    destruct a as [ [ ] ].
    destruct (LabelKey.eq_dec (modName, Global s) (mn, l)).
    congruence.
    apply LabelMap.add_3 in H; [ | assumption ].
    destruct (LabelKey.eq_dec (modName, Local start) (mn, l)).
    congruence.
    apply LabelMap.add_3 in H; [ | assumption ].
    apply MapsTo_union in H; intuition.
    apply buildLocals_notImport in H0; destruct H0; intuition congruence.
    eauto.
  Qed.

  Theorem bmoduleOk : moduleOk bmodule_.
    constructor.

    clear NoDupFunc BlocksGood.
    red; simpl.
    apply Forall_MapsTo.
    intros.
    simpl.
    generalize dependent 1.
    induction functions; simpl; intuition.
    apply LabelMap.empty_1 in H; tauto.
    destruct a as [ [ ] ]; simpl in *.
    apply LabelFacts.add_mapsto_iff in H; intuition; subst; eauto.
    apply LabelFacts.add_mapsto_iff in H2; intuition; subst; eauto.
    apply MapsTo_union in H3; intuition.

    destruct (buildLocals_notImport _ _ H1); intuition; subst; eauto.
    eauto.

    red; simpl; unfold allPreconditions; simpl; intros.

    generalize (MapsTo_blocks _ _ H); intros.
    repeat match goal with
             | [ H : ex _ |- _ ] => destruct H; intuition; subst
           end.

    injection H8; clear H8; intros; subst; simpl.
    destruct (PreconditionOk (Generate (x1 fullImports fullImportsGlobal x0) (Nsucc x2) x2)).
    apply H2 in H6.
    autorewrite with N in H6.

    match type of H6 with
      | LabelMap.MapsTo ?k (?v, _) _ => destruct (H0 k v)
    end.
    eapply skipImports; eauto.
    intuition.
    rewrite H8.
    eauto.

    injection H8; clear H8; intros; subst; simpl.
    match type of H5 with
      | LabelMap.MapsTo ?k (?v, _) _ => destruct (H0 k v)
    end.
    eapply skipImports; eauto.
    intuition.
    rewrite H7.
    eauto.

    generalize (BlocksOk (Generate (x1 fullImports fullImportsGlobal x0) (Nsucc x2) x2)); intuition.
    match type of H6 with
      | ?P -> _ => assert P
    end.
    generalize BlocksGood' H3; clear.
    induction functions; simpl; intuition; subst.
    inversion H; clear H; subst.
    tauto.
    inversion H; clear H; subst.
    auto.

    intuition.
    match type of H9 with
      | ?P -> _ => assert P by nomega
    end; intuition.
    apply (Forall_nth_error H10) in H8; simpl in *.
    apply H8; intuition.
    apply H0.

    apply imps_cases in H9; intuition; subst.

    eapply skipImports; eauto.

    apply MapsTo_fullImports in H9; intuition.
    assert (~LabelMap.In l (blocks functions 1)).
    pose proof importsNotThis' as importsNotThis'.
    generalize NoSelfImport H11; clear -importsNotThis'.
    generalize false at 2.
    generalize 1.
    induction functions as [ | [ [ ] ] ]; simpl; intuition.
    destruct H.
    destruct (LabelMap.empty_1 H).
    destruct H.
    apply LabelFacts.add_mapsto_iff in H; intuition; subst.
    eapply importsNotThis'; eauto.
    apply LabelFacts.add_mapsto_iff in H1; intuition; subst.
    eapply importsNotThis'; eauto.
    apply MapsTo_union in H2; intuition.
    apply ungetLocal in H0; destruct H0; intuition; subst.
    eapply importsNotThis'; eauto.
    eapply IHl0 in NoSelfImport; eauto.
    eexists; eauto.

    assert (forall v, ~SetoidList.InA (@LabelMap.eq_key_elt _) (l, v) (LabelMap.elements (blocks functions 1))).
    generalize H9; clear.
    intros; intro.
    apply H9.
    eexists.
    apply LabelMap.elements_2; eauto.

    generalize H11 H12; clear.
    rewrite LabelMap.fold_1.
    generalize importsMap.
    induction (LabelMap.elements (blocks functions 1)) as [ | [ [ ] ] ]; simpl; intuition; simpl.
    apply IHl0.
    apply LabelMap.add_2; auto.
    intro; subst.
    eapply H12.
    constructor; hnf; eauto.
    eauto.

    destruct H11; intuition; subst.
    destruct H12.

    assert (SetoidList.NoDupA (fun p1 p2 => fst (fst p1) = fst (fst p2)) functions).
    generalize NoDupFunc; clear.
    generalize dependent (LabelMap.empty unit).
    induction functions as [ | [ [ ] ] ]; simpl; intuition.
    case_eq (LabelMap.mem (s, Local 0) t); intro Heq; rewrite Heq in *.
    elimtype False.
    generalize NoDupFunc; clear.
    induction l as [ | [ [ ] ] ]; simpl; intuition.
    specialize (IHl _ NoDupFunc).
    constructor; auto.
    generalize NoDupFunc; clear.
    assert (LabelMap.MapsTo (s, Local 0) tt (LabelMap.add (s, Local 0) tt t)) by (apply LabelMap.add_1; auto).
    generalize dependent (LabelMap.add (s, Local 0) tt t).
    induction l as [ | [ [ ] ] ]; simpl; intuition.
    inversion H0.
    inversion H0; clear H0; simpl in *; subst.
    assert (LabelMap.In (s0, Local 0) t0) by (hnf; eauto).
    apply LabelMap.mem_1 in H0.
    rewrite H0 in NoDupFunc.
    elimtype False.
    generalize NoDupFunc; clear.
    induction l as [ | [ [ ] ] ]; simpl; intuition.
    case_eq (LabelMap.mem (s0, Local 0) t0); intro Heq; rewrite Heq in *.
    elimtype False.
    generalize NoDupFunc; clear.
    induction l as [ | [ [ ] ] ]; simpl; intuition.
    specialize (fun H => IHl _ H NoDupFunc).
    apply IHl; auto.

    assert (exists bl, LabelMap.MapsTo (modName, Global x5) (pre0, bl) (blocks functions 1)).
    generalize H11 H9; clear.
    generalize 1.
    induction functions; simpl; intuition; subst.
    eexists; apply LabelMap.add_1; eauto.
    destruct a as [ [ ] ].
    inversion H11; clear H11; subst.
    match goal with
      | [ |- context[blocks _ ?n] ] => destruct (IHl n H3)
    end; auto.
    eexists.
    apply LabelMap.add_2.
    intro Ho; injection Ho; clear Ho; intros; subst.
    apply H2.
    generalize H; clear.
    induction l; simpl; intuition; subst; auto.
    apply LabelMap.add_2; [ congruence | ].
    apply MapsTo_union2; eauto.
    intros.
    destruct (ungetLocal _ _ H1); intuition congruence.

    rewrite LabelMap.fold_1.
    destruct H12.
    assert (SetoidList.InA (@LabelMap.eq_key_elt _) ((modName, Global x5), (pre0, x7)) (LabelMap.elements (blocks functions 1))).
    apply LabelMap.elements_1; auto.
    generalize H13; clear.
    generalize (LabelMap.elements_3w (blocks functions 1)).
    generalize importsMap.
    induction (LabelMap.elements (blocks functions 1)); simpl; intuition.
    inversion H13.
    inversion H; clear H; subst.
    inversion H13; clear H13; subst; simpl.
    hnf in H0; simpl in H0; intuition; subst.
    injection H1; clear H1; intros; subst.
    assert (LabelMap.MapsTo (modName, Global x5) a (LabelMap.add (modName, Global x5) a t)) by (apply LabelMap.add_1; auto).
    generalize H2 H; clear.
    generalize (LabelMap.add (modName, Global x5) a t).
    induction l; simpl; intuition; simpl.
    apply IHl; auto.
    apply LabelMap.add_2; auto.
    intro; subst.
    apply H2; constructor; hnf; auto.
    auto.

    destruct H9 as [ ? [ ] ]; intuition; subst.
    eapply skipImports; eauto.

    simpl.

    intros; eapply importsMap_global; eauto.

    simpl.

    intros; eapply blocks_exps; eauto.

    simpl.

    intros; eapply exps_blocks; eauto.

    simpl.
    intros.
    apply StringSet.singleton_2.

    eapply blocks_modName; eauto.
  Qed.

End module.