Inductive Noun : Set:=
  | VirusChecker
  | PCR.

Create HintDb eq_dec_db.
Theorem eq_dec_noun : forall n1 n2 : Noun, {n1 = n2} + {n1 <> n2}.
Proof. intros.   destruct n1, n2;
  try (left;reflexivity); right; unfold not; intros H; inversion H.
Defined.

Hint Resolve eq_dec_noun : eq_dec_db.
(*Require Import String.*)
Require Import Coq.Relations.Relation_Definitions.
Require Import Coq.Classes.EquivDec.
Inductive Adjective : Set :=
  | Name : Adjective
  | HashA : Adjective
  | Index : nat -> Adjective
  | Version : Adjective.

Ltac rec_eq :=
 match goal with
    | [ x : ?T, y : ?T |- _ ] =>
       (match T with
        | nat => generalize nat_eq_eqdec
        | bool => generalize bool_eqdec
        | unit => generalize unit_eqdec
       end) ;
       intros X; destruct X with x y as [| paul];
       try (left; inversion e; subst; reflexivity);
       try (right; unfold complement in paul; unfold not;
            intros Hpaul; apply paul; inversion Hpaul; reflexivity)
    end.

Theorem eq_dec_adjective : forall a1 a2 : Adjective,
                    {a1 = a2} + {a1 <> a2}.
Proof. decide equality; rec_eq.
Defined.
Hint Resolve eq_dec_adjective : eq_dec_db.
Require Import Coq.Program.Equality.
Inductive DescriptionR : Noun -> Adjective -> Set :=
  | pcrMR : forall n, DescriptionR PCR (Index n)
  | virusCheckerNameR : DescriptionR VirusChecker Name
  | virusCheckerVersionR : DescriptionR VirusChecker Version.

Theorem eq_dec_DescriptionR1 :
forall n : Noun,
forall a : Adjective,
forall x y : DescriptionR n a,
x = y.
Proof. intros;
induction x; dependent induction y;
( reflexivity).
Defined.

Inductive Description : Set :=
  | descriptor {n : Noun} {a : Adjective} : DescriptionR n a -> Description.

Theorem eq_dec_Description :
forall d1 d2 : Description,
{d1 = d2} + {d1 <> d2}.
Proof. intros. destruct d1, d2.
specialize eq_dec_adjective with a a0. intros. destruct H.
 specialize eq_dec_noun with n n0. intros.
destruct H. left. subst. specialize eq_dec_DescriptionR1 with n0 a0 d0 d.
intros. subst. reflexivity.
right. unfold not. intros. inversion H. contradiction.
right. unfold not. intros. inversion H. contradiction.
Defined.
Hint Resolve eq_dec_Description : eq_dec_db.
Hint Resolve eq_dec_DescriptionR1 : eq_dec_db.

Add LoadPath "/users/paulkline/Documents/coqs/dependent-crypto".
Add LoadPath "/users/paulkline/Documents/coqs/cpdt/src".
Add LoadPath "C:\Users\Paul\Documents\coqs\dependent-crypto".
Add LoadPath "C:\Users\Paul\Documents\coqs\cpdt\src".
Add LoadPath "C:\Users\Paul\Documents\coqs\protosynth".
Require Import MyShortHand.

Definition measurementDenote (d: Description) :=
match d with
 | descriptor r => match r with
    | pcrMR n => nat
    | virusCheckerNameR => nat
    | virusCheckerVersionR => bool
end

end.

Inductive Message : Set :=
| Sendable_Measurement (d: Description) : (measurementDenote d) -> Message
| RequestS : Description -> Message
| StopMessage : Message.
Theorem eq_dec_bool : forall b c : bool,
{b = c} + {b <> c}.
decide equality.
Defined.

Require Import Coq.Program.Equality.
Require Import Eqdep_dec.
Require Export Coq.Arith.EqNat.
Require Import Coq.Arith.Peano_dec.

Theorem sendable_measurment_inversion :
forall d : Description, forall n n1 : (measurementDenote d),
@Sendable_Measurement d n = @Sendable_Measurement d n1 -> n = n1.
Proof. intros.
inversion H. apply inj_pair2_eq_dec. apply eq_dec_Description. Print existT.   apply H1.
Qed.

(*
Theorem eq_dec_Message : forall x y : Message,
  { x = y} + {x <> y}. Proof. intros. *)
Theorem eq_dec_Message : forall x y : Message,
  { x = y} + {x <> y}.
Proof. intros. destruct x, y. specialize eq_dec_Description with d d0; intros.
destruct H. subst. specialize sendable_measurment_inversion with d0 m0 m.
intros.
destruct d0.
destruct n,a.
destruct d.
    simpl in m0, m;
specialize eq_nat_dec with m m0; intros;
destruct H0 as [eq |neq]; subst; ( (left; reflexivity) +
right; unfold not; intros; apply neq; apply symmetry in H0;
apply H in H0; rewrite H0; reflexivity).
simpl. cbn. simpl in H. simpl in m0. simpl in m.
destruct eq_nat_dec with m0 m. left. subst. refl.
right. unfold not; intros. symmetry in H0. apply H in H0. contradiction.

simpl in m0. simpl in m.
destruct eq_dec_bool with m0 m. left. subst. refl.
right. unfold not; intros. symmetry in H0. apply H in H0. contradiction.
subst. simpl in m.
destruct d eqn:b.
Admitted.


Require Import Bedrock.Platform.AutoSep Bedrock.Platform.Malloc.

Require Import Bedrock.Platform.Cito.WordKey.

Require Import Coq.MSets.MSetRBT.
Module WordSet := Make W_as_OT_new.

Section adt.
  Variable P : WordSet.t -> W -> HProp.
  Variable res : nat.

  Definition newS := SPEC("extra_stack") reserving res
    PRE[_] mallocHeap 0
    POST[R] P WordSet.empty R * mallocHeap 0.

  Definition deleteS := SPEC("extra_stack", "self") reserving res
    Al s,
    PRE[V] P s (V "self") * mallocHeap 0
    POST[_] mallocHeap 0.

  Definition memS := SPEC("extra_stack", "self", "n") reserving res
    Al s,
    PRE[V] P s (V "self") * mallocHeap 0
    POST[R] [| R = WordSet.mem (V "n") s |] * P s (V "self") * mallocHeap 0.

  Definition addS := SPEC("extra_stack", "self", "n") reserving res
    Al s,
    PRE[V] P s (V "self") * mallocHeap 0
    POST[_] P (WordSet.add (V "n") s) (V "self") * mallocHeap 0.

  Definition sizeS := SPEC("extra_stack", "self") reserving res
    Al s,
    PRE[V] P s (V "self") * mallocHeap 0
    POST[R] [| R = WordSet.cardinal s |] * P s (V "self") * mallocHeap 0.
End adt.


(**************************************************************************)
(*  This is part of IMP-STATES-EXCEPTIONS, it is distributed under the    *)
(*       terms  of the GNU Lesser General Public License version 3        *)
(*              (see file LICENSE for more details)                       *)
(*                                                                        *)
(*       Copyright 2015: Jean-Guillaume Dumas, Dominique Duval            *)
(*			                 Burak Ekici, Damien Pous.                        *)
(**************************************************************************)

Require Import Relations Morphisms.
Require Import Program.
Require Memory Terms Decorations Axioms Derived_co_Pairs
        Derived_co_Products Proofs Functions IMPEX_to_COQ.
Set Implicit Arguments.
Require Import ZArith.
Require Import Bool.
Open Scope Z_scope.
Require Setoid.

Module Make(Import M: Memory.T).
  Module Export IMPEX_ProofsExp := IMPEX_to_COQ.Make(M).

 Lemma lemma1: forall (b: bool) (f g: Cmd),
      (EPURE rw (dCmd f)) -> (EPURE rw (dCmd g)) ->
      {{IFB (bconst b)
          THEN (IFB (bconst b) THEN f ELSE g ENDIF)
        ELSE g
        ENDIF}}
      ===
      {{IFB (bconst b)
          THEN f
        ELSE g
        ENDIF}}.
 Proof.
      intros. case_eq b; intros; simpl.
      - rewrite !(@copair_true rw); try edecorate. easy.
      - rewrite !(@copair_false rw); try edecorate. easy.
 Qed.

 Lemma lemma2: forall (x: Loc),
	{{x ::= (aconst 2) ;;
	  WHILE ((var x) << (aconst 11))
	    DO (x ::= ((var x) +++ (aconst 4)))
	  ENDWHILE}}
	===
	{{x ::= (aconst 14)}}.
 Proof.
    intro x. simpl.
      do 3 setoid_rewrite <- assoc at 1. rewrite CLUC.
      do 4 setoid_rewrite assoc at 1.
      do 2 setoid_rewrite <- assoc at 3. rewrite imp3.
 (*first loop iteration*)
      do 2 setoid_rewrite <- assoc. setoid_rewrite assoc at 1.
    cut (
      (copair
      (lpi (pbl o (tpure chklt o pair (lookup x) (constant 11)))
      (update x o (tpure add o pair (lookup x) (constant 4)))
      o (update x o (tpure add o pair (lookup x) (constant 4)))) id o (pbl o constant true))
                          ===
      (lpi (pbl o (tpure chklt o pair (lookup x) (constant 11)))
      (update x o (tpure add o pair (lookup x) (constant 4)))
      o (update x o (tpure add o pair (lookup x) (constant 4))))
    ).
    intro H1. rewrite H1.
      do 3 setoid_rewrite <- assoc at 1. rewrite CLUC.
      do 3 setoid_rewrite assoc at 1. setoid_rewrite <- assoc at 2.
      rewrite imp1. simpl. setoid_rewrite <- assoc at 2.
      setoid_rewrite assoc. do 2 setoid_rewrite <- assoc at 1.
      rewrite IUU.
 (*second loop iteration*)
    rewrite imp_loopiter.
    do 3 setoid_rewrite <- assoc at 1. rewrite CLUC.
    do 3 setoid_rewrite assoc at 1.
      do 2 setoid_rewrite <- assoc at 2. rewrite imp3.
      rewrite H1.
      do 3 setoid_rewrite <- assoc at 1. rewrite CLUC.
      do 3 setoid_rewrite assoc at 1. setoid_rewrite <- assoc at 2.
      rewrite imp1. simpl. setoid_rewrite <- assoc at 2.
      setoid_rewrite assoc. do 2 setoid_rewrite <- assoc at 1.
      rewrite IUU.
 (*third loop iteration*)
    rewrite imp_loopiter.
    do 3 setoid_rewrite <- assoc at 1. rewrite CLUC.
    do 3 setoid_rewrite assoc at 1.
      do 2 setoid_rewrite <- assoc at 2. rewrite imp3.
      rewrite H1.
      do 3 setoid_rewrite <- assoc at 1. rewrite CLUC.
      do 3 setoid_rewrite assoc at 1. setoid_rewrite <- assoc at 2.
      rewrite imp1. simpl. setoid_rewrite <- assoc at 2.
      setoid_rewrite assoc. do 2 setoid_rewrite <- assoc at 1.
      rewrite IUU.
 (*fourth loop iteration*)
  rewrite imp_loopiter.
    do 3 setoid_rewrite <- assoc at 1. rewrite CLUC.
    do 3 setoid_rewrite assoc at 1.
      do 2 setoid_rewrite <- assoc at 2. rewrite imp2.
      rewrite !(@copair_false rw); try edecorate.
      rewrite idt. reflexivity. easy. easy. easy.
      rewrite !(@copair_true rw); try edecorate.
    easy. easy.
 Qed.

 Lemma lemma3: forall (x y: Loc), forall (e: EName), x <> y ->
       {{x ::= (aconst 1) ;;
         (y ::= (aconst 20)) ;;
         TRY(WHILE (bconst true)
               DO(IFB ((var x) <<= (aconst 0))
                    THEN (THROW e)
                  ELSE(x ::= ((var x) +++ (aconst (-1))))
                  ENDIF)
              ENDWHILE)
         CATCH e => (y ::= (aconst 7))}}
       ===
       {{x ::= (aconst 0) ;;
         (y ::= (aconst 7))}}.
 Proof.
    intros. simpl. unfold try_catch.
      apply (@swtoss _ _ rw). apply is_comp. apply is_ro_rw, is_pure_ro, is_downcast.
      edecorate. edecorate.
 (*tackling downcast*)
      transitivity( ((copair id ((update y o constant 7) o untag e) o in1)
      o (copair
        (lpi (pbl o constant true)
           (copair (throw () e)
              (update x o (tpure add o pair (lookup x) (constant (-1))))
            o (pbl o (tpure chkle o pair (lookup x) (constant 0))))
         o (copair (throw () e)
              (update x o (tpure add o pair (lookup x) (constant (-1))))
            o (pbl o (tpure chkle o pair (lookup x) (constant 0))))) id
      o (pbl o constant true)))
      o ((update y o constant 20) o (update x o constant 1))).
      apply (@pswsubs _ _ _  rw) .
        apply swsym, sw_downcast. unfold pure_id. split. edecorate. reflexivity.
    setoid_rewrite CUU; [| exact H| exact H].
      setoid_rewrite <- assoc at 1.
 (*first loop iteration*)
    rewrite (@copair_true rw); [ | unfold throw; apply is_comp; [edecorate| apply is_comp; [ apply is_copair;
      [decorate | decorate | edecorate]| edecorate ]]| decorate ].
    do 3 setoid_rewrite assoc at 3.
    setoid_rewrite assoc at 2. setoid_rewrite <- assoc at 4.
    rewrite CLUC.
    do 2 setoid_rewrite  assoc at 3. do 2 setoid_rewrite <- assoc at 6.
    rewrite imp2. setoid_rewrite <- assoc at 6.
      rewrite !(@copair_false rw); try edecorate.
    setoid_rewrite <- assoc at 4. do 3 setoid_rewrite <- assoc at 4.
    rewrite CLUC.
    do 3 setoid_rewrite assoc at 3. setoid_rewrite <- assoc at 5.
    rewrite imp1.
    simpl. setoid_rewrite <- assoc at 5. setoid_rewrite <- assoc at 4.
    rewrite IUU.
 (*second loop iteration*)
    rewrite imp_loopiter.
    rewrite (@copair_true rw); [ | unfold throw; apply is_comp; [edecorate| apply is_comp; [ apply is_copair;
      [decorate | decorate | edecorate]| edecorate ]]| decorate ].
    setoid_rewrite <- assoc at 3. do 3 setoid_rewrite assoc at 3.
    setoid_rewrite assoc at 2. setoid_rewrite <- assoc at 4.
    rewrite CLUC.
    do 2 setoid_rewrite  assoc at 3. do 2 setoid_rewrite <- assoc at 6.
    rewrite imp3. setoid_rewrite <- assoc at 6.
    rewrite (@copair_true rw); [| decorate| edecorate].
    setoid_rewrite assoc at 1. setoid_rewrite assoc at 2.
    setoid_rewrite assoc at 2.
    setoid_rewrite <- assoc at 2. setoid_rewrite <- assoc at 1.
    setoid_rewrite <- assoc at 1.
 (*an exception is thrown -> quitting the loop in the second loop iteration*)
    unfold throw. rewrite PPT.
    setoid_rewrite assoc. setoid_rewrite assoc at 2. setoid_rewrite <- assoc at 3.
    cut(in1 o (@empty unit) === in2).
      intro H1. rewrite H1.
      rewrite assoc. rewrite (@ss_lcopair_eq _ _ _ rw).
      setoid_rewrite assoc. setoid_rewrite <- assoc at 2.
      transitivity (((update y o constant 7) o id) o
      ((update x o constant 0) o (update y o constant 20))).
      repeat setoid_rewrite <- assoc. setoid_rewrite assoc. apply swrepl. reflexivity.
      setoid_rewrite assoc at 1. apply (@pswsubs _ _ _ rw).
      apply eax1. unfold pure_id.
      split. decorate. reflexivity. rewrite ids. setoid_rewrite <- assoc at 3.
      rewrite CUU. setoid_rewrite assoc at 1.
      rewrite IUU.
      rewrite CUU. reflexivity.
      exact H. auto. decorate.
      repeat apply is_comp. unfold lpi.
    (*1st cut*)
    setoid_rewrite ss_empty; [reflexivity| edecorate| edecorate].
    decorate.
    easy. decorate. easy.
 Qed.

End Make.


(* $Id: MoreFunSeries.v,v 1.16 2003/03/13 12:06:20 lcf Exp $ *)

Require Export FunctSeries.
Require Export MoreFunctions.

Section Definitions.

(* Tex_Prose
\chapter{More on Sequences and Series}

We will now extend our convergence definitions and results for sequences and series of functions defined in compact intervals to arbitrary intervals.

\begin{convention} Throughout this file, \verb!J! will be an interval, \verb!f,g! will be sequences of continuous (in \verb!J!) functions and \verb!F,G! will be continuous (in \verb!J!) functions.
\end{convention}

\section{Sequences}

First we will consider the case of sequences.

\subsection{Definitions}

Some of the definitions do not make sense in this more general setting (for instance, because the norm of a function is no longer defined), but the ones which do we simply adapt in the usual way.
*)

Variable J:interval.
Variable f:nat->PartIR.
Variable F:PartIR.

Hypothesis contf:(n:nat)(Continuous J (f n)).
Hypothesis contF:(Continuous J F).

(* Begin_Tex_Verb *)
Definition Cauchy_fun_seq_IR :=
  (a,b:IR)(Hab:a[<=]b)(Hinc:(included (Compact Hab) (iprop J)))
  (Cauchy_fun_seq a b Hab f
    [n:nat](included_imp_Continuous ?? (contf n) ??? Hinc)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition conv_fun_seq_IR :=
  (a,b:IR)(Hab:a[<=]b)(Hinc:(included (Compact Hab) (iprop J)))
  (conv_fun_seq a b Hab f
    [n:nat](included_imp_Continuous ?? (contf n) ??? Hinc)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition conv_fun_seq'_IR :=
  (a,b:IR)(Hab:a[<=]b)(Hinc:(included (Compact Hab) (iprop J)))
  (conv_fun_seq' a b Hab f F
    [n:nat](included_imp_Continuous ?? (contf n) ??? Hinc)
    (included_imp_Continuous ?? contF ??? Hinc)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition Cauchy_fun_seq2_IR :=
  (a,b:IR)(Hab:a[<=]b)(Hinc:(included (Compact Hab) (iprop J)))
  (Cauchy_fun_seq2 a b Hab f
    [n:nat](included_imp_Continuous ?? (contf n) ??? Hinc)).
(* End_Tex_Verb *)

(* Tex_Prose
The equivalences between these definitions still hold.
*)

(* Begin_Tex_Verb *)
Lemma conv_Cauchy_fun_seq'_IR :
  conv_fun_seq'_IR->Cauchy_fun_seq_IR.
(* End_Tex_Verb *)
Intro.
Red; Red in H.
Intros.
Apply conv_Cauchy_fun_seq' with F (included_imp_Continuous ?? contF ??? Hinc); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Cauchy_fun_seq_seq2_IR :
  Cauchy_fun_seq_IR->Cauchy_fun_seq2_IR.
(* End_Tex_Verb *)
Intro.
Red; Red in H.
Intros.
Apply Cauchy_fun_seq_seq2; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Cauchy_fun_seq2_seq_IR :
  Cauchy_fun_seq2_IR->Cauchy_fun_seq_IR.
(* End_Tex_Verb *)
Intro.
Red; Red in H.
Intros.
Apply Cauchy_fun_seq2_seq; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Cauchy_fun_real_IR : Cauchy_fun_seq_IR->(x,Hx:?)
  (Cauchy_prop [n:nat](pfpfun ? ? (Continuous_imp_inc ?? (contf n) x Hx))).
(* End_Tex_Verb *)
Intros.
Red in H.
Cut (included (compact_single x) (iprop J)); Intros.
LetTac contf':=[i:nat](included_imp_Continuous J (f i) (contf i) ?? (leEq_reflexive ? x) H0).
Apply Cauchy_prop_wd with
  [n:nat](Part (f n) x ([i:nat](contin_imp_inc ?? (leEq_reflexive ? x) (f i) (contf' i)) n x (compact_single_prop x))).
Apply Cauchy_fun_real.
Unfold contf'; Simpl; Apply H.
Intro; Simpl; Algebra.
Apply compact_single_iprop; Auto.
Qed.

End Definitions.

Section More_Definitions.

(* Tex_Prose
Limit is defined and works in the same way as before.
*)

Variable J:interval.
Variable f:nat->PartIR.

Hypothesis contf:(n:nat)(Continuous J (f n)).
(* Begin_Tex_Verb *)
Hypothesis conv : (Cauchy_fun_seq_IR J f contf).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Definition Cauchy_fun_seq_Lim_IR : PartIR.
(* End_Tex_Verb *)
Apply Build_PartFunct with
  pfpfun:=[x:IR][Hx:(iprop J x)](Lim (Build_CauchySeq ?? (Cauchy_fun_real_IR ??? conv x Hx))).
Apply iprop_wd.
Intros.
Elim (Lim_strext ?? H).
Intros n Hn.
Simpl in Hn.
Exact (pfstrx ?????? Hn).
Defined.

(* Begin_Tex_Verb *)
Lemma Cauchy_fun_seq_Lim_char :
  (a,b:IR)(Hab:a[<=]b)(Hinc:(included (Compact Hab) (iprop J)))
  (Feq (Compact Hab)
       Cauchy_fun_seq_Lim_IR
       (Cauchy_fun_seq_Lim ????? (conv a b Hab Hinc))).
(* End_Tex_Verb *)
Intros.
FEQ.
Simpl.
Apply Lim_wd'; Intros; Simpl; Algebra.
Qed.

End More_Definitions.

Section Irrelevance_of_Proofs.

(* Tex_Prose
\subsection{Basic Properties}

Proofs are irrelevant as before---they just have to be present.
*)

Variable J:interval.
Variable f:nat->PartIR.
(* Begin_Tex_Verb *)
Hypothesis contf,contf0:(n:nat)(Continuous J (f n)).
(* End_Tex_Verb *)

Variable F:PartIR.
(* Begin_Tex_Verb *)
Hypothesis contF,contF0:(Continuous J F).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma conv_fun_seq'_wd_IR : (conv_fun_seq'_IR ??? contf contF)->
  (conv_fun_seq'_IR ??? contf0 contF0).
(* End_Tex_Verb *)
Intro.
Red; Intros.
EApply conv_fun_seq'_wd.
Apply (H a b Hab Hinc).
Qed.

(* Begin_Tex_Verb *)
Lemma Cauchy_fun_seq2_wd_IR : (Cauchy_fun_seq2_IR ?? contf)->
  (Cauchy_fun_seq2_IR ?? contf0).
(* End_Tex_Verb *)
Intro.
Red; Intros.
EApply Cauchy_fun_seq2_wd.
Apply (H a b Hab Hinc).
Qed.

(* Begin_Tex_Verb *)
Lemma conv_fun_seq_wd_IR : (conv_fun_seq_IR ?? contf)->
  (conv_fun_seq_IR ?? contf0).
(* End_Tex_Verb *)
Intro.
Red; Intros.
EApply conv_fun_seq_wd.
Apply (H a b Hab Hinc).
Qed.

End Irrelevance_of_Proofs.

Opaque Cauchy_fun_seq_Lim_IR.

Section More_Properties.

Variable J:interval.
Variables f,g:nat->PartIR.

(* Begin_Tex_Verb *)
Hypothesis contf,contf0:(n:nat)(Continuous J (f n)).
Hypothesis contg,contg0:(n:nat)(Continuous J (g n)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma Cauchy_conv_fun_seq'_IR :
  (H:(Cauchy_fun_seq_IR ?? contf))
  (contf':(Continuous J (Cauchy_fun_seq_Lim_IR ??? H)))
    (conv_fun_seq'_IR ??? contf contf').
(* End_Tex_Verb *)
Intros.
Red; Intros.
EApply conv_fun_seq'_wdr.
Apply Feq_symmetric.
Apply (Cauchy_fun_seq_Lim_char J f contf H a b Hab Hinc).
Apply Cauchy_conv_fun_seq' with H:=(H a b Hab Hinc) contf':=(Cauchy_cont_Lim ????? (H a b Hab Hinc)).
Qed.

Variables F,G:PartIR.
(* Begin_Tex_Verb *)
Hypothesis contF,contF0:(Continuous J F).
Hypothesis contG,contG0:(Continuous J G).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma conv_fun_seq'_wdl_IR :
  ((n:nat)(Feq (iprop J) (f n) (g n)))->
  (conv_fun_seq'_IR ??? contf contF)->
  (conv_fun_seq'_IR ??? contg contF0).
(* End_Tex_Verb *)
Intros.
Red; Intros.
EApply conv_fun_seq'_wdl with f:=f.
2: Apply (H0 a b Hab Hinc).
Intro; Elim (H n); Intros.
Inversion_clear a0.
Apply eq_imp_Feq; Included.
Qed.

(* Begin_Tex_Verb *)
Lemma conv_fun_seq'_wdr_IR : (Feq (iprop J) F G)->
  (conv_fun_seq'_IR ??? contf contF)->
  (conv_fun_seq'_IR ??? contf0 contG).
(* End_Tex_Verb *)
Intros.
Red; Intros.
EApply conv_fun_seq'_wdr with F:=F.
2: Apply (H0 a b Hab Hinc).
Apply included_Feq with (iprop J); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma conv_fun_seq'_wdl'_IR :
  ((n:nat)(Feq (iprop J) (f n) (g n)))->
  (conv_fun_seq'_IR ??? contf contF)->
  (conv_fun_seq'_IR ??? contg contF).
(* End_Tex_Verb *)
Intros.
Red; Intros.
EApply conv_fun_seq'_wdl' with f:=f; Auto.
Intro; Elim (H n); Intros.
Inversion_clear a0.
Apply eq_imp_Feq; Included.
Qed.

(* Begin_Tex_Verb *)
Lemma conv_fun_seq'_wdr'_IR : (Feq (iprop J) F G)->
  (conv_fun_seq'_IR ??? contf contF)->
  (conv_fun_seq'_IR ??? contf contG).
(* End_Tex_Verb *)
Intros.
Red; Intros.
EApply conv_fun_seq'_wdr' with F:=F.
2: Apply (H0 a b Hab Hinc).
Apply included_Feq with (iprop J); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Cauchy_cont_Lim_IR : (H:(Cauchy_fun_seq_IR ?? contf))
  (Continuous J (Cauchy_fun_seq_Lim_IR ?? contf H)).
(* End_Tex_Verb *)
Intros.
Split; Included.
Intros; EApply Continuous_I_wd.
Apply Feq_symmetric.
Apply (Cauchy_fun_seq_Lim_char J f contf H a b Hab H0).
Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma Cauchy_conv_fun_seq_IR :
  (Cauchy_fun_seq_IR ?? contf)->(conv_fun_seq_IR ?? contf).
(* End_Tex_Verb *)
Intro.
Red; Intros.
EApply Cauchy_conv_fun_seq.
Apply (H a b Hab Hinc).
Qed.

(* Begin_Tex_Verb *)
Lemma conv_Cauchy_fun_seq_IR :
  (conv_fun_seq_IR ?? contf)->(Cauchy_fun_seq_IR ?? contf).
(* End_Tex_Verb *)
Intro.
Red; Intros.
EApply conv_Cauchy_fun_seq.
Apply (H a b Hab Hinc).
Qed.

End More_Properties.

Hints Resolve Cauchy_cont_Lim_IR : continuous.

Section Algebraic_Properties.

(* Tex_Prose
\subsection{Algebraic Properties}

Algebraic operations still work well.
*)

Variable J:interval.
Variables f,g:nat->PartIR.

Hypothesis contf:(n:nat)(Continuous J (f n)).
Hypothesis contg:(n:nat)(Continuous J (g n)).

(* Begin_Tex_Verb *)
Lemma FLim_unique_IR : (F,G,HF,HG:?)
  (conv_fun_seq'_IR J f F contf HF)->
  (conv_fun_seq'_IR J f G contf HG)->(Feq (iprop J) F G).
(* End_Tex_Verb *)
Intros.
Apply included_Feq'.
Intros.
Apply FLim_unique with f [n:nat](included_imp_Continuous ?? (contf n) ??? H1)
  (included_imp_Continuous ?? HF ??? H1) (included_imp_Continuous ?? HG ??? H1); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Cauchy_fun_seq_wd_IR :
  ((n:nat)(Feq (iprop J) (f n) (g n)))->
  (Cauchy_fun_seq_IR ?? contf)->(Cauchy_fun_seq_IR ?? contg).
(* End_Tex_Verb *)
Intros.
Red; Intros.
EApply Cauchy_fun_seq_wd with f:=f.
2: Apply (H0 a b Hab Hinc).
Intro; Apply included_Feq with (iprop J); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma fun_Lim_seq_const_IR : (H:PartIR)(contH,contH':?)
  (conv_fun_seq'_IR J [n:nat]H H contH contH').
(* End_Tex_Verb *)
Exists O; Intros.
EApply leEq_wdl.
2: EApply eq_transitive_unfolded.
2: Apply eq_symmetric_unfolded; Apply AbsIRz_isz.
Apply less_leEq; Assumption.
Apply AbsIR_wd; Rational.
Qed.

(* Begin_Tex_Verb *)
Lemma fun_Cauchy_prop_const_IR : (H:PartIR)(contH:?)
  (Cauchy_fun_seq_IR J [n:nat]H contH).
(* End_Tex_Verb *)
Intros.
Apply conv_Cauchy_fun_seq'_IR with H (contH O).
Apply fun_Lim_seq_const_IR.
Qed.

Variables F,G:PartIR.
Hypothesis contF:(Continuous J F).
Hypothesis contG:(Continuous J G).

(* Begin_Tex_Verb *)
Hypothesis convF:(conv_fun_seq'_IR ??? contf contF).
Hypothesis convG:(conv_fun_seq'_IR ??? contg contG).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma fun_Lim_seq_plus'_IR : (H,H':?)
  (conv_fun_seq'_IR J [n:nat](f n){+}(g n) F{+}G H H').
(* End_Tex_Verb *)
Intros.
Red; Intros.
EApply fun_Lim_seq_plus'.
Apply (convF a b Hab Hinc).
Apply (convG a b Hab Hinc).
Qed.

(* Begin_Tex_Verb *)
Lemma fun_Lim_seq_minus'_IR : (H,H':?)
  (conv_fun_seq'_IR J [n:nat](f n){-}(g n) F{-}G H H').
(* End_Tex_Verb *)
Intros.
Red; Intros.
EApply fun_Lim_seq_minus'.
Apply (convF a b Hab Hinc).
Apply (convG a b Hab Hinc).
Qed.

(* Begin_Tex_Verb *)
Lemma fun_Lim_seq_mult'_IR : (H,H':?)
  (conv_fun_seq'_IR J [n:nat](f n){*}(g n) F{*}G H H').
(* End_Tex_Verb *)
Intros.
Red; Intros.
EApply fun_Lim_seq_mult'.
Apply (convF a b Hab Hinc).
Apply (convG a b Hab Hinc).
Qed.

End Algebraic_Properties.

Section More_Algebraic_Properties.

(* Tex_Prose
If we work with the Limit function things fit in just as well.
*)

Variable J:interval.
Variables f,g:nat->PartIR.

Hypothesis contf:(n:nat)(Continuous J (f n)).
Hypothesis contg:(n:nat)(Continuous J (g n)).

(* Begin_Tex_Verb *)
Hypothesis Hf:(Cauchy_fun_seq_IR ?? contf).
Hypothesis Hg:(Cauchy_fun_seq_IR ?? contg).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma fun_Lim_seq_plus_IR : (H,H':?)
  (conv_fun_seq'_IR J [n:nat](f n){+}(g n)
    (Cauchy_fun_seq_Lim_IR ??? Hf){+}
      (Cauchy_fun_seq_Lim_IR ??? Hg) H H').
(* End_Tex_Verb *)
Intros.
Red; Intros.
Cut (Continuous_I Hab (Cauchy_fun_seq_Lim ????? (Hf a b Hab Hinc))); [Intro | Contin].
Cut (Continuous_I Hab (Cauchy_fun_seq_Lim ????? (Hg a b Hab Hinc))); [Intro | Contin].
EApply conv_fun_seq'_wdr with
  contF:=(Continuous_I_plus ????? H0 H1).
Apply Feq_symmetric; Apply Feq_plus; Apply Cauchy_fun_seq_Lim_char.
Apply fun_Lim_seq_plus with Hf:=(Hf a b Hab Hinc) Hg:=(Hg a b Hab Hinc) H:=[n:nat](included_imp_Continuous ?? (H n) ??? Hinc).
Qed.

(* Begin_Tex_Verb *)
Lemma fun_Cauchy_prop_plus :
  (H:?)(Cauchy_fun_seq_IR J [n:nat](f n){+}(g n) H).
(* End_Tex_Verb *)
Intro.
Cut (Continuous J (Cauchy_fun_seq_Lim_IR ??? Hf){+}(Cauchy_fun_seq_Lim_IR ??? Hg)); [Intro | Contin].
Apply conv_Cauchy_fun_seq'_IR with (Cauchy_fun_seq_Lim_IR ??? Hf){+}(Cauchy_fun_seq_Lim_IR ??? Hg) H0.
Apply fun_Lim_seq_plus_IR.
Qed.

(* Begin_Tex_Verb *)
Lemma fun_Lim_seq_inv_IR : (H,H':?)
  (conv_fun_seq'_IR J [n:nat]{--}(f n)
    {--}(Cauchy_fun_seq_Lim_IR ??? Hf) H H').
(* End_Tex_Verb *)
Intros.
Red; Intros.
Cut (Continuous_I Hab (Cauchy_fun_seq_Lim ????? (Hf a b Hab Hinc))); [Intro | Contin].
Intros.
EApply conv_fun_seq'_wdr with contF:=(Continuous_I_inv ???? H0).
Apply Feq_symmetric; Apply Feq_inv; Apply Cauchy_fun_seq_Lim_char.
Apply fun_Lim_seq_inv with Hf:=(Hf a b Hab Hinc) H:=[n:nat](included_imp_Continuous ?? (H n) ??? Hinc).
Qed.

(* Begin_Tex_Verb *)
Lemma fun_Cauchy_prop_inv :
  (H:?)(Cauchy_fun_seq_IR J [n:nat]{--}(f n) H).
(* End_Tex_Verb *)
Intro.
Cut (Continuous J ({--}(Cauchy_fun_seq_Lim_IR ??? Hf))); [Intro | Contin].
Apply conv_Cauchy_fun_seq'_IR with ({--}(Cauchy_fun_seq_Lim_IR ??? Hf)) H0.
Apply fun_Lim_seq_inv_IR.
Qed.

(* Begin_Tex_Verb *)
Lemma fun_Lim_seq_minus_IR : (H,H':?)
  (conv_fun_seq'_IR J [n:nat](f n){-}(g n)
    (Cauchy_fun_seq_Lim_IR ??? Hf){-}
      (Cauchy_fun_seq_Lim_IR ??? Hg) H H').
(* End_Tex_Verb *)
Intros.
Red; Intros.
Cut (Continuous_I Hab (Cauchy_fun_seq_Lim ????? (Hf a b Hab Hinc))); [Intro | Contin].
Cut (Continuous_I Hab (Cauchy_fun_seq_Lim ????? (Hg a b Hab Hinc))); [Intro | Contin].
Intros.
EApply conv_fun_seq'_wdr with
  contF:=(Continuous_I_minus ????? H0 H1).
Apply Feq_symmetric; Apply Feq_minus; Apply Cauchy_fun_seq_Lim_char.
Apply fun_Lim_seq_minus with Hf:=(Hf a b Hab Hinc) Hg:=(Hg a b Hab Hinc) H:=[n:nat](included_imp_Continuous ?? (H n) ??? Hinc).
Qed.

(* Begin_Tex_Verb *)
Lemma fun_Cauchy_prop_minus :
  (H:?)(Cauchy_fun_seq_IR J [n:nat](f n){-}(g n) H).
(* End_Tex_Verb *)
Intro.
Cut (Continuous J (Cauchy_fun_seq_Lim_IR ??? Hf){-}(Cauchy_fun_seq_Lim_IR ??? Hg)); [Intro | Contin].
Apply conv_Cauchy_fun_seq'_IR with (Cauchy_fun_seq_Lim_IR ??? Hf){-}(Cauchy_fun_seq_Lim_IR ??? Hg) H0.
Apply fun_Lim_seq_minus_IR.
Qed.

(* Begin_Tex_Verb *)
Lemma fun_Lim_seq_mult_IR : (H,H':?)
  (conv_fun_seq'_IR J [n:nat](f n){*}(g n)
    (Cauchy_fun_seq_Lim_IR ??? Hf){*}
      (Cauchy_fun_seq_Lim_IR ??? Hg) H H').
(* End_Tex_Verb *)
Intros.
Red; Intros.
Cut (Continuous_I Hab (Cauchy_fun_seq_Lim ????? (Hf a b Hab Hinc))); [Intro | Contin].
Cut (Continuous_I Hab (Cauchy_fun_seq_Lim ????? (Hg a b Hab Hinc))); [Intro | Contin].
Intros.
EApply conv_fun_seq'_wdr with
  contF:=(Continuous_I_mult ????? H0 H1).
Apply Feq_symmetric; Apply Feq_mult; Apply Cauchy_fun_seq_Lim_char.
Apply fun_Lim_seq_mult with Hf:=(Hf a b Hab Hinc) Hg:=(Hg a b Hab Hinc) H:=[n:nat](included_imp_Continuous ?? (H n) ??? Hinc).
Qed.

(* Begin_Tex_Verb *)
Lemma fun_Cauchy_prop_mult :
  (H:?)(Cauchy_fun_seq_IR J [n:nat](f n){*}(g n) H).
(* End_Tex_Verb *)
Intro.
Cut (Continuous J (Cauchy_fun_seq_Lim_IR ??? Hf){*}(Cauchy_fun_seq_Lim_IR ??? Hg)); [Intro | Contin].
Apply conv_Cauchy_fun_seq'_IR with (Cauchy_fun_seq_Lim_IR ??? Hf){*}(Cauchy_fun_seq_Lim_IR ??? Hg) H0.
Apply fun_Lim_seq_mult_IR.
Qed.

End More_Algebraic_Properties.

Section Other.

(* Tex_Prose
\subsection{Miscellaneous}

Finally, we define a mapping between sequences of real numbers and sequences of (constant) functions and prove that convergence is preserved.
*)

(* Begin_Tex_Verb *)
Definition seq_to_funseq [x:nat->IR] : nat->PartIR :=
  [n:nat]{-C-}(x n).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma funseq_conv : (J,x,y:?)(nonvoid J)->
  (conv_fun_seq'_IR J (seq_to_funseq x) {-C-}y
    [n:nat](Continuous_const ??) (Continuous_const ??))->
  (Cauchy_Lim_prop2 x y).
(* End_Tex_Verb *)
Intros.
Red; Intros.
Elim (nonvoid_point J H); Intros x0 Hx0.
Cut (included (compact_single x0) (iprop J)).
2: Apply compact_single_iprop; Auto.
Intro.
Elim (H0 ?? (leEq_reflexive ??) H2 eps).
Intros N HN.
Exists N; Intros.
Simpl in HN.
Apply AbsIR_imp_AbsSmall.
Apply HN with x0.
Auto.
Fold (compact_single x0).
Apply compact_single_prop.
Auto.
Qed.

(* Tex_Prose
Another interesting fact: if a sequence of constant functions converges then it must converge to a constant function.
*)

(* Begin_Tex_Verb *)
Lemma fun_const_Lim : (J,f,F,contf,contF:?)(proper J)->
  (conv_fun_seq'_IR J f F contf contF)->
  ((n:nat){c:IR & (Feq (iprop J) (f n) {-C-}c)})->
  {c:IR & (Feq (iprop J) F {-C-}c)}.
(* End_Tex_Verb *)
Intros J f F contf contF pJ; Intros.
LetTac incF:=(Continuous_imp_inc ?? contF).
LetTac incf:=[n:nat](Continuous_imp_inc ?? (contf n)).
Elim (nonvoid_point ? (proper_nonvoid ? pJ)); Intros x0 Hx0.
Exists (Part F x0 (incF x0 Hx0)).
FEQ.
Simpl.
Apply cg_inv_unique_2; Apply AbsIR_approach_zero.
Intros.
Cut (included (Compact (Min_leEq_Max x x0)) (iprop J)).
2: Apply included_interval; Auto.
Intro Hinc.
Elim (H ??? Hinc ? (pos_div_two ?? H2)); Intros N HN.
LetTac Fx:=(pfpfun ? ? Hx).
LetTac Fa:=(pfpfun ? ? (incF x0 Hx0)).
LetTac fx:=(pfpfun ? ? (incf N x H1)).
LetTac fa:=(pfpfun ? ? (incf N x0 Hx0)).
Apply leEq_wdl with (AbsIR (Fx[-]fx)[+](fx[-]fa)[+](fa[-]Fa)).
2: Apply AbsIR_wd; Rational.
RStepr e[/]TwoNZ[+]Zero[+]e[/]TwoNZ.
EApply leEq_transitive.
Apply triangle_IR.
Apply plus_resp_leEq_both.
EApply leEq_transitive.
Apply triangle_IR.
Apply plus_resp_leEq_both.
EApply leEq_wdl.
2: Apply AbsIR_minus.
EApply leEq_wdl.
Apply (HN N (le_n N) x (compact_Min_lft ???)).
Unfold Fx fx; Apply AbsIR_wd; Rational.
Elim (H0 N); Intros c Hc.
Apply eq_imp_leEq.
EApply eq_transitive_unfolded.
2: Apply AbsIRz_isz.
Inversion_clear Hc.
Inversion_clear H3.
Apply AbsIR_wd; Unfold fx fa; Stepr c[-]c.
Apply cg_minus_wd; Simpl in H4; Apply H4; Auto.
EApply leEq_wdl.
Apply (HN N (le_n N) x0 (compact_Min_rht ???)).
Unfold Fa fa; Apply AbsIR_wd; Rational.
Qed.

End Other.

Section Series_Definitions.

(* Tex_Prose
\section{Series}

We now consider series of functions defined in arbitrary intervals.

\subsection{Definitions}

Convergence is defined as expected---through convergence in every compact interval.
*)

Variable J:interval.
Variable f:nat->PartIR.

(* Begin_Tex_Verb *)
Definition fun_series_convergent_IR :=
  (a,b:IR)(Hab:a[<=]b)(Hinc:(included (Compact Hab) (iprop J)))
  (fun_series_convergent a b Hab f).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma fun_series_conv_imp_conv_IR :
  fun_series_convergent_IR->(x:IR)(iprop J x)->(Hx:?)
   (convergent [n:nat]((f n) x (Hx n))).
(* End_Tex_Verb *)
Intros.
Apply fun_series_conv_imp_conv with Hab:=(leEq_reflexive ? x).
Apply H.
Fold (compact_single x); Apply compact_single_iprop; Auto.
Apply compact_single_prop.
Qed.

(* Begin_Tex_Verb *)
Hypothesis H:fun_series_convergent_IR.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma fun_series_inc_IR :
  (x:IR)(iprop J x)->(n:nat)(Pred (f n) x).
(* End_Tex_Verb *)
Intros.
Elim (H ?? (leEq_reflexive ? x) (compact_single_iprop J x H0)).
Intros contF CauchyF.
Apply (contin_imp_inc ???? (contF n)).
Apply compact_single_prop.
Qed.

(* Begin_Tex_Verb *)
Local h:=[x:IR][Hx:(iprop J x)](series_sum ?
  (fun_series_conv_imp_conv ????
    (H ?? (leEq_reflexive ? x) (compact_single_iprop J x Hx))
     x (compact_single_prop x) (fun_series_inc_IR x Hx))).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_strext_IR : (x,y,Hx,Hy:?)
  (((h x Hx)[#](h y Hy))->(x[#]y)).
(* End_Tex_Verb *)
Unfold h; Clear h; Intros.
Unfold series_sum in H0.
Elim (Lim_strext ?? H0); Intros N HN.
Simpl in HN; Unfold seq_part_sum in HN.
Elim (Sum0_strext ???? HN); Intros.
Exact (pfstrx ?????? q).
Qed.

(* Begin_Tex_Verb *)
Definition FSeries_Sum : PartIR.
(* End_Tex_Verb *)
Apply Build_PartFunct with pfpfun:=h.
Apply iprop_wd.
Exact FSeries_Sum_strext_IR.
Defined.

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_char :
  (a,b:IR)(Hab:a[<=]b)(Hinc:(included (Compact Hab) (iprop J)))
  (Feq (Compact Hab) FSeries_Sum
                     (Fun_Series_Sum (H a b Hab Hinc))).
(* End_Tex_Verb *)
Intros; FEQ.
Simpl; Included.
Simpl; Unfold h.
Apply series_sum_wd; Intros; Algebra.
Qed.

End Series_Definitions.

Implicits FSeries_Sum [1 2].

Section More_Series_Definitions.

Variable J:interval.
Variable f:nat->PartIR.

(* Tex_Prose
Absolute convergence still exists.
*)

(* Begin_Tex_Verb *)
Definition fun_series_abs_convergent_IR :=
  (fun_series_convergent_IR J [n:nat](FAbs (f n))).
(* End_Tex_Verb *)

End More_Series_Definitions.

Section Convergence_Results.

(* Tex_Prose
As before, any series converges to its Sum.
*)

Variable J:interval.
Variable f:nat->PartIR.

(* Begin_Tex_Verb *)
Lemma FSeries_conv : (convF,H,H':?)
  (conv_fun_seq'_IR J [n:nat](FSum0 n f)
    (!FSeries_Sum J f convF) H H').
(* End_Tex_Verb *)
Intros.
Red; Intros.
Elim (convF ??? Hinc); Intros Hcont Hconv.
Apply conv_fun_seq'_wdr with
  f:=[n:nat](FSum0 n f)
  contf:=[n:nat](included_imp_Continuous ?? (H n) ??? Hinc)
  contF:=(Fun_Series_Sum_cont ???? (convF ??? Hinc)).
Apply Feq_symmetric; Apply FSeries_Sum_char.
Apply conv_fun_seq'_wdl with
  f:=(fun_seq_part_sum f)
  contf:=[n:nat](included_imp_Continuous ?? (H n) ??? Hinc)
  contF:=(Fun_Series_Sum_cont ???? (convF ??? Hinc)).
Intro; Apply Feq_reflexive.
Red; Intros.
Simpl; Intros.
Apply (contin_imp_inc ???? (Hcont n0)); Auto.
Apply fun_series_conv.
Qed.

(* Begin_Tex_Verb *)
Lemma convergent_imp_inc : (fun_series_convergent_IR J f)->
  (n:nat)(included (iprop J) (Pred (f n))).
(* End_Tex_Verb *)
Intros.
Apply included_imp_inc.
Intros.
Red in H.
Elim (H ??? H0); Intros.
Apply contin_imp_inc; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma convergent_imp_Continuous :
  (fun_series_convergent_IR J f)->(n:nat)(Continuous J (f n)).
(* End_Tex_Verb *)
Intros.
Split.
Exact (convergent_imp_inc H n).
Intros; Auto.
Elim (H a b Hab H0); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_FSeries_Sum :
  (H:?)(Continuous J (!FSeries_Sum J f H)).
(* End_Tex_Verb *)
Intros.
Split; Included.
Intros.
EApply Continuous_I_wd.
Apply Feq_symmetric; Apply (FSeries_Sum_char ?? H ??? H0).
EApply Continuous_I_wd.
Apply Fun_Series_Sum_char.
Apply Cauchy_cont_Lim.
Qed.

End Convergence_Results.

Hints Resolve convergent_imp_inc : included.
Hints Resolve convergent_imp_Continuous Continuous_FSeries_Sum : continuous.

Section Operations.

(* Tex_Prose
\subsection{Algebraic Operations}

Convergence is well defined and preserved by operations.
*)

Variable J:interval.

(* Begin_Tex_Verb *)
Lemma conv_fun_const_series_IR : (x:nat->IR)(convergent x)->
  (fun_series_convergent_IR J [n:nat]{-C-}(x n)).
(* End_Tex_Verb *)
Intros.
Red; Intros.
Apply conv_fun_const_series; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma fun_const_series_Sum_IR : (y:nat->IR)(H:(convergent y))
  (H':(fun_series_convergent_IR J [n:nat]{-C-}(y n)))
  (x,Hx:?)((FSeries_Sum H') x Hx)[=](series_sum ? H).
(* End_Tex_Verb *)
Intros.
Simpl.
Apply series_sum_wd.
Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma conv_zero_fun_series_IR :
  (fun_series_convergent_IR J [n:nat]{-C-}Zero).
(* End_Tex_Verb *)
Apply conv_fun_const_series_IR with x:=[n:nat](Zero::IR).
Apply conv_zero_series.
Qed.

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_zero_IR :
  (H:(fun_series_convergent_IR J [n:nat]{-C-}Zero))
  (x:IR)(Hx:?)((FSeries_Sum H) x Hx)[=]Zero.
(* End_Tex_Verb *)
Intros.
Simpl.
Apply series_sum_zero.
Qed.

Variables f,g:nat->PartIR.

(* Begin_Tex_Verb *)
Lemma fun_series_convergent_wd_IR :
  ((n:nat)(Feq (iprop J) (f n) (g n)))->
  (fun_series_convergent_IR J f)->(fun_series_convergent_IR J g).
(* End_Tex_Verb *)
Intros.
Red; Intros.
Apply fun_series_convergent_wd with f.
Intros; Apply included_Feq with (iprop J); Auto.
Auto.
Qed.

(* Begin_Tex_Verb *)
Hypothesis convF : (fun_series_convergent_IR J f).
Hypothesis convG : (fun_series_convergent_IR J g).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_wd' :
  ((n:nat)(Feq (iprop J) (f n) (g n)))->
  (Feq (iprop J) (FSeries_Sum convF) (FSeries_Sum convG)).
(* End_Tex_Verb *)
Intros.
Apply included_Feq'; Intros.
EApply Feq_transitive.
Apply (FSeries_Sum_char ?? convF a b Hab H0).
EApply Feq_transitive.
2: Apply Feq_symmetric; Apply (FSeries_Sum_char ?? convG a b Hab H0).
Apply Fun_Series_Sum_wd'.
Intro; Apply included_Feq with (iprop J); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_plus_conv :
  (fun_series_convergent_IR J [n:nat](f n){+}(g n)).
(* End_Tex_Verb *)
Red; Intros.
Apply conv_fun_series_plus; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_plus :
  (H:(fun_series_convergent_IR J [n:nat](f n){+}(g n)))
  (Feq (iprop J) (FSeries_Sum H)
                 (FSeries_Sum convF){+}(FSeries_Sum convG)).
(* End_Tex_Verb *)
Intros.
Apply included_Feq'; Intros.
EApply Feq_transitive.
Apply (FSeries_Sum_char ?? H a b Hab H0).
EApply Feq_transitive.
Apply Fun_Series_Sum_plus with convF:=(convF a b Hab H0) convG:=(convG a b Hab H0).
Apply Feq_symmetric; Apply Feq_plus; Apply FSeries_Sum_char.
Qed.

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_inv_conv :
  (fun_series_convergent_IR J [n:nat]{--}(f n)).
(* End_Tex_Verb *)
Red; Intros.
Apply conv_fun_series_inv; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_inv :
  (H:(fun_series_convergent_IR J [n:nat]{--}(f n)))
  (Feq (iprop J) (FSeries_Sum H) {--}(FSeries_Sum convF)).
(* End_Tex_Verb *)
Intros.
Apply included_Feq'; Intros.
EApply Feq_transitive.
Apply (FSeries_Sum_char ?? H a b Hab H0).
EApply Feq_transitive.
Apply Fun_Series_Sum_inv with convF:=(convF a b Hab H0).
Apply Feq_symmetric; Apply Feq_inv; Apply FSeries_Sum_char.
Qed.

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_minus_conv :
  (fun_series_convergent_IR J [n:nat](f n){-}(g n)).
(* End_Tex_Verb *)
Red; Intros.
Apply conv_fun_series_minus; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_minus :
  (H:(fun_series_convergent_IR J [n:nat](f n){-}(g n)))
  (Feq (iprop J) (FSeries_Sum H)
                 (FSeries_Sum convF){-}(FSeries_Sum convG)).
(* End_Tex_Verb *)
Intros.
Apply included_Feq'; Intros.
EApply Feq_transitive.
Apply (FSeries_Sum_char ?? H a b Hab H0).
EApply Feq_transitive.
Apply Fun_Series_Sum_minus with convF:=(convF a b Hab H0) convG:=(convG a b Hab H0).
Apply Feq_symmetric; Apply Feq_minus; Apply FSeries_Sum_char.
Qed.

(* Tex_Prose
\begin{convention} Let \verb!c:IR! and \verb!H:PartIR! be continuous in \verb!J!.
\end{convention}
*)

Variable c:IR.
Variable H:PartIR.
Hypothesis contH:(Continuous J H).

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_scal_conv :
  (fun_series_convergent_IR J [n:nat]H{*}(f n)).
(* End_Tex_Verb *)
Red; Intros.
Apply conv_fun_series_mult_scal; Auto.
EApply included_imp_Continuous.
Apply contH.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma FSeries_Sum_scal :
  (H':(fun_series_convergent_IR J [n:nat]H{*}(f n)))
  (Feq (iprop J) (FSeries_Sum H') H{*}(FSeries_Sum convF)).
(* End_Tex_Verb *)
Intros.
Apply included_Feq'; Intros.
Cut (Continuous_I Hab H); Intros.
EApply Feq_transitive.
Apply (FSeries_Sum_char ?? H' a b Hab H0).
EApply Feq_transitive.
Apply Fun_Series_Sum_mult_scal with convF:=(convF a b Hab H0).
Auto.
Apply Feq_symmetric; Apply Feq_mult.
Apply Feq_reflexive; Included.
Apply FSeries_Sum_char.
EApply included_imp_Continuous.
Apply contH.
Auto.
Qed.

End Operations.

Section Convergence_Criteria.

(* Tex_Prose
\subsection{Convergence Criteria}

The most important tests for convergence of series still apply: the comparison test (in both versions) and the ratio test.
*)

Variable J:interval.
Variable f:nat->PartIR.
Hypothesis contF : (n:nat)(Continuous J (f n)).

(* Begin_Tex_Verb *)
Lemma fun_str_comparison_IR : (g:nat->PartIR)
  (fun_series_convergent_IR J g)->
  {k:nat | ((n:nat)(le k n)->(x:IR)((iprop J x)->
    (Hx,Hx':?)(AbsIR ((f n) x Hx))[<=]((g n) x Hx')))}->
  (fun_series_convergent_IR J f).
(* End_Tex_Verb *)
Intros.
Red; Intros.
Apply fun_str_comparison with g.
Intro; Apply included_imp_Continuous with J; Auto.
Auto.
Elim H0; Clear H0; Intros k Hk.
Exists k; Intros.
Apply Hk; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma fun_comparison_IR : (g:nat->PartIR)
  (fun_series_convergent_IR J g)->
  ((n:nat)(x:IR)(iprop J x)->
    (Hx,Hx':?)(AbsIR ((f n) x Hx))[<=]((g n) x Hx'))->
  (fun_series_convergent_IR J f).
(* End_Tex_Verb *)
Intros.
Apply fun_str_comparison_IR with g; Auto.
Exists O; Intros; Apply H0; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma abs_imp_conv_IR : (fun_series_abs_convergent_IR J f)->
  (fun_series_convergent_IR J f).
(* End_Tex_Verb *)
Intros.
Apply fun_comparison_IR with [n:nat](FAbs (f n)).
Apply H.
Intros; Simpl; Apply eq_imp_leEq; Apply AbsIR_wd; Rational.
Qed.

(* Begin_Tex_Verb *)
Lemma fun_ratio_test_conv_IR : {N:nat & {c:IR &
  (c[<]One) | (Zero[<=]c) /\ (x:IR)(iprop J x)->
    (n:nat)(le N n)->(Hx,Hx':?)
    (AbsIR ((f (S n)) x Hx'))[<=]
      c[*](AbsIR ((f n) x Hx))}}->
  (fun_series_convergent_IR J f).
(* End_Tex_Verb *)
Intros.
Red; Intros.
Apply fun_ratio_test_conv.
Intro; Apply included_imp_Continuous with J; Auto.
Elim H; Intros N HN.
Elim HN; Clear H HN; Intros c Hc H.
Inversion_clear H.
Exists N; Exists c; Repeat Split; Auto.
Qed.

End Convergence_Criteria.

Section Insert_Series.

(* Tex_Prose
\subsection{Translation}

When working in particular with power series and Taylor series, it is sometimes useful to ``shift'' all the terms in the series one position forward, that is, replacing each $f_{i+1}$ by $f_i$ and inserting the null function in the first position.  This does not affect convergence or the Sum of the series.
*)

Variable J:interval.
Variable f:nat->PartIR.
Hypothesis convF:(fun_series_convergent_IR J f).

(* Begin_Tex_Verb *)
Definition insert_series : nat->PartIR := [n:nat]
  Cases n of
    O     => {-C-}Zero
  | (S p) => (f p)
  end.
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma insert_series_cont :
  (n:nat)(Continuous J (insert_series n)).
(* End_Tex_Verb *)
Intro; Elim n; Intros.
Simpl; Apply Continuous_const.
Simpl; Apply convergent_imp_Continuous; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma insert_series_sum_char : (n:nat)(x,Hx,Hx':?)
  ((fun_seq_part_sum f n) x Hx)[=]
    ((fun_seq_part_sum insert_series (S n)) x Hx').
(* End_Tex_Verb *)
Intro; Induction n.
Intros; Simpl; Algebra.
Intros; Simpl; Simpl in Hrecn; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma insert_series_conv :
  (fun_series_convergent_IR J insert_series).
(* End_Tex_Verb *)
Red; Intros.
Elim (convF ??? Hinc); Intros Hcont HCauchy.
Exists [n:nat](included_imp_Continuous ?? (insert_series_cont n) ??? Hinc).
Red; Intros.
Elim (HCauchy e H); Intros N HN.
Exists (S N); Do 4 Intro.
Cut m=(S (pred m)); [Intro | Apply S_pred with O; Apply lt_le_trans with (S N); Auto with arith].
Cut n=(S (pred n)); [Intro | Apply S_pred with O; Apply lt_le_trans with (S N); Auto with arith].
Generalize H0 H1; Clear H1 H0.
Rewrite H2; Rewrite H3; Clear H2 H3.
Intros.
Cut (le N (pred m)); [Intro | Auto with arith].
Cut (le N (pred n)); [Intro | Auto with arith].
EApply leEq_wdl.
Apply (HN ?? H2 H3 x Hx).
Apply AbsIR_wd.
Apply cg_minus_wd; Apply insert_series_sum_char.
Qed.

(* Begin_Tex_Verb *)
Lemma insert_series_sum :
  (Feq (iprop J) (FSeries_Sum convF)
                 (FSeries_Sum insert_series_conv)).
(* End_Tex_Verb *)
LetTac contF:=(convergent_imp_Continuous ?? convF).
Apply FLim_unique_IR with [n:nat](FSum0 n f) [n:nat](Continuous_Sum0 ?? contF n)
  (Continuous_FSeries_Sum ?? convF) (Continuous_FSeries_Sum ?? insert_series_conv).
Apply FSeries_conv.
Red; Intros.
LetTac convS:=
  (FSeries_conv ?? insert_series_conv (Continuous_Sum0 ?? insert_series_cont) (Continuous_FSeries_Sum ?? insert_series_conv) ??? Hinc).
ClearBody convS.
Red; Intros.
Elim (convS e H); Intros N HN.
Clear convS; Exists N; Intros.
EApply leEq_wdl.
Apply (HN (S n) (le_S ?? H0) ? Hx).
Apply AbsIR_wd; Apply cg_minus_wd.
2: Algebra.
Apply eq_symmetric_unfolded.
EApply eq_transitive_unfolded.
EApply eq_transitive_unfolded.
2: Apply (insert_series_sum_char n x
  (contin_imp_inc ???? (included_imp_Continuous ?? (Continuous_Sum0 ?? contF n) ??? Hinc) ? Hx)
  (contin_imp_inc ???? (included_imp_Continuous ?? (Continuous_Sum0 ?? insert_series_cont (S n)) ??? Hinc) ? Hx)).
Unfold fun_seq_part_sum; Algebra.
Unfold fun_seq_part_sum; Algebra.
Qed.

End Insert_Series.


(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *         Copyright INRIA, CNRS and contributors             *)
(* <O___,, * (see version control and CREDITS file for authors & dates) *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)

(** * Finite map library *)

(** This file proposes an implementation of the non-dependent interface
 [FMapInterfaceLarge.S] using lists of pairs ordered (increasing) with respect to
 left projection. *)

Require Import Fairness.FMapInterface.
Require Import FunInd.

Set Implicit Arguments.
Unset Strict Implicit.

Module Raw (X:OrderedTypeLarge).

Module Import MX := OrderedTypeLargeFacts X.
Module Import PX := KeyOrderedTypeLarge X.

Definition key := X.t.
Definition t (elt:Type) := list (X.t * elt).

Section Elt.
Variable elt : Type.

Notation eqk := (eqk (elt:=elt)).
Notation eqke := (eqke (elt:=elt)).
Notation ltk := (ltk (elt:=elt)).
Notation MapsTo := (MapsTo (elt:=elt)).
Notation In := (In (elt:=elt)).
Notation Sort := (sort ltk).
Notation Inf := (lelistA (ltk)).

(** * [empty] *)

Definition empty : t elt := nil.

Definition Empty m := forall (a : key)(e:elt) , ~ MapsTo a e m.

Lemma empty_1 : Empty empty.
Proof.
 unfold Empty,empty.
 intros a e.
 intro abs.
 inversion abs.
Qed.
#[local]
Hint Resolve empty_1 : core.

Lemma empty_sorted : Sort empty.
Proof.
 unfold empty; auto.
Qed.

(** * [is_empty] *)

Definition is_empty (l : t elt) : bool := if l then true else false.

Lemma is_empty_1 :forall m, Empty m -> is_empty m = true.
Proof.
 unfold Empty, PX.MapsTo.
 intros m.
 case m;auto.
 intros (k,e) l inlist.
 absurd (InA eqke (k, e) ((k, e) :: l)); auto with ordered_type.
Qed.

Lemma is_empty_2 : forall m, is_empty m = true -> Empty m.
Proof.
 intros m.
 case m;auto.
 intros p l abs.
 inversion abs.
Qed.

(** * [mem] *)

Function mem (k : key) (s : t elt) {struct s} : bool :=
 match s with
  | nil => false
  | (k',_) :: l =>
     match X.compare k k' with
      | LT _ => false
      | EQ _ => true
      | GT _ => mem k l
     end
 end.

Lemma mem_1 : forall m (Hm:Sort m) x, In x m -> mem x m = true.
Proof.
 intros m Hm x; generalize Hm; clear Hm.
 functional induction (mem x m);intros sorted belong1;trivial.

 inversion belong1. inversion H.

 absurd (In x ((k', _x) :: l));try assumption.
 apply Sort_Inf_NotIn with _x;auto.

 apply IHb.
 elim (sort_inv sorted);auto.
 elim (In_inv belong1);auto.
 intro abs.
 absurd (X.eq x k'); auto with ordered_type.
Qed.

Lemma mem_2 : forall m (Hm:Sort m) x, mem x m = true -> In x m.
Proof.
 intros m Hm x; generalize Hm; clear Hm; unfold PX.In,PX.MapsTo.
 functional induction (mem x m); intros sorted hyp;try ((inversion hyp);fail).
 exists _x; auto with ordered_type.
 induction IHb; auto.
 exists x0; auto.
 inversion_clear sorted; auto.
Qed.

(** * [find] *)

Function find (k:key) (s: t elt) {struct s} : option elt :=
 match s with
  | nil => None
  | (k',x)::s' =>
     match X.compare k k' with
      | LT _ => None
      | EQ _ => Some x
      | GT _ => find k s'
     end
 end.

Lemma find_2 :  forall m x e, find x m = Some e -> MapsTo x e m.
Proof.
 intros m x. unfold PX.MapsTo.
 functional induction (find x m);simpl;intros e' eqfind; inversion eqfind; auto with ordered_type.
Qed.

Lemma find_1 :  forall m (Hm:Sort m) x e, MapsTo x e m -> find x m = Some e.
Proof.
 intros m Hm x e; generalize Hm; clear Hm; unfold PX.MapsTo.
 functional induction (find x m);simpl; subst; try clear H_eq_1.

 inversion 2.

 inversion_clear 2.
 clear e1;compute in H0; destruct H0;order.
 clear e1;generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute; order.

 clear e1;inversion_clear 2.
 compute in H0; destruct H0; intuition congruence.
 generalize (Sort_In_cons_1 Hm (InA_eqke_eqk H0)); compute; order.

 clear e1; do 2 inversion_clear 1; auto.
 compute in H2; destruct H2; order.
Qed.

(** * [add] *)

Function add (k : key) (x : elt) (s : t elt) {struct s} : t elt :=
 match s with
  | nil => (k,x) :: nil
  | (k',y) :: l =>
     match X.compare k k' with
      | LT _ => (k,x)::s
      | EQ _ => (k,x)::l
      | GT _ => (k',y) :: add k x l
     end
 end.

Lemma add_1 : forall m x y e, X.eq x y -> MapsTo y e (add x e m).
Proof.
 intros m x y e; generalize y; clear y.
 unfold PX.MapsTo.
 functional induction (add x e m);simpl;auto with ordered_type.
Qed.

Lemma add_2 : forall m x y e e',
  ~ X.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
Proof.
 intros m x  y e e'.
 generalize y e; clear y e; unfold PX.MapsTo.
 functional induction (add x e' m) ;simpl;auto;  clear e0.
 subst;auto.

 intros y' e'' eqky';  inversion_clear 1;  destruct H0; simpl in *.
 order.
 auto.
 auto.
 intros y' e'' eqky'; inversion_clear 1; intuition.
Qed.

Lemma add_3 : forall m x y e e',
  ~ X.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
Proof with auto with ordered_type.
 intros m x y e e'. generalize y e; clear y e; unfold PX.MapsTo.
 functional induction (add x e' m);simpl; intros.
 apply (In_inv_3 H0)...
 apply (In_inv_3 H0)...
 constructor 2; apply (In_inv_3 H0)...
 inversion_clear H0; auto.
Qed.

Lemma add_Inf : forall (m:t elt)(x x':key)(e e':elt),
  Inf (x',e') m -> ltk (x',e') (x,e) -> Inf (x',e') (add x e m).
Proof.
 induction m.
 simpl; intuition.
 intros.
 destruct a as (x'',e'').
 inversion_clear H.
 compute in H0,H1.
 simpl; case (X.compare x x''); intuition.
Qed.
#[local]
Hint Resolve add_Inf : core.

Lemma add_sorted : forall m (Hm:Sort m) x e, Sort (add x e m).
Proof.
 induction m.
 simpl; intuition.
 intros.
 destruct a as (x',e').
 simpl; case (X.compare x x'); intuition; inversion_clear Hm; auto.
 constructor; auto.
 apply Inf_eq with (x',e'); auto.
Qed.

(** * [remove] *)

Function remove (k : key) (s : t elt) {struct s} : t elt :=
 match s with
  | nil => nil
  | (k',x) :: l =>
     match X.compare k k' with
      | LT _ => s
      | EQ _ => l
      | GT _ => (k',x) :: remove k l
     end
 end.

Lemma remove_1 : forall m (Hm:Sort m) x y, X.eq x y -> ~ In y (remove x m).
Proof.
 intros m Hm x y; generalize Hm; clear Hm.
 functional induction (remove x m);simpl;intros;subst.

 red; inversion 1; inversion H1.

 apply Sort_Inf_NotIn with x0; auto.
 clear e0;constructor; compute; order.

 clear e0;inversion_clear Hm.
 apply Sort_Inf_NotIn with x0; auto.
 apply Inf_eq with (k',x0);auto; compute; apply X.eq_trans with x; auto with ordered_type.

 clear e0;inversion_clear Hm.
 assert (notin:~ In y (remove x l)) by auto.
 intros (x1,abs).
 inversion_clear abs.
 compute in H2; destruct H2; order.
 apply notin; exists x1; auto.
Qed.

Lemma remove_2 : forall m (Hm:Sort m) x y e,
  ~ X.eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
Proof.
 intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo.
 functional induction (remove x m);subst;auto;
   match goal with
     | [H: X.compare _ _ = _ |- _ ] => clear H
     | _ => idtac
   end.

 inversion_clear 3; auto.
 compute in H1; destruct H1; order.

 inversion_clear 1; inversion_clear 2; auto.
Qed.

Lemma remove_3 : forall m (Hm:Sort m) x y e,
  MapsTo y e (remove x m) -> MapsTo y e m.
Proof.
 intros m Hm x y e; generalize Hm; clear Hm; unfold PX.MapsTo.
 functional induction (remove x m);subst;auto.
 inversion_clear 1; inversion_clear 1; auto.
Qed.

Lemma remove_Inf : forall (m:t elt)(Hm : Sort m)(x x':key)(e':elt),
  Inf (x',e') m -> Inf (x',e') (remove x m).
Proof.
 induction m.
 simpl; intuition.
 intros.
 destruct a as (x'',e'').
 inversion_clear H.
 compute in H0.
 simpl; case (X.compare x x''); intuition.
 inversion_clear Hm.
 apply Inf_lt with (x'',e''); auto.
Qed.
#[local]
Hint Resolve remove_Inf : core.

Lemma remove_sorted : forall m (Hm:Sort m) x, Sort (remove x m).
Proof.
 induction m.
 simpl; intuition.
 intros.
 destruct a as (x',e').
 simpl; case (X.compare x x'); intuition; inversion_clear Hm; auto.
Qed.

(** * [elements] *)

Definition elements (m: t elt) := m.

Lemma elements_1 : forall m x e,
  MapsTo x e m -> InA eqke (x,e) (elements m).
Proof.
 auto.
Qed.

Lemma elements_2 : forall m x e,
  InA eqke (x,e) (elements m) -> MapsTo x e m.
Proof.
 auto.
Qed.

Lemma elements_3 : forall m (Hm:Sort m), sort ltk (elements m).
Proof.
 auto.
Qed.

Lemma elements_3w : forall m (Hm:Sort m), NoDupA eqk (elements m).
Proof.
 intros.
 apply Sort_NoDupA.
 apply elements_3; auto.
Qed.

(** * [fold] *)

Function fold (A:Type)(f:key->elt->A->A)(m:t elt) (acc:A) {struct m} :  A :=
  match m with
   | nil => acc
   | (k,e)::m' => fold f m' (f k e acc)
  end.

Lemma fold_1 : forall m (A:Type)(i:A)(f:key->elt->A->A),
  fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
Proof.
 intros; functional induction (fold f m i); auto.
Qed.

(** * [equal] *)

Function equal (cmp:elt->elt->bool)(m m' : t elt) {struct m} : bool :=
  match m, m' with
   | nil, nil => true
   | (x,e)::l, (x',e')::l' =>
      match X.compare x x' with
       | EQ _ => cmp e e' && equal cmp l l'
       | _    => false
      end
   | _, _ => false
  end.

Definition Equivb cmp m m' :=
  (forall k, In k m <-> In k m') /\
  (forall k e e', MapsTo k e m -> MapsTo k e' m' -> cmp e e' = true).

Lemma equal_1 : forall m (Hm:Sort m) m' (Hm': Sort m') cmp,
  Equivb cmp m m' -> equal cmp m m' = true.
Proof with auto with ordered_type.
 intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'.
 functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb;
 intuition; subst.
 match goal with H: X.compare _ _ = _ |- _ => clear H end.
 assert (cmp_e_e':cmp e e' = true).
  apply H1 with x...
 rewrite cmp_e_e'; simpl.
 apply IHb; auto.
 inversion_clear Hm; auto.
 inversion_clear Hm'; auto.
 unfold Equivb; intuition.
 destruct (H0 k).
 assert (In k ((x,e) ::l)).
  destruct H as (e'', hyp); exists e''...
 destruct (In_inv (H2 H4)); auto.
 inversion_clear Hm.
 elim (Sort_Inf_NotIn H6 H7).
 destruct H as (e'', hyp); exists e''; auto.
 apply MapsTo_eq with k; auto; order.
 destruct (H0 k).
 assert (In k ((x',e') ::l')).
  destruct H as (e'', hyp); exists e''...
 destruct (In_inv (H3 H4)); auto.
 inversion_clear Hm'.
 elim (Sort_Inf_NotIn H6 H7).
 destruct H as (e'', hyp); exists e''; auto.
 apply MapsTo_eq with k; auto; order.
 apply H1 with k; destruct (X.eq_dec x k)...

 destruct (X.compare x x') as [Hlt|Heq|Hlt]; try contradiction; clear y.
 destruct (H0 x).
 assert (In x ((x',e')::l')).
  apply H; auto.
  exists e...
 destruct (In_inv H3).
 order.
 inversion_clear Hm'.
 assert (Inf (x,e) l').
 apply Inf_lt with (x',e'); auto.
 elim (Sort_Inf_NotIn H5 H7 H4).

 destruct (H0 x').
 assert (In x' ((x,e)::l)).
  apply H2; auto.
  exists e'...
 destruct (In_inv H3).
 order.
 inversion_clear Hm.
 assert (Inf (x',e') l).
  apply Inf_lt with (x,e); auto.
 elim (Sort_Inf_NotIn H5 H7 H4).

 destruct m;
 destruct m';try contradiction.

 clear H1;destruct p as (k,e).
 destruct (H0 k).
 destruct H1.
 exists e...
 inversion H1.

 destruct p as (x,e).
 destruct (H0 x).
 destruct H.
 exists e...
 inversion H.

 destruct p;destruct p0;contradiction.
Qed.

Lemma equal_2 : forall m (Hm:Sort m) m' (Hm:Sort m') cmp,
  equal cmp m m' = true -> Equivb cmp m m'.
Proof with auto with ordered_type.
 intros m Hm m' Hm' cmp; generalize Hm Hm'; clear Hm Hm'.
 functional induction (equal cmp m m'); simpl; subst;auto; unfold Equivb;
  intuition; try discriminate; subst;
  try match goal with H: X.compare _ _ = _ |- _ => clear H end.

 inversion H0.

 inversion_clear Hm;inversion_clear Hm'.
 destruct (andb_prop _ _ H); clear H.
 destruct (IHb H1 H3 H6).
 destruct (In_inv H0).
 exists e'; constructor; split; trivial; apply X.eq_trans with x; auto.
 destruct (H k).
 destruct (H9 H8) as (e'',hyp).
 exists e''...

 inversion_clear Hm;inversion_clear Hm'.
 destruct (andb_prop _ _ H); clear H.
 destruct (IHb H1 H3 H6).
 destruct (In_inv H0).
 exists e; constructor; split; trivial; apply X.eq_trans with x'...
 destruct (H k).
 destruct (H10 H8) as (e'',hyp).
 exists e''...

 inversion_clear Hm;inversion_clear Hm'.
 destruct (andb_prop _ _ H); clear H.
 destruct (IHb H2 H4 H7).
 inversion_clear H0.
 destruct H9; simpl in *; subst.
 inversion_clear H1.
 destruct H9; simpl in *; subst; auto.
 elim (Sort_Inf_NotIn H4 H5).
 exists e'0; apply MapsTo_eq with k; auto; order.
 inversion_clear H1.
 destruct H0; simpl in *; subst; auto.
 elim (Sort_Inf_NotIn H2 H3).
 exists e0; apply MapsTo_eq with k; auto; order.
 apply H8 with k; auto.
Qed.

(** This lemma isn't part of the spec of [Equivb], but is used in [FMapAVL] *)

Lemma equal_cons : forall cmp l1 l2 x y, Sort (x::l1) -> Sort (y::l2) ->
  eqk x y -> cmp (snd x) (snd y) = true ->
  (Equivb cmp l1 l2 <-> Equivb cmp (x :: l1) (y :: l2)).
Proof.
 intros.
 inversion H; subst.
 inversion H0; subst.
 destruct x; destruct y; compute in H1, H2.
 split; intros.
 apply equal_2; auto.
 simpl.
 elim_comp.
 rewrite H2; simpl.
 apply equal_1; auto.
 apply equal_2; auto.
 generalize (equal_1 H H0 H3).
 simpl.
 elim_comp.
 rewrite H2; simpl; auto.
Qed.

Variable elt':Type.

(** * [map] and [mapi] *)

Fixpoint map (f:elt -> elt') (m:t elt) : t elt' :=
  match m with
   | nil => nil
   | (k,e)::m' => (k,f e) :: map f m'
  end.

Fixpoint mapi (f: key -> elt -> elt') (m:t elt) : t elt' :=
  match m with
   | nil => nil
   | (k,e)::m' => (k,f k e) :: mapi f m'
  end.

End Elt.
Section Elt2.
(* A new section is necessary for previous definitions to work
   with different [elt], especially [MapsTo]... *)

Variable elt elt' : Type.

(** Specification of [map] *)

Lemma map_1 : forall (m:t elt)(x:key)(e:elt)(f:elt->elt'),
  MapsTo x e m -> MapsTo x (f e) (map f m).
Proof.
 intros m x e f.
 (* functional induction map elt elt' f m.  *) (* Marche pas ??? *)
 induction m.
 inversion 1.

 destruct a as (x',e').
 simpl.
 inversion_clear 1.
 constructor 1.
 unfold eqke in *; simpl in *; intuition congruence.
 unfold MapsTo in *; auto.
Qed.

Lemma map_2 : forall (m:t elt)(x:key)(f:elt->elt'),
  In x (map f m) -> In x m.
Proof.
 intros m x f.
 (* functional induction map elt elt' f m. *) (* Marche pas ??? *)
 induction m; simpl.
 intros (e,abs).
 inversion abs.

 destruct a as (x',e).
 intros hyp.
 inversion hyp. clear hyp.
 inversion H; subst; rename x0 into e'.
 exists e; constructor.
 unfold eqke in *; simpl in *; intuition.
 destruct IHm as (e'',hyp).
 exists e'; auto.
 exists e''.
 constructor 2; auto.
Qed.

Lemma map_lelistA : forall (m: t elt)(x:key)(e:elt)(e':elt')(f:elt->elt'),
  lelistA (@ltk elt) (x,e) m ->
  lelistA (@ltk elt') (x,e') (map f m).
Proof.
 induction m; simpl; auto.
 intros.
 destruct a as (x0,e0).
 inversion_clear H; auto.
Qed.

#[local]
Hint Resolve map_lelistA : core.

Lemma map_sorted : forall (m: t elt)(Hm : sort (@ltk elt) m)(f:elt -> elt'),
  sort (@ltk elt') (map f m).
Proof.
 induction m; simpl; auto.
 intros.
 destruct a as (x',e').
 inversion_clear Hm.
 constructor; auto.
 exact (map_lelistA _ _ H0).
Qed.

(** Specification of [mapi] *)

Lemma mapi_1 : forall (m:t elt)(x:key)(e:elt)(f:key->elt->elt'),
  MapsTo x e m ->
  exists y, X.eq y x /\ MapsTo x (f y e) (mapi f m).
Proof.
 intros m x e f.
 (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *)
 induction m.
 inversion 1.

 destruct a as (x',e').
 simpl.
 inversion_clear 1.
 exists x'.
 destruct H0; simpl in *.
 split.
 auto with ordered_type.
 constructor 1.
 unfold eqke in *; simpl in *; intuition congruence.
 destruct IHm as (y, hyp); auto.
 exists y; intuition.
Qed.

Lemma mapi_2 : forall (m:t elt)(x:key)(f:key->elt->elt'),
  In x (mapi f m) -> In x m.
Proof.
 intros m x f.
 (* functional induction mapi elt elt' f m. *) (* Marche pas ??? *)
 induction m; simpl.
 intros (e,abs).
 inversion abs.

 destruct a as (x',e).
 intros hyp.
 inversion hyp. clear hyp.
 inversion H; subst; rename x0 into e'.
 exists e; constructor.
 unfold eqke in *; simpl in *; intuition.
 destruct IHm as (e'',hyp).
 exists e'; auto.
 exists e''.
 constructor 2; auto.
Qed.

Lemma mapi_lelistA : forall (m: t elt)(x:key)(e:elt)(f:key->elt->elt'),
  lelistA (@ltk elt) (x,e) m ->
  lelistA (@ltk elt') (x,f x e) (mapi f m).
Proof.
 induction m; simpl; auto.
 intros.
 destruct a as (x',e').
 inversion_clear H; auto.
Qed.

#[local]
Hint Resolve mapi_lelistA : core.

Lemma mapi_sorted : forall m (Hm : sort (@ltk elt) m)(f: key ->elt -> elt'),
  sort (@ltk elt') (mapi f m).
Proof.
 induction m; simpl; auto.
 intros.
 destruct a as (x',e').
 inversion_clear Hm; auto.
Qed.

End Elt2.
Section Elt3.

(** * [map2] *)

Variable elt elt' elt'' : Type.
Variable f : option elt -> option elt' -> option elt''.

Definition option_cons (A:Type)(k:key)(o:option A)(l:list (key*A)) :=
  match o with
   | Some e => (k,e)::l
   | None => l
  end.

Fixpoint map2_l (m : t elt) : t elt'' :=
  match m with
   | nil => nil
   | (k,e)::l => option_cons k (f (Some e) None) (map2_l l)
  end.

Fixpoint map2_r (m' : t elt') : t elt'' :=
  match m' with
   | nil => nil
   | (k,e')::l' => option_cons k (f None (Some e')) (map2_r l')
  end.

Fixpoint map2 (m : t elt) : t elt' -> t elt'' :=
  match m with
   | nil => map2_r
   | (k,e) :: l =>
      fix map2_aux (m' : t elt') : t elt'' :=
        match m' with
         | nil => map2_l m
         | (k',e') :: l' =>
            match X.compare k k' with
             | LT _ => option_cons k (f (Some e) None) (map2 l m')
             | EQ _ => option_cons k (f (Some e) (Some e')) (map2 l l')
             | GT _ => option_cons k' (f None (Some e')) (map2_aux l')
            end
        end
  end.

Notation oee' := (option elt * option elt')%type.

Fixpoint combine (m : t elt) : t elt' -> t oee' :=
  match m with
   | nil => map (fun e' => (None,Some e'))
   | (k,e) :: l =>
      fix combine_aux (m':t elt') : list (key * oee') :=
        match m' with
         | nil => map (fun e => (Some e,None)) m
         | (k',e') :: l' =>
            match X.compare k k' with
             | LT _ => (k,(Some e, None))::combine l m'
             | EQ _ => (k,(Some e, Some e'))::combine l l'
             | GT _ => (k',(None,Some e'))::combine_aux l'
            end
        end
  end.

Definition fold_right_pair (A B C:Type)(f: A->B->C->C)(l:list (A*B))(i:C) :=
  List.fold_right (fun p => f (fst p) (snd p)) i l.

Definition map2_alt m m' :=
  let m0 : t oee' := combine m m' in
  let m1 : t (option elt'') := map (fun p => f (fst p) (snd p)) m0 in
  fold_right_pair (option_cons (A:=elt'')) m1 nil.

Lemma map2_alt_equiv : forall m m', map2_alt m m' = map2 m m'.
Proof.
 unfold map2_alt.
 induction m.
 simpl; auto; intros.
 (* map2_r *)
 induction m'; try destruct a; simpl; auto.
 rewrite IHm'; auto.
 (* fin map2_r *)
 induction m'; destruct a.
 simpl; f_equal.
 (* map2_l *)
 clear IHm.
 induction m; try destruct a; simpl; auto.
 rewrite IHm; auto.
 (* fin map2_l *)
 destruct a0.
 simpl.
 destruct (X.compare t0 t1); simpl; f_equal.
 apply IHm.
 apply IHm.
 apply IHm'.
Qed.

Lemma combine_lelistA :
  forall m m' (x:key)(e:elt)(e':elt')(e'':oee'),
  lelistA (@ltk elt) (x,e) m ->
  lelistA (@ltk elt') (x,e') m' ->
  lelistA (@ltk oee') (x,e'') (combine m m').
Proof.
 induction m.
 intros.
 simpl.
 exact (map_lelistA _ _ H0).
 induction m'.
 intros.
 destruct a.
 replace (combine ((t0, e0) :: m) nil) with
             (map (fun e => (Some e,None (A:=elt'))) ((t0,e0)::m)); auto.
 exact (map_lelistA _ _ H).
 intros.
 simpl.
 destruct a as (k,e0); destruct a0 as (k',e0').
 destruct (X.compare k k').
 inversion_clear H; auto.
 inversion_clear H; auto.
 inversion_clear H0; auto.
Qed.
#[local]
Hint Resolve combine_lelistA : core.

Lemma combine_sorted :
  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'),
  sort (@ltk oee') (combine m m').
Proof.
 induction m.
 intros; clear Hm.
 simpl.
 apply map_sorted; auto.
 induction m'.
 intros; clear Hm'.
 destruct a.
 replace (combine ((t0, e) :: m) nil) with
             (map (fun e => (Some e,None (A:=elt'))) ((t0,e)::m)); auto.
 apply map_sorted; auto.
 intros.
 simpl.
 destruct a as (k,e); destruct a0 as (k',e').
 destruct (X.compare k k') as [Hlt|Heq|Hlt].
 inversion_clear Hm.
 constructor; auto.
 assert (lelistA (ltk (elt:=elt')) (k, e') ((k',e')::m')) by auto.
 exact (combine_lelistA _ H0 H1).
 inversion_clear Hm; inversion_clear Hm'.
 constructor; auto.
 assert (lelistA (ltk (elt:=elt')) (k, e') m') by (apply Inf_eq with (k',e'); auto).
 exact (combine_lelistA _ H0 H3).
 inversion_clear Hm; inversion_clear Hm'.
 constructor; auto.
 change (lelistA (ltk (elt:=oee')) (k', (None, Some e'))
                 (combine ((k,e)::m) m')).
 assert (lelistA (ltk (elt:=elt)) (k', e) ((k,e)::m)) by auto.
 exact (combine_lelistA _  H3 H2).
Qed.

Lemma map2_sorted :
  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m'),
  sort (@ltk elt'') (map2 m m').
Proof.
 intros.
 rewrite <- map2_alt_equiv.
 unfold map2_alt.
 assert (H0:=combine_sorted Hm Hm').
 set (l0:=combine m m') in *; clearbody l0.
 set (f':= fun p : oee' => f (fst p) (snd p)).
 assert (H1:=map_sorted (elt' := option elt'') H0 f').
 set (l1:=map f' l0) in *; clearbody l1.
 clear f' f H0 l0 Hm Hm' m m'.
 induction l1.
 simpl; auto.
 inversion_clear H1.
 destruct a; destruct o; auto.
 simpl.
 constructor; auto.
 clear IHl1.
 induction l1.
 simpl; auto.
 destruct a; destruct o; simpl; auto.
 inversion_clear H0; auto.
 inversion_clear H0.
 red in H1; simpl in H1.
 inversion_clear H.
 apply IHl1; auto.
 apply Inf_lt with (t1, None (A:=elt'')); auto.
Qed.

Definition at_least_one (o:option elt)(o':option elt') :=
  match o, o' with
   | None, None => None
   | _, _  => Some (o,o')
  end.

Lemma combine_1 :
  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key),
  find x (combine m m') = at_least_one (find x m) (find x m').
Proof.
 induction m.
 intros.
 simpl.
 induction m'.
 intros; simpl; auto.
 simpl; destruct a.
 simpl; destruct (X.compare x t0); simpl; auto.
 inversion_clear Hm'; auto.
 induction m'.
 (* m' = nil *)
 intros; destruct a; simpl.
 destruct (X.compare x t0) as [Hlt| |Hlt]; simpl; auto.
 inversion_clear Hm; clear H0 Hlt Hm' IHm t0.
 induction m; simpl; auto.
 inversion_clear H.
 destruct a.
 simpl; destruct (X.compare x t0); simpl; auto.
 (* m' <> nil *)
 intros.
 destruct a as (k,e); destruct a0 as (k',e'); simpl.
 inversion Hm; inversion Hm'; subst.
 destruct (X.compare k k'); simpl;
  destruct (X.compare x k);
   elim_comp || destruct (X.compare x k'); simpl; auto.
 rewrite IHm; auto; simpl; elim_comp; auto.
 rewrite IHm; auto; simpl; elim_comp; auto.
 rewrite IHm; auto; simpl; elim_comp; auto.
 change (find x (combine ((k, e) :: m) m') = at_least_one None (find x m')).
 rewrite IHm'; auto.
 simpl find; elim_comp; auto.
 change (find x (combine ((k, e) :: m) m') = Some (Some e, find x m')).
 rewrite IHm'; auto.
 simpl find; elim_comp; auto.
 change (find x (combine ((k, e) :: m) m') =
         at_least_one (find x m) (find x m')).
 rewrite IHm'; auto.
 simpl find; elim_comp; auto.
Qed.

Definition at_least_one_then_f (o:option elt)(o':option elt') :=
  match o, o' with
   | None, None => None
   | _, _  => f o o'
  end.

Lemma map2_0 :
  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m') (x:key),
  find x (map2 m m') = at_least_one_then_f (find x m) (find x m').
Proof.
 intros.
 rewrite <- map2_alt_equiv.
 unfold map2_alt.
 assert (H:=combine_1 Hm Hm' x).
 assert (H2:=combine_sorted Hm Hm').
 set (f':= fun p : oee' => f (fst p) (snd p)).
 set (m0 := combine m m') in *; clearbody m0.
 set (o:=find x m) in *; clearbody o.
 set (o':=find x m') in *; clearbody o'.
 clear Hm Hm' m m'.
 generalize H; clear H.
 match goal with |- ?m=?n -> ?p=?q =>
   assert ((m=n->p=q)/\(m=None -> p=None)); [|intuition] end.
 induction m0; simpl in *; intuition.
 destruct o; destruct o'; simpl in *; try discriminate; auto.
 destruct a as (k,(oo,oo')); simpl in *.
 inversion_clear H2.
 destruct (X.compare x k) as [Hlt|Heq|Hlt]; simpl in *.
 (* x < k *)
 destruct (f' (oo,oo')); simpl.
 elim_comp.
 destruct o; destruct o'; simpl in *; try discriminate; auto.
 destruct (IHm0 H0) as (H2,_); apply H2; auto.
 rewrite <- H.
 case_eq (find x m0); intros; auto.
 assert (ltk (elt:=oee') (x,(oo,oo')) (k,(oo,oo'))).
  red; auto.
 destruct (Sort_Inf_NotIn H0 (Inf_lt H4 H1)).
 exists p; apply find_2; auto.
 (* x = k *)
 assert (at_least_one_then_f o o' = f oo oo').
  destruct o; destruct o'; simpl in *; inversion_clear H; auto.
 rewrite H2.
 unfold f'; simpl.
 destruct (f oo oo'); simpl.
 elim_comp; auto.
 destruct (IHm0 H0) as (_,H4); apply H4; auto.
 case_eq (find x m0); intros; auto.
 assert (eqk (elt:=oee') (k,(oo,oo')) (x,(oo,oo'))).
  red; auto with ordered_type.
 destruct (Sort_Inf_NotIn H0 (Inf_eq (eqk_sym H5) H1)).
 exists p; apply find_2; auto.
 (* k < x *)
 unfold f'; simpl.
 destruct (f oo oo'); simpl.
 elim_comp; auto.
 destruct (IHm0 H0) as (H3,_); apply H3; auto.
 destruct (IHm0 H0) as (H3,_); apply H3; auto.

 (* None -> None *)
 destruct a as (k,(oo,oo')).
 simpl.
 inversion_clear H2.
 destruct (X.compare x k) as [Hlt|Heq|Hlt].
 (* x < k *)
 unfold f'; simpl.
 destruct (f oo oo'); simpl.
 elim_comp; auto.
 destruct (IHm0 H0) as (_,H4); apply H4; auto.
 case_eq (find x m0); intros; auto.
 assert (ltk (elt:=oee') (x,(oo,oo')) (k,(oo,oo'))).
  red; auto.
 destruct (Sort_Inf_NotIn H0 (Inf_lt H3 H1)).
 exists p; apply find_2; auto.
 (* x = k *)
 discriminate.
 (* k < x *)
 unfold f'; simpl.
 destruct (f oo oo'); simpl.
 elim_comp; auto.
 destruct (IHm0 H0) as (_,H4); apply H4; auto.
 destruct (IHm0 H0) as (_,H4); apply H4; auto.
Qed.

(** Specification of [map2] *)

Lemma map2_1 :
  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key),
  In x m \/ In x m' ->
  find x (map2 m m') = f (find x m) (find x m').
Proof.
 intros.
 rewrite map2_0; auto.
 destruct H as [(e,H)|(e,H)].
 rewrite (find_1 Hm H).
 destruct (find x m'); simpl; auto.
 rewrite (find_1 Hm' H).
 destruct (find x m); simpl; auto.
Qed.

Lemma map2_2 :
  forall m (Hm : sort (@ltk elt) m) m' (Hm' : sort (@ltk elt') m')(x:key),
  In x (map2 m m') -> In x m \/ In x m'.
Proof.
 intros.
 destruct H as (e,H).
 generalize (map2_0 Hm Hm' x).
 rewrite (find_1 (map2_sorted Hm Hm') H).
 generalize (@find_2 _ m x).
 generalize (@find_2 _ m' x).
 destruct (find x m);
   destruct (find x m'); simpl; intros.
 left; exists e0; auto.
 left; exists e0; auto.
 right; exists e0; auto.
 discriminate.
Qed.

End Elt3.
End Raw.

Module Make (X: OrderedTypeLarge) <: S with Module E := X.
Module Raw := Raw X.
Module E := X.

Definition key := E.t.

Record slist (elt:Type) :=
  {this :> Raw.t elt; sorted : sort (@Raw.PX.ltk elt) this}.
Definition t (elt:Type) : Type := slist elt.

Section Elt.
 Variable elt elt' elt'':Type.

 Implicit Types m : t elt.
 Implicit Types x y : key.
 Implicit Types e : elt.

 Definition empty : t elt := Build_slist (Raw.empty_sorted elt).
 Definition is_empty m : bool := Raw.is_empty (this m).
 Definition add x e m : t elt := Build_slist (Raw.add_sorted (sorted m) x e).
 Definition find x m : option elt := Raw.find x (this m).
 Definition remove x m : t elt := Build_slist (Raw.remove_sorted (sorted m) x).
 Definition mem x m : bool := Raw.mem x (this m).
 Definition map f m : t elt' := Build_slist (Raw.map_sorted (sorted m) f).
 Definition mapi (f:key->elt->elt') m : t elt' := Build_slist (Raw.mapi_sorted (sorted m) f).
 Definition map2 f m (m':t elt') : t elt'' :=
   Build_slist (Raw.map2_sorted f (sorted m) (sorted m')).
 Definition elements m : list (key*elt) := @Raw.elements elt (this m).
 Definition cardinal m := length (this m).
 Definition fold (A:Type)(f:key->elt->A->A) m (i:A) : A := @Raw.fold elt A f (this m) i.
 Definition equal cmp m m' : bool := @Raw.equal elt cmp (this m) (this m').

 Definition MapsTo x e m : Prop := Raw.PX.MapsTo x e (this m).
 Definition In x m : Prop := Raw.PX.In x (this m).
 Definition Empty m : Prop := Raw.Empty (this m).

 Definition Equal m m' := forall y, find y m = find y m'.
 Definition Equiv (eq_elt:elt->elt->Prop) m m' :=
         (forall k, In k m <-> In k m') /\
         (forall k e e', MapsTo k e m -> MapsTo k e' m' -> eq_elt e e').
 Definition Equivb cmp m m' : Prop := @Raw.Equivb elt cmp (this m) (this m').

 Definition eq_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.eqk elt.
 Definition eq_key_elt : (key*elt) -> (key*elt) -> Prop:= @Raw.PX.eqke elt.
 Definition lt_key : (key*elt) -> (key*elt) -> Prop := @Raw.PX.ltk elt.

 Lemma MapsTo_1 : forall m x y e, E.eq x y -> MapsTo x e m -> MapsTo y e m.
 Proof. intros m; exact (@Raw.PX.MapsTo_eq elt (this m)). Qed.

 Lemma mem_1 : forall m x, In x m -> mem x m = true.
 Proof. intros m; exact (@Raw.mem_1 elt (this m) (sorted m)). Qed.
 Lemma mem_2 : forall m x, mem x m = true -> In x m.
 Proof. intros m; exact (@Raw.mem_2 elt (this m) (sorted m)). Qed.

 Lemma empty_1 : Empty empty.
 Proof. exact (@Raw.empty_1 elt). Qed.

 Lemma is_empty_1 : forall m, Empty m -> is_empty m = true.
 Proof. intros m; exact (@Raw.is_empty_1 elt (this m)). Qed.
 Lemma is_empty_2 :  forall m, is_empty m = true -> Empty m.
 Proof. intros m; exact (@Raw.is_empty_2 elt (this m)). Qed.

 Lemma add_1 : forall m x y e, E.eq x y -> MapsTo y e (add x e m).
 Proof. intros m; exact (@Raw.add_1 elt (this m)). Qed.
 Lemma add_2 : forall m x y e e', ~ E.eq x y -> MapsTo y e m -> MapsTo y e (add x e' m).
 Proof. intros m; exact (@Raw.add_2 elt (this m)). Qed.
 Lemma add_3 : forall m x y e e', ~ E.eq x y -> MapsTo y e (add x e' m) -> MapsTo y e m.
 Proof. intros m; exact (@Raw.add_3 elt (this m)). Qed.

 Lemma remove_1 : forall m x y, E.eq x y -> ~ In y (remove x m).
 Proof. intros m; exact (@Raw.remove_1 elt (this m) (sorted m)). Qed.
 Lemma remove_2 : forall m x y e, ~ E.eq x y -> MapsTo y e m -> MapsTo y e (remove x m).
 Proof. intros m; exact (@Raw.remove_2 elt (this m) (sorted m)). Qed.
 Lemma remove_3 : forall m x y e, MapsTo y e (remove x m) -> MapsTo y e m.
 Proof. intros m; exact (@Raw.remove_3 elt (this m) (sorted m)). Qed.

 Lemma find_1 : forall m x e, MapsTo x e m -> find x m = Some e.
 Proof. intros m; exact (@Raw.find_1 elt (this m) (sorted m)). Qed.
 Lemma find_2 : forall m x e, find x m = Some e -> MapsTo x e m.
 Proof. intros m; exact (@Raw.find_2 elt (this m)). Qed.

 Lemma elements_1 : forall m x e, MapsTo x e m -> InA eq_key_elt (x,e) (elements m).
 Proof. intros m; exact (@Raw.elements_1 elt (this m)). Qed.
 Lemma elements_2 : forall m x e, InA eq_key_elt (x,e) (elements m) -> MapsTo x e m.
 Proof. intros m; exact (@Raw.elements_2 elt (this m)). Qed.
 Lemma elements_3 : forall m, sort lt_key (elements m).
 Proof. intros m; exact (@Raw.elements_3 elt (this m) (sorted m)). Qed.
 Lemma elements_3w : forall m, NoDupA eq_key (elements m).
 Proof. intros m; exact (@Raw.elements_3w elt (this m) (sorted m)). Qed.

 Lemma cardinal_1 : forall m, cardinal m = length (elements m).
 Proof. intros; reflexivity. Qed.

 Lemma fold_1 : forall m (A : Type) (i : A) (f : key -> elt -> A -> A),
        fold f m i = fold_left (fun a p => f (fst p) (snd p) a) (elements m) i.
 Proof. intros m; exact (@Raw.fold_1 elt (this m)). Qed.

 Lemma equal_1 : forall m m' cmp, Equivb cmp m m' -> equal cmp m m' = true.
 Proof. intros m m'; exact (@Raw.equal_1 elt (this m) (sorted m) (this m') (sorted m')). Qed.
 Lemma equal_2 : forall m m' cmp, equal cmp m m' = true -> Equivb cmp m m'.
 Proof. intros m m'; exact (@Raw.equal_2 elt (this m) (sorted m) (this m') (sorted m')). Qed.

 End Elt.

 Lemma map_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)(f:elt->elt'),
        MapsTo x e m -> MapsTo x (f e) (map f m).
 Proof. intros elt elt' m; exact (@Raw.map_1 elt elt' (this m)). Qed.
 Lemma map_2 : forall (elt elt':Type)(m: t elt)(x:key)(f:elt->elt'),
        In x (map f m) -> In x m.
 Proof. intros elt elt' m; exact (@Raw.map_2 elt elt' (this m)). Qed.

 Lemma mapi_1 : forall (elt elt':Type)(m: t elt)(x:key)(e:elt)
        (f:key->elt->elt'), MapsTo x e m ->
        exists y, E.eq y x /\ MapsTo x (f y e) (mapi f m).
 Proof. intros elt elt' m; exact (@Raw.mapi_1 elt elt' (this m)). Qed.
 Lemma mapi_2 : forall (elt elt':Type)(m: t elt)(x:key)
        (f:key->elt->elt'), In x (mapi f m) -> In x m.
 Proof. intros elt elt' m; exact (@Raw.mapi_2 elt elt' (this m)). Qed.

 Lemma map2_1 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt')
	(x:key)(f:option elt->option elt'->option elt''),
	In x m \/ In x m' ->
        find x (map2 f m m') = f (find x m) (find x m').
 Proof.
 intros elt elt' elt'' m m' x f;
 exact (@Raw.map2_1 elt elt' elt'' f (this m) (sorted m) (this m') (sorted m') x).
 Qed.
 Lemma map2_2 : forall (elt elt' elt'':Type)(m: t elt)(m': t elt')
	(x:key)(f:option elt->option elt'->option elt''),
        In x (map2 f m m') -> In x m \/ In x m'.
 Proof.
 intros elt elt' elt'' m m' x f;
 exact (@Raw.map2_2 elt elt' elt'' f (this m) (sorted m) (this m') (sorted m') x).
 Qed.

End Make.

Module Make_ord (X: OrderedTypeLarge)(D : OrderedTypeLarge) <:
Sord with Module Data := D
        with Module MapS.E := X.

Module Data := D.
Module MapS := Make(X).
Import MapS.

Module MD := OrderedTypeLargeFacts(D).
Import MD.

Definition t := MapS.t D.t.

Definition cmp e e' := match D.compare e e' with EQ _ => true | _ => false end.

Fixpoint eq_list (m m' : list (X.t * D.t)) : Prop :=
  match m, m' with
   | nil, nil => True
   | (x,e)::l, (x',e')::l' =>
      match X.compare x x' with
       | EQ _ => D.eq e e' /\ eq_list l l'
       | _       => False
      end
   | _, _ => False
  end.

Definition eq m m' := eq_list (this m) (this m').

Fixpoint lt_list (m m' : list (X.t * D.t)) : Prop :=
  match m, m' with
   | nil, nil => False
   | nil, _  => True
   | _, nil  => False
   | (x,e)::l, (x',e')::l' =>
      match X.compare x x' with
       | LT _ => True
       | GT _ => False
       | EQ _ => D.lt e e' \/ (D.eq e e' /\ lt_list l l')
      end
  end.

Definition lt m m' := lt_list (this m) (this m').

Lemma eq_equal : forall m m', eq m m' <-> equal cmp m m' = true.
Proof.
 intros (l,Hl); induction l.
 intros (l',Hl'); unfold eq; simpl.
 destruct l'; unfold equal; simpl; intuition.
 intros (l',Hl'); unfold eq.
 destruct l'.
 destruct a; unfold equal; simpl; intuition.
 destruct a as (x,e).
 destruct p as (x',e').
 unfold equal; simpl.
 destruct (X.compare x x') as [Hlt|Heq|Hlt]; simpl; intuition.
 unfold cmp at 1.
 MD.elim_comp; clear H; simpl.
 inversion_clear Hl.
 inversion_clear Hl'.
 destruct (IHl H (Build_slist H3)).
 unfold equal, eq in H5; simpl in H5; auto.
 destruct (andb_prop _ _ H); clear H.
 generalize H0; unfold cmp.
 MD.elim_comp; auto; intro; discriminate.
 destruct (andb_prop _ _ H); clear H.
 inversion_clear Hl.
 inversion_clear Hl'.
 destruct (IHl H (Build_slist H3)).
 unfold equal, eq in H6; simpl in H6; auto.
Qed.

Lemma eq_1 : forall m m', Equivb cmp m m' -> eq m m'.
Proof.
 intros.
 generalize (@equal_1 D.t m m' cmp).
 generalize (@eq_equal m m').
 intuition.
Qed.

Lemma eq_2 : forall m m', eq m m' -> Equivb cmp m m'.
Proof.
 intros.
 generalize (@equal_2 D.t m m' cmp).
 generalize (@eq_equal m m').
 intuition.
Qed.

Lemma eq_refl : forall m : t, eq m m.
Proof.
 intros (m,Hm); induction m; unfold eq; simpl; auto.
 destruct a.
 destruct (X.compare t0 t0) as [Hlt|Heq|Hlt]; auto.
 apply (MapS.Raw.MX.lt_antirefl Hlt); auto.
 split.
 apply D.eq_refl.
 inversion_clear Hm.
 apply (IHm H).
 apply (MapS.Raw.MX.lt_antirefl Hlt); auto.
Qed.

Lemma eq_sym : forall m1 m2 : t, eq m1 m2 -> eq m2 m1.
Proof.
 intros (m,Hm); induction m;
 intros (m', Hm'); destruct m'; unfold eq; simpl;
 try destruct a as (x,e); try destruct p as (x',e'); auto.
 destruct (X.compare x x')  as [Hlt|Heq|Hlt]; MapS.Raw.MX.elim_comp; intuition.
 inversion_clear Hm; inversion_clear Hm'.
 apply (IHm H0 (Build_slist H4)); auto.
Qed.

Lemma eq_trans : forall m1 m2 m3 : t, eq m1 m2 -> eq m2 m3 -> eq m1 m3.
Proof.
 intros (m1,Hm1); induction m1;
 intros (m2, Hm2); destruct m2;
 intros (m3, Hm3); destruct m3; unfold eq; simpl;
 try destruct a as (x,e);
 try destruct p as (x',e');
 try destruct p0 as (x'',e''); try contradiction; auto.
 destruct (X.compare x x') as [Hlt|Heq|Hlt];
  destruct (X.compare x' x'') as [Hlt'|Heq'|Hlt'];
   MapS.Raw.MX.elim_comp; intuition.
 apply D.eq_trans with e'; auto.
 inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
 apply (IHm1 H1 (Build_slist H6) (Build_slist H8)); intuition.
Qed.

Lemma lt_trans : forall m1 m2 m3 : t, lt m1 m2 -> lt m2 m3 -> lt m1 m3.
Proof.
 intros (m1,Hm1); induction m1;
 intros (m2, Hm2); destruct m2;
 intros (m3, Hm3); destruct m3; unfold lt; simpl;
 try destruct a as (x,e);
 try destruct p as (x',e');
 try destruct p0 as (x'',e''); try contradiction; auto.
 destruct (X.compare x x') as [Hlt|Heq|Hlt];
  destruct (X.compare x' x'') as [Hlt'|Heq'|Hlt'];
   MapS.Raw.MX.elim_comp; intuition.
 left; apply D.lt_trans with e'; auto.
 left; apply lt_eq with e'; auto.
 left; apply eq_lt with e'; auto.
 right.
 split.
 apply D.eq_trans with e'; auto.
 inversion_clear Hm1; inversion_clear Hm2; inversion_clear Hm3.
 apply (IHm1 H2 (Build_slist H6) (Build_slist H8)); intuition.
Qed.

Lemma lt_not_eq : forall m1 m2 : t, lt m1 m2 -> ~ eq m1 m2.
Proof.
 intros (m1,Hm1); induction m1;
 intros (m2, Hm2); destruct m2; unfold eq, lt; simpl;
 try destruct a as (x,e);
 try destruct p as (x',e'); try contradiction; auto.
 destruct (X.compare x x') as [Hlt|Heq|Hlt]; auto.
 intuition.
 exact (D.lt_not_eq H0 H1).
 inversion_clear Hm1; inversion_clear Hm2.
 apply (IHm1 H0 (Build_slist H5)); intuition.
Qed.

Ltac cmp_solve := unfold eq, lt; simpl; try Raw.MX.elim_comp; auto with ordered_type.

Definition compare : forall m1 m2, Compare lt eq m1 m2.
Proof.
 intros (m1,Hm1); induction m1;
 intros (m2, Hm2); destruct m2;
  [ apply EQ | apply LT | apply GT | ]; cmp_solve.
 destruct a as (x,e); destruct p as (x',e').
 destruct (X.compare x x');
  [ apply LT | | apply GT ]; cmp_solve.
 destruct (D.compare e e');
  [ apply LT | | apply GT ]; cmp_solve.
 assert (Hm11 : sort (Raw.PX.ltk (elt:=D.t)) m1).
  inversion_clear Hm1; auto.
 assert (Hm22 : sort (Raw.PX.ltk (elt:=D.t)) m2).
  inversion_clear Hm2; auto.
 destruct (IHm1 Hm11 (Build_slist Hm22));
  [ apply LT | apply EQ | apply GT ]; cmp_solve.
Qed.

End Make_ord.


Require Import FP.Structures.Proxy.
Require Import FP.Relations.Setoid.
Require Import FP.Structures.EqvEnv.

Import ProperNotation.

Class Feq T :=
  { feq : T -> T -> Prop }.
Definition Feq_Px {T} {Feq_:Feq T} : Px (Feq T) := Feq_.
Definition Px_Feq {T} {Px_:Px (Feq T)} : Feq T := Px_.
Hint Resolve Feq_Px : typeclass_instances.
Hint Immediate Px_Feq : typeclass_instances.

Class Feq_E_WF T {Feq_:Feq T} :=
  { feq_E_WF : Equivalence feq }.
Class Feq_PE_WF T {Feq_:Feq T} :=
  { feq_PE_WF : PER feq }.
Definition Feq_PE_WF_Px {T} {Feq_:Feq T} {Feq_PE_WF_:Feq_PE_WF T}
    : Px (Feq_PE_WF T) := Feq_PE_WF_.
Definition Px_Feq_PE_WF {T} {Feq_:Feq T} {Px_:Px (Feq_PE_WF T)}
    : Feq_PE_WF T := Px_.
Hint Resolve Feq_PE_WF_Px : typeclass_instances.
Hint Immediate Px_Feq_PE_WF : typeclass_instances.

Class FeqIsEq T {Feq_:Feq T} :=
  { feq_is_eq :  feq = eq }.

Definition feq_EqvEnv : EqvEnv :=
  {| env_PER := @Feq
  ;  env_eqv := fun T (p:Px (Feq T)) => feq
  ;  env_PER_WF := fun T (p:Px (Feq T)) => Feq_PE_WF T
  ;  env_eqv_WF := fun T (p:Px (Feq T)) (pwf:Px (Feq_PE_WF T)) => feq_PE_WF
  |}.

Section Fun_Feq.
  Context {A} {aF:Feq A} {B} {bF:Feq B}.
  Global Instance Fun_Feq : Feq (A -> B) | 9 :=
    { feq := (feq ==> feq) }.

  Variable (aPEWF:Feq_PE_WF A) (bPEWF:Feq_PE_WF B).
  Global Instance Fun_Feq_PE_WF : Feq_PE_WF (A -> B) | 9.
  Proof.
    inversion aPEWF ; inversion bPEWF.
    repeat econstructor.
    - unfold Symmetric ; intros.
      simpl in * ; unfold "==>" in * ; intros.
      symmetry.
      apply H.
      symmetry.
      exact H0.
    - unfold Transitive ; intros.
      transitivity y ; simpl in * ; unfold "==>" in * ; intros ; auto.
  Qed.
End Fun_Feq.
Section Univ_Feq.
  Context {A:Type}.
  Local Instance Univ_Feq : Feq A | 10 :=
    { feq := eq }.
  Local Instance Univ_Feq_PE_WF : Feq_PE_WF A | 10.
  Proof.
    repeat econstructor ; simpl ; auto ; unfold Transitive ; intros ; subst ; auto.
  Qed.
End Univ_Feq.

Section Feq_EqvEnvLogical.
  Definition feq_EqvEnvLogical : EqvEnvLogical (EqvEnv_:=feq_EqvEnv).
  Proof.
    econstructor ; intros.
    apply Fun_Feq_PE_WF ; auto.
    simpl ; auto.
    simpl in H ; auto.
  Qed.
End Feq_EqvEnvLogical.


(*
 * SPDX-License-Identifier: MIT
 *
 *)
From Coq Require Import
     String
     Sumbool
     Morphisms.

From SPICY Require Import
     MyPrelude
     Maps
     Tactics.

Set Implicit Arguments.

Definition key_identifier := nat.
Definition key_permission : Set := key_identifier * bool.

Inductive key_usage :=
| Encryption
| Signing.

Inductive key_type :=
| SymKey
| AsymKey.

Record key :=
  MkCryptoKey { keyId    : key_identifier
              ; keyUsage : key_usage
              ; keyType  : key_type
              }.

Lemma key_usage_eq_dec :
  forall u1 u2 : key_usage, { u1 = u2 } + { u1 <> u2 }.
  decide equality.
Defined.

Lemma key_type_eq_dec :
  forall kt1 kt2 : key_type, { kt1 = kt2 } + { kt1 <> kt2 }.
  decide equality.
Defined.

Lemma key_eq_dec :
  forall k1 k2 : key, { k1 = k2 } + { k1 <> k2 }.
  decide equality; auto using Nat.eq_dec, key_usage_eq_dec, key_type_eq_dec.
Defined.

Lemma key_permission_eq_dec :
  forall kp1 kp2 : key_permission, { kp1 = kp2 } + { kp1 <> kp2 }.
  decide equality; auto using Nat.eq_dec, Bool.bool_dec.
Defined.

Notation "x ==kk y" := (key_eq_dec x y) (right associativity, at level 75).
Notation "x ==ku y" := (key_usage_eq_dec x y) (right associativity, at level 75).
Notation "x ==kt y" := (key_type_eq_dec x y) (right associativity, at level 75).
Notation "x ==kp y" := (key_permission_eq_dec x y) (right associativity, at level 75).

Definition keys            := NatMap.t key.
Definition key_perms       := NatMap.t bool.

Definition greatest_permission (kp1 kp2 : bool) : bool :=
  kp1 || kp2.

Definition add_key_perm (k : key_identifier)(kp : bool) (perms : key_perms) : key_perms :=
    match perms $? k with
    | None     => perms $+ (k, kp)
    | Some kp' => perms $+ (k, greatest_permission kp kp')
    end.

Definition merge_perms (ks ks' : key_perms) : key_perms :=
  Map.fold add_key_perm ks ks'.

Notation "m1 $k++ m2" := (merge_perms m2 m1) (at level 50, left associativity).