Require Import CompCert.Behaviors.
Require Import CompCert.Smallstep.
Require Import Common.Definitions.
Require Import Common.Linking.
Require Import Common.CompCertExtensions.
Require Import Common.TracesInform.
Require Import Common.RenamingOption.

Require Import Source.Definability.
Require Import Source.DefinabilityEnd.
Require Import Source.Language.
Require Import Source.GlobalEnv.
Require Import Source.CS.
Require Import Intermediate.Machine.
Require Import Intermediate.CS.
Require Import Intermediate.RecompositionRel.
Require Import S2I.Compiler.
Require Import S2I.Definitions.

From mathcomp Require Import ssreflect ssrfun ssrbool.

Set Implicit Arguments.
Unset Strict Implicit.

Set Bullet Behavior "Strict Subproofs".

Section RSC_Section.
  Variable p: Source.program.
  Variable psz: {fmap Component.id -> nat}.
  Variable p_compiled: Intermediate.program.
  Variable Ct: Intermediate.program.

  (* Some reasonable assumptions about our programs *)

  Hypothesis domm_psz_intf: domm psz = domm (Source.prog_interface p).
  Hypothesis well_formed_p : Source.well_formed_program p.
  Hypothesis disciplined_p: Compiler.disciplined_program p.
  Hypothesis good_Elocal_p: NoLeak.good_Elocal_usage_program p.
  Hypothesis successful_compilation : Compiler.compile_program p psz = Some p_compiled.
  Hypothesis well_formed_Ct : Intermediate.well_formed_program Ct.
  Hypothesis linkability : linkable (Source.prog_interface p) (Intermediate.prog_interface Ct).
  Hypothesis closedness :
    Intermediate.closed_program (Intermediate.program_link p_compiled Ct).
  Hypothesis mains : Intermediate.linkable_mains p_compiled Ct.

  (* Main Theorem *)

  (* [DynShare]

     - Maybe we can get rid of the disjunction "... \/ behavior_improves_blame beh".
     - And also we should (instead of program_behaves) directly use
       does_prefix (Source.CS.sem (Source.program_link p Cs)) m'
       Notice that does_prefix is the "finite version" of "program_behaves", i.e., it still
       contains the cases of FTerminates and FGoesWrong.

     * Because our current S2I compiler does not seem to refine any undef behavior,
       we should be able to get rid of the blame disjunct.

   *)

  Theorem RSC:
    forall t s,
      Star (Intermediate.CS.CS.sem_non_inform (Intermediate.program_link p_compiled Ct))
           (Intermediate.CS.CS.initial_machine_state
              (Intermediate.program_link p_compiled Ct)
           )
           t
           s
      ->
      exists Cs t' s' size_meta size_meta',
      Source.prog_interface Cs = Intermediate.prog_interface Ct /\
      Source.well_formed_program Cs /\
      linkable (Source.prog_interface p) (Source.prog_interface Cs) /\
      Source.closed_program (Source.program_link p Cs) /\
      Star (Source.CS.CS.sem (Source.program_link p Cs))
           (Source.CS.CS.initial_machine_state
              (Source.program_link p Cs)
           )
           t'
           s'
      /\
      traces_shift_each_other_option size_meta size_meta' t t'.
  Proof.
    intros t s Hstar.

    (* Some auxiliary results. *)
    pose proof
      Compiler.compilation_preserves_well_formedness well_formed_p successful_compilation
      as well_formed_p_compiled.

    assert (linkability_pcomp_Ct :
              linkable (Intermediate.prog_interface p_compiled)
                       (Intermediate.prog_interface Ct)).
    {
      assert (sound_interface_p_Ct : sound_interface (unionm (Source.prog_interface p)
                                                             (Intermediate.prog_interface Ct)))
        by apply linkability.
      assert (fdisjoint_p_Ct : fdisjoint (domm (Source.prog_interface p))
                                         (domm (Intermediate.prog_interface Ct)))
        by apply linkability.
      constructor;
        apply Compiler.compilation_preserves_interface in successful_compilation;
        now rewrite successful_compilation.
    }

    assert (exists t_inform,
               Star
                 (Intermediate.CS.CS.sem_inform
                    (Intermediate.program_link p_compiled Ct))
                 (Intermediate.CS.CS.initial_machine_state
                    (Intermediate.program_link p_compiled Ct)
                 )
                 t_inform
                 s
               /\ project_non_inform t_inform = t) as [t_inform [Hstarinform Hproj]].
    {
      by eapply Intermediate.CS.CS.star_sem_non_inform_star_sem_inform.
    }

    (* definability *)
    destruct (definability_with_linking
                well_formed_p_compiled
                well_formed_Ct
                linkability_pcomp_Ct
                closedness
                Hstarinform)
      as [P' [Cs [t' [s' [metadata_size
         [Hsame_iface1 [Hsame_iface2
         [Hmatching_mains_P'_p_compiled [Hmatching_mains_Cs_Ct
                                           [well_formed_P' [well_formed_Cs [HP'Cs_closed [Hstar' [Ht_rel_t' [Hconst_map [good_P'_Cs [P'_Cs_disciplined P'_CS_good_Elocal]]]]]]]]]]]]]]]]].

    assert (Source.linkable_mains P' Cs) as HP'Cs_mains.
    { apply Source.linkable_disjoint_mains; trivial; congruence. }

    (* FCC *)

    (* the definability output can be split in two programs *)
    (* probably need partialize to obtain them *)

    (* At this point, we compile P' and Cs and establish their basic properties. *)

    have well_formed_P'Cs : Source.well_formed_program (Source.program_link P' Cs).
      rewrite -Hsame_iface1 -Hsame_iface2 in linkability_pcomp_Ct.
      exact: Source.linking_well_formedness well_formed_P' well_formed_Cs linkability_pcomp_Ct.

      assert (P'Cs_disciplined: disciplined_program (Source.program_link P' Cs)).
      {
        intros ? ? ? Hfind.
        eapply P'_Cs_disciplined; eauto.
      }

      assert (exists s' t'compiled P'Cs_sz P'_Cs_compiled,
                 domm P'Cs_sz = domm (Source.prog_interface (Source.program_link P' Cs))
                 /\
                 Compiler.compile_program (Source.program_link P' Cs) P'Cs_sz =
                 Some P'_Cs_compiled
                 /\
                 Star (Intermediate.CS.CS.sem_non_inform P'_Cs_compiled)
                      (I.CS.initial_machine_state P'_Cs_compiled)
                      t'compiled s'
                 /\
                 traces_shift_each_other_option
                   (uniform_shift 1)
                   (uniform_shift 1)
                   t'
                   t'compiled
             )
        as [s'_compiled [t'compiled [P'Cs_sz [P'_Cs_compiled
                                       [Hdomm_P'Cs_sz
                                          [HP'_Cs_compiles
                                             [HP'_Cs_compiled_star
                                                Ht'_rel_t'compiled

           ]]]]]]].
      {
        eapply Compiler.forward_simulation_star with (metasize := uniform_shift 1).
        - assumption.
        - assumption.
        - exact P'Cs_disciplined.
        - exact P'_CS_good_Elocal.
        - exact Hstar'.
      }

    assert (P'_Cs_linkable:
              linkable (Source.prog_interface P') (Source.prog_interface Cs)).
    {
      by rewrite Hsame_iface1 Hsame_iface2.
    }

    assert (exists P'sz Cssz,
               unionm P'sz Cssz = P'Cs_sz
           ) as [P'sz [Cssz Hunion]].
    {
      exists (filterm (fun k => fun=> k \in domm (Source.prog_interface P')) P'Cs_sz).
      exists (filterm (fun k => fun=> k \in domm (Source.prog_interface Cs)) P'Cs_sz).
      assert (G': unionm
                    (filterm (T:=nat_ordType)
                             (fun k : nat_ordType =>
                                fun=> k \in domm
                                              (T:=nat_ordType)
                                              (S:=Component.interface)
                                              (Source.prog_interface P'))
                             P'Cs_sz)
                    (filterm (T:=nat_ordType)
                             (fun k : nat_ordType =>
                                fun=> k \in domm
                                              (T:=nat_ordType)
                                              (S:=Component.interface)
                                              (Source.prog_interface Cs))
                             P'Cs_sz) = P'Cs_sz).
      {
        apply eq_fmap. intros x. rewrite unionmE !filtermE.

        destruct (P'Cs_sz x) eqn:e.
        + simpl.
          assert (G1: exists n, P'Cs_sz x = Some n) by eauto.
          move : G1 => /dommP => G1.
          rewrite Hdomm_P'Cs_sz domm_union in G1.
          destruct (x \in domm (Source.prog_interface P')) eqn:edomm; rewrite edomm;
            simpl; auto.
          assert (x \in domm (Source.prog_interface Cs)).
          {
            rewrite in_fsetU in G1.
            move : G1 => /orP => G1.
            destruct G1 as [contra|G1]; [by rewrite edomm in contra | assumption].
          }
            by rewrite H.
        + by simpl.
      }
      exact G'.
    }

    specialize (Compiler.well_formed_compilable _ P'sz well_formed_P') as
        [P'_compiled HP'_compiles].

    specialize (Compiler.well_formed_compilable _ Cssz well_formed_Cs) as
        [Cs_compiled HCs_compiles].
    rewrite -Hunion in HP'_Cs_compiles.

    assert (Hrewr: compile_program (Source.program_link P' Cs) (unionm P'sz Cssz) =
                   Some (Intermediate.program_link P'_compiled Cs_compiled)).
    { by eapply Compiler.separate_compilation; eauto. }

    rewrite HP'_Cs_compiles in Hrewr.
    inversion Hrewr. subst.

    pose proof Compiler.compilation_preserves_well_formedness well_formed_P' HP'_compiles
      as well_formed_P'_compiled.

    pose proof Compiler.compilation_preserves_well_formedness well_formed_Cs HCs_compiles
      as well_formed_Cs_compiled.

    assert
      (linkable
         (Intermediate.prog_interface Cs_compiled)
         (Intermediate.prog_interface P'_compiled))
      as linkability'. {
      eapply @Compiler.compilation_preserves_linkability with (p:=Cs) (c:=P'); eauto.
      apply linkable_sym.
      rewrite <- Hsame_iface1 in linkability_pcomp_Ct.
      rewrite <- Hsame_iface2 in linkability_pcomp_Ct.
      apply linkability_pcomp_Ct.
    }

    rewrite Intermediate.program_linkC in HP'_Cs_compiled_star;
       [| assumption |assumption | apply linkable_sym in linkability'; assumption].

    (* intermediate composition *)
    assert (Intermediate.prog_interface Ct = Intermediate.prog_interface Cs_compiled)
      as Hctx_same_iface. {
      symmetry. erewrite Compiler.compilation_preserves_interface.
      - rewrite <- Hsame_iface2. reflexivity.
      - eassumption.
    }
    (* rewrite Hctx_same_iface in HP_decomp. *)
    assert (Intermediate.prog_interface p_compiled = Intermediate.prog_interface P'_compiled) as Hprog_same_iface. {
      symmetry. erewrite Compiler.compilation_preserves_interface.
      - apply Hsame_iface1.
      - eassumption.
    }
    (* rewrite <- Hprog_same_iface in HCs_decomp. *)

    assert (linkable (Intermediate.prog_interface p_compiled) (Intermediate.prog_interface Cs_compiled))
      as linkability''.
    {
      unfold linkable. split; try
        rewrite Hprog_same_iface;
        apply linkable_sym in linkability';
        now inversion linkability'.
    }
    assert (Intermediate.closed_program (Intermediate.program_link p_compiled Cs_compiled))
      as HpCs_compiled_closed.
    pose proof S2I.Definitions.matching_mains_equiv
         _ _ _
         Hmatching_mains_Cs_Ct
         (Compiler.compilation_has_matching_mains well_formed_Cs HCs_compiles)
         as Hctx_match_mains.
    now apply (Intermediate.interface_preserves_closedness_r
                 well_formed_p_compiled well_formed_Cs_compiled
                 Hctx_same_iface linkability_pcomp_Ct closedness mains Hctx_match_mains); auto.
    assert (Intermediate.well_formed_program (Intermediate.program_link p_compiled Cs_compiled))
      as HpCs_compiled_well_formed
        by (apply Intermediate.linking_well_formedness; assumption).

    assert (Intermediate.linkable_mains p_compiled Cs_compiled) as linkable_mains.
    {
      eapply (@Compiler.compilation_preserves_linkable_mains p _ _ Cs);
        try eassumption.
      - rewrite <- Hsame_iface2 in linkability.
        eapply Source.linkable_disjoint_mains; assumption.
    }

    assert (mergeable_interfaces (Intermediate.prog_interface p_compiled)
                                 (Intermediate.prog_interface Cs_compiled))
      as Hmergeable_ifaces.
      by apply Intermediate.compose_mergeable_interfaces.

    assert (Source.closed_program (Source.program_link p Cs)) as Hclosed_p_Cs. {
      apply (Source.interface_preserves_closedness_l HP'Cs_closed); trivial.
      apply Compiler.compilation_preserves_interface in HP'_compiles.
      apply Compiler.compilation_preserves_interface in successful_compilation.
      congruence.
    }
    assert (linkable (Source.prog_interface p) (Source.prog_interface Cs))
      as Hlinkable_p_Cs. {
      inversion linkability'' as [sound_interface_p_Cs fdisjoint_p_Cs].
      constructor;
        (apply Compiler.compilation_preserves_interface in HCs_compiles;
        apply Compiler.compilation_preserves_interface in successful_compilation;
        rewrite <- HCs_compiles; rewrite <- successful_compilation;
        assumption).
    }
    assert (Source.well_formed_program (Source.program_link p Cs)) as Hwf_p_Cs
      by (apply Source.linking_well_formedness; assumption).

    assert (HP'Cs_compiled_closed :
              Intermediate.closed_program (Intermediate.program_link P'_compiled Cs_compiled)).
    {
      rewrite Intermediate.program_linkC; try easy; try now apply linkable_sym.
      apply Intermediate.interface_preserves_closedness_r with (p2 := p_compiled); eauto.
      apply linkable_sym; eauto.
      rewrite Intermediate.program_linkC; eauto.
      apply linkable_sym; eauto.
      apply Intermediate.linkable_mains_sym; eauto.
      eapply S2I.Definitions.matching_mains_equiv; eauto.
      eapply Compiler.compilation_has_matching_mains; eauto.
    }

    rewrite Intermediate.program_linkC in HP'_Cs_compiled_star; try assumption.
    rewrite <- Hctx_same_iface in Hmergeable_ifaces.

    assert (H_p_Ct_good: forall (ss : CS.state) (tt : Events.trace Events.event),
               CSInvariants.CSInvariants.is_prefix
                 ss (Intermediate.program_link p_compiled Ct) tt ->
               good_trace_extensional (left_addr_good_for_shifting all_zeros_shift) tt
               /\
               (forall (mem : eqtype.Equality.sort Memory.Memory.t) (ptr : Pointer.t)
                       (addr : Component.id * Block.id) (v : value),
                   CS.state_mem ss = mem ->
                   Memory.Memory.load mem ptr = Some v ->
                   addr = (Pointer.component ptr, Pointer.block ptr) ->
                   left_addr_good_for_shifting all_zeros_shift addr ->
                   left_value_good_for_shifting all_zeros_shift v)).
    {
      intros ? ? ?. split.
      - constructor. intros ? ?. destruct a as [? ?].
        unfold all_zeros_shift, uniform_shift. easy.
      - intros ? ? ? ? ? ? ? ?.
        destruct v as [| [[[[|] ?] ?] ?] |]; unfold all_zeros_shift, uniform_shift;
          simpl; easy.
    }

    (** Need an axiom about the Compiler. The axiom will transfer goodness of *)
    (** a source program to goodness of the compiled version, where goodness  *)
    (** is described as conformance of the sharing behavior with the static   *)
    (** address renaming convention (i.e., shared addresses are renamed into  *)
    (** shared addresses). Viewed dually, the axiom about the compiler says   *)
    (** that the compiler preserves the privacy of private (non-shared)       *)
    (** addresses.                                                            *)

    (** With such an axiom in hand, we can assert the following from its      *)
    (** corresponding source version.                                         *)

    assert (HP'_compiled_Cs_compiled_good: forall (ss'' : CS.state) tt'',
               CSInvariants.CSInvariants.is_prefix
                 ss''
                 (Intermediate.program_link P'_compiled Cs_compiled) tt'' ->
               good_trace_extensional
                 (left_addr_good_for_shifting
                    (uniform_shift 1)) tt''
               /\
               (forall (mem : eqtype.Equality.sort Memory.Memory.t) (ptr : Pointer.t)
                       (addr : Component.id * Block.id) (v : value),
                   CS.state_mem ss'' = mem ->
                   Memory.Memory.load mem ptr = Some v ->
                   addr = (Pointer.component ptr, Pointer.block ptr) ->
                   left_addr_good_for_shifting
                     (uniform_shift 1) addr ->
                   left_value_good_for_shifting
                     (uniform_shift 1) v)).
    {
      assert (P'_Cs_closed: Source.closed_program (Source.program_link P' Cs)).
      {
        eapply Source.interface_preserves_closedness_l; eauto.
        rewrite Hsame_iface1.
        erewrite compilation_preserves_interface; eauto.
      }

      assert (P'_Cs_wf: Source.well_formed_program (Source.program_link P' Cs)).
      {
        eapply Source.linking_well_formedness; eauto.
      }

      specialize (Compiler.compiler_preserves_non_leakage_of_private_pointers
                    _ _ _ _ P'_Cs_closed P'_Cs_wf HP'_Cs_compiles good_P'_Cs
                 ) as G.
      unfold CSInvariants.CSInvariants.is_prefix.
      intros ? ? Hpref.
      unfold private_pointers_never_leak_I, shared_locations_have_only_shared_values in *.
      specialize (G ss'' tt'' Hpref) as [G1 G2].
      split; first exact G1.
      intros ? ? ? ? ? ? ? ?.
      eapply G2; eauto.
    }

    assert (t_rel_t'compiled: traces_shift_each_other_option
                        all_zeros_shift
                        (uniform_shift 1)
                        (project_non_inform t_inform) t'compiled).
    {
        eapply traces_shift_each_other_option_transitive.
        - apply traces_shift_each_other_option_symmetric; exact Ht_rel_t'.
        - exact Ht'_rel_t'compiled.
    }

    pose proof Intermediate.RecompositionRel.recombination_trace_rel
    well_formed_p_compiled
    well_formed_Ct
    well_formed_P'_compiled
    well_formed_Cs_compiled
    Hmergeable_ifaces
    Hprog_same_iface
    Hctx_same_iface
    closedness
    HP'Cs_compiled_closed
    H_p_Ct_good
    HP'_compiled_Cs_compiled_good
    Hstar
    HP'_Cs_compiled_star
    t_rel_t'compiled
      as [s_recomb [t_recomb [Hstar_recomb [_ trel_recomb]]]].

    (* BCC *)
    assert (exists pCs_compiled,
               Compiler.compile_program (Source.program_link p Cs)
                                        (unionm psz Cssz)
               = Some pCs_compiled)
      as [pCs_compiled HpCs_compiles].
      by now apply Compiler.well_formed_compilable.

      eapply Compiler.backward_simulation_star
        in Hstar_recomb
      ;
        eauto;
        last by
        (erewrite HpCs_compiles;
         erewrite Compiler.separate_compilation in HpCs_compiles; eauto
        ).

      destruct Hstar_recomb as [s'_pCs HpCs_star].
      destruct HpCs_star as [tQed [HstarQed HshiftQed]].
      do 5 eexists; split; last split; last split; last split; last split;
        eauto.
      {
        eapply traces_shift_each_other_option_transitive.
        - exact trel_recomb.
        - eassumption.
      }

      apply disciplined_program_link; auto.

      eapply disciplined_program_unlink with (c := P'); eauto.
      - eapply linkable_sym. eauto.
      - rewrite Source.link_sym; auto.
        by apply linkable_sym.
      - eapply NoLeak.good_Elocal_usage_program_link; auto.
        eapply NoLeak.good_Elocal_usage_program_unlink with (c := P'); eauto.
        eapply linkable_sym; eauto.
        rewrite Source.link_sym; auto.
        by apply linkable_sym.
Qed.

Print Assumptions RSC.

End RSC_Section.

(* To evaluate the assumptions and statements of the main results,
   uncomment and execute the following statements. To show the
   statement of a theorem, replace [Print Assumptions] -> [Check]. *)

(* Check RSC. *)
(* Print Assumptions S2I.Compiler.forward_simulation_star. *)
(* Print Assumptions Intermediate.RecompositionRel.recombination_trace_rel. *)
(* Print Assumptions S2I.Compiler.backward_simulation_star. *)
(* Print CompCert.Events.event. *)
(* Print Common.TracesInform.event_inform. *)
(* Print Assumptions Intermediate.CS.CS.star_sem_non_inform_star_sem_inform. *)
(* Print Assumptions Source.Definability.definability. *)
(* Print Intermediate.RecompositionRelCommon.mergeable_internal_states. *)
(* Print Common.RenamingOption.traces_shift_each_other_option. *)
(* Check Intermediate.CS.CS.Jump. *)
(* Check Intermediate.CS.CS.Store. *)
(* Print Assumptions RSC. *)
(* Print Assumptions Source.Definability.definability_gen_rel_right. *)
(* Print Intermediate.RecompositionRelCommon.mergeable_border_states. *)
(* Print Assumptions Intermediate.RecompositionRelStrengthening.threeway_multisem_event_lockstep_program_step. *)
(* Print Assumptions Intermediate.RecompositionRelOptionSim.merge_states_silent_star. *)
(* Print Assumptions Intermediate.RecompositionRelLockstepSim.threeway_multisem_star_E0. *)
(* Print Assumptions Intermediate.RecompositionRelCommon.mergeable_internal_states_sym. *)


(** This file implements symbolic evaluation for the
 ** language defined in IL.v
 **)
Require Import List.
Require Import ExtLib.Tactics.Consider.
Require Import MirrorShard.SepExpr.
Require Import MirrorShard.Expr.
Require Import MirrorShard.Prover.
Require Import MirrorShard.Quantifier.
Require Import MirrorShard.Env TypedPackage.
Require Import IL SepIL.
Require Import Word Memory.
Require Import PropX.
Require Structured SymEval.
Require Import ILEnv SymIL.

Set Implicit Arguments.
Set Strict Implicit.

(** The Symolic Evaluation Interfaces *)
Module MEVAL := SymIL.MEVAL.

Module SymIL_Correct.
  Section typed.
    Variable ts : list type.
    Let types := repr bedrock_types_r ts.

    Notation pcT := (tvType 0).
    Notation tvWord := (tvType 0).
    Notation stT := (tvType 1).
    Notation tvState := (tvType 2).
    Notation tvTest := (tvType 3).
    Notation tvReg := (tvType 4).

    Variable fs : functions types.
    Let funcs := repr (bedrock_funcs_r ts) fs.
    Variable preds : SEP.predicates types.

    Variable Prover : ProverT types.
    Variable PC : ProverT_correct Prover funcs.

    Variable meval : MEVAL.MemEvaluator types.
    Variable meval_correct : MEVAL.MemEvaluator_correct pcT stT meval funcs preds tvWord tvWord
      (@IL_mem_satisfies ts) (@IL_ReadWord ts) (@IL_WriteWord ts) (@IL_ReadByte ts) (@IL_WriteByte ts).

    Variable facts : Facts Prover.
    Variable meta_env : env types.
    Variable vars_env : env types.

    Lemma stateD_interp : forall cs stn_st ss sh,
      stateD funcs preds meta_env vars_env cs stn_st ss ->
      SymMem ss = Some sh ->
      interp cs (![ SEP.sexprD funcs preds meta_env vars_env (SH.sheapD sh)] stn_st).
    Proof.
      clear. destruct stn_st; destruct ss; destruct SymRegs; destruct p; simpl; intros.
      rewrite H0 in *. intuition.
    Qed.

    Hint Resolve stateD_interp : sym_eval_hints.

    Ltac t_correct :=
      simpl; intros;
        unfold IL_stn_st, IL_mem_satisfies, IL_ReadWord, IL_WriteWord in *;
          repeat (simpl in *;
            match goal with
              | [ H : Some _ = Some _ |- _ ] => inversion H; clear H; subst
              | [ H : prod _ _ |- _ ] => destruct H
              | [ H : match ?X with
                        | Some _ => _
                        | None => _
                      end |- _ ] =>
                revert H; case_eq X; intros; try contradiction
              | [ H : match ?X with
                        | Some _ => _
                        | None => _
                      end = _ |- _ ] =>
                revert H; case_eq X; intros; try congruence
              | [ H : _ = _ |- _ ] => rewrite H
              | [ H : @existsEach _ _ _ |- _ ] => apply existsEach_sem in H
              | [ H : exists x, _ |- _ ] => destruct H
              | [ H : _ /\ _ |- _ ] => destruct H
              | [ |- exists x, Some _ = Some _ /\ _ ] =>
                eexists; split; [ reflexivity | ]
            end); subst; eauto with sym_eval_hints.

    Lemma sym_evalLoc_correct : forall loc ss res res' stn_st locD cs,
      stateD funcs preds meta_env vars_env cs stn_st ss ->
      sym_locD fs meta_env vars_env loc = Some locD ->
      evalLoc (snd stn_st) locD = res' ->
      sym_evalLoc loc ss = res ->
      exprD funcs meta_env vars_env res tvWord = Some res'.
    Proof.
      destruct loc; unfold stateD; destruct ss; destruct SymRegs; destruct p; intros; destruct stn_st; simpl in *;
        t_correct; try solve [ eauto
                             | destruct r; simpl in *;
                               repeat match goal with
                                        | [ H : _ = _ |- _ ] => rewrite H
                                        | [ |- _ ] => subst funcs
                                      end; eauto ].
    Qed.

    Hypothesis Valid_facts : Valid PC meta_env vars_env facts.

    Lemma sym_evalRval_correct : forall rv ss res stn_st rvD cs,
      stateD funcs preds meta_env vars_env cs stn_st ss ->
      sym_rvalueD funcs meta_env vars_env rv = Some rvD ->
      sym_evalRval Prover meval facts rv ss = Some res ->
      exists val,
        evalRvalue (fst stn_st) (snd stn_st) rvD = Some val /\
        exprD funcs meta_env vars_env res tvWord = Some val.
    Proof.
      Opaque stateD sym_locD.
      destruct rv; t_correct.
      { destruct s; t_correct.
        { erewrite <- (@sym_evalLoc_correct (SymReg _ r)). f_equal. eauto. simpl.
          Transparent sym_locD. simpl. reflexivity. Opaque sym_locD. reflexivity. reflexivity. }
        { eapply (MEVAL.ReadCorrect meval_correct) with (cs := cs) in H2; eauto with sym_eval_hints.
          2: eapply sym_evalLoc_correct; (instantiate; eauto with sym_eval_hints). 2: eauto.
          t_correct. }
        { eapply (MEVAL.ReadByteCorrect meval_correct) with (cs := cs) in H2; eauto with sym_eval_hints.
          2: eapply sym_evalLoc_correct; (instantiate; eauto with sym_eval_hints). 2: eauto.
          t_correct. } }
      { congruence. }
    Qed.

    Lemma sym_evalLval_correct : forall lv stn_st lvD cs val ss ss' valD,
      stateD funcs preds meta_env vars_env cs stn_st ss ->
      sym_lvalueD funcs meta_env vars_env lv = Some lvD ->
      sym_evalLval Prover meval facts lv val ss = Some ss' ->
      exprD funcs meta_env vars_env val tvWord = Some valD ->
      exists st',
        evalLvalue (fst stn_st) (snd stn_st) lvD valD = Some st' /\
        stateD funcs preds meta_env vars_env cs (fst stn_st, st') ss'.
    Proof.
      destruct lv; t_correct.
      { Transparent stateD. unfold stateD in *. t_correct. Opaque stateD.
        case_eq (sym_setReg r val (SymRegs ss)); intros.
        destruct ss; destruct SymRegs; destruct p. t_correct.
        unfold sym_setReg in H0. destruct r; inversion H0; subst; t_correct; unfold rupd; simpl; intuition;
        try solve [ repeat rewrite sepFormula_eq in *; unfold sepFormula_def in *; simpl in *; auto ].
        destruct r; inversion H0; subst; t_correct; unfold rupd; simpl; intuition. }
      { eapply (@sym_evalLoc_correct s) in H0; eauto.
        simpl.
        match goal with
          | [ H : MEVAL.swrite_word _ _ _ _ _ _ = _ |- _ ] =>
            eapply (MEVAL.WriteCorrect meval_correct) with (cs := cs) (stn_m := (s0,s1)) in H; eauto with sym_eval_hints
        end.
        simpl in *.
        destruct (WriteWord s0 (Mem s1) (evalLoc s1 l) valD); try contradiction. t_correct.
        Transparent stateD. destruct ss; destruct SymRegs; destruct p. simpl in *. Opaque stateD. intuition. subst.
        eapply sheapD_pures_SF in H3.
        apply AllProvable_app' in H6. apply AllProvable_app; intuition auto. }
      { eapply (@sym_evalLoc_correct s) in H0; eauto.
        simpl.
        match goal with
          | [ H : MEVAL.swrite_byte _ _ _ _ _ _ = _ |- _ ] =>
            eapply (MEVAL.WriteByteCorrect meval_correct) with (cs := cs) (stn_m := (s0,s1)) in H; eauto with sym_eval_hints
        end.
        simpl in *.
        destruct (WriteByte (Mem s1) (evalLoc s1 l) (WtoB valD)); try contradiction. t_correct.
        Transparent stateD. destruct ss; destruct SymRegs; destruct p. simpl in *. Opaque stateD. intuition. subst.
        eapply sheapD_pures_SF in H3.
        apply AllProvable_app' in H6. apply AllProvable_app; intuition auto. }
    Qed.

    Ltac think := instantiate; simpl;
      repeat match goal with
               | [ H : _ = _ |- _ ] => rewrite H
             end; eauto.

    Lemma sym_evalInstr_correct' : forall instr stn_st instrD cs ss ss',
      stateD funcs preds meta_env vars_env cs stn_st ss ->
      sym_instrD funcs meta_env vars_env instr = Some instrD ->
      sym_evalInstr Prover meval facts instr ss = Some ss' ->
      exists st',
        evalInstr (fst stn_st) (snd stn_st) instrD = Some st' /\
        stateD funcs preds meta_env vars_env cs (fst stn_st, st') ss'.
    Proof.
      destruct instr; t_correct; simpl;
        repeat match goal with
                 | [ H : exists x, _ |- _ ] => destruct H
                 | [ H : _ /\ _ |- _ ] => destruct H
                 | [ H : sym_rvalueD _ _ _ _ = _ |- _ ] =>
                   (eapply sym_evalRval_correct in H; think); [ simpl in * ]
                 | [ H : sym_lvalueD _ _ _ _ = _ |- _ ] =>
                   (eapply sym_evalLval_correct in H; think); [ simpl in * ]
                 | [ H : _ = _ |- _ ] => rewrite H
                 | [ |- _ ] => progress (simpl in * )
                 | [ b : binop |- _ ] =>
                   destruct b; unfold fPlus, fMinus, fMult in *; simpl in *
               end; t_correct.
    Qed.

    Lemma sym_assertTest_correct' : forall cs r rD t l lD ss stn_st,
      stateD funcs preds meta_env vars_env cs stn_st ss ->
      sym_rvalueD funcs meta_env vars_env r = Some rD ->
      sym_rvalueD funcs meta_env vars_env l = Some lD ->
      match Structured.evalCond rD t lD (fst stn_st) (snd stn_st) with
        | None =>
          forall res,
            match sym_assertTest Prover meval facts r t l ss res with
              | Some _ => False
              | None => True
            end
        | Some res' =>
          match sym_assertTest Prover meval facts r t l ss res' with
            | Some b =>
              Provable funcs meta_env vars_env b
            | None => True
          end
      end.
    Proof.
      unfold sym_assertTest, Structured.evalCond; destruct stn_st; simpl in *;
        repeat match goal with
                 | [ H : exists x, _ |- _ ] => destruct H
                 | [ H : _ /\ _ |- _ ] => destruct H
                 | [ H : sym_rvalueD _ _ _ _ = _ |- _ ] =>
                   (eapply sym_evalRval_correct in H; think); [ simpl in * ]
                 | [ H : sym_lvalueD _ _ _ _ = _ |- _ ] =>
                   (eapply sym_evalLval_correct in H; think); [ simpl in * ]
                 | [ H : _ = _ |- _ ] => rewrite H
                 | [ |- _ ] => progress (simpl in * )
                 | [ |- context [ evalRvalue ?A ?B ?C ] ] =>
                   case_eq (evalRvalue A B C); intros
                 | [ |- context [ evalTest ?A ?B ?C ] ] =>
                   case_eq (evalTest A B C); intros
                 | [ b : binop |- _ ] =>
                   destruct b; unfold fPlus, fMinus, fMult in *; simpl in *
               end; t_correct; simpl in *;
      try destruct res;
       repeat match goal with
        | [ |- context [ sym_evalRval ?A ?B ?C ?D ?E ] ] =>
          case_eq (sym_evalRval A B C D E); intros
               end; auto;
        unfold Provable; destruct t;
        repeat match goal with
                 | [ |- match match ?X with
                                | Some _ => match ?Y with _ => _ end
                                | _ => _
                              end with _ => _ end ] =>
                   (case_eq X; trivial; case_eq Y; trivial); []

                 | [ H : exists x, _ |- _ ] => destruct H
                 | [ H : _ /\ _ |- _ ] => destruct H
                 | [ H : sym_rvalueD _ _ _ _ = _ |- _ ] =>
                   (eapply sym_evalRval_correct in H; think); [ simpl in * ]
                 | [ H : sym_lvalueD _ _ _ _ = _ |- _ ] =>
                   (eapply sym_evalLval_correct in H; think); [ simpl in * ]
                 | [ H : _ = _ |- _ ] => rewrite H
                 | [ |- _ ] => progress (simpl in * )
                 | [ |- context [ evalRvalue ?A ?B ?C ] ] =>
                   case_eq (evalRvalue A B C); intros
                 | [ |- context [ evalTest ?A ?B ?C ] ] =>
                   consider (evalTest A B C); intros
                 | [ b : binop |- _ ] =>
                   destruct b; unfold fPlus, fMinus, fMult in *; simpl in *
                 | [ |- _ ] => progress t_correct
               end; unfold IL.weqb, IL.wneb, wltb, wleb in *; simpl in *;
        repeat match goal with
                 | [ H : (if ?X then _ else _) = _ |- _ ] =>
                   revert H; consider X; try congruence
                 | [ H : Some _ = Some _ |- _ ] => inversion H; clear H; subst
                 | [ H : ?X = _ , H' : ?X = _ |- _ ] => rewrite H in H'
                 | [ |- context [ wlt_dec ?X ?Y ] ] =>
                   destruct (wlt_dec X Y); try congruence
               end; try congruence; eauto 10 using eq_le, lt_le, le_neq_lt.
      eapply weqb_true_iff; auto.
      intro. apply weqb_true_iff in H1. congruence.
    Qed.

  End typed.

  Section typed2.
    Variable ts : list type.
    Let types := repr bedrock_types_r ts.

    Notation pcT := (tvType 0).
    Notation tvWord := (tvType 0).
    Notation stT := (tvType 1).
    Notation tvState := (tvType 2).
    Notation tvTest := (tvType 3).
    Notation tvReg := (tvType 4).

    Variable fs : functions types.
    Let funcs := repr (bedrock_funcs_r ts) fs.
    Variable preds : SEP.predicates types.

    Variable Prover : ProverT types.
    Variable PC : ProverT_correct Prover funcs.

    Variable meval : MEVAL.MemEvaluator types.
    Variable meval_correct : MEVAL.MemEvaluator_correct pcT stT meval funcs preds tvWord tvWord
      (@IL_mem_satisfies ts) (@IL_ReadWord ts) (@IL_WriteWord ts) (@IL_ReadByte ts) (@IL_WriteByte ts).

    Ltac t_correct :=
      simpl; intros;
        unfold IL_stn_st, IL_mem_satisfies, IL_ReadWord, IL_WriteWord in *;
          repeat (simpl in *;
            match goal with
              | [ H : Some _ = Some _ |- _ ] => inversion H; clear H; subst
              | [ H : prod _ _ |- _ ] => destruct H
              | [ H : match ?X with
                        | Some _ => _
                        | None => _
                      end |- _ ] =>
              revert H; case_eq X; intros; try contradiction
              | [ H : match ?X with
                        | Some _ => _
                        | None => _
                      end = _ |- _ ] =>
              revert H; case_eq X; intros; try congruence
              | [ H : _ = _ |- _ ] => rewrite H
              | [ H : reg |- _ ] => destruct H
            end; intuition); subst.

    Lemma sym_evalInstrs_correct : forall (facts : Facts Prover) (meta_env var_env : env types),
      Valid PC meta_env var_env facts  ->
      forall is stn_st isD cs ss,
        stateD funcs preds meta_env var_env cs stn_st ss ->
        sym_instrsD funcs meta_env var_env is = Some isD ->
        match evalInstrs (fst stn_st) (snd stn_st) isD with
          | Some st' =>
            match sym_evalInstrs Prover meval facts is ss with
              | inl ss' => stateD funcs preds meta_env var_env cs (fst stn_st, st') ss'
              | inr (ss', is') =>
                match sym_instrsD funcs meta_env var_env is' with
                  | None => False
                  | Some is'D =>
                    exists st'', stateD funcs preds meta_env var_env cs (fst stn_st, st'') ss' /\
                      evalInstrs (fst stn_st) st'' is'D = Some st'
                end
            end
          | None =>
            match sym_evalInstrs Prover meval facts is ss with
              | inl ss' => False
              | inr (ss', is') =>
                match sym_instrsD funcs meta_env var_env is' with
                  | None => False
                  | Some is'D =>
                    exists st'', stateD funcs preds meta_env var_env cs (fst stn_st, st'') ss' /\
                      evalInstrs (fst stn_st) st'' is'D = None
                end
            end
        end.
    Proof.
      Opaque stateD.
      induction is; simpl; intros;
        repeat match goal with
                 | [ H : Some _ = Some _ |- _ ] => inversion H; clear H; subst
               end; simpl; destruct stn_st; simpl in *; eauto.
      t_correct. simpl in *.
      case_eq (evalInstr s s0 i); intros.
      case_eq (sym_evalInstr Prover meval facts a ss); intros.

      destruct (@sym_evalInstr_correct' ts fs preds Prover PC meval meval_correct facts meta_env var_env
        H a (s,s0) i cs ss s2 H0 H1 H4). simpl in *. intuition.
      rewrite H6 in H3. inversion H3; clear H3; subst.
      specialize (IHis (s, s1)). simpl in *. eapply IHis; eauto.

      simpl. rewrite H1. rewrite H2. simpl.
      case_eq (evalInstrs s s1 l); intros; exists s0; simpl; rewrite H3; eauto.

      case_eq (sym_evalInstr Prover meval facts a ss); intros.
      Focus 2. simpl. rewrite H1. rewrite H2. exists s0; simpl; rewrite H3; intuition.

      edestruct (@sym_evalInstr_correct' ts fs preds Prover PC meval meval_correct facts meta_env var_env
        H a (s,s0) i cs ss); eauto.
      simpl in *. destruct H5. rewrite H3 in H5. congruence.
      Transparent stateD.
    Qed.

    Variable learnHook : MEVAL.LearnHook types (SymState types).
    Variable learn_correct : @MEVAL.LearnHook_correct _ _ pcT stT learnHook (@stateD _ funcs preds) funcs preds.

    Ltac shatter_state ss :=
      destruct ss as [ ? [ [ ? ? ] ? ] ].

    Lemma skip_to_nil : forall T U (F : T -> U) vars env X,
      map F env = skipn (length vars) X ->
      map F nil = skipn (length (vars ++ env)) X.
    Proof.
      clear. induction vars; simpl; intros; subst.
      induction env; eauto.
      destruct X; auto.
    Qed.
    Lemma AllProvable_cons : forall U G P Ps,
      Provable funcs U G P ->
      AllProvable funcs U G Ps ->
      AllProvable funcs U G (P :: Ps).
    Proof. simpl; intuition. Qed.
    Lemma AllProvable_nil : forall U G,
      AllProvable funcs U G nil.
    Proof. simpl; intuition. Qed.
    Hint Resolve AllProvable_cons AllProvable_nil : env_resolution.
    Hint Resolve Learn_correct : env_resolution.
    Hint Resolve skip_to_nil : env_resolution.

    Lemma skip_prove_nil : forall T U (F : T -> U) vars env X Y,
      map F env = skipn (length vars) X ->
      map F Y = skipn (length (vars ++ env)) X ->
      Y = nil.
    Proof.
      clear. intros. destruct Y; auto.
      eapply skip_to_nil in H. rewrite <- H in H0. simpl in *; congruence.
    Qed.
    Hint Resolve skip_prove_nil : env_resolution.
    Lemma stateD_addToPures : forall U G cs ss stn_st P,
      stateD funcs preds U G cs stn_st ss ->
      Provable funcs U G P ->
      stateD funcs preds U G cs stn_st
      {| SymMem := SymMem ss
        ; SymRegs := SymRegs ss
        ; SymPures := P :: SymPures ss |}.
    Proof.
      Transparent stateD.
      clear. intros; shatter_state ss; destruct stn_st; simpl in *. intuition.
      destruct SymMem; intuition.
      Opaque stateD.
    Qed.
    Hint Resolve stateD_addToPures : stateD_solver.

    Ltac qstateD_solver :=
      eapply existsEach_sem; intros; eexists; split; [ solve [ eauto with env_resolution ] | ];
      let e := fresh in
      eapply forallEach_sem; intro e; intro;
      eauto with stateD_solver.

    Opaque repr stateD.
    Ltac split_congruence :=
      repeat match goal with
               | [ H : prod _ _ |- _ ] => destruct H
             end; congruence.

    Lemma stateD_weaken_vars : forall uvars vars cs stn_st ss' env,
      stateD funcs preds uvars vars cs stn_st ss' ->
      stateD funcs preds uvars (vars ++ env) cs stn_st ss'.
    Proof.
      Transparent stateD.
      clear. intros. destruct stn_st; shatter_state ss'; simpl in *.
      repeat match goal with
               | [ H : _ /\ _ |- _ ] => destruct H
               | [ H : context [ match exprD ?A ?B ?C ?D ?E with _ => _ end ] |- _ ] =>
                 revert H; case_eq (exprD A B C D E); intros; try contradiction
             end; subst.
      rewrite <- app_nil_r with (l := uvars). repeat erewrite exprD_weaken by eassumption.
      intuition. destruct SymMem; auto. erewrite SH.SE_FACTS.sexprD_weaken in H0. eassumption.
      eapply AllProvable_weaken; eauto.
    Qed.
    Lemma stateD_weaken_uvars : forall uvars vars cs stn_st ss' env,
      stateD funcs preds uvars vars cs stn_st ss' ->
      stateD funcs preds (uvars ++ env) vars cs stn_st ss'.
    Proof.
      Transparent stateD.
      clear. intros. destruct stn_st; shatter_state ss'; simpl in *.
      repeat match goal with
               | [ H : _ /\ _ |- _ ] => destruct H
               | [ H : context [ match exprD ?A ?B ?C ?D ?E with _ => _ end ] |- _ ] =>
                 revert H; case_eq (exprD A B C D E); intros; try contradiction
             end; subst.
      rewrite <- app_nil_r with (l := vars). repeat erewrite exprD_weaken by eassumption.
      intuition. destruct SymMem; auto. erewrite SH.SE_FACTS.sexprD_weaken in H0. eassumption.
      eapply AllProvable_weaken; eauto.
    Qed.
    Hint Resolve stateD_weaken_vars stateD_weaken_uvars : stateD_solver.
    Require ListFacts.
    Require Import MirrorShard.Tactics.
    Hint Resolve ListFacts.not_sure ListFacts.map_skipn_all_map_is_nil ListFacts.map_skipn_all_map : env_resolution.

    Lemma sym_locD_weaken : forall ts X A C Y Z,
      sym_locD (types' := ts) X A C Y = Some Z ->
      forall B D,
        sym_locD X (A ++ B) (C ++ D) Y = Some Z.
    Proof.
      clear. destruct Y; simpl; intros; think; auto;
      erewrite exprD_weaken; eauto.
    Qed.

    Lemma sym_lvalueD_weaken : forall ts X A C Y Z,
      sym_lvalueD (types' := ts) X A C Y = Some Z ->
      forall B D,
        sym_lvalueD X (A ++ B) (C ++ D) Y = Some Z.
    Proof.
      clear. destruct Y; simpl; intros; think; auto.
      erewrite sym_locD_weaken; eauto.
      erewrite sym_locD_weaken; eauto.
    Qed.
    Lemma sym_rvalueD_weaken : forall ts X A C Y Z,
      sym_rvalueD (types' := ts) X A C Y = Some Z ->
      forall B D,
        sym_rvalueD X (A ++ B) (C ++ D) Y = Some Z.
    Proof.
      clear. destruct Y; simpl; intros; think; auto.
      erewrite sym_lvalueD_weaken; eauto.
      erewrite exprD_weaken; eauto.
    Qed.

    Lemma sym_instrD_weaken : forall ts X A C Y Z,
      sym_instrD (types' := ts) X A C Y = Some Z ->
      forall B D,
      sym_instrD X (A ++ B) (C ++ D) Y = Some Z.
    Proof.
      clear; destruct Y; simpl; intros; think; auto;
        repeat ((erewrite sym_lvalueD_weaken by eauto) ||
                (erewrite sym_rvalueD_weaken by eauto)); auto.
    Qed.

    Lemma sym_instrsD_weaken : forall ts X A C Y Z,
      sym_instrsD (types' := ts) X A C Y = Some Z ->
      forall B D,
      sym_instrsD X (A ++ B) (C ++ D) Y = Some Z.
    Proof.
      clear. induction Y; simpl; intros; think; auto.
      erewrite sym_instrD_weaken; eauto.
    Qed.

    Lemma istreamD_weaken : forall ts X A C Y Z P L,
      istreamD (types' := ts) X A C Y Z P L ->
      forall B D,
      istreamD X (A ++ B) (C ++ D) Y Z P L.
    Proof.
      clear. induction Y; simpl; intros; think; auto.
      repeat match goal with
               | [ H : match ?X with _ => _ end |- _ ] =>
                 consider X; intros
               | [ H : _ /\ _ |- _ ] => destruct H
               | [ |- _ ] =>
                 (erewrite sym_instrsD_weaken by eauto) ||
                 (erewrite sym_rvalueD_weaken by eauto) ||
                 (erewrite sym_lvalueD_weaken by eauto)
             end; intuition.
    Qed.

    Lemma env_nil_by_length_eq : forall ts L X Y,
      typeof_env (types := ts) L = X ->
      length Y = length X ->
      typeof_env (types := ts) nil = skipn (length L) Y.
    Proof.
      clear. intros. subst.
      erewrite ListFacts.skipn_length_gt; auto. unfold typeof_env in *. rewrite map_length in H0. omega.
    Qed.
    Hint Resolve env_nil_by_length_eq : env_resolution.

    Lemma all2_tvar_seq_dec_true : forall a b,
      Folds.all2 Expr.tvar_seqb a b = true -> a = b.
    Proof.
      clear; induction a; destruct b; simpl; intros; try congruence.
      consider (tvar_seqb a t); intros; subst. erewrite IHa; auto.
    Qed.

    Lemma sym_evalStream_quant_append : forall path facts qs uvars vars ss res,
      sym_evalStream Prover meval learnHook facts path qs uvars vars ss = res ->
      match res with
        | Safe qs' _
        | SafeUntil qs' _ _ => exists qs'', qs' = appendQ qs'' qs
(*        | Unsafe qs'  *)
      end.
    Proof.
      clear.
      induction path; simpl; intros.
      { inversion H. subst. exists QBase.
        clear. simpl; auto. }
      { destruct a. destruct p. consider (sym_evalInstrs Prover meval facts l ss); intros; try congruence.
        eapply IHpath; eauto. destruct p. subst. exists QBase. auto.
        destruct s. destruct o. consider (sym_assertTest Prover meval facts s t s0 ss b); intros.
        repeat match goal with
                 | [ H : match ?X with (_,_) => _ end = _ |- _ ] => destruct X; try congruence
               end.
        eapply IHpath in H0. destruct res; auto; destruct H0; rewrite <- appendQ_assoc in H0; eauto.
        subst; auto. exists QBase; auto.
        repeat match goal with
                 | [ H : match ?X with _ => _ end = _ |- _ ] => destruct X; try congruence
               end; subst;
        try eapply IHpath; eauto.
        exists QBase; auto.
        exists QBase; auto. }
    Qed.

    Hint Extern 1 (@eq (list tvar) _ _) =>
      simpl; repeat (rewrite app_nil_r in * || rewrite typeof_env_app in * || rewrite app_ass ||
        (f_equal; []) || (f_equal; [ solve [ reflexivity | assumption ] | ] || reflexivity || assumption)) : env_resolution.

    Definition NO_MORE_COND : Prop := True.

    Ltac sym_eval_prover IHpath :=
      repeat match goal with
               | [ H : Valid _ (?A ++ ?b) (?C ++ ?d) _
                 , H' : sym_instrsD ?X ?A ?C ?Y = ?Z |- _ ] =>
                 apply sym_instrsD_weaken with (B := b) (D := d) in H'
               | [ H : Valid _ (?A ++ ?b) (?C ++ ?d) _
                 , H' : istreamD ?X ?A ?C ?Y ?Z ?P ?L |- _ ] =>
                 apply istreamD_weaken with (B := b) (D := d) in H'
               | [ H : (_,_) = (_,_) |- _ ] => inversion H; clear H; subst
               | [ H : Some _ = Some _ |- _ ] => inversion H; clear H; subst
               | [ H : Safe _ _ = Safe _ _ |- _ ] => inversion H; clear H; subst
               | [ H : SafeUntil _ _ _ = SafeUntil _ _ _ |- _ ] => inversion H; clear H; subst
               | [ H : inl _ = inl _ |- _ ] => inversion H; clear H; subst
               | [ H : inr _ = inr _ |- _ ] => inversion H; clear H; subst
               | [ H : SymAssertCond _ _ _ _ = SymAssertCond _ _ _ _ |- _ ] => inversion H; clear H; subst
               | [ H : sum (prod _ _) _ |- _ ] => destruct H as [ [ ? ? ] | ? ]
               | [ H : ?X = _ , H' : ?X = _ |- _ ] => rewrite H in H'
               | [ H : option state |- _ ] => destruct H
               | [ H : _ /\ _ |- _ ] => destruct H
               | [ H : ?X = _ , H' : context [ match ?X with _ => _ end ] |- _ ] =>
                 rewrite H in H'
               | [ H : match ?X with _ => _ end |- _ ] =>
                 (revert H; case_eq X; intros; try contradiction); []
               | [ |- _ ] => progress (repeat rewrite app_nil_r in * )
               | [ |- _ ] => solve [ congruence | eauto with stateD_solver ]
               | [ H : ?X -> _ , H' : ?X |- _ ] =>
                 match type of X with
                   | Prop =>
                     specialize (H H')
                 end
               | [ H   : sym_evalInstrs _ _ ?F ?is ?S = _
                 , H'  : evalInstrs ?stn ?st _ = _
                 , H'' : sym_instrsD _ ?U ?G _ = Some ?isD
                 , Hst : stateD _ _ _ _ _ _ _
                 |- _ ] =>
               ( eapply sym_evalInstrs_correct with (stn_st := (stn,st)) (facts := F) (ss := S) in H'' ; eauto ;
                 simpl in H'' ) ; [ clear Hst ]
               | [ H : Structured.evalCond ?l ?A ?r ?B ?C = _
                 , Hst : stateD _ _ ?U ?G ?cs _ _
                 , H' : sym_rvalueD _ _ _ _ = Some ?l
                 , H'' : sym_rvalueD _ _ _ _ = Some ?r |- _ ] =>
               match goal with
                 | [ H : NO_MORE_COND |- _ ] => fail 1
                 | _ =>
                   (generalize Hst; eapply sym_assertTest_correct' with (meta_env := U) (vars_env := G) (t := A) (rD := l) (lD := r) (stn_st := (B,C)) in Hst; eauto using sym_rvalueD_weaken) ; [ intro; simpl in Hst ; assert NO_MORE_COND by (exact I) ]
               end
               | [ H : learnHook _ ?U' ?G' ?SS ?f ?F = (?A, ?B)
                 , H' : stateD _ _ ?U ?G _ _ _
                 , LC : MEVAL.LearnHook_correct _ _ _ _ _ _
                 , PC : ProverT_correct _ _ |- _ ] =>
                 (cutrewrite (U' = typeof_env U) in H; [ | rewrite typeof_env_app; f_equal; auto ] ;
                  cutrewrite (G' = typeof_env G) in H; [ | rewrite typeof_env_app; f_equal; auto ] ;
                  eapply (@MEVAL.hook_sound _ _ _ _ _ _ _ _ LC _ PC U G) with
                    (new_facts := F) (ss := SS) (ss' := A) (quant := B) in H ;
                  eauto using Learn_correct, AllProvable_cons, AllProvable_nil with stateD_solver) ; [ clear H' ]
               | [ H : quantD _ _ _ _ |- quantD _ _ _ _ ] =>
                 eapply quantD_impl; [ eapply H | clear H ; simpl; intros ]
               | [ |- quantD _ _ (appendQ _ ?X) _ ] =>
                 apply quantD_app
               | [ H : appendQ _ _ = appendQ _ _ |- _ ] => apply appendQ_proper in H; subst

               | [ H : appendQ ?A ?B = appendQ _ (appendQ _ ?B) |- _ ] =>
                 rewrite <- appendQ_assoc in H; apply appendQ_proper in H; subst
               | [ H : context [ Safe (appendQ (appendQ ?A ?B) ?C) _ ] |- _ ] =>
                 rewrite appendQ_assoc with (a := A) (b := B) (c := C) in H
               | [ H : context [ SafeUntil (appendQ (appendQ ?A ?B) ?C) _ _ ] |- _ ] =>
                 rewrite appendQ_assoc with (a := A) (b := B) (c := C) in H

               | [ H : sym_evalStream _ _ _ _ _ (appendQ _ ?X) _ _ _ = Safe (appendQ ?Y ?X) _ |- _ ] =>
                 match Y with
                   | appendQ _ _ => fail 1
                   | _ => destruct (sym_evalStream_quant_append _ _ _ _ _ _ H); subst
                 end
               | [ H : sym_evalStream _ _ _ _ _ (appendQ _ (appendQ _ ?X)) _ _ _ = Safe (appendQ ?Y ?X) _ |- _ ] =>
                 match Y with
                   | appendQ _ _ => fail 1
                   | _ => rewrite <- appendQ_assoc in H; destruct (sym_evalStream_quant_append _ _ _ _ _ _ H); subst
                 end
               | [ H : sym_evalStream _ _ _ _ _ (appendQ _ ?X) _ _ _ = SafeUntil (appendQ ?Y ?X) _ _ |- _ ] =>
                 match Y with
                   | appendQ _ _ => fail 1
                   | _ => destruct (sym_evalStream_quant_append _ _ _ _ _ _ H); subst
                 end
               | [ H : sym_evalStream _ _ _ _ _ (appendQ _ (appendQ _ ?X)) _ _ _ = SafeUntil (appendQ ?Y ?X) _ _ |- _ ] =>
                 match Y with
                   | appendQ _ _ => fail 1
                   | _ => rewrite <- appendQ_assoc in H; destruct (sym_evalStream_quant_append _ _ _ _ _ _ H); subst
                 end
               | [ H : EqNat.beq_nat ?X ?Y = true |- _ ] =>
                 symmetry in H; apply EqNat.beq_nat_eq in H
               | [ H : Folds.all2 _ _ _ = true |- _ ] =>
                 eapply all2_tvar_seq_dec_true in H
               | [ H : sym_evalStream _ _ _ _ _ ?QS _ _ _ = _
                 , H' : stateD _ _ ?Uall ?Gall _ (_, ?st) _
                 , H'' : istreamD _ _ _ _ _ ?st _
                 |- _ ] =>
               let t := change (QS) with (appendQ QBase QS) in H at 1 ;
                 eapply IHpath with (env_q := QS) (qs := QBase) (meta_env := Uall) (vars_env := Gall) in H;
                   simpl; subst; intuition (eauto using istreamD_weaken, Valid_weaken with env_resolution) in
               solve [ t ] || (t; [])
               | [ H : forall res : bool, match sym_assertTest _ _ _ _ _ _ _ res with _ => _ end |- _ ] =>
                 specialize (H true); unfold sym_assertTest in H
               | [ H : match ?X with | IL.Eq => _ | _ => _ end = None |- _ ] =>
                 destruct X; congruence
               | [ H : exists x : state, _ |- exists y : state, _ ] =>
                 let s := fresh "st" in
                 solve [ destruct H as [ s ? ] ; exists s ; intuition ]
               | [ H : match ?X with _ => _ end |- _ ] =>
                 (revert H; case_eq X; intros; try contradiction)
               | [ H : match ?X with _ => _ end = _ |- _ ] =>
                 (revert H; case_eq X; intros; try split_congruence)
               | [ H : sym_rvalueD _ _ _ _ = _ |- context [ sym_rvalueD _ _ _ _ ] ] =>
                   erewrite sym_rvalueD_weaken by eauto
               | [ H : option bool |- _ ] => destruct H
             end.

    Lemma evalStream_correct_Safe : forall sound_or_safe cs stn path facts ss qs qs' ss' uvars vars env_q,
      sym_evalStream Prover meval learnHook facts path (appendQ qs env_q) uvars vars ss = Safe (appendQ qs' env_q) ss' ->
      forall meta_env vars_env,
        typeof_env meta_env ++ gatherAll qs = uvars ->
        typeof_env vars_env ++ gatherEx qs = vars ->
        forall st,
          istreamD funcs meta_env vars_env path stn st sound_or_safe ->
        quantD vars_env meta_env qs (fun vars_env meta_env =>
          stateD funcs preds meta_env vars_env cs (stn,st) ss /\
          Valid PC meta_env vars_env facts) ->
        quantD vars_env meta_env qs' (fun vars_env meta_env =>
          match sound_or_safe with
            | None => False
            | Some (st') =>
              stateD funcs preds meta_env vars_env cs (stn, st') ss'
          end).
    Proof.
      Opaque stateD.
      induction path; simpl; intros; sym_eval_prover IHpath; try contradiction.
    Qed.

    Lemma evalStream_correct_SafeUntil : forall sound_or_safe cs stn path facts ss qs qs' ss' is' uvars vars env_q,
      sym_evalStream Prover meval learnHook facts path (appendQ qs env_q) uvars vars ss = SafeUntil (appendQ qs' env_q) ss' is' ->
      forall meta_env vars_env,
        typeof_env meta_env ++ gatherAll qs = uvars ->
        typeof_env vars_env ++ gatherEx qs = vars ->
        forall st,
          istreamD funcs meta_env vars_env path stn st sound_or_safe ->
        quantD vars_env meta_env qs (fun vars_env meta_env =>
          stateD funcs preds meta_env vars_env cs (stn,st) ss /\
          Valid PC meta_env vars_env facts) ->
        quantD vars_env meta_env qs' (fun vars_env meta_env =>
          exists st' : state,
          stateD funcs preds meta_env vars_env cs (stn, st') ss' /\
          istreamD funcs meta_env vars_env is' stn st' sound_or_safe).
    Proof.
      induction path; simpl; intros; sym_eval_prover IHpath; try contradiction.
    Qed.

(*
    Theorem evalStream_correct : forall sound_or_safe cs stn path facts ss qs env_q uvars vars res,
      sym_evalStream Prover meval learnHook facts path (appendQ qs env_q) uvars vars ss = res ->
      forall meta_env vars_env,
        typeof_env meta_env ++ gatherAll qs = uvars ->
        typeof_env vars_env ++ gatherEx qs = vars ->
        forall st,
          istreamD funcs meta_env vars_env path stn st sound_or_safe ->
        quantD vars_env meta_env qs (fun vars_env meta_env =>
          stateD funcs preds meta_env vars_env cs (stn,st) ss /\
          Valid PC meta_env vars_env facts) ->
        match res with
          | Safe qs' ss' =>
            quantD vars_env meta_env qs' (fun vars_env meta_env =>
              match sound_or_safe with
                | None => False
                | Some (st') => stateD funcs preds meta_env vars_env cs (stn, st') ss'
              end)
          | SafeUntil qs' ss' is' =>
            quantD vars_env meta_env qs' (fun vars_env meta_env =>
              exists st' : state,
                stateD funcs preds meta_env vars_env cs (stn, st') ss' /\
                istreamD funcs meta_env vars_env is' stn st' sound_or_safe)
        end.
    Proof.
      destruct res; intros.
      { destruct (sym_evalStream_quant_append _ _ _ _ _ _ H).
        generalize (@evalStream_correct_Safe sound_or_safe cs stn path facts ss qs (appendQ x qs) s uvars vars env_q). subst.
        rewrite appendQ_assoc.
        intro. eapply H0 in H; eauto. }
      { destruct (sym_evalStream_quant_append _ _ _ _ _ _ H).
        generalize (@evalStream_correct_SafeUntil sound_or_safe cs stn path facts ss qs (appendQ x qs) s i uvars vars QBase);
          subst.
        repeat rewrite appendQ_QBase_r. intro. eapply H0 in H; eauto. }
    Qed.
*)
  End typed2.

End SymIL_Correct.


Require Import Ensembles.
Require Import AST.
Require Import Floats.
Require Import Metatheory.
Require Import alist.
Require Import monad.
Require Import targetdata.
Require Import genericvalues.
Require Import Values.
Require Import Memory.
Require Import Integers.
Require Import Coqlib.
Require Import syntax.
Require Import typings.
Require Import static.
Require Import opsem.
Require Import opsem_props.
Require Import opsem_wf.
Require Import vellvm_tactics.

Import LLVMsyntax.
Import LLVMgv.
Import LLVMtd.
Import LLVMtypings.

(* This file defines the non-deterministic instance of Vellvm's operational
   semantics. *)

(* NDGVs implements the signature of GenericValues. *)
Module MNDGVs.

Lemma singleton_inhabited : forall U (x:U), Inhabited U (Singleton U x).
Proof.
  intros. apply Inhabited_intro with (x:=x); auto using In_singleton.
Qed.

Lemma full_set_inhabited : forall U,
  (exists x:U, True) -> Inhabited U (Full_set U).
Proof.
  intros. inversion H.
  apply Inhabited_intro with (x:=x); auto using Full_intro.
Qed.

Definition t := Ensemble GenericValue.
Definition instantiate_gvs (gv : GenericValue) (gvs : t) : Prop :=
  Ensembles.In _ gvs gv.
Definition inhabited (gvs : t) : Prop := Ensembles.Inhabited _ gvs.
Hint Unfold instantiate_gvs inhabited.
Definition cundef_gvs gv ty : t :=
match ty with
| typ_int sz => fun gv => exists z, gv = (Vint (sz-1) z, Mint (sz - 1))::nil
| typ_floatpoint fp_float => fun gv => exists f, gv = (Vsingle f, Mfloat32)::nil
| typ_floatpoint fp_double => fun gv => exists f, gv = (Vfloat f, Mfloat64)::nil
| typ_pointer _ =>
    fun gv => exists b, exists ofs, gv = (Vptr b ofs, AST.Mint 31)::nil
| _ => Singleton GenericValue gv
end.

Definition undef_gvs gv ty : t :=
match ty with
| typ_int sz =>
    Ensembles.Union _ (Singleton _ gv)
      (fun gv => exists z, gv = (Vint (sz-1) z, Mint (sz-1))::nil)
| typ_floatpoint fp_float =>
    Ensembles.Union _ (Singleton _ gv)
      (fun gv => exists f, gv = (Vsingle f, Mfloat32)::nil)
| typ_floatpoint fp_double =>
    Ensembles.Union _ (Singleton _ gv)
      (fun gv => exists f, gv = (Vfloat f, Mfloat64)::nil)
| typ_pointer _ =>
    Ensembles.Union _ (Singleton _ gv)
      (fun gv => exists b, exists ofs, gv = (Vptr b ofs, AST.Mint 31)::nil)
| _ => Singleton GenericValue gv
end.

Definition cgv2gvs (gv:GenericValue) ty : t :=
match gv with
| (Vundef, _)::nil => cundef_gvs gv ty
| _ => Singleton _ gv
end.

Definition gv2gvs (gv:GenericValue) (ty:typ) : t :=
match gv with
| (Vundef, _)::nil => undef_gvs gv ty
| _ => Singleton GenericValue gv
end.

Notation "gv @ gvs" :=
  (instantiate_gvs gv gvs) (at level 43, right associativity).
Notation "$ gv # t $" := (gv2gvs gv t) (at level 41).

Lemma cundef_gvs__getTypeSizeInBits : forall S los nts gv t sz al gv',
  wf_typ S (los,nts) t ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t =
      Some (sz, al) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv ->
  gv' @ (cundef_gvs gv t) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) =
    sizeGenericValue gv'.
Proof.
  intros S los nts gv t sz al gv' Hwft Heq1 Heq2 Hin.
  destruct_typ t; simpl in *;
    try solve [inv Heq1; inv Hin; erewrite int_typsize; eauto |
               inv Heq1; inv Hin; eauto].
    destruct f; try solve [inv Heq1; inv Hin; eauto].
    inv Heq1. inv Hin. inv H. simpl. auto.
Qed.

Lemma cundef_gvs__matches_chunks : forall S los nts gv t gv',
  wf_typ S (los,nts) t ->
  gv_chunks_match_typ (los, nts) gv t ->
  gv' @ (cundef_gvs gv t) ->
  gv_chunks_match_typ (los, nts) gv' t.
Proof.
  intros S los nts gv t gv' Hwft Heq1 Hin.
  unfold gv_chunks_match_typ, vm_matches_typ in *.
  inv_mbind.
  destruct_typ t; simpl in *; uniq_result;
    try solve [inv Heq1; inv Hin; auto].

    inv Heq1; inv Hin.
    constructor; auto.
    split; auto. simpl. split; auto. apply Int.unsigned_range.

    destruct f; uniq_result; inv Heq1; inv Hin; eauto.
      constructor; auto.
      split; auto. simpl. auto.

      constructor; auto.
      split; auto. simpl. auto.

    inv Heq1. inv Hin. inv H.
    constructor; auto.
    split; auto. simpl. auto.
Qed.

Lemma cundef_gvs__inhabited : forall gv ty, inhabited (cundef_gvs gv ty).
Proof.
  destruct_typ ty; simpl;
    try solve [eapply Ensembles.Inhabited_intro; constructor].
    eapply Ensembles.Inhabited_intro.
      exists (Int.zero (s0-1)). auto.

    destruct f; try solve [
      eapply Ensembles.Inhabited_intro; exists Float.zero; auto |
      eapply Ensembles.Inhabited_intro; exists Float32.zero; auto |
      eapply Ensembles.Inhabited_intro; constructor].

    eapply Ensembles.Inhabited_intro.
      exists Mem.nullptr. exists (Int.repr 31 0). auto.
Qed.

Lemma undef_gvs__getTypeSizeInBits : forall S los nts gv t sz al gv',
  wf_typ S (los,nts) t ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t =
      Some (sz, al) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv ->
  gv' @ (undef_gvs gv t) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) =
    sizeGenericValue gv'.
Proof.
  intros S los nts gv t sz al gv' Hwft Heq1 Heq2 Hin.
  destruct_typ t; simpl in *;
    try solve [inv Heq1; inv Hin; erewrite int_typsize; eauto |
               inv Heq1; inv Hin; eauto].

    inv Heq1; inv Hin; inv H; unfold Size.to_nat;
      try solve [eauto | erewrite int_typsize; eauto].

    destruct f; try solve [inv Heq1; inv Hin; eauto |
                           inv Heq1; inv Hin; inv H; auto].

    inv Heq1; inv Hin; inv H; auto.
      inv H0. auto.
Qed.

Lemma undef_gvs__matches_chunks : forall S los nts gv t gv',
  wf_typ S (los,nts) t ->
  gv_chunks_match_typ (los, nts) gv t ->
  gv' @ (undef_gvs gv t) ->
  gv_chunks_match_typ (los, nts) gv' t.
Proof.
  intros S los nts gv t gv' Hwft Heq1 Hin.
  unfold gv_chunks_match_typ, vm_matches_typ in *.
  inv_mbind.
  destruct_typ t; simpl in *; uniq_result; try solve [
    inv Heq1; inv Hin; eauto
  ].

    inv Heq1; inv Hin; inv H.
    constructor; auto.
    constructor; auto.
      split; auto. split; auto. apply Int.unsigned_range.

    destruct f; uniq_result; try solve [
      inv Heq1; inv Hin; eauto
    ].

      inv Heq1; inv Hin; inv H.
      constructor; auto.
      constructor; auto.
        split; auto. simpl. auto.

      inv Heq1; inv Hin; inv H.
      constructor; auto.
      constructor; auto.
        split; auto. simpl. auto.

    inv Heq1; inv Hin; inv H; try solve [congruence | auto].
      match goal with
      | H1: exists _:_, _ |- _ => inv H1;
         constructor; try solve [auto | split; simpl; auto]
      end.
Qed.

Lemma undef_gvs__inhabited : forall gv ty, inhabited (undef_gvs gv ty).
Proof.
  destruct_typ ty; simpl; try solve [
    eapply Ensembles.Inhabited_intro; apply Union_introl; constructor |
    eapply Ensembles.Inhabited_intro; constructor].

    destruct f; try solve [
      eapply Ensembles.Inhabited_intro; apply Union_introl; constructor |
      eapply Ensembles.Inhabited_intro; constructor].
Qed.

Lemma cgv2gvs__getTypeSizeInBits : forall S los nts gv t sz al gv',
  wf_typ S (los,nts) t ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t =
      Some (sz, al) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv ->
  gv' @ (cgv2gvs gv t) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) =
    sizeGenericValue gv'.
Proof.
  intros S los nts gv t sz al gv' Hwft Heq1 Heq2 Hin.
  destruct gv; simpl in *.
    inv Hin. simpl. auto.

    destruct p.
    destruct v; try solve [inv Hin; simpl; auto].
    destruct gv; try solve [inv Hin; simpl; auto].
      eapply cundef_gvs__getTypeSizeInBits in Hin; eauto.
Qed.

Lemma cgv2gvs__matches_chunks : forall S los nts gv t gv',
  wf_typ S (los,nts) t ->
  gv_chunks_match_typ (los, nts) gv t ->
  instantiate_gvs gv' (cgv2gvs gv t) ->
  gv_chunks_match_typ (los, nts) gv' t.
Proof.
  intros S los nts gv t gv' Hwft Heq1 Hin.
  unfold gv_chunks_match_typ, vm_matches_typ in *.
  inv_mbind.
  destruct gv as [|[]]; simpl in *.
    inv Hin. simpl. auto.

    destruct v; try solve [inv Hin; simpl; auto].
    destruct gv; try solve [inv Hin; simpl; auto].
      eapply cundef_gvs__matches_chunks in Hin;
        unfold gv_chunks_match_typ, vm_matches_typ in *; simpl in *; eauto.
        rewrite <- HeqR in Hin. auto.
        rewrite <- HeqR. auto.
Qed.

Lemma cgv2gvs__inhabited : forall gv t, inhabited (cgv2gvs gv t).
Proof.
  intros gv t.
  destruct gv; simpl.
    apply Ensembles.Inhabited_intro with (x:=nil).
    apply Ensembles.In_singleton.

    destruct p.
    destruct v; auto using singleton_inhabited, cundef_gvs__inhabited.
    destruct gv; auto using singleton_inhabited, cundef_gvs__inhabited.
Qed.

Lemma gv2gvs__getTypeSizeInBits : forall S los nts gv t sz al,
  wf_typ S (los,nts) t ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t =
      Some (sz, al) ->
  Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8) = sizeGenericValue gv ->
  forall gv', gv' @ (gv2gvs gv t) ->
  sizeGenericValue gv' = Coqlib.nat_of_Z (Coqlib.ZRdiv (Z_of_nat sz) 8).
Proof.
  intros S los nts gv t sz al Hwft Heq1 Heq2 gv' Hin.
  destruct gv; simpl in *.
    inv Hin. simpl. auto.

    destruct p.
    destruct v; try solve [inv Hin; simpl; auto].
    destruct gv; try solve [inv Hin; simpl; auto].
      eapply undef_gvs__getTypeSizeInBits in Hin; eauto.
Qed.

Lemma gv2gvs__matches_chunks : forall S los nts gv t,
  wf_typ S (los,nts) t ->
  gv_chunks_match_typ (los, nts) gv t ->
  forall gv', gv' @ (gv2gvs gv t) ->
  gv_chunks_match_typ (los, nts) gv' t.
Proof.
  intros S los nts gv t Hwft Heq1 gv' Hin.
  unfold gv_chunks_match_typ, vm_matches_typ in *.
  inv_mbind.
  destruct gv as [|[]]; simpl in *.
    inv Hin. simpl. auto.

    destruct v; try solve [inv Hin; simpl; auto].
    destruct gv; try solve [inv Hin; simpl; auto].
      eapply undef_gvs__matches_chunks in Hin;
        unfold gv_chunks_match_typ, vm_matches_typ in *; simpl in *; eauto.
        rewrite <- HeqR in Hin. auto.
        rewrite <- HeqR. auto.
Qed.

Lemma gv2gvs__inhabited : forall gv t, inhabited ($ gv # t $).
Proof.
  intros gv t.
  destruct gv; simpl.
    apply Ensembles.Inhabited_intro with (x:=nil).
    apply Ensembles.In_singleton.

    destruct p.
    destruct v; auto using singleton_inhabited, undef_gvs__inhabited.
    destruct gv; auto using singleton_inhabited, undef_gvs__inhabited.
Qed.

Definition lift_op1 (f: GenericValue -> option GenericValue) gvs1 ty : option t
  :=
  Some (fun gv2 => exists gv1, exists gv2',
    gv1 @ gvs1 /\ f gv1 = Some gv2' /\ (gv2 @ $ gv2' # ty $)).

Definition lift_op2 (f: GenericValue -> GenericValue -> option GenericValue)
  gvs1 gvs2 ty : option t :=
  Some (fun gv3 => exists gv1, exists gv2, exists gv3',
    gv1 @ gvs1 /\ gv2 @ gvs2 /\ f gv1 gv2 = Some gv3' /\ (gv3 @ $ gv3' # ty $)).

Lemma lift_op1__inhabited : forall f gvs1 ty gvs2
  (H:forall x, exists z, f x = Some z),
  inhabited gvs1 ->
  lift_op1 f gvs1 ty = Some gvs2 ->
  inhabited gvs2.
Proof.
  intros. inv H1. inv H0.
  destruct (@H x) as [z J].
  destruct (@gv2gvs__inhabited z ty).
  exists x0. unfold Ensembles.In. exists x. exists z.
  rewrite J.
  repeat (split; auto).
Qed.

Lemma lift_op2__inhabited : forall f gvs1 gvs2 ty gv3
  (H:forall x y, exists z, f x y = Some z),
  inhabited gvs1 -> inhabited gvs2 ->
  lift_op2 f gvs1 gvs2 ty = Some gv3 ->
  inhabited gv3.
Proof.
  intros. inv H0. inv H1. inv H2.
  destruct (@H x x0) as [z J].
  destruct (@gv2gvs__inhabited z ty).
  exists x1. unfold Ensembles.In. exists x. exists x0. exists z.
  rewrite J.
  repeat (split; auto).
Qed.

Lemma lift_op1__isnt_stuck : forall f gvs1 ty
  (H:forall x, exists z, f x = Some z),
  exists gvs2, lift_op1 f gvs1 ty = Some gvs2.
Proof.
  intros. unfold lift_op1. eauto.
Qed.

Lemma lift_op2__isnt_stuck : forall f gvs1 gvs2 ty
  (H:forall x y, exists z, f x y = Some z),
  exists gv3, lift_op2 f gvs1 gvs2 ty = Some gv3.
Proof.
  intros. unfold lift_op2. eauto.
Qed.

Lemma lift_op1__getTypeSizeInBits : forall S los nts f g t sz al gvs,
  wf_typ S (los,nts) t ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t =
      Some (sz, al) ->
  (forall x y, x @ g -> f x = Some y ->
   sizeGenericValue y = nat_of_Z (ZRdiv (Z_of_nat sz) 8)) ->
  lift_op1 f g t = Some gvs ->
  forall gv : GenericValue,
  gv @ gvs ->
  sizeGenericValue gv = nat_of_Z (ZRdiv (Z_of_nat sz) 8).
Proof.
  intros. inv H2.
  destruct H3 as [x [y [J1 [J2 J3]]]].
  apply H1 in J2; auto.
  eapply gv2gvs__getTypeSizeInBits; eauto.
Qed.

Lemma lift_op1__matches_chunks : forall S los nts f g t gvs
  (Hwft: wf_typ S (los,nts) t),
  (forall x y, x @ g -> f x = Some y ->
   gv_chunks_match_typ (los, nts) y t) ->
  lift_op1 f g t = Some gvs ->
  forall gv : GenericValue,
  gv @ gvs ->
  gv_chunks_match_typ (los, nts) gv t.
Proof.
  intros. inv H0.
  destruct H1 as [x [y [J1 [J2 J3]]]].
  apply H in J2; auto.
  eapply gv2gvs__matches_chunks; eauto.
Qed.

Lemma lift_op2__getTypeSizeInBits : forall S los nts f g1 g2 t sz al gvs,
  wf_typ S (los,nts) t ->
  _getTypeSizeInBits_and_Alignment los
    (getTypeSizeInBits_and_Alignment_for_namedts (los,nts) true) true t =
      Some (sz, al) ->
  (forall x y z, x @ g1 -> y @ g2 -> f x y = Some z ->
   sizeGenericValue z = nat_of_Z (ZRdiv (Z_of_nat sz) 8)) ->
  lift_op2 f g1 g2 t = Some gvs ->
  forall gv : GenericValue,
  gv @ gvs ->
  sizeGenericValue gv = nat_of_Z (ZRdiv (Z_of_nat sz) 8).
Proof.
  intros. inv H2.
  destruct H3 as [x [y [z [J1 [J2 [J3 J4]]]]]].
  apply H1 in J3; auto.
  eapply gv2gvs__getTypeSizeInBits; eauto.
Qed.

Lemma lift_op2__matches_chunks : forall S los nts f g1 g2 t gvs
  (Hwft: wf_typ S (los,nts) t),
  (forall x y z, x @ g1 -> y @ g2 -> f x y = Some z ->
   gv_chunks_match_typ (los, nts) z t) ->
  lift_op2 f g1 g2 t = Some gvs ->
  forall gv : GenericValue,
  gv @ gvs ->
  gv_chunks_match_typ (los, nts) gv t.
Proof.
  intros. inv H0.
  destruct H1 as [x [y [z [J1 [J2 [J3 J4]]]]]].
  apply H in J3; auto.
  eapply gv2gvs__matches_chunks; eauto.
Qed.

Lemma inhabited_inv : forall gvs, inhabited gvs -> exists gv, gv @ gvs.
Proof.
  intros. inv H; eauto.
Qed.

Lemma instantiate_undef__undef_gvs : forall gv t, gv @ (undef_gvs gv t).
Proof.
  intros. unfold undef_gvs.
  destruct_typ t0; try solve [apply Union_introl; constructor | constructor].
  destruct f;
    try solve [apply Union_introl; constructor | constructor].
Qed.

Lemma instantiate_gv__gv2gvs : forall gv t, gv @ ($ gv # t $).
Proof.
  intros.
  destruct gv; simpl; try constructor.
  destruct p; simpl; try constructor.
  destruct v; simpl; try constructor.
  destruct gv; simpl;
    try solve [constructor | auto using instantiate_undef__undef_gvs].
Qed.

Lemma none_undef2gvs_inv : forall gv gv' t,
  gv @ $ gv' # t $ -> (forall mc, (Vundef, mc)::nil <> gv') -> gv = gv'.
Proof.
  intros.
  destruct gv'; try solve [inv H; auto].
  destruct p.
  destruct v; try solve [inv H; auto].
  destruct gv'; try solve [inv H; auto].
  assert (J:=@H0 m). congruence.
Qed.

End MNDGVs.

Definition NDGVs : GenericValues := mkGVs
MNDGVs.t
MNDGVs.instantiate_gvs
MNDGVs.inhabited
MNDGVs.cgv2gvs
MNDGVs.gv2gvs
MNDGVs.lift_op1
MNDGVs.lift_op2
MNDGVs.cgv2gvs__getTypeSizeInBits
MNDGVs.cgv2gvs__matches_chunks
MNDGVs.cgv2gvs__inhabited
MNDGVs.gv2gvs__getTypeSizeInBits
MNDGVs.gv2gvs__matches_chunks
MNDGVs.gv2gvs__inhabited
MNDGVs.lift_op1__inhabited
MNDGVs.lift_op2__inhabited
MNDGVs.lift_op1__isnt_stuck
MNDGVs.lift_op2__isnt_stuck
MNDGVs.lift_op1__getTypeSizeInBits
MNDGVs.lift_op2__getTypeSizeInBits
MNDGVs.lift_op1__matches_chunks
MNDGVs.lift_op2__matches_chunks
MNDGVs.inhabited_inv
MNDGVs.instantiate_gv__gv2gvs
MNDGVs.none_undef2gvs_inv.


(**************************************************************************)
(*  This file is part of CertrBPF,                                        *)
(*  a formally verified rBPF verifier + interpreter + JIT in Coq.         *)
(*                                                                        *)
(*  Copyright (C) 2022 Inria                                              *)
(*                                                                        *)
(*  This program is free software; you can redistribute it and/or modify  *)
(*  it 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 program is distributed in the hope that it will be useful,       *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of        *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the         *)
(*  GNU General Public License for more details.                          *)
(*                                                                        *)
(**************************************************************************)

From Coq Require Import List ZArith.
Import ListNotations.

From compcert Require Import Integers.

From dx Require Import ResultMonad IR.

From bpf.dxcomm Require Import InfComp GenMatchable CoqIntegers DxNat.
From bpf.verifier.synthesismodel Require Import opcode_synthesis.

(******************** Dx related *******************)

Open Scope Z_scope.

Definition opcodeCompilableType :=
  MkCompilableType opcode C_U8.

Definition opcodeCompilableTypeMatchableType : MatchableType:=
  Eval compute in
 (mkEnumMatchableType
    opcodeCompilableType  opcode_eqb
    (     (ALU64, 0x07)
       :: (ALU32, 0x04)
       :: (Branch, 0x05)
       :: (LD_IMM, 0x00)
       :: (LD_REG, 0x01)
       :: (ST_IMM, 0x02)
       :: (ST_REG, 0x03) :: nil)
    ILLEGAL
    (fun m A => opcode_rect (fun _ => m A))).

Instance CINT : CType nat := mkCType _ (cType nat8CompilableType).
Instance COP : CType opcode := mkCType _ (cType opcodeCompilableType).

Definition opcodeSymbolType :=
  MkCompilableSymbolType [nat8CompilableType] (Some opcodeCompilableType).

Definition Const_nat_to_opcode :=
  ltac: (mkprimitive nat_to_opcode
                (fun es => match es with
                           | [e1] => Ok (Csyntax.Ecast (Csyntax.Ebinop Cop.Oand e1 C_NAT8_0x07 C_U8) C_U8)
                           | _       => Err PrimitiveEncodingFailed
                           end)).

Definition opcode_alu64_immCompilableType :=
  MkCompilableType opcode_alu64_imm C_U8.

Definition opcode_alu64_immCompilableTypeMatchableType : MatchableType:=
  Eval compute in
 (mkEnumMatchableType
    opcode_alu64_immCompilableType  opcode_alu64_imm_eqb
    (     (ADD64_IMM, 0x07)
       :: (SUB64_IMM, 0x17)
       :: (MUL64_IMM, 0x27)
       :: (DIV64_IMM, 0x37)
       :: (OR64_IMM,  0x47)
       :: (AND64_IMM, 0x57)
       :: (LSH64_IMM, 0x67)
       :: (RSH64_IMM, 0x77)
       :: (NEG64_IMM, 0x87)
       :: (MOD64_IMM, 0x97)
       :: (XOR64_IMM, 0xa7)
       :: (MOV64_IMM, 0xb7)
       :: (ARSH64_IMM, 0xc7) :: nil)
    ALU64_IMM_ILLEGAL
    (fun m A => opcode_alu64_imm_rect (fun _ => m A))).

Instance COP_alu64_imm : CType opcode_alu64_imm  := mkCType _ (cType opcode_alu64_immCompilableType).

Definition opcode_alu64_immSymbolType :=
  MkCompilableSymbolType [nat8CompilableType] (Some opcode_alu64_immCompilableType).

Definition Const_nat_to_opcode_alu64_imm :=
  ltac: (mkprimitive nat_to_opcode_alu64_imm
                (fun es => match es with
                           | [e1] => Ok (e1)
                           | _       => Err PrimitiveEncodingFailed
                           end)).

Definition opcode_alu64_regCompilableType :=
  MkCompilableType opcode_alu64_reg C_U8.

Definition opcode_alu64_regCompilableTypeMatchableType : MatchableType:=
  Eval compute in
 (mkEnumMatchableType
    opcode_alu64_regCompilableType  opcode_alu64_reg_eqb
    (     (ADD64_REG, 0x0f)
       :: (SUB64_REG, 0x1f)
       :: (MUL64_REG, 0x2f)
       :: (DIV64_REG, 0x3f)
       :: (OR64_REG,  0x4f)
       :: (AND64_REG, 0x5f)
       :: (LSH64_REG, 0x6f)
       :: (RSH64_REG, 0x7f)
       :: (MOD64_REG, 0x9f)
       :: (XOR64_REG, 0xaf)
       :: (MOV64_REG, 0xbf)
       :: (ARSH64_REG, 0xcf) :: nil)
    ALU64_REG_ILLEGAL
    (fun m A => opcode_alu64_reg_rect (fun _ => m A))).

Instance COP_alu64_reg : CType opcode_alu64_reg  := mkCType _ (cType opcode_alu64_regCompilableType).

Definition opcode_alu64_regSymbolType :=
  MkCompilableSymbolType [nat8CompilableType] (Some opcode_alu64_regCompilableType).

Definition Const_nat_to_opcode_alu64_reg :=
  ltac: (mkprimitive nat_to_opcode_alu64_reg
                (fun es => match es with
                           | [e1] => Ok (e1)
                           | _       => Err PrimitiveEncodingFailed
                           end)).

Definition opcode_alu32_immCompilableType :=
  MkCompilableType opcode_alu32_imm C_U8.

Definition opcode_alu32_immCompilableTypeMatchableType : MatchableType:=
  Eval compute in
 (mkEnumMatchableType
    opcode_alu32_immCompilableType  opcode_alu32_imm_eqb
    (     (ADD32_IMM, 0x04)
       :: (SUB32_IMM, 0x14)
       :: (MUL32_IMM, 0x24)
       :: (DIV32_IMM, 0x34)
       :: (OR32_IMM,  0x44)
       :: (AND32_IMM, 0x54)
       :: (LSH32_IMM, 0x64)
       :: (RSH32_IMM, 0x74)
       :: (NEG32_IMM, 0x84)
       :: (MOD32_IMM, 0x94)
       :: (XOR32_IMM, 0xa4)
       :: (MOV32_IMM, 0xb4)
       :: (ARSH32_IMM, 0xc4) :: nil)
    ALU32_IMM_ILLEGAL
    (fun m A => opcode_alu32_imm_rect (fun _ => m A))).

Instance COP_alu32_imm : CType opcode_alu32_imm  := mkCType _ (cType opcode_alu32_immCompilableType).

Definition opcode_alu32_immSymbolType :=
  MkCompilableSymbolType [nat8CompilableType] (Some opcode_alu32_immCompilableType).

Definition Const_nat_to_opcode_alu32_imm :=
  ltac: (mkprimitive nat_to_opcode_alu32_imm
                (fun es => match es with
                           | [e1] => Ok (e1)
                           | _       => Err PrimitiveEncodingFailed
                           end)).

Definition opcode_alu32_regCompilableType :=
  MkCompilableType opcode_alu32_reg C_U8.

Definition opcode_alu32_regCompilableTypeMatchableType : MatchableType:=
  Eval compute in
 (mkEnumMatchableType
    opcode_alu32_regCompilableType  opcode_alu32_reg_eqb
    (     (ADD32_REG, 0x0c)
       :: (SUB32_REG, 0x1c)
       :: (MUL32_REG, 0x2c)
       :: (DIV32_REG, 0x3c)
       :: (OR32_REG,  0x4c)
       :: (AND32_REG, 0x5c)
       :: (LSH32_REG, 0x6c)
       :: (RSH32_REG, 0x7c)
       :: (MOD32_REG, 0x9c)
       :: (XOR32_REG, 0xac)
       :: (MOV32_REG, 0xbc)
       :: (ARSH32_REG, 0xcc) :: nil)
    ALU32_REG_ILLEGAL
    (fun m A => opcode_alu32_reg_rect (fun _ => m A))).

Instance COP_alu32_reg : CType opcode_alu32_reg  := mkCType _ (cType opcode_alu32_regCompilableType).

Definition opcode_alu32_regSymbolType :=
  MkCompilableSymbolType [nat8CompilableType] (Some opcode_alu32_regCompilableType).

Definition Const_nat_to_opcode_alu32_reg :=
  ltac: (mkprimitive nat_to_opcode_alu32_reg
                (fun es => match es with
                           | [e1] => Ok (e1)
                           | _       => Err PrimitiveEncodingFailed
                           end)).

Definition opcode_branch_immCompilableType :=
  MkCompilableType opcode_branch_imm C_U8.

Definition opcode_branch_immCompilableTypeMatchableType : MatchableType:=
  Eval compute in
 (mkEnumMatchableType
    opcode_branch_immCompilableType  opcode_branch_imm_eqb
    (     (JA_IMM,  0x05)
       :: (JEQ_IMM, 0x15)
       :: (JGT_IMM, 0x25)
       :: (JGE_IMM, 0x35)
       :: (JLT_IMM, 0xa5)
       :: (JLE_IMM, 0xb5)
       :: (JNE_IMM, 0x45)
       :: (JNE_IMM, 0x55)
       :: (JSGT_IMM, 0x65)
       :: (JSGE_IMM, 0x75)
       :: (JSLT_IMM, 0xc5)
       :: (JSLE_IMM, 0xd5)
       :: (CALL_IMM, 0x85)
       :: (RET_IMM, 0x95) :: nil)
    JMP_IMM_ILLEGAL_INS
    (fun m A => opcode_branch_imm_rect (fun _ => m A))).

Instance COP_branch_imm : CType opcode_branch_imm  := mkCType _ (cType opcode_branch_immCompilableType).

Definition opcode_branch_immSymbolType :=
  MkCompilableSymbolType [nat8CompilableType] (Some opcode_branch_immCompilableType).

Definition Const_nat_to_opcode_branch_imm :=
  ltac: (mkprimitive nat_to_opcode_branch_imm
                (fun es => match es with
                           | [e1] => Ok (e1)
                           | _       => Err PrimitiveEncodingFailed
                           end)).

Definition opcode_branch_regCompilableType :=
  MkCompilableType opcode_branch_reg C_U8.

Definition opcode_branch_regCompilableTypeMatchableType : MatchableType:=
  Eval compute in
 (mkEnumMatchableType
    opcode_branch_regCompilableType  opcode_branch_reg_eqb
    (     (JEQ_REG, 0x1d)
       :: (JGT_REG, 0x2d)
       :: (JGE_REG, 0x3d)
       :: (JLT_REG,  0xad)
       :: (JLE_REG, 0xbd)
       :: (JSET_REG, 0x4d)
       :: (JNE_REG, 0x5d)
       :: (JSGT_REG, 0x6d)
       :: (JSGE_REG, 0x7d)
       :: (JSLT_REG, 0xcd)
       :: (JSLE_REG, 0xdd) :: nil)
    JMP_REG_ILLEGAL_INS
    (fun m A => opcode_branch_reg_rect (fun _ => m A))).

Instance COP_branch_reg : CType opcode_branch_reg  := mkCType _ (cType opcode_branch_regCompilableType).

Definition opcode_branch_regSymbolType :=
  MkCompilableSymbolType [nat8CompilableType] (Some opcode_branch_regCompilableType).

Definition Const_nat_to_opcode_branch_reg :=
  ltac: (mkprimitive nat_to_opcode_branch_reg
                (fun es => match es with
                           | [e1] => Ok (e1)
                           | _       => Err PrimitiveEncodingFailed
                           end)).

Definition opcode_load_immCompilableType :=
  MkCompilableType opcode_load_imm C_U8.

Definition opcode_load_immCompilableTypeMatchableType : MatchableType:=
  Eval compute in
 (mkEnumMatchableType
    opcode_load_immCompilableType  opcode_load_imm_eqb
    (     (LDDW_low,  0x18)
       :: (LDDW_high, 0x10) :: nil)
    LDX_IMM_ILLEGAL_INS
    (fun m A => opcode_load_imm_rect (fun _ => m A))).

Instance COP_load_imm : CType opcode_load_imm  := mkCType _ (cType opcode_load_immCompilableType).

Definition opcode_load_immSymbolType :=
  MkCompilableSymbolType [nat8CompilableType] (Some opcode_load_immCompilableType).

Definition Const_nat_to_opcode_load_imm :=
  ltac: (mkprimitive nat_to_opcode_load_imm
                (fun es => match es with
                           | [e1] => Ok (e1)
                           | _       => Err PrimitiveEncodingFailed
                           end)).

Definition opcode_load_regCompilableType :=
  MkCompilableType opcode_load_reg C_U8.

Definition opcode_load_regCompilableTypeMatchableType : MatchableType:=
  Eval compute in
 (mkEnumMatchableType
    opcode_load_regCompilableType  opcode_load_reg_eqb
    (     (LDXW, 0x61)
       :: (LDXH, 0x69)
       :: (LDXB, 0x71)
       :: (LDXDW,  0x79) :: nil)
    LDX_REG_ILLEGAL_INS
    (fun m A => opcode_load_reg_rect (fun _ => m A))).

Instance COP_load_reg : CType opcode_load_reg  := mkCType _ (cType opcode_load_regCompilableType).

Definition opcode_load_regSymbolType :=
  MkCompilableSymbolType [nat8CompilableType] (Some opcode_load_regCompilableType).

Definition Const_nat_to_opcode_load_reg :=
  ltac: (mkprimitive nat_to_opcode_load_reg
                (fun es => match es with
                           | [e1] => Ok (e1)
                           | _       => Err PrimitiveEncodingFailed
                           end)).

Definition opcode_store_immCompilableType :=
  MkCompilableType opcode_store_imm C_U8.

Definition opcode_store_immCompilableTypeMatchableType : MatchableType:=
  Eval compute in
 (mkEnumMatchableType
    opcode_store_immCompilableType  opcode_store_imm_eqb
    (     (STW,  0x62)
       :: (STH,  0x6a)
       :: (STB,  0x72)
       :: (STDW, 0x7a) :: nil)
    ST_ILLEGAL_INS
    (fun m A => opcode_store_imm_rect (fun _ => m A))).

Instance COP_store_imm : CType opcode_store_imm  := mkCType _ (cType opcode_store_immCompilableType).

Definition opcode_store_immSymbolType :=
  MkCompilableSymbolType [nat8CompilableType] (Some opcode_store_immCompilableType).

Definition Const_nat_to_opcode_store_imm :=
  ltac: (mkprimitive nat_to_opcode_store_imm
                (fun es => match es with
                           | [e1] => Ok (e1)
                           | _       => Err PrimitiveEncodingFailed
                           end)).

Definition opcode_store_regCompilableType :=
  MkCompilableType opcode_store_reg C_U8.

Definition opcode_store_regCompilableTypeMatchableType : MatchableType:=
  Eval compute in
 (mkEnumMatchableType
    opcode_store_regCompilableType  opcode_store_reg_eqb
    (     (STXW,  0x63)
       :: (STXH,  0x6b)
       :: (STXB,  0x73)
       :: (STXDW, 0x7b) :: nil)
    STX_ILLEGAL_INS
    (fun m A => opcode_store_reg_rect (fun _ => m A))).

Instance COP_store_reg : CType opcode_store_reg  := mkCType _ (cType opcode_store_regCompilableType).

Definition opcode_store_regSymbolType :=
  MkCompilableSymbolType [nat8CompilableType] (Some opcode_store_regCompilableType).

Definition Const_nat_to_opcode_store_reg :=
  ltac: (mkprimitive nat_to_opcode_store_reg
                (fun es => match es with
                           | [e1] => Ok (e1)
                           | _       => Err PrimitiveEncodingFailed
                           end)).
Close Scope Z_scope.

Module Exports.
  Definition opcodeCompilableTypeMatchableType            := opcodeCompilableTypeMatchableType.
  Definition Const_nat_to_opcode                          := Const_nat_to_opcode.
  Definition opcode_alu64_immCompilableTypeMatchableType  := opcode_alu64_immCompilableTypeMatchableType.
  Definition Const_nat_to_opcode_alu64_imm                := Const_nat_to_opcode_alu64_imm.
  Definition opcode_alu64_regCompilableTypeMatchableType  := opcode_alu64_regCompilableTypeMatchableType.
  Definition Const_nat_to_opcode_alu64_reg                := Const_nat_to_opcode_alu64_reg.
  Definition opcode_alu32_immCompilableTypeMatchableType  := opcode_alu32_immCompilableTypeMatchableType.
  Definition Const_nat_to_opcode_alu32_imm                := Const_nat_to_opcode_alu32_imm.
  Definition opcode_alu32_regCompilableTypeMatchableType  := opcode_alu32_regCompilableTypeMatchableType.
  Definition Const_nat_to_opcode_alu32_reg                := Const_nat_to_opcode_alu32_reg.
  Definition opcode_branch_immCompilableTypeMatchableType := opcode_branch_immCompilableTypeMatchableType.
  Definition Const_nat_to_opcode_branch_imm               := Const_nat_to_opcode_branch_imm.
  Definition opcode_branch_regCompilableTypeMatchableType := opcode_branch_regCompilableTypeMatchableType.
  Definition Const_nat_to_opcode_branch_reg               := Const_nat_to_opcode_branch_reg.
  Definition opcode_load_immCompilableTypeMatchableType   := opcode_load_immCompilableTypeMatchableType.
  Definition Const_nat_to_opcode_load_imm                 := Const_nat_to_opcode_load_imm.
  Definition opcode_load_regCompilableTypeMatchableType   := opcode_load_regCompilableTypeMatchableType.
  Definition Const_nat_to_opcode_load_reg                 := Const_nat_to_opcode_load_reg.
  Definition opcode_store_immCompilableTypeMatchableType  := opcode_store_immCompilableTypeMatchableType.
  Definition Const_nat_to_opcode_store_imm                := Const_nat_to_opcode_store_imm.
  Definition opcode_store_regCompilableTypeMatchableType  := opcode_store_regCompilableTypeMatchableType.
  Definition Const_nat_to_opcode_store_reg                := Const_nat_to_opcode_store_reg.
End Exports.