(*
 * Module: ICText
 *
 * Description:
 *  This file provides functions and theorems about how the program counters in
 *  Interrupt Contexts relate to a configuration's text section.
 *)

(* Load Coq Standard Library modules *)
Require Import Arith.
Require Import List.
Require Import Coq.Logic.Classical_Prop.

(* Load SVAOS specific modules *)
Require Export Semantics.

(*
 * Function: ICInText
 *
 * Description:
 *  Determine whether the specified Interrupt Context is within the text
 *  section.  Note that both the Interrupt Context's current program counter
 *  and the virtual address before the program counter must be mapped into
 *  the code section.
 *)
Definition ICInText (ic : InterruptContext) (cs ce : nat) (mmu : MMU) :=
  cs <= (getPhysical (getTLB (getICPC ic) mmu)) <= ce /\
  cs <= (getPhysical (getTLB (pred (getICPC ic)) mmu)) <= ce.

(*
 * Function: ICListInText
 *
 * Description:
 *  Determine whether all Interrupt Contexts in a list are within the text
 *  section.
 *)
Fixpoint ICListInText (icl : list InterruptContext) (cs ce : nat) (mmu : MMU) :=
  match icl with
  | nil => True
  | h :: t => (ICInText h cs ce mmu) /\ (ICListInText t cs ce mmu)
  end.

(*
 * Function: ThreadICsInText
 *
 * Description:
 *  Determine whether all Interrupt Contexts in all the threads in a thread
 *  list have their program counters in the text segment.
 *)
Fixpoint ThreadICsInText (tl : ThreadList) (c : config) :=
  match tl with
  | nil => True
  | h :: t => (ICListInText (getThreadICL h) (getTextStart c) (getTextEnd c) (getCMMU c)) /\ (ThreadICsInText t c)
  end.

Fixpoint ThreadSICsInText (tl : ThreadList) (c : config) :=
  match tl with
  | nil => True
  | h :: t => (ICListInText (getThreadSICL h) (getTextStart c) (getTextEnd c) (getCMMU c)) /\ (ThreadSICsInText t c)
  end.

(*
 * Function: AreAllThreadICsInText
 *
 * Description:
 *  Determine whether all Interrupt Contexts in all the threads in a thread
 *  list have their program counters in the text segment.  This is equivalent
 *  to ThreadICsInText.
 *)
Definition AreAllThreadICsInText (tl : ThreadList) (c : config) :=
forall (t : SVAThread), (In t tl) -> (ICListInText (getThreadICL t) (getTextStart c) (getTextEnd c) (getCMMU c)).

Definition AreAllThreadICsInText2 (tl : ThreadList) (mmu : MMU) (cs ce: nat) :=
forall (t : SVAThread), (In t tl) -> (ICListInText (getThreadICL t) cs ce mmu).

Definition AreAllThreadSICsInText (tl : ThreadList) (c : config) :=
forall (t : SVAThread), (In t tl) -> (ICListInText (getThreadSICL t) (getTextStart c) (getTextEnd c) (getCMMU c)).

Definition addrNotInIC (v : nat) (ic : InterruptContext) :=
  ((getICPC ic) <> v) /\ ((pred (getICPC ic)) <> v).

Fixpoint addrNotInICL (v : nat) (icl : ICStack) :=
  match icl with
  | nil => True
  | h :: t => (addrNotInIC v h) /\ (addrNotInICL v t)
  end.

Fixpoint addrNotInTLICL (v : nat) (tl : ThreadList) :=
  match tl with
  | nil => True
  | h :: t => (addrNotInICL v (getThreadICL h)) /\ (addrNotInTLICL v t)
  end.

Definition addrInICL (v : nat) (icl : ICStack) :=
  forall (ic : InterruptContext), (In ic icl) -> not (addrNotInIC v ic).

(*
 * Function: noWritePCIC
 *
 * Description:
 *  Determine whether the program counter in the interrupt context is writeable.
 *)
Definition noWritePCIC (ic : InterruptContext) (mmu : MMU) :=
  (not (canWrite (getICPC ic) mmu)) /\
  (not (canWrite (pred (getICPC ic)) mmu)).

(*
 * Function: noWritePCICL
 *
 * Description:
 *  Determine whether all Interrupt Contexts in a list have non-writeable
 *  program counters.
 *)
Fixpoint noWritePCICL (icl : list InterruptContext) (mmu : MMU) :=
  match icl with
  | nil => True
  | h :: t => (noWritePCIC h mmu) /\ (noWritePCICL t mmu)
  end.

(*
 * Function: noWriteTLPC
 *
 * Description:
 *  Determine whether all Interrupt Contexts in all the threads in a thread
 *  list have non-writeable program counters.
 *)
Fixpoint noWriteTLPC (tl : ThreadList) (mmu : MMU) :=
  match tl with
  | nil => True
  | h :: t => (noWritePCICL (getThreadICL h) mmu) /\ (noWriteTLPC t mmu)
  end.

(*
 ******************************************************************************
 * Theorems
 ******************************************************************************
 *)

(*
 * Theorem: areAllImpliesAll
 *
 * Description:
 *  This theorem shows that ThreadICsInText implies AreAllThreadICsInText.
 *)
Theorem areAllImpliesAll: forall (tl : ThreadList) (c : config),
ThreadICsInText tl c -> AreAllThreadICsInText tl c.
Proof.
intros.
induction tl.

(* Case 1: Empty thread list *)
unfold AreAllThreadICsInText.
intros.
unfold In in H0.
contradiction.

(* Case 2: Induction step *)
unfold ThreadICsInText in H.
destruct H as [H1 H2].
fold ThreadICsInText in H2.
unfold AreAllThreadICsInText.
intros.
destruct H.

(* Case 2a: First thread *)
rewrite <- H.
auto.

(* Case 2b: The thread is not the first thread in the thread list *)
apply IHtl.
auto.
auto.
Qed.

(*
 * Theorem: areAllIffAll
 *
 * Description:
 *  This theorem shows that ThreadICsInText are AreAllThreadICsInText are
 *  equivalent.
 *)
Theorem areAllIffAll: forall (tl : ThreadList) (c : config),
ThreadICsInText tl c <-> AreAllThreadICsInText tl c.
Proof.
intros.
split.
apply areAllImpliesAll.
intros.
induction tl.

(* Case 1: Empty thread list *)
simpl.
auto.

(* Case 2: Induction step *)
unfold ThreadICsInText.
split.
unfold AreAllThreadICsInText in H.
apply H.
simpl.
auto.

fold ThreadICsInText.
apply IHtl.
unfold AreAllThreadICsInText in H.
unfold AreAllThreadICsInText.
intros.
apply H.
unfold In.
right.
apply H0.
Qed.

Theorem SICareAllImpliesAll: forall (tl : ThreadList) (c : config),
ThreadSICsInText tl c -> AreAllThreadSICsInText tl c.
Proof.
intros.
induction tl.

(* Case 1: Empty thread list *)
unfold AreAllThreadSICsInText.
intros.
unfold In in H0.
contradiction.

(* Case 2: Induction step *)
unfold ThreadSICsInText in H.
destruct H as [H1 H2].
fold ThreadSICsInText in H2.
unfold AreAllThreadSICsInText.
intros.
destruct H.

(* Case 2a: First thread *)
rewrite <- H.
auto.

(* Case 2b: The thread is not the first thread in the thread list *)
apply IHtl.
auto.
auto.
Qed.

Theorem SICareAllIffAll: forall (tl : ThreadList) (c : config),
ThreadSICsInText tl c <-> AreAllThreadSICsInText tl c.
Proof.
intros.
split.
apply SICareAllImpliesAll.
intros.
induction tl.

(* Case 1: Empty thread list *)
simpl.
auto.

(* Case 2: Induction step *)
unfold ThreadSICsInText.
split.
unfold AreAllThreadSICsInText in H.
apply H.
simpl.
auto.

fold ThreadSICsInText.
apply IHtl.
unfold AreAllThreadSICsInText in H.
unfold AreAllThreadSICsInText.
intros.
apply H.
unfold In.
right.
apply H0.
Qed.

(*
 * Theorem: ICListInTextImpliesICInText
 *
 * Description:
 *  Prove that if ICListInText holds for an entire list of interrupt contexts,
 *  then it must hold for an individual interrupt context within the list.
 *)
Theorem ICListInTextImpliesICInText:
forall (icl : list InterruptContext)
       (ic : InterruptContext)
       (cs ce : nat)
       (mmu : MMU),
(ICListInText icl cs ce mmu)
->
((In ic icl) -> (ICInText ic cs ce mmu)).
Proof.
intros.
induction icl.

(* Case 1: Base case: Empty thread list *)
unfold In in H0.
contradiction.

(* Case 2: Induction case: Non-empty thread list *)
unfold ICListInText in H.
destruct H as [H1 H2].
fold ICListInText in H2.

unfold In in H0.
destruct H0.

(* Case 2a: IC is first in list *)
rewrite <- H.
auto.

(* Case 2b: IC is in the rest of the list *)
apply IHicl.
auto.
auto.
Qed.

(*
 * Theorem: noWriteTLPCForAll
 *
 * Description:
 *  This theorem states that if noWriteTLPC holds for a longer thread list,
 *  then it also holds for the same thread list minus its first element.
 *)
Theorem noWriteTLPCForAll:
forall (mmu : MMU) (t : SVAThread) (tl : ThreadList),
(noWriteTLPC (t :: tl) mmu) -> (noWriteTLPC tl mmu).
Proof.
intros c t.
induction tl.

(* Case 1: Base case (empty list) *)
intros.
simpl.
auto.

(* Case 2: Induction case *)
unfold noWriteTLPC.
split.
apply H.
fold noWriteTLPC.
fold noWriteTLPC in H.
apply IHtl.
simpl.
split.
apply H.
apply H.
Qed.

Theorem notInPCICL : forall (c : config) (v : nat),
(ThreadICsInText (getThreadList c) c) /\
(getPhysical (getTLB v (getCMMU c)) < (getTextStart c) \/
  (getTextEnd c) < getPhysical (getTLB v (getCMMU c)))
->
addrNotInTLICL v (getThreadList c).
Proof.
intros c.
induction (getThreadList).

(* Case 1: Base case: empty thread list *)
intros.
unfold addrNotInTLICL.
auto.

(* Case 2: Induction case *)
intros.
destruct H as [H2 H1].
simpl in H1.
simpl in H2.
unfold addrNotInTLICL.
split.

(* Case 2a: Deal with the first thread in the list *)
induction getThreadICL.

(* Case 2a1: Empty Interrupt Context list *)
unfold addrNotInICL.
auto.

(* Case 1a2: Non-empty Interrupt Context list *)
unfold addrNotInICL.
split.
unfold addrNotInIC.
destruct H2 as [H2 H3].
unfold ICListInText in H2.
destruct H2 as [H2 H4].
fold ICListInText in H4.
unfold ICInText in H2.
destruct H2 as [H2 predH2].
destruct H2 as [H5 H6].
split.
contradict H1.
rewrite <- H1.
contradict H1.
destruct H1 as [H11 | H12].
apply lt_not_le in H11.
contradiction.
apply lt_not_le in H12.
contradiction.

destruct predH2 as [predH2 predH3].
contradict H1.
rewrite <- H1.
contradict H1.
destruct H1 as [H11 | H12].
apply lt_not_le in H11.
contradiction.
apply lt_not_le in H12.
contradiction.

(* Case 2b: Deal with the read of the thread list *)
fold addrNotInTLICL.
apply IHi.
split.
apply H2.
apply H2.
fold addrNotInTLICL.
apply IHt.
split.
apply H2.
auto.
Qed.

(*
 * Theorem: moreThreadICsInText
 *
 * Description:
 *  Show that having one less thread in a thread list maintains ThreadICsInText.
 *)
Theorem moreThreadICsInText:
forall (mmu: MMU)
       (ds : store)
       (Reg : tm)
       (PC SP : nat)
       (cfg : list nat)
       (cs ce : nat)
       (st : list Stack)
       (asid tid ntid : nat)
       (tl : ThreadList)
       (gvs gve : nat)
       (gl : list nat)
       (th : nat)
       (t : SVAThread),
ThreadICsInText tl
  (C mmu ds Reg PC SP cfg cs ce st asid tid ntid (t :: tl) gvs gve gl th) ->
ThreadICsInText tl
  (C mmu ds Reg PC SP cfg cs ce st asid tid ntid tl gvs gve gl th).
Proof.
intros.
induction tl.

(* Case 1: Base case: The thread list is empty *)
auto.

(* Case 2: Induction case *)
intros.
apply areAllIffAll.
apply areAllImpliesAll in H.
apply H.
Qed.

(*
 * Theorem: addThreadICsInText
 *
 * Description:
 *)
Theorem addThreadICsInText: forall (c : config) (t : SVAThread),
(ThreadICsInText (t :: (getThreadList c)) (setThreadList (t :: getThreadList c) c))
->
(ThreadICsInText (getThreadList c) c).
Proof.
intros.
unfold ThreadICsInText in H.
destruct H as [H1 H2].
fold ThreadICsInText in H2.
destruct c.
simpl in H1.
simpl in H2.
unfold ICListInText in H1.
unfold ThreadICsInText.
simpl.
fold ThreadICsInText.
apply moreThreadICsInText with (t := t).
auto.
Qed.

(*
 * Theorem: threadOnICListInText
 *
 * Description:
 *  Show that swapping a thread on to the CPU does not invalidate whether
 *  ICListInText holds on the Interrupt Context list.
 *)
Theorem threadOnICListInText:
forall (tl : ThreadList) (cs ce : nat) (mmu : MMU) (id : nat) (pc : nat),
ICListInText (getThreadICL (getThread id tl)) cs ce mmu ->
ICListInText (getThreadICL (threadOnCPU pc (getThread id tl))) cs ce mmu.
Proof.
intros.
generalize dependent id.
induction tl.

(* Case 1: Base case: empty list *)
intros.
destruct id.
auto.
auto.

(* Case 2: Induction case: non-empty list *)
intros.
destruct id.

(* Case 2a: Swapping off first element *)
unfold getThread.
simpl.
unfold getThread in H.
simpl in H.
destruct a.
simpl.
simpl in H.
auto.

(* Case 2b: Swapping off second or later element *)
unfold getThread in H.
simpl in H.
unfold getThread.
simpl.
apply IHtl.
auto.
Qed.

(*
 * Theorem: threadOffICListInText
 *
 * Description:
 *  Show that swapping a thread off of the CPU does not invalidate whether
 *  ICListInText holds on the Interrupt Context list.
 *)
Theorem threadOffICListInText:
forall (tl : ThreadList) (cs ce : nat) (mmu : MMU) (id : nat),
ICListInText (getThreadICL (getThread id tl)) cs ce mmu ->
ICListInText (getThreadICL (threadOffCPU (getThread id tl))) cs ce mmu.
Proof.
intros.
generalize dependent id.
induction tl.

(* Case 1: Base case: empty list *)
intros.
destruct id.
auto.
auto.

(* Case 2: Induction case: non-empty list *)
intros.
destruct id.

(* Case 2a: Swapping off first element *)
unfold getThread.
simpl.
unfold getThread in H.
simpl in H.
destruct a.
simpl.
simpl in H.
auto.

(* Case 2b: Swapping off second or later element *)
unfold getThread in H.
simpl in H.
unfold getThread.
simpl.
apply IHtl.
auto.
Qed.

(*
 * Theorem: threadOnSICListInText
 *
 * Description:
 *  Show that swapping a thread on to the CPU does not invalidate whether
 *  ICListInText holds on the saved Interrupt Context list.
 *)
Theorem threadOnSICListInText:
forall (tl : ThreadList) (cs ce : nat) (mmu : MMU) (id : nat) (pc : nat),
ICListInText (getThreadSICL (getThread id tl)) cs ce mmu ->
ICListInText (getThreadSICL (threadOnCPU pc (getThread id tl))) cs ce mmu.
Proof.
intros.
generalize dependent id.
induction tl.

(* Case 1: Base case: empty list *)
intros.
destruct id.
auto.
auto.

(* Case 2: Induction case: non-empty list *)
intros.
destruct id.

(* Case 2a: Swapping off first element *)
unfold getThread.
simpl.
unfold getThread in H.
simpl in H.
destruct a.
simpl.
simpl in H.
auto.

(* Case 2b: Swapping off second or later element *)
unfold getThread in H.
simpl in H.
unfold getThread.
simpl.
apply IHtl.
auto.
Qed.

(*
 * Theorem: threadOffSICListInText
 *
 * Description:
 *  Show that swapping a thread off of the CPU does not invalidate
 *  whether ICListInText holds on the saved Interrupt Context list.
 *)
Theorem threadOffSICListInText:
forall (tl : ThreadList) (cs ce : nat) (mmu : MMU) (id : nat),
ICListInText (getThreadSICL (getThread id tl)) cs ce mmu ->
ICListInText (getThreadSICL (threadOffCPU (getThread id tl))) cs ce mmu.
Proof.
intros.
generalize dependent id.
induction tl.

(* Case 1: Base case: empty list *)
intros.
destruct id.
auto.
auto.

(* Case 2: Induction case: non-empty list *)
intros.
destruct id.

(* Case 2a: Swapping off first element *)
unfold getThread.
simpl.
unfold getThread in H.
simpl in H.
destruct a.
simpl.
simpl in H.
auto.

(* Case 2b: Swapping off second or later element *)
unfold getThread in H.
simpl in H.
unfold getThread.
simpl.
apply IHtl.
auto.
Qed.

Theorem getNWTLPC: forall (c : config),
(textNotWriteable c) /\ (AreAllThreadICsInText (getThreadList c) c) ->
(noWriteTLPC (getThreadList c) (getCMMU c)).
Proof.
intros.
destruct H as [H1 H2].
destruct c.
simpl in H1.
unfold AreAllThreadICsInText in H2.
simpl in H2.
simpl.
induction t0.

(* Case 1: Base case: Empty thread list *)
unfold noWriteTLPC.
auto.

(* Case 2: Induction case: Non-empty thread list *)
unfold noWriteTLPC.
split.
assert (ICListInText (getThreadICL a) n1 n2 m).
apply H2.
unfold In.
auto.
induction (getThreadICL a).

(* Case 2a: Base case: Thread's ICL is empty *)
auto.

(* Case 2b: Induction case: Thread's ICL is not empty *)
unfold noWritePCICL.
split.
unfold noWritePCIC.
split.
apply H1.
unfold ICListInText in H.
destruct H as [H3 H].
fold ICListInText in H.
apply H3.
apply H1.
unfold ICListInText in H.
destruct H as [H3 H].
fold ICListInText in H.
apply H3.

fold noWritePCICL.
apply IHi.
unfold ICListInText in H.
destruct H as [H3 H].
fold ICListInText in H.
auto.

fold noWriteTLPC.
apply IHt0.
intros.
apply H2.
apply in_cons.
auto.
Qed.


Require Import Coq.ZArith.ZArith.
Require Import Optimizer.Machine.
Require Import Optimizer.System.
Require Import Optimizer.ProofOfConcept.CostModel.
Require Import Optimizer.ProofOfConcept.Flags.
Require Import Optimizer.ProofOfConcept.Optimality.
Require Import Optimizer.ProofOfConcept.Maps.
Require Import Optimizer.ProofOfConcept.Registers.
Require Optimizer.ProofOfConcept.Instructions.
Local Open Scope Z_scope.

Instance regt : reg_impl :=
  {|
    register := Registers.register;
    reg_mapt := Maps.RegMaps.reg_mapt;
    reg_enum := {|
                 enum := Registers.all_registers;
                 enum_complete := all_registers_complete;
               |};
    register_size := Registers.size;
    reg_eq_dec := Registers.reg_eq_dec
  |}.
Instance flagt : flag_impl :=
  {|
    flag := Flags.flag;
    flag_mapt := Maps.FlagMaps.flag_mapt;
    flag_enum := {|
                  enum := Flags.all_flags;
                  enum_complete := all_flags_complete
                |};
    flag_spec := Flags.flag_spec;
    flag_eq_dec := Flags.flag_eq_dec;
  |}.
Instance instrt : instr_impl :=
  {|
    instruction := Instructions.instruction;
    instr_enum := {|
                   enum := Instructions.all_instructions;
                   enum_complete := Instructions.all_instructions_complete;
                 |};
    flags_written := Instructions.flags_written;
    flags_read := Instructions.flags_read;
    num_source_regs := Instructions.num_source_regs;
    spec := Instructions.spec;
    precondition := Instructions.precondition (register_size:=Registers.size);
    flags_read_correct := Instructions.flags_read_correct;
    instr_eq_dec := Instructions.instr_eq_dec;
    precondition_dec := Instructions.precondition_dec;
  |}.

Notation cost := (CostModel.cost
                    (instr_cost:=Instructions.instr_cost)).
Notation optimal := (Optimality.optimal cost).
Lemma instr_cost_eq i rd args cont :
  cost (Machine.Instr i rd args cont) = (cost cont + Instructions.instr_cost i)%nat.
Proof. cbn [CostModel.cost]. omega. Qed.
Lemma ret_cost_eq r : cost (Machine.Ret r) = 0%nat.
Proof. reflexivity. Qed.
Notation optimal_limited_domain_equiv :=
  (Optimality.optimal_limited_domain_equiv
     cost
     (CostModel.cost_of_instr_pos Instructions.instr_cost_pos)
     (Enumerators.enumerate_programs_under_cost Instructions.instr_cost Instructions.instr_size)
     (Enumerators.enumerate_under_cost_with_condition Instructions.instr_cost Instructions.instr_size)
     (Enumerators.enumerate_programs_under_cost_complete_alt
        Instructions.instr_cost
        Instructions.instr_size
        cost
        Instructions.instr_cost_pos
        instr_cost_eq
        Instructions.precondition_instr_size
        Instructions.precondition_length_args)
     (Enumerators.enumerate_under_cost_with_condition_complete
        Instructions.instr_cost
        Instructions.instr_size
        cost
        Instructions.instr_cost_pos
        instr_cost_eq
        Instructions.precondition_instr_size
        Instructions.precondition_length_args)
     (Enumerators.enumerate_under_cost_with_condition_sound
        Instructions.instr_cost
        Instructions.instr_size)
     (Enumerators.enumerate_under_cost_with_condition_bound
        Instructions.instr_cost
        Instructions.instr_size
        cost
        Instructions.instr_cost_pos
        ret_cost_eq
        instr_cost_eq
     )
     (Enumerators.enumerate_under_cost_with_condition_zero
        Instructions.instr_cost
        Instructions.instr_size)
     Enumerators.enumerate_contexts
     (Enumerators.enumerate_contexts_complete Maps.reg_map_equiv)
     Maps.flag_map_equiv
     (fun m1 m2 => Maps.reg_map_dec m1 m2 Z.eq_dec)
     (fun m1 m2 => Maps.flag_map_dec m1 m2 Bool.bool_dec)
  ).


(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program is distributed in the hope that it will be useful,    *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of     *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the      *)
(* GNU General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

(** %\subsection*{ support :  seq\_equality.v }%*)
Set Implicit Arguments.
Unset Strict Implicit.
Require Export cast_seq_lengths.

(** - We cannot compare v++w and w++v using =' since they have non-convertible
 lengths (n+k $v.$ k+n) and hence are judged to stem from different setoids.
 We have two complementing ways of dealing with sequences of equal
 but non-convertible lengths: one is using casting functions (see cast_seq_lengths.v),
 the other is defining a different equality predicate for sequences: seq_equal.
 Two sequences v:(seq n A) and w:(seq k A) are seq_equal if every i:nat
 is either out of both sequences' bounds (ie. $i\geq n$ and $i\geq k$), or there
 exist proofs that we can use to turn i into a (fin n) and (fin k), so
 that "v(i)=w(i)"

 %\label{seqequal}% *)

Definition seq_equal (A : Setoid) (n m : Nat) (v : seq n A)
  (w : seq m A) :=
  forall i : Nat,
  (exists p : i < n,
     (exists q : i < m, v (Build_finiteT p) =' w (Build_finiteT q) in _)) \/
  n <= i /\ m <= i.

(** - Of course seq_equal holds for ='-equal sequences *)
Lemma Map_eq_seq_equal :
 forall (A : Setoid) (n : Nat) (v w : seq n A), v =' w in _ -> seq_equal v w.
intros.
red in |- *.
intro.
generalize (le_or_lt n i).
intro p; inversion_clear p.
right; split; auto.
left.
repeat exists H0.
simpl in H; red in H; simpl in H; apply H.
Qed.

(** - And the other way around, if v and w happen to have the same type *)

Lemma seq_equal_map_equal :
 forall (A : Setoid) (n : Nat) (v w : seq n A), seq_equal v w -> v =' w in _.
intros.
simpl in |- *.
red in |- *.
intro.
red in H.
destruct x.
rename index into i.
generalize (H i); clear H; intro.
inversion_clear H.
inversion_clear H0.
inversion_clear H.
apply Trans with (v (Build_finiteT x)).
apply Ap_comp; auto with algebra; simpl in |- *; auto.
apply Trans with (w (Build_finiteT x0)); auto with algebra.
apply Ap_comp; auto with algebra; simpl in |- *; auto.
inversion_clear H0; (apply False_ind; auto with algebra).
apply (le_not_lt n i); auto with algebra.
Qed.

Hint Resolve seq_equal_map_equal: algebra.

(* Of course it's an equivalence relation: refl, symm, trans *)
Lemma seq_equal_refl :
 forall (A : Setoid) (n : Nat) (v : seq n A), seq_equal v v.
intros.
apply Map_eq_seq_equal; auto with algebra.
Qed.

Hint Resolve seq_equal_refl: algebra.

Lemma seq_equal_symm :
 forall (A : Setoid) (n m : Nat) (v : seq n A) (w : seq m A),
 seq_equal v w -> seq_equal w v.
intros.
red in |- *; red in H; intro; generalize (H i); clear H; intro.
inversion_clear H.
left.
inversion_clear H0.
inversion_clear H.
exists x0.
exists x.
apply Sym; auto with algebra.
right.
inversion_clear H0; split; trivial.
Qed.

Hint Immediate seq_equal_symm: algebra.

Lemma seq_equal_trans :
 forall (A : Setoid) (n m l : Nat) (v : seq n A) (w : seq m A) (u : seq l A),
 seq_equal v w -> seq_equal w u -> seq_equal v u.
intros.
red in H, H0.
red in |- *; intro.
generalize (H i) (H0 i); clear H H0; intros.
inversion_clear H; inversion_clear H0.
left.
inversion_clear H1; inversion_clear H.
exists x.
inversion_clear H0; inversion_clear H1.
exists x2.
apply Trans with (w (Build_finiteT x1)); auto with algebra.
apply Trans with (w (Build_finiteT x0)); auto with algebra.
inversion_clear H1; inversion_clear H.
inversion_clear H0.
apply False_ind; auto with algebra.
generalize (lt_not_le i m); intro p; red in p.
auto.
inversion_clear H1; inversion_clear H.
apply False_ind; auto with algebra.
generalize (lt_not_le i m); intro p; red in p.
auto.
right.
inversion_clear H; inversion_clear H1; split; auto.
Qed.

Hint Resolve seq_equal_trans: algebra.

(* Finally, the interplay with casting functions: *)
Lemma cast_seq_preserves_seq_equal :
 forall (A : Setoid) (n m : Nat) (v : seq n A) (H : n =' m in _),
 seq_equal v (cast_seq v H).
red in |- *; intros.
generalize (le_or_lt n i).
intro p; inversion_clear p.
right.
split; try trivial.
rewrite <- H.
trivial.
left.
exists H0.
exists (lt_comp H0 H).
apply Trans with (cast_seq v H (cast_fin (Build_finiteT H0) H)).
apply cast_seq_cast_fin; auto with algebra.
unfold cast_fin in |- *.
auto with algebra.
Qed.

Hint Resolve cast_seq_preserves_seq_equal: algebra.