From compcert Require Import Maps AST Values Memory Globalenvs Ctypes.
From compcert Require Coqlib Clight Clightdefs.

Require Import String List ZArith Lia.

Require Import sflib.
Require Import StdlibExt IntegersExt.
Require Import IPModel IntByteModel.

Require Import NWSysModel.
Require Import RTSysEnv.
Require Import MWITree.

Require Import VerifProgBase.
Require Import config_prm main_prm SystemProgs.

Local Open Scope Z.
Local Opaque Z.of_nat Z.to_nat.
Arguments Z.add: simpl nomatch.

Section INIT_DATA_LEMMAS.
  Context `{SystemEnv}.

  Variable p: Clight.program.
  Let ge := Genv.globalenv p.

  Variable m: Mem.mem.
  Hypothesis INIT_MEM: Genv.init_mem p = Some m.

  Section TASK_ID.
    (* App is responsible to define TASK_ID  *)

    Variable tid: nat.
    Hypothesis RANGE_TID: (Z.of_nat tid <= Byte.max_signed)%Z.

    Hypothesis DEFMAP: (prog_defmap p) ! main_prm._TASK_ID =
                       Some (Gvar (v_TASK_ID_p (Z.of_nat tid))).

    Lemma _init_mem_tid
      : exists b_tid,
        Genv.find_symbol ge main_prm._TASK_ID = Some b_tid /\
        (b_tid < Genv.genv_next ge)%positive /\
        Mem.load Mint8signed m b_tid 0%Z =
        Some (Vint (IntNat.of_nat tid)).
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      esplits; eauto.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOAD_STORE.
      { ss. }
      clear LOAD_STORE. clear - RANGE_TID.
      intro LOAD_STORE. ss. des.
      rewrite Mem.load_int8_signed_unsigned.
      rewrite LOAD_STORE. ss.

      repeat f_equal.
      rewrite Int.sign_ext_zero_ext by ss.

      apply sign_ext_byte_range.
      r. split; ss.
      etransitivity.
      - instantiate (1:= 0%Z). ss.
      - nia.
    Qed.
  End TASK_ID.

  (** ** pals_period *)

  Section PALS_PERIOD.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._PALS_PERIOD =
      Some (Gvar (config_prm.v_PALS_PERIOD (Z.of_nat period))).

    Lemma _init_mem_pals_period
      : exists b_pprd,
        Genv.find_symbol ge main_prm._PALS_PERIOD = Some b_pprd /\
        (b_pprd < Genv.genv_next ge)%positive /\
        Mem.load Mint64 m b_pprd 0%Z =
        Some (Vlong (IntNat.of_nat64 period)).
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      esplits; eauto.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOAD_STORE.
      { ss. }
      clear LOAD_STORE.
      intro LOAD_STORE. ss. des.
      rewrite LOAD_STORE. ss.
    Qed.
  End PALS_PERIOD.

  Section MAX_CSKEW.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._MAX_CSKEW =
      Some (Gvar (config_prm.v_MAX_CSKEW (Z.of_nat max_clock_skew))).

    Lemma _init_mem_max_cskew
      : exists b_sk,
        Genv.find_symbol ge main_prm._MAX_CSKEW = Some b_sk /\
        (b_sk < Genv.genv_next ge)%positive /\
        Mem.load Mint64 m b_sk 0%Z =
        Some (Vlong (IntNat.of_nat64 max_clock_skew)).
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      esplits; eauto.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOAD_STORE.
      { ss. }
      clear LOAD_STORE.
      intro LOAD_STORE. ss. des.
      rewrite LOAD_STORE. ss.
    Qed.
  End MAX_CSKEW.

  Section MAX_NWDELAY.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._MAX_NWDELAY =
      Some (Gvar (config_prm.v_MAX_NWDELAY (Z.of_nat max_nw_delay))).

    Lemma _init_mem_max_nwdelay
      : exists b_nd,
        Genv.find_symbol ge main_prm._MAX_NWDELAY = Some b_nd /\
        (b_nd < Genv.genv_next ge)%positive /\
        Mem.load Mint64 m b_nd 0%Z =
        Some (Vlong (IntNat.of_nat64 max_nw_delay)).
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      esplits; eauto.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOAD_STORE.
      { ss. }
      clear LOAD_STORE.
      intro LOAD_STORE. ss. des.
      rewrite LOAD_STORE. ss.
    Qed.
  End MAX_NWDELAY.

  Section NUM_TASKS.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._NUM_TASKS =
      Some (Gvar (config_prm.v_NUM_TASKS (Z.of_nat num_tasks))).

    Lemma _init_mem_num_tasks
      : exists b_nt,
        Genv.find_symbol ge main_prm._NUM_TASKS = Some b_nt /\
        (b_nt < Genv.genv_next ge)%positive /\
        Mem.load Mint32 m b_nt 0%Z =
        Some (Vint (IntNat.of_nat num_tasks)).
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      esplits; eauto.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOAD_STORE.
      { ss. }
      clear LOAD_STORE.
      intro LOAD_STORE. ss. des.
      rewrite LOAD_STORE. ss.
    Qed.
  End NUM_TASKS.

  Section NUM_MCASTS.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._NUM_MCASTS =
      Some (Gvar (config_prm.v_NUM_MCASTS (Z.of_nat num_mcasts))).

    Lemma _init_mem_num_mcasts
      : exists b_nmc,
        Genv.find_symbol ge main_prm._NUM_MCASTS = Some b_nmc /\
        (b_nmc < Genv.genv_next ge)%positive /\
        Mem.load Mint32 m b_nmc 0%Z =
        Some (Vint (IntNat.of_nat num_mcasts)).
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      esplits; eauto.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOAD_STORE.
      { ss. }
      clear LOAD_STORE.
      intro LOAD_STORE. ss. des.
      rewrite LOAD_STORE. ss.
    Qed.
  End NUM_MCASTS.

  Section MSG_SIZE.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._MSG_SIZE =
      Some (Gvar (config_prm.v_MSG_SIZE (Z.of_nat msg_size))).

    Lemma _init_mem_msg_size
      : exists b_msz,
        Genv.find_symbol ge main_prm._MSG_SIZE = Some b_msz /\
        (b_msz < Genv.genv_next ge)%positive /\
        Mem.load Mint32 m b_msz 0%Z =
        Some (Vint (IntNat.of_nat msg_size)).
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      esplits; eauto.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOAD_STORE.
      { ss. }
      clear LOAD_STORE.
      intro LOAD_STORE. ss. des.
      rewrite LOAD_STORE. ss.
    Qed.
  End MSG_SIZE.

  Section PORT.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._PORT =
      Some (Gvar (config_prm.v_PORT (Z.of_nat port))).

    Lemma _init_mem_port
      : exists b_pn,
        Genv.find_symbol ge main_prm._PORT = Some b_pn /\
        (b_pn < Genv.genv_next ge)%positive /\
        Mem.load Mint32 m b_pn 0%Z =
        Some (Vint (IntNat.of_nat port)).
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      esplits; eauto.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOAD_STORE.
      { ss. }
      clear LOAD_STORE.
      intro LOAD_STORE. ss. des.
      rewrite LOAD_STORE. ss.
    Qed.
  End PORT.

  Section IP_ADDR.
    Let v_IP_ADDR_i: globvar type :=
      config_prm.v_IP_ADDR (Z.of_nat max_num_tasks)
                           (Z.of_nat max_num_mcasts)
                           dest_ips_brep.

    Hypothesis DEFMAP: (prog_defmap p) ! main_prm._IP_ADDR =
                       Some (Gvar v_IP_ADDR_i).

    Lemma _init_mem_ip_addr
      : exists b_ip_addr,
        Genv.find_symbol ge main_prm._IP_ADDR = Some b_ip_addr /\
        (b_ip_addr < Genv.genv_next ge)%positive /\
        iForall (fun n ip_bs =>
                   Mem.loadbytes
                     m b_ip_addr (Z.of_nat (n * 16))
                     (Zlength ip_bs + 1) =
                   Some (inj_bytes (snoc ip_bs Byte.zero)))
                0 (task_ips_brep ++ (map fst mcasts))
    .
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      eexists. split; eauto.
      split.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOADBYTES.
      { eauto. }

      clear - ge.
      replace (init_data_list_size (gvar_init v_IP_ADDR_i))
        with (Z.of_nat (max_num_tasks + max_num_mcasts) * 16)%Z.
      2: { ss.
           rewrite init_data_list_size_app. ss.
           rewrite flat_map_concat_map.
           erewrite init_data_list_size_concat.
           2: { i. rewrite in_map_iff in IN. des.
                unfold ip_init_data in IN. subst.
                ss. }
           rewrite Zlength_correct.
           rewrite map_length.

           assert (length dest_ips_brep <= max_num_tasks + max_num_mcasts)%nat.
           { pose proof num_tasks_bound as NT.
             pose proof num_mcasts_bound as NMC.
             pose proof task_ips_convert_brep as CONV_T.
             pose proof mcast_ips_convert_brep as CONV_M.
             apply Forall2_length in CONV_T.
             apply Forall2_length in CONV_M.

             unfold dest_ips_brep.
             rewrite app_length. rewrite map_length.
             unfold bytes in *. nia.
           }
           unfold bytes in *.
           rewrite Zlength_correct. nia.
      }

      ss.
      clear. intros LOADBYTES.

      apply iForall_nth. i. r.
      destruct (nth_error (task_ips_brep ++ map fst mcasts) n)
        as [ip_bs| ] eqn: IP_BS.
      2: { desf.
           exfalso.
           unfold bytes in *.
           congruence. }
      fold bytes in *.
      rewrite IP_BS. ss.

      assert (LEN_IP: Forall (fun ip_bs' => (length ip_bs' < 16)%nat) dest_ips_brep).
      { apply Forall_forall.
        unfold dest_ips_brep.
        intros bs IN.
        apply in_app_or in IN.
        des.
        - apply In_nth_error in IN. des.
          pose proof task_ips_convert_brep as CONV.
          eapply Forall2_nth1 in CONV; eauto. des.
          hexploit IP.valid_ip_brep_spec; eauto. i. des.
          unfold IP.max_byte_length in *. ss.
        - apply In_nth_error in IN. des.
          pose proof mcast_ips_convert_brep as CONV.
          apply map_nth_error_iff in IN. des.
          destruct a as [ip' mbrs]. ss. subst.

          eapply Forall2_nth1 in CONV; eauto. des.
          hexploit IP.valid_ip_brep_spec; eauto. i. des.
          unfold IP.max_byte_length in *. ss.
      }

      eapply Mem_loadbytes_sublist with
          (n1:= Z.of_nat (n * 16)) (n2:= (Zlength ip_bs + 1)%Z)
        in LOADBYTES; cycle 1.
      { nia. }
      { rewrite Zlength_correct. nia. }
      { match goal with
        | |- (?lhs <= _)%Z => replace lhs with (Z.of_nat (n * 16 + S (length ip_bs)))
        end.
        2: { rewrite Zlength_correct. nia. }

        assert (length ip_bs < 16)%nat.
        { rewrite Forall_nth in LEN_IP.
          specialize (LEN_IP n). r in LEN_IP.
          unfold dest_ips_brep in LEN_IP.
          unfold bytes in *.
          rewrite IP_BS in LEN_IP. ss. }
        assert (n < max_num_tasks + max_num_mcasts)%nat.
        { apply nth_error_Some1' in IP_BS.
          rewrite app_length in IP_BS.
          rewrite map_length in IP_BS.

          pose proof task_ips_convert_brep as CONV_T.
          apply Forall2_length in CONV_T.
          pose proof mcast_ips_convert_brep as CONV_M.
          apply Forall2_length in CONV_M.

          pose proof num_tasks_bound.
          pose proof num_mcasts_bound.
          unfold bytes in *. nia.
        }
        nia.
      }
      ss.
      rewrite LOADBYTES.
      f_equal.
      clear LOADBYTES.
      fold dest_ips_brep in IP_BS.

      match goal with
      | |- context[flat_map _ _ ++ ?x] => generalize x as rest
      end.

      revert n IP_BS LEN_IP.
      generalize dest_ips_brep.
      intro l.

      induction l as [| h t IH]; i.
      { exfalso.
        destruct n; ss. }

      destruct n as [| n'].
      { simpl in IP_BS. clarify. ss.
        assert (LEN_IP_BS: (length ip_bs < 16)%nat).
        { inv LEN_IP. ss. }
        clear LEN_IP IH.
        rewrite Zlength_correct. ss.

        match goal with
        | |- context [firstn ?n] => replace n with (length ip_bs + 1)%nat by nia
        end.

        repeat rewrite Int.unsigned_repr by apply ubyte_in_uint_range.
        repeat rewrite simpl_init_byte.
        destruct ip_bs as [| h1 tl]; ss.
        do 15 (destruct tl as [| ? tl]; ss; []).
        exfalso. nia.
      }
      { simpl in IP_BS.
        hexploit IH; eauto.
        { inv LEN_IP. ss. }
        intro FN.
        rewrite flat_map_concat_map. ss.
        replace (S n' * 16)%nat with (16 + n' * 16)%nat by ss.

        repeat rewrite Int.unsigned_repr by apply ubyte_in_uint_range.
        repeat rewrite simpl_init_byte. ss.
        rewrite Nat2Z.id. ss.
        rewrite <- flat_map_concat_map.
        rewrite Nat2Z.id in FN.  eauto.
      }
    Qed.
  End IP_ADDR.

  Lemma load_store_init_data_mcmem
        b ofs
        mip_bs mbrs tid'
        (VALID_TID: (tid' < num_tasks)%nat)
        (MCMEM: Genv.load_store_init_data
                  ge m b ofs (mcmem_init_data
                                (Z.of_nat max_num_tasks)
                                (group_memflags (mip_bs, mbrs))))
    : Mem.load Mint8signed m b (ofs + Z.of_nat tid') =
      Some (Vint (if existsb (Nat.eqb tid') mbrs
                  then Int.one else Int.zero)).
  Proof.
    unfold group_memflags in MCMEM. ss.
    unfold mcmem_init_data in *.
    apply load_store_init_data_app in MCMEM. des.

    clear MCMEM0.

    assert (AUX: forall nt ofs' tid' i
                   (TID: (tid' < nt)%nat)
                   (MCMEM : Genv.load_store_init_data
                              ge m b ofs'
                              (map (fun b: bool =>
                                      Init_int8 (Int.repr (if b then 1 else 0)))
                                   (imap (fun n _ => existsb (Nat.eqb n) mbrs)
                                         i (repeat tt nt))))
             ,
               Mem.load Mint8signed m b (ofs' + Z.of_nat tid') =
               Some (Vint (if existsb (Nat.eqb (i + tid')) mbrs
                           then Int.one else Int.zero))).
    { clear.
      intro nt.
      induction nt as [| nt' IH]; i; ss.
      { nia. }
      destruct tid' as [| tid']; ss.
      { des.
        rewrite plus_0_r. rewrite Z.add_0_r.
        rewrite Mem.load_int8_signed_unsigned.
        rewrite MCMEM. ss.
        desf. }
      des.

      hexploit (IH (ofs' + 1)%Z tid' (S i)).
      { nia. }
      { eauto. }
      intro LOAD.

      replace (Z.of_nat (S tid')) with (1 + Z.of_nat tid')%Z by nia.
      replace (i + S tid')%nat with (S i + tid')%nat by nia.
      rewrite Z.add_assoc. apply LOAD.
    }
    hexploit AUX; eauto.
  Qed.

  Lemma mcmem_init_data_list_size
        ginfo
    : init_data_list_size
        (mcmem_init_data (Z.of_nat max_num_tasks)
                         (group_memflags ginfo)) =
      (Z.of_nat max_num_tasks).
  Proof.
    assert (LEN_GMFS: length (group_memflags ginfo) = num_tasks).
    { unfold group_memflags.
      rewrite imap_length.
      apply repeat_length. }

    unfold mcmem_init_data.
    rewrite init_data_list_size_app.

    match goal with
    | |- (init_data_list_size (map ?f ?l) + _)%Z = _ =>
      replace (init_data_list_size (map f l)) with (Zlength l)
    end.
    2: { clear.
         induction (group_memflags ginfo) as [| h t IH]; ss.
         rewrite Zlength_cons.
         rewrite <- IH. nia. }

    rewrite Zlength_correct.
    rewrite LEN_GMFS.

    assert (NT_BOUND: (num_tasks <= max_num_tasks)%nat).
    { pose proof num_tasks_bound.
      unfold num_tasks. ss. }

    destruct (Z.ltb_spec (Z.of_nat num_tasks)
                         (Z.of_nat max_num_tasks)) as [LT|GE].
    - ss. nia.
    - ss. nia.
  Qed.

  Lemma load_store_init_data_flatmap_mcmem
        b ofs mcasts'
        midx mip_bs mbrs tid'
        (MCMEM: Genv.load_store_init_data
                  ge m b ofs
                  (flat_map (mcmem_init_data
                               (Z.of_nat max_num_tasks))
                            (map group_memflags mcasts')))
        (MIDX: nth_error mcasts' midx = Some (mip_bs, mbrs))
        (* (MAX_NUM_MEMBERS: (length mbrs <= num_tasks)%nat) *)
        (TID': (tid' < num_tasks)%nat)
    : Mem.load Mint8signed m b
               (ofs + Z.of_nat ((max_num_tasks * midx + tid'))) =
      Some (Vint (if existsb (Nat.eqb tid') mbrs
                  then Int.one else Int.zero)).
  Proof.
    depgen ofs. revert midx MIDX.
    induction mcasts' as [| h_mc t_mc IH]; i; ss.
    { destruct midx; ss. }

    destruct midx as [| midx]; ss.
    { clarify.
      apply load_store_init_data_app in MCMEM. des.
      rewrite Nat.mul_0_r. ss.
      eapply load_store_init_data_mcmem; eauto.
    }
    apply load_store_init_data_app in MCMEM. des.

    rewrite mcmem_init_data_list_size in *.
    hexploit IH; eauto. intro LOAD.
    match goal with
    | LOAD: Mem.load _ m b ?ofs1 = Some ?a |-
      Mem.load _ m b ?ofs2 = Some ?a =>
      replace ofs2 with ofs1 by nia
    end.
    congruence.
  Qed.

  Section MCAST_MEMBER.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._MCAST_MEMBER =
      Some (Gvar (config_prm.v_MCAST_MEMBER
                    (Z.of_nat max_num_tasks)
                    (Z.of_nat max_num_mcasts)
                    mcast_memflags)).

    Lemma _init_mem_mcm
      : exists b_mcm,
        Genv.find_symbol ge main_prm._MCAST_MEMBER = Some b_mcm /\
        (b_mcm < Genv.genv_next ge)%positive /\
        (forall mid midx tid' mip_bs mbrs
           (MCAST_ID: mid = (num_tasks + midx)%nat)
           (MCASTS_MID: nth_error mcasts midx = Some (mip_bs, mbrs))
           (RANGE_TID: (tid' < num_tasks)%nat),
            Mem.load Mint8signed m b_mcm
                     (Z.of_nat (max_num_tasks * midx + tid')) =
            Some (Vint (if existsb (Nat.eqb tid') mbrs
                        then Int.one else Int.zero)))
    .
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      eexists.
      split; eauto.
      split.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).
      ss.
      hexploit LOAD_STORE.
      { ss. }
      clear LOAD_STORE. clear LOADBYTES.
      intro LOAD_STORE.
      apply load_store_init_data_app in LOAD_STORE. des.

      i. hexploit load_store_init_data_flatmap_mcmem; eauto.
    Qed.
  End MCAST_MEMBER.

  (* writable *)

  Section SEND_BUF.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._send_buf =
      Some (Gvar (main_prm.v_send_buf (Z.of_nat msg_size_k))).

    Lemma _init_mem_send_buf
      : exists b_sbuf,
        Genv.find_symbol ge main_prm._send_buf = Some b_sbuf /\
        (b_sbuf < Genv.genv_next ge)%positive /\
        Mem.loadbytes m b_sbuf 0 8 = Some (inj_bytes (IntByte.to_bytes64 Int64.zero)) /\
        (* Mem.load Mint64 m b_sbuf 0 = Some (Vlong Int64.zero) /\ *)
        Mem.load Mint8signed m b_sbuf 8 = Some (Vint Int.zero) /\
        Mem.loadbytes m b_sbuf 9 (Z.of_nat msg_size) =
        Some (inj_bytes (List.repeat Byte.zero msg_size)) /\
        Mem.range_perm m b_sbuf 0 (Z.of_nat pld_size) Cur Writable
    .
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      eexists.
      split; eauto.
      split.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOADBYTES; ss.
      clear LOADBYTES.

      assert (STRT_SZ_EQ: msg_struct_sz (Z.of_nat msg_size_k) =
                          Z.of_nat max_pld_size).
      { unfold msg_struct_sz, max_pld_size.
        unfold max_msg_size. nia. }
      rewrite STRT_SZ_EQ in *.
      rewrite Z.max_l in * by nia.
      rewrite Z.add_0_r in *.
      rewrite app_nil_r.
      rewrite Nat2Z.id.
      rewrite list_repeat_eq.

      intro LOADBYTES.
      assert (SIZE_DIV: exists rest,
                 (max_pld_size = 8 + (1 + (msg_size + rest)))%nat).
      { clear.
        unfold max_pld_size.
        exists (max_msg_size - msg_size)%nat.
        unfold max_msg_size.
        pose proof msg_size_bound. nia. }
      des.
      rewrite SIZE_DIV in LOADBYTES.

      rewrite Nat2Z.inj_add in LOADBYTES.
      eapply Mem_loadbytes_split' in LOADBYTES; cycle 1.
      { nia. }
      { nia. }

      replace (Z.of_nat 8) with 8%Z in * by ss.
      replace (Z.to_nat 8) with 8%nat in * by ss.

      destruct LOADBYTES as [LOAD_TIME LOADBYTES].
      split.
      { erewrite LOAD_TIME. ss. }

      rewrite Nat2Z.inj_add in LOADBYTES.
      eapply Mem_loadbytes_split' in LOADBYTES; ss.
      2: { nia. }

      destruct LOADBYTES as [LOAD_TID LOADBYTES].
      split.
      { erewrite Mem.loadbytes_load; eauto; ss.
        solve_divide. }

      rewrite Nat2Z.inj_add in LOADBYTES.
      replace (Z.of_nat 1) with 1%Z in * by ss.
      replace (Z.to_nat 1) with 1%nat in * by ss.
      eapply Mem_loadbytes_split' in LOADBYTES; cycle 1.
      { nia. }
      { nia. }
      destruct LOADBYTES as [LOADBYTES LOADBYTES_REST].

      split; ss.
      { rewrite LOADBYTES. f_equal.
        rewrite Nat2Z.id.
        unfold inj_bytes.
        rewrite map_repeat.
        rewrite repeat_app.
        rewrite firstn_app_exact.
        2: { rewrite repeat_length. ss. }
        ss.
      }
      clear - RANGE_PERM.

      assert (pld_size <= max_pld_size)%nat.
      { unfold max_pld_size, pld_size.
        unfold max_msg_size.
        pose proof msg_size_bound. nia. }

      unfold v_send_buf in RANGE_PERM.
      unfold Genv.perm_globvar in RANGE_PERM. ss.

      ii. apply RANGE_PERM. nia.
    Qed.
  End SEND_BUF.

  Lemma _init_Mem_msg_entries
        b ofs
        (LBS: Mem.loadbytes m b ofs inb_sz =
              Some (repeat (Byte Byte.zero) inb_nsz))
    : iForall (Mem_msg_entry m b ofs) 0
              (repeat None num_tasks).
  Proof.
    apply iForall_nth. ss. i.
    destruct (lt_ge_dec n num_tasks).
    2: { rewrite repeat_nth_error_None; ss. }
    rewrite repeat_nth_error_Some by ss.
    ss.

    erewrite Mem_loadbytes_sublist; eauto; cycle 1.
    { nia. }
    { nia. }
    { hexploit (within_inb_nsz2 n mentry_ensz); eauto.
      { apply range_mentry_ensz. }
      unfold mentry_ensz. nia. }

    f_equal.
    rewrite Nat2Z.id.

    pose proof num_tasks_bound' as NT_BOUND.
    replace inb_nsz with (mentry_nsz * n +
                          mentry_nsz * (max_num_tasks - n))%nat.
    2: { unfold inb_nsz. nia. }

    rewrite repeat_app.
    rewrite skipn_app_exact.
    2: { rewrite repeat_length. nia. }

    destruct (max_num_tasks - n)%nat as [|n'] eqn: SUB.
    { exfalso. nia. }

    replace (mentry_nsz * S n')%nat with
        (S (max_msg_size + mentry_nsz * n'))%nat.
    2: { unfold mentry_nsz. nia. }
    ss.
  Qed.

  (* assert (MENTRY_SZ_DIV: exists rest, *)
  (*            (mentry_nsz = mentry_ensz + rest)%nat). *)
  (* { exists (mentry_nsz - mentry_ensz)%nat. *)
  (*   clear. *)
  (*   pose proof range_mentry_ensz. nia. } *)

  (*   des. rewrite MENTRY_SZ_DIV. *)

  (*   rewrite <- Nat.add_assoc. *)
  (*   rewrite repeat_app. *)
  (*   rewrite firstn_app_exact. *)
  (*   2: { rewrite repeat_length. ss. } *)

  (*   unfold inj_bytes, mentry_to_bytes. ss. *)
  (*   unfold mentry_ensz. rewrite plus_comm. ss. *)
  (*   rewrite map_repeat. ss. *)
  (* Qed. *)

  Section MSTORE.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._mstore =
      Some (Gvar (main_prm.v_mstore (Z.of_nat msg_size_k)
                                    (Z.of_nat max_num_tasks))).

    Lemma _init_mem_mstore
      : exists b_mst,
        Genv.find_symbol ge main_prm._mstore = Some b_mst /\
        (b_mst < Genv.genv_next ge)%positive /\
        Mem.load Mint32 m b_mst 0 = Some (Vint Int.zero) /\
        Mem.range_perm m b_mst 0 4 Cur Writable /\
        Mem_inbox m b_mst 4 (List.repeat None num_tasks) /\
        Mem_inbox m b_mst (4 + inb_sz) (List.repeat None num_tasks)
    .
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      eexists.
      split; eauto.
      split.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      (* assert (INBOX_SZ_NNEG: 0 <= inb_sz). *)
      (* { apply range_inb_sz_precise. } *)

      hexploit LOADBYTES; ss.
      rewrite <- inb_sz_eq.

      clear LOADBYTES.
      rewrite Z.max_l by nia.
      rewrite app_nil_r.
      rewrite list_repeat_eq.
      rewrite Z2Nat.inj_add by nia.
      rewrite Z.add_0_r in *.
      (* rewrite <- Z2Nat.inj_add by nia. *)

      intro LOADBYTES.
      eapply Mem_loadbytes_split' in LOADBYTES; ss.
      2: { nia. }

      rewrite repeat_app in LOADBYTES.
      rewrite firstn_app_exact in LOADBYTES.
      2: { rewrite repeat_length. ss. }
      rewrite skipn_app_exact in LOADBYTES.
      2: { rewrite repeat_length. ss. }

      change (Z.to_nat 4) with 4%nat in LOADBYTES.
      destruct LOADBYTES as [LOAD_RCV LOADBYTES].

      split.
      { erewrite Mem.loadbytes_load; eauto; ss.
        solve_divide. }
      split.
      { ii. apply RANGE_PERM.
        rewrite <- inb_sz_eq.
        rewrite Z.max_l by nia.
        nia. }

      rewrite <- Zplus_diag_eq_mult_2 in LOADBYTES.
      eapply Mem_loadbytes_split' in LOADBYTES; try nia.
      rewrite Z2Nat.inj_add in LOADBYTES by nia.
      rewrite repeat_app in LOADBYTES.
      rewrite firstn_app_exact in LOADBYTES.
      2: { rewrite repeat_length. ss. }
      rewrite skipn_app_exact in LOADBYTES.
      2: { rewrite repeat_length. ss. }

      rewrite Nat2Z.id in LOADBYTES by ss.
      destruct LOADBYTES as [LOAD_INB1 LOAD_INB2].

      split.
      - clear LOAD_INB2.
        r. splits; ss; cycle 1.
        { (* unfold empty_msg_entry. *)
          rewrite repeat_length. ss. }
        { clear - RANGE_PERM.
          ii. apply RANGE_PERM.
          rewrite <- inb_sz_eq. nia. }
        eapply _init_Mem_msg_entries; eauto.
      - clear LOAD_INB1.
        r. splits; ss; cycle 1.
        { (* unfold empty_msg_entry. *)
          rewrite repeat_length. ss. }
        { clear - RANGE_PERM.
          ii. apply RANGE_PERM.
          rewrite <- inb_sz_eq. nia. }
        eapply _init_Mem_msg_entries; eauto.
    Qed.

  End MSTORE.

  Section SEND_HIST.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._send_hist =
      Some (Gvar (main_prm.v_send_hist (Z.of_nat max_num_tasks))).

    Lemma _init_mem_send_hist
      : exists b_sh,
        Genv.find_symbol ge main_prm._send_hist = Some b_sh /\
        (b_sh < Genv.genv_next ge)%positive /\
        Mem.loadbytes m b_sh 0 (Z.of_nat num_tasks) =
        Some (map bool2memval (List.repeat false num_tasks)) /\
        Mem.range_perm m b_sh 0 (Z.of_nat num_tasks) Cur Writable
    .
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      eexists.
      split; eauto.
      split.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).
      ss.
      assert (MAX_NT_DIV: exists rst, (max_num_tasks = num_tasks + rst)%nat).
      { clear. pose proof num_tasks_bound'.
        exists (max_num_tasks - num_tasks)%nat. nia. }
      des.

      split.
      - hexploit LOADBYTES; eauto.
        rewrite Z.max_l by nia.
        rewrite Z.add_0_r.
        rewrite MAX_NT_DIV.
        rewrite Nat2Z.inj_add.
        rewrite list_repeat_eq.
        rewrite Z2Nat.inj_add by nia.
        rewrite app_nil_r.
        rewrite repeat_app.

        intro LB1.
        apply Mem_loadbytes_split' in LB1; try nia.
        destruct LB1 as [LB LB_R].
        rewrite Nat2Z.id in *.
        rewrite firstn_app_exact in LB.
        2: { rewrite repeat_length. ss. }

        rewrite LB. f_equal.
        rewrite map_repeat. ss.
      - ii. apply RANGE_PERM.
        rewrite Z.max_l by nia.
        rewrite Z.add_0_r. nia.
    Qed.

  End SEND_HIST.

  Section TXS.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._txs =
      Some (Gvar (main_prm.v_txs)).

    Lemma _init_mem_txs
      : exists b_txs,
        Genv.find_symbol ge main_prm._txs = Some b_txs /\
        (b_txs < Genv.genv_next ge)%positive /\
        Mem.load Mint32 m b_txs 0%Z = Some (Vint Int.zero) /\
        Mem.range_perm m b_txs 0%Z 4 Cur Writable.
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      eexists.
      split; eauto.
      split.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOAD_STORE.
      { ss. }
      clear LOAD_STORE.
      intro LOAD_STORE. ss. des.
      splits; eauto.
      rr in LOAD_STORE.
      rewrite LOAD_STORE; ss.
      solve_divide.
    Qed.
  End TXS.

  Section RXS.
    Hypothesis DEFMAP:
      (prog_defmap p) ! main_prm._rxs =
      Some (Gvar (main_prm.v_rxs)).

    Lemma _init_mem_rxs
      : exists b_rxs,
        Genv.find_symbol ge main_prm._rxs = Some b_rxs /\
        (b_rxs < Genv.genv_next ge)%positive /\
        Mem.load Mint32 m b_rxs 0%Z = Some (Vint Int.zero) /\
        Mem.range_perm m b_rxs 0%Z 4 Cur Writable.
    Proof.
      apply Genv.find_def_symbol in DEFMAP.
      destruct DEFMAP as (b & FSYMB & FDEF).

      eexists.
      split; eauto.
      split.
      { eapply Genv.genv_symb_range. eauto. }

      eapply Genv.init_mem_characterization_gen in FDEF; eauto.
      destruct FDEF as (RANGE_PERM & PERM_ORDER &
                        LOAD_STORE & LOADBYTES).

      hexploit LOAD_STORE.
      { ss. }
      clear LOAD_STORE.
      intro LOAD_STORE. ss. des.
      splits; eauto.
      rr in LOAD_STORE.
      rewrite LOAD_STORE; ss.
      solve_divide.
    Qed.
  End RXS.

End INIT_DATA_LEMMAS.

Section INIT_MEM_INVERSION.
  Import Clight.
  Context `{SystemEnv}.
  (* Context `{CProgSysEvent}. *)
  Variable cprog: Clight.program.
  Variable m_i: mem.
  Let ge := globalenv cprog.

  Hypothesis INIT_MEM: Genv.init_mem cprog = Some m_i.
  (* Variable gvars: list (ident * cglobvar). *)
  Variable tid: nat.
  Variable gfuns: list (ident * fundef).
  Variable cenvs: list (ident * composite).
  Hypothesis RANGE_TID: (tid < num_tasks)%nat.

  Context `{genv_props ge (main_gvar_ilist tid) gfuns cenvs}.

  (* (* init_mem_inversion *) *)
  (* Let glob_init: Genv.globals_initialized ge ge m_i. *)
  (* Proof. *)
  (*   apply Genv.init_mem_characterization_gen; eauto. *)
  (* Qed. *)

  Lemma main_gvar_find_def
        i gv b
        (FSYMB: Genv.find_symbol ge i = Some b)
        (IN: In (i, gv) (main_gvar_ilist tid))
    : Genv.find_def ge b = Some (Gvar gv).
  Proof.
    hexploit (in_gvar_ilist i); eauto.
    i. des. clarify.
    apply Genv.find_var_info_iff; eauto.
  Qed.

  Lemma bytes_of_init_data_list_map
        (ge': genv) l
    : Genv.bytes_of_init_data_list ge' l =
      concat (map (Genv.bytes_of_init_data ge') l).
  Proof.
    induction l as [| h t IH]; ss.
    rewrite IH. ss.
  Qed.

  (* Lemma loadbytes_ip_aux *)
  (*       (ge': genv) m (ip_bs: bytes) b ofs *)
  (*       (LEN_BD: length ip_bs < 16) *)
  (*       (LBS: Mem.loadbytes m b ofs 16 = *)
  (*             Some (concat (map (Genv.bytes_of_init_data ge') *)
  (*                               (ip_init_data ip_bs)))) *)
  (*   : Mem.loadbytes m b ofs (Zlength ip_bs + 1)%Z = *)
  (*     Some (inj_bytes (snoc ip_bs Byte.zero)). *)
  (* Proof. *)
  (*   ss. unfold encode_int in *. ss. *)
  (*   repeat rewrite rev_if_be_single in *. ss. *)
  (*   unfold app in LBS. *)
  (*   repeat (rewrite Int.unsigned_repr in LBS *)
  (*            by eapply ubyte_in_uint_range). *)
  (*   repeat rewrite Byte.repr_unsigned in LBS. *)

  (*   pose (k:= (16 - (Zlength ip_bs + 1))%Z). *)
  (*   assert (k >= 0)%Z. *)
  (*   { subst k. rewrite Zlength_correct. nia. } *)

  (*   replace 16%Z with (Zlength ip_bs + 1 + k)%Z in LBS. *)
  (*   2: { subst k. nia. } *)
  (*   apply Mem.loadbytes_split in LBS; ss. *)
  (*   2: { rewrite Zlength_correct. nia. } *)

  (*   des. rewrite LBS. *)
  (*   apply Mem.loadbytes_length in LBS. *)

  (*   unfold snoc. unfold inj_bytes. *)
  (*   rewrite map_app. *)
  (*   f_equal. *)
  (*   eapply (ip_bytes_aux ip_bs 16). *)
  (*   { ss. rewrite LBS1. eauto. } *)
  (*   { rewrite LBS. *)
  (*     rewrite Zlength_correct. nia. } *)
  (* Qed. *)

  Lemma init_mem_consts: mem_consts ge m_i tid.
  Proof.
    (* r in glob_init. *)
    econs.
    - i. ss.
      hexploit _init_mem_tid; eauto.
      { instantiate (1:= tid).
        pose proof range_num_tasks.
        range_stac. }
      { apply Genv.find_def_symbol.
        esplits; eauto.
        eapply main_gvar_find_def; eauto.
        sIn. }
      i. des. fold fundef in *. clarify.
    - i. ss.
      hexploit _init_mem_pals_period; eauto.
      { apply Genv.find_def_symbol.
        esplits; eauto.
        eapply main_gvar_find_def; eauto.
        sIn. }
      i. des. fold fundef in *. clarify.
    - i. ss.
      hexploit _init_mem_max_cskew; eauto.
      { apply Genv.find_def_symbol.
        esplits; eauto.
        eapply main_gvar_find_def; eauto.
        sIn. }
      i. des. fold fundef in *. clarify.
    - i. ss.
      hexploit _init_mem_max_nwdelay; eauto.
      { apply Genv.find_def_symbol.
        esplits; eauto.
        eapply main_gvar_find_def; eauto.
        sIn. }
      i. des. fold fundef in *. clarify.
    - i. ss.
      hexploit _init_mem_num_tasks; eauto.
      { apply Genv.find_def_symbol.
        esplits; eauto.
        eapply main_gvar_find_def; eauto.
        sIn. }
      i. des. fold fundef in *. clarify.
    - i. ss.
      hexploit _init_mem_num_mcasts; eauto.
      { apply Genv.find_def_symbol.
        esplits; eauto.
        eapply main_gvar_find_def; eauto.
        sIn. }
      i. des. fold fundef in *. clarify.
    - i. ss.
      hexploit _init_mem_msg_size; eauto.
      { apply Genv.find_def_symbol.
        esplits; eauto.
        eapply main_gvar_find_def; eauto.
        sIn. }
      i. des. fold fundef in *. clarify.
    - i. ss.
      hexploit _init_mem_port; eauto.
      { apply Genv.find_def_symbol.
        esplits; eauto.
        eapply main_gvar_find_def; eauto.
        sIn. }
      i. des. fold fundef in *. clarify.
    - i. ss.
      hexploit _init_mem_ip_addr; eauto.
      { apply Genv.find_def_symbol.
        esplits; eauto.
        eapply main_gvar_find_def; eauto.
        sIn. }
      i. des. fold fundef in *. clarify.
    - i. ss.
      hexploit _init_mem_mcm; eauto.
      { apply Genv.find_def_symbol.
        esplits; eauto.
        eapply main_gvar_find_def; eauto.
        sIn. }
      intros (b_mcm' & FSYMB2 & NBLK & INIT).
      fold fundef in *. clarify.
      eapply INIT; eauto.
  Qed.

  Lemma init_mem_mstore
    : mem_mstore ge m_i
                 false 4%Z (4 + inb_sz)%Z
                 MWITree.init_inbox MWITree.init_inbox.
  Proof.
    ii.
    hexploit _init_mem_mstore; eauto.
    { apply Genv.find_def_symbol.
      esplits; eauto.
      eapply main_gvar_find_def; eauto.
      sIn. }

    i. des. ss.
    fold fundef in *. clarify.
  Qed.

  Lemma init_mem_sbuf
    : mem_sbuf ge m_i 0 0 (List.repeat Byte.zero msg_size).
  Proof.
    ii.
    hexploit _init_mem_send_buf; eauto.
    { apply Genv.find_def_symbol.
      esplits; eauto.
      eapply main_gvar_find_def; eauto.
      sIn. }

    i. des. ss.
    fold fundef in *. clarify.
  Qed.

  Lemma init_mem_sh
    : mem_sh ge m_i (List.repeat false num_tasks).
  Proof.
    ii.
    hexploit _init_mem_send_hist; eauto.
    { apply Genv.find_def_symbol.
      esplits; eauto.
      eapply main_gvar_find_def; eauto.
      sIn. }

    i. des. ss.
    fold fundef in *. clarify.
  Qed.

  Lemma init_mem_txs: mem_txs ge m_i 0.
  Proof.
    ii.
    hexploit _init_mem_txs; eauto.
    { apply Genv.find_def_symbol.
      esplits; eauto.
      eapply main_gvar_find_def; eauto.
      sIn. }

    i. des. ss.
    fold fundef in *. clarify.
  Qed.

  Lemma init_mem_rxs: mem_rxs ge m_i 0.
  Proof.
    ii.
    hexploit _init_mem_rxs; eauto.
    { apply Genv.find_def_symbol.
      esplits; eauto.
      eapply main_gvar_find_def; eauto.
      sIn. }

    i. des. ss.
    fold fundef in *. clarify.
  Qed.

End INIT_MEM_INVERSION.


Require Import Coq.Program.Equality.
Require Import Language Notations Auxiliaries Subtyping Automations.
Require Import Strings.String.

Set Printing Parentheses.

Lemma tred_ord_toplike : forall (e e' : trm) (A : typ),
    ordinary A -> toplike A -> typedred e A e' -> e' = (trm_anno (trm_nat 1) A).
Proof.
  intros e e' A H_ord H_top H_tred.
  dependent induction H_tred; subst; eauto.
  - inversion H_top.
  - inversion H_top. contradiction.
  - inversion H_ord.
Qed.

Lemma tred_toplike :
  forall (A : typ),
    toplike A ->
    forall e1 e2 e1' e2' : trm, typedred e1 A e1' -> typedred e2 A e2' -> e1' = e2'.
Proof.
  intros A Htop.
  dependent induction Htop; intros e1 e2 e1' e2' H_tred1 H_tred2.
  - eapply tred_ord_toplike in H_tred1. eapply tred_ord_toplike in H_tred2.
    rewrite H_tred1. rewrite H_tred2. reflexivity.
    constructor. constructor. constructor. constructor.
  - inversion H_tred1; subst; eauto 3.
    + inversion H0.
    + inversion H0.
    + inversion H0.
    + inversion H_tred2; subst; eauto 3.
      * inversion H0.
      * inversion H0.
      * inversion H0.
      * assert (Heq1: v1 = v0).
        eapply IHHtop1; eauto 3.
        assert (Heq2: v2 = v3).
        eapply IHHtop2; eauto 3.
        rewrite Heq1. rewrite Heq2. reflexivity.
  - assert (HAB: toplike (typ_arrow A B)).
    constructor. assumption.
    eapply tred_ord_toplike in H_tred2; eauto.
    eapply tred_ord_toplike in H_tred1; eauto.
    rewrite H_tred1. rewrite H_tred2. reflexivity.
Qed.

Lemma tred_sub :
  forall (A B : typ) (v1 v2 : trm),
    value v1 -> typedred v1 A v2 ->
    typing nil nil infer_mode v1 B ->
    sub B A.
Proof.
  intros A B v1 v2 Hval Hred Htyp.
  generalize dependent B.
  induction Hred; eauto.
  - intros B Htyp.
    inversion Htyp; subst.
    inversion H3; subst. constructor.
  - intros B Htyp.
    eapply toplike_sub in H.
    eapply sub_transitivity; eauto 3.
  - intros B0 Htyp.
    inversion Hval; subst; clear Hval.
    inversion Htyp; subst; clear Htyp.
    inversion H7; subst; clear H7.
    + eapply sub_arrow; eauto 3.
    (* + dependent destruction H2. eapply toplike_sub_toplike in H2; eauto. contradiction. *)
  - intros B0 Htyp.
    inversion Hval; subst; clear Hval.
    inversion Htyp; subst; clear Htyp.
    + apply sub_and_l.
      eapply IHHred; eauto 3.
    + apply sub_and_l.
      eapply IHHred; eauto 3.
  - intros B0 Htyp.
    inversion Hval; subst; clear Hval.
    inversion Htyp; subst; clear Htyp.
    + apply sub_and_r.
      eapply IHHred; eauto 3.
    + apply sub_and_r.
      eapply IHHred; eauto 3.
Qed.

Lemma disjoint_value_consistent :
  forall (A B : typ) (v1 v2 : trm),
    disjoint_spec A B -> value v1 -> value v2 ->
    typing nil nil infer_mode v1 A ->
    typing nil nil infer_mode v2 B ->
    consistency_spec v1 v2.
Proof.
  intros A B v1 v2 Hdis Hv1 Hv2 Htyp1 Htyp2.
  unfold consistency_spec.
  intros A0 e1' e2'. intros Hred1 Hred2.
  assert (Hsub1: sub A A0).
  eapply tred_sub. apply Hv1. apply Hred1. apply Htyp1.
  assert (Hsub2: sub B A0).
  eapply tred_sub. apply Hv2. apply Hred2. apply Htyp2.
  assert (Htop : toplike A0).
  unfold disjoint_spec in Hdis.
  apply Hdis. assumption. assumption.
  eapply tred_toplike. apply Htop. apply Hred1. apply Hred2.
Qed.

Lemma tred_determinism :
  forall (v v1 v2 : trm) (A : typ),
    value v -> (exists B, typing nil nil infer_mode v B) ->
    typedred v A v1 -> typedred v A v2 -> v1 = v2.
Proof.
  intros v v1 v2 A Hval Htyp Hred1.
  generalize dependent v2.
  induction Hred1.
  - intros v2 Hred2.
    inversion Hred2; subst.
    + reflexivity.
    + inversion H.
  - intros v2 Hred2.
    inversion Hred2; subst; clear Hred2; eauto.
    + inversion H.
    + inversion H. contradiction.
    + symmetry. eapply tred_ord_toplike; eauto.
    + symmetry. eapply tred_ord_toplike; eauto.
    + inversion H0.
  - intros v2 Hred2.
    inversion Hred2; subst; clear Hred2.
    + inversion H2. contradiction.
    + reflexivity.
  - intros v0 Hred2.
    inversion Hred2; subst; eauto.
    + eapply tred_ord_toplike; eauto 3.
    + eapply IHHred1; eauto.
      * inversion Hval; assumption.
      * destruct Htyp. inversion H0; subst.
        exists A0. assumption.
        exists A0. assumption.
    + destruct Htyp.
      inversion H0; subst.
      * inversion Hval; subst; clear Hval.
        assert (Hcons: consistency_spec v1 v2).
        eapply disjoint_value_consistent; eauto 3.
        eapply Hcons; eauto 3.
      * eapply H11; eauto 3.
    + inversion H.
  - intros v0 Hred2.
    inversion Hred2; subst; eauto.
    + eapply tred_ord_toplike; eauto 3.
    + destruct Htyp.
      inversion H0; subst; eauto.
      * inversion Hval; subst; clear Hval.
        assert(Hcons: consistency_spec v1 v2).
        eapply disjoint_value_consistent; eauto 3.
        unfold consistency_spec in Hcons.
        symmetry. eapply Hcons; eauto 3.
      * unfold consistency_spec in H10.
        symmetry. eapply H11; eauto.
    + inversion Hval; subst; clear Hval.
      eapply IHHred1.
      * assumption.
      * destruct Htyp. inversion H0; subst.
        exists B. assumption.
        exists B. assumption.
      * assumption.
    + inversion H.
  - intros v0 Hred2.
    inversion Hred2; subst; clear Hred2.
    + inversion H0.
    + inversion H0.
    + inversion H0.
    + assert (Heq1: v1 = v3).
      eapply IHHred1_1; eauto 3.
      assert (Heq2: v2 = v4).
      eapply IHHred1_2; eauto 3.
      rewrite Heq1. rewrite Heq2. reflexivity.
Qed.

Lemma tred_value :
  forall (v v' : trm) (A : typ),
    value v -> typedred v A v' -> value v'.
Proof.
  intros v v' A Hval Hred.
  induction Hred; eauto.
  + apply IHHred. inversion Hval; eauto.
  + apply IHHred. inversion Hval; eauto.
Qed.

Lemma tred_transitivity : forall (v1 v2 v3 : trm) (A B : typ),
    value v1 -> typedred v1 A v2 -> typedred v2 B v3 -> typedred v1 B v3.
Proof.
  intros v1 v2 v3 A B Hval Hred1 Hred2.
  generalize dependent v3.
  generalize dependent B.
  dependent induction Hred1; eauto.
  - intros B v3 Hred2. dependent induction Hred2; eauto.
  - intros B0 v3 Hred2. dependent induction Hred2; eauto.
    + constructor. assumption.
      eapply sub_transitivity; eauto.
      eapply sub_transitivity; eauto.
  - intros B v3 Hred2.
    inversion Hval; subst; clear Hval.
    induction Hred2; eauto.
  - intros B v3 Hred2. inversion Hval; subst; clear Hval.
    induction Hred2; eauto.
  - intros B0 v0 Hred2.
    generalize dependent v0.
    induction B0; intros v0 Hred2; eauto.
    + inversion Hred2; subst; clear Hred2; eauto.
    + inversion Hred2; subst; clear Hred2; eauto.
    + inversion Hred2; subst; clear Hred2; eauto.
    + inversion Hred2; subst; clear Hred2; eauto.
Qed.

Lemma tred_consistency :
  forall (v v1 v2 : trm) (A B C : typ),
    value v -> typing nil nil infer_mode v C ->
    typedred v A v1 ->
    typedred v B v2 ->
    consistency_spec v1 v2.
Proof.
  intros v v1 v2 A B C Hval Htyp Hred1 Hred2.
  unfold consistency_spec.
  intros D v1' v2' Hred1' Hred2'.
  assert (Htrans1: typedred v D v1').
  eapply tred_transitivity. apply Hval. apply Hred1. apply Hred1'.
  assert (Htrans2: typedred v D v2').
  eapply tred_transitivity. apply Hval. apply Hred2. apply Hred2'.
  eapply tred_determinism; eauto 3.
Qed.

Lemma typing_merge_inversion:
  forall (v1 v2 : trm),
    (exists (A : typ), typing nil nil infer_mode (trm_merge v1 v2) A) ->
    (exists (B : typ), typing nil nil infer_mode v1 B) /\
    (exists (C : typ), typing nil nil infer_mode v2 C).
Proof.
  intros v1 v2 Htyp.
  destruct Htyp.
  inversion H; subst.
  - split. eauto. eauto.
  - split. eauto. eauto.
Qed.

Lemma ptype_determinsm :
  forall (e : trm) (A B : typ),
    ptype e A -> ptype e B -> A = B.
Proof.
  intros e A B Hp1 Hp2.
  generalize dependent B.
  dependent induction Hp1.
  - intros. inversion Hp2. reflexivity.
  - intros. inversion Hp2. reflexivity.
  - intros. inversion Hp2; subst.
    assert (A = A0).
    eapply IHHp1_1; eauto.
    assert (B = B1).
    eapply IHHp1_2; eauto.
    rewrite H. rewrite H0. reflexivity.
Qed.

Lemma appsub_determinism :
  forall (A : typ) (B1 B2 : typ) (S : arg),
    appsub S A B1 ->
    appsub S A B2 ->
    B1 = B2.
Proof.
  intros A B1 B2 S Has1 Has2.
  generalize dependent B2.
  dependent induction Has1; intros.
  - dependent destruction Has2.
    + reflexivity.
  - dependent destruction Has2.
    + assert (Heq: D = D0).
      eapply IHHas1; eauto.
      rewrite Heq. reflexivity.
  - dependent destruction Has2.
    + eapply IHHas1; eauto.
    + admit.
  - dependent destruction Has2.
    + admit.
    + eapply IHHas1; eauto.
Admitted.

Lemma ptype_merge_same :
  forall (v1 v2 : trm) (A : typ),
    value v1 -> value v2 -> ptype (trm_merge v1 v2) (typ_and A A) ->
    v1 = v2.
Proof.
Admitted.

Lemma papp_determinism :
  forall (v vl e1 e2 : trm),
    value v -> value vl ->
    (exists (B : typ), typing nil nil infer_mode vl B) ->
    papp v vl e1 -> papp v vl e2 -> e1 = e2.
Proof.
 intros v vl e1 e2 Hrv Hv Htyp Hp1 Hp2.
  generalize dependent e2.
  dependent induction Hp1.
  - intros. inversion Hp2; subst.
    + assert (A = A0). eapply ptype_determinsm; eauto.
      rewrite H3. reflexivity.
    + dependent destruction H. dependent destruction H0. contradiction.
    + assert (Heq: A = C). eapply ptype_determinsm; eauto. subst.
      contradiction.
    + assert (Heq: A = C). eapply ptype_determinsm; eauto. subst.
      contradiction.
  - intros. dependent destruction Hp2.
    + dependent destruction H1. dependent destruction H2. contradiction.
    + assert (v' = v'0). eapply tred_determinism; eauto.
      rewrite H3; eauto.
  - intros. apply IHHp1; eauto.
    + dependent destruction Hrv. assumption.
    + dependent destruction Hp2; eauto.
      * assert (Heq: A0 = C). eapply ptype_determinsm; eauto. subst.
        contradiction.
      * assert (B = B0). eapply ptype_determinsm; eauto. subst.
        assert (C = C0). eapply ptype_determinsm; eauto. subst.
        assert (A = A0). eapply appsub_determinism; eauto. subst.
        dependent destruction H6.
        assert (A = B).
        assert (A = A0). eapply ptype_determinsm; eauto. subst.
        assert (B = A0). eapply ptype_determinsm; eauto. subst.
        reflexivity. subst.
        dependent destruction Hrv.
        assert (v1 = v2). eapply ptype_merge_same; eauto. subst. eauto.
  - intros. apply IHHp1; eauto.
    + dependent destruction Hrv. assumption.
    + dependent destruction Hp2; eauto.
      * assert (Heq: A0 = C). eapply ptype_determinsm; eauto. subst.
        contradiction.
      * assert (B = B0). eapply ptype_determinsm; eauto. subst.
        assert (C = C0). eapply ptype_determinsm; eauto. subst.
        assert (A = A0). eapply appsub_determinism; eauto. subst.
        dependent destruction H6.
        assert (A = B).
        assert (A = A0). eapply ptype_determinsm; eauto. subst.
        assert (B = A0). eapply ptype_determinsm; eauto. subst.
        reflexivity. subst.
        dependent destruction Hrv.
        assert (v1 = v2). eapply ptype_merge_same; eauto. subst. eauto.
Qed.

Lemma value_cannot_step_further :
  forall (v : trm),
    value v -> forall (e : trm), not (step v e).
Proof.
  intros v Hval.
  induction v.
  - inversion Hval.
  - inversion Hval.
  - inversion Hval.
  - unfold not. intros. inversion H.
  - inversion Hval.
  - inversion Hval; subst.
    intros. unfold not. intros.
    inversion H; subst.
    + eapply IHv1; eauto 3.
    + eapply IHv2; eauto 3.
  - inversion Hval; subst; clear Hval.
    induction H0.
    + intros. unfold not. intros.
      inversion H; subst.
      * inversion H2.
      * apply H2. constructor. constructor.
    + intros. unfold not. intros.
      inversion H; subst.
      * inversion H2.
      * apply H2. constructor. constructor.
Qed.

Lemma app_check_inversion :
  forall (v vl : trm) (A : typ),
    value v -> value vl -> typing nil nil check_mode (trm_app v vl) A ->
    exists (B : typ), typing nil nil infer_mode vl B.
Proof.
  intros r vl A Hrv Hv Hchk.
  dependent destruction Hchk.
  - inversion H0.
  - exists A. auto.
  - dependent destruction Hchk.
    exists A0. eauto.
Qed.

(* aux lemma for anno_check_to_infer *)
Lemma value_with_anno_is_not_value :
  forall (v : trm) (A : typ),
    value v -> not (value (trm_anno v A)).
Proof.
  intros v A Hv.
  unfold not. intro.
  dependent destruction H.
  dependent induction H.
  - inversion Hv.
  - inversion Hv.
Qed.

(* this case have conflict with typing rule: any value can be checked by lemma *)
(* current workaround is add a premise not-toplike *)
Lemma anno_check_to_infer :
  forall (v : trm) (A B : typ),
    value v -> typing nil nil check_mode (trm_anno v A) B ->
    (exists (C : typ), typing nil nil infer_mode v C).
Proof.
  intros v A B Hv Htyp.
  dependent destruction Htyp.
  inversion H0.
  dependent destruction Htyp.
  dependent destruction Htyp.
  - dependent destruction H1; try solve [inversion Hv].
  - inversion Hv.
  - exists B0; eauto.
Qed.

(* aux lemma for step_determinism *)
Lemma lambda_typing1 :
  forall (e : trm) (A B : typ),
    typing nil (cons A nil) infer_mode e B ->
    (exists C, typing nil nil check_mode e C).
Proof.
  intros e A B Htyp.
  dependent induction Htyp.
  - simpl in *.
    exists (typ_arrow A0 B). eapply typing_sub.
    assert (Habs: typing nil nil infer_mode (trm_abs A0 e) (typ_arrow A0 B)).
    eapply typing_abs1; eauto. eapply Habs. eapply sub_reflexivity.
  - dependent destruction H.
    + dependent destruction H0.
      exists (typ_arrow A0 A1). eapply typing_sub; eauto.
      eapply sub_reflexivity.
    + clear IHHtyp. exists (typ_and A0 B). eapply typing_sub; eauto.
      eapply sub_reflexivity.
    + clear IHHtyp. exists (typ_and A0 B). eapply typing_sub; eauto.
      eapply sub_reflexivity.
  - exists B. eapply typing_app2.
    + eapply Htyp1.
    + admit.
  - clear IHHtyp1 IHHtyp2.
    exists B. eapply typing_sub; eauto.
Admitted.

Lemma step_determinism :
  forall (e e1 e2 : trm) (A : typ),
    typing nil nil check_mode e A ->
    step e e1 -> step e e2 -> e1 = e2.
Proof.
  intros e e1 e2 A Htyp Hred1.
  generalize dependent e2.
  generalize dependent A.
  induction Hred1.
  - intros A Htyp e2 Hred2.
    inversion Hred2; subst.
    reflexivity.
  - intros A Htyp e2 Hred2.
    inversion Hred2; subst. (* papp and 2 congruence rules *)
    + eapply app_check_inversion in Htyp; eauto.
      apply papp_determinism with (v:=v) (vl:=vl); eauto.
    + eapply value_cannot_step_further in H5. inversion H5. auto.
    + eapply value_cannot_step_further in H6. inversion H6. auto.
  - intros A0 Htyp e2 Hred2.
    dependent destruction Hred2.
    + eapply tred_determinism; eauto 3.
      eapply anno_check_to_infer in Htyp; eauto.
    + eapply value_cannot_step_further in Hred2; eauto. contradiction.
  - intros A0 Htyp e2 Hred2.
    dependent destruction Hred2.
    + eapply value_cannot_step_further in Hred1. contradiction.
      auto.
    + assert (Heq: e' = e'0).
      dependent destruction Htyp.
      * inversion H1.
      * dependent destruction Htyp.
        eapply IHHred1; eauto.
      * rewrite Heq. reflexivity.
  - intros A Htyp e0 Hred2.
    dependent destruction Hred2.
    + eapply value_cannot_step_further in Hred1; eauto. contradiction.
    + assert (Heq: e1' = e1'0).
      dependent destruction Htyp.
      * inversion H0.
      * eapply IHHred1; eauto 3.
      * dependent destruction Htyp.
        assert (exists C, typing nil nil check_mode e1 C).
        eapply lambda_typing1; eauto 3.
        destruct H0.
        eapply IHHred1; eauto 3.
      * rewrite Heq; eauto.
    + eapply value_cannot_step_further in Hred1. contradiction. assumption.
  - intros A Htyp e0 Hred2.
    dependent destruction Hred2.
    + eapply value_cannot_step_further in Hred1. contradiction. assumption.
    + eapply value_cannot_step_further in Hred2. contradiction. assumption.
    + assert (Heq: e2' = e2'0).
      dependent destruction Htyp.
      * inversion H1.
      * eapply IHHred1; eauto 3.
      * dependent destruction Htyp.
        eapply IHHred1; eauto 3.
      * rewrite Heq. reflexivity.
  - intros A Htyp e0 Hred2.
    dependent destruction Hred2.
    + assert (Heq: e1' = e1'0).
      dependent destruction Htyp.
      inversion H0.
      dependent destruction Htyp.
      * eapply IHHred1; eauto.
      * eapply IHHred1; eauto.
      * rewrite Heq. reflexivity.
    + eapply value_cannot_step_further in Hred1. contradiction. assumption.
  - intros A Htyp e0 Hred2.
    dependent destruction Hred2.
    + eapply value_cannot_step_further in Hred2.
      contradiction. assumption.
    + assert (Heq: e2' = e2'0).
      dependent destruction Htyp.
      inversion H1.
      dependent destruction Htyp.
      * eapply IHHred1; eauto.
      * eapply IHHred1; eauto.
      * rewrite Heq. reflexivity.
Qed.


Require Import
        Coq.Strings.String
        Coq.Vectors.Vector.

Require Import
        Fiat.Computation
        Fiat.BinEncoders.Env.Common.Specs
        Fiat.BinEncoders.Env.Common.WordFacts
        Fiat.BinEncoders.Env.Common.ComposeIf
        Fiat.BinEncoders.Env.Common.ComposeOpt
        Fiat.BinEncoders.Env.Automation.Solver
        Fiat.BinEncoders.Env.BinLib.AlignedByteString
        Fiat.BinEncoders.Env.BinLib.AlignWord
        Fiat.BinEncoders.Env.BinLib.AlignedDecoders
        Fiat.BinEncoders.Env.Lib2.WordOpt
        Fiat.BinEncoders.Env.Lib2.NatOpt
        Fiat.BinEncoders.Env.Lib2.FixListOpt.

Instance ByteStringQueueTransformer : Transformer ByteString := ByteStringQueueTransformer.

Definition simple_record := ((word 16) * list (word 8))%type.

Definition Simple_Format_Spec
           (p : simple_record) :=
        encode_nat_Spec 8 (|snd p|)
  ThenC encode_word_Spec (fst p)
  ThenC encode_list_Spec encode_word_Spec (snd p)
  DoneC.

Definition Simply_OK (p : simple_record) :=
  ((|snd p|) < pow2 8)%nat.

Arguments split1' : simpl never.
Arguments split2' : simpl never.
Arguments weq : simpl never.
Arguments natToWord : simpl never.
Arguments Guarded_Vector_split : simpl never.
Arguments Core.append_word : simpl never.

Definition refine_simple_encode
  : { b : _ & forall (p : simple_record)
                     (p_OK : Simply_OK p),
          refine (Simple_Format_Spec p ())
                 (ret (b p)) }.
Proof.
  unfold Simple_Format_Spec.
  eexists; intros.
  eapply AlignedEncodeChar; eauto.
  eapply AlignedEncode2Char; eauto.
  etransitivity.
  apply refine_under_bind_both.
  eapply optimize_align_encode_list.
  etransitivity.
  eapply aligned_encode_char_eq.
  instantiate (1 := fun a ce => (existT _ _ _, _)); simpl.
  reflexivity.
  intros; unfold Bind2; simplify with monad laws; higher_order_reflexivity.
  simpl.
  match goal with
    |- context [let (v, c) := ?z in ret (@?b v c)] =>
    rewrite (zeta_inside_ret z _)
  end.
  simplify with monad laws; simpl.
  rewrite zeta_to_fst; simpl.
  replace ByteString_id
  with (build_aligned_ByteString (Vector.nil _)).
  erewrite <- build_aligned_ByteString_append.
  reflexivity.
  eapply ByteString_f_equal;
    instantiate (1 := eq_refl _); reflexivity.
Defined.

Definition byte_aligned_simple_encoder
             (r : simple_record)
  := Eval simpl in (projT1 refine_simple_encode r).

Import Vectors.VectorDef.VectorNotations.
Print byte_aligned_simple_encoder.

Definition Simple_Format_decoder
  : CorrectDecoderFor Simply_OK Simple_Format_Spec.
Proof.
  start_synthesizing_decoder.
  normalize_compose transformer.
  repeat decode_step idtac.
  intros; eauto using FixedList_predicate_rest_True.
  synthesize_cache_invariant.
  cbv beta; optimize_decoder_impl.
Defined.

Definition SimpleDecoderImpl
    := Eval simpl in (projT1 Simple_Format_decoder).

  Ltac rewrite_DecodeOpt2_fmap :=
    set_refine_evar;
    progress rewrite ?BindOpt_map, ?DecodeOpt2_fmap_if,
    ?DecodeOpt2_fmap_if_bool;
    subst_refine_evar.

Definition ByteAligned_SimpleDecoderImpl {A}
           (f : _ -> A)
           n
  : {impl : _ & forall (v : Vector.t _ (3 + n)),
         f (fst SimpleDecoderImpl (build_aligned_ByteString v) ()) =
         impl v () }.
Proof.
  eexists _; intros.
  etransitivity.
  set_refine_evar; simpl.
  unfold DecodeBindOpt2 at 1; rewrite_DecodeOpt2_fmap.
  rewrite (@AlignedDecodeNat NoCache.test_cache).
  subst_refine_evar; apply rewrite_under_LetIn; intros; set_refine_evar.
  unfold DecodeBindOpt2 at 1; rewrite_DecodeOpt2_fmap.
  rewrite (@AlignedDecode2Char NoCache.test_cache).
  subst_refine_evar; apply rewrite_under_LetIn; intros; set_refine_evar.
  unfold DecodeBindOpt2 at 1; rewrite_DecodeOpt2_fmap.
  erewrite optimize_align_decode_list.
  rewrite Ifopt_Ifopt; simpl.
  etransitivity.
  eapply optimize_under_if_opt; simpl; intros.
  higher_order_reflexivity.
  reflexivity.
  Focus 2.
  clear H; intros.
  etransitivity.
  match goal with
    |- ?b = _ =>
    let b' := (eval pattern (build_aligned_ByteString v0) in b) in
    let b' := match b' with ?f _ => f end in
      eapply (@optimize_Guarded_Decode n0 _ 1 b')
  end.
  destruct n0 as [ | [ | ?] ]; intros; try omega.
  apply (@decode_word_aligned_ByteString_overflow NoCache.test_cache) with (sz := 1); auto.
  destruct n0 as [ | ?]; intros; try omega.
  higher_order_reflexivity.
  instantiate (1 := fun n1 v1 (cd0 : CacheDecode) =>
                      If NPeano.leb 1 n1 Then (Some ((Vector.hd (Guarded_Vector_split 1 n1 v1), @existT _ (Vector.t _) _ (Vector.tl (Guarded_Vector_split 1 n1 v1))), cd0)) Else None).
  simpl; find_if_inside; simpl; try reflexivity.
  pattern n0, v0; apply Vector.caseS; simpl; intros.
  unfold decode_word, WordOpt.decode_word.
  rewrite aligned_decode_char_eq; reflexivity.
  subst_refine_evar; higher_order_reflexivity.
  higher_order_reflexivity.
Defined.

Definition ByteAligned_SimpleDecoderImpl' n :=
  Eval simpl in (projT1 (ByteAligned_SimpleDecoderImpl id n)).

Print ByteAligned_SimpleDecoderImpl'.


(* Require Import Coq.Program.Basics.
Require Import Coq.Strings.String.
Require Import Setoid.
Require Import ZArith.
Require Import Psatz.
Require Import Coq.Program.Equality.

Require Import mathcomp.ssreflect.ssreflect.
From mathcomp Require Import seq ssreflect ssrbool ssrnat eqtype.

Require Import FinProof.Common.
Require Import FinProof.MonadTransformers21.
Require Import FinProof.Common.
Require Import FinProof.StateMonad21.
Require Import FinProof.StateMonad21Instances.
Require Import FinProof.Types.IsoTypes.
Require Import FinProof.ProgrammingWith.

Require Import UMLang.UrsusLib.

Require Import UrsusStdLib.Cpp.stdTypes.
Require Import UrsusStdLib.Cpp.stdErrors.
Require Import UrsusStdLib.Cpp.stdFunc.
Require Import UrsusStdLib.Cpp.stdNotations.
Require Import UrsusStdLib.Cpp.stdUFunc.

Require Import UrsusTVM.Cpp.tvmTypes.
Require Import UrsusTVM.Cpp.tvmFunc.
Require Import UrsusTVM.Cpp.tvmNotations.

Require Import Project.CommonConstSig.
Require Import Project.CommonTypes.

(*Fully qualified name are mandatory in multi-contract environment*)
Require Import DBlank.Ledger.
Require Import DBlank.ClassTypesNotations.
Require Import DBlank.ClassTypes.
Require Import DBlank.Functions.FuncSig.
Require Import DBlank.Functions.FuncNotations.
Require Import DBlank.Functions.Funcs.

(* Require Import Blank.ClassTypesNotations. *)

Set Typeclasses Iterative Deepening.
(* Set Typeclasses Depth 100. *)

Import UrsusNotations.
Local Open Scope ursus_scope.
Local Open Scope ucpp_scope.
Local Open Scope struct_scope.
Local Open Scope N_scope.
Local Open Scope string_scope.
Local Open Scope xlist_scope.
 *)
Require Import Logic.FunctionalExtensionality.
From QuickChick Require Import QuickChick.
Import QcDefaultNotation. Open Scope qc_scope.
Import GenLow GenHigh.
Set Warnings "-extraction-opaque-accessed,-extraction".

Require Import Project.CommonQCEnvironment.
Require Import DBlank.QuickChicks.QCEnvironment.
Require Import DBlank.QuickChicks.Props.
(* Require Import UMLang.ExecGenerator. *)
(*
Definition UinterpreterL := @Uinterpreter XBool XUInteger XMaybe XList XProd XHMap _ _ _ _ _ _
                             LedgerLRecord ContractLRecord LocalStateLRecord VMStateLRecord
                             MessagesAndEventsLRecord GlobalParamsLRecord
                             OutgoingMessageParamsLRecord ledgerClass .
Arguments UinterpreterL {_} {_} {_}.

Definition ledger_prop1 (l: LedgerLRecord) := true.

(* Time QuickChick ledger_prop1.*)

Import FinProof.Common.  (*for eqb!!!*)
Require Import FinProof.CommonInstances. *)

(*
Time QuickCheck constructor_isError_propb.
Time QuickCheck constructor_exec_propb.
  Time QuickCheck constructor_noexec_propb.
  Time QuickCheck setFromGiverCode_isError_propb.
  Time QuickCheck setFromGiverCode_exec_propb.
  Time QuickCheck setFromGiverCode_noexec_propb.
  Time QuickCheck setKWDPoolCode_isError_propb.
  Time QuickCheck setKWDPoolCode_exec_propb.
  Time QuickCheck setKWDPoolCode_noexec_propb.
  Time QuickCheck isFundReady_isError_propb.
  Time QuickCheck isFundReady_exec_propb.
  Time QuickCheck notifyLeft_isError_propb.
  Time QuickCheck notifyLeft_exec_propb.
  Time QuickCheck notifyLeft_noexec_propb.
  Time QuickCheck deployFromGiver_isError_propb.
  Time QuickCheck deployFromGiver_exec_propb.
  Time QuickCheck deployFromGiver_noexec_propb.
  Time QuickCheck acknowledgeDeploy_isError_propb.
  Time QuickCheck acknowledgeDeploy_exec_propb.
  Time QuickCheck acknowledgeDeploy_noexec_propb.
  Time QuickCheck notifyRight_isError_propb.
  Time QuickCheck notifyRight_exec_propb.
  Time QuickCheck notifyRight_noexec_propb.
  Time QuickCheck acknowledgeFinalizeRight_isError_propb.
  Time QuickCheck acknowledgeFinalizeRight_exec_propb.
  Time QuickCheck acknowledgeFinalizeRight_noexec_propb.
  Time QuickCheck acknowledgeFinalizeLeft_isError_propb.
  Time QuickCheck acknowledgeFinalizeLeft_exec_propb.
  Time QuickCheck acknowledgeFinalizeLeft_noexec_propb.
  Time QuickCheck finalize_isError_propb.
  Time QuickCheck finalize_exec_propb.
  Time QuickCheck finalize_noexec_propb.
  Time QuickCheck finalize_noexec_contract_propb.
  Time QuickCheck setFundCode_isError_propb.
  Time QuickCheck setFundCode_exec_propb.
  Time QuickCheck setFundCode_noexec_propb.
  Time QuickCheck setFundCode_contract_noexec_propb.
  Time QuickCheck killBlank_isError_propb.
  Time QuickCheck killBlank_exec_propb.
  Time QuickCheck killBlank_noexec_propb.
  Time QuickCheck killBlank_noexec_contract_propb.   *)


Require Export MinBFTass_tknows.
Require Export MinBFTass_knew.
Require Export MinBFTass_diss.
Require Export ComponentAxiom.

Section MinBFTass_tlearn.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { dtc                 : DTimeContext        }.
  Context { minbft_context      : MinBFT_context      }.
  Context { m_initial_keys      : MinBFT_initial_keys }.
  Context { u_initial_keys      : USIG_initial_keys   }.
  Context { usig_hash           : USIG_hash           }.
  Context { minbft_auth         : MinBFT_auth         }.

  Lemma ASSUMPTION_trusted_learns_if_gen_true :
    forall (eo : EventOrdering),
      AXIOM_authenticated_messages_were_sent_or_byz eo MinBFTsys
      -> assume_eo eo (KE_ALL_TRUST ASSUMPTION_trusted_learns_if_gen).
  Proof.
    introv sendbyz; introv.
    rewrite <- sequent_true_iff_interpret.
    apply DERIVED_RULE_implies_all_trusted_learns_if_gen2_true; simseqs j;
      apply sequent_true_iff_interpret; eauto 3 with minbft;
      try (apply ASSUMPTION_in_knows_implies_trusted_knows_true);
      try (apply ASSUMPTION_diss_correct_implies_knows_true);
      try (apply ASSUMPTION_all_knew_or_learns_or_gen_true).

    { apply ASSUMPTION_authenticated_messages_were_sent_or_byz_true; simpl; auto; tcsp;
        try (complete (introv h q; destruct a as [a x], a; simpl in *; ginv; simpl in *; tcsp; eauto));
        try (complete (introv h q; destruct m; simpl in *; tcsp; repndors; subst; tcsp;
                       try (destruct p as [p a], p, a);
                       try (destruct c as [c a], c, a);
                       simpl in *; repndors; subst; simpl in *; tcsp)). }
  Qed.

End MinBFTass_tlearn.

Hint Resolve ASSUMPTION_trusted_learns_if_gen_true : minbft.


Require Export MicroBFTprops2.
Require Export ComponentAxiom.

Section MicroBFTass_tlearn.

  Local Open Scope eo.
  Local Open Scope proc.

  Context { dtc                 : DTimeContext          }.
  Context { microbft_context    : MicroBFT_context      }.
  Context { m_initial_keys      : MicroBFT_initial_keys }.
  Context { u_initial_keys      : USIG_initial_keys     }.
  Context { usig_hash           : USIG_hash             }.
  Context { microbft_auth       : MicroBFT_auth         }.

  Opaque KE_TOWNS.
  Opaque KE_TGENS.

  Lemma ASSUMPTION_trusted_learns_if_gen_true :
    forall (eo : EventOrdering),
      AXIOM_authenticated_messages_were_sent_or_byz eo MicroBFTsys
      -> assume_eo eo (KE_ALL_TRUST ASSUMPTION_trusted_learns_if_gen).
  Proof.
    introv sendbyz; introv lrn.
    destruct e as [e exe].

    simpl in *; exrepnd; GC.
    unfold learns_data in *; exrepnd; GC.

    pose proof (sendbyz e a (const_opTrust lrn3)) as sendbyz.
    simpl in *.
    repeat (autodimp sendbyz hyp).
    exrepnd; repndors; exrepnd; ginv;[|].

    {
      autodimp sendbyz5 hyp; eauto 3 with microbft.

      assert (exists k, loc e' = MicroBFTheader.node2name k) as eqloc'.
      { destruct a as [a tok], a, m; simpl in *; tcsp; ginv;
          try (complete (inversion sendbyz4; eauto)). }
      exrepnd.

      unfold M_output_sys_on_event in sendbyz5; simpl in *.
      rewrite eqloc'0 in *; simpl in *.
      apply M_output_ls_on_event_as_run in sendbyz5; exrepnd.
      applydup M_run_ls_before_event_ls_is_microbft in sendbyz5; exrepnd; subst; simpl in *.

      unfold M_output_ls_on_this_one_event in sendbyz6.
      remember (trigger_op e') as trig; symmetry in Heqtrig.
      destruct trig; simpl in *; tcsp;[].

      (* XXXXXXXXXXX *)
      unfold M_run_ls_on_input_out in *.
      unfold M_run_ls_on_input in *.
      autorewrite with comp microbft in *.
      Time microbft_dest_msg Case; [|].

      { Case "Request".

        inversion sendbyz6; subst; simpl in *; clear sendbyz6.
        repeat (repndors; subst; tcsp; simpl in *; ginv);[].

        assert (ex_node_e e') as exe' by (eexists; allrw; simpl; eauto).

        exists (MkEventN e' exe'); dands;
          allrw interp_owns; simpl; eauto 3 with minbft;
            try (complete (unfold data_is_owned_by; simpl; unfold ui2rep; simpl; eauto));[ | unfold data_is_owned_by; smash_microbft].

        unfold disseminate_data; simpl.
        unfold M_byz_output_sys_on_event; simpl.
        allrw; simpl.
        rewrite M_byz_output_ls_on_event_as_run.
        applydup @M_run_ls_before_event_M_byz_run_ls_before_event in sendbyz5 as byz.
        applydup trigger_op_Some_implies_trigger_message in Heqtrig as trig'.
        unfold M_byz_output_ls_on_this_one_event; simpl.
        unfold M_byz_run_ls_on_one_event; simpl.
        repeat (allrw; simpl).
        unfold data_is_in_out, event2out; rewrite trig'; simpl.
        unfold M_run_ls_on_input; simpl.
        autorewrite with comp microbft.
        repeat unfold_handler_concl.
        smash_microbft.
        eexists; dands; try reflexivity; dands; tcsp.
      }

      {
        Case "Commit".

        repeat (simpl in *; try autorewrite with comp minbft in *; smash_microbft2);
          try (complete (inversion sendbyz6; subst; simpl in *; tcsp)).
      }
    }

    {
      ginv.
      assert (ex_node_e e') as exe' by (eexists; allrw; simpl; eauto).
      exists (MkEventN e' exe'); simpl; allrw interp_towns; dands; eauto 3 with minbft;
        try (complete (unfold data_is_owned_by; simpl; unfold ui2rep; simpl; eauto));[].

      unfold M_byz_output_sys_on_event in *; simpl in *.
      rewrite sendbyz7 in *; simpl in *.

      assert (MicroBFTsys (MicroBFTheader.node2name (ui2rep t)) = MicroBFTlocalSys (ui2rep t)) as temp by auto.
      rewrite temp in *.

      unfold disseminate_data.
      unfold M_byz_output_sys_on_event; simpl.
      allrw.
      exists o; dands; auto.
      clear sendbyz4.

      revert dependent o.
      unfold is_trusted_event in *.
      unfold data_is_in_out, trusted_is_in_out, event2out; simpl in *; rewrite p; simpl in *.
      introv xx; subst; simpl in *.
      allrw; simpl; tcsp.
    }
  Qed.
  Hint Resolve ASSUMPTION_trusted_learns_if_gen_true : microbft.

End MicroBFTass_tlearn.

Hint Resolve ASSUMPTION_trusted_learns_if_gen_true : microbft.


Require Import SpecDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import TableDataOpsIntro.Spec.

Local Open Scope Z_scope.

Section SpecLow.

  Definition data_create_unknown1_spec0 (g_rd: Pointer) (data_addr: Z64) (map_addr: Z64) (g_data: Pointer) (adt: RData) : option (RData * Z64) :=
    match g_rd, data_addr, map_addr, g_data with
    | (_g_rd_base, _g_rd_ofst), VZ64 _data_addr, VZ64 _map_addr, (_g_data_base, _g_data_ofst) =>
      rely is_int64 _data_addr;
      rely is_int64 _map_addr;
      when' _t'1, adt == data_create_unknown_spec (_g_rd_base, _g_rd_ofst) (VZ64 _data_addr) (VZ64 _map_addr) (_g_data_base, _g_data_ofst) adt;
      rely is_int64 _t'1;
      Some (adt, (VZ64 _t'1))
     end
    .

End SpecLow.