(**************************************************
 * Author: Ana Nora Evans (ananevans@virginia.edu)
 **************************************************)
Require Import Coq.ZArith.ZArith.
Require Import Coq.Structures.Equalities.
Require Import Coq.Lists.List.

Require Import Common.Definitions.
Require Import Common.Maps.
Require Import SFIUtil.

From mathcomp.ssreflect Require Import ssreflect ssrfun ssrbool eqtype.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(******************************************
 * Basic Risc Machine Definition
 *******************************************)
Module RiscMachine.

  Definition value := Z.

  Definition immediate := Z.

  Definition address : Set := N.

  (* program counter register type *)
  Definition pc : Set := address.

  Definition PC0 : pc := N0.

  (******************************************
   * Register Type Definition
   *******************************************)
  Module Register.

    Open Scope N_scope.
    Definition t := N.

    Definition R_ONE: t := 1.
    Definition R_COM : t := 2.
    Definition R_AUX1 : t := 3.
    Definition R_AUX2 : t := 4.
    Definition R_RA : t := 5.
    Definition R_SP : t := 6.
    Definition R_ARG : t := 7.
    (* reserved SFI registers *)
    Definition R_SFI_SP: t := 26.
    Definition R_AND_CODE_MASK : t := 27.
    Definition R_AND_DATA_MASK : t := 28.
    Definition R_OR_CODE_MASK : t := 29.
    Definition R_OR_DATA_MASK : t := 30.
    Definition R_T : t := 31.
    Definition R_D : t := 32.
    Close Scope N_scope.

    Definition NO_REGISTERS : nat := 33.

    Definition eqb (r1 r2 : t) : bool :=
      N.eqb r1 r2.

    Theorem eqb_eq:
      forall r1 r2 : t, eqb r1 r2 = true <-> r1 = r2.
    Proof.
      intros r1 r2. apply N.eqb_eq.
    Qed.

    Theorem eqb_refl:
      forall r : t, eqb r r = true.
    Proof. apply N.eqb_refl. Qed.

  End Register.

  (******************************************************
   * Register File Definition
   * General Registers (does not contain program counter)
   ******************************************************)
  Module RegisterFile <: UsualDecidableType.

    (* Use the constants in the Register Module as indices in the list,
       to get the value of the register *)
    Definition t : Set := list value.

    Fixpoint is_zero (gen_regs:t)  : Prop :=
      match gen_regs with
      | [] => True
      | r :: l' => (r = Z0 )/\ is_zero l'
      end.

    Definition reset_all : t := repeat Z0 Register.NO_REGISTERS.

    Definition update {A} (l : list A) (pos : nat) (x:A) (def:A) : list A :=
      let fix up_aux l pos x :=
          match pos with
          | O => match l with
                | nil => [x]
                | _::xs => x::xs
                end
          | S pos' =>
            match l with
            | nil => def :: (up_aux l pos' x)
            | x'::xs => x' :: (up_aux xs pos' x)
            end
          end in
      up_aux l pos x.

    Definition set_register (reg : Register.t) (val : value)
               (gen_regs  : t) : t :=
      update gen_regs (N.to_nat reg) val Z0.

    Definition get_register (reg : Register.t) (gen_regs : t) : option value :=
      nth_error gen_regs (N.to_nat reg).

    Fixpoint eqb (regs1 regs2 : t) : bool :=
      match (regs1,regs2) with
      | ([],[]) => true
      | (v1::regs1',v2::regs2') => (Z.eqb v1 v2) && (eqb regs1' regs2')
      | _ => false
      end.

    Lemma eqb_refl:
      forall regs, eqb regs regs = true.
    Proof.
      intros.
      induction regs.
      - reflexivity.
      - simpl.
        rewrite Z.eqb_refl. rewrite IHregs.
        reflexivity.
    Qed.

    Lemma eqb_eq: forall (regs1 regs2 : t),
        (eqb regs1 regs2) = true <-> regs1 = regs2.
    Proof.
      split.
      - intro H. generalize dependent regs2. induction regs1.
        + intros. destruct regs2.
          * reflexivity.
          * inversion H.
        + intros. destruct regs2.
          * inversion H.
          * inversion H. apply andb_true_iff in H1.
            destruct H1 as [Hh Ht].
            apply IHregs1 in Ht.
            rewrite Ht.
            apply Z.eqb_eq in Hh.
            rewrite Hh. reflexivity.
      - intro H. rewrite H. apply eqb_refl.
    Defined.

    Lemma neqb_neq: forall (regs1 regs2 : t),
        (eqb regs1 regs2) = false -> regs1 <> regs2.
    Proof.
      intros. intro H1. apply eqb_eq in H1. rewrite H1 in H. inversion H.
    Qed.

    Theorem eq_dec: forall regs1 regs2 : t, {regs1 = regs2} + {regs1 <> regs2}.
    Proof.
      apply List.list_eq_dec. apply Z.eq_dec.
    Defined.

    Include HasUsualEq <+ UsualIsEq.

  End RegisterFile.

  (******************************************************
   * ISA Definitions: Instructions and binary operations
   ******************************************************)
  Module ISA.

    Inductive binop : Type :=
    | Addition : binop
    | Subtraction : binop
    | Multiplication : binop
    | Equality : binop
    | Leq : binop
    | BitwiseOr : binop
    | BitwiseAnd : binop
    | ShiftLeft : binop.

    Inductive instr : Set :=
    | INop : instr
    (* register operations *)
    | IConst : value -> Register.t -> instr
    | IMov : Register.t -> Register.t -> instr
    | IBinOp : binop -> Register.t -> Register.t -> Register.t -> instr
    (* memory operations *)
    | ILoad : Register.t -> Register.t -> instr
    | IStore : Register.t -> Register.t -> instr
    (* conditional and unconditional jumps *)
    | IBnz : Register.t -> immediate -> instr
    | IJump : Register.t -> instr
    | IJal : address -> instr
    (* termination *)
    | IHalt : instr.

    Definition eqb_op (op1 op2 : binop) :=
      match (op1,op2) with
        | (Addition,Addition) => true
        | (Subtraction,Subtraction) => true
        | (Multiplication,Multiplication) => true
        | (Equality,Equality) => true
        | (Leq,Leq) => true
        | (BitwiseOr,BitwiseOr) => true
        | (BitwiseAnd,BitwiseAnd) => true
        | (ShiftLeft,ShiftLeft) => true
        | _ => false
      end.

    Theorem  eqb_refl_op:
      forall op : binop,  eqb_op op op = true.
    Proof.
      intro op. unfold eqb_op. destruct op; reflexivity.
    Qed.

    Theorem eqb_eq_bop:
      forall op1 op2: binop, eqb_op op1 op2 = true <-> op1 = op2.
    Proof.
      split.
      - unfold eqb_op.
        destruct op1; destruct op2; intro H;
          try (reflexivity); try (inversion H).
      - intro H. rewrite H. apply eqb_refl_op.
    Qed.

    Definition eqb_instr (i1 i2 : instr) : bool :=
      match (i1,i2) with
      | (INop,INop) => true
      | (IConst v1 r1, IConst v2 r2) => (Z.eqb v1 v2)
                                          && (Register.eqb r1 r2)
      | (IMov r11 r12, IMov r21 r22) =>
        (Register.eqb r11 r21)
          && (Register.eqb r12 r22)
      | (IBinOp op1 r11 r12 r13, IBinOp op2 r21 r22 r23) =>
        (eqb_op op1 op2)
          && (Register.eqb r11 r21)
          && (Register.eqb r12 r22)
          && (Register.eqb r13 r23)
      | (ILoad r11 r12, ILoad r21 r22) =>
        (Register.eqb r11 r21)
          && (Register.eqb r12 r22)
      | (IStore r11 r12, IStore r21 r22) =>
        (Register.eqb r11 r21)
          && (Register.eqb r12 r22)
      | (IBnz r1 imm1, IBnz r2 imm2) =>
        (Register.eqb r1 r2)
          && (Z.eqb imm1 imm2)
      | (IJump r1, IJump r2) => (Register.eqb r1 r2)
      | (IJal a1, IJal a2) => (N.eqb a1 a2)
      | (IHalt, IHalt) => true
      | _ => false
      end.

    Theorem eqb_refl_instr:
      forall i : instr, eqb_instr i i = true.
    Proof.
      intro i. unfold eqb_instr.
      destruct i;
        try (reflexivity);
        try (apply N.eqb_refl);
        try (apply  andb_true_iff; split; apply Register.eqb_refl).
      - apply  andb_true_iff. split.
        + apply Z.eqb_refl.
        + apply Register.eqb_refl.
      - repeat (apply  andb_true_iff; split);
          try (apply Register.eqb_refl).
        apply eqb_refl_op.
      - apply  andb_true_iff. split.
        + apply Register.eqb_refl.
        + apply Z.eqb_refl.
    Qed.

    Theorem eqb_eq_instr:
      forall i1 i2 : instr, eqb_instr i1 i2= true <-> i1 = i2.
    Proof.
      intros i1 i2. split.
      - unfold eqb_instr.
        destruct i1; destruct i2; intro H;
          try (reflexivity); try (inversion H);
            (* 2 register instructions *)
            try ( apply andb_true_iff in H; destruct H as [H' H''];
                  apply Register.eqb_eq in H'; rewrite H';
                  apply Register.eqb_eq in H''; rewrite H''; reflexivity);
            (* Const *)
            try ( apply andb_true_iff in H; destruct H as [H' H''];
                  apply Z.eqb_eq in H'; rewrite H';
                  apply Register.eqb_eq in H''; rewrite H''; reflexivity).
        (* BinOp *)
        + clear H1. apply andb_true_iff in H. destruct H as [H H1].
          apply andb_true_iff in H. destruct H as [H H2].
          apply andb_true_iff in H. destruct H as [H3 H4].
          apply eqb_eq_bop in H3. rewrite H3.
          apply Register.eqb_eq in H2. rewrite H2.
          apply Register.eqb_eq in H1. rewrite H1.
          apply Register.eqb_eq in H4. rewrite H4.
          reflexivity.
        (* Bnz *)
        + clear H1. apply andb_true_iff in H. destruct H as [H1 H2].
          apply Z.eqb_eq in H2. rewrite H2.
          apply Register.eqb_eq in H1; rewrite H1; reflexivity.
        (* Jump *)
        + apply Register.eqb_eq in H1; rewrite H1; reflexivity.
        + apply N.eqb_eq in H. rewrite H. reflexivity.
      - intro H. rewrite H. apply eqb_refl_instr.
        Qed.

    Theorem instr_eq_dec:
      forall i1 i2 : instr,  {i1 = i2} + {i1 <> i2}.
    Proof.
      repeat decide equality. Defined.

  End ISA.

  (* Type of a memory location *)
  Inductive word :=
  | Data : value -> word
  | Instruction : ISA.instr -> word.

  Definition eqb_word (w1 w2 : word) : bool :=
    match (w1,w2) with
    | (Data v1, Data v2) => Z.eqb v1 v2
    | (Instruction i1, Instruction i2) => ISA.eqb_instr i1 i2
    | _ => false
    end.

  Theorem eqb_refl_word:
    forall w : word, eqb_word w w = true.
  Proof.
    intro w. unfold eqb_word. destruct w.
    - apply Z.eqb_refl.
    - apply  ISA.eqb_refl_instr.
  Qed.

  Theorem eq_word_trans:
    forall (w1 w2 w3 : word), w1=w2 -> w2=w3 -> w1=w3.
  Proof.
    intros. destruct w1, w2, w3; inversion H; inversion H0; reflexivity.
  Qed.

  Theorem eqb_eq_word: forall (e e' : word),
      eqb_word e e' = true <-> e = e'.
  Proof.
    split.
    - unfold eqb_word. destruct e; destruct e'.
      + intro H. apply Z.eqb_eq in H. rewrite H. reflexivity.
      + intro H. inversion H.
      + intro H. inversion H.
      + intro H. apply ISA.eqb_eq_instr in H. rewrite H. reflexivity.
    - intro H. rewrite H. apply eqb_refl_word.
  Qed.

  (******************************************************
   * Memory Definitions
   ******************************************************)
  Module Memory.

    (* key: address, value: word at that address (data or code) *)
    Definition t := BinNatMap.t word.

    Definition get_word (mem : t) (ptr : address) : option word :=
      BinNatMap.find ptr mem.

    Definition get_value (mem : t) (ptr : address) : option value :=
      match get_word mem ptr with
      | Some (Data val) => Some val
      | _ => Some Z0
      end.

    Definition get_instr (mem : t) (ptr : address) : option RiscMachine.ISA.instr :=
      match get_word mem ptr with
      | Some (Instruction val) => Some val
      | _ => None
      end.

    Definition set_value (mem : t) (ptr : address) (val : value) : t :=
      BinNatMap.add ptr (Data val) mem.

    Definition set_instr (mem : t) (ptr : address) (i : ISA.instr) : t :=
      BinNatMap.add ptr (Instruction i) mem.

    Definition to_address (ptr:value) : address :=
      (* negatives are converted to zero *)
      Z.to_N ptr.

    (* returns an empty memory *)
    Definition empty : t := BinNatMap.empty word.

    (* returns all addresses that have been assigned a value *)
    Definition get_used_addresses (mem : t) :=
      BinNatMap.fold (fun key elt acc => key::acc) mem nil.

    Definition filter_used_addresses (mem : t) (filter : address -> bool) :=
      BinNatMap.fold (fun key elt acc =>
                        if (filter key)
                        then key::acc
                        else acc)
                     mem nil.

    Definition of_list (lst : list (RiscMachine.address * word)) : t :=
      BinNatMapExtra.of_list lst.

    Definition eqb (m1 m2 : t) : bool :=
      BinNatMap.equal eqb_word m1 m2.

    Definition Equal (m1 m2 : t) : Prop :=
      BinNatMap.Equal m1 m2.

    Theorem Equal_sym:
      forall (m1 m2 : t), Equal m1 m2 -> Equal m2 m1.
    Proof.
      intros m1 m2. apply (BinNatMapFacts.Equal_sym).
    Qed.

    Theorem Equal_trans:
      forall (m1 m2 m3 : t),
        Equal m1 m2 -> Equal m2 m3 -> Equal m1 m3.
    Proof.
      unfold Equal.
      apply (BinNatMapFacts.Equal_trans).
    Qed.

    Theorem Equal_refl:
      forall (m : t), Equal m m.
    Proof.
      intro m. apply (BinNatMapFacts.Equal_refl).
    Qed.

    Theorem eqb_refl:
      forall (m : t), eqb m m = true.
    Proof.
      unfold eqb. intros.
      apply BinNatMap.equal_1.
      apply BinNatMapFacts.Equal_Equivb.
      - apply eqb_eq_word.
      - apply BinNatMapFacts.Equal_refl.
    Qed.

    Lemma eqb_Equal: forall (m1 m2 : t),
        (eqb m1 m2) = true <->  BinNatMap.Equal m1 m2.
    Proof.
      split.
      - unfold eqb. intro H.
        apply BinNatMap.equal_2 in H.
        apply BinNatMapFacts.Equal_Equivb in H.
        + apply H.
        + apply eqb_eq_word.
      - intro H. unfold eqb.
        apply  BinNatMap.equal_1.
        apply BinNatMapFacts.Equal_Equivb.
        apply eqb_eq_word.
        apply H.
    Qed.

    Theorem get_word_Equal:
      forall (m1 m2 : t) (ptr : address),
        Equal m1 m2 -> (get_word m1 ptr) = (get_word m2 ptr).
    Proof.
      intros. unfold Equal in H.
      unfold BinNatMap.Equal in H.
      unfold get_word.
      apply H.
    Qed.

    Theorem get_value_Equal:
      forall (m1 m2 : t) (ptr : address),
        Equal m1 m2 -> (get_value m1 ptr) = (get_value m2 ptr).
    Proof.
      intros. unfold get_value. apply get_word_Equal with (m1:=m1) (m2:=m2) (ptr:=ptr) in H.
      rewrite H. reflexivity.
    Qed.

    Theorem  set_value_Equal:
      forall (m1 m2 : t) (ptr : address) (val : value),
        Equal m1 m2 -> Equal (set_value m1 ptr val) (set_value m2 ptr val).
    Proof.
      intros. unfold set_value.
      apply BinNatMapFacts.add_m.
      reflexivity. reflexivity. unfold Equal in H. apply H.
    Qed.

  End Memory.

  (* evaluates the given binary operation *)
  Definition eval_binop (op : ISA.binop)
             (op1 : value) (op2 : value) : value :=
    match op with
    | ISA.Addition => (op1 + op2)%Z
    | ISA.Subtraction => (op1 - op2)%Z
    | ISA.Multiplication => (op1 * op2)%Z
    | ISA.Equality => if Zeq_bool op1 op2 then 1%Z else 0%Z
    | ISA.Leq => if Zle_bool op1 op2 then 1%Z else 0%Z
    | ISA.BitwiseAnd => Z.land op1 op2
    | ISA.BitwiseOr => Z.lor op1 op2
    | ISA.ShiftLeft => Z.shiftl op1 op2
  end.

  Definition executing (mem : Memory.t) (pc : address) ( i : ISA.instr) : Prop :=
    match (Memory.get_word mem pc) with
    | Some (Instruction i') => i = i'
    |  _ => False
    end.

  Definition is_executing (mem : Memory.t) (pc : address) ( i : ISA.instr) : bool :=
    match (Memory.get_word mem pc) with
    | Some (Instruction i') => ISA.eqb_instr i i'
    |  _ => false
    end.

  Theorem executing_equal:
    forall (m1 m2 : Memory.t) (pc : address) ( i : ISA.instr),
      BinNatMap.Equal m1 m2 -> executing m1 pc i -> executing m2 pc i.
  Proof.
    unfold executing. unfold Memory.get_word.
    simpl. intros.
    unfold BinNatMap.Equal in H.
    rewrite H in H0. apply H0.
  Qed.

  Definition inc_pc (a : pc) : pc := N.add a 1.

  Definition to_value (v : N) : value := Z.of_N v.

End RiscMachine.

Close Scope Z_scope.

(******************************************
 * SFIComponent Definition
 *******************************************)
Module SFIComponent.

  Definition id := N.

End SFIComponent.

(******************************************************
 * SFI specific definitions
 ******************************************************)
Module SFI.

  (* Number of bits used for offset within slot *)
  Definition OFFSET_BITS_NO : N := 12.

  (* Number of bits used for component *)
  Definition COMP_BITS_NO : N := 4.

  (* Definition COMPONENT_MASK : N := 2^CID_SIZE - 1. *)

  Definition CODE_DATA_BIT_MASK : N :=  N.shiftl 1 (OFFSET_BITS_NO + COMP_BITS_NO).

  (* Slot dimension *)
  Definition SLOT_SIZE : N := 2^OFFSET_BITS_NO.

  (* Maximum number of components, including the zero (special) component *)
  Definition COMP_MAX:N := 2^COMP_BITS_NO.

  Definition C_SFI (addr : RiscMachine.address) : SFIComponent.id  :=
    N.land (N.shiftr addr OFFSET_BITS_NO) (2^COMP_BITS_NO - 1).

  Definition SLOT_SFI (addr : RiscMachine.address) : N :=
    N.shiftr addr (OFFSET_BITS_NO+COMP_BITS_NO).

  Definition OFFSET_SFI (addr: RiscMachine.address) : N :=
    N.land addr (2^OFFSET_BITS_NO-1).

  Definition ADDRESS_ALLIGN_BITS_NO : N := 4.

  Definition BASIC_BLOCK_SIZE : N := 16.

  Definition MONITOR_COMPONENT_ID : N := 0.

  Definition BLOCK_BITS_NO : N := 7.

  Definition AND_DATA_MASK : N :=
    N.lor
      (N.shiftl (2^BLOCK_BITS_NO -1) (OFFSET_BITS_NO+COMP_BITS_NO+1))
      (2^OFFSET_BITS_NO - 1).

  Definition AND_CODE_MASK : N :=
    N.lor
      (N.shiftl (2^BLOCK_BITS_NO-1) (OFFSET_BITS_NO+COMP_BITS_NO+1))
      (N.shiftl (2^(OFFSET_BITS_NO-ADDRESS_ALLIGN_BITS_NO) - 1) ADDRESS_ALLIGN_BITS_NO).

  Open Scope N_scope.

  Definition last_address_in_slot (addr : RiscMachine.address) : bool :=
    N.eqb (OFFSET_SFI addr) (2^OFFSET_BITS_NO - 1).

  Definition address_of (cid : SFIComponent.id) (bid off: N) : RiscMachine.address :=
    N.lor
      (N.shiftl bid (COMP_BITS_NO+OFFSET_BITS_NO))
      (N.lor
         (N.shiftl cid OFFSET_BITS_NO)
         off).

  Definition convert_address (addr : RiscMachine.address) : SFIComponent.id * N * N :=
    ((C_SFI addr), (SLOT_SFI addr), (OFFSET_SFI addr)).

  Close Scope N_scope.

  Definition is_same_component (addr1: RiscMachine.address)
             (addr2: RiscMachine.address) : Prop :=
    (C_SFI addr1) = (C_SFI addr2).

  Definition is_same_component_bool (addr1: RiscMachine.address)
             (addr2: RiscMachine.address) :=
    N.eqb (C_SFI addr1) (C_SFI addr2).

  Definition is_code_address  (addr : RiscMachine.address) : bool :=
    N.eqb (N.land addr CODE_DATA_BIT_MASK) N0.

  Definition is_data_address  (addr : RiscMachine.address) : bool :=
    negb (is_code_address addr).

  Definition or_data_mask (cid : SFIComponent.id) : N :=
    (N.shiftl (N.lor (N.shiftl 1%N COMP_BITS_NO) cid) OFFSET_BITS_NO).

  Definition or_code_mask (cid : SFIComponent.id) : N :=
    (N.shiftl cid OFFSET_BITS_NO).

  Module Allocator.

    Definition allocator_data_slot := 1%N.

    (* will allocate starting with 3, odd numbers *)
    (* 1 is reserved for dynamic memory allocation data *)
    Definition allocate_data_slots (n : nat) : (list N) :=
      (List.map (fun nn => (2 *(N.of_nat nn)  + 1)%N) (List.seq 1 n)).

    Definition allocate_code_slots (n : nat) : (list N) :=
      (List.map (fun n => ((N.of_nat n) * 2)%N)
                (List.seq 0 n)).

    Definition initial_allocator_value (n:nat) : RiscMachine.value :=
      Z.of_nat n.

  End Allocator.

End SFI.

(******************************************************
 * Environment Definitions
 ******************************************************)
Module Env  <: UsualDecidableType.

  (* list of dimension COMP_MAX*)
  (* use the SFI component id as index to retrieve the intermediate
     level component id *)
  Definition CN := list Component.id.

  (* E is a partial map from addresses to procedure names.*)
  Definition E := list (RiscMachine.address*Procedure.id).

  Definition t := (CN * E)%type.

  Open Scope N_scope.
  Definition index2SFIid (i : nat) : SFIComponent.id :=
    (N.of_nat i) + 1.

  Definition SFIid2index (id : SFIComponent.id) : nat :=
    N.to_nat (id-1).
  Close Scope N_scope.

  Definition get_component_name_from_id (id : SFIComponent.id)
             (G : t): option Component.id :=
    nth_error (fst G) (SFIid2index id).

  Definition get_procedure (addr : RiscMachine.address)
             (G : Env.t) : option Procedure.id :=
    ListUtil.get_by_key (N.eqb) addr (snd G).

  Definition eq_dec:
    forall g1 g2 : t,  {g1 = g2} + {g1 <> g2}.
  Proof.
    repeat decide equality. Defined.

  Include HasUsualEq <+ UsualIsEq.

End Env.

(******************************************************
 * Machine State Definitions
 ******************************************************)
Module MachineState.

  Definition t := (RiscMachine.Memory.t * RiscMachine.pc * RiscMachine.RegisterFile.t)%type.

  Definition getMemory (st : t) : RiscMachine.Memory.t := fst (fst st).

  Definition getPC (st : t) : RiscMachine.pc := snd (fst st).

  Definition getRegs (st : t) :  RiscMachine.RegisterFile.t := snd st.

  Definition empty : t := (RiscMachine.Memory.empty, RiscMachine.PC0,
                           RiscMachine.RegisterFile.reset_all).

  Definition eq (st1 st2 : t) : Prop :=
    let '(mem1,pc1,gen_regs1) := st1 in
    let '(mem2,pc2,gen_regs2) := st2 in
    (BinNatMap.Equal mem1 mem2) /\ (pc1 = pc2) /\
    (gen_regs1 = gen_regs2).

  Definition eqb (st1 st2 : t) : bool :=
    let '(mem1,pc1,gen_regs1) := st1 in
    let '(mem2,pc2,gen_regs2) := st2 in
    (RiscMachine.Memory.eqb mem1 mem2)
    && (N.eqb pc1 pc2)
    && (RiscMachine.RegisterFile.eqb gen_regs1 gen_regs2).

End MachineState.

(******************************************************
 * Program Definitions
 ******************************************************)
Record sfi_program :=
  {
    cn : Env.CN;
    e : Env.E;
    mem : RiscMachine.Memory.t;
    prog_interface : Program.interface
  }.


Require Import Essentials.Notations.
Require Import Essentials.Types.
Require Import Essentials.Facts_Tactics.
Require Import Category.Main.
Require Import Ext_Cons.Prod_Cat.Prod_Cat Ext_Cons.Prod_Cat.Nat_Facts
        Ext_Cons.Prod_Cat.Operations.
Require Import Functor.Main.
Require Import Functor.Representable.Hom_Func
        Functor.Representable.Hom_Func_Prop.
Require Import NatTrans.Main.
Require Import Adjunction.Adjunction Adjunction.Duality.
Require Import Cat.Cat Cat.Exponential Cat.Exponential_Facts.
Require Import Yoneda.Yoneda.
Require Import Functor.Functor_Extender.

Local Open Scope functor_scope.

Section Hom_Adjunct_left_iso.
  Context {C D : Category}
          {F F' : C –≻ D}
          (N : (F' ≃ F)%natiso)
          {G : D –≻ C}
          (adj : F ⊣_hom G)
  .

  (** If F ≃ F' and (F ⊣_hom G) then (F' ⊣_hom G) *)
  Definition Hom_Adjunct_left_iso : F' ⊣_hom G :=
    (adj ∘ ((NatTrans_id_Iso (Hom_Func D))
              ∘_h (Prod_Functor_NatIso
                     (N^op) (NatTrans_id_Iso (Functor_id D))))
    )%isomorphism%natiso.

End Hom_Adjunct_left_iso.

Section Hom_Adjunct_right_iso.
  Context {C D : Category}
          {F : C –≻ D}
          {G G' : D –≻ C}
          (N : (G ≃ G')%natiso)
          (adj : F ⊣_hom G)
  .

  (** If G ≃ G' and (F ⊣_hom G) then (F ⊣_hom G') *)
  Definition Hom_Adjunct_right_iso : F ⊣_hom G' :=
    Hom_Adjunct_Duality
      (Hom_Adjunct_left_iso
         ((N^op)⁻¹)%isomorphism%natiso (Hom_Adjunct_Duality adj)).

End Hom_Adjunct_right_iso.

Section Adjunct_left_iso.
  Context {C D : Category}
          (F F' : C –≻ D)
          (N : (F' ≃ F)%natiso)
          (G : D –≻ C)
          (adj : F ⊣ G)
  .

  (** If F ≃ F' and (F ⊣ G) then (F' ⊣ G) *)
  Definition Adjunct_left_iso : F' ⊣ G :=
    Hom_Adj_to_Adj (Hom_Adjunct_left_iso N (Adj_to_Hom_Adj adj)).

End Adjunct_left_iso.

Section Adjunct_right_iso.
  Context {C D : Category}
          (F : C –≻ D)
          (G G' : D –≻ C)
          (N : (G ≃ G')%natiso)
          (adj : F ⊣ G)
  .

  (** If G ≃ G' and (F ⊣ G) then (F ⊣ G') *)
  Definition Adjunct_right_iso : F ⊣ G' :=
    Hom_Adj_to_Adj (Hom_Adjunct_right_iso N (Adj_to_Hom_Adj adj)).

End Adjunct_right_iso.

Section Hom_Adjunct_left_unique.
  Context {C D : Category}
          {F F' : C –≻ D}
          {G : D –≻ C}
          (adj : F ⊣_hom G)
          (adj' : F' ⊣_hom G)
  .

  (** If F ⊣_hom G and F' ⊣_hom G then F ≃ F' *)
  Definition Hom_Adjunct_left_unique : (F ≃ F')%natiso.
  Proof.
    apply (@Opposite_NatIso _ _ (F^op) (F'^op)).
    eapply (Embedding_mono (Yoneda_Emb (D^op))).
    eapply Isomorphism_Compose;
      [eapply Inverse_Isomorphism; apply Exp_Cat_morph_ex_compose_Iso |].
    eapply Isomorphism_Compose; [|apply Exp_Cat_morph_ex_compose_Iso].
    apply Exp_Cat_morph_ex_Iso.
    eapply Isomorphism_Compose.
    apply adj.
    eapply Inverse_Isomorphism.
    apply adj'.
  Defined.

End Hom_Adjunct_left_unique.

Section Hom_Adjunct_right_unique.
  Context {C D : Category}
          {F : C –≻ D}
          {G G' : D –≻ C}
          (adj : F ⊣_hom G)
          (adj' : F ⊣_hom G')
  .

  (** If F ⊣_hom G and F ⊣_hom G' then G ≃ G' *)
  Theorem Hom_Adjunct_right_unique : (G ≃ G')%natiso.
  Proof.
    apply Hom_Adjunct_Duality in adj.
    apply Hom_Adjunct_Duality in adj'.
    apply (@Opposite_NatIso _ _ (G^op) (G'^op)).
    apply (Hom_Adjunct_left_unique adj adj').
  Defined.

End Hom_Adjunct_right_unique.

Section Adjunct_left_unique.
  Context {C D : Category}
          {F F' : C –≻ D}
          {G : D –≻ C}
          (adj : F ⊣ G)
          (adj' : F' ⊣ G)
  .

  (** If F ⊣ G and F' ⊣ G then F ≃ F' *)
  Theorem Adjunct_left_unique : (F ≃ F' )%natiso.
  Proof.
    apply Adj_to_Hom_Adj in adj.
    apply Adj_to_Hom_Adj in adj'.
    eapply Hom_Adjunct_left_unique; eassumption.
  Defined.

End Adjunct_left_unique.

Section Adjunct_right_unique.
  Context {C D : Category}
          {F : C –≻ D}
          {G G' : D –≻ C}
          (adj : F ⊣ G)
          (adj' : F ⊣ G')
  .

  (** If F ⊣ G and F ⊣ G' then G ≃ G' *)
  Theorem Adjunct_right_unique : (G ≃ G')%natiso.
  Proof.
    apply Adj_to_Hom_Adj in adj.
    apply Adj_to_Hom_Adj in adj'.
    eapply Hom_Adjunct_right_unique; eassumption.
  Defined.

End Adjunct_right_unique.

(** If F ⊣_ucu G then
    Hom_{Func_Cat B D}(Fᵒᵖ ∘ –, –) ≃ Hom_{Func_Cat B C}(–, G ∘ —) *)
Section Hom_Adjunct_Lifted.
  Context {C D : Category}
          {F : C –≻ D}
          {G : D –≻ C}
          (adj : F ⊣_ucu G)
          (B : Category)
  .

  Local Notation NID := NatTrans_id (only parsing).
  Local Notation FCAT := Func_Cat (only parsing).

  Local Notation LEFT :=
    (
      (Hom_Func (Func_Cat B D))
        ∘ (Prod_Functor
             ((Right_Functor_Extender F B)^op)
             (Functor_id (Func_Cat B D))
          )
    )
      (only parsing).

  Local Notation RIGHT :=
    (
      (Hom_Func (Func_Cat B C))
        ∘ (Prod_Functor
             (Functor_id ((Func_Cat B C)^op)%category)
             (Right_Functor_Extender G B)
          )
    )
      (only parsing).

  Local Obligation Tactic := idtac.

  Program Definition Hom_Adjunct_Lifted_LR : (LEFT –≻ RIGHT)%nattrans :=
    {|
      Trans := fun c h =>
                 ((((NatTrans_id G) ∘_h h)
                     ∘ ((NatTrans_Functor_assoc (fst c) F G)
                          ∘ ((ucu_adj_unit adj) ∘_h (NatTrans_id (fst c)))))
                    ∘ (NatTrans_to_compose_id _))%nattrans
    |}.

  Next Obligation.
    intros [c1 c2] [c1' c2'] [h1 h2].
    extensionality w.
    apply NatTrans_eq_simplify.
    extensionality x.
    cbn in *.
    repeat rewrite F_id; simpl_ids.
    repeat rewrite F_compose.
    repeat rewrite assoc.
    cbn_rewrite (@Trans_com _ _ _ _ (ucu_adj_unit adj) _ _ (Trans h1 x)).
    trivial.
  Qed.

  Next Obligation.
    symmetry.
    apply Hom_Adjunct_Lifted_LR_obligation_1.
  Qed.

  Program Definition Hom_Adjunct_Lifted_RL : (RIGHT –≻ LEFT)%nattrans :=
    {|
      Trans := fun c h =>
                 ((NatTrans_from_compose_id _)
                    ∘ ((((ucu_adj_counit adj)
                           ∘_h (NatTrans_id (snd c)))
                          ∘ (NatTrans_Functor_assoc_sym (snd c) G F))
                         ∘ ((NatTrans_id F) ∘_h h)))%nattrans
    |}.

  Next Obligation.
    intros [c1 c2] [c1' c2'] [h1 h2].
    extensionality w.
    apply NatTrans_eq_simplify.
    extensionality x.
    cbn in *.
    repeat rewrite F_id; simpl_ids.
    repeat rewrite F_compose.
    repeat rewrite assoc_sym.
    cbn_rewrite (@Trans_com _ _ _ _ (ucu_adj_counit adj) _ _ (Trans h2 x)).
    trivial.
  Qed.

  Next Obligation.
    symmetry.
    apply Hom_Adjunct_Lifted_RL_obligation_1.
  Qed.

  Program Definition Hom_Adjunct_Lifted : (LEFT ≃ RIGHT)%natiso :=
    {|
      iso_morphism := Hom_Adjunct_Lifted_LR;
      inverse_morphism := Hom_Adjunct_Lifted_RL
    |}.

  Next Obligation.
  Proof.
    apply NatTrans_eq_simplify;
    extensionality c; extensionality h.
    destruct c as [c1 c2].
    apply NatTrans_eq_simplify; extensionality y.
    cbn in *.
    repeat rewrite F_id.
    simpl_ids.
    rewrite F_compose.
    rewrite assoc_sym.
    cbn_rewrite (Trans_com (ucu_adj_counit adj) (Trans h y)).
    rewrite assoc.
    simpl_ids; trivial.
    set (W := f_equal (fun w => Trans w (c1 _o y)) (ucu_adj_left_id adj));
      cbn in W; simpl_ids in W; apply W.
  Qed.

  Next Obligation.
  Proof.
    apply NatTrans_eq_simplify;
    extensionality c; extensionality h.
    destruct c as [c1 c2].
    apply NatTrans_eq_simplify; extensionality y.
    cbn in *.
    repeat rewrite F_id.
    simpl_ids.
    rewrite F_compose.
    rewrite assoc.
    cbn_rewrite <- (Trans_com (ucu_adj_unit adj) (Trans h y)).
    rewrite assoc_sym.
    simpl_ids; trivial.
    set (W := f_equal (fun w => Trans w (c2 _o y)) (ucu_adj_right_id adj));
      cbn in W;
      repeat rewrite F_compose in W; repeat rewrite F_id in W; simpl_ids in W;
      apply W.
  Qed.

End Hom_Adjunct_Lifted.


Require Import Category.Lib.
Require Import Category.Theory.Category.
Require Import Category.Theory.Isomorphism.
Require Import Category.Theory.Functor.
Require Import Category.Theory.Adjunction.
Require Import Category.Functor.Opposite.

Generalizable All Variables.

Program Definition Opposite_Adjunction `(F : D ⟶ C) `(U : C ⟶ D)
        (A : F ⊣ U) :
  U^op ⊣ F^op := {|
  adj := fun x y =>
    {| to          := from (@adj _ _ _ _ A y x)
     ; from        := to (@adj _ _ _ _ A y x)
     ; iso_to_from := iso_from_to (@adj _ _ _ _ A y x)
     ; iso_from_to := iso_to_from (@adj _ _ _ _ A y x) |};

  to_adj_nat_l   := fun _ _ _ f g => @from_adj_nat_r _ _ _ _ A _ _ _ g f;
  to_adj_nat_r   := fun _ _ _ f g => @from_adj_nat_l _ _ _ _ A _ _ _ g f;
  from_adj_nat_l := fun _ _ _ f g => @to_adj_nat_r  _ _ _ _ A _ _ _ g f;
  from_adj_nat_r := fun _ _ _ f g => @to_adj_nat_l  _ _ _ _ A _ _ _ g f
|}.

Notation "N ^op" := (@Opposite_Adjunction _ _ _ _ N)
  (at level 7, format "N ^op", left associativity) : adjunction_scope.

Open Scope adjunction_scope.

Corollary Opposite_Adjunction_invol `(F : D ⟶ C) `(U : C ⟶ D) (A : F ⊣ U) :
  (A^op)^op = A.
Proof. reflexivity. Qed.


(**************************************************************************
* TLC: A library for Coq                                                  *
* Heaps: finite maps from keys to values                                  *
**************************************************************************)

Set Implicit Arguments.
Require Import LibTactics LibReflect LibList LibSet.
Generalizable Variable K V.

(* FILE TO BE DEPRECATED SOON *)

(***********************************************************)
(***********************************************************)
(***********************************************************)
(* Abstract interface of a heap *)

Module Type HeapSpec.

Parameter heap : Type -> Type -> Type.

(***********************************************************)
(** Operations *)

Section HeapDef.
Variables K V : Type.

Parameter empty : heap K V.
Parameter dom : heap K V -> set K. (* LATER: should be a finite set *)
Parameter binds : heap K V -> K -> V -> Prop.
Parameter write : heap K V -> K -> V -> heap K V.
Parameter to_list : heap K V -> list (K * V).
Definition indom h r :=	(r \in dom h).

End HeapDef.

Parameter read : forall `{Comparable K} `{Inhab V}, heap K V -> K -> V.
Parameter read_option : forall `{Comparable K} V, heap K V -> K -> option V.
Parameter rem : forall `{Comparable K} V, heap K V -> K -> heap K V.

Implicit Arguments empty [[K] [V]].

(***********************************************************)
(** Properties *)

Section HeapParameters.
Context `{Comparable K} `{Inhab V}.
Implicit Types h : heap K V.

Parameter indom_equiv_binds : forall h k,
  indom h k = (exists v, binds h k v).

Parameter dom_empty :
  dom (@empty K V) = \{}.

Parameter binds_equiv_read : forall h k,
  indom h k -> (forall v, (binds h k v) = (read h k = v)).

Parameter dom_write : forall h r v,
  dom (write h r v) = dom h \u \{r}.

Parameter binds_write_eq : forall h k v,
  binds (write h k v) k v.

Parameter binds_write_neq : forall h k v k' v',
  binds h k v -> k <> k' ->
  binds (write h k' v') k v.

Parameter binds_write_inv : forall h k v k' v',
  binds (write h k' v') k v ->
  (k = k' /\ v = v') \/ (k <> k' /\ binds h k v).

Parameter binds_rem : forall h k k' v,
  binds h k v -> k <> k' -> binds (rem h k') k v.

Parameter binds_rem_inv : forall h k v k',
  binds (rem h k') k v -> k <> k' /\ binds h k v.

(* TODO: need to add the instance BagRemove to LibSet
Parameter dom_rem : forall h k,
  dom (rem h k) = (dom h) \- k.
For now, we used this derived form:
*)

Parameter not_indom_rem : forall h k,
  ~ indom (rem h k) k.

Parameter binds_equiv_read_option : forall h k v,
  (binds h k v) = (read_option h k = Some v).

Parameter not_indom_equiv_read_option : forall h k,
  (~ indom h k) = (read_option h k = None).

Parameter read_option_def : forall h k,
  read_option h k = (If indom h k then Some (read h k) else None).

End HeapParameters.

Parameter indom_decidable : forall `{Comparable K} V (h:heap K V) k,
  Decidable (indom h k).
Existing Instance indom_decidable.

End HeapSpec.

(***********************************************************)
(***********************************************************)
(***********************************************************)
(** Implementation of heaps as lists *)

Module HeapList : HeapSpec.

Definition heap K V := list (K*V).

Section HeapDefs.
(*Variables K V : Type.*)
Context `{Comparable K} `{Inhab V}.
Definition empty : heap K V := nil.
Definition dom (l : heap K V) : set K :=
  fold_right (fun p acc => acc \u \{fst p}) \{} l.
Definition binds (l : heap K V) k v :=
  Assoc k v l.
Definition to_list (l : heap K V) := l.

(* TODO: move *)
Generalizable Variable A B.
Fixpoint assoc `{Comparable A} `{Inhab B} k (l:list (A*B)) : B :=
  match l with
  | nil => arbitrary
  | (x, v) :: l' => ifb x = k then v else assoc k l'
  end.
Definition read (l : heap K V) k :=
  assoc k l.
Definition write (l : heap K V) k v :=
  (k, v) :: l.
Definition rem K `{Comparable K} V (l : heap K V) k :=
  LibList.filter (fun p => ifb (fst p) = k then false else true) l.
Definition indom h r := (r \in dom h).
Fixpoint read_option (l : heap K V) k :=
  match l with
  | nil => None
  | (x, v) :: l' => ifb x = k then Some v else read_option l' k
  end.

End HeapDefs.

Implicit Arguments empty [[K] [V]].

Section HeapParameters.
Context `{HK: Comparable K} `{IV: Inhab V}.
Implicit Types h : heap K V.
(* TODO: do the right proof using *)

Lemma indom_equiv_binds : forall h k,
  indom h k = (exists v, binds h k v).
Proof using.
Admitted. (* File will be soon deprecated *)

Lemma dom_empty :
  dom (@empty K V) = \{}.
Proof using. auto. Qed.

Lemma binds_equiv_read : forall h k,
  indom h k -> (forall v, (binds h k v) = (read h k = v)).
Proof using HK IV.
Admitted. (* File will be soon deprecated *)

Lemma dom_write : forall h r v,
  dom (write h r v) = dom h \u \{r}.
Proof. intros. unfold dom, write. rew_list. auto. Qed.

Lemma binds_write_eq : forall h k v,
  binds (write h k v) k v.
Proof. unfolds @binds, @write. intros. constructors. Qed.

Lemma binds_write_neq : forall h k v k' v',
  binds h k v -> k <> k' ->
  binds (write h k' v') k v.
Proof. unfolds @binds, @write. intros. constructors~. Qed.

Lemma binds_write_inv : forall h k v k' v',
  binds (write h k' v') k v ->
  (k = k' /\ v = v') \/ (k <> k' /\ binds h k v).
Proof. unfolds @binds, @write. introv M. inverts* M. Qed.

Lemma binds_rem : forall h k k' v,
  binds h k v -> k <> k' -> binds (rem h k') k v.
Proof using HK.
Admitted. (* File will be soon deprecated *)

Lemma binds_rem_inv : forall h k v k',
  binds (rem h k') k v -> k <> k' /\ binds h k v.
Proof using HK.
Admitted. (* File will be soon deprecated *)

(* TODO: need to add the instance BagRemove to LibSet
Lemma dom_rem : forall h k,
  dom (rem h k) = (dom h) \- k.
For now, we used this derived form:
*)

Lemma not_indom_rem : forall h k,
  ~ indom (rem h k) k.
Proof using HK.
Admitted. (* File will be soon deprecated *)

Lemma binds_equiv_read_option : forall h k v,
  (binds h k v) = (read_option h k = Some v).
Proof using. clear IV.
  unfolds @binds. introv. extens.
  induction h as [|(x&v0)].
   splits ; intro N ; invert* N.
   simpl. case_if.
     subst. splits ; intro N ; inverts* N. constructors.
     splits ; intro N.
      inverts* N.
      constructors*.
Qed.

Lemma not_indom_equiv_read_option : forall h k,
  (~ indom h k) = (read_option h k = None).
Proof using.
  introv. apply* not_cancel. rew_logic. rewrite indom_equiv_binds.
  splits ; intro N.
   lets (v & B): rm N.
    rewrite binds_equiv_read_option in B. rewrite* B. discriminate.
   asserts (v & E): (exists v, read_option h k = Some v).
     destruct* @read_option.
    rewrite* <- binds_equiv_read_option in E.
Qed.

Lemma read_option_def : forall h k,
  read_option h k = (If indom h k then Some (read h k) else None).
Proof using.
(* TODO
  introv. cases_if.
   rewrite* <- binds_equiv_read_option.
    rewrites* binds_equiv_read.
   rewrite* <- @not_indom_equiv_read_option.
*)
Admitted. (* File will be soon deprecated *)

(* TODO: move *)
Generalizable Variable A.
Fixpoint mem_assoc B `{Comparable A} k (l : list (A * B)) : bool :=
  match l with
  | nil => false
  | (x, _) :: l' => decide (x = k) || mem_assoc k l'
  end.

Definition indom_dec `{Comparable K} V (h:heap K V) (k:K) : bool :=
  mem_assoc k h.

Lemma indom_dec_spec : forall `{Comparable K} V (h:heap K V) k,
  indom_dec h k = isTrue (indom h k).
Proof.
  intros. unfold indom, dom, indom_dec.
  induction h as [|[k' v'] h]; simpl.
  rewrite in_empty_eq. rew_refl~.
  rewrite in_union_eq. rewrite in_single_eq. rewrite IHh.
   extens. rew_refl*.
Qed.

End HeapParameters.

Lemma indom_decidable : forall `{Comparable K} V (h:heap K V) k,
  Decidable (indom h k).
Proof.
  intros. applys decidable_make (indom_dec h k).
  applys indom_dec_spec.
Qed.

End HeapList.

Export HeapList.

(***********************************************************)
(** Facts *)

Global Instance heap_inhab : forall (K V : Type), Inhab (heap K V).
Proof using. introv. apply (prove_Inhab empty). Qed.

Section HeapFacts.
Context `{HK:Comparable K} `{HV:Inhab V}.
Implicit Types h : heap K V.

(** indom *)

Lemma indom_binds : forall h k,
  indom h k -> exists v, binds h k v.
Proof using. introv H. rewrite~ @indom_equiv_binds in H. Qed.

Lemma binds_indom : forall h k v,
  binds h k v -> indom h k.
Proof using. introv H. rewrite* @indom_equiv_binds. Qed.

(** binds-func *)

Lemma binds_func : forall h k v v',
  binds h k v -> binds h k v' -> v = v'.
Proof using HK HV.
  introv B1 B2. forwards: binds_indom B1. forwards: binds_indom B2.
  rewrite binds_equiv_read in B1,B2; congruence.
Qed.

(** read--binds *)

Lemma binds_read : forall h k v,
  binds h k v -> read h k = v.
Proof using. introv H. rewrite~ <- binds_equiv_read. apply* binds_indom. Qed.

Lemma read_binds : forall h k v,
  read h k = v -> indom h k -> binds h k v.
Proof using. introv H D. rewrite~ binds_equiv_read. Qed.

(** read-write *)

Lemma read_write_eq : forall h k v,
  read (write h k v) k = v.
Proof using. introv. apply binds_read. apply binds_write_eq. Qed.

Lemma read_write_neq : forall h k k' v',
  indom h k -> k <> k' -> read (write h k' v') k = read h k.
Proof using.
  introv. rewrite indom_equiv_binds. introv [v B] N.
  rewrite (binds_read B).
  forwards B': @binds_write_neq B N. rewrite~ (binds_read B').
Qed.

(** indom-write *)

Lemma indom_write_eq : forall h k v,
  indom (write h k v) k.
Proof using.
  intros. rewrite indom_equiv_binds. exists v.
  apply* @binds_write_eq.
Qed.

Lemma indom_write : forall h k k' v',
  indom h k -> indom (write h k' v') k.
Proof using.
  introv. do 2 rewrite indom_equiv_binds.
  introv [v B]. tests: (k = k').
    subst. exists v'. apply* @binds_write_eq.
    exists v. apply* @binds_write_neq.
Qed.

Lemma indom_write_inv : forall h k k' v',
  indom (write h k' v') k -> k <> k' -> indom h k.
Proof using.
  introv. do 2 rewrite indom_equiv_binds.
  introv [v B] N. lets [[? ?]|[? ?]]: @binds_write_inv B.
  false. eauto.
Qed.

(** binds-write *)

Lemma binds_write_eq_inv : forall h k v v',
  binds (write h k v') k v -> v = v'.
Proof using.
  introv B. lets [[? ?]|[? ?]]: @binds_write_inv B; auto_false.
Qed.

Lemma binds_write_neq_inv : forall h k v k' v',
  binds (write h k' v') k v -> k <> k' -> binds h k v.
Proof using.
  introv B. lets [[? ?]|[? ?]]: @binds_write_inv B; auto_false.
Qed.

(** indom-rem *)

Lemma indom_rem : forall h k k',
  indom h k -> k <> k' -> indom (rem h k') k.
Proof using.
  introv. do 2 rewrite indom_equiv_binds.
  introv [v B] N. exists v. apply* @binds_rem.
Qed.

Lemma indom_rem_inv : forall h k k',
  indom (rem h k) k' -> k <> k' /\ indom h k'.
Proof using.
  introv. do 2 rewrite indom_equiv_binds.
  introv [v B]. lets [? ?]: @binds_rem_inv B. eauto.
Qed.

(** read-rem *)

Lemma read_rem_neq : forall h k k',
  indom h k -> k <> k' -> read (rem h k') k = read h k.
Proof using HK HV.
  introv. rewrite indom_equiv_binds. introv [v B] N.
  rewrite (binds_read B).
  forwards B': @binds_rem B N. rewrite~ (binds_read B').
Qed.

(** indom-empty, binds-empty *)

Lemma not_indom_empty : forall k,
  ~ indom (@empty K V) k.
Proof using HV. introv H. unfold indom in H. rewrite dom_empty in H.
Admitted. (* File will be soon deprecated *)
  (* TODO: add an instance for in_empty_eq in LibSet.
  apply* in_empty_eq. *)

Lemma not_binds_empty : forall k v,
  ~ binds (@empty K V) k v.
Proof using HV. introv H. eapply not_indom_empty. apply* binds_indom. Qed.

(** binds--read_option **)

Lemma binds_read_option : forall h k v,
  binds h k v -> read_option h k = Some v.
Proof using. introv. rewrite* <- @binds_equiv_read_option. Qed.

Lemma read_option_binds : forall h k v,
  read_option h k = Some v -> binds h k v.
Proof using. introv R. rewrite* <- @binds_equiv_read_option in R. Qed.

(** indom--read_option **)

Lemma not_indom_read_option : forall h k,
  ~ indom h k -> read_option h k = None.
Proof using. introv. rewrite not_indom_equiv_read_option. autos*. Qed.

Lemma read_option_not_indom : forall h k,
  read_option h k = None -> ~ indom h k.
Proof using. introv. rewrite not_indom_equiv_read_option. autos*. Qed.

End HeapFacts.


(**************************************************************************
* TLC: A library for Coq                                                  *
* Axioms                                                                  *
**************************************************************************)

Set Implicit Arguments.

(** This file is used to extend Coq with standard axioms from classical,
    non-constructive higher-order logic. (Such axioms are provided by
    default in other theorem provers like Isabelle/HOL or HOL4.) *)

(** Three axioms taken are: functional extensionality, and propositional
    extensionality and indefinite description.

    All other comomn axioms are derivable, including: the excluded middle,
    the strong excluded middle, propositional degenerency, proof irrelevance,
    injectivity of equality on dependent pairs, predicate extensionality,
    definite description, and all the versions of the axiom of choice. *)

(* ********************************************************************** *)
(* ################################################################# *)
(** * Functional extensionality *)

(** Two functions that yield equal results on equal arguments are equal. *)

Axiom fun_ext_dep : forall (A : Type) (B : A->Type) (f g : forall x, B x),
  (forall x, f x = g x) ->
  f = g.

(* ********************************************************************** *)
(* ################################################################# *)
(** * Propositional extensionality *)

(** Two propositions that are equivalent can be considered to be equal. *)

Axiom prop_ext : forall (P Q : Prop),
  (P <-> Q) ->
  P = Q.

(* ********************************************************************** *)
(* ################################################################# *)
(** * Indefinite description *)

(** Proofs of existence can be reified from [Prop] to [Type]. The lemma
    below is a concise statement for [(exists x, P x) -> { x : A | P x }]. *)

Axiom indefinite_description : forall (A : Type) (P : A->Prop),
  ex P ->
  sig P.