The Coq Proof Assistant

The standard library



Version 7.0 1













Coq Development Project






















































V7.0,
©INRIA 1999-2001

The Coq standard library

This document is a short description of the Coq standard library. This library comes with the system as a complement of the core library (the Init library ; see the Reference Manual for a description of this library). It provides a set of modules directly available through the Require command.

The standard library is composed of the following subdirectories:

Logic Classical logic and dependent equality
Bool Booleans (basic functions and results)
Arith Basic Peano arithmetic
Zarith Basic integer arithmetic
Reals Axiomatization of Real Numbers (classical, basic functions and results, integer part and fractional part, requires the Zarith library).
Lists Monomorphic and polymorphic lists (basic functions and results), Streams (infinite sequences defined with co-inductive types)
Sets Sets (classical, constructive, finite, infinite, power set, etc.)
Relations Relations (definitions and basic results).
Wellfounded Well-founded relations (basic results).
IntMap Representation of finite sets by an efficient structure of map (trees indexed by binary integers).

Each of these subdirectories contains a set of modules, whose specifications (Gallina files) have been roughly, and automatically, pasted in the following pages. There is also a version of this document in HTML format on the WWW, which you can access from the Coq home page at http://pauillac.inria.fr/coq/coq-eng.html.

1   Logic

This library deals with classical logic and its properties. The main file is Classical.v.

This library also provides some facts on an equality which contains its own proof. See the file Eqdep.v.

Module Classical_Prop

Id: ClassicalProp.v,v 1.2 2001/03/15 13:38:50 filliatr Exp
Classical Propositional Logic
Hints Unfold not : core.

Axiom classic: (P:Prop)(P or not(P)).

Lemma NNPP : (p:Prop)not(not(p))®p.

Lemma not_imply_elim : (P,Q:Prop)not(P®Q)®P.

Lemma not_imply_elim2 : (P,Q:Prop)not(P®Q® notQ.

Lemma imply_to_or : (P,Q:Prop)(P®Q® notP or Q.

Lemma imply_to_and : (P,Q:Prop)not(P®Q® P & notQ.

Lemma or_to_imply : (P,Q:Prop)(notP or Q® P®Q.

Lemma not_and_or : (P,Q:Prop)not(P&Q)® notP or notQ.

Lemma or_not_and : (P,Q:Prop)(notP or notQ® not(P&Q).

Lemma not_or_and : (P,Q:Prop)not(PorQ)® notP & notQ.

Lemma and_not_or : (P,Q:Prop)(notP & notQ® not(PorQ).

Lemma imply_and_or: (P,Q:Prop)(P®Q® P or Q ® Q.

Lemma imply_and_or2: (P,Q,R:Prop)(P®Q® P or R ® Q or R.

Module Classical_Pred_Set

Id: ClassicalPredSet.v,v 1.2 2001/03/15 13:38:50 filliatr Exp
Classical Predicate Logic on Set
Require Classical_Prop.

Section Generic.
Variable USet.

de Morgan laws for quantifiers
Lemma not_all_ex_not : (P:U®Prop)(not(n:U)(P n)) ® (EX n:U | not(P n)).

Lemma not_all_not_ex : (P:U®Prop)(not(n:U)not(P n)) ® (EX n:U |(P n)).

Lemma not_ex_all_not : (P:U®Prop) (not(EX n:U |(P n))) ® (n:U)not(P n).

Lemma not_ex_not_all : (P:U®Prop)(not(EX n:U | not(P n))) ® (n:U)(P n).

Lemma ex_not_not_all : (P:U®Prop) (EX n:U | not(P n)) ® not(n:U)(P n).

Lemma all_not_not_ex : (P:U®Prop) ((n:U)not(P n)) ® not(EX n:U |(P n)).

End Generic.

Module Eqdep

Id: Eqdep.v,v 1.5 2001/03/15 13:38:50 filliatr Exp
Section Dependent_Equality.

Variable U : Set.
Variable P : U®Set.

Inductive eq_dep [p:U;x:(P p)] : (q:U)(P q)®Prop :=
     eq_dep_intro : (eq_dep p x p x).

Lemma eq_dep_sym : (p,q:U)(x:(P p))(y:(P q))(eq_dep p x q y)®(eq_dep q y p x).
Hints 
Lemma eq_dep_trans : (p,q,r:U)(x:(P p))(y:(P q))(z:(P r))
       (eq_dep p x q y)®(eq_dep q y r z)®(eq_dep p x r z).

Inductive eq_dep1 [p:U;x:(P p);q:U;y:(P q)] : Prop :=
     eq_dep1_intro : (h:q=p)
                   (x=(eq_rec U q P y p h))®(eq_dep1 p x q y).

Axiom eq_rec_eq : (p:U)(Q:U®Set)(x:(Q p))(h:p=p)
                   x=(eq_rec U p Q x p h).

Lemma eq_dep1_dep :
       (p:U)(x:(P p))(q:U)(y:(P q))(eq_dep1 p x q y)®(eq_dep p x q y).

Lemma eq_dep_dep1 : (p,q:U)(x:(P p))(y:(P q))(eq_dep p x q y)®(eq_dep1 p x q y).

Lemma eq_dep1_eq : (p:U)(x,y:(P p))(eq_dep1 p x p y)®x=y.

Lemma eq_dep_eq : (p:U)(x,y:(P p))(eq_dep p x p y)®x=y.

Lemma equiv_eqex_eqdep : (p,q:U)(x:(P p))(y:(P q)) 
     (existS U P p x)=(existS U P q y« (eq_dep p x q y).

Lemma inj_pair2: (p:U)(x,y:(P p))
     (existS U P p x)=(existS U P p y)® x=y.

End Dependent_Equality.

Hints Resolve eq_dep_intro : core v62.
Hints 

Module Classical_Type

Id: ClassicalType.v,v 1.2 2001/03/15 13:38:50 filliatr Exp
Classical Logic for Type
Require Export Classical_Prop.
Require Export Classical_Pred_Type.

Module Classical_Pred_Type

Id: ClassicalPredType.v,v 1.2 2001/03/15 13:38:50 filliatr Exp
Classical Predicate Logic on Type
Require Classical_Prop.

Section Generic.
Variable UType.

de Morgan laws for quantifiers
Lemma not_all_ex_not : (P:U®Prop)(not(n:U)(P n)) ® (EXT n:U | not(P n)).

Lemma not_all_not_ex : (P:U®Prop)(not(n:U)not(P n)) ® (EXT n:U | (P n)).

Lemma not_ex_all_not : (P:U®Prop)(not(EXT n:U | (P n))) ® (n:U)not(P n).

Lemma not_ex_not_all : (P:U®Prop)(not(EXT n:U | not(P n))) ® (n:U)(P n).

Lemma ex_not_not_all : (P:U®Prop) (EXT n:U | not(P n)) ® not(n:U)(P n).

Lemma all_not_not_ex : (P:U®Prop) ((n:U)not(P n)) ® not(EXT n:U | (P n)).

End Generic.

Module Classical

Id: Classical.v,v 1.2 2001/03/15 13:38:50 filliatr Exp
Classical Logic
Require Export Classical_Prop.
Require Export Classical_Pred_Set.

Module Eqdep_dec

Id: Eqdepdec.v,v 1.8 2001/04/11 12:41:40 filliatr Exp
We prove that there is only one proof of x=x, i.e (refl_equal ? x). This holds if the equality upon the set of x is decidable. A corollary of this theorem is the equality of the right projections of two equal dependent pairs.

Author: Thomas Kleymann <tms@dcs.ed.ac.uk> in Lego adapted to Coq by B. Barras Credit: Proofs up to K_dec follows an outline by Michael Hedberg


We need some dependent elimination schemes
Scheme eq_indd := Induction for eq Sort Prop.
Scheme eqT_indd := Induction for eqT Sort Prop.
Scheme or_indd := Induction for or Sort Prop.

Implicit Arguments On.

Bijection between eq and eqT
Definition eq2eqT: (A:Set)(x,y:A)x=y®x==y :=
     [A,x,_,eqxy]<[y:A]x==y>Cases eqxy of refl_equal Þ (refl_eqT ? xend.

Definition eqT2eq: (A:Set)(x,y:A)x==y®x=y :=
     [A,x,_,eqTxy]<[y:A]x=y>Cases eqTxy of refl_eqT Þ (refl_equal ? xend.

Lemma eq_eqT_bij: (A:Set)(x,y:A)(p:x=y)p==(eqT2eq (eq2eqT p)).

Lemma eqT_eq_bij: (A:Set)(x,y:A)(p:x==y)p==(eq2eqT (eqT2eq p)).

Section DecidableEqDep.

Variable AType.

Local comp [x,y,y':A]: x==y®x==y'®y==y' :=
     [eq1,eq2](eqT_ind ? ? [a]a==y' eq2 ? eq1).

Remark trans_sym_eqT: (x,y:A)(u:x==y)(comp u u)==(refl_eqT ? y).

Variable eq_dec: (x,y:Ax==y or notx==y.

Variable xA.

Local nu [y:A]: x==y®x==y :=
     [u]Cases (eq_dec x yof
         (or_introl eqxyÞ eqxy
       | (or_intror neqxyÞ (False_ind ? (neqxy u))
       end.

Local nu_constant : (y:A)(u,v:x==y) (nu u)==(nu v).
Intros.
Unfold nu.
Elim (eq_dec x yusing or_inddIntros.
Reflexivity.

Case bTrivial.
Save.

Local nu_inv [y:A]: x==y®x==y := [v](comp (nu (refl_eqT ? x)) v).

Remark nu_left_inv : (y:A)(u:x==y) (nu_inv (nu u))==u.

Theorem eq_proofs_unicity: (y:A)(p1,p2:x==yp1==p2.

Theorem K_dec: (P:x==x®Prop)(P (refl_eqT ? x)) ® (p:x==x)(P p).

The corollary
Local proj: (P:A®Prop)(ExT P)®(P x)®(P x) :=
     [P,exP,def]Cases exP of
       (exT_intro x' prfÞ
         Cases (eq_dec x' xof
           (or_introl eqprfÞ (eqT_ind ? x' P prf x eqprf)
         | _ Þ def
         end
       end.

Theorem inj_right_pair: (P:A®Prop)(y,y':(P x))
     (exT_intro ? P x y)==(exT_intro ? P x y'® y==y'.

End DecidableEqDep.

We deduce the K axiom for (decidable) Set
Theorem K_dec_set: (A:Set)((x,y:A){x=y}+{notx=y})
                         ®(x:A)(Px=x®Prop)(P (refl_equal ? x))
                           ®(p:x=x)(P p).

Module Decidable

Definition decidable := [P:PropP or notP.

Theorem dec_not_not : (P:Prop)(decidable P® (notP ® False® P.

Theorem dec_True: (decidable True).

Theorem dec_False: (decidable False).

Theorem dec_or: (A,B:Prop)(decidable A® (decidable B® (decidable (AorB)).

Theorem dec_and: (A,B:Prop)(decidable A® (decidable B®(decidable (A&B)).

Theorem dec_not: (A:Prop)(decidable A® (decidable notA).

Theorem dec_imp: (A,B:Prop)(decidable A® (decidable B®(decidable (A®B)).

Theorem not_not : (P:Prop)(decidable P® (not(notP)) ® P.

Theorem not_or : (A,B:Propnot(AorB® notA & notB.

Theorem not_and : (A,B:Prop) (decidable A® not(A&B® notA or notB.

Theorem not_imp : (A,B:Prop) (decidable A® not(A ® B® A & notB.

Theorem imp_simp : (A,B:Prop) (decidable A® (A ® B® notA or B.

2   Bool

The BOOL library includes the following files:

Module Zerob

Id: Zerob.v,v 1.3 2001/03/15 13:38:49 filliatr Exp
Require Arith.
Require Bool.

Definition zerob : nat®bool 
       := [n:nat]Cases n of O Þ true | (S _) Þ false end.

Lemma zerob_true_intro : (n:nat)(n=O)®(zerob n)=true.
Hints Resolve zerob_true_intro : bool.

Lemma zerob_true_elim : (n:nat)(zerob n)=true®(n=O).

Lemma zerob_false_intro : (n:nat)not(n=O)®(zerob n)=false.
Hints Resolve zerob_false_intro : bool.

Lemma zerob_false_elim : (n:nat)(zerob n)=false ® not(n=O).

Module IfProp

Id: IfProp.v,v 1.2 2001/03/15 13:38:49 filliatr Exp
Require Bool.

Inductive IfProp [A,B:Prop] : bool® Prop
   := Iftrue : A ® (IfProp A B true)
   | Iffalse : B ® (IfProp A B false).

Hints Resolve Iftrue Iffalse : bool v62.

Lemma Iftrue_inv : (A,B:Prop)(b:bool) (IfProp A B b® b=true ® A.

Lemma Iffalse_inv : (A,B:Prop)(b:bool) (IfProp A B b® b=false ® B.

Lemma IfProp_true : (A,B:Prop)(IfProp A B true® A.

Lemma Ifprop_false : (A,B:Prop)(IfProp A B false® B.

Lemma IfProp_or : (A,B:Prop)(b:bool)(IfProp A B b® AorB.

Lemma IfProp_sum : (A,B:Prop)(b:bool)(IfProp A B b® {A}+{B}.

Module DecBool

Id: DecBool.v,v 1.2 2001/03/15 13:38:49 filliatr Exp
Implicit Arguments On.

Definition ifdec : (A,B:Prop)(C:Set)({A}+{B})®C®C®C
     := [A,B,C,H,x,y]if H then [_]x else [_]y.

Theorem ifdec_left : (A,B:Prop)(C:Set)(H:{A}+{B})notB®(x,y:C)(ifdec H x y)=x.

Theorem ifdec_right : (A,B:Prop)(C:Set)(H:{A}+{B})notA®(x,y:C)(ifdec H x y)=y.

Implicit Arguments Off.

Module Bool

Id: Bool.v,v 1.8 2001/03/30 15:04:59 mohring Exp
Booleans
The type bool is defined in the prelude as
Inductive bool : Set := true : bool | false : bool (from Prelude)
Interpretation of booleans as Propopsition
Definition Is_true := [b:bool](Cases b of
                                   true Þ True
                                 | false Þ False
                                 end).
Hints Unfold Is_true : bool.

Lemma Is_true_eq_left : (x:bool)x=true ® (Is_true x).

Lemma Is_true_eq_right : (x:bool)true=x ® (Is_true x).

Hints 
(*******************)
(*s Discrimination *)
(*******************)

Lemma diff_true_false : nottrue=false.
Hints Resolve diff_true_false : bool v62.

Lemma diff_false_true : notfalse=true.
Hints Resolve diff_false_true : bool v62.

Lemma eq_true_false_abs : (b:bool)(b=true)®(b=false)®False.
Hints Resolve eq_true_false_abs : bool.

Lemma not_true_is_false : (b:bool)notb=true®b=false.

Lemma not_false_is_true : (b:bool)notb=false®b=true.
Order on booleans
Definition leb := [b1,b2:bool]
   Cases b1 of
   | true Þ b2=true
   | false Þ True
   end.
Hints Unfold leb : bool v62.
Equality
Definition eqb : bool®bool®bool :=
   [b1,b2:bool]
     Cases b1 b2 of
       true true Þ true
     | true false Þ false
     | false true Þ false
     | false false Þ true
     end.

Lemma eqb_refl : (x:bool)(Is_true (eqb x x)).

Lemma eqb_eq : (x,y:bool)(Is_true (eqb x y))®x=y.

Lemma Is_true_eq_true : (x:bool) (Is_true x® x=true.

Lemma Is_true_eq_true2 : (x:boolx=true ® (Is_true x).

Lemma eqb_subst : 
   (P:bool®Prop)(b1,b2:bool)(eqb b1 b2)=true®(P b1)®(P b2).

Lemma eqb_reflx : (b:bool)(eqb b b)=true.

Lemma eqb_prop : (a,b:bool)(eqb a b)=true ® a=b.
Logical combinators
Definition ifb : bool ® bool ® bool ® bool
       := [b1,b2,b3:bool](Cases b1 of true Þ b2 | false Þ b3 end).

Definition andb : bool ® bool ® bool
       := [b1,b2:bool](ifb b1 b2 false).

Definition orb : bool ® bool ® bool
       := [b1,b2:bool](ifb b1 true b2).

Definition implb : bool ® bool ® bool
       := [b1,b2:bool](ifb b1 b2 true).

Definition xorb : bool ® bool ® bool
       := [b1,b2:bool]
     Cases b1 b2 of
       true true Þ false
     | true false Þ true
     | false true Þ true
     | false false Þ false
     end.

Definition negb := [b:bool]Cases b of
                               true Þ false
                             | false Þ true
                             end.
Lemmas about negb
Lemma negb_intro : (b:bool)b=(negb (negb b)).

Lemma negb_elim : (b:bool)(negb (negb b))=b.

Lemma negb_orb : (b1,b2:bool)
   (negb (orb b1 b2)) = (andb (negb b1) (negb b2)).

Lemma negb_andb : (b1,b2:bool)
   (negb (andb b1 b2)) = (orb (negb b1) (negb b2)).

Lemma negb_sym : (b,b':bool)(b'=(negb b))®(b=(negb b')).

Lemma no_fixpoint_negb : (b:bool)not(negb b)=b.

Lemma eqb_negb1 : (b:bool)(eqb (negb bb)=false.

Lemma eqb_negb2 : (b:bool)(eqb b (negb b))=false.

Lemma if_negb : (A:Set) (b:bool) (x,y:A) (if (negb bthen x else y)=(if b then y else x).
A few lemmas about or
Lemma orb_prop : 
   (a,b:bool)(orb a b)=true ® (a = true)or(b = true).

Lemma orb_prop2 : 
   (a,b:bool)(Is_true (orb a b)) ® (Is_true a)or(Is_true b).

Lemma orb_true_intro 
     : (b1,b2:bool)(b1=true)or(b2=true)®(orb b1 b2)=true.
Hints Resolve orb_true_intro : bool v62.

Lemma orb_b_true : (b:bool)(orb b true)=true.
Hints Resolve orb_b_true : bool v62.

Lemma orb_true_b : (b:bool)(orb true b)=true.

Lemma orb_true_elim : (b1,b2:bool)(orb b1 b2)=true ® {b1=true}+{b2=true}.
Lemma orb_false_intro 
     : (b1,b2:bool)(b1=false)®(b2=false)®(orb b1 b2)=false.
Hints Resolve orb_false_intro : bool v62.

Lemma orb_b_false : (b:bool)(orb b false)=b.
Hints Resolve orb_b_false : bool v62.

Lemma orb_false_b : (b:bool)(orb false b)=b.
Hints Resolve orb_false_b : bool v62.

Lemma orb_false_elim : 
     (b1,b2:bool)(orb b1 b2)=false ® (b1=false)&(b2=false).

Lemma orb_neg_b :
   (b:bool)(orb b (negb b))=true.
Hints Resolve orb_neg_b : bool v62.

Lemma orb_sym : (b1,b2:bool)(orb b1 b2)=(orb b2 b1).

Lemma orb_assoc : (b1,b2,b3:bool)(orb b1 (orb b2 b3))=(orb (orb b1 b2b3).

Hints Resolve orb_sym orb_assoc orb_b_false orb_false_b : bool v62.
A few lemmas about and
Lemma andb_prop : 
   (a,b:bool)(andb a b) = true ® (a = true)&(b = true).
Hints Resolve andb_prop : bool v62.

Lemma andb_prop2 : 
   (a,b:bool)(Is_true (andb a b)) ® (Is_true a)&(Is_true b).
Hints Resolve andb_prop2 : bool v62.

Lemma andb_true_intro : (b1,b2:bool)(b1=true)&(b2=true)®(andb b1 b2)=true.
Hints Resolve andb_true_intro : bool v62.

Lemma andb_true_intro2 : 
   (b1,b2:bool)(Is_true b1)®(Is_true b2)®(Is_true (andb b1 b2)).
Hints Resolve andb_true_intro2 : bool v62.

Lemma andb_false_intro1 
     : (b1,b2:bool)(b1=false)®(andb b1 b2)=false.

Lemma andb_false_intro2 
     : (b1,b2:bool)(b2=false)®(andb b1 b2)=false.

Lemma andb_b_false : (b:bool)(andb b false)=false.

Lemma andb_false_b : (b:bool)(andb false b)=false.

Lemma andb_b_true : (b:bool)(andb b true)=b.

Lemma andb_true_b : (b:bool)(andb true b)=b.

Lemma andb_false_elim : 
     (b1,b2:bool)(andb b1 b2)=false ® {b1=false}+{b2=false}.
Hints Resolve andb_false_elim : bool v62.

Lemma andb_neg_b :
     (b:bool)(andb b (negb b))=false.
Hints Resolve andb_neg_b : bool v62.

Lemma andb_sym : (b1,b2:bool)(andb b1 b2)=(andb b2 b1).

Lemma andb_assoc : (b1,b2,b3:bool)(andb b1 (andb b2 b3))=(andb (andb b1 b2b3).

Hints Resolve andb_sym andb_assoc : bool v62.
Properties of xorb
Lemma xorb_false : (b:bool) (xorb b false)=b.

Lemma false_xorb : (b:bool) (xorb false b)=b.

Lemma xorb_true : (b:bool) (xorb b true)=(negb b).

Lemma true_xorb : (b:bool) (xorb true b)=(negb b).

Lemma xorb_nilpotent : (b:bool) (xorb b b)=false.

Lemma xorb_comm : (b,b':bool) (xorb b b')=(xorb b' b).

Lemma xorb_assoc : (b,b',b'':bool) (xorb (xorb b b'b'')=(xorb b (xorb b' b'')).

Lemma xorb_eq : (b,b':bool) (xorb b b')=false ® b=b'.

Lemma xorb_move_l_r_1 : (b,b',b'':bool) (xorb b b')=b'' ® b'=(xorb b b'').

Lemma xorb_move_l_r_2 : (b,b',b'':bool) (xorb b b')=b'' ® b=(xorb b'' b').

Lemma xorb_move_r_l_1 : (b,b',b'':boolb=(xorb b' b''® (xorb b' b)=b''.

Lemma xorb_move_r_l_2 : (b,b',b'':boolb=(xorb b' b''® (xorb b b'')=b'.
De Morgan's law
Lemma demorgan1 : (b1,b2,b3:bool)
   (andb b1 (orb b2 b3)) = (orb (andb b1 b2) (andb b1 b3)).

Lemma demorgan2 : (b1,b2,b3:bool)
   (andb (orb b1 b2b3) = (orb (andb b1 b3) (andb b2 b3)).

Lemma demorgan3 : (b1,b2,b3:bool)
   (orb b1 (andb b2 b3)) = (andb (orb b1 b2) (orb b1 b3)).

Lemma demorgan4 : (b1,b2,b3:bool)
   (orb (andb b1 b2b3) = (andb (orb b1 b3) (orb b2 b3)).

Lemma absoption_andb : (b1,b2:bool)
   (andb b1 (orb b1 b2)) = b1.

Lemma absoption_orb : (b1,b2:bool)
   (orb b1 (andb b1 b2)) = b1.

Module Sumbool

Id: Sumbool.v,v 1.2 2001/03/15 13:38:49 filliatr Exp
Here are collected some results about the type sumbool (see INIT/Specif.v)

(sumbool A B), which is written A+B, is the informative disjunction "A or B", where A and B are logical propositions. Its extraction is isomorphic to the type of booleans.


A boolean is either true or false, and this is decidable
Lemma sumbool_of_bool : (b:bool) {b=true}+{b=false}.

Hints Resolve sumbool_of_bool : bool.

pourquoi ce machin-la est dans BOOL et pas dans LOGIC ? Papageno
Logic connectives on type sumbool
Section connectives.

Variables A,B,C,D : Prop.

Hypothesis H1 : {A}+{B}.
Hypothesis H2 : {C}+{D}.

Lemma sumbool_and : {A&C}+{BorD}.

Lemma sumbool_or : {AorC}+{B&D}.

Lemma sumbool_not : {B}+{A}.

End connectives.

Hints Resolve sumbool_and sumbool_or sumbool_not : core.

3   Arith

The Arith library deals with various arithmetical notions and their properties.

Standard Arith library

The following files are automatically loaded by Require Arith.

Additional Arith library

Module Le

Id: Le.v,v 1.2 2001/03/15 13:38:48 filliatr Exp
Order on natural numbers
Theorem le_n_S : (n,m:nat)(le n m)®(le (S n) (S m)).

Theorem le_trans : (n,m,p:nat)(le n m)®(le m p)®(le n p).

Theorem le_n_Sn : (n:nat)(le n (S n)).

Theorem le_O_n : (n:nat)(le O n).

Hints Resolve le_n_S le_n_Sn le_O_n le_n_S le_trans : arith v62.

Theorem le_pred_n : (n:nat)(le (pred nn).
Hints Resolve le_pred_n : arith v62.

Theorem le_trans_S : (n,m:nat)(le (S nm)®(le n m).
Hints 
Theorem le_S_n : (n,m:nat)(le (S n) (S m))®(le n m).
Hints 
(* Negative properties *)

Theorem le_Sn_O : (n:nat)not(le (S nO).
Hints Resolve le_Sn_O : arith v62.

Theorem le_Sn_n : (n:nat)not(le (S nn).
Hints Resolve le_Sn_n : arith v62.

Theorem le_antisym : (n,m:nat)(le n m)®(le m n)®(n=m).
Hints 
Theorem le_n_O_eq : (n:nat)(le n O)®(O=n).
Hints 
(* A different elimination principle for the order on natural numbers *)

Lemma le_elim_rel : (P:nat®nat®Prop)
       ((p:nat)(P O p))®
       ((p,q:nat)(le p q)®(P p q)®(P (S p) (S q)))®
       (n,m:nat)(le n m)®(P n m).

Module Lt

Id: Lt.v,v 1.2 2001/03/15 13:38:48 filliatr Exp
Require Le.

Theorem lt_n_Sn : (n:nat)(lt n (S n)).
Hints Resolve lt_n_Sn : arith v62.

Theorem lt_S : (n,m:nat)(lt n m)®(lt n (S m)).
Hints Resolve lt_S : arith v62.

Theorem lt_n_S : (n,m:nat)(lt n m)®(lt (S n) (S m)).
Hints Resolve lt_n_S : arith v62.

Theorem lt_S_n : (n,m:nat)(lt (S n) (S m))®(lt n m).
Hints 
Theorem lt_O_Sn : (n:nat)(lt O (S n)).
Hints Resolve lt_O_Sn : arith v62.

Theorem lt_n_O : (n:nat)not(lt n O).
Hints Resolve lt_n_O : arith v62.

Theorem lt_n_n : (n:nat)not(lt n n).
Hints Resolve lt_n_n : arith v62.

Lemma S_pred : (n,m:nat)(lt m n)®(n=(S (pred n))).

Lemma lt_pred : (n,p:nat)(lt (S np)®(lt n (pred p)).
Hints 
Lemma lt_pred_n_n : (n:nat)(lt O n)®(lt (pred nn).
Hints Resolve lt_pred_n_n : arith v62.

Relationship between le and lt
Theorem lt_le_S : (n,p:nat)(lt n p)®(le (S np).
Hints 
Theorem lt_n_Sm_le : (n,m:nat)(lt n (S m))®(le n m).
Hints 
Theorem le_lt_n_Sm : (n,m:nat)(le n m)®(lt n (S m)).
Hints 
Theorem lt_le_weak : (n,m:nat)(lt n m)®(le n m).
Hints 
Theorem neq_O_lt : (n:nat)(notO=n)®(lt O n).
Hints 
Theorem lt_O_neq : (n:nat)(lt O n)®(notO=n).
Hints 
(* Transitivity properties *)

Theorem lt_trans : (n,m,p:nat)(lt n m)®(lt m p)®(lt n p).

Theorem lt_le_trans : (n,m,p:nat)(lt n m)®(le m p)®(lt n p).

Theorem le_lt_trans : (n,m,p:nat)(le n m)®(lt m p)®(lt n p).

Hints Resolve lt_trans lt_le_trans le_lt_trans : arith v62.

Theorem le_lt_or_eq : (n,m:nat)(le n m)®((lt n mor n=m).

Theorem le_or_lt : (n,m:nat)((le n m)or(lt m n)).

Theorem le_not_lt : (n,m:nat)(le n m® not(lt m n).

Theorem lt_not_le : (n,m:nat)(lt n m® not(le m n).
Hints 
Theorem lt_not_sym : (n,m:nat)(lt n m® not(lt m n).

Theorem nat_total_order: (m,nnatnot m = n ® (lt m nor (lt n m).

Module Plus

Id: Plus.v,v 1.3 2001/04/08 17:18:08 mohring Exp
Properties of addition
Require Le.
Require Lt.

Lemma plus_sym : (n,m:nat)(plus n m)=(plus m n).
Hints 
Lemma plus_Snm_nSm : 
   (n,m:nat)(plus (S nm)=(plus n (S m)).

Lemma simpl_plus_l : (n,m,p:nat)((plus n m)=(plus n p))®(m=p).

Lemma plus_assoc_l : (n,m,p:nat)((plus n (plus m p))=(plus (plus n mp)).
Hints Resolve plus_assoc_l : arith v62.

Lemma plus_permute : (n,m,p:nat) ((plus n (plus m p))=(plus m (plus n p))).

Lemma plus_assoc_r : (n,m,p:nat)((plus (plus n mp)=(plus n (plus m p))).
Hints Resolve plus_assoc_r : arith v62.

Lemma simpl_le_plus_l : (p,n,m:nat)(le (plus p n) (plus p m))®(le n m).

Lemma le_reg_l : (n,m,p:nat)(le n m)®(le (plus p n) (plus p m)).
Hints Resolve le_reg_l : arith v62.

Lemma le_reg_r : (a,b,c:nat) (le a b)®(le (plus a c) (plus b c)).
Hints Resolve le_reg_r : arith v62.

Lemma le_plus_plus : 
         (n,m,p,q:nat) (le n m)®(le p q)®(le (plus n p) (plus m q)).

Lemma le_plus_l : (n,m:nat)(le n (plus n m)).
Hints Resolve le_plus_l : arith v62.

Lemma le_plus_r : (n,m:nat)(le m (plus n m)).
Hints Resolve le_plus_r : arith v62.

Theorem le_plus_trans : (n,m,p:nat)(le n m)®(le n (plus m p)).
Hints Resolve le_plus_trans : arith v62.

Lemma simpl_lt_plus_l : (n,m,p:nat)(lt (plus p n) (plus p m))®(lt n m).

Lemma lt_reg_l : (n,m,p:nat)(lt n m)®(lt (plus p n) (plus p m)).
Hints Resolve lt_reg_l : arith v62.

Lemma lt_reg_r : (n,m,p:nat)(lt n m® (lt (plus n p) (plus m p)).
Hints Resolve lt_reg_r : arith v62.

Theorem lt_plus_trans : (n,m,p:nat)(lt n m)®(lt n (plus m p)).
Hints 
Lemma le_lt_plus_plus : (n,m,p,q:nat) (le n m)®(lt p q)®(lt (plus n p) (plus m q)).

Lemma lt_le_plus_plus : (n,m,p,q:nat) (lt n m)®(le p q)®(lt (plus n p) (plus m q)).

Lemma lt_plus_plus : (n,m,p,q:nat) (lt n m)®(lt p q)®(lt (plus n p) (plus m q)).

Lemma plus_is_O : (m,n:nat) (plus m n)=O ® m=O & n=O.

Lemma plus_is_one : (m,n:nat) (plus m n)=(S O® {m=O & n=(S O)}+{m=(S O) & n=O}.

Lemma plus_permute_2_in_4 : (a,b,c,d:nat)
       (plus (plus a b) (plus c d))=(plus (plus a c) (plus b d)).

Module Gt

Id: Gt.v,v 1.2 2001/03/15 13:38:48 filliatr Exp
Require Le.
Require Lt.
Require Plus.

Theorem gt_Sn_O : (n:nat)(gt (S nO).
Hints Resolve gt_Sn_O : arith v62.

Theorem gt_Sn_n : (n:nat)(gt (S nn).
Hints Resolve gt_Sn_n : arith v62.

Theorem le_S_gt : (n,m:nat)(le (S nm)®(gt m n).
Hints 
Theorem gt_n_S : (n,m:nat)(gt n m)®(gt (S n) (S m)).
Hints Resolve gt_n_S : arith v62.

Theorem gt_trans_S : (n,m,p:nat)(gt (S nm)®(gt m p)®(gt n p).

Theorem le_gt_trans : (n,m,p:nat)(le m n)®(gt m p)®(gt n p).

Theorem gt_le_trans : (n,m,p:nat)(gt n m)®(le p m)®(gt n p).

Hints Resolve gt_trans_S le_gt_trans gt_le_trans : arith v62.

Lemma le_not_gt : (n,m:nat)(le n m® not(gt n m).
Hints Resolve le_not_gt : arith v62.

Lemma gt_antirefl : (n:nat)not(gt n n).
Hints Resolve gt_antirefl : arith v62.

Lemma gt_not_sym : (n,m:nat)(gt n m® not(gt m n).

Lemma gt_not_le : (n,m:nat)(gt n m® not(le n m).
Hints Resolve gt_not_sym gt_not_le : arith v62.

Lemma gt_trans : (n,m,p:nat)(gt n m)®(gt m p)®(gt n p).

Lemma gt_S_n : (n,p:nat)(gt (S p) (S n))®(gt p n).
Hints 
Lemma gt_S_le : (n,p:nat)(gt (S pn)®(le n p).
Hints 
Lemma gt_le_S : (n,p:nat)(gt p n)®(le (S np).
Hints Resolve gt_le_S : arith v62.

Lemma le_gt_S : (n,p:nat)(le n p)®(gt (S pn).
Hints Resolve le_gt_S : arith v62.

Lemma gt_pred : (n,p:nat)(gt p (S n))®(gt (pred pn).
Hints 
Theorem gt_S : (n,m:nat)(gt (S nm)®((gt n m)or(<nat>m=n)).

Theorem gt_O_eq : (n:nat)((gt n O)or(<nat>O=n)).

Lemma simpl_gt_plus_l : (n,m,p:nat)(gt (plus p n) (plus p m))®(gt n m).

Lemma gt_reg_l : (n,m,p:nat)(gt n m)®(gt (plus p n) (plus p m)).
Hints Resolve gt_reg_l : arith v62.

Module Minus

Id: Minus.v,v 1.3 2001/04/08 17:18:08 mohring Exp
Subtraction (difference between two natural numbers
Require Lt.
Require Le.

Fixpoint minus [n:nat] : nat ® nat :=
   [m:nat]Cases n m of
             O _ Þ O
           | (S kO Þ (S k)
           | (S k) (S lÞ (minus k l)
         end.

Lemma minus_plus_simpl : 
         (n,m,p:nat)((minus n m)=(minus (plus p n) (plus p m))).
Hints Resolve minus_plus_simpl : arith v62.

Lemma minus_n_O : (n:nat)(n=(minus n O)).
Hints Resolve minus_n_O : arith v62.

Lemma minus_n_n : (n:nat)(O=(minus n n)).
Hints Resolve minus_n_n : arith v62.

Lemma plus_minus : (n,m,p:nat)(n=(plus m p))®(p=(minus n m)).
Hints 
Lemma minus_plus : (n,m:nat)(minus (plus n mn)=m.
Hints Resolve minus_plus : arith v62.

Lemma le_plus_minus : (n,m:nat)(le n m)®(m=(plus n (minus m n))).
Hints Resolve le_plus_minus : arith v62.

Lemma le_plus_minus_r : (n,m:nat)(le n m)®(plus n (minus m n))=m.
Hints Resolve le_plus_minus_r : arith v62.

Lemma minus_Sn_m : (n,m:nat)(le m n)®((S (minus n m))=(minus (S nm)).
Hints Resolve minus_Sn_m : arith v62.

Lemma lt_minus : (n,m:nat)(le m n)®(lt O m)®(lt (minus n mn).
Hints Resolve lt_minus : arith v62.

Lemma lt_O_minus_lt : (n,m:nat)(lt O (minus n m))®(lt m n).
Hints 
Theorem pred_of_minus : (x:nat)(pred x)=(minus x (S O)).

Theorem inj_minus_aux: (x,y:natnot(le y x® (minus x y) = O.

Module Mult

Id: Mult.v,v 1.3 2001/04/08 17:18:08 mohring Exp
Require Export Plus.
Require Export Minus.
Require Export Lt.

Multiplication
Lemma mult_plus_distr : 
       (n,m,p:nat)((mult (plus n mp)=(plus (mult n p) (mult m p))).
Hints Resolve mult_plus_distr : arith v62.

Lemma mult_plus_distr_r : (n,m,p:nat) (mult n (plus m p))=(plus (mult n m) (mult n p)).

Lemma mult_minus_distr : (n,m,p:nat)((mult (minus n mp)=(minus (mult n p) (mult m p))).
Hints Resolve mult_minus_distr : arith v62.

Lemma mult_O_le : (n,m:nat)(m=O)or(le n (mult m n)).
Hints Resolve mult_O_le : arith v62.

Lemma mult_assoc_r : (n,m,p:nat)((mult (mult n mp) = (mult n (mult m p))).
Hints Resolve mult_assoc_r : arith v62.

Lemma mult_assoc_l : (n,m,p:nat)(mult n (mult m p)) = (mult (mult n mp).
Hints Resolve mult_assoc_l : arith v62.

Lemma mult_1_n : (n:nat)(mult (S On)=n.
Hints Resolve mult_1_n : arith v62.

Lemma mult_sym : (n,m:nat)(mult n m)=(mult m n).
Hints Resolve mult_sym : arith v62.

Lemma mult_n_1 : (n:nat)(mult n (S O))=n.
Hints Resolve mult_n_1 : arith v62.

Lemma mult_le : (m,n,p:nat) (le n p® (le (mult m n) (mult m p)).
Hints Resolve mult_le : arith.

Lemma mult_lt : (m,n,p:nat) (lt n p® (lt (mult (S mn) (mult (S mp)).

Hints Resolve mult_lt : arith.

Lemma mult_le_conv_1 : (m,n,p:nat) (le (mult (S mn) (mult (S mp)) ® (le n p).

Module Between

Id: Between.v,v 1.2 2001/03/15 13:38:47 filliatr Exp
Require Le.
Require Lt.

Section Between.
Variables P,Q : nat ® Prop.

Inductive between [k:nat] : nat ® Prop
   := bet_emp : (between k k)
   | bet_S : (l:nat)(between k l)®(P l)®(between k (S l)).

Lemma bet_eq : (k,l:nat)(l=k)®(between k l).

Hints Resolve bet_eq : arith v62.

Lemma between_le : (k,l:nat)(between k l)®(le k l).
Hints 
Lemma between_Sk_l : (k,l:nat)(between k l)®(le (S kl)®(between (S kl).
Hints Resolve between_Sk_l : arith v62.

Lemma between_restr : 
   (k,l,m:nat)(le k l)®(le l m)®(between k m)®(between l m).

Inductive exists [k:nat] : nat ® Prop
   := exists_S : (l:nat)(exists k l)®(exists k (S l))
   | exists_le: (l:nat)(le k l)®(Q l)®(exists k (S l)).

Lemma exists_le_S : (k,l:nat)(exists k l)®(le (S kl).

Lemma exists_lt : (k,l:nat)(exists k l)®(lt k l).
Hints 
Lemma exists_S_le : (k,l:nat)(exists k (S l))®(le k l).
Hints 
Definition in_int := [p,q,r:nat](le p r)&(lt r q).

Lemma in_int_intro : (p,q,r:nat)(le p r)®(lt r q)®(in_int p q r).
Hints Resolve in_int_intro : arith v62.

Lemma in_int_lt : (p,q,r:nat)(in_int p q r)®(lt p q).

Lemma in_int_p_Sq : 
   (p,q,r:nat)(in_int p (S qr)®((in_int p q ror <nat>r=q).

Lemma in_int_S : (p,q,r:nat)(in_int p q r)®(in_int p (S qr).
Hints Resolve in_int_S : arith v62.

Lemma in_int_Sp_q : (p,q,r:nat)(in_int (S pq r)®(in_int p q r).
Hints 
Lemma between_in_int : (k,l:nat)(between k l)®(r:nat)(in_int k l r)®(P r).

Lemma in_int_between : 
   (k,l:nat)(le k l)®((r:nat)(in_int k l r)®(P r))®(between k l).

Lemma exists_in_int : 
   (k,l:nat)(exists k l)®(EX m:nat | (in_int k l m) & (Q m)).

Lemma in_int_exists : (k,l,r:nat)(in_int k l r)®(Q r)®(exists k l).

Lemma between_or_exists : 
   (k,l:nat)(le k l)®((n:nat)(in_int k l n)®((P n)or(Q n)))
       ®((between k l)or(exists k l)).

Lemma between_not_exists : (k,l:nat)(between k l)®
       ((n:nat)(in_int k l n® (P n® not(Q n))
       ® not(exists k l).

Inductive nth [init:nat] : nat®nat®Prop
   := nth_O : (nth init init O)
   | nth_S : (k,l:nat)(n:nat)(nth init k n)®(between (S kl)
                         ®(Q l)®(nth init l (S n)).

Lemma nth_le : (init,l,n:nat)(nth init l n)®(le init l).

Definition eventually := [n:nat](EX k:nat | (le k n) & (Q k)).

Lemma event_O : (eventually O)®(Q O).

End Between.

Hints Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le
   in_int_S in_int_intro : arith v62.
Hints 

Module Peano_dec

Require Decidable.
(* Id: Peanodec.v,v 1.3 2001/04/08 17:18:08 mohring Exp *)

Theorem O_or_S : (n:nat)({m:nat|(S m)=n})+{O=n}.

Theorem eq_nat_dec : (n,m:nat){n=m}+{not(n=m)}.

Hints Resolve O_or_S eq_nat_dec : arith.

Theorem dec_eq_nat:(x,y:nat)(decidable (x=y)).

Module Arith

Id: Arith.v,v 1.5 2001/03/15 13:38:46 filliatr Exp
Require Export Le.
Require Export Lt.
Require Export Plus.
Require Export Gt.
Require Export Minus.
Require Export Mult.
Require Export Between.
Require Export Minus.

Axiom My_special_variable : nat ® nat.

Grammar nat number :=.

Grammar constr constr10 :=
   natural_nat [ nat:number($c) ] ® [$c].

Grammar constr pattern :=
   natural_pat [ nat:pat_number($c) ] ® [$c].

Module Wf_nat

Id: Wfnat.v,v 1.3 2001/04/11 12:41:38 filliatr Exp
Well-founded relations and natural numbers
Require Lt.

Chapter Well_founded_Nat.

Variable A : Set.

Variable f : A ® nat.
Definition ltof := [a,b:A](lt (f a) (f b)).
Definition gtof := [a,b:A](gt (f b) (f a)).

Theorem well_founded_ltof : (well_founded A ltof).

Theorem well_founded_gtof : (well_founded A gtof).

It is possible to directly prove the induction principle going back to primitive recursion on natural numbers (induction_ltof1) or to use the previous lemmas to extract a program with a fixpoint (induction_ltof2) the ML-like program for induction_ltof1 is :
   let induction_ltof1 F a = indrec ((f a)+1) a 
   where rec indrec = 
        function 0    -> (function a -> error)
               |(S m) -> (function a -> (F a (function y -> indrec y m)));;
the ML-like program for induction_ltof2 is :
   let induction_ltof2 F a = indrec a
   where rec indrec a = F a indrec;;

Theorem induction_ltof1 : (P:A®Set)((x:A)((y:A)(ltof y x)®(P y))®(P x))®(a:A)(P a).

Theorem induction_gtof1 : (P:A®Set)((x:A)((y:A)(gtof y x)®(P y))®(P x))®(a:A)(P a).

Theorem induction_ltof2 
     : (P:A®Set)((x:A)((y:A)(ltof y x)®(P y))®(P x))®(a:A)(P a).

Theorem induction_gtof2 : (P:A®Set)((x:A)((y:A)(gtof y x)®(P y))®(P x))®(a:A)(P a).

If a relation R is compatible with lt i.e. if x R y => f(x) < f(y) then R is well-founded.
Variable R : A®A®Prop.

Hypothesis H_compat : (x,y:A) (R x y® (lt (f x) (f y)).

Theorem well_founded_lt_compat : (well_founded A R).

End Well_founded_Nat.

Lemma lt_wf : (well_founded nat lt).

Lemma lt_wf_rec1 : (p:nat)(P:nat®Set)
               ((n:nat)((m:nat)(lt m n)®(P m))®(P n)) ® (P p).

Lemma lt_wf_rec : (p:nat)(P:nat®Set)
               ((n:nat)((m:nat)(lt m n)®(P m))®(P n)) ® (P p).

Lemma lt_wf_ind : (p:nat)(P:nat®Prop)
               ((n:nat)((m:nat)(lt m n)®(P m))®(P n)) ® (P p).

Lemma gt_wf_rec : (p:nat)(P:nat®Set)
               ((n:nat)((m:nat)(gt n m)®(P m))®(P n)) ® (P p).

Lemma gt_wf_ind : (p:nat)(P:nat®Prop)
               ((n:nat)((m:nat)(gt n m)®(P m))®(P n)) ® (P p).

Lemma lt_wf_double_rec : 
   (P:nat®nat®Set)
   ((n,m:nat)((p,q:nat)(lt p n)®(P p q))®((p:nat)(lt p m)®(P n p))®(P n m))
     ® (p,q:nat)(P p q).

Lemma lt_wf_double_ind : 
   (P:nat®nat®Prop)
   ((n,m:nat)((p,q:nat)(lt p n)®(P p q))®((p:nat)(lt p m)®(P n p))®(P n m))
     ® (p,q:nat)(P p q).

Hints Resolve lt_wf : arith.
Hints Resolve well_founded_lt_compat : arith.

Module Compare_dec

Id: Comparedec.v,v 1.3 2001/04/08 17:18:08 mohring Exp
Require Le.
Require Lt.
Require Gt.
Require Decidable.

Theorem zerop : (n:nat){n=O}+{lt O n}.

Theorem lt_eq_lt_dec : (n,m:nat){(lt n m)}+{n=m}+{(lt m n)}.

Lemma gt_eq_gt_dec : (n,m:nat)({(gt m n)}+{n=m})+{(gt n m)}.

Lemma le_lt_dec : (n,m:nat) {le n m} + {lt m n}.

Lemma le_le_S_dec : (n,m:nat) {le n m} + {le (S mn}.

Lemma le_ge_dec : (n,m:nat) {le n m} + {ge n m}.

Theorem le_gt_dec : (n,m:nat){(le n m)}+{(gt n m)}.

Theorem le_lt_eq_dec : (n,m:nat)(le n m)®({(lt n m)}+{n=m}).

Proofs of decidability
Theorem dec_le:(x,y:nat)(decidable (le x y)).

Theorem dec_lt:(x,y:nat)(decidable (lt x y)).

Theorem dec_gt:(x,y:nat)(decidable (gt x y)).

Theorem dec_ge:(x,y:nat)(decidable (ge x y)).

Theorem not_eq : (x,y:natnot x=y ® (lt x yor (lt y x).

Theorem not_le : (x,y:natnot(le x y® (gt x y).

Theorem not_gt : (x,y:natnot(gt x y® (le x y).

Theorem not_ge : (x,y:natnot(ge x y® (lt x y).

Theorem not_lt : (x,y:natnot(lt x y® (ge x y).

Module Min

Id: Min.v,v 1.2 2001/03/15 13:38:48 filliatr Exp
Require Arith.

minimum of two natural numbers
Fixpoint min [n:nat] : nat ® nat :=
[m:nat]Cases n m of
           O _ Þ O
         | (S n'O Þ O
         | (S n') (S m'Þ (S (min n' m'))
         end.

Lemma min_SS : (n,m:nat)((S (min n m))=(min (S n) (S m))).

Lemma le_min_l : (n,m:nat)(le (min n mn).
Hints Resolve le_min_l : arith v62.

Lemma le_min_r : (n,m:nat)(le (min n mm).
Hints Resolve le_min_r : arith v62.

min n m is equal to n or m
Lemma min_case : (n,m:nat)(P:nat®Set)(P n)®(P m)®(P (min n m)).

Module Even

Id: Even.v,v 1.4 2001/03/15 13:38:48 filliatr Exp
Here we define the predicates even and odd by mutual induction and we prove the decidability and the exclusion of those predicates. * The main results about parity are proved in the module Div2.


Inductive even : nat®Prop :=
     even_O : (even O)
   | even_S : (n:nat)(odd n)®(even (S n))
with odd : nat®Prop :=
     odd_S : (n:nat)(even n)®(odd (S n)).

Lemma even_or_odd : (n:nat) (even n)or(odd n).

Lemma even_odd_dec : (n:nat) { (even n) }+{ (odd n) }.

Lemma not_even_and_odd : (n:nat) (even n® (odd n® False.

Module Compare

Id: Compare.v,v 1.3 2001/03/15 13:38:47 filliatr Exp
equality is decidable on nat
Lemma not_eq_sym : (A:Set)(p,q:A)(notp=q® not(q=p).
Hints 
Require Arith.
Require Peano_dec.
Require Compare_dec.

Definition le_or_le_S := le_le_S_dec.

Definition compare := gt_eq_gt_dec.

Lemma le_dec : (n,m:nat) {le n m} + {le m n}.

Definition lt_or_eq := [n,m:nat]{(gt m n)}+{n=m}.

Lemma le_decide : (n,m:nat)(le n m)®(lt_or_eq n m).

Lemma le_le_S_eq : (p,q:nat)(le p q)®((le (S pq)or(p=q)).

By special request of G. Kahn - Used in Group Theory
Lemma discrete_nat : (mnnat) (lt m n®
     (S m) = n or (EX rnat | n = (S (S (plus m r)))).

Require Export Wf_nat.

Require Export Min.

Module Euclid_def

Id: Eucliddef.v,v 1.2 2001/03/15 13:38:48 filliatr Exp
Require Export Mult.

Inductive diveucl [a,b:nat] : Set
       := divex : (q,r:nat)(gt b r)®(a=(plus (mult q br))®(diveucl a b).

Module EqNat

Id: EqNat.v,v 1.5 2001/03/15 13:38:48 filliatr Exp
Equality on natural numbers
Fixpoint eq_nat [n:nat] : nat ® Prop :=
   [m:nat]Cases n m of
                 O O Þ True
               | O (S _) Þ False
               | (S _) O Þ False
               | (S n1) (S m1Þ (eq_nat n1 m1)
           end.

Theorem eq_nat_refl : (n:nat)(eq_nat n n).
Hints Resolve eq_nat_refl : arith v62.

Theorem eq_eq_nat : (n,m:nat)(n=m)®(eq_nat n m).
Hints 
Theorem eq_nat_eq : (n,m:nat)(eq_nat n m)®(n=m).
Hints 
Theorem eq_nat_elim : (n:nat)(P:nat®Prop)(P n)®(m:nat)(eq_nat n m)®(P m).

Theorem eq_nat_decide : (n,m:nat){(eq_nat n m)}+{not(eq_nat n m)}.

Fixpoint beq_nat [n:nat] : nat ® bool :=
   [m:nat]Cases n m of
                 O O Þ true
               | O (S _) Þ false
               | (S _) O Þ false
               | (S n1) (S m1Þ (beq_nat n1 m1)
           end.

Lemma beq_nat_refl : (x:nat)true=(beq_nat x x).

Definition beq_nat_eq : (x,y:nat)true=(beq_nat x y)®x=y.

Module Div2

Id: Div2.v,v 1.7 2001/03/15 13:38:47 filliatr Exp
Require Lt.
Require Plus.
Require Compare_dec.
Require Even.

Here we define n/2 and prove some of its properties
Fixpoint div2 [n:nat] : nat :=
   Cases n of
     O Þ O
   | (S OÞ O
   | (S (S n')) Þ (S (div2 n'))
   end.

Since div2 is recursively defined on 0, 1 and (S (S n)), it is useful to prove the corresponding induction principle
Lemma ind_0_1_SS : (P:nat®Prop)
   (P O® (P (S O)) ® ((n:nat)(P n)®(P (S (S n)))) ® (n:nat)(P n).

0 <n => n/2 < n
Lemma lt_div2 : (n:nat) (lt O n® (lt (div2 nn).

Hints Resolve lt_div2 : arith.

Properties related to the parity
Lemma even_odd_div2 : (n:nat
   ((even n)«(div2 n)=(div2 (S n))) & ((odd n)«(S (div2 n))=(div2 (S n))).

Specializations
Lemma even_div2 : (n:nat) (even n® (div2 n)=(div2 (S n)).

Lemma div2_even : (n:nat) (div2 n)=(div2 (S n)) ® (even n).

Lemma odd_div2 : (n:nat) (odd n® (S (div2 n))=(div2 (S n)).

Lemma div2_odd : (n:nat) (S (div2 n))=(div2 (S n)) ® (odd n).

Hints Resolve even_div2 div2_even odd_div2 div2_odd : arith.

Properties related to the double (2n)
Definition double := [n:nat](plus n n).

Hints Unfold double : arith.

Lemma double_S : (n:nat) (double (S n))=(S (S (double n))).

Hints Resolve double_S : arith.

Lemma even_odd_double : (n:nat
   ((even n)«n=(double (div2 n))) & ((odd n)«n=(S (double (div2 n)))).

Specializations
Lemma even_double : (n:nat) (even n® n=(double (div2 n)).

Lemma double_even : (n:natn=(double (div2 n)) ® (even n).

Lemma odd_double : (n:nat) (odd n® n=(S (double (div2 n))).

Lemma double_odd : (n:natn=(S (double (div2 n))) ® (odd n).

Hints Resolve even_double double_even odd_double double_odd : arith.

Application: if n is even then there is a p such that n = 2p if n is odd then there is a p such that n = 2p+1 * (Immediate: it is n/2)


Lemma even_2n : (n:nat) (even n® { p:nat | n=(double p) }.

Lemma odd_S2n : (n:nat) (odd n® { p:nat | n=(S (double p)) }.

Module Euclid_proof

Id: Euclidproof.v,v 1.5 2001/03/15 13:38:48 filliatr Exp
Require Minus.
Require Euclid_def.
Require Compare_dec.
Require Wf_nat.

Lemma eucl_dev : (b:nat)(gt b O)®(a:nat)(diveucl a b).

Lemma quotient : (b:nat)(gt b O)®
       (a:nat){q:nat|(EX r:nat | (a=(plus (mult q br))&(gt b r))}.

Lemma modulo : (b:nat)(gt b O)®
       (a:nat){r:nat|(EX q:nat | (a=(plus (mult q br))&(gt b r))}.

The ZArith library deals with binary integers (those used by the Omega decision tactic). Here are defined various arithmetical notions and their properties, similar to those of Arith.

Module Fast_integer

Binary Integers
Pierre Crégut (CNET, Lannion, France)
Require Le.
Require Lt.
Require Plus.
Require Mult.
Require Minus.
Definition of fast binary integers
Section fast_integers.

Inductive positive : Set :=
   xI : positive ® positive
xO : positive ® positive
xH : positive.

Inductive Z : Set :=
   ZERO : Z | POS : positive ® Z | NEG : positive ® Z.

Inductive relation : Set :=
   EGAL :relation | INFERIEUR : relation | SUPERIEUR : relation.
Addition
Fixpoint add_un [x:positive]:positive :=
   <positiveCases x of
                 (xI x'Þ (xO (add_un x'))
               | (xO x'Þ (xI x')
               | xH Þ (xO xH)
               end.

Fixpoint add [x,y:positive]:positive :=
   <positive>Cases x of
       (xI x'Þ <positive>Cases y of
                     (xI y'Þ (xO (add_carry x' y'))
                   | (xO y'Þ (xI (add x' y'))
                   | xH Þ (xO (add_un x'))
                   end
     | (xO x'Þ <positive>Cases y of
                     (xI y'Þ (xI (add x' y'))
                   | (xO y'Þ (xO (add x' y'))
                   | xH Þ (xI x')
                   end
     | xH Þ <positive>Cases y of
                     (xI y'Þ (xO (add_un y'))
                   | (xO y'Þ (xI y')
                   | xH Þ (xO xH)
                   end
     end
with add_carry [x,y:positive]:positive :=
   <positive>Cases x of
       (xI x'Þ <positive>Cases y of
             (xI y'Þ (xI (add_carry x' y'))
           | (xO y'Þ (xO (add_carry x' y'))
           | xH Þ (xI (add_un x'))
           end
     | (xO x'Þ <positive>Cases y of
             (xI y'Þ (xO (add_carry x' y'))
           | (xO y'Þ (xI (add x' y'))
           | xH Þ (xO (add_un x'))
           end
     | xH Þ <positive>Cases y of
             (xI y'Þ (xI (add_un y'))
           | (xO y'Þ (xO (add_un y'))
           | xH Þ (xI xH)
           end
   end.
From positive to natural numbers
Fixpoint positive_to_nat [x:positive]:nat ® nat :=
   [pow2:nat]
     <natCases x of
       (xI x'Þ (plus pow2 (positive_to_nat x' (plus pow2 pow2)))
     | (xO x'Þ (positive_to_nat x' (plus pow2 pow2))
     | xH Þ pow2
     end.

Definition convert := [x:positive] (positive_to_nat x (S O)).
From natural numbers to positive
Fixpoint anti_convert [n:nat]: positive :=
   <positiveCases n of
                 O Þ xH
               | (S x'Þ (add_un (anti_convert x'))
               end.

Correctness of addition
Lemma convert_add_un :
   (x:positive)(m:nat)
     (positive_to_nat (add_un xm) = (plus m (positive_to_nat x m)).

Theorem convert_add_carry :
   (x,y:positive)(m:nat)
     (positive_to_nat (add_carry x ym) =
     (plus m (positive_to_nat (add x ym)).

Theorem cvt_carry :
   (x,y:positive)(convert (add_carry x y)) = (S (convert (add x y))).

Theorem add_verif :
   (x,y:positive)(m:nat)
     (positive_to_nat (add x ym) = 
     (plus (positive_to_nat x m) (positive_to_nat y m)).

Theorem convert_add:
   (x,y:positive) (convert (add x y)) = (plus (convert x) (convert y)).
Correctness of conversion
Theorem bij1 : (m:nat) (convert (anti_convert m)) = (S m).

Theorem compare_positive_to_nat_O : 
         (p:positive)(m:nat)(le m (positive_to_nat p m)).

Theorem compare_convert_O : (p:positive)(lt O (convert p)).

Hints Resolve compare_convert_O.
Subtraction
Fixpoint double_moins_un [x:positive]:positive :=
   <positive>Cases x of
       (xI x'Þ (xI (xO x'))
     | (xO x'Þ (xI (double_moins_un x'))
     | xH Þ xH
     end.

Definition sub_un := [x:positive]
   <positiveCases x of
               (xI x'Þ (xO x')
             | (xO x'Þ (double_moins_un x')
             | xH Þ xH
             end.

Lemma sub_add_one : (x:positive) (sub_un (add_un x)) = x.

Lemma is_double_moins_un : (x:positive) (add_un (double_moins_un x)) = (xO x).

Lemma add_sub_one : (x:positive) (x=xHor (add_un (sub_un x)) = x.

Lemma ZL0 : (S (S O))=(plus (S O) (S O)).

Lemma ZL1: (y:positive)(xO (add_un y)) = (add_un (add_un (xO y))).

Lemma ZL2:
   (y:positive)(m:nat)
     (positive_to_nat y (plus m m)) =
               (plus (positive_to_nat y m) (positive_to_nat y m)).

Lemma ZL3: (x:nat) (add_un (anti_convert (plus x x))) = (xO (anti_convert x)).

Lemma ZL4: (y:positive) (EX h:nat |(convert y)=(S h)).

Lemma ZL5: (x:nat) (anti_convert (plus (S x) (S x))) = (xI (anti_convert x)).

Lemma bij2 : (x:positive) (anti_convert (convert x)) = (add_un x).
Comparison of positive
Fixpoint compare [x,y:positive]: relation ® relation :=
   [r:relation] <relationCases x of
             (xI x'Þ <relation>Cases y of
                           (xI y'Þ (compare x' y' r)
                         | (xO y'Þ (compare x' y' SUPERIEUR)
                         | xH Þ SUPERIEUR
                         end
           | (xO x'Þ <relation>Cases y of
                           (xI y'Þ (compare x' y' INFERIEUR)
                         | (xO y'Þ (compare x' y' r)
                         | xH Þ SUPERIEUR
                         end
           | xH Þ <relation>Cases y of
                       (xI y'Þ INFERIEUR
                     | (xO y'Þ INFERIEUR
                     | xH Þ r
                     end
   end.

Theorem compare_convert1 : 
   (x,y:positive
   not(compare x y SUPERIEUR) = EGAL & not(compare x y INFERIEUR) = EGAL.

Theorem compare_convert_EGAL : (x,y:positive) (compare x y EGAL) = EGAL ® x=y.

Lemma ZL6:
   (p:positive) (positive_to_nat p (S(S O))) = (plus (convert p) (convert p)).

Lemma ZL7:
   (m,n:nat) (lt m n® (lt (plus m m) (plus n n)).

Lemma ZL8:
   (m,n:nat) (lt m n® (lt (S (plus m m)) (plus n n)).

Lemma ZLSI:
   (x,y:positive) (compare x y SUPERIEUR) = INFERIEUR ® 
                 (compare x y EGAL) = INFERIEUR.

Lemma ZLIS:
   (x,y:positive) (compare x y INFERIEUR) = SUPERIEUR ® 
                 (compare x y EGAL) = SUPERIEUR.

Lemma ZLII:
   (x,y:positive) (compare x y INFERIEUR) = INFERIEUR ®
                 (compare x y EGAL) = INFERIEUR or x = y.

Lemma ZLSS:
   (x,y:positive) (compare x y SUPERIEUR) = SUPERIEUR ®
                 (compare x y EGAL) = SUPERIEUR or x = y.

Theorem compare_convert_INFERIEUR : 
   (x,y:positive) (compare x y EGAL) = INFERIEUR ® 
     (lt (convert x) (convert y)).

Theorem compare_convert_SUPERIEUR : 
   (x,y:positive) (compare x y EGAL)=SUPERIEUR ® (gt (convert x) (convert y)).

Lemma Dcompare : (r:relationr=EGAL or r = INFERIEUR or r = SUPERIEUR.

Theorem convert_compare_INFERIEUR : 
   (x,y:positive)(lt (convert x) (convert y)) ® (compare x y EGAL) = INFERIEUR.

Theorem convert_compare_SUPERIEUR : 
   (x,y:positive)(gt (convert x) (convert y)) ® (compare x y EGAL) = SUPERIEUR.

Theorem convert_compare_EGAL: (x:positive)(compare x x EGAL)=EGAL.
Natural numbers coded with positive
Inductive entierSet := Nul : entier | Pos : positive ® entier.

Definition Un_suivi_de :=
   [x:entier]<entierCases x of Nul Þ (Pos xH) | (Pos pÞ (Pos (xI p)) end.

Definition Zero_suivi_de :=
   [x:entier]<entierCases x of Nul Þ Nul | (Pos pÞ (Pos (xO p)) end.

Definition double_moins_deux :=
   [x:positive] <entier>Cases x of
             (xI x'Þ (Pos (xO (xO x')))
           | (xO x'Þ (Pos (xO (double_moins_un x')))
           | xH Þ Nul
           end.
Lemma ZS: (p:entier) (Zero_suivi_de p) = Nul ® p = Nul.

Lemma US: (p:entiernot(Un_suivi_de p)=Nul.

Lemma USH: (p:entier) (Un_suivi_de p) = (Pos xH® p = Nul.

Lemma ZSH: (p:entiernot(Zero_suivi_de p)= (Pos xH).

Fixpoint sub_pos[x,y:positive]:entier :=
   <entier>Cases x of
           (xI x'Þ <entier>Cases y of
                             (xI y'Þ (Zero_suivi_de (sub_pos x' y'))
                           | (xO y'Þ (Un_suivi_de (sub_pos x' y'))
                           | xH Þ (Pos (xO x'))
                           end
         | (xO x'Þ <entier>Cases y of
                             (xI y'Þ (Un_suivi_de (sub_neg x' y'))
                           | (xO y'Þ (Zero_suivi_de (sub_pos x' y'))
                           | xH Þ (Pos (double_moins_un x'))
                           end
         | xH Þ <entier>Cases y of
                             (xI y'Þ (Pos (double_moins_un y'))
                           | (xO y'Þ (double_moins_deux y')
                           | xH Þ Nul
                           end
         end
with sub_neg [x,y:positive]:entier :=
   <entier>Cases x of
         (xI x'Þ <entier>Cases y of
                             (xI y'Þ (Un_suivi_de (sub_neg x' y'))
                           | (xO y'Þ (Zero_suivi_de (sub_pos x' y'))
                           | xH Þ (Pos (double_moins_un x'))
                           end
       | (xO x'Þ <entier>Cases y of
                             (xI y'Þ (Zero_suivi_de (sub_neg x' y'))
                           | (xO y'Þ (Un_suivi_de (sub_neg x' y'))
                           | xH Þ (double_moins_deux x')
                           end
       | xH Þ <entier>Cases y of
                             (xI y'Þ (Pos (xO y'))
                           | (xO y'Þ (Pos (double_moins_un y'))
                           | xH Þ Nul
                           end
       end.

Theorem sub_pos_x_x : (x:positive) (sub_pos x x) = Nul.

Theorem ZL10: (x,y:positive)
   (compare x y EGAL) = SUPERIEUR ®
   (sub_pos x y) = (Pos xH® (sub_neg x y) = Nul.

Lemma ZL11: (x:positive) (x=xHor not(x=xH).

Lemma ZL12: (q:positive) (add_un q) = (add q xH).

Lemma ZL12bis: (q:positive) (add_un q) = (add xH q).

Theorem ZL13:
   (x,y:positive)(add_carry x y) = (add_un (add x y)).

Theorem ZL14:
   (x,y:positive)(add x (add_un y)) = (add_un (add x y)).

Theorem ZL15:
   (q,z:positivenotz=xH ® (add_carry q (sub_un z)) = (add q z).

Theorem sub_pos_SUPERIEUR:
   (x,y:positive)(compare x y EGAL)=SUPERIEUR ® 
     (EX h:positive | (sub_pos x y) = (Pos h) & (add y h) = x &
                       (h = xH or (sub_neg x y) = (Pos (sub_un h)))).

Lemma ZC1:
   (x,y:positive)(compare x y EGAL)=SUPERIEUR ® (compare y x EGAL)=INFERIEUR.

Lemma ZC2:
   (x,y:positive)(compare x y EGAL)=INFERIEUR ® (compare y x EGAL)=SUPERIEUR.

Lemma ZC3: (x,y:positive)(compare x y EGAL)=EGAL ® (compare y x EGAL)=EGAL.

Definition Op := [r:relation]
   <relation>Cases r of
               EGAL Þ EGAL
             | INFERIEUR Þ SUPERIEUR
             | SUPERIEUR Þ INFERIEUR
             end.

Lemma ZC4: (x,y:positive) (compare x y EGAL) = (Op (compare y x EGAL)).

Theorem add_sym : (x,y:positive) (add x y) = (add y x).

Lemma bij3: (x:positive)(sub_un (anti_convert (convert x))) = x.

Lemma convert_intro : (x,y:positive)(convert x)=(convert y® x=y.

Lemma simpl_add_r : (x,y,z:positive) (add x z)=(add y z® x=y.

Lemma simpl_add_l : (x,y,z:positive) (add x y)=(add x z® y=z.

Theorem add_assoc: (x,y,z:positive)(add x (add y z)) = (add (add x yz).

Local true_sub := [x,y:positive]
   <positiveCases (sub_pos x yof Nul Þ xH | (Pos zÞ z end.
Proof.
Theorem sub_add
(x,y:positive) (compare x y EGAL) = SUPERIEUR ® (add y (true_sub x y)) = x.

Theorem true_sub_convert:
   (x,y:positive) (compare x y EGAL) = SUPERIEUR ® 
       (convert (true_sub x y)) = (minus (convert x) (convert y)).
Addition on integers
Definition Zplus := [x,y:Z]
   <Z>Cases x of
       ZERO Þ y
     | (POS x'Þ
           <Z>Cases y of
                 ZERO Þ x
               | (POS y'Þ (POS (add x' y'))
               | (NEG y'Þ
                     <Z>Cases (compare x' y' EGALof
                         EGAL Þ ZERO
                       | INFERIEUR Þ (NEG (true_sub y' x'))
                       | SUPERIEUR Þ (POS (true_sub x' y'))
                       end
               end
     | (NEG x'Þ
           <Z>Cases y of
                 ZERO Þ x
               | (POS y'Þ
                     <Z>Cases (compare x' y' EGALof
                         EGAL Þ ZERO
                       | INFERIEUR Þ (POS (true_sub y' x'))
                       | SUPERIEUR Þ (NEG (true_sub x' y'))
                       end
               | (NEG y'Þ (NEG (add x' y'))
               end
     end.
Opposite
Definition Zopp := [x:Z]
   <Z>Cases x of
       ZERO Þ ZERO
     | (POS xÞ (NEG x)
     | (NEG xÞ (POS x)
     end.

Theorem Zero_left: (x:Z) (Zplus ZERO x) = x.

Theorem Zopp_Zopp: (x:Z) (Zopp (Zopp x)) = x.
Addition and opposite
Theorem Zero_right: (x:Z) (Zplus x ZERO) = x.

Theorem Zplus_inverse_r: (x:Z) (Zplus x (Zopp x)) = ZERO.

Theorem Zopp_Zplus
   (x,y:Z) (Zopp (Zplus x y)) = (Zplus (Zopp x) (Zopp y)).

Theorem Zplus_sym: (x,y:Z) (Zplus x y) = (Zplus y x).

Theorem Zplus_inverse_l: (x:Z) (Zplus (Zopp xx) = ZERO.

Theorem Zopp_intro : (x,y:Z) (Zopp x) = (Zopp y® x = y.

Theorem Zopp_NEG : (x:positive) (Zopp (NEG x)) = (POS x).

Hints Resolve Zero_left Zero_right.

Theorem weak_assoc :
   (x,y:positive)(z:Z) (Zplus (POS x) (Zplus (POS yz))=
                         (Zplus (Zplus (POS x) (POS y)) z).

Hints Resolve weak_assoc.

Theorem Zplus_assoc :
   (x,y,z:Z) (Zplus x (Zplus y z))= (Zplus (Zplus x yz).

Lemma Zplus_simpl : (n,m,p,q:Zn=m ® p=q ® (Zplus n p)=(Zplus m q).
Addition on positive numbers
Fixpoint times1 [x:positive] : (positive ® positive® positive ® positive:=
   [f:positive ® positive][y:positive]
   <positiveCases x of
           (xI x'Þ (add (f y) (times1 x' [z:positive](xO (f z)) y))
         | (xO x'Þ (times1 x' [z:positive](xO (f z)) y)
         | xH Þ (f y)
   end.

Local times := [x:positive](times1 x [y:positive]y).

Theorem times1_convert :
   (x,y:positive)(f:positive ® positive)
     (convert (times1 x f y)) = (mult (convert x) (convert (f y))).
Correctness of multiplication on positive
Theorem times_convert :
   (x,y:positive) (convert (times x y)) = (mult (convert x) (convert y)).
Multiplication on integers
Definition Zmult := [x,y:Z]
   <Z>Cases x of
       ZERO Þ ZERO
     | (POS x'Þ
           <Z>Cases y of
                 ZERO Þ ZERO
               | (POS y'Þ (POS (times x' y'))
               | (NEG y'Þ (NEG (times x' y'))
               end
     | (NEG x'Þ
           <Z>Cases y of
                 ZERO Þ ZERO
               | (POS y'Þ (NEG (times x' y'))
               | (NEG y'Þ (POS (times x' y'))
               end
     end.

Theorem times_assoc :
   ((x,y,z:positive) (times x (times y z))= (times (times x yz)).

Theorem times_sym : (x,y:positive) (times x y) = (times y x).

Theorem Zmult_sym : (x,y:Z) (Zmult x y) = (Zmult y x).

Theorem Zmult_assoc :
   (x,y,z:Z) (Zmult x (Zmult y z))= (Zmult (Zmult x yz).

Theorem Zmult_one:
   (x:Z) (Zmult (POS xHx) = x.

Theorem times_add_distr:
   (x,y,z:positive) (times x (add y z)) = (add (times x y) (times x z)).

Theorem lt_mult_left :
   (x,y,z:nat) (lt x y® (lt (mult (S zx) (mult (S zy)).

Theorem times_true_sub_distr:
   (x,y,z:positive) (compare y z EGAL) = SUPERIEUR ® 
       (times x (true_sub y z)) = (true_sub (times x y) (times x z)).

Theorem Zero_mult_left: (x:Z) (Zmult ZERO x) = ZERO.

Theorem Zero_mult_right: (x:Z) (Zmult x ZERO) = ZERO.

Hints Resolve Zero_mult_left Zero_mult_right.

Multiplication and Opposite
Theorem Zopp_Zmult:
   (x,y:Z) (Zmult (Zopp xy) = (Zopp (Zmult x y)).

Theorem Zmult_Zopp_Zopp:
   (x,y:Z) (Zmult (Zopp x) (Zopp y)) = (Zmult x y).

Theorem weak_Zmult_plus_distr_r:
   (x:positive)(y,z:Z)
     (Zmult (POS x) (Zplus y z)) = (Zplus (Zmult (POS xy) (Zmult (POS xz)).

Theorem Zmult_plus_distr_r:
   (x,y,z:Z) (Zmult x (Zplus y z)) = (Zplus (Zmult x y) (Zmult x z)).
Comparison on integers
Definition Zcompare := [x,y:Z]
   <relation>Cases x of
       ZERO Þ <relation>Cases y of
                 ZERO Þ EGAL
               | (POS y'Þ INFERIEUR
               | (NEG y'Þ SUPERIEUR
               end
     | (POS x'Þ <relation>Cases y of
                 ZERO Þ SUPERIEUR
               | (POS y'Þ (compare x' y' EGAL)
               | (NEG y'Þ SUPERIEUR
               end
     | (NEG x'Þ <relation>Cases y of
                 ZERO Þ INFERIEUR
               | (POS y'Þ INFERIEUR
               | (NEG y'Þ (Op (compare x' y' EGAL))
               end
   end.

Theorem Zcompare_EGAL : (x,y:Z) (Zcompare x y) = EGAL « x = y.

Theorem Zcompare_ANTISYM : 
   (x,y:Z) (Zcompare x y) = SUPERIEUR « (Zcompare y x) = INFERIEUR.

Theorem le_minus: (i,h:nat) (le (minus i hi).

Lemma ZL16: (p,q:positive)(lt (minus (convert p) (convert q)) (convert p)).

Lemma ZL17: (p,q:positive)(lt (convert p) (convert (add p q))).

Theorem Zcompare_Zopp :
   (x,y:Z) (Zcompare x y) = (Zcompare (Zopp y) (Zopp x)).

Hints Resolve convert_compare_EGAL.

Theorem weaken_Zcompare_Zplus_compatible : 
   ((x,y:Z) (z:positive
     (Zcompare (Zplus (POS zx) (Zplus (POS zy)) = (Zcompare x y)) ®
     (x,y,z:Z) (Zcompare (Zplus z x) (Zplus z y)) = (Zcompare x y).

Hints Resolve ZC4.

Theorem weak_Zcompare_Zplus_compatible : 
   (x,y:Z) (z:positive
     (Zcompare (Zplus (POS zx) (Zplus (POS zy)) = (Zcompare x y).

Theorem Zcompare_Zplus_compatible : 
     (x,y,z:Z) (Zcompare (Zplus z x) (Zplus z y)) = (Zcompare x y).

Theorem Zcompare_trans_SUPERIEUR : 
   (x,y,z:Z) (Zcompare x y) = SUPERIEUR ® 
             (Zcompare y z) = SUPERIEUR ®
             (Zcompare x z) = SUPERIEUR.

Lemma SUPERIEUR_POS :
   (x,y:Z) (Zcompare x y) = SUPERIEUR ®
   (EX h:positive |(Zplus x (Zopp y)) = (POS h)).
End fast_integers.

Module Zarith_aux

Binary Integers
Pierre Crégut (CNET, Lannion, France)
Require Arith.
Require Export fast_integer.

Meta Definition ElimCompare com1 com2:=
   Elim (Dcompare (Zcompare com1 com2)); [
           Idtac
         | Intro hidden_auxiliaryElim hidden_auxiliary;
           Clear hidden_auxiliary ] .
Order relations
Definition Zlt := [x,y:Z](Zcompare x y) = INFERIEUR.
Definition Zgt := [x,y:Z](Zcompare x y) = SUPERIEUR.
Definition Zle := [x,y:Z]not(Zcompare x y) = SUPERIEUR.
Definition Zge := [x,y:Z]not(Zcompare x y) = INFERIEUR.
Absolu function
Definition absolu [x:Z] : nat :=
   Cases x of
       ZERO Þ O
   | (POS pÞ (convert p)
   | (NEG pÞ (convert p)
   end.

Definition Zabs [z:Z] : Z :=
   Cases z of
       ZERO Þ ZERO
   | (POS pÞ (POS p)
   | (NEG pÞ (POS p)
   end.
Properties of absolu function
Lemma Zabs_eq : (x:Z) (Zle ZERO x® (Zabs x)=x.
From nat to Z
Definition inject_nat :=
   [x:nat]Cases x of
             O Þ ZERO
           | (S yÞ (POS (anti_convert y))
           end.
Successor and Predecessor functions on Z
Definition Zs := [x:Z](Zplus x (POS xH)).
Definition Zpred := [x:Z](Zplus x (NEG xH)).

Properties of the order relation
Theorem Zgt_Sn_n : (n:Z)(Zgt (Zs nn).
Properties of the order
Theorem Zle_gt_trans : (n,m,p:Z)(Zle m n)®(Zgt m p)®(Zgt n p).

Theorem Zgt_le_trans : (n,m,p:Z)(Zgt n m)®(Zle p m)®(Zgt n p).

Theorem Zle_S_gt : (n,m:Z) (Zle (Zs nm® (Zgt m n).

Theorem Zcompare_n_S : (n,m:Z)(Zcompare (Zs n) (Zs m)) = (Zcompare n m).

Theorem Zgt_n_S : (n,m:Z)(Zgt m n® (Zgt (Zs m) (Zs n)).

Lemma Zle_not_gt : (n,m:Z)(Zle n m® not(Zgt n m).

Lemma Zgt_antirefl : (n:Z)not(Zgt n n).

Lemma Zgt_not_sym : (n,m:Z)(Zgt n m® not(Zgt m n).

Lemma Zgt_not_le : (n,m:Z)(Zgt n m® not(Zle n m).

Lemma Zgt_trans : (n,m,p:Z)(Zgt n m)®(Zgt m p)®(Zgt n p).

Lemma Zle_gt_S : (n,p:Z)(Zle n p)®(Zgt (Zs pn).

Lemma Zgt_pred 
         : (n,p:Z)(Zgt p (Zs n))®(Zgt (Zpred pn).

Lemma Zsimpl_gt_plus_l 
         : (n,m,p:Z)(Zgt (Zplus p n) (Zplus p m))®(Zgt n m).

Lemma Zsimpl_gt_plus_r
         : (n,m,p:Z)(Zgt (Zplus n p) (Zplus m p))®(Zgt n m).

Lemma Zgt_reg_l 
         : (n,m,p:Z)(Zgt n m)®(Zgt (Zplus p n) (Zplus p m)).

Lemma Zgt_reg_r : (n,m,p:Z)(Zgt n m)®(Zgt (Zplus n p) (Zplus m p)).

Theorem Zcompare_et_un
   (x,y:Z) (Zcompare x y)=SUPERIEUR « 
     not(Zcompare x (Zplus y (POS xH)))=INFERIEUR.

Lemma Zgt_S_n : (n,p:Z)(Zgt (Zs p) (Zs n))®(Zgt p n).

Lemma Zle_S_n : (n,m:Z) (Zle (Zs m) (Zs n)) ® (Zle m n).

Lemma Zgt_le_S : (n,p:Z)(Zgt p n)®(Zle (Zs np).

Lemma Zgt_S_le : (n,p:Z)(Zgt (Zs pn)®(Zle n p).

Theorem Zgt_S : (n,m:Z)(Zgt (Zs nm)®((Zgt n m)or(<Z>m=n)).

Theorem Zgt_trans_S : (n,m,p:Z)(Zgt (Zs nm)®(Zgt m p)®(Zgt n p).

Theorem Zeq_S : (n,m:Zn=m ® (Zs n)=(Zs m).

Theorem Zpred_Sn : (m:Zm=(Zpred (Zs m)).

Theorem Zeq_add_S : (n,m:Z) (Zs n)=(Zs m® n=m.

Theorem Znot_eq_S : (n,m:Znot(n=m® not((Zs n)=(Zs m)).

Lemma Zsimpl_plus_l : (n,m,p:Z)(Zplus n m)=(Zplus n p)®m=p.

Theorem Zn_Sn : (n:Znot(n=(Zs n)).

Lemma Zplus_n_O : (n:Zn=(Zplus n ZERO).

Lemma Zplus_unit_left : (n,m:Z) (Zplus n ZERO)=m ® n=m.

Lemma Zplus_unit_right : (n,m:Zn=(Zplus m ZERO® n=m.

Lemma Zplus_n_Sm : (n,m:Z) (Zs (Zplus n m))=(Zplus n (Zs m)).

Lemma Zmult_n_O : (n:ZZERO=(Zmult n ZERO).

Lemma Zmult_n_Sm : (n,m:Z) (Zplus (Zmult n mn)=(Zmult n (Zs m)).

Theorem Zle_n : (n:Z) (Zle n n).

Theorem Zle_refl : (n,m:Zn=m ® (Zle n m).

Theorem Zle_trans : (n,m,p:Z)(Zle n m)®(Zle m p)®(Zle n p).

Theorem Zle_n_Sn : (n:Z)(Zle n (Zs n)).

Lemma Zle_n_S : (n,m:Z) (Zle m n® (Zle (Zs m) (Zs n)).

Hints Resolve Zle_n Zle_n_Sn Zle_trans Zle_n_S : zarith.
Hints 
Lemma Zs_pred : (n:Zn=(Zs (Zpred n)).

Hints 
Theorem Zle_pred_n : (n:Z)(Zle (Zpred nn).

Theorem Zle_trans_S : (n,m:Z)(Zle (Zs nm)®(Zle n m).

Theorem Zle_Sn_n : (n:Z)not(Zle (Zs nn).

Theorem Zle_antisym : (n,m:Z)(Zle n m)®(Zle m n)®(n=m).

Theorem Zgt_lt : (m,n:Z) (Zgt m n® (Zlt n m).

Theorem Zlt_gt : (m,n:Z) (Zlt m n® (Zgt n m).

Theorem Zge_le : (m,n:Z) (Zge m n® (Zle n m).

Theorem Zle_ge : (m,n:Z) (Zle m n® (Zge n m).

Theorem Zge_trans : (nmp : Z) (Zge n m® (Zge m p® (Zge n p).

Theorem Zlt_n_Sn : (n:Z)(Zlt n (Zs n)).
Theorem Zlt_S : (n,m:Z)(Zlt n m)®(Zlt n (Zs m)).

Theorem Zlt_n_S : (n,m:Z)(Zlt n m)®(Zlt (Zs n) (Zs m)).

Theorem Zlt_S_n : (n,m:Z)(Zlt (Zs n) (Zs m))®(Zlt n m).

Theorem Zlt_n_n : (n:Z)not(Zlt n n).

Lemma Zlt_pred : (n,p:Z)(Zlt (Zs np)®(Zlt n (Zpred p)).

Lemma Zlt_pred_n_n : (n:Z)(Zlt (Zpred nn).

Theorem Zlt_le_S : (n,p:Z)(Zlt n p)®(Zle (Zs np).

Theorem Zlt_n_Sm_le : (n,m:Z)(Zlt n (Zs m))®(Zle n m).

Theorem Zle_lt_n_Sm : (n,m:Z)(Zle n m)®(Zlt n (Zs m)).

Theorem Zlt_le_weak : (n,m:Z)(Zlt n m)®(Zle n m).

Theorem Zlt_trans : (n,m,p:Z)(Zlt n m)®(Zlt m p)®(Zlt n p).
Theorem Zlt_le_trans : (n,m,p:Z)(Zlt n m)®(Zle m p)®(Zlt n p).

Theorem Zle_lt_trans : (n,m,p:Z)(Zle n m)®(Zlt m p)®(Zlt n p).

Theorem Zle_lt_or_eq : (n,m:Z)(Zle n m)®((Zlt n mor n=m).

Theorem Zle_or_lt : (n,m:Z)((Zle n m)or(Zlt m n)).

Theorem Zle_not_lt : (n,m:Z)(Zle n m® not(Zlt m n).

Theorem Zlt_not_le : (n,m:Z)(Zlt n m® not(Zle m n).

Theorem Zlt_not_sym : (n,m:Z)(Zlt n m® not(Zlt m n).

Theorem Zle_le_S : (x,y:Z)(Zle x y)®(Zle x (Zs y)).

Hints Resolve Zle_le_S : zarith.

Definition Zmin := [n,m:Z]
   <Z>Cases (Zcompare n mof
       EGAL Þ n
     | INFERIEUR Þ n
     | SUPERIEUR Þ m
     end.

Lemma Zmin_SS : (n,m:Z)((Zs (Zmin n m))=(Zmin (Zs n) (Zs m))).

Lemma Zle_min_l : (n,m:Z)(Zle (Zmin n mn).

Lemma Zle_min_r : (n,m:Z)(Zle (Zmin n mm).

Lemma Zmin_case : (n,m:Z)(P:Z®Set)(P n)®(P m)®(P (Zmin n m)).

Lemma Zmin_or : (n,m:Z)(Zmin n m)=n or (Zmin n m)=m.

Lemma Zmin_n_n : (n:Z) (Zmin n n)=n.

Lemma Zplus_assoc_l : (n,m,p:Z)((Zplus n (Zplus m p))=(Zplus (Zplus n mp)).

Lemma Zplus_assoc_r : (n,m,p:Z)(Zplus (Zplus n mp) =(Zplus n (Zplus m p)).

Lemma Zplus_permute : (n,m,p:Z) (Zplus n (Zplus m p))=(Zplus m (Zplus n p)).

Lemma Zsimpl_le_plus_l : (p,n,m:Z)(Zle (Zplus p n) (Zplus p m))®(Zle n m).

Lemma Zsimpl_le_plus_r : (p,n,m:Z)(Zle (Zplus n p) (Zplus m p))®(Zle n m).

Lemma Zle_reg_l : (n,m,p:Z)(Zle n m)®(Zle (Zplus p n) (Zplus p m)).

Lemma Zle_reg_r : (a,b,c:Z) (Zle a b)®(Zle (Zplus a c) (Zplus b c)).

Lemma Zle_plus_plus : 
   (n,m,p,q:Z) (Zle n m)®(Zle p q)®(Zle (Zplus n p) (Zplus m q)).

Lemma Zplus_Snm_nSm : (n,m:Z)(Zplus (Zs nm)=(Zplus n (Zs m)).

Lemma Zsimpl_lt_plus_l 
         : (n,m,p:Z)(Zlt (Zplus p n) (Zplus p m))®(Zlt n m).

Lemma Zsimpl_lt_plus_r
         : (n,m,p:Z)(Zlt (Zplus n p) (Zplus m p))®(Zlt n m).

Lemma Zlt_reg_l : (n,m,p:Z)(Zlt n m)®(Zlt (Zplus p n) (Zplus p m)).

Lemma Zlt_reg_r : (n,m,p:Z)(Zlt n m)®(Zlt (Zplus n p) (Zplus m p)).

Lemma Zlt_le_reg :
   (a,b,c,d:Z) (Zlt a b)®(Zle c d)®(Zlt (Zplus a c) (Zplus b d)).

Lemma Zle_lt_reg :
   (a,b,c,d:Z) (Zle a b)®(Zlt c d)®(Zlt (Zplus a c) (Zplus b d)).

Definition Zminus := [m,n:Z](Zplus m (Zopp n)).

Lemma Zminus_plus_simpl : 
   (n,m,p:Z)((Zminus n m)=(Zminus (Zplus p n) (Zplus p m))).

Lemma Zminus_n_O : (n:Z)(n=(Zminus n ZERO)).

Lemma Zminus_n_n : (n:Z)(ZERO=(Zminus n n)).

Lemma Zplus_minus : (n,m,p:Z)(n=(Zplus m p))®(p=(Zminus n m)).

Lemma Zminus_plus : (n,m:Z)(Zminus (Zplus n mn)=m.

Lemma Zle_plus_minus : (n,m:Z) (Zplus n (Zminus m n))=m.

Lemma Zminus_Sn_m : (n,m:Z)((Zs (Zminus n m))=(Zminus (Zs nm)).

Lemma Zlt_minus : (n,m:Z)(Zlt ZERO m)®(Zlt (Zminus n mn).

Lemma Zlt_O_minus_lt : (n,m:Z)(Zlt ZERO (Zminus n m))®(Zlt m n).

Lemma Zmult_plus_distr_l : 
   (n,m,p:Z)((Zmult (Zplus n mp)=(Zplus (Zmult n p) (Zmult m p))).

Lemma Zmult_minus_distr :
   (n,m,p:Z)((Zmult (Zminus n mp)=(Zminus (Zmult n p) (Zmult m p))).

Lemma Zmult_assoc_r : (n,m,p:Z)((Zmult (Zmult n mp) = (Zmult n (Zmult m p))).

Lemma Zmult_assoc_l : (n,m,p:Z)(Zmult n (Zmult m p)) = (Zmult (Zmult n mp).

Theorem Zmult_permute : (n,m,p:Z)(Zmult n (Zmult m p)) = (Zmult m (Zmult n p)).

Lemma Zmult_1_n : (n:Z)(Zmult (POS xHn)=n.

Lemma Zmult_n_1 : (n:Z)(Zmult n (POS xH))=n.

Lemma Zmult_Sm_n : (n,m:Z) (Zplus (Zmult n mm)=(Zmult (Zs nm).

Just for compatibility with previous versions Use Zmult_plus_distr_r and Zmult_plus_distr_l rather than their synomymous


Definition Zmult_Zplus_distr := Zmult_plus_distr_r.
Definition Zmult_plus_distr := Zmult_plus_distr_l.

Module Auxiliary

Id: auxiliary.v,v 1.12 2001/04/08 17:18:57 mohring Exp
Require Export Arith.
Require fast_integer.
Require zarith_aux.
Require Decidable.
Require Peano_dec.
Require Export Compare_dec.

Definition neq := [x,y:natnot(x=y).
Definition Zne := [x,y:Znot(x=y).
Theorem add_un_Zs : (x:positive) (POS (add_un x)) = (Zs (POS x)).

Theorem inj_S : (y:nat) (inject_nat (S y)) = (Zs (inject_nat y)).

Theorem Zplus_S_n: (x,y:Z) (Zplus (Zs xy) = (Zs (Zplus x y)).

Theorem inj_plus : 
   (x,y:nat) (inject_nat (plus x y)) = (Zplus (inject_nat x) (inject_nat y)).

Theorem inj_mult : 
   (x,y:nat) (inject_nat (mult x y)) = (Zmult (inject_nat x) (inject_nat y)).

Theorem inj_neq:
   (x,y:nat) (neq x y® (Zne (inject_nat x) (inject_nat y)).

Theorem inj_le:
   (x,y:nat) (le x y® (Zle (inject_nat x) (inject_nat y)).

Theorem inj_lt: (x,y:nat) (lt x y® (Zlt (inject_nat x) (inject_nat y)).

Theorem inj_gt: (x,y:nat) (gt x y® (Zgt (inject_nat x) (inject_nat y)).

Theorem inj_ge: (x,y:nat) (ge x y® (Zge (inject_nat x) (inject_nat y)).

Theorem inj_eq: (x,y:natx=y ® (inject_nat x) = (inject_nat y).

Theorem intro_Z : 
   (x:nat) (EX y:Z | (inject_nat x)=y & 
           (Zle ZERO (Zplus (Zmult y (POS xH)) ZERO))).

Theorem inj_minus1 :
   (x,y:nat) (le y x® 
     (inject_nat (minus x y)) = (Zminus (inject_nat x) (inject_nat y)).

Theorem inj_minus2: (x,y:nat) (gt y x® (inject_nat (minus x y)) = ZERO.

Theorem dec_eq: (x,y:Z) (decidable (x=y)).

Theorem dec_Zne: (x,y:Z) (decidable (Zne x y)).

Theorem dec_Zle: (x,y:Z) (decidable (Zle x y)).

Theorem dec_Zgt: (x,y:Z) (decidable (Zgt x y)).

Theorem dec_Zge: (x,y:Z) (decidable (Zge x y)).

Theorem dec_Zlt: (x,y:Z) (decidable (Zlt x y)).
Theorem dec_eq_nat:(x,y:nat)(decidable (x=y)).

Theorem not_Zge : (x,y:Znot(Zge x y® (Zlt x y).

Theorem not_Zlt : (x,y:Znot(Zlt x y® (Zge x y).

Theorem not_Zle : (x,y:Znot(Zle x y® (Zgt x y).

Theorem not_Zgt : (x,y:Znot(Zgt x y® (Zle x y).

Theorem not_Zeq : (x,y:Znot x=y ® (Zlt x yor (Zlt y x).

Lemma new_var: (x:Z) (EX y:Z |(x=y)).

Theorem Zne_left : (x,y:Z) (Zne x y® (Zne (Zplus x (Zopp y)) ZERO).

Theorem Zegal_left : (x,y:Z) (x=y® (Zplus x (Zopp y)) = ZERO.

Theorem Zle_left : (x,y:Z) (Zle x y® (Zle ZERO (Zplus y (Zopp x))).

Theorem Zle_left_rev : (x,y:Z) (Zle ZERO (Zplus y (Zopp x))) 
         ® (Zle x y).

Theorem Zlt_left_rev : (x,y:Z) (Zlt ZERO (Zplus y (Zopp x))) 
         ® (Zlt x y).

Theorem Zlt_left :
   (x,y:Z) (Zlt x y® (Zle ZERO (Zplus (Zplus y (NEG xH)) (Zopp x))).

Theorem Zlt_left_lt :
   (x,y:Z) (Zlt x y® (Zlt ZERO (Zplus y (Zopp x))).

Theorem Zge_left : (x,y:Z) (Zge x y® (Zle ZERO (Zplus x (Zopp y))).

Theorem Zgt_left :
   (x,y:Z) (Zgt x y® (Zle ZERO (Zplus (Zplus x (NEG xH)) (Zopp y))).

Theorem Zgt_left_gt :
   (x,y:Z) (Zgt x y® (Zgt (Zplus x (Zopp y)) ZERO).

Theorem Zgt_left_rev : (x,y:Z) (Zgt (Zplus x (Zopp y)) ZERO
         ® (Zgt x y).

Theorem Zopp_one : (x:Z)(Zopp x)=(Zmult x (NEG xH)).

Theorem Zopp_Zmult_r : (x,y:Z)(Zopp (Zmult x y)) = (Zmult x (Zopp y)).

Theorem Zmult_Zopp_left : (x,y:Z)(Zmult (Zopp xy) = (Zmult x (Zopp y)).

Theorem Zopp_Zmult_l : (x,y:Z)(Zopp (Zmult x y)) = (Zmult (Zopp xy).

Theorem Zred_factor0 : (x:Zx = (Zmult x (POS xH)).

Theorem Zred_factor1 : (x:Z) (Zplus x x) = (Zmult x (POS (xO xH))).

Theorem Zred_factor2 :
   (x,y:Z) (Zplus x (Zmult x y)) = (Zmult x (Zplus (POS xHy)).

Theorem Zred_factor3 :
   (x,y:Z) (Zplus (Zmult x yx) = (Zmult x (Zplus (POS xHy)).
Theorem Zred_factor4 :
   (x,y,z:Z) (Zplus (Zmult x y) (Zmult x z)) = (Zmult x (Zplus y z)).

Theorem Zred_factor5 : (x,y:Z) (Zplus (Zmult x ZEROy) = y.

Theorem Zred_factor6 : (x:Zx = (Zplus x ZERO).

Theorem Zcompare_Zplus_compatible2 :
   (r:relation)(x,y,z,t:Z)
     (Zcompare x y) = r ® (Zcompare z t) = r ®
     (Zcompare (Zplus x z) (Zplus y t)) = r.

Lemma add_x_x : (x:positive) (add x x) = (xO x).

Theorem Zcompare_Zmult_compatible : 
     (x:positive)(y,z:Z)
       (Zcompare (Zmult (POS xy) (Zmult (POS xz)) = (Zcompare y z).

Theorem Zmult_eq:
   (x,y:Znot(x=ZERO® (Zmult y x) = ZERO ® y = ZERO.

Theorem Z_eq_mult:
   (x,y:Zy = ZERO ® (Zmult y x) = ZERO.

Theorem Zmult_le:
   (x,y:Z) (Zgt x ZERO® (Zle ZERO (Zmult y x)) ® (Zle ZERO y).

Theorem Zle_ZERO_mult : 
           (x,y:Z) (Zle ZERO x® (Zle ZERO y® (Zle ZERO (Zmult x y)).

Lemma Zgt_ZERO_mult: (a,b:Z) (Zgt a ZERO)®(Zgt b ZERO)
         ®(Zgt (Zmult a bZERO).

Theorem Zle_mult:
   (x,y:Z) (Zgt x ZERO® (Zle ZERO y® (Zle ZERO (Zmult y x)).

Theorem Zmult_lt:
   (x,y:Z) (Zgt x ZERO® (Zlt ZERO (Zmult y x)) ® (Zlt ZERO y).

Theorem Zmult_gt:
   (x,y:Z) (Zgt x ZERO® (Zgt (Zmult x yZERO® (Zgt y ZERO).

Theorem Zle_mult_approx:
   (x,y,z:Z) (Zgt x ZERO® (Zgt z ZERO® (Zle ZERO y® 
     (Zle ZERO (Zplus (Zmult y xz)).

Lemma Zle_Zmult_pos_right : 
         (a,b,c : Z
         (Zle a b® (Zle ZERO c® (Zle (Zmult a c) (Zmult b c)).

Lemma Zle_Zmult_pos_left : 
         (a,b,c : Z
         (Zle a b® (Zle ZERO c® (Zle (Zmult c a) (Zmult c b)).

Lemma Zge_Zmult_pos_right : 
         (a,b,c : Z
         (Zge a b® (Zge c ZERO® (Zge (Zmult a c) (Zmult b c)).

Lemma Zge_Zmult_pos_left : 
         (a,b,c : Z
         (Zge a b® (Zge c ZERO® (Zge (Zmult c a) (Zmult c b)).

Lemma Zge_Zmult_pos_compat : 
         (a,b,c,d : Z
         (Zge a c® (Zge b d® (Zge c ZERO® (Zge d ZERO
         ® (Zge (Zmult a b) (Zmult c d)).

Lemma Zle_mult_simpl 
   : (a,b,c:Z) (Zgt c ZERO)®(Zle (Zmult a c) (Zmult b c))®(Zle a b).

Lemma Zge_mult_simpl 
   : (a,b,c:Z) (Zgt c ZERO)®(Zge (Zmult a c) (Zmult b c))®(Zge a b).

Lemma Zgt_mult_simpl 
   : (a,b,c:Z) (Zgt c ZERO)®(Zgt (Zmult a c) (Zmult b c))®(Zgt a b).

Lemma Zgt_square_simpl
(xy : Z) (Zge x ZERO® (Zge y ZERO
         ® (Zgt (Zmult x x) (Zmult y y)) ® (Zgt x y).

Theorem Zmult_le_approx:
   (x,y,z:Z) (Zgt x ZERO® (Zgt x z® 
     (Zle ZERO (Zplus (Zmult y xz)) ® (Zle ZERO y).

Theorem OMEGA1 : (x,y:Z) (x=y® (Zle ZERO x® (Zle ZERO y).

Theorem OMEGA2 : (x,y:Z) (Zle ZERO x® (Zle ZERO y® (Zle ZERO (Zplus x y)).

Theorem OMEGA3 : (x,y,k:Z)(Zgt k ZERO)® (x=(Zmult y k)) ® (x=ZERO® (y=ZERO).

Theorem OMEGA4 :
   (x,y,z:Z)(Zgt x ZERO® (Zgt y x® not(Zplus (Zmult z yx) = ZERO.

Theorem OMEGA5: (x,y,z:Z)(x=ZERO® (y=ZERO® (Zplus x (Zmult y z)) = ZERO.
Theorem OMEGA6:
   (x,y,z:Z)(Zle ZERO x® (y=ZERO® (Zle ZERO (Zplus x (Zmult y z))).

Theorem OMEGA7:
   (x,y,z,t:Z)(Zgt z ZERO® (Zgt t ZERO® (Zle ZERO x® (Zle ZERO y® 
     (Zle ZERO (Zplus (Zmult x z) (Zmult y t))).

Theorem OMEGA8: (x,y:Z) (Zle ZERO x® (Zle ZERO y® x = (Zopp y® x = ZERO.

Theorem OMEGA9:(x,y,z,t:Zy=ZERO ® x = z ® 
   (Zplus y (Zmult (Zplus (Zopp xzt)) = ZERO.
Theorem OMEGA10:(v,c1,c2,l1,l2,k1,k2:Z)
   (Zplus (Zmult (Zplus (Zmult v c1l1k1) (Zmult (Zplus (Zmult v c2l2k2))
   = (Zplus (Zmult v (Zplus (Zmult c1 k1) (Zmult c2 k2)))
             (Zplus (Zmult l1 k1) (Zmult l2 k2))).

Theorem OMEGA11:(v1,c1,l1,l2,k1:Z)
   (Zplus (Zmult (Zplus (Zmult v1 c1l1k1l2)
   = (Zplus (Zmult v1 (Zmult c1 k1)) (Zplus (Zmult l1 k1l2)).

Theorem OMEGA12:(v2,c2,l1,l2,k2:Z)
   (Zplus l1 (Zmult (Zplus (Zmult v2 c2l2k2))
   = (Zplus (Zmult v2 (Zmult c2 k2)) (Zplus l1 (Zmult l2 k2))).

Theorem OMEGA13:(v,l1,l2:Z)(x:positive)
   (Zplus (Zplus (Zmult v (POS x)) l1) (Zplus (Zmult v (NEG x)) l2))
   = (Zplus l1 l2).

Theorem OMEGA14:(v,l1,l2:Z)(x:positive)
   (Zplus (Zplus (Zmult v (NEG x)) l1) (Zplus (Zmult v (POS x)) l2))
   = (Zplus l1 l2).
Theorem OMEGA15:(v,c1,c2,l1,l2,k2:Z)
   (Zplus (Zplus (Zmult v c1l1) (Zmult (Zplus (Zmult v c2l2k2))
   = (Zplus (Zmult v (Zplus c1 (Zmult c2 k2)))
             (Zplus l1 (Zmult l2 k2))).

Theorem OMEGA16:
   (v,c,l,k:Z)
     (Zmult (Zplus (Zmult v clk) = (Zplus (Zmult v (Zmult c k)) (Zmult l k)).

Theorem OMEGA17
   (x,y,z:Z)(Zne x ZERO® (y=ZERO® (Zne (Zplus x (Zmult y z)) ZERO).

Theorem OMEGA18:
(x,y,k:Z) (x=(Zmult y k)) ® (Zne x ZERO® (Zne y ZERO).

Theorem OMEGA19:
   (x:Z) (Zne x ZERO® 
     (Zle ZERO (Zplus x (NEG xH))) or (Zle ZERO (Zplus (Zmult x (NEG xH)) (NEG xH))).

Theorem OMEGA20:
   (x,y,z:Z)(Zne x ZERO® (y=ZERO® (Zne (Zplus x (Zmult y z)) ZERO).

Definition fast_Zplus_sym :=
[x,y:Z][P:Z ® Prop][H: (P (Zplus y x))]
   (eq_ind_r Z (Zplus y xP H (Zplus x y) (Zplus_sym x y)).

Definition fast_Zplus_assoc_r :=
[n,m,p:Z][P:Z ® Prop][H : (P (Zplus n (Zplus m p)))]
   (eq_ind_r Z (Zplus n (Zplus m p)) P H (Zplus (Zplus n mp) (Zplus_assoc_r n m p)).

Definition fast_Zplus_assoc_l :=
[n,m,p:Z][P:Z ® Prop][H : (P (Zplus (Zplus n mp))]
   (eq_ind_r Z (Zplus (Zplus n mpP H (Zplus n (Zplus m p))
             (Zplus_assoc_l n m p)).

Definition fast_Zplus_permute :=
[n,m,p:Z][P:Z ® Prop][H : (P (Zplus m (Zplus n p)))]
   (eq_ind_r Z (Zplus m (Zplus n p)) P H (Zplus n (Zplus m p))
             (Zplus_permute n m p)).

Definition fast_OMEGA10 :=
[v,c1,c2,l1,l2,k1,k2:Z][P:Z ® Prop]
[H : (P (Zplus (Zmult v (Zplus (Zmult c1 k1) (Zmult c2 k2)))
                 (Zplus (Zmult l1 k1) (Zmult l2 k2))))]
   (eq_ind_r Z
             (Zplus (Zmult v (Zplus (Zmult c1 k1) (Zmult c2 k2)))
             (Zplus (Zmult l1 k1) (Zmult l2 k2)))
             P H
           (Zplus (Zmult (Zplus (Zmult v c1l1k1)
                   (Zmult (Zplus (Zmult v c2l2k2))
         (OMEGA10 v c1 c2 l1 l2 k1 k2)).

Definition fast_OMEGA11 :=
[v1,c1,l1,l2,k1:Z][P:Z ® Prop]
[H : (P (Zplus (Zmult v1 (Zmult c1 k1)) (Zplus (Zmult l1 k1l2)))]
   (eq_ind_r Z
     (Zplus (Zmult v1 (Zmult c1 k1)) (Zplus (Zmult l1 k1l2))
     P H
     (Zplus (Zmult (Zplus (Zmult v1 c1l1k1l2)
     (OMEGA11 v1 c1 l1 l2 k1)).
Definition fast_OMEGA12 :=
[v2,c2,l1,l2,k2:Z][P:Z ® Prop]
[H : (P (Zplus (Zmult v2 (Zmult c2 k2)) (Zplus l1 (Zmult l2 k2))))]
   (eq_ind_r Z
     (Zplus (Zmult v2 (Zmult c2 k2)) (Zplus l1 (Zmult l2 k2)))
     P H
     (Zplus l1 (Zmult (Zplus (Zmult v2 c2l2k2))
     (OMEGA12 v2 c2 l1 l2 k2)).

Definition fast_OMEGA15 :=
[v,c1,c2,l1,l2,k2 :Z][P:Z ® Prop]
[H : (P (Zplus (Zmult v (Zplus c1 (Zmult c2 k2))) (Zplus l1 (Zmult l2 k2))))]
   (eq_ind_r Z
     (Zplus (Zmult v (Zplus c1 (Zmult c2 k2))) (Zplus l1 (Zmult l2 k2)))
     P H
     (Zplus (Zplus (Zmult v c1l1) (Zmult (Zplus (Zmult v c2l2k2))
     (OMEGA15 v c1 c2 l1 l2 k2)).
Definition fast_OMEGA16 :=
[v,c,l,k :Z][P:Z ® Prop]
[H : (P (Zplus (Zmult v (Zmult c k)) (Zmult l k)))]
   (eq_ind_r Z
     (Zplus (Zmult v (Zmult c k)) (Zmult l k))
     P H
     (Zmult (Zplus (Zmult v clk)
     (OMEGA16 v c l k)).

Definition fast_OMEGA13 :=
[v,l1,l2 :Z][x:positive][P:Z ® Prop]
[H : (P (Zplus l1 l2))]
   (eq_ind_r Z
     (Zplus l1 l2)
     P H
     (Zplus (Zplus (Zmult v (POS x)) l1) (Zplus (Zmult v (NEG x)) l2))
     (OMEGA13 v l1 l2 x )).

Definition fast_OMEGA14 :=
[v,l1,l2 :Z][x:positive][P:Z ® Prop]
[H : (P (Zplus l1 l2))]
   (eq_ind_r Z
     (Zplus l1 l2)
     P H
     (Zplus (Zplus (Zmult v (NEG x)) l1) (Zplus (Zmult v (POS x)) l2))
     (OMEGA14 v l1 l2 x )).
Definition fast_Zred_factor0:=
[x:Z][P:Z ® Prop]
[H : (P (Zmult x (POS xH)) )]
   (eq_ind_r Z
     (Zmult x (POS xH))
     P H
     x
     (Zred_factor0 x)).

Definition fast_Zopp_one :=
[x:Z][P:Z ® Prop]
[H : (P (Zmult x (NEG xH)))]
   (eq_ind_r Z
     (Zmult x (NEG xH))
     P H
     (Zopp x)
     (Zopp_one x)).

Definition fast_Zmult_sym :=
[x,y :Z][P:Z ® Prop]
[H : (P (Zmult y x))]
   (eq_ind_r Z
(Zmult y x)
     P H
(Zmult x y)
     (Zmult_sym x y )).

Definition fast_Zopp_Zplus :=
[x,y :Z][P:Z ® Prop]
[H : (P (Zplus (Zopp x) (Zopp y)) )]
   (eq_ind_r Z
     (Zplus (Zopp x) (Zopp y))
     P H
     (Zopp (Zplus x y))
     (Zopp_Zplus x y )).

Definition fast_Zopp_Zopp :=
[x:Z][P:Z ® Prop]
[H : (P x )] (eq_ind_r Z x P H (Zopp (Zopp x)) (Zopp_Zopp x)).

Definition fast_Zopp_Zmult_r :=
[x,y:Z][P:Z ® Prop]
[H : (P (Zmult x (Zopp y)))]
   (eq_ind_r Z
     (Zmult x (Zopp y))
     P H
     (Zopp (Zmult x y))
     (Zopp_Zmult_r x y )).

Definition fast_Zmult_plus_distr :=
[n,m,p:Z][P:Z ® Prop]
[H : (P (Zplus (Zmult n p) (Zmult m p)))]
   (eq_ind_r Z
     (Zplus (Zmult n p) (Zmult m p))
     P H
     (Zmult (Zplus n mp)
     (Zmult_plus_distr_l n m p)).
Definition fast_Zmult_Zopp_left:=
[x,y:Z][P:Z ® Prop]
[H : (P (Zmult x (Zopp y)))]
   (eq_ind_r Z
     (Zmult x (Zopp y))
     P H
     (Zmult (Zopp xy)
     (Zmult_Zopp_left x y)).

Definition fast_Zmult_assoc_r :=
[n,m,p :Z][P:Z ® Prop]
[H : (P (Zmult n (Zmult m p)))]
   (eq_ind_r Z
     (Zmult n (Zmult m p))
     P H
     (Zmult (Zmult n mp)
     (Zmult_assoc_r n m p)).

Definition fast_Zred_factor1 :=
[x:Z][P:Z ® Prop]
[H : (P (Zmult x (POS (xO xH))) )]
   (eq_ind_r Z
     (Zmult x (POS (xO xH)))
     P H
     (Zplus x x)
     (Zred_factor1 x)).

Definition fast_Zred_factor2 :=
[x,y:Z][P:Z ® Prop]
[H : (P (Zmult x (Zplus (POS xHy)))]
   (eq_ind_r Z
     (Zmult x (Zplus (POS xHy))
     P H
     (Zplus x (Zmult x y))
     (Zred_factor2 x y)).
Definition fast_Zred_factor3 :=
[x,y:Z][P:Z ® Prop]
[H : (P (Zmult x (Zplus (POS xHy)))]
   (eq_ind_r Z
     (Zmult x (Zplus (POS xHy))
     P H
     (Zplus (Zmult x yx)
     (Zred_factor3 x y)).

Definition fast_Zred_factor4 :=
[x,y,z:Z][P:Z ® Prop]
[H : (P (Zmult x (Zplus y z)))]
   (eq_ind_r Z
     (Zmult x (Zplus y z))
     P H
     (Zplus (Zmult x y) (Zmult x z))
     (Zred_factor4 x y z)).

Definition fast_Zred_factor5 :=
[x,y:Z][P:Z ® Prop]
[H : (P y)]
   (eq_ind_r Z
     y
     P H
     (Zplus (Zmult x ZEROy)
     (Zred_factor5 x y)).

Definition fast_Zred_factor6 :=
[x :Z][P:Z ® Prop]
[H : (P(Zplus x ZERO) )]
   (eq_ind_r Z
     (Zplus x ZERO)
     P H
     x
     (Zred_factor6 x )).

Module Zsyntax

Id: Zsyntax.v,v 1.7 2001/03/15 13:38:55 filliatr Exp
Require Export fast_integer.
Require Export zarith_aux.

Axiom My_special_variable0 : positive®positive.
Axiom My_special_variable1 : positive®positive.

Grammar znatural ident :=
   nat_id [ prim:var($id) ] ® [$id]

with number :=

with negnumber :=

with formula : constr :=
   form_expr [ expr($p) ] ® [$p]
form_eq [ expr($p"=" expr($c) ] ® [ (eq Z $p $c) ]
form_le [ expr($p"<=" expr($c) ] ® [ (Zle $p $c) ]
form_lt [ expr($p"<" expr($c) ] ® [ (Zlt $p $c) ]
form_ge [ expr($p">=" expr($c) ] ® [ (Zge $p $c) ]
form_gt [ expr($p">" expr($c) ] ® [ (Zgt $p $c) ]
form_eq_eq [ expr($p"=" expr($c"=" expr($c1) ]
               ® [ (eq Z $p $c)&(eq Z $c $c1) ]
form_le_le [ expr($p"<=" expr($c"<=" expr($c1) ]
               ® [ (Zle $p $c)&(Zle $c $c1) ]
form_le_lt [ expr($p"<=" expr($c"<" expr($c1) ]
               ® [ (Zle $p $c)&(Zlt $c $c1) ]
form_lt_le [ expr($p"<" expr($c"<=" expr($c1) ]
               ® [ (Zlt $p $c)&(Zle $c $c1) ]
form_lt_lt [ expr($p"<" expr($c"<" expr($c1) ]
               ® [ (Zlt $p $c)&(Zlt $c $c1) ]
form_neq [ expr($p"<>" expr($c) ] ® [ not(eq Z $p $c) ]
form_comp [ expr($p"?=" expr($c) ] ® [ (Zcompare $p $c) ]

with expr : constr :=
   expr_plus [ expr($p"+" expr($c) ] ® [ (Zplus $p $c) ]
expr_minus [ expr($p"-" expr($c) ] ® [ (Zminus $p $c) ]
expr2 [ expr2($e) ] ® [$e]

with expr2 : constr :=
   expr_mult [ expr2($p"*" expr2($c) ] ® [ (Zmult $p $c) ]
expr1 [ expr1($e) ] ® [$e]

with expr1 : constr :=
   expr_abs [ "|" expr($c"|" ] ® [ (Zabs $c) ]
expr0 [ expr0($e) ] ® [$e]

with expr0 : constr :=
   expr_id [ constr:global($c) ] ® [ $c ]
expr_com [ "[" constr:constr($c"]" ] ® [$c]
expr_appl [ "(" application($a")" ] ® [$a]
expr_num [ number($s) ] ® [$s ]
expr_negnum [ "-" negnumber($n) ] ® [ $n ]
expr_inv [ "-" expr0($c) ] ® [ (Zopp $c) ]

with application : constr :=
   apply [ application($pexpr($c1) ] ® [ ($p $c1) ]
pair [ expr($p"," expr($c) ] ® [ ($p, $c) ]
appl0 [ expr($a) ] ® [$a]
.

Grammar constr constr0 :=
   z_in_com [ "`" znatural:formula($c"`" ] ® [$c].

Grammar constr pattern :=
   z_in_pattern [ "`" znatural:number($c"`" ] ® [$c].

The symbols "`" "`" must be printed just once at the top of the expession, to avoid printings like |``x` + `y`` < `45`| for |x + y < 45|. So when a Z-expression is to be printed, its sub-expresssions are enclosed into an ast (ZEXPR subexpr). (ZEXPR s) is printed like s but without symbols "`" "`" around.
There is just one problem: NEG and Zopp have the same printing rules. If Zopp is opaque, we may not be able to solve a goal like ` -5 = -5 ` by reflexivity. (In fact, this precise Goal is solved by the Reflexivity tactic, but more complex problems may arise
SOLUTION : Print (Zopp 5) for constants and -x for variables

Module ZArith_dec

Require Sumbool.

Require fast_integer.
Require zarith_aux.
Require auxiliary.
Require Zsyntax.

Lemma Dcompare_inf : (r:relation) {r=EGAL} + {r=INFERIEUR} + {r=SUPERIEUR}.

Lemma Zcompare_rec :
   (P:Set)(x,y:Z)
     ((Zcompare x y)=EGAL ® P®
     ((Zcompare x y)=INFERIEUR ® P®
     ((Zcompare x y)=SUPERIEUR ® P®
     P.

Section decidability.

Local inf_decidable := [P:Prop] {P}+{notP}.

Variables x,y : Z.

Theorem Z_eq_dec : (inf_decidable (x=y)).

Theorem Z_lt_dec : (inf_decidable (Zlt x y)).

Theorem Z_le_dec : (inf_decidable (Zle x y)).

Theorem Z_gt_dec : (inf_decidable (Zgt x y)).

Theorem Z_ge_dec : (inf_decidable (Zge x y)).

Theorem Z_lt_ge_dec : {`x < y`}+{`x ³ y`}.

Theorem Z_le_gt_dec : {`x £ y`}+{`x > y`}.

Theorem Z_gt_le_dec : {`x > y`}+{`x £ y`}.

Theorem Z_ge_lt_dec : {`x ³ y`}+{`x < y`}.

Theorem Z_le_lt_eq_dec : `x £ y® {`x < y`}+{x=y}.

End decidability.

Theorem Z_zerop : (x:Z){(`x = 0`)}+{(`x ¹ 0`)}.

Definition Z_notzerop := [x:Z](sumbool_not ? ? (Z_zerop x)).

Definition Z_noteq_dec := [x,y:Z](sumbool_not ? ? (Z_eq_dec x y)).

Module Wf_Z

Id: WfZ.v,v 1.6 2001/03/15 13:38:55 filliatr Exp
Require fast_integer.
Require zarith_aux.
Require auxiliary.
Require Zsyntax.

Our purpose is to write an induction shema for 0,1,2,... similar to the nat schema (Theorem Natlike_rec). For that the following implications will be used :
 (n:nat)(Q n)==(n:nat)(P (inject_nat n)) ===> (x:Z)`x > 0) -> (P x)

             /\
      ||
      ||

  (Q O) (n:nat)(Q n)->(Q (S n)) <=== (P 0) (x:Z) (P x) -> (P (Zs x))

                               <=== (inject_nat (S n))=(Zs (inject_nat n))

                               <=== inject_nat_complete

  Then the  diagram will be closed and the theorem proved. 

Lemma inject_nat_complete :
   (x:Z)`0 £ x® (EX n:nat | x=(inject_nat n)).

Lemma ZL4_inf: (y:positive) { h:nat | (convert y)=(S h) }.

Lemma inject_nat_complete_inf :
   (x:Z)`0 £ x® { n:nat | (x=(inject_nat n)) }.

Lemma inject_nat_prop :
   (P:Z®Prop)((n:nat)(P (inject_nat n))) ® 
     (x:Z) `0 £ x® (P x).

Lemma ZERO_le_inj :
   (n:nat) `0 £ (inject_nat n)`.

Lemma natlike_ind : (P:Z®Prop) (P `0`) ®
   ((x:Z)(`0 £ x® (P x® (P (Zs x)))) ®
   (x:Z) `0 £ x® (P x).

Lemma Z_lt_induction : 
   (P:Z®Prop)
       ((x:Z)((y:Z)`0 £ y < x`®(P y))®(P x))
   ® (x:Z)`0 £ x`®(P x).

Module Zmisc

Module Zmisc.v :
Definitions et lemmes complementaires
Division euclidienne
Patrick Loiseleur, avril 1997
Require fast_integer.
Require zarith_aux.
Require auxiliary.
Require Zsyntax.
Require Bool.

********************************************************************* Overview of the sections of this file :

- logic : Logic complements. - numbers : a few very simple lemmas for manipulating the constructors POS, NEG, ZERO and xI, xO, xH - registers : defining arrays of bits and their relation with integers. - iter : the n-th iterate of a function is defined for n:nat and n:positive. The two notions are identified and an invariant conservation theorem is proved. - recursors : Here a nat-like recursor is built. - arith : lemmas about < £ ?= + × ...

***********************************************************************
Section logic.

Lemma rename : (A:Set)(P:A®Prop)(x:A) ((y:A)(x=y)®(P y)) ® (P x).

End logic.

Section numbers.

Definition entier_of_Z := [z:Z]Case z of Nul Pos Pos end.
Definition Z_of_entier := [x:entier]Case x of ZERO POS end.

Lemma POS_xI : (p:positive) (POS (xI p))=`2×(POS p) + 1`.
Lemma POS_xO : (p:positive) (POS (xO p))=`2×(POS p)`.
Lemma NEG_xI : (p:positive) (NEG (xI p))=`2×(NEG p) - 1`.
Lemma NEG_xO : (p:positive) (NEG (xO p))=`2×(NEG p)`.

Lemma POS_add : (p,p':positive)`(POS (add p p'))=(POS p)+(POS p')`.

Lemma NEG_add : (p,p':positive)`(NEG (add p p'))=(NEG p)+(NEG p')`.

Definition Zle_bool := [x,y:Z]Case `x ?= yof true true false end.
Definition Zge_bool := [x,y:Z]Case `x ?= yof true false true end.
Definition Zlt_bool := [x,y:Z]Case `x ?= yof false true false end.
Definition Zgt_bool := [x,y:Z]Case ` x ?= yof false false true end.
Definition Zeq_bool := [x,y:Z]Cases `x ?= yof EGAL Þ true | _ Þ false end.
Definition Zneq_bool := [x,y:Z]Cases `x ?= yof EGAL Þfalse | _ Þ true end.

End numbers.

Section iterate.

l'itere n-ieme d'une fonction f
Fixpoint iter_nat[n:nat] : (A:Set)(f:A®A)A®A :=
   [A:Set][f:A®A][x:A]
     Cases n of
       O Þ x
     | (S n'Þ (f (iter_nat n' A f x))
     end.

Fixpoint iter_pos[n:positive] : (A:Set)(f:A®A)A®A :=
   [A:Set][f:A®A][x:A]
     Cases n of
         xH Þ (f x)
       | (xO n'Þ (iter_pos n' A f (iter_pos n' A f x))
       | (xI n'Þ (f (iter_pos n' A f (iter_pos n' A f x)))
     end.

Definition iter :=
   [n:Z][A:Set][f:A®A][x:A]Cases n of
     ZERO Þ x
   | (POS pÞ (iter_pos p A f x)
   | (NEG pÞ x
   end.

Theorem iter_nat_plus :
   (n,m:nat)(A:Set)(f:A®A)(x:A)
     (iter_nat (plus n mA f x)=(iter_nat n A f (iter_nat m A f x)).

Theorem iter_convert : (n:positive)(A:Set)(f:A®A)(x:A)
   (iter_pos n A f x) = (iter_nat (convert nA f x).

Theorem iter_pos_add :
   (n,m:positive)(A:Set)(f:A®A)(x:A)
     (iter_pos (add n mA f x)=(iter_pos n A f (iter_pos m A f x)).

Preservation of invariants : if f : A->A preserves the invariant Inv, then the iterates of f also preserve it.
Theorem iter_nat_invariant :
   (n:nat)(A:Set)(f:A®A)(Inv:A®Prop)
   ((x:A)(Inv x)®(Inv (f x)))®(x:A)(Inv x)®(Inv (iter_nat n A f x)).

Theorem iter_pos_invariant :
   (n:positive)(A:Set)(f:A®A)(Inv:A®Prop)
   ((x:A)(Inv x)®(Inv (f x)))®(x:A)(Inv x)®(Inv (iter_pos n A f x)).

End iterate.

Section arith.

Lemma ZERO_le_POS : (p:positive) `0 £ (POS p)`.

Lemma POS_gt_ZERO : (p:positive) `(POS p) > 0`.

Lemma Zlt_ZERO_pred_le_ZERO : (x:Z) `0 < x® `0 £ (Zpred x)`.

Zeven, Zodd, Zdiv2 and their related properties
Definition Zeven :=
   [z:Z]Cases z of ZERO Þ True
                 | (POS (xO _)) Þ True
                 | (NEG (xO _)) Þ True
                 | _ Þ False
                 end.

Definition Zodd :=
   [z:Z]Cases z of (POS xHÞ True
                 | (NEG xHÞ True
                 | (POS (xI _)) Þ True
                 | (NEG (xI _)) Þ True
                 | _ Þ False
                 end.

Definition Zeven_bool :=
   [z:Z]Cases z of ZERO Þ true
                 | (POS (xO _)) Þ true
                 | (NEG (xO _)) Þ true
                 | _ Þ false
                 end.

Definition Zodd_bool :=
   [z:Z]Cases z of ZERO Þ false
                 | (POS (xO _)) Þ false
                 | (NEG (xO _)) Þ false
                 | _ Þ true
                 end.

Lemma Zeven_odd_dec : (z:Z) { (Zeven z) }+{ (Zodd z) }.

Lemma Zeven_dec : (z:Z) { (Zeven z) }+{ not(Zeven z) }.

Lemma Zodd_dec : (z:Z) { (Zodd z) }+{ not(Zodd z) }.

Lemma Zeven_not_Zodd : (z:Z)(Zeven z® not(Zodd z).

Lemma Zodd_not_Zeven : (z:Z)(Zodd z® not(Zeven z).

Hints Unfold Zeven Zodd : zarith.

Zdiv2 is defined on all Z, but notice that for odd negative integers it is not the euclidean quotient: in that case we have n = 2*(n/2)-1


Definition Zdiv2_pos :=
   [z:positive]Cases z of xH Þ xH
                         | (xO pÞ p
                         | (xI pÞ p
                       end.

Definition Zdiv2 :=
   [z:Z]Cases z of ZERO Þ ZERO
                 | (POS xHÞ ZERO
                 | (POS pÞ (POS (Zdiv2_pos p))
                 | (NEG xHÞ ZERO
                 | (NEG pÞ (NEG (Zdiv2_pos p))
                 end.

Lemma Zeven_div2 : (x:Z) (Zeven x® `x = 2×(Zdiv2 x)`.

Lemma Zodd_div2 : (x:Z) `x ³ 0` ® (Zodd x® `x = 2×(Zdiv2 x)+1`.

Lemma Z_modulo_2 : (x:Z) `x ³ 0` ® { y:Z | `x=2×y` }+{ y:Z | `x=2×y+1` }.

Very simple
Lemma Zminus_Zplus_compatible :
   (x,y,n:Z) `(x+n) - (y+n) = x - y`.

Decompose an egality between two ?= relations into 3 implications
Theorem Zcompare_egal_dec :
     (x1,y1,x2,y2:Z)
     (`x1 < y1`®`x2 < y2`)
       ®(`x1 ?= y1`=EGAL ® `x2 ?= y2`=EGAL)
         ®(`x1 > y1`®`x2 > y2`)®`x1 ?= y1`=`x2 ?= y2`.

Theorem Zcompare_elim :
   (c1,c2,c3:Prop)(x,y:Z)
     ((x=y® c1®(`x < y® c2®(`x > y`® c3)
         ® Case `x ?= y`of c1 c2 c3 end.

Lemma Zcompare_x_x : (x:Z) `x ?= x` = EGAL.

Lemma Zlt_not_eq : (x,y:Z)`x < y® notx=y.

Lemma Zcompare_eq_case : 
   (c1,c2,c3:Prop)(x,y:Zc1 ® x=y ® (Case `x ?= yof c1 c2 c3 end).

Four very basic lemmas about Zle, Zlt, Zge, Zgt
Lemma Zle_Zcompare :
   (x,y:Z)`x £ y® Case `x ?= yof True True False end.

Lemma Zlt_Zcompare :
   (x,y:Z)`x < y® Case `x ?= yof False True False end.

Lemma Zge_Zcompare :
   (x,y:Z)` x ³ y`® Case `x ?= yof True False True end.

Lemma Zgt_Zcompare :
   (x,y:Z)`x > y® Case `x ?= yof False False True end.

Lemmas about Zmin
Lemma Zmin_plus : (x,y,n:Z) `(Zmin (x+n)(y+n))=(Zmin x y)+n`.

Lemmas about absolu
Lemma absolu_lt : (x,y:Z) `0 £ x < y® (lt (absolu x) (absolu y)).

End arith.

Module ZArith

Library for manipulating integers based on binary encoding
Require Export fast_integer.
Require Export zarith_aux.
Require Export auxiliary.
Require Export Zsyntax.
Require Export ZArith_dec.
Require Export Zmisc.
Require Export Wf_Z.

Hints Resolve Zle_n Zplus_sym Zplus_assoc Zmult_sym Zmult_assoc
   Zero_left Zero_right Zmult_one Zplus_inverse_l Zplus_inverse_r
   Zmult_plus_distr_l Zmult_plus_distr_r : zarith.

4   Reals

This library contains an axiomatization of real numbers. The main file is Reals.v.

Module TypeSyntax

Id: TypeSyntax.v,v 1.2 2001/03/15 13:38:53 filliatr Exp
Or and Exist in Type
Inductive sumboolT [A,B:Prop]:Type:=
     leftT : A®(sumboolT A B)
   |rightTB®(sumboolT A B).

Inductive sumorT [A:Type;B:Prop]:Type:=
     inleftT : A®(sumorT A B)
   |inrightTB®(sumorT A B).

Inductive sigT [A:Set;P:A®Prop]:Type:=
     existT: (x:A)(P x)®(sigT A P).

Inductive sigTT [A:Type;P:A®Prop]:Type:=
     existTT: (x:A)(P x)®(sigTT A P).

Module Rsyntax

Require Export Rdefinitions.

Axiom NRplus : R®R®R.

Grammar rnatural ident :=
   nat_id [ prim:var($id) ] ® [$id]

with rnegnumber :=
   neg_expr [ "-" rnumber ($c) ] ® [<<(Ropp $c)>>]

with rnumber :=

with rformula :=
   form_expr [ rexpr($p) ] ® [$p]
form_eq [ rexpr($p"==" rexpr($c) ] ® [<<(eqT R $p $c)>>]
form_le [ rexpr($p"<=" rexpr($c) ] ® [<<(Rle $p $c)>>]
form_lt [ rexpr($p"<" rexpr($c) ] ® [<<(Rlt $p $c)>>]
form_ge [ rexpr($p">=" rexpr($c) ] ® [<<(Rge $p $c)>>]
form_gt [ rexpr($p">" rexpr($c) ] ® [<<(Rgt $p $c)>>]
form_eq_eq [ rexpr($p"==" rexpr($c"==" rexpr($c1) ]
               ® [<<(eqT R $p $c)&(eqT R $c $c1)>>]
form_le_le [ rexpr($p"<=" rexpr($c"<=" rexpr($c1) ]
               ® [<<(Rle $p $c)&(Rle $c $c1)>>]
form_le_lt [ rexpr($p"<=" rexpr($c"<" rexpr($c1) ]
               ® [<<(Rle $p $c)&(Rlt $c $c1)>>]
form_lt_le [ rexpr($p"<" rexpr($c"<=" rexpr($c1) ]
               ® [<<(Rlt $p $c)&(Rle $c $c1)>>]
form_lt_lt [ rexpr($p"<" rexpr($c"<" rexpr($c1) ]
               ® [<<(Rlt $p $c)&(Rlt $c $c1)>>]
form_neq [ rexpr($p"<>" rexpr($c) ] ® [<< not(eqT R $p $c)>>]

with rexpr :=
   expr_plus [ rexpr($p"+" rexpr($c) ] ® [<<(Rplus $p $c)>>]
expr_minus [ rexpr($p"-" rexpr($c) ] ® [<<(Rminus $p $c)>>]
rexpr2 [ rexpr2($e) ] ® [$e]

with rexpr2 :=
   expr_mult [ rexpr2($p"*" rexpr2($c) ] ® [<<(Rmult $p $c)>>]
rexpr0 [ rexpr0($e) ] ® [$e]

with rexpr0 :=
   expr_id [ constr:global($c) ] ® [$c]
expr_hole [ "?" ] ® [<< ? >>]
expr_com [ "[" constr:constr($c"]" ] ® [$c]
expr_appl [ "(" rapplication($a")" ] ® [$a]
expr_num [ rnumber($s) ] ® [$s ]
expr_negnum [ "-" rnegnumber($n) ] ® [ $n ]
expr_div [ rexpr0($p"/" rexpr0($c) ] ® [<<(Rdiv $p $c)>>]
expr_opp [ "-" rexpr0($c) ] ® [<<(Ropp $c)>>]
expr_inv [ "1" "/" rexpr0($c) ] ® [<<(Rinv $c)>>]

with rapplication :=
   apply [ rapplication($prexpr($c1) ] ® [<<($p $c1)>>]
pair [ rexpr($p"," rexpr($c) ] ® [<<($p, $c)>>]
appl0 [ rexpr($a) ] ® [$a].

Grammar command command0 :=
   r_in_com [ "``" rnatural:rformula($c"``" ] ® [$c].

Grammar command atomic_pattern :=
   r_in_pattern [ "``" rnatural:rnumber($c"``" ] ® [$c].

* pp *
pb: on rajoute des () lorsque les constantes terminent par 1 lors de l'appel avec NRplus

Module Rdefinitions

Definitions for the axiomatization
Require Export ZArith.
Require Export TypeSyntax.

Parameter R:Type.
Parameter R0:R.
Parameter R1:R.
Parameter Rplus:R®R®R.
Parameter Rmult:R®R®R.
Parameter Ropp:R®R.
Parameter Rinv:R®R.
Parameter Rlt:R®R®Prop.
Parameter up:R®Z.
(*********************************************************)

Definition Rgt:R®R®Prop:=[r1,r2:R](Rlt r2 r1).

Definition Rle:R®R®Prop:=[r1,r2:R]((Rlt r1 r2)or(r1==r2)).

Definition Rge:R®R®Prop:=[r1,r2:R]((Rgt r1 r2)or(r1==r2)).

Definition Rminus:R®R®R:=[r1,r2:R](Rplus r1 (Ropp r2)).

Definition Rdiv:R®R®R:=[r1,r2:R](Rmult r1 (Rinv r2)).

Module Raxioms

Axiomatisation of the classical reals
Require Export ZArith.
Require Export Rsyntax.
Require Export TypeSyntax.

Field axioms
Addition
Axiom Rplus_sym:(r1,r2:R)``r1+r2==r2+r1``.
Hints Resolve Rplus_sym : real.

Axiom Rplus_assoc:(r1,r2,r3:R)``(r1+r2)+r3==r1+(r2+r3)``.
Hints Resolve Rplus_assoc : real.

Axiom Rplus_Ropp_r:(r:R)``r+(-r)==0``.
Hints Resolve Rplus_Ropp_r : real v62.

Axiom Rplus_Ol:(r:R)``0+r==r``.
Hints Resolve Rplus_Ol : real.
Multiplication
Axiom Rmult_sym:(r1,r2:R)``r1×r2==r2×r1``.
Hints Resolve Rmult_sym : real v62.

Axiom Rmult_assoc:(r1,r2,r3:R)``(r1×r2r3==r1×(r2×r3)``.
Hints Resolve Rmult_assoc : real v62.

Axiom Rinv_l:(r:R)``r¹0``®``(1/rr==1``.
Hints Resolve Rinv_l : real.

Axiom Rmult_1l:(r:R)``1×r==r``.
Hints Resolve Rmult_1l : real.

Axiom R1_neq_R0:``1¹0``.
Hints Resolve R1_neq_R0 : real.
Distributivity
Axiom Rmult_Rplus_distr:(r1,r2,r3:R)``r1×(r2+r3)==(r1×r2)+(r1×r3)``.
Hints Resolve Rmult_Rplus_distr : real v62.

Order axioms
Total Order
Axiom total_order_T:(r1,r2:R)(sumorT (sumboolT ``r1<r2`` r1==r2) ``r1>r2``).
Lower
Axiom Rlt_antisym:(r1,r2:R)``r1<r2`` ® not ``r2<r1``.

Axiom Rlt_trans:(r1,r2,r3:R)
   ``r1<r2``®``r2<r3``®``r1<r3``.

Axiom Rlt_compatibility:(r,r1,r2:R)``r1<r2``®``r+r1<r+r2``.

Axiom Rlt_monotony:(r,r1,r2:R)``0<r``®``r1<r2``®``r×r1<r×r2``.

Hints Resolve Rlt_antisym Rlt_compatibility Rlt_monotony : real.
Injection from N to R
Fixpoint INR [n:nat]:R:=(Cases n of
                           O Þ ``0``
                           |(S OÞ ``1``
                           |(S nÞ ``(INR n)+1``
                         end).
Injection from Z to R
Definition IZR:Z®R:=[z:Z](Cases z of
                           ZERO Þ ``0``
                         |(POS nÞ (INR (convert n))
                         |(NEG nÞ ``-(INR (convert n))``
                             end).
R Archimedian
Axiom archimed:(r:R)``(IZR (up r)) > r``&``(IZR (up r))-r £ 1``.
R Complete
Definition is_upper_bound:=[E:R®Prop][m:R](x:R)(E x)®``x £ m``.

Definition bound:=[E:R®Prop](ExT [m:R](is_upper_bound E m)).

Definition is_lub:=[E:R®Prop][m:R]
     (is_upper_bound E m)&(b:R)(is_upper_bound E b)®``m £ b``.

Axiom complet:(E:R®Prop)(bound E)®
               (ExT [x:R] (E x))®
               (ExT [m:R](is_lub E m)).

Module Rbase

Basic lemmas for the classical reals numbers
Require Export Raxioms.
Require Export ZArithRing.
Require Omega.
Instantiating Ring tactic on reals
Lemma RTheory : (Ring_Theory Rplus Rmult R1 R0 Ropp [x,y:R]false).

Add Abstract Ring R Rplus Rmult R1 R0 Ropp [x,y:R]false RTheory.
Relation between orders and equality
Lemma Rlt_antirefl:(r:R)not``r<r``.
Hints Resolve Rlt_antirefl : real.

Lemma Rlt_not_eq:(r1,r2:R)``r1<r2``®``r1¹r2``.

Lemma Rgt_not_eq:(r1,r2:R)``r1>r2``®``r1¹r2``.

Lemma imp_not_Req:(r1,r2:R)(``r1<r2``or ``r1>r2``) ® ``r1¹r2``.
Hints Resolve imp_not_Req : real.
Reasoning by case on equalities and order
Lemma Req_EM:(r1,r2:R)(r1==r2)or``r1¹r2``.
Hints Resolve Req_EM : real.

Lemma total_order:(r1,r2:R)``r1<r2``or(r1==r2)or``r1>r2``.

Lemma not_Req:(r1,r2:R)``r1¹r2``®(``r1<r2``or``r1>r2``).
Order Lemma : relating <, >, £ and ³
Lemma Rlt_le:(r1,r2:R)``r1<r2``® ``r1£r2``.
Hints Resolve Rlt_le : real.

Lemma Rle_ge : (r1,r2:R)``r1£r2`` ® ``r2³r1``.

Lemma Rge_le : (r1,r2:R)``r1³r2`` ® ``r2£r1``.

Lemma not_Rle:(r1,r2:R)not(``r1£r2``)®``r1>r2``.

Hints 
(**********)
Lemma Rlt_le_not:(r1,r2:R)``r2<r1``®not(``r1£r2``).

Lemma Rle_not:(r1,r2:R)``r1>r2`` ® not(``r1£r2``).

Hints 
(**********)
Lemma Rlt_ge_not:(r1,r2:R)``r1<r2``®not(``r1³r2``).

Hints 
(**********)
Lemma eq_Rle:(r1,r2:R)r1==r2®``r1£r2``.
Hints 
Lemma eq_Rge:(r1,r2:R)r1==r2®``r1³r2``.
Hints 
Lemma eq_Rle_sym:(r1,r2:R)r2==r1®``r1£r2``.
Hints 
Lemma eq_Rge_sym:(r1,r2:R)r2==r1®``r1³r2``.
Hints 
Lemma Rle_antisym : (r1,r2:R)``r1£r2`` ® ``r2£r1``® r1==r2.
Hints Resolve Rle_antisym : real.

Lemma Rle_le_eq:(r1,r2:R)(``r1£r2``&``r2£r1``)«(r1==r2).

Lemma Rle_trans:(r1,r2,r3:R) ``r1£r2``®``r2£r3``®``r1£r3``.

Lemma Rle_lt_trans:(r1,r2,r3:R)``r1£r2``®``r2<r3``®``r1<r3``.

Lemma Rlt_le_trans:(r1,r2,r3:R)``r1<r2``®``r2£r3``®``r1<r3``.
Decidability of the order
Lemma total_order_Rlt:(r1,r2:R)(sumboolT ``r1<r2`` not(``r1<r2``)).

Lemma total_order_Rle:(r1,r2:R)(sumboolT ``r1£r2`` not(``r1£r2``)).

Lemma total_order_Rgt:(r1,r2:R)(sumboolT ``r1>r2`` not(``r1>r2``)).

Lemma total_order_Rge:(r1,r2:R)(sumboolT (``r1³r2``) not(``r1³r2``)).

Lemma total_order_Rlt_Rle:(r1,r2:R)(sumboolT ``r1<r2`` ``r2£r1``).

Lemma total_order_Rle_Rlt_eq :(r1,r2:R)``r1£r2``® (sumboolT ``r1<r2`` ``r1==r2``).

Lemma inser_trans_R:(n,m,p,q:R)``n£m<p``® (sumboolT ``n£m<q`` ``q£m<p``).
Field Lemmas
This part contains lemma involving the Fields operations
Addition
Lemma Rplus_ne:(r:R)``r+0==r``&``0+r==r``.
Hints Resolve Rplus_ne : real v62.

Lemma Rplus_Or:(r:R)``r+0==r``.
Hints Resolve Rplus_Or : real.

Lemma Rplus_Ropp_l:(r:R)``(-r)+r==0``.
Hints Resolve Rplus_Ropp_l : real.

Lemma Rplus_Ropp:(x,y:R)``x+y==0``®``y== -x``.

New
Lemma Rplus_plus_r:(r,r1,r2:R)(r1==r2)®``r+r1==r+r2``.
(* Old *) Hints Resolve Rplus_plus_r : v62.

Lemma r_Rplus_plus:(r,r1,r2:R)``r+r1==r+r2``®r1==r2.
Hints Resolve r_Rplus_plus : real.

Lemma Rplus_ne_i:(r,b:R)``r+b==r`` ® ``b==0``.
Multiplication
Lemma Rinv_r:(r:R)``r¹0``®``r× (1/r)==1``.
Hints Resolve Rinv_r : real.

Lemma Rinv_l_sym:(r:R)``r¹0``®``1==(1/r) × r``.

Lemma Rinv_r_sym:(r:R)``r¹0``®``1==r× (1/r)``.
Hints Resolve Rinv_l_sym Rinv_r_sym : real.

Lemma Rmult_Or :(r:R) ``r×0==0``.
Hints Resolve Rmult_Or : real v62.

Lemma Rmult_Ol:(r:R)(``0×r==0``).
Hints Resolve Rmult_Ol : real v62.

Lemma Rmult_ne:(r:R)``r×1==r``&``1×r==r``.
Hints Resolve Rmult_ne : real v62.

Lemma Rmult_1r:(r:R)(``r×1==r``).
Hints Resolve Rmult_1r : real.

Lemma Rmult_mult_r:(r,r1,r2:R)r1==r2®``r×r1==r×r2``.
(* OLD *) Hints Resolve Rmult_mult_r : v62.

Lemma r_Rmult_mult:(r,r1,r2:R)(``r×r1==r×r2``)®``r¹0``®(r1==r2).

Lemma without_div_Od:(r1,r2:R)``r1×r2==0`` ® ``r1==0`` or ``r2==0``.

Lemma without_div_Oi:(r1,r2:R) ``r1==0``or``r2==0`` ® ``r1×r2==0``.

Hints Resolve without_div_Oi : real.

Lemma without_div_Oi1:(r1,r2:R) ``r1==0`` ® ``r1×r2==0``.

Lemma without_div_Oi2:(r1,r2:R) ``r2==0`` ® ``r1×r2==0``.

Lemma without_div_O_contr:(r1,r2:R)``r1×r2¹0`` ® ``r1¹0`` & ``r2¹0``.

Lemma mult_non_zero :(r1,r2:R)``r1¹0`` & ``r2¹0`` ® ``r1×r2¹0``.
Hints Resolve mult_non_zero : real.

Lemma Rmult_Rplus_distrl:
     (r1,r2,r3:R) ``(r1+r2r3 == (r1×r3)+(r2×r3)``.
Square function
Definition Rsqr:R®R:=[r:R]``r×r``.

Lemma Rsqr_O:(Rsqr ``0``)==``0``.

Lemma Rsqr_r_R0:(r:R)(Rsqr r)==``0``®``r==0``.
Opposite
Lemma eq_Ropp:(r1,r2:R)(r1==r2)®``-r1 == -r2``.
Hints Resolve eq_Ropp : real.

Lemma Ropp_O:``-0==0``.
Hints Resolve Ropp_O : real v62.

Lemma eq_RoppO:(r:R)``r==0``® ``-r==0``.
Hints Resolve eq_RoppO : real.

Lemma Ropp_Ropp:(r:R)``-(-r)==r``.
Hints Resolve Ropp_Ropp : real.

Lemma Ropp_neq:(r:R)``r¹0``®``-r¹0``.
Hints Resolve Ropp_neq : real.

Lemma Ropp_distr1:(r1,r2:R)``-(r1+r2)==(-r1 + -r2)``.
Hints Resolve Ropp_distr1 : real.
Opposite and multiplication
Lemma Ropp_mul1:(r1,r2:R)``(-r1r2 == -(r1×r2)``.
Hints Resolve Ropp_mul1 : real.

Lemma Ropp_mul2:(r1,r2:R)``(-r1)×(-r2)==r1×r2``.
Hints Resolve Ropp_mul2 : real.
Substraction
Lemma minus_R0:(r:R)``r-0==r``.
Hints Resolve minus_R0 : real.

Lemma Ropp_distr2:(r1,r2:R)``-(r1-r2)==r2-r1``.
Hints Resolve Ropp_distr2 : real.

Lemma eq_Rminus:(r1,r2:R)(r1==r2)®``r1-r2==0``.
Hints Resolve eq_Rminus : real.

Lemma Rminus_eq:(r1,r2:R)``r1-r2==0`` ® r1==r2.
Hints 
(**********)
Lemma Rminus_eq_contra:(r1,r2:R)``r1¹r2``®``r1-r2¹0``.
Hints Resolve Rminus_eq_contra : real.

Lemma Rminus_distr: (x,y,z:R) ``x×(y-z)==(x×y) - (x×z)``.
Inverse
Lemma Rinv_R1:``1/1==1``.
Hints Resolve Rinv_R1 : real.

Lemma Rinv_neq_R0:(r:R)``r¹0``®``(1/r)¹0``.
Hints Resolve Rinv_neq_R0 : real.

Lemma Rinv_Rinv:(r:R)``r¹0``®``1/(1/r)==r``.
Hints Resolve Rinv_Rinv : real.

Lemma Rinv_Rmult:(r1,r2:R)``r1¹0``®``r2¹0``®``1/(r1×r2)==(1/r1)×(1/r2)``.

Lemma Ropp_Rinv:(r:R)``r¹0``®``-(1/r)==1/(-r)``.

Lemma Rinv_r_simpl_r : (r1,r2:R)``r1¹0``®``r1×(1/r1r2==r2``.

Lemma Rinv_r_simpl_l : (r1,r2:R)``r1¹0``®``r2×r1×(1/r1)==r2``.

Lemma Rinv_r_simpl_m : (r1,r2:R)``r1¹0``®``r1×r2×(1/r1)==r2``.
Hints Resolve Rinv_r_simpl_l Rinv_r_simpl_r Rinv_r_simpl_m : real.

Lemma Rinv_Rmult_simpl:(a,b,c:R)``a¹0``®``(a×(1/b))×(c×(1/a))==c×(1/b)``.
Order and addition
Lemma Rlt_compatibility_r:(r,r1,r2:R)``r1<r2``®``r1+r<r2+r``.

Hints Resolve Rlt_compatibility_r : real.

Lemma Rlt_anti_compatibility: (r,r1,r2:R)``r+r1 < r+r2`` ® ``r1<r2``.

Lemma Rle_compatibility:(r,r1,r2:R)``r1£r2`` ® ``r+r1 £ r+r2 ``.

Lemma Rle_compatibility_r:(r,r1,r2:R)``r1£r2`` ® ``r1+r£r2+r``.

Hints Resolve Rle_compatibility Rle_compatibility_r : real.

Lemma Rle_anti_compatibility: (r,r1,r2:R)``r+r1£r+r2`` ® ``r1£r2``.

Lemma sum_inequa_Rle_lt:(a,x,b,c,y,d:R)``a£x`` ® ``x<b`` ®
             ``c<y`` ® ``y£d`` ® ``a+c < x+y < b+d``.

Lemma Rplus_lt:(r1,r2,r3,r4:R)``r1<r2`` ® ``r3<r4`` ® ``r1+r3 < r2+r4``.

Lemma Rplus_lt_le_lt:(r1,r2,r3,r4:R)``r1<r2`` ® ``r3£r4`` ® ``r1+r3 < r2+r4``.

Lemma Rplus_le_lt_lt:(r1,r2,r3,r4:R)``r1£r2`` ® ``r3<r4`` ® ``r1+r3 < r2+r4``.

Hints 
(*s Order and Opposite *)

Lemma Rgt_Ropp:(r1,r2:R) ``r1 > r2`` ® ``-r1 < -r2``.
Hints Resolve Rgt_Ropp.

Lemma Rlt_Ropp:(r1,r2:R) ``r1 < r2`` ® ``-r1 > -r2``.
Hints Resolve Rlt_Ropp : real.

Lemma Rle_Ropp:(r1,r2:R) ``r1 £ r2`` ® ``-r1 ³ -r2``.
Hints Resolve Rle_Ropp : real.

Lemma Rge_Ropp:(r1,r2:R) ``r1 ³ r2`` ® ``-r1 £ -r2``.
Hints Resolve Rge_Ropp : real.

Lemma Rlt_RO_Ropp:(r:R) ``0 < r`` ® ``0 > -r``.
Hints Resolve Rlt_RO_Ropp : real.

Lemma Rgt_RO_Ropp:(r:R) ``0 > r`` ® ``0 < -r``.
Hints Resolve Rgt_RO_Ropp : real.

Lemma Rle_RO_Ropp:(r:R) ``0 £ r`` ® ``0 ³ -r``.
Hints Resolve Rle_RO_Ropp : real.

Lemma Rge_RO_Ropp:(r:R) ``0 ³ r`` ® ``0 £ -r``.
Hints Resolve Rge_RO_Ropp : real.
Order and multiplication
Lemma Rlt_monotony_r:(r,r1,r2:R)``0<r`` ® ``r1 < r2`` ® ``r1×r < r2×r``.
Hints Resolve Rlt_monotony_r.

Lemma Rlt_anti_monotony:(r,r1,r2:R)``r < 0`` ® ``r1 < r2`` ® ``r×r1 > r×r2``.

Lemma Rle_monotony
   (r,r1,r2:R)``0 £ r`` ® ``r1 £ r2`` ® ``r×r1 £ r×r2``.
Hints Resolve Rle_monotony : real.

Lemma Rle_monotony_r
   (r,r1,r2:R)``0 £ r`` ® ``r1 £ r2`` ® ``r1×r £ r2×r``.
Hints Resolve Rle_monotony_r : real.

Lemma Rle_anti_monotony
         :(r,r1,r2:R)``r £ 0`` ® ``r1 £ r2`` ® ``r×r1 ³ r×r2``.
Hints Resolve Rle_anti_monotony : real.

Lemma Rmult_lt:(r1,r2,r3,r4:R)``r3>0`` ® ``r2>0`` ®
   `` r1 < r2`` ® ``r3 < r4`` ® ``r1×r3 < r2×r4``.
Order and Substractions
Lemma Rlt_minus:(r1,r2:R)``r1 < r2`` ® ``r1-r2 < 0``.
Hints Resolve Rlt_minus : real.

Lemma Rle_minus:(r1,r2:R)``r1 £ r2`` ® ``r1-r2 £ 0``.

Lemma Rminus_lt:(r1,r2:R)``r1-r2 < 0`` ® ``r1 < r2``.

Lemma Rminus_le:(r1,r2:R)``r1-r2 £ 0`` ® ``r1 £ r2``.

Lemma tech_Rplus:(r,s:R)``0£r`` ® ``0<s`` ® ``r+s¹0``.
Hints 
(*s Order and the square function *)
Lemma pos_Rsqr:(r:R)``0£(Rsqr r)``.

Lemma pos_Rsqr1:(r:R)``r¹0``®``0<(Rsqr r)``.
Hints Resolve pos_Rsqr pos_Rsqr1 : real.
Zero is less than one
Lemma Rlt_R0_R1:``0<1``.
Hints Resolve Rlt_R0_R1 : real.
Order and inverse
Lemma Rlt_Rinv:(r:R)``0<r``®``0<1/r``.
Hints Resolve Rlt_Rinv : real.

Lemma Rlt_Rinv2:(r:R)``r < 0``®``1/r < 0``.
Hints Resolve Rlt_Rinv2 : real.

Lemma Rlt_monotony_rev:
   (r,r1,r2:R)``0<r`` ® ``r×r1 < r×r2`` ® ``r1 < r2``.

Lemma Rinv_lt:(r1,r2:R)``0 < r1×r2`` ® ``r1 < r2`` ® ``1/r2 < 1/r1``.
Greater
Lemma Rge_ge_eq:(r1,r2:R)``r1 ³ r2`` ® ``r2 ³ r1`` ® r1==r2.

Lemma Rlt_not_ge:(r1,r2:R)not(``r1<r2``)®``r1³r2``.

Lemma Rgt_not_le:(r1,r2:R)not(``r1>r2``)®``r1£r2``.

Lemma Rgt_ge:(r1,r2:R)``r1>r2`` ® ``r1 ³ r2``.

Lemma Rlt_sym:(r1,r2:R)``r1<r2`` « ``r2>r1``.

Lemma Rle_sym1:(r1,r2:R)``r1£r2``®``r2³r1``.

Lemma Rle_sym2:(r1,r2:R)``r2³r1`` ® ``r1£r2``.

Lemma Rle_sym:(r1,r2:R)``r1£r2``«``r2³r1``.

Lemma Rge_gt_trans:(r1,r2,r3:R)``r1³r2``®``r2>r3``®``r1>r3``.

Lemma Rgt_ge_trans:(r1,r2,r3:R)``r1>r2`` ® ``r2³r3`` ® ``r1>r3``.

Lemma Rgt_trans:(r1,r2,r3:R)``r1>r2`` ® ``r2>r3`` ® ``r1>r3``.

Lemma Rge_trans:(r1,r2,r3:R)``r1³r2`` ® ``r2³r3`` ® ``r1³r3``.

Lemma Rgt_RoppO:(r:R)``r>0``®``(-r)<0``.

Lemma Rlt_RoppO:(r:R)``r<0``®``-r>0``.
Hints Resolve Rgt_RoppO Rlt_RoppOreal.

Lemma Rlt_r_plus_R1:(r:R)``0£r`` ® ``0<r+1``.
Hints Resolve Rlt_r_plus_R1real.

Lemma Rlt_r_r_plus_R1:(r:R)``r<r+1``.
Hints Resolve Rlt_r_r_plus_R1real.

Lemma tech_Rgt_minus:(r1,r2:R)``0<r2``®``r1>r1-r2``.

Lemma Rgt_plus_plus_r:(r,r1,r2:R)``r1>r2``®``r+r1 > r+r2``.
Hints Resolve Rgt_plus_plus_r : real.

Lemma Rgt_r_plus_plus:(r,r1,r2:R)``r+r1 > r+r2`` ® ``r1 > r2``.

Lemma Rge_plus_plus_r:(r,r1,r2:R)``r1³r2`` ® ``r+r1 ³ r+r2``.
Hints Resolve Rge_plus_plus_r : real.

Lemma Rge_r_plus_plus:(r,r1,r2:R)``r+r1 ³ r+r2`` ® ``r1³r2``.

Lemma Rge_monotony:
   (x,y,z:R) ``z³0`` ® ``x³y`` ® ``x×z ³ y×z``.

Lemma Rgt_minus:(r1,r2:R)``r1>r2`` ® ``r1-r2 > 0``.

Lemma minus_Rgt:(r1,r2:R)``r1-r2 > 0`` ® ``r1>r2``.

Lemma Rge_minus:(r1,r2:R)``r1³r2`` ® ``r1-r2 ³ 0``.

Lemma minus_Rge:(r1,r2:R)``r1-r2 ³ 0`` ® ``r1³r2``.

Lemma Rmult_gt:(r1,r2:R)``r1>0`` ® ``r2>0`` ® ``r1×r2>0``.

Lemma Rmult_lt_0
   :(r1,r2,r3,r4:R)``r3³0``®``r2>0``®``r1<r2``®``r3<r4``®``r1×r3<r2×r4``.

Lemma Rmult_lt_pos:(x,y:R)``0<x`` ® ``0<y`` ® ``0<x×y``.

Lemma Rplus_eq_R0_l:(a,b:R)``0£a`` ® ``0£b`` ® ``a+b==0`` ® ``a==0``.

Lemma Rplus_eq_R0
         :(a,b:R)``0£a`` ® ``0£b`` ® ``a+b==0`` ® ``a==0``&``b==0``.

Lemma Rplus_Rsr_eq_R0_l:(a,b:R)``(Rsqr a)+(Rsqr b)==0``®``a==0``.

Lemma Rplus_Rsr_eq_R0:(a,b:R)``(Rsqr a)+(Rsqr b)==0``®``a==0``&``b==0``.
Injection from N to R
Lemma S_INR:(n:nat)(INR (S n))==``(INR n)+1``.

Lemma S_O_plus_INR:(n:nat)
     (INR (plus (S On))==``(INR (S O))+(INR n)``.

Lemma plus_INR:(n,m:nat)(INR (plus n m))==``(INR n)+(INR m)``.

Lemma minus_INR:(n,m:nat)(le m n)®(INR (minus n m))==``(INR n)-(INR m)``.

Lemma mult_INR:(n,m:nat)(INR (mult n m))==(Rmult (INR n) (INR m)).

Hints Resolve plus_INR minus_INR mult_INR : real.

Lemma INR_lt_0:(n:nat)(lt O n)®``0 < (INR n)``.
Hints Resolve INR_lt_0real.

Lemma INR_pos : (p:positive)``0<(INR (convert p))``.
Hints Resolve INR_pos : real.

Lemma INR_le:(n:nat)``0 £ (INR n)``.
Hints Resolve INR_lereal.

Lemma INR_le_nm:(n,m:nat)(le n m)®``(INR n)£(INR m)``.
Hints Resolve INR_le_nmreal.

Lemma not_INR_O:(n:nat)``(INR n)¹0``®notn=O.
Hints

Lemma not_O_INR:(n:nat)notn=O®``(INR n)¹0``.
Hints Resolve not_O_INR : real.
Injection from Z to R
Definition INZ:=inject_nat.

Lemma IZN:(z:Z)(`0£z`)®(Ex [n:natz=(INZ n)).

Lemma INR_IZR_INZ:(n:nat)(INR n)==(IZR (INZ n)).

Lemma plus_IZR_NEG_POS : 
         (p,q:positive)(IZR `(POS p)+(NEG q)`)==``(IZR (POS p))+(IZR (NEG q))``.

Lemma plus_IZR:(z,t:Z)(IZR `z+t`)==``(IZR z)+(IZR t)``.

Lemma Ropp_Ropp_IZR:(z:Z)(IZR (`-z`))==``-(IZR z)``.

Lemma Z_R_minus:(z1,z2:Z)``(IZR z1)-(IZR z2)``==(IZR `z1-z2`).

Lemma lt_O_IZR:(z:Z)``0 < (IZR z)``®`0<z`.

Lemma lt_IZR:(z1,z2:Z)``(IZR z1)<(IZR z2)``®`z1<z2`.

Lemma eq_IZR_R0:(z:Z)``(IZR z)==0``®`z=0`.

Lemma eq_IZR:(z1,z2:Z)(IZR z1)==(IZR z2)®z1=z2.

Lemma le_O_IZR:(z:Z)``0£ (IZR z)``®`0£z`.

Lemma le_IZR:(z1,z2:Z)``(IZR z1)£(IZR z2)``®`z1£z2`.

Lemma le_IZR_R1:(z:Z)``(IZR z)£1``® `z£1`.

Lemma IZR_ge: (m,n:Z) `m³ n® ``(IZR m)³(IZR n)``.

Lemma one_IZR_lt1 : (z:Z)``-1<(IZR z)<1``®`z=0`.

Lemma one_IZR_r_R1
   : (r:R)(z,x:Z)``r<(IZR z)£r+1``®``r<(IZR x)£r+1``®z=x.

Lemma single_z_r_R1
   : (r:R)(z,x:Z)``r<(IZR z)``®``(IZR z)£r+1``®``r<(IZR x)``®``(IZR x)£r+1``®z=x.

Lemma tech_single_z_r_R1
         :(r:R)(z:Z)``r<(IZR z)``®``(IZR z)£r+1``
           ® (Ex [s:Z] (nots=z&``r<(IZR s)``&``(IZR s)£r+1``))®False.

Module R_Ifp

Id: RIfp.v,v 1.4 2001/03/15 13:38:51 filliatr Exp
Complements for the reals.Integer and fractional part
Require Export Rbase.
Require Omega.

Fractional part
Definition Int_part:R®Z:=[r:R](`(up r)-1`).

Definition frac_part:R®R:=[r:R](Rminus r (IZR (Int_part r))).

Lemma tech_up:(r:R)(z:Z)(Rlt r (IZR z))®(Rle (IZR z) (Rplus r R1))®
   z=(up r).

Lemma up_tech:(r:R)(z:Z)(Rle (IZR zr)®(Rlt r (IZR `z+1`))®
   `z+1`=(up r).

Lemma fp_R0:(frac_part R0)==R0.

Lemma for_base_fp:(r:R)(Rgt (Rminus (IZR (up r)) rR0)& 
                         (Rle (Rminus (IZR (up r)) rR1).

Lemma base_fp:(r:R)(Rge (frac_part rR0)&(Rlt (frac_part rR1).

Properties
Lemma base_Int_part:(r:R)(Rle (IZR (Int_part r)) r)&
                     (Rgt (Rminus (IZR (Int_part r)) r) (Ropp R1)).

Lemma fp_nat:(r:R)(frac_part r)==R0®(Ex [c:Z](r==(IZR c))).

Lemma R0_fp_O:(r:R)notR0==(frac_part r)®notR0==r.

Lemma Rminus_Int_part1:(r1,r2:R)(Rge (frac_part r1) (frac_part r2))®
   (Int_part (Rminus r1 r2))=(Zminus (Int_part r1) (Int_part r2)).

Lemma Rminus_Int_part2:(r1,r2:R)(Rlt (frac_part r1) (frac_part r2))®
   (Int_part (Rminus r1 r2))=(Zminus (Zminus (Int_part r1) (Int_part r2)) `1`).

Lemma Rminus_fp1:(r1,r2:R)(Rge (frac_part r1) (frac_part r2))®
   (frac_part (Rminus r1 r2))==(Rminus (frac_part r1) (frac_part r2)).

Lemma Rminus_fp2:(r1,r2:R)(Rlt (frac_part r1) (frac_part r2))®
   (frac_part (Rminus r1 r2))==
   (Rplus (Rminus (frac_part r1) (frac_part r2)) R1).

Lemma plus_Int_part1:(r1,r2:R)(Rge (Rplus (frac_part r1) (frac_part r2)) R1)®
   (Int_part (Rplus r1 r2))=(Zplus (Zplus (Int_part r1) (Int_part r2)) `1`).

Lemma plus_Int_part2:(r1,r2:R)(Rlt (Rplus (frac_part r1) (frac_part r2)) R1)®
   (Int_part (Rplus r1 r2))=(Zplus (Int_part r1) (Int_part r2)).

Lemma plus_frac_part1:(r1,r2:R)
   (Rge (Rplus (frac_part r1) (frac_part r2)) R1)®
                 (frac_part (Rplus r1 r2))==
                 (Rminus (Rplus (frac_part r1) (frac_part r2)) R1).

Lemma plus_frac_part2:(r1,r2:R)
   (Rlt (Rplus (frac_part r1) (frac_part r2)) R1)®
(frac_part (Rplus r1 r2))==(Rplus (frac_part r1) (frac_part r2)).

Module Rbasic_fun

Id: Rbasicfun.v,v 1.5 2001/03/15 13:38:52 filliatr Exp
Complements for the real numbers
Require Export R_Ifp.

Rmin
Definition Rmin :R®R®R:=[x,y:R]
   Cases (total_order_Rle x yof
     (leftT _) Þ x
   | (rightT _) Þ y
   end.

Lemma Rmin_Rgt_l:(r1,r2,r:R)(Rgt (Rmin r1 r2r®
     ((Rgt r1 r)&(Rgt r2 r)).

Lemma Rmin_Rgt_r:(r1,r2,r:R)(((Rgt r1 r)&(Rgt r2 r)) ® 
           (Rgt (Rmin r1 r2r)).

Lemma Rmin_Rgt:(r1,r2,r:R)(Rgt (Rmin r1 r2r)«
     ((Rgt r1 r)&(Rgt r2 r)).

Rmax
Definition Rmax :R®R®R:=[x,y:R]
   Cases (total_order_Rle x yof
     (leftT _) Þ y
   | (rightT _) Þ x
   end.

Lemma Rmax_Rle:(r1,r2,r:R)(Rle r (Rmax r1 r2))«
     ((Rle r r1)or(Rle r r2)).

Rabsolu
Lemma case_Rabsolu:(r:R)(sumboolT (Rlt r R0) (Rge r R0)).

Definition Rabsolu:R®R:=
       [r:R](Cases (case_Rabsolu rof
               (leftT _) Þ (Ropp r)
               |(rightT _) Þ r
             end).

Lemma Rabsolu_R0:(Rabsolu R0)==R0.

Lemma Rabsolu_no_R0:(r:R)notr==R0®not(Rabsolu r)==R0.

Lemma Rabsolu_left: (r:R)(Rlt r R0)®((Rabsolu r) == (Ropp r)).

Lemma Rabsolu_right: (r:R)(Rge r R0)®((Rabsolu r) == r).

Lemma Rabsolu_pos:(x:R)(Rle R0 (Rabsolu x)).

Lemma Rabsolu_pos_eq:(x:R)(Rle R0 x)®(Rabsolu x)==x.

Lemma Rabsolu_Rabsolu:(x:R)(Rabsolu (Rabsolu x))==(Rabsolu x).

Lemma Rabsolu_pos_lt:(x:R)(notx==R0)®(Rlt R0 (Rabsolu x)).

Lemma Rabsolu_minus_sym:(x,y:R)
   (Rabsolu (Rminus x y))==(Rabsolu (Rminus y x)).

Lemma Rabsolu_mult:(x,y:R)
   (Rabsolu (Rmult x y))==(Rmult (Rabsolu x) (Rabsolu y)).

Lemma Rabsolu_Rinv:(r:R)(notr==R0)®(Rabsolu (Rinv r))==
                                   (Rinv (Rabsolu r)).

Lemma Rabsolu_triang:(a,b:R)(Rle (Rabsolu (Rplus a b)) 
                                 (Rplus (Rabsolu a) (Rabsolu b))).

Lemma Rabsolu_triang_inv:(a,b:R)(Rle (Rminus (Rabsolu a) (Rabsolu b))
                                       (Rabsolu (Rminus a b))).

Lemma Rabsolu_def1:(x,a:R)(Rlt x a)®(Rlt (Ropp ax)®(Rlt (Rabsolu xa).

Lemma Rabsolu_def2:(x,a:R)(Rlt (Rabsolu xa)®(Rlt x a)&(Rlt (Ropp ax).

Module Rlimit

Id: Rlimit.v,v 1.3 2001/03/15 13:38:53 filliatr Exp
Definition of the limit
Require Export Rbasic_fun.
Require Export Classical_Prop.

Calculus
Lemma eps2_Rgt_R0:(eps:R)(Rgt eps R0)®
       (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0).

Lemma eps2:(eps:R)(Rplus (Rmult eps (Rinv (Rplus R1 R1)))
                         (Rmult eps (Rinv (Rplus R1 R1))))==eps.

Lemma eps4:(eps:R)
   (Rplus (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1) )))
         (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1) ))))==
                   (Rmult eps (Rinv (Rplus R1 R1))).

Lemma Rlt_eps2_eps:(eps:R)(Rgt eps R0)®
         (Rlt (Rmult eps (Rinv (Rplus R1 R1))) eps).

Lemma Rlt_eps4_eps:(eps:R)(Rgt eps R0)®
         (Rlt (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1)))) eps).

Lemma prop_eps:(r:R)((eps:R)(Rgt eps R0)®(Rlt r eps))®(Rle r R0).

Definition mul_factor := [l,l':R](Rinv (Rplus R1 (Rplus (Rabsolu l)
                                                         (Rabsolu l')))).

Lemma mul_factor_wd : (l,l':R)
   not(Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))==R0.

Lemma mul_factor_gt:(eps:R)(l,l':R)(Rgt eps R0)®
       (Rgt (Rmult eps (mul_factor l l')) R0).

Lemma mul_factor_gt_f:(eps:R)(l,l':R)(Rgt eps R0)®
       (Rgt (Rmin R1 (Rmult eps (mul_factor l l'))) R0).

Metric space
Record Metric_Space:Type:= {
     Base:Type;
     dist:Base®Base®R;
     dist_pos:(x,y:Base)(Rge (dist x yR0);
     dist_sym:(x,y:Base)(dist x y)==(dist y x);
     dist_refl:(x,y:Base)((dist x y)==R0«x==y);
     dist_tri:(x,y,z:Base)(Rle (dist x y)
               (Rplus (dist x z) (dist z y))) }.

Limit in Metric space
Definition limit_in:=
     [X:Metric_SpaceX':Metric_Spacef:(Base X)®(Base X');
     D:(Base X)®Propx0:(Base X); l:(Base X')]
     (eps:R)(Rgt eps R0)®
     (EXT alp:R | (Rgt alp R0)&(x:(Base X))(D x)&
                 (Rlt (dist X x x0alp)®
                 (Rlt (dist X' (f xleps)).

Distance in R
Definition R_dist:R®R®R:=[x,y:R](Rabsolu (Rminus x y)).

Lemma R_dist_pos:(x,y:R)(Rge (R_dist x yR0).

Lemma R_dist_sym:(x,y:R)(R_dist x y)==(R_dist y x).

Lemma R_dist_refl:(x,y:R)((R_dist x y)==R0«x==y).

Lemma R_dist_tri:(x,y,z:R)(Rle (R_dist x y
                     (Rplus (R_dist x z) (R_dist z y))).

Lemma R_dist_plus: (a,b,c,d:R)(Rle (R_dist (Rplus a c) (Rplus b d))
                     (Rplus (R_dist a b) (R_dist c d))).

R is a metric space
Definition R_met:Metric_Space:=(Build_Metric_Space R R_dist
   R_dist_pos R_dist_sym R_dist_refl R_dist_tri).

Limit 1 arg
Definition Dgf:=[Df,Dg:R®Prop][f:R®R][x:R](Df x)&(Dg (f x)).

Definition limit1_in:(R®R)®(R®Prop)®R®R®Prop:=
   [f:R®RD:R®Propl:Rx0:R](limit_in R_met R_met f D x0 l).

Lemma tech_limit:(f:R®R)(D:R®Prop)(l:R)(x0:R)(D x0)®
     (limit1_in f D l x0)®l==(f x0).

Lemma tech_limit_contr:(f:R®R)(D:R®Prop)(l:R)(x0:R)(D x0)®notl==(f x0)
     ®not(limit1_in f D l x0).

Lemma lim_x:(D:R®Prop)(x0:R)(limit1_in [x:R]x D x0 x0).

Lemma limit_plus:(f,g:R®R)(D:R®Prop)(l,l':R)(x0:R)
     (limit1_in f D l x0)®(limit1_in g D l' x0)®
     (limit1_in [x:R](Rplus (f x) (g x)) D (Rplus l l'x0).

Lemma limit_Ropp:(f:R®R)(D:R®Prop)(l:R)(x0:R)
     (limit1_in f D l x0)®(limit1_in [x:R](Ropp (f x)) D (Ropp lx0).

Lemma limit_minus:(f,g:R®R)(D:R®Prop)(l,l':R)(x0:R)
     (limit1_in f D l x0)®(limit1_in g D l' x0)®
     (limit1_in [x:R](Rminus (f x) (g x)) D (Rminus l l'x0).

Lemma limit_free:(f:R®R)(D:R®Prop)(x:R)(x0:R)
     (limit1_in [h:R](f xD (f xx0).

Lemma limit_mul:(f,g:R®R)(D:R®Prop)(l,l':R)(x0:R)
     (limit1_in f D l x0)®(limit1_in g D l' x0)®
     (limit1_in [x:R](Rmult (f x) (g x)) D (Rmult l l'x0).

Definition adhDa:(R®Prop)®R®Prop:=[D:R®Prop][a:R]
   (alp:R)(Rgt alp R0)®(EXT x:R | (D x)&(Rlt (R_dist x aalp)).

Lemma single_limit:(f:R®R)(D:R®Prop)(l:R)(l':R)(x0:R)
   (adhDa D x0)®(limit1_in f D l x0)®(limit1_in f D l' x0)®l==l'.

Lemma limit_comp:(f,g:R®R)(Df,Dg:R®Prop)(l,l':R)(x0:R)
     (limit1_in f Df l x0)®(limit1_in g Dg l' l)®
     (limit1_in [x:R](g (f x)) (Dgf Df Dg fl' x0).

Module Rfunctions

Id: Rfunctions.v,v 1.5 2001/04/11 12:41:40 filliatr Exp
Definition of the some functions
Require Export Rlimit.

Factorial
Fixpoint fact [n:nat]:nat:=
   Cases n of
       O Þ (S O)
     |(S nÞ (mult (S n) (fact n))
   end.

Lemma fact_neq_0:(n:nat)not(fact n)=O.

Lemma INR_fact_neq_0:(n:nat)not(INR (fact n))==R0.

Lemma simpl_fact:(n:nat)(Rmult (Rinv (INR (fact (S n)))) 
           (Rinv (Rinv (INR (fact n)))))==
           (Rinv (INR (S n))).

Power
Fixpoint pow [r:R;n:nat]:R:=
   Cases n of
       O Þ R1
     |(S nÞ (Rmult r (pow r n))
   end.

Lemma tech_pow_Rmult:(x:R)(n:nat)(Rmult x (pow x n))==(pow x (S n)).

Lemma tech_pow_Rplus:(x:R)(a,n:nat)
   (Rplus (pow x a) (Rmult (INR n) (pow x a)))==
             (Rmult (INR (S n)) (pow x a)).

Sum of n first naturals
Fixpoint sum_nat_f_O [f:nat®nat;n:nat]:nat:=
   Cases n of
     O Þ (f O)
     |(S n'Þ (plus (sum_nat_f_O f n') (f (S n')))
   end.

Definition sum_nat_f [s,n:nat;f:nat®nat]:nat:=
   (sum_nat_f_O [x:nat](f (plus x s)) (minus n s)).

Definition sum_nat_O [n:nat]:nat:=
   (sum_nat_f_O [x]x n).

Definition sum_nat [s,n:nat]:nat:=
   (sum_nat_f s n [x]x).

Sum
Fixpoint sum_f_R0 [f:nat®R;N:nat]:R:=
   Cases N of
       O Þ (f O)
     |(S iÞ (Rplus (sum_f_R0 f i) (f (S i)))
   end.

Definition sum_f [s,n:nat;f:nat®R]:R:=
   (sum_f_R0 [x:nat](f (plus x s)) (minus n s)).

Infinit Sum
Definition infinit_sum:(nat®R)®R®Prop:=[s:nat®R;l:R]
   (eps:R)(Rgt eps R0)®
   (Ex[N:nat](n:nat)(ge n N)®(Rlt (R_dist (sum_f_R0 s nleps)).

Module Rderiv

Id: Rderiv.v,v 1.3 2001/03/15 13:38:52 filliatr Exp
Definition of the derivative,continuity
Require Export Rfunctions.
Require Classical_Pred_Type.
Require Omega.

Definition D_x:(R®Prop)®R®R®Prop:=[D:R®Prop][y:R][x:R]
         (D x)&(noty==x).

Definition continue_in:(R®R)®(R®Prop)®R®Prop:=
         [f:R®RD:R®Propx0:R](limit1_in f (D_x D x0) (f x0x0).

Definition D_in:(R®R)®(R®R)®(R®Prop)®R®Prop:=
   [f:R®Rd:R®RD:R®Propx0:R](limit1_in
     [x:R] (Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0)))
     (D_x D x0) (d x0x0).

Lemma cont_deriv:(f,d:R®R;D:R®Prop;x0:R)
           (D_in f d D x0)®(continue_in f D x0).

Lemma Dconst:(D:R®Prop)(y:R)(x0:R)(D_in [x:R]y [x:R]R0 D x0).

Lemma Dx:(D:R®Prop)(x0:R)(D_in [x:R]x [x:R]R1 D x0).

Lemma Dadd:(D:R®Prop)(df,dg:R®R)(f,g:R®R)(x0:R)
   (D_in f df D x0)®(D_in g dg D x0)®
   (D_in [x:R](Rplus (f x) (g x)) [x:R](Rplus (df x) (dg x)) D x0).

Lemma Dmult:(D:R®Prop)(df,dg:R®R)(f,g:R®R)(x0:R)
   (D_in f df D x0)®(D_in g dg D x0)®
   (D_in [x:R](Rmult (f x) (g x)) 
               [x:R](Rplus (Rmult (df x) (g x)) (Rmult (f x) (dg x))) D x0).

Lemma Dmult_const:(D:R®Prop)(f,df:R®R)(x0:R)(a:R)(D_in f df D x0)®
   (D_in [x:R](Rmult a (f x)) ([x:R](Rmult a (df x))) D x0).

Lemma Dopp:(D:R®Prop)(f,df:R®R)(x0:R)(D_in f df D x0)®
   (D_in [x:R](Ropp (f x)) ([x:R](Ropp (df x))) D x0).

Lemma Dminus:(D:R®Prop)(df,dg:R®R)(f,g:R®R)(x0:R)
   (D_in f df D x0)®(D_in g dg D x0)®
   (D_in [x:R](Rminus (f x) (g x)) [x:R](Rminus (df x) (dg x)) D x0).

Lemma Dx_pow_n:(n:nat)(D:R®Prop)(x0:R)
   (D_in [x:R](pow x n
         [x:R](Rmult (INR n) (pow x (minus n (1)))) D x0).

Lemma Dcomp:(Df,Dg:R®Prop)(df,dg:R®R)(f,g:R®R)(x0:R)
   (D_in f df Df x0)®(D_in g dg Dg (f x0))®
   (D_in [x:R](g (f x)) [x:R](Rmult (df x) (dg (f x))) 
                         (Dgf Df Dg fx0).

Module Reals

Id: Reals.v,v 1.3 2001/03/15 13:38:53 filliatr Exp
Require Export Rdefinitions.
Require Export TypeSyntax.
Require Export Raxioms.
Require Export Rbase.
Require Export R_Ifp.
Require Export Rbasic_fun.
Require Export Rlimit.
Require Export Rfunctions.
Require Export Rderiv.

5   Lists

The LISTS library includes the following files:

Module List

Id: List.v,v 1.3 2001/03/15 13:38:50 filliatr Exp
** THIS IS A OLD CONTRIB. IT IS NO LONGER MAINTAINED
Require Le.

Parameter List_Dom:Set.
Definition A := List_Dom.

Inductive list : Set := nil : list | cons : A ® list ® list.

Fixpoint app [l:list] : list ® list
       := [m:list]<list>Cases l of
                             nil Þ m
                         | (cons a l1Þ (cons a (app l1 m))
                     end.

Lemma app_nil_end : (l:list)(l=(app l nil)).
Hints Resolve app_nil_end : list v62.

Lemma app_ass : (l,m,n : list)(app (app l mn)=(app l (app m n)).
Hints Resolve app_ass : list v62.

Lemma ass_app : (l,m,n : list)(app l (app m n))=(app (app l mn).
Hints Resolve ass_app : list v62.

Definition tail :=
     [l:list] <list>Cases l of (cons _ mÞ m | _ Þ nil end : list®list.

Lemma nil_cons : (a:A)(m:list)notnil=(cons a m).

Length of lists
Fixpoint length [l:list] : nat
     := <nat>Cases l of (cons _ mÞ (S (length m)) | _ Þ O end.

Length order of lists
Section length_order.
Definition lel := [l,m:list](le (length l) (length m)).

Hints Unfold lel : list.

Variables a,b:A.
Variables l,m,n:list.

Lemma lel_refl : (lel l l).

Lemma lel_trans : (lel l m)®(lel m n)®(lel l n).

Lemma lel_cons_cons : (lel l m)®(lel (cons a l) (cons b m)).

Lemma lel_cons : (lel l m)®(lel l (cons b m)).

Lemma lel_tail : (lel (cons a l) (cons b m)) ® (lel l m).

Lemma lel_nil : (l':list)(lel l' nil)®(nil=l').
End length_order.

Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons : list v62.

Fixpoint In [a:A;l:list] : Prop :=
       Cases l of
           nil Þ False
       | (cons b mÞ (b=a)or(In a m)
       end.

Lemma in_eq : (a:A)(l:list)(In a (cons a l)).
Hints Resolve in_eq : list v62.

Lemma in_cons : (a,b:A)(l:list)(In b l)®(In b (cons a l)).
Hints Resolve in_cons : list v62.

Lemma in_app_or : (l,m:list)(a:A)(In a (app l m))®((In a l)or(In a m)).
Hints 
Lemma in_or_app : (l,m:list)(a:A)((In a l)or(In a m))®(In a (app l m)).
Hints Resolve in_or_app : list v62.

Definition incl := [l,m:list](a:A)(In a l)®(In a m).

Hints Unfold incl : list v62.

Lemma incl_refl : (l:list)(incl l l).
Hints Resolve incl_refl : list v62.

Lemma incl_tl : (a:A)(l,m:list)(incl l m)®(incl l (cons a m)).
Hints 
Lemma incl_tran : (l,m,n:list)(incl l m)®(incl m n)®(incl l n).

Lemma incl_appl : (l,m,n:list)(incl l n)®(incl l (app n m)).
Hints 
Lemma incl_appr : (l,m,n:list)(incl l n)®(incl l (app m n)).
Hints 
Lemma incl_cons : (a:A)(l,m:list)(In a m)®(incl l m)®(incl (cons a lm).
Hints Resolve incl_cons : list v62.

Lemma incl_app : (l,m,n:list)(incl l n)®(incl m n)®(incl (app l mn).
Hints Resolve incl_app : list v62.

Module PolyListSyntax

Id: PolyListSyntax.v,v 1.4 2001/03/15 13:38:50 filliatr Exp
Syntax for list concatenation
Require PolyList.

Infix RIGHTA 7 "^" app.

Module PolyList

Id: PolyList.v,v 1.9 2001/04/11 12:41:39 filliatr Exp
Require Le.

Section Lists.

Variable A : Set.

Implicit Arguments On.

Inductive list : Set := nil : list | cons : A ® list ® list.

Concatenation
Fixpoint app [l:list] : list ® list
       := [m:list]Cases l of
                     nil Þ m
                   | (cons a l1Þ (cons a (app l1 m))
                   end.

Infix RIGHTA 7 "^" app.

Lemma app_nil_end : (l:list)l=(l^nil).
Hints Resolve app_nil_end.

Lemma app_ass : (l,m,n : list)((l^m)^ n)=(l^(m^n)).
Hints Resolve app_ass.

Lemma ass_app : (l,m,n : list)(l^(m^n))=((l^m)^n).
Hints Resolve ass_app.

Definition head :=
   [l:list]Cases l of
   | nil Þ Error
   | (cons x _) Þ (Value x)
   end.

Definition tail : list ® list :=
   [l:list]Cases l of
   | nil Þ nil
   | (cons a mÞ m
   end.

Lemma nil_cons : (a:A)(m:list)not(nil=(cons a m)).

Lemma app_comm_cons : (x,y:list)(a:A) (cons a (x^y))=((cons a x)^y).

Lemma app_eq_nil: (x,y:list) (x^y)=nil ® x=nil & y=nil.

Lemma app_cons_not_nil: (x,y:list)(a:A)notnil=(x^(cons a y)).

Lemma app_eq_unit:(x,y:list)(a:A)
       (x^y)=(cons a nil)® (x=nil)& y=(cons a nilor x=(cons a nil)& y=nil.

Lemma app_inj_tail : (x,y:list)(a,b:A)
     (x^(cons a nil))=(y^(cons b nil)) ® x=y & a=b.

Length of lists
Fixpoint length [l:list] : nat
     := Cases l of nil Þ O | (cons _ mÞ (S (length m)) end.

Length order of lists
Section length_order.
Definition lel := [l,m:list](le (length l) (length m)).

Variables a,b:A.
Variables l,m,n:list.

Lemma lel_refl : (lel l l).

Lemma lel_trans : (lel l m)®(lel m n)®(lel l n).

Lemma lel_cons_cons : (lel l m)®(lel (cons a l) (cons b m)).

Lemma lel_cons : (lel l m)®(lel l (cons b m)).

Lemma lel_tail : (lel (cons a l) (cons b m)) ® (lel l m).

Lemma lel_nil : (l':list)(lel l' nil)®(nil=l').
End length_order.

Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons
.

The In predicate
Fixpoint In [a:A;l:list] : Prop :=
       Cases l of nil Þ False | (cons b mÞ (b=a)or(In a mend.

Lemma in_eq : (a:A)(l:list)(In a (cons a l)).
Hints Resolve in_eq.

Lemma in_cons : (a,b:A)(l:list)(In b l)®(In b (cons a l)).
Hints Resolve in_cons.

Lemma in_nil : (a:A)not(In a nil).

Lemma in_inv : (a,b:A)(l:list)
                 (In b (cons a l)) ® a=b or (In b l).

Lemma In_dec : ((x,y:A){x=y}+{notx=y}) ® (a:A)(l:list){(In a l)}+{not(In a l)}.

Lemma in_app_or : (l,m:list)(a:A)(In a (l^m))®((In a l)or(In a m)).
Hints 
Lemma in_or_app : (l,m:list)(a:A)((In a l)or(In a m))®(In a (l^m)).
Hints Resolve in_or_app.

Inclusion on list
Definition incl := [l,m:list](a:A)(In a l)®(In a m).
Hints Unfold incl.

Lemma incl_refl : (l:list)(incl l l).
Hints Resolve incl_refl.

Lemma incl_tl : (a:A)(l,m:list)(incl l m)®(incl l (cons a m)).
Hints 
Lemma incl_tran : (l,m,n:list)(incl l m)®(incl m n)®(incl l n).

Lemma incl_appl : (l,m,n:list)(incl l n)®(incl l (n^m)).
Hints 
Lemma incl_appr : (l,m,n:list)(incl l n)®(incl l (m^n)).
Hints 
Lemma incl_cons : (a:A)(l,m:list)(In a m)®(incl l m)®(incl (cons a lm).
Hints Resolve incl_cons.

Lemma incl_app : (l,m,n:list)(incl l n)®(incl m n)®(incl (l^mn).
Hints Resolve incl_app.

Nth element of a list
Fixpoint nth [n:natl:list] : A®A :=
   [default]Cases n l of
     O (cons x l'Þ x
   | O other Þ default
   | (S mnil Þ default
   | (S m) (cons x tÞ (nth m t default)
   end.

Fixpoint nth_ok [n:natl:list] : A®bool :=
   [default]Cases n l of
     O (cons x l'Þ true
   | O other Þ false
   | (S mnil Þ false
   | (S m) (cons x tÞ (nth_ok m t default)
   end.

Lemma nth_in_or_default :
   (n:nat)(l:list)(d:A){(In (nth n l dl)}+{(nth n l d)=d}.

Lemma nth_S_cons :
   (n:nat)(l:list)(d:A)(a:A)(In (nth n l dl)
     ®(In (nth (S n) (cons a ld) (cons a l)).

Reverse Induction Principle on Lists
Section Reverse_Induction.

Variable leAA®A®Prop.

Fixpoint rev [l:list] : list :=
     Cases l of
       nil Þ nil
     | (cons x l'Þ (rev l')^(cons x nil)
     end.

Lemma distr_rev : 
   (x,y:list) (rev (x^y))=((rev y)^(rev x)).

Remark rev_unit : (l:list)(a:A) (rev l^(cons a nil))= (cons a (rev l)).

Lemma idempot_rev : (l:list)(rev (rev l))=l.

Implicit Arguments Off.
Remark rev_list_ind: (P:list®Prop)
       (P nil)
         ®((a:A)(l:list)(P (rev l))®(P (rev (cons a l)))) 
               ®(l:list) (P (rev l)).
Implicit Arguments On.

Lemma rev_ind : 
   (P:list®Prop)
     (P nil)®
     ((x:A)(l:list)(P l)®(P l^(cons x nil)))
       ®(l:list)(P l).

End Reverse_Induction.

End Lists.

Hints Resolve nil_cons app_nil_end ass_app app_ass : datatypes v62.
Hints Resolve app_comm_cons app_cons_not_nil : datatypes v62.
Hints Hints Resolve app_eq_unit app_inj_tail : datatypes v62.
Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons
     : datatypes v62.
Hints Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app : datatypes v62.
Hints Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons incl_app
   : datatypes v62.

Section Functions_on_lists.

Some generic functions on lists and basic functions of them
Section Map.
Variables A,B:Set.
Variable f:A®B.
Fixpoint map [l:(list A)] : (list B) :=
   Cases l of
       nil Þ (nil B)
   | (cons a tÞ (cons (f a) (map t))
   end.
End Map.

Lemma in_map : (A,B:Set)(f:A®B)(l:(list A))(x:A)
   (In x l® (In (f x) (map f l)).

Fixpoint flat_map [A,B:Setf:A®(list B); l:(list A)] : (list B) :=
   Cases l of
     nil Þ (nil B)
   | (cons x tÞ (app (f x) (flat_map f t))
   end.

Fixpoint list_prod [A:SetB:Setl:(list A)] : (list B)®(list A×B) :=
   [l']Cases l of
     nil Þ (nil A×B)
   | (cons x tÞ (app (map [y:B](x,yl')
                               (list_prod t l'))
   end.

Lemma in_prod_aux :
   (A:Set)(B:Set)(x:A)(y:B)(l:(list B))
     (In y l® (In (x,y) (map [y0:B](x,y0l)).

Lemma in_prod : (A:Set)(B:Set)(l:(list A))(l':(list B))
   (x:A)(y:B)(In x l)®(In y l')®(In (x,y) (list_prod l l')).

(list_power x y) is y^x, or the set of sequences of elts of y indexed by elts of x, sorted in lexicographic order.
Fixpoint list_power [A,B:Setl:(list A)] : (list B)®(list (list A×B)) :=
   [l']Cases l of
     nil Þ (cons (nil A×B) (nil ?))
   | (cons x tÞ (flat_map [f:(list A×B)](map [y:B](cons (x,yfl')
                             (list_power t l'))
   end.

Section Fold_Left_Recursor.
Variables A,B:Set.
Variable f:A®B®A.
Fixpoint fold_left[l:(list B)] : A ® A :=
[a0]Cases l of
       nil Þ a0
   | (cons b tÞ (fold_left t (f a0 b))
   end.
End Fold_Left_Recursor.

Section Fold_Right_Recursor.
Variables A,B:Set.
Variable f:B®A®A.
Variable a0:A.
Fixpoint fold_right [l:(list B)] : A :=
   Cases l of
     nil Þ a0
   | (cons b tÞ (f b (fold_right t))
   end.
End Fold_Right_Recursor.

End Functions_on_lists.

Implicit Arguments Off.

Module Streams

Id: Streams.v,v 1.8 2001/03/15 13:38:50 filliatr Exp
Implicit Arguments On.

Section Streams. (* The set of streams : definition *)

Variable A : Set.

CoInductive Set Stream := Cons : A®Stream®Stream.

Definition hd :=
   [x:StreamCases x of (Cons a _) Þ a end.

Definition tl :=
   [x:StreamCases x of (Cons _ sÞ s end.

Fixpoint Str_nth_tl [n:nat] : Stream®Stream :=
   [s:StreamCases n of
                   O Þ s
                 |(S mÞ (Str_nth_tl m (tl s))
             end.

Definition Str_nth : nat®Stream®A := [n:nat][s:Stream](hd (Str_nth_tl n s)).

Lemma unfold_Stream :(x:Stream)x=(Cases x of (Cons a sÞ (Cons a send).

Lemma tl_nth_tl : (n:nat)(s:Stream)(tl (Str_nth_tl n s))=(Str_nth_tl n (tl s)).
Hints Resolve tl_nth_tl : datatypes v62.

Lemma Str_nth_tl_plus 
: (n,m:nat)(s:Stream)(Str_nth_tl n (Str_nth_tl m s))=(Str_nth_tl (plus n ms).

Lemma Str_nth_plus 
   : (n,m:nat)(s:Stream)(Str_nth n (Str_nth_tl m s))=(Str_nth (plus n ms).

Extensional Equality between two streams
CoInductive EqSt : Stream®Stream®Prop :=
             eqst : (s1,s2:Stream)
                     ((hd s1)=(hd s2))®
                     (EqSt (tl s1) (tl s2))
                     ®(EqSt s1 s2).

A coinduction principle
Meta Definition CoInduction proof :=
   Cofix proofIntrosConstructor;
     [Clear proof | Try (Apply proof;Clear proof)].

Extensional equality is an equivalence relation
Theorem EqSt_reflex : (s:Stream)(EqSt s s).

Theorem sym_EqSt : 
   (s1:Stream)(s2:Stream)(EqSt s1 s2)®(EqSt s2 s1).

Theorem trans_EqSt : 
   (s1,s2,s3:Stream)(EqSt s1 s2)®(EqSt s2 s3)®(EqSt s1 s3).

The definition given is equivalent to require the elements at each position to be equal


Theorem eqst_ntheq :
   (n:nat)(s1,s2:Stream)(EqSt s1 s2)®(Str_nth n s1)=(Str_nth n s2).

Theorem ntheq_eqst : 
   (s1,s2:Stream)((n:nat)(Str_nth n s1)=(Str_nth n s2))®(EqSt s1 s2).

Section Stream_Properties.

Variable P : Stream®Prop.

Inductive Exists : Stream -> Prop := Here : (x:Stream)(P x) ->(Exists x) | Further : (x:Stream) (P x)->(Exists (tl x))->(Exists x).


Inductive Exists : Stream ® Prop :=
     Here : (x:Stream)(P x®(Exists x) |
     Further : (x:Stream)(Exists (tl x))®(Exists x).

CoInductive ForAll : Stream ® Prop :=
     forall : (x:Stream)(P x)®(ForAll (tl x))®(ForAll x).

Section Co_Induction_ForAll.
Variable Inv : Stream ® Prop.
Hypothesis InvThenP : (x:Stream)(Inv x)®(P x).
Hypothesis InvIsStable: (x:Stream)(Inv x)®(Inv (tl x)).

Theorem ForAll_coind : (x:Stream)(Inv x)®(ForAll x).
End Co_Induction_ForAll.

End Stream_Properties.

End Streams.

Section Map.
Variables A,B : Set.
Variable f : A®B.
CoFixpoint map : (Stream A)®(Stream B) :=
   [s:(Stream A)](Cons (f (hd s)) (map (tl s))).
End Map.

Section Constant_Stream.
Variable A : Set.
Variable a : A.
CoFixpoint const : (Stream A) := (Cons a const).
End Constant_Stream.

Implicit Arguments Off.

Module ListSet

Id: ListSet.v,v 1.5 2001/04/11 12:41:39 filliatr Exp
A Library for finite sets, implemented as lists
A Library with similar interface will soon be available under the name TreeSet in the theories/TREES directory
PolyList is loaded, but not exported
This allow to "hide" the definitions, functions and theorems of PolyList and to see only the ones of ListSet
Require PolyList.

Implicit Arguments On.

Section first_definitions.

Variable A : Set.
   Hypothesis Aeq_dec : (x,y:A){x=y}+{notx=y}.

Definition set := (list A).

Definition empty_set := (nil A).

Fixpoint set_add [a:Ax:set] : set :=
     Cases x of
     | nil Þ (cons a (nil A))
     | (cons a1 x1Þ Cases (Aeq_dec a a1of
                     | (left _) Þ (cons a1 x1)
                     | (right _) Þ (cons a1 (set_add a x1))
                     end
     end.

Fixpoint set_mem [a:Ax:set] : bool :=
     Cases x of
     | nil Þ false
     | (cons a1 x1Þ Cases (Aeq_dec a a1of
                     | (left _) Þ true
                     | (right _) Þ (set_mem a x1)
                     end
     end.

If a belongs to x, removes a from x. If not, does nothing
Fixpoint set_remove [a:Ax:set] : set :=
     Cases x of
     | nil Þ empty_set
     | (cons a1 x1Þ Cases (Aeq_dec a a1of
                     | (left _) Þ x1
                     | (right _) Þ (cons a1 (set_remove a x1))
                     end
     end.

Fixpoint set_inter [x:set] : set ® set :=
     Cases x of
     | nil Þ [y](nil A)
     | (cons a1 x1Þ [y]if (set_mem a1 y)
                       then (cons a1 (set_inter x1 y))
                       else (set_inter x1 y)
     end.

Fixpoint set_union [x,y:set] : set :=
     Cases y of
     | nil Þ x
     | (cons a1 y1Þ (set_add a1 (set_union x y1))
     end.

returns the set of all els of x that does not belong to y
Fixpoint set_diff [x:set] : set ® set :=
     [y]Cases x of
     | nil Þ (nil A)
     | (cons a1 x1Þ if (set_mem a1 y)
                       then (set_diff x1 y)
                       else (set_add a1 (set_diff x1 y))
     end.

Definition set_In : A ® set ® Prop := (In 1!A).

Lemma set_In_dec : (a:Ax:set){(set_In a x)}+{not(set_In a x)}.

Lemma set_mem_ind : 
     (B:Set)(P:B®Prop)(y,z:B)(a:A)(x:set)
       ((set_In a x® (P y))
         ®(P z)
         ®(P (if (set_mem a xthen y else z)).

Lemma set_mem_correct1 :
     (a:A)(x:set)(set_mem a x)=true ® (set_In a x).

Lemma set_mem_correct2 :
     (a:A)(x:set)(set_In a x® (set_mem a x)=true.

Lemma set_mem_complete1 :
     (a:A)(x:set)(set_mem a x)=false ® not(set_In a x).

Lemma set_mem_complete2 :
     (a:A)(x:set)not(set_In a x® (set_mem a x)=false.

Lemma set_add_intro1 : (a,b:A)(x:set
     (set_In a x® (set_In a (set_add b x)).

Lemma set_add_intro2 : (a,b:A)(x:set
     a=b ® (set_In a (set_add b x)).

Hints Resolve set_add_intro1 set_add_intro2.

Lemma set_add_intro : (a,b:A)(x:set
     a=bor(set_In a x® (set_In a (set_add b x)).

Lemma set_add_elim : (a,b:A)(x:set
     (set_In a (set_add b x)) ® a=bor(set_In a x).

Hints Resolve set_add_intro set_add_elim.

Lemma set_add_not_empty : (a:A)(x:set)not(set_add a x)=empty_set.

Lemma set_union_intro1 : (a:A)(x,y:set)
     (set_In a x® (set_In a (set_union x y)).

Lemma set_union_intro2 : (a:A)(x,y:set)
     (set_In a y® (set_In a (set_union x y)).

Hints Resolve set_union_intro2 set_union_intro1.

Lemma set_union_intro : (a:A)(x,y:set)
     (set_In a x)or(set_In a y® (set_In a (set_union x y)).

Lemma set_union_elim : (a:A)(x,y:set)
     (set_In a (set_union x y)) ® (set_In a x)or(set_In a y).

Lemma set_inter_intro : (a:A)(x,y:set)
     (set_In a x® (set_In a y® (set_In a (set_inter x y)).

Lemma set_inter_elim1 : (a:A)(x,y:set)
     (set_In a (set_inter x y)) ® (set_In a x).

Lemma set_inter_elim2 : (a:A)(x,y:set)
     (set_In a (set_inter x y)) ® (set_In a y).

Hints Resolve set_inter_elim1 set_inter_elim2.

Lemma set_inter_elim : (a:A)(x,y:set)
     (set_In a (set_inter x y)) ® (set_In a x)&(set_In a y).

Lemma set_diff_intro : (a:A)(x,y:set)
     (set_In a x® not(set_In a y® (set_In a (set_diff x y)).

Lemma set_diff_elim1 : (a:A)(x,y:set)
     (set_In a (set_diff x y)) ® (set_In a x).

End first_definitions.

Section other_definitions.

Variables A,B : Set.

Definition set_prod : (set A® (set B® (set A×B) := (list_prod 1!A 2!B).

B^A, set of applications from A to B
Definition set_power : (set A® (set B® (set (set A×B)) :=
     (list_power 1!A 2!B).

Definition set_map : (A®B® (set A® (set B) := (map 1!A 2!B).

Definition set_fold_left : (B ® A ® B® (set A® B ® B :=
       (fold_left 1!B 2!A).

Definition set_fold_right : (A ® B ® B® (set A® B ® B :=
       [f][x][b](fold_right f b x).

End other_definitions.

Implicit Arguments Off.

Module TheoryList

Id: TheoryList.v,v 1.6 2001/03/15 13:38:50 filliatr Exp
Some programs and results about lists following CAML Manual
Require Export PolyList.
Implicit Arguments On.
Chapter Lists.

Variable A : Set.

The null function
Definition Isnil : (list A® Prop := [l:(list A)](nil A)=l.

Lemma Isnil_nil : (Isnil (nil A)).
Hints Resolve Isnil_nil.

Lemma not_Isnil_cons : (a:A)(l:(list A))not(Isnil (cons a l)).

Hints Resolve Isnil_nil not_Isnil_cons.

Lemma Isnil_dec : (l:(list A)){(Isnil l)}+{not(Isnil l)}.

The Uncons function
Lemma Uncons : (l:(list A)){a : A & { m: (list A) | (cons a m)=l}}+{Isnil l}.

The head function
Lemma Hd : (l:(list A)){a : A | (EX m:(list A) |(cons a m)=l)}+{Isnil l}.

Lemma Tl : (l:(list A)){m:(list A)| (EX a:A |(cons a m)=l)
                           or ((Isnil l) & (Isnil m)) }.

Length of lists
length is defined in PolyList
Fixpoint Length_l [l:(list A)] : nat ® nat
   := [n:natCases l of
                   nil Þ n
               | (cons _ mÞ (Length_l m (S n))
               end.

A tail recursive version
Lemma Length_l_pf : (l:(list A))(n:nat){m:nat|(plus n (length l))=m}.

Lemma Length : (l:(list A)){m:nat|(length l)=m}.

Members of lists
Inductive In_spec [a:A] : (list A® Prop :=
     | in_hd : (l:(list A))(In_spec a (cons a l))
     | in_tl : (l:(list A))(b:A)(In a l)®(In_spec a (cons b l)).
Hints Resolve in_hd in_tl.
Hints Unfold In.
Hints Resolve in_cons.

Theorem In_In_spec : (a:A)(l:(list A))(In a l« (In_spec a l).

Inductive AllS [P:A®Prop] : (list A® Prop
     := allS_nil : (AllS P (nil A))
     | allS_cons : (a:A)(l:(list A))(P a)®(AllS P l)®(AllS P (cons a l)).
Hints Resolve allS_nil allS_cons.

Hypothesis eqA_dec : (a,b:A){a=b}+{nota=b}.

Fixpoint mem [a:Al:(list A)] : bool :=
   Cases l of
     nil Þ false
   | (cons b mÞ if (eqA_dec a bthen [H]true else [H](mem a m)
   end.

Hints Unfold In.
Lemma Mem : (a:A)(l:(list A)){(In a l)}+{(AllS [b:A]notb=a l)}.

Index of elements
Require Le.
Require Lt.

Inductive nth_spec : (list A)®nat®A®Prop :=
   nth_spec_O : (a:A)(l:(list A))(nth_spec (cons a l) (S Oa)
nth_spec_S : (n:nat)(a,b:A)(l:(list A))
             (nth_spec l n a)®(nth_spec (cons b l) (S na).
Hints Resolve nth_spec_O nth_spec_S.

Inductive fst_nth_spec : (list A)®nat®A®Prop :=
   fst_nth_O : (a:A)(l:(list A))(fst_nth_spec (cons a l) (S Oa)
fst_nth_S : (n:nat)(a,b:A)(l:(list A))(nota=b)®
             (fst_nth_spec l n a)®(fst_nth_spec (cons b l) (S na).
Hints Resolve fst_nth_O fst_nth_S.

Lemma fst_nth_nth : (l:(list A))(n:nat)(a:A)(fst_nth_spec l n a)®(nth_spec l n a).
Hints 
Lemma nth_lt_O : (l:(list A))(n:nat)(a:A)(nth_spec l n a)®(lt O n).

Lemma nth_le_length : (l:(list A))(n:nat)(a:A)(nth_spec l n a)®(le n (length l)).

Fixpoint Nth_func [l:(list A)] : nat ® (Exc A)
   := [n:natCases l n of
                 (cons a _) (S OÞ (value A a)
               | (cons _ l') (S (S p)) Þ (Nth_func l' (S p))
               | _ _ Þ Error
             end.

Lemma Nth : (l:(list A))(n:nat)
             {a:A|(nth_spec l n a)}+{(n=O)or(lt (length ln)}.

Lemma Item : (l:(list A))(n:nat){a:A|(nth_spec l (S na)}+{(le (length ln)}.

Require Minus.
Require DecBool.

Fixpoint index_p [a:A;l:(list A)] : nat ® (Exc nat) :=
     Cases l of nil Þ [p]Error
       | (cons b mÞ [p](ifdec (eqA_dec a b) (Value p) (index_p a m (S p)))
     end.

Lemma Index_p : (a:A)(l:(list A))(p:nat)
       {n:nat|(fst_nth_spec l (minus (S npa)}+{(AllS [b:A]nota=b l)}.

Lemma Index : (a:A)(l:(list A))
       {n:nat|(fst_nth_spec l n a)}+{(AllS [b:A]nota=b l)}.

Section Find_sec.
Variable R,P : A ® Prop.

Inductive InR : (list A® Prop
     := inR_hd : (a:A)(l:(list A))(R a)®(InR (cons a l))
     | inR_tl : (a:A)(l:(list A))(InR l)®(InR (cons a l)).
Hints Resolve inR_hd inR_tl.

Definition InR_inv :=
         [l:(list A)]Cases l of
                     nil Þ False
                 | (cons b mÞ (R b)or(InR m)
                 end.

Lemma InR_INV : (l:(list A))(InR l)®(InR_inv l).

Lemma InR_cons_inv : (a:A)(l:(list A))(InR (cons a l))®((R a)or(InR l)).

Lemma InR_or_app : (l,m:(list A))((InR l)or(InR m))®(InR (app l m)).

Lemma InR_app_or : (l,m:(list A))(InR (app l m))®((InR l)or(InR m)).

Hypothesis RS_dec : (a:A){(R a)}+{(P a)}.

Fixpoint find [l:(list A)] : (Exc A) :=
         Cases l of nil Þ Error
                 | (cons a mÞ (ifdec (RS_dec a) (Value a) (find m))
         end.

Lemma Find : (l:(list A)){a:A | (In a l) & (R a)}+{(AllS P l)}.

Variable B : Set.
Variable T : A ® B ® Prop.

Variable TS_dec : (a:A){c:B| (T a c)}+{(P a)}.

Fixpoint try_find [l:(list A)] : (Exc B) :=
     Cases l of
       nil Þ Error
     | (cons a l1Þ
             Cases (TS_dec aof
               (inleft (exist c _)) Þ (Value c)
             | (inright _) Þ (try_find l1)
             end
     end.

Lemma Try_find : (l:(list A)){c:B|(EX a:A |(In a l) & (T a c))}+{(AllS P l)}.

End Find_sec.

Section Assoc_sec.

Variable B : Set.
Fixpoint assoc [a:A;l:(list A×B)] : (Exc B) :=
     Cases l of nil Þ Error
         | (cons (a',bmÞ (ifdec (eqA_dec a a') (Value b) (assoc a m))
     end.

Inductive AllS_assoc [P:A ® Prop]: (list A×B® Prop :=
       allS_assoc_nil : (AllS_assoc P (nil A×B))
     | allS_assoc_cons : (a:A)(b:B)(l:(list A×B))
         (P a)®(AllS_assoc P l)®(AllS_assoc P (cons (a,bl)).

Hints Resolve allS_assoc_nil allS_assoc_cons.

Lemma Assoc : (a:A)(l:(list A×B))(B+{(AllS_assoc [a':A]not(a=a'l)}).

End Assoc_sec.

End Lists.

Hints Resolve Isnil_nil not_Isnil_cons in_hd in_tl in_cons allS_nil allS_cons
   : datatypes.
Hints 

6   Sets

This is a library on sets defined by their characteristic predicate. It contains the following modules:

Module Ensembles

Id: Ensembles.v,v 1.3 2001/04/11 12:41:40 filliatr Exp
Section Ensembles.
Variable UType.

Definition Ensemble := U ® Prop.

Definition In : Ensemble ® U ® Prop := [AEnsemble] [xU] (A x).

Definition Included : Ensemble ® Ensemble ® Prop :=
     [BCEnsemble] (xU) (In B x® (In C x).

Inductive Empty_set : Ensemble :=
     .

Inductive Full_set : Ensemble :=
       Full_intro: (xU) (In Full_set x).

NB The following definition builds-in equality of elements in U as Leibniz equality. This may have to be changed if we replace U by a Setoid on U with its own equality eqs, with In_singleton: (yU)(eqs x y® (In (Singleton xy).
Inductive Singleton [x:U] : Ensemble :=
       In_singleton: (In (Singleton xx).

Inductive Union [BCEnsemble] : Ensemble :=
       Union_introl: (xU) (In B x® (In (Union B Cx)
     | Union_intror: (xU) (In C x® (In (Union B Cx).

Definition Add : Ensemble ® U ® Ensemble :=
     [BEnsemble] [xU] (Union B (Singleton x)).

Inductive Intersection [BC:Ensemble] : Ensemble :=
       Intersection_intro:
         (xU) (In B x® (In C x® (In (Intersection B Cx).

Inductive Couple [x,y:U] : Ensemble :=
       Couple_l: (In (Couple x yx)
     | Couple_r: (In (Couple x yy).

Inductive Triple[xyz:U] : Ensemble :=
     Triple_l: (In (Triple x y zx)
   | Triple_m: (In (Triple x y zy)
   | Triple_r: (In (Triple x y zz).

Definition Complement : Ensemble ® Ensemble :=
     [AEnsemble] [xUnot (In A x).

Definition Setminus : Ensemble ® Ensemble ® Ensemble :=
     [BEnsemble] [CEnsemble] [xU] (In B x) & not (In C x).

Definition Subtract : Ensemble ® U ® Ensemble :=
     [BEnsemble] [xU] (Setminus B (Singleton x)).

Inductive Disjoint [BC:Ensemble] : Prop :=
       Disjoint_intro: ((xUnot (In (Intersection B Cx)) ® (Disjoint B C).

Inductive Inhabited [B:Ensemble] : Prop :=
       Inhabited_intro: (xU) (In B x® (Inhabited B).

Definition Strict_Included : Ensemble ® Ensemble ® Prop :=
     [BCEnsemble] (Included B C) & not B == C.

Definition Same_set : Ensemble ® Ensemble ® Prop :=
     [BCEnsemble] (Included B C) & (Included C B).

****** Extensionality Axiom ******
Axiom Extensionality_Ensembles:
     (A,BEnsemble) (Same_set A B® A == B.
Hints Resolve Extensionality_Ensembles.

End Ensembles.

Hints Unfold In Included Same_set Strict_Included Add Setminus Subtract : sets v62.

Hints Resolve Union_introl Union_intror Intersection_intro In_singleton Couple_l
         Couple_r Triple_l Triple_m Triple_r Disjoint_intro
         Extensionality_Ensembles : sets v62.

Module Constructive_sets

Id: Constructivesets.v,v 1.2 2001/03/15 13:38:53 filliatr Exp
Require Export Ensembles.

Section Ensembles_facts.
Variable UType.

Lemma Extension: (BC: (Ensemble U)) B == C ® (Same_set U B C).

Lemma Noone_in_empty: (xUnot (In U (Empty_set Ux).
Hints Resolve Noone_in_empty.

Lemma Included_Empty: (A: (Ensemble U))(Included U (Empty_set UA).
Hints Resolve Included_Empty.

Lemma Add_intro1:
   (A: (Ensemble U)) (xyU) (In U A y® (In U (Add U A xy).
Hints Resolve Add_intro1.

Lemma Add_intro2: (A: (Ensemble U)) (xU) (In U (Add U A xx).
Hints Resolve Add_intro2.

Lemma Inhabited_add: (A: (Ensemble U)) (xU) (Inhabited U (Add U A x)).
Hints Resolve Inhabited_add.

Lemma Inhabited_not_empty:
   (X: (Ensemble U)) (Inhabited U X® not X == (Empty_set U).
Hints Resolve Inhabited_not_empty.

Lemma Add_not_Empty :
   (A: (Ensemble U)) (xUnot (Add U A x) == (Empty_set U).
Hints Resolve Add_not_Empty.

Lemma not_Empty_Add :
   (A: (Ensemble U)) (xUnot (Empty_set U) == (Add U A x).
Hints Resolve not_Empty_Add.

Lemma Singleton_inv: (xyU) (In U (Singleton U xy® x == y.
Hints Resolve Singleton_inv.

Lemma Singleton_intro: (xyUx == y ® (In U (Singleton U xy).
Hints Resolve Singleton_intro.

Lemma Union_inv: (BC: (Ensemble U)) (xU
   (In U (Union U B Cx® (In U B xor (In U C x).

Lemma Add_inv:
   (A: (Ensemble U)) (xyU) (In U (Add U A xy® (In U A yor x == y.

Lemma Intersection_inv:
   (BC: (Ensemble U)) (xU) (In U (Intersection U B Cx®
     (In U B x) & (In U C x).
Hints Resolve Intersection_inv.

Lemma Couple_inv: (xyzU) (In U (Couple U x yz® z == x or z == y.
Hints Resolve Couple_inv.

Lemma Setminus_intro:
   (AB: (Ensemble U)) (xU) (In U A x® not (In U B x®
     (In U (Setminus U A Bx).
Hints Resolve Setminus_intro.

Lemma Strict_Included_intro:
   (XY: (Ensemble U)) (Included U X Y) & not X == Y ® 
                         (Strict_Included U X Y).
Hints Resolve Strict_Included_intro.

Lemma Strict_Included_strict: (X: (Ensemble U)) not (Strict_Included U X X).
Hints Resolve Strict_Included_strict.

End Ensembles_facts.

Hints Resolve Singleton_inv Singleton_intro Add_intro1 Add_intro2
         Intersection_inv Couple_inv Setminus_intro Strict_Included_intro
         Strict_Included_strict Noone_in_empty Inhabited_not_empty
         Add_not_Empty not_Empty_Add Inhabited_add Included_Empty : sets v62.

Module Classical_sets

Id: Classicalsets.v,v 1.2 2001/03/15 13:38:53 filliatr Exp
Require Export Ensembles.
Require Export Constructive_sets.
Require Export Classical_Type.

Hints Unfold not .
Section Ensembles_classical.
Variable UType.

Lemma not_included_empty_Inhabited
   (A: (Ensemble U)) not (Included U A (Empty_set U)) ® (Inhabited U A).
Hints Resolve not_included_empty_Inhabited.

Lemma not_empty_Inhabited
   (A: (Ensemble U)) not A == (Empty_set U® (Inhabited U A).

Lemma Inhabited_Setminus :
(XY: (Ensemble U)) (Included U X Y® not (Included U Y X®
         (Inhabited U (Setminus U Y X)).
Hints Resolve Inhabited_Setminus.

Lemma Strict_super_set_contains_new_element:
   (XY: (Ensemble U)) (Included U X Y® not X == Y ®
     (Inhabited U (Setminus U Y X)).
Hints Resolve Strict_super_set_contains_new_element.

Lemma Subtract_intro:
   (A: (Ensemble U)) (xyU) (In U A y® not x == y ®
     (In U (Subtract U A xy).
Hints Resolve Subtract_intro.

Lemma Subtract_inv:
   (A: (Ensemble U)) (xyU) (In U (Subtract U A xy®
     (In U A y) & not x == y.

Lemma Included_Strict_Included:
   (XY: (Ensemble U)) (Included U X Y® (Strict_Included U X Yor X == Y.

Lemma Strict_Included_inv:
   (XY: (Ensemble U)) (Strict_Included U X Y®
     (Included U X Y) & (Inhabited U (Setminus U Y X)).

Lemma not_SIncl_empty
     (X: (Ensemble U)) not (Strict_Included U X (Empty_set U)).

Lemma Complement_Complement :
   (A: (Ensemble U)) (Complement U (Complement U A)) == A.

End Ensembles_classical.

Hints Resolve Strict_super_set_contains_new_element Subtract_intro
         not_SIncl_empty : sets v62.

Module Relations_1_facts

Require Export Relations_1.

Definition Complement : (UType) (Relation U® (Relation U) :=
     [UType] [R: (Relation U)] [x,yUnot (R x y).

Theorem Rsym_imp_notRsym: (UType) (R: (Relation U)) (Symmetric U R®
             (Symmetric U (Complement U R)).

Theorem Equiv_from_preorder :
   (UType) (R: (Relation U)) (Preorder U R®
             (Equivalence U [x,yU] (R x y) & (R y x)).
Hints Resolve Equiv_from_preorder.

Theorem Equiv_from_order :
   (UType) (R: (Relation U)) (Order U R®
             (Equivalence U [x,yU] (R x y) & (R y x)).
Hints Resolve Equiv_from_order.

Theorem contains_is_preorder :
   (UType) (Preorder (Relation U) (contains U)).
Hints Resolve contains_is_preorder.

Theorem same_relation_is_equivalence :
   (UType) (Equivalence (Relation U) (same_relation U)).
Hints Resolve same_relation_is_equivalence.

Theorem cong_reflexive_same_relation:
   (U:Type) (RR':(Relation U)) (same_relation U R R'® (Reflexive U R®
   (Reflexive U R').

Theorem cong_symmetric_same_relation:
   (U:Type) (RR':(Relation U)) (same_relation U R R'® (Symmetric U R®
   (Symmetric U R').

Theorem cong_antisymmetric_same_relation:
   (U:Type) (RR':(Relation U)) (same_relation U R R'®
             (Antisymmetric U R® (Antisymmetric U R').

Theorem cong_transitive_same_relation:
   (U:Type) (RR':(Relation U)) (same_relation U R R'® (Transitive U R®
   (Transitive U R').

Module Relations_1

Id: Relations1.v,v 1.2 2001/03/15 13:38:54 filliatr Exp
Section Relations_1.
     Variable UType.

Definition Relation := U ® U ® Prop.
     Variable RRelation.

Definition Reflexive : Prop := (xU) (R x x).

Definition Transitive : Prop := (x,y,zU) (R x y® (R y z® (R x z).

Definition Symmetric : Prop := (x,yU) (R x y® (R y x).

Definition Antisymmetric : Prop :=
       (xU) (yU) (R x y® (R y x® x == y.

Definition contains : Relation ® Relation ® Prop :=
       [R,R'Relation] (xU) (yU) (R' x y® (R x y).

Definition same_relation : Relation ® Relation ® Prop :=
       [R,R'Relation] (contains R R') & (contains R' R).

Inductive Preorder : Prop :=
           Definition_of_preorderReflexive ® Transitive ® Preorder.

Inductive Order : Prop :=
           Definition_of_orderReflexive ® Transitive ® Antisymmetric ® Order.

Inductive Equivalence : Prop :=
           Definition_of_equivalence:
             Reflexive ® Transitive ® Symmetric ® Equivalence.

Inductive PER : Prop :=
           Definition_of_PERSymmetric ® Transitive ® PER.

End Relations_1.
Hints Unfold Reflexive Transitive Antisymmetric Symmetric contains
         same_relation : sets v62.
Hints Resolve Definition_of_preorder Definition_of_order
         Definition_of_equivalence Definition_of_PER : sets v62.

Module Permut

Id: Permut.v,v 1.3 2001/04/11 12:41:40 filliatr Exp
G. Huet 1-9-95
We consider a Set U, given with a commutative-associative operator op, and a congruence cong; we show permutation lemmas
Section Axiomatisation.

Variable USet.

Variable opU ® U ® U.

Variable cong : U ® U ® Prop.

Hypothesis op_comm : (x,y:U)(cong (op x y) (op y x)).
Hypothesis op_ass : (x,y,z:U)(cong (op (op x yz) (op x (op y z))).

Hypothesis cong_left : (x,y,z:U)(cong x y)®(cong (op x z) (op y z)).
Hypothesis cong_right : (x,y,z:U)(cong x y)®(cong (op z x) (op z y)).
Hypothesis cong_trans : (x,y,z:U)(cong x y)®(cong y z)®(cong x z).
Hypothesis cong_sym : (x,y:U)(cong x y)®(cong y x).

Remark. we do not need: Hypothesis cong_refl : (x:U)(cong x x).
Lemma cong_congr :
   (x,y,z,t:U)(cong x y)®(cong z t)®(cong (op x z) (op y t)).

Lemma comm_right : (x,y,z:U)(cong (op x (op y z)) (op x (op z y))).

Lemma comm_left : (x,y,z:U)(cong (op (op x yz) (op (op y xz)).

Lemma perm_right : (x,y,z:U)(cong (op (op x yz) (op (op x zy)).

Lemma perm_left : (x,y,z:U)(cong (op x (op y z)) (op y (op x z))).

Lemma op_rotate : (x,y,z,t:U)(cong (op x (op y z)) (op z (op x y))).

Needed for treesort ...
Lemma twist : (x,y,z,t:U)
     (cong (op x (op (op y zt)) (op (op y (op x t)) z)).

End Axiomatisation.

Module Partial_Order

Id: PartialOrder.v,v 1.3 2001/03/15 13:38:54 filliatr Exp
Require Export Ensembles.
Require Export Relations_1.

Section Partial_orders.
Variable UType.

Definition Carrier := (Ensemble U).

Definition Rel := (Relation U).

Record PO : Type := Definition_of_PO {
     Carrier_of: (Ensemble U);
     Rel_of: (Relation U);
     PO_cond1: (Inhabited U Carrier_of);
     PO_cond2: (Order U Rel_of) }.
Variable pPO.

Definition Strict_Rel_of : Rel := [xyU] (Rel_of p x y) & not x == y.

Inductive covers [yx:U]: Prop :=
       Definition_of_covers:
       (Strict_Rel_of x y®
           not (EXT z | (Strict_Rel_of x z) & (Strict_Rel_of z y)) ®
           (covers y x).

End Partial_orders.

Hints Unfold Carrier_of Rel_of Strict_Rel_of : sets v62.
Hints Resolve Definition_of_covers : sets v62.

Section Partial_order_facts.
Variable U:Type.
Variable D:(PO U).

Lemma Strict_Rel_Transitive_with_Rel:
   (x:U) (y:U) (z:U) (Strict_Rel_of U D x y® (Rel_of U D y z®
   (Strict_Rel_of U D x z).

Lemma Strict_Rel_Transitive_with_Rel_left:
   (x:U) (y:U) (z:U) (Rel_of U D x y® (Strict_Rel_of U D y z®
   (Strict_Rel_of U D x z).

Lemma Strict_Rel_Transitive: (Transitive U (Strict_Rel_of U D)).
End Partial_order_facts.

Module Cpo

Id: Cpo.v,v 1.2 2001/03/15 13:38:54 filliatr Exp
Require Export Ensembles.
Require Export Relations_1.
Require Export Partial_Order.

Section Bounds.
Variable UType.
Variable D: (PO U).

Local C := (Carrier_of U D).

Local R := (Rel_of U D).

Inductive Upper_Bound [B:(Ensemble U); x:U]: Prop :=
       Upper_Bound_definition:
         (In U C x® ((yU) (In U B y® (R y x)) ® (Upper_Bound B x).

Inductive Lower_Bound [B:(Ensemble U); x:U]: Prop :=
       Lower_Bound_definition:
         (In U C x® ((yU) (In U B y® (R x y)) ® (Lower_Bound B x).

Inductive Lub [B:(Ensemble U); x:U]: Prop :=
       Lub_definition:
         (Upper_Bound B x® ((yU) (Upper_Bound B y® (R x y)) ® (Lub B x).

Inductive Glb [B:(Ensemble U); x:U]: Prop :=
       Glb_definition:
         (Lower_Bound B x® ((yU) (Lower_Bound B y® (R y x)) ® (Glb B x).

Inductive Bottom [bot:U]: Prop :=
       Bottom_definition:
         (In U C bot® ((yU) (In U C y® (R bot y)) ® (Bottom bot).

Inductive Totally_ordered [B:(Ensemble U)]: Prop :=
       Totally_ordered_definition:
         ((Included U B C®
           (xU) (yU) (Included U (Couple U x yB® (R x yor (R y x)) ®
           (Totally_ordered B).

Definition Compatible : (Relation U) :=
     [xU] [yU] (In U C x® (In U C y®
     (EXT z | (In U C z) & (Upper_Bound (Couple U x yz)).

Inductive Directed [X:(Ensemble U)]: Prop :=
       Definition_of_Directed:
         (Included U X C®
         (Inhabited U X®
         ((x1U) (x2U) (Included U (Couple U x1 x2X®
           (EXT x3 | (In U X x3) & (Upper_Bound (Couple U x1 x2x3))) ®
           (Directed X).

Inductive Complete : Prop :=
       Definition_of_Complete:
         ((EXT bot | (Bottom bot))) ®
         ((X: (Ensemble U)) (Directed X® (EXT bsup | (Lub X bsup))) ®
           Complete.

Inductive Conditionally_complete : Prop :=
       Definition_of_Conditionally_complete:
         ((X: (Ensemble U))
           (Included U X C® (EXT maj | (Upper_Bound X maj)) ®
           (EXT bsup | (Lub X bsup))) ® Conditionally_complete.
End Bounds.
Hints Resolve Totally_ordered_definition Upper_Bound_definition
         Lower_Bound_definition Lub_definition Glb_definition
         Bottom_definition Definition_of_Complete
           Definition_of_Complete Definition_of_Conditionally_complete.

Section Specific_orders.
Variable UType.

Record Cpo : Type := Definition_of_cpo {
     PO_of_cpo: (PO U);
     Cpo_cond: (Complete U PO_of_cpo) }.

Record Chain : Type := Definition_of_chain {
     PO_of_chain: (PO U);
     Chain_cond: (Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)) }.

End Specific_orders.

Module Powerset

Id: Powerset.v,v 1.3 2001/03/15 13:38:54 filliatr Exp
Require Export Ensembles.
Require Export Relations_1.
Require Export Relations_1_facts.
Require Export Partial_Order.
Require Export Cpo.

Section The_power_set_partial_order.
Variable UType.

Inductive Power_set [A:(Ensemble U)]: (Ensemble (Ensemble U)) :=
     Definition_of_Power_set:
       (X: (Ensemble U)) (Included U X A® (In (Ensemble U) (Power_set AX).
Hints Resolve Definition_of_Power_set.

Theorem Empty_set_minimal: (X: (Ensemble U)) (Included U (Empty_set UX).
Hints Resolve Empty_set_minimal.

Theorem Power_set_Inhabited:
   (X: (Ensemble U)) (Inhabited (Ensemble U) (Power_set X)).
Hints Resolve Power_set_Inhabited.

Theorem Inclusion_is_an_order: (Order (Ensemble U) (Included U)).
Hints Resolve Inclusion_is_an_order.

Theorem Inclusion_is_transitive: (Transitive (Ensemble U) (Included U)).
Hints Resolve Inclusion_is_transitive.

Definition Power_set_PO: (Ensemble U® (PO (Ensemble U)).
Hints Unfold Power_set_PO.

Theorem Strict_Rel_is_Strict_Included:
   (same_relation
       (Ensemble U) (Strict_Included U)
       (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U)))).
Hints Resolve Strict_Rel_Transitive Strict_Rel_is_Strict_Included.

Lemma Strict_inclusion_is_transitive_with_inclusion:
   (xyz:(Ensemble U)) (Strict_Included U x y® (Included U y z®
   (Strict_Included U x z).

Lemma Strict_inclusion_is_transitive_with_inclusion_left:
   (xyz:(Ensemble U)) (Included U x y® (Strict_Included U y z®
   (Strict_Included U x z).

Lemma Strict_inclusion_is_transitive:
   (Transitive (Ensemble U) (Strict_Included U)).

Theorem Empty_set_is_Bottom:
   (A: (Ensemble U)) (Bottom (Ensemble U) (Power_set_PO A) (Empty_set U)).
Hints Resolve Empty_set_is_Bottom.

Theorem Union_minimal:
   (abX: (Ensemble U)) (Included U a X® (Included U b X®
     (Included U (Union U a bX).
Hints Resolve Union_minimal.

Theorem Intersection_maximal:
   (abX: (Ensemble U)) (Included U X a® (Included U X b®
     (Included U X (Intersection U a b)).

Theorem Union_increases_l: (ab: (Ensemble U)) (Included U a (Union U a b)).

Theorem Union_increases_r: (ab: (Ensemble U)) (Included U b (Union U a b)).

Theorem Intersection_decreases_l:
   (ab: (Ensemble U)) (Included U (Intersection U a ba).

Theorem Intersection_decreases_r:
   (ab: (Ensemble U)) (Included U (Intersection U a bb).
Hints Resolve Union_increases_l Union_increases_r Intersection_decreases_l
       Intersection_decreases_r.

Theorem Union_is_Lub:
   (A: (Ensemble U)) (ab: (Ensemble U)) (Included U a A® (Included U b A®
     (Lub (Ensemble U) (Power_set_PO A) (Couple (Ensemble Ua b) (Union U a b)).

Theorem Intersection_is_Glb:
   (A: (Ensemble U)) (ab: (Ensemble U)) (Included U a A® (Included U b A®
     (Glb
       (Ensemble U)
       (Power_set_PO A)
       (Couple (Ensemble Ua b)
       (Intersection U a b)).

End The_power_set_partial_order.

Hints Resolve Empty_set_minimal : sets v62.
Hints Resolve Power_set_Inhabited : sets v62.
Hints Resolve Inclusion_is_an_order : sets v62.
Hints Resolve Inclusion_is_transitive : sets v62.
Hints Resolve Union_minimal : sets v62.
Hints Resolve Union_increases_l : sets v62.
Hints Resolve Union_increases_r : sets v62.
Hints Resolve Intersection_decreases_l : sets v62.
Hints Resolve Intersection_decreases_r : sets v62.
Hints Resolve Empty_set_is_Bottom : sets v62.
Hints Resolve Strict_inclusion_is_transitive : sets v62.

Module Powerset_facts

Id: Powersetfacts.v,v 1.4 2001/03/15 13:38:54 filliatr Exp
Require Export Ensembles.
Require Export Constructive_sets.
Require Export Relations_1.
Require Export Relations_1_facts.
Require Export Partial_Order.
Require Export Cpo.
Require Export Powerset.

Section Sets_as_an_algebra.
Variable UType.
Hints Unfold not.

Theorem Empty_set_zero :
   (X: (Ensemble U)) (Union U (Empty_set UX) == X.
Hints Resolve Empty_set_zero.

Theorem Empty_set_zero' :
   (xU) (Add U (Empty_set Ux) == (Singleton U x).
Hints Resolve Empty_set_zero'.

Lemma less_than_empty :
   (X: (Ensemble U)) (Included U X (Empty_set U)) ® X == (Empty_set U).
Hints Resolve less_than_empty.

Theorem Union_commutative :
   (A,B: (Ensemble U)) (Union U A B) == (Union U B A).

Theorem Union_associative :
   (ABC: (Ensemble U))
   (Union U (Union U A BC) == (Union U A (Union U B C)).
Hints Resolve Union_associative.

Theorem Union_idempotent : (A: (Ensemble U)) (Union U A A) == A.

Lemma Union_absorbs :
   (AB: (Ensemble U)) (Included U B A® (Union U A B) == A.

Theorem Couple_as_union:
   (xyU) (Union U (Singleton U x) (Singleton U y)) == (Couple U x y).

Theorem Triple_as_union :
   (xyzU)
   (Union U (Union U (Singleton U x) (Singleton U y)) (Singleton U z)) ==
   (Triple U x y z).

Theorem Triple_as_Couple : (xyU) (Couple U x y) == (Triple U x x y).

Theorem Triple_as_Couple_Singleton :
   (xyzU) (Triple U x y z) == (Union U (Couple U x y) (Singleton U z)).

Theorem Intersection_commutative :
   (A,B: (Ensemble U)) (Intersection U A B) == (Intersection U B A).

Theorem Distributivity :
   (ABC: (Ensemble U))
       (Intersection U A (Union U B C)) ==
       (Union U (Intersection U A B) (Intersection U A C)).

Theorem Distributivity' :
   (ABC: (Ensemble U))
       (Union U A (Intersection U B C)) ==
       (Intersection U (Union U A B) (Union U A C)).

Theorem Union_add :
   (AB: (Ensemble U)) (xU)
     (Add U (Union U A Bx) == (Union U A (Add U B x)).
Hints Resolve Union_add.

Theorem Non_disjoint_union :
   (X: (Ensemble U)) (xU) (In U X x® (Add U X x) == X.

Theorem Non_disjoint_union' :
   (X: (Ensemble U)) (xUnot (In U X x® (Subtract U X x) == X.

Lemma singlx : (xyU) (In U (Add U (Empty_set Uxy® x == y.
Hints Resolve singlx.

Lemma incl_add :
   (AB: (Ensemble U)) (xU) (Included U A B®
     (Included U (Add U A x) (Add U B x)).
Hints Resolve incl_add.

Lemma incl_add_x :
   (AB: (Ensemble U))
   (xUnot (In U A x® (Included U (Add U A x) (Add U B x)) ®
     (Included U A B).

Lemma Add_commutative :
   (A: (Ensemble U)) (xyU) (Add U (Add U A xy) == (Add U (Add U A yx).

Lemma Add_commutative' :
   (A: (Ensemble U)) (xyzU)
     (Add U (Add U (Add U A xyz) == (Add U (Add U (Add U A zxy).

Lemma Add_distributes :
   (AB: (Ensemble U)) (xyU) (Included U B A®
   (Add U (Add U A xy) == (Union U (Add U A x) (Add U B y)).

Lemma setcover_intro :
   (UType)
   (A: (Ensemble U))
   (xy: (Ensemble U))
   (Strict_Included U x y®
   not (EXT z | (Strict_Included U x z
               & (Strict_Included U z y)) ®
     (covers (Ensemble U) (Power_set_PO U Ay x).
Hints Resolve setcover_intro.

End Sets_as_an_algebra.

Hints Resolve Empty_set_zero Empty_set_zero' Union_associative Union_add
         singlx incl_add : sets v62.

Id: Powersetfacts.v,v 1.4 2001/03/15 13:38:54 filliatr Exp

Module Powerset_Classical_facts

Id: PowersetClassicalfacts.v,v 1.2 2001/03/15 13:38:54 filliatr Exp
Require Export Ensembles.
Require Export Constructive_sets.
Require Export Relations_1.
Require Export Relations_1_facts.
Require Export Partial_Order.
Require Export Cpo.
Require Export Powerset.
Require Export Powerset_facts.
Require Export Classical_Type.
Require Export Classical_sets.

Section Sets_as_an_algebra.

Variable UType.

Lemma sincl_add_x:
   (AB: (Ensemble U))
   (xUnot (In U A x® (Strict_Included U (Add U A x) (Add U B x)) ®
                           (Strict_Included U A B).

Lemma incl_soustr_in:
   (X: (Ensemble U)) (xU) (In U X x® (Included U (Subtract U X xX).
Hints Resolve incl_soustr_in : sets v62.

Lemma incl_soustr:
   (XY: (Ensemble U)) (xU) (Included U X Y®
     (Included U (Subtract U X x) (Subtract U Y x)).
Hints Resolve incl_soustr : sets v62.

Lemma incl_soustr_add_l:
   (X: (Ensemble U)) (xU) (Included U (Subtract U (Add U X xxX).
Hints Resolve incl_soustr_add_l : sets v62.

Lemma incl_soustr_add_r:
   (X: (Ensemble U)) (xUnot (In U X x®
     (Included U X (Subtract U (Add U X xx)).
Hints Resolve incl_soustr_add_r : sets v62.

Lemma add_soustr_2:
   (X: (Ensemble U)) (xU) (In U X x®
     (Included U X (Add U (Subtract U X xx)).

Lemma add_soustr_1:
   (X: (Ensemble U)) (xU) (In U X x®
     (Included U (Add U (Subtract U X xxX).
Hints Resolve add_soustr_1 add_soustr_2 : sets v62.

Lemma add_soustr_xy:
   (X: (Ensemble U)) (xyUnot x == y ®
     (Subtract U (Add U X xy) == (Add U (Subtract U X yx).
Hints Resolve add_soustr_xy : sets v62.

Lemma incl_st_add_soustr:
   (XY: (Ensemble U)) (xUnot (In U X x® 
     (Strict_Included U (Add U X xY®
     (Strict_Included U X (Subtract U Y x)).

Lemma Sub_Add_new:
   (X: (Ensemble U)) (xUnot (In U X x® X == (Subtract U (Add U X xx).

Lemma Simplify_add:
   (XX0 : (Ensemble U)) (xU)
   not (In U X x® not (In U X0 x® (Add U X x) == (Add U X0 x® X == X0.

Lemma Included_Add:
   (XA: (Ensemble U)) (xU) (Included U X (Add U A x)) ®
     (Included U X Aor
     (EXT A' | X == (Add U A' x) & (Included U A' A)).

Lemma setcover_inv:
   (A: (Ensemble U))
   (xy: (Ensemble U)) (covers (Ensemble U) (Power_set_PO U Ay x®
   (Strict_Included U x y) &
   ((z: (Ensemble U)) (Included U x z® (Included U z y® x == z or z == y).

Theorem Add_covers:
   (A: (Ensemble U)) (a: (Ensemble U)) (Included U a A®
     (xU) (In U A x® not (In U a x®
     (covers (Ensemble U) (Power_set_PO U A) (Add U a xa).

Theorem covers_Add:
   (A: (Ensemble U))
   (aa': (Ensemble U))
   (Included U a A®
   (Included U a' A® (covers (Ensemble U) (Power_set_PO U Aa' a®
     (EXT x | a' == (Add U a x) & ((In U A x) & not (In U a x))).

Theorem covers_is_Add:
   (A: (Ensemble U))
   (aa': (Ensemble U)) (Included U a A® (Included U a' A®
     (iff
       (covers (Ensemble U) (Power_set_PO U Aa' a)
       (EXT x | a' == (Add U a x) & ((In U A x) & not (In U a x)))).

Theorem Singleton_atomic:
   (x:U) (A:(Ensemble U)) (In U A x®
   (covers (Ensemble U) (Power_set_PO U A) (Singleton U x) (Empty_set U)).

Lemma less_than_singleton:
   (X:(Ensemble U)) (x:U) (Strict_Included U X (Singleton U x)) ®
   X ==(Empty_set U).

End Sets_as_an_algebra.

Hints Resolve incl_soustr_in : sets v62.
Hints Resolve incl_soustr : sets v62.
Hints Resolve incl_soustr_add_l : sets v62.
Hints Resolve incl_soustr_add_r : sets v62.
Hints Resolve add_soustr_1 add_soustr_2 : sets v62.
Hints Resolve add_soustr_xy : sets v62.

Module Finite_sets

Id: Finitesets.v,v 1.2 2001/03/15 13:38:54 filliatr Exp
Require Ensembles.

Section Ensembles_finis.
Variable UType.

Inductive Finite : (Ensemble U® Prop :=
       Empty_is_finite: (Finite (Empty_set U))
     | Union_is_finite:
       (A: (Ensemble U)) (Finite A®
       (xUnot (In U A x® (Finite (Add U A x)).

Inductive cardinal : (Ensemble U® nat ® Prop :=
       card_empty: (cardinal (Empty_set UO)
     | card_add:
         (A: (Ensemble U)) (nnat) (cardinal A n®
         (xUnot (In U A x® (cardinal (Add U A x) (S n)).

End Ensembles_finis.

Hints Resolve Empty_is_finite Union_is_finite : sets v62.
Hints Resolve card_empty card_add : sets v62.

Require Constructive_sets.

Section Ensembles_finis_facts.
Variable UType.

Lemma cardinal_invert :
   (X: (Ensemble U)) (p:nat)(cardinal U X p® Case p of
             X == (Empty_set U)
     [n:nat] (EXT A | (EXT x | 
             X == (Add U A x) & not (In U A x) & (cardinal U A n))) end.

Lemma cardinal_elim :
   (X: (Ensemble U)) (p:nat)(cardinal U X p® Case p of
                               X == (Empty_set U)
                               [n:nat](Inhabited U Xend.

End Ensembles_finis_facts.

Module Finite_sets_facts

Id: Finitesetsfacts.v,v 1.3 2001/03/15 13:38:54 filliatr Exp
Require Export Finite_sets.
Require Export Constructive_sets.
Require Export Classical_Type.
Require Export Classical_sets.
Require Export Powerset.
Require Export Powerset_facts.
Require Export Powerset_Classical_facts.
Require Export Gt.
Require Export Lt.

Section Finite_sets_facts.
Variable UType.

Lemma finite_cardinal :
   (X: (Ensemble U)) (Finite U X® (EX n:nat |(cardinal U X n)).

Lemma cardinal_finite:
   (X: (Ensemble U)) (nnat) (cardinal U X n® (Finite U X).

Theorem Add_preserves_Finite:
   (X: (Ensemble U)) (xU) (Finite U X® (Finite U (Add U X x)).
Hints Resolve Add_preserves_Finite.

Theorem Singleton_is_finite: (xU) (Finite U (Singleton U x)).
Hints Resolve Singleton_is_finite.

Theorem Union_preserves_Finite:
   (XY: (Ensemble U)) (Finite U X® (Finite U Y® 
                         (Finite U (Union U X Y)).

Lemma Finite_downward_closed:
   (A: (Ensemble U)) (Finite U A®
     (X: (Ensemble U)) (Included U X A® (Finite U X).

Lemma Intersection_preserves_finite:
   (A: (Ensemble U)) (Finite U A®
     (X: (Ensemble U)) (Finite U (Intersection U X A)).

Lemma cardinalO_empty:
   (X: (Ensemble U)) (cardinal U X O® X == (Empty_set U).
Hints Resolve cardinalO_empty.

Lemma inh_card_gt_O:
   (X: (Ensemble U)) (Inhabited U X® (nnat) (cardinal U X n® (gt n O).

Lemma card_soustr_1:
   (X: (Ensemble U)) (nnat) (cardinal U X n®
     (xU) (In U X x® (cardinal U (Subtract U X x) (pred n)).

Lemma cardinal_is_functional:
   (X: (Ensemble U)) (c1nat) (cardinal U X c1®
     (Y: (Ensemble U)) (c2nat) (cardinal U Y c2® X == Y ®
     c1 = c2.

Lemma cardinal_Empty : (m:nat)(cardinal U (Empty_set Um® O = m.

Lemma cardinal_unicity :
   (X: (Ensemble U)) (nnat) (cardinal U X n® 
                     (mnat) (cardinal U X m® n = m.

Lemma card_Add_gen:
   (A: (Ensemble U))
   (xU) (nn'nat) (cardinal U A n® (cardinal U (Add U A xn'®
     (le n' (S n)).

Lemma incl_st_card_lt:
   (X: (Ensemble U)) (c1nat) (cardinal U X c1®
   (Y: (Ensemble U)) (c2nat) (cardinal U Y c2® (Strict_Included U X Y®
     (gt c2 c1).

Lemma incl_card_le:
   (X,Y: (Ensemble U)) (n,mnat) (cardinal U X n® (cardinal U Y m® 
   (Included U X Y® (le n m).

Lemma G_aux:
   (P:(Ensemble U®Prop)
   ((X:(Ensemble U))
     (Finite U X® ((Y:(Ensemble U)) (Strict_Included U Y X®(P Y)) ®(P X)) ®
   (P (Empty_set U)).

Hints Unfold not.

Lemma Generalized_induction_on_finite_sets:
   (P:(Ensemble U®Prop)
   ((X:(Ensemble U))
     (Finite U X® ((Y:(Ensemble U)) (Strict_Included U Y X®(P Y)) ®(P X)) ®
   (X:(Ensemble U)) (Finite U X®(P X).

End Finite_sets_facts.

Module Image

Id: Image.v,v 1.2 2001/03/15 13:38:54 filliatr Exp
Require Export Finite_sets.
Require Export Constructive_sets.
Require Export Classical_Type.
Require Export Classical_sets.
Require Export Powerset.
Require Export Powerset_facts.
Require Export Powerset_Classical_facts.
Require Export Gt.
Require Export Lt.
Require Export Le.
Require Export Finite_sets_facts.

Section Image.
Variables UVType.

Inductive Im [X:(Ensemble U); f:U ® V]: (Ensemble V) :=
       Im_intro: (xU) (In ? X x® (yVy == (f x® (In ? (Im X fy).

Lemma Im_def:
   (X: (Ensemble U)) (fU ® V) (xU) (In ? X x® (In ? (Im X f) (f x)).
Hints Resolve Im_def.

Lemma Im_add:
   (X: (Ensemble U)) (xU) (fU ® V)
       (Im (Add ? X xf) == (Add ? (Im X f) (f x)).

Lemma image_empty: (fU ® V) (Im (Empty_set Uf) == (Empty_set V).
Hints Resolve image_empty.

Lemma finite_image:
   (X: (Ensemble U)) (fU ® V) (Finite ? X® (Finite ? (Im X f)).
Hints Resolve finite_image.

Lemma Im_inv:
   (X: (Ensemble U)) (fU ® V) (yV) (In ? (Im X fy®
     (exT ? [xU] (In ? X x) & (f x) == y).

Definition injective := [fU ® V] (xyU) (f x) == (f y® x == y.

Lemma not_injective_elim:
   (fU ® Vnot (injective f®
     (EXT x | (EXT y | (f x) == (f y) & not x == y)).

Lemma cardinal_Im_intro:
   (A: (Ensemble U)) (fU ® V) (nnat) (cardinal ? A n®
     (EX pnat | (cardinal ? (Im A fp)).

Lemma In_Image_elim:
   (A: (Ensemble U)) (fU ® V) (injective f®
     (xU) (In ? (Im A f) (f x)) ® (In ? A x).

Lemma injective_preserves_cardinal:
   (A: (Ensemble U)) (fU ® V) (nnat) (injective f® (cardinal ? A n®
     (n'nat) (cardinal ? (Im A fn'® n' = n.

Lemma cardinal_decreases:
   (A: (Ensemble U)) (fU ® V) (nnat) (cardinal U A n®
     (n'nat) (cardinal V (Im A fn'® (le n' n).

Theorem Pigeonhole:
   (A: (Ensemble U)) (fU ® V) (nnat) (cardinal U A n®
     (n'nat) (cardinal V (Im A fn'® (lt n' n® not (injective f).

Lemma Pigeonhole_principle:
   (A: (Ensemble U)) (fU ® V) (nnat) (cardinal ? A n®
     (n'nat) (cardinal ? (Im A fn'® (lt n' n®
     (EXT x | (EXT y | (f x) == (f y) & not x == y)).
End Image.
Hints Resolve Im_def image_empty finite_image : sets v62.

Module Relations_2

Id: Relations2.v,v 1.2 2001/03/15 13:38:54 filliatr Exp
Require Export Relations_1.

Section Relations_2.
Variable UType.
Variable R: (Relation U).

Inductive Rstar : (Relation U) :=
       Rstar_0: (xU) (Rstar x x)
     | Rstar_n: (xyzU) (R x y® (Rstar y z® (Rstar x z).

Inductive Rstar1 : (Relation U) :=
       Rstar1_0: (xU) (Rstar1 x x)
     | Rstar1_1: (xU) (yU) (R x y® (Rstar1 x y)
     | Rstar1_n: (xyzU) (Rstar1 x y® (Rstar1 y z® (Rstar1 x z).

Inductive Rplus : (Relation U) :=
       Rplus_0: (xyU) (R x y® (Rplus x y)
     | Rplus_n: (xyzU) (R x y® (Rplus y z® (Rplus x z).

Definition Strongly_confluent : Prop :=
     (xabU) (R x a® (R x b® (exT U [zU] (R a z) & (R b z)).

End Relations_2.

Hints Resolve Rstar_0 : sets v62.
Hints Resolve Rstar1_0 : sets v62.
Hints Resolve Rstar1_1 : sets v62.
Hints Resolve Rplus_0 : sets v62.

Module Infinite_sets

Id: Infinitesets.v,v 1.2 2001/03/15 13:38:54 filliatr Exp
Require Export Finite_sets.
Require Export Constructive_sets.
Require Export Classical_Type.
Require Export Classical_sets.
Require Export Powerset.
Require Export Powerset_facts.
Require Export Powerset_Classical_facts.
Require Export Gt.
Require Export Lt.
Require Export Le.
Require Export Finite_sets_facts.
Require Export Image.

Section Approx.
Variable UType.

Inductive Approximant [AX:(Ensemble U)] : Prop :=
   Defn_of_Approximant: (Finite U X® (Included U X A® (Approximant A X).
End Approx.

Hints Resolve Defn_of_Approximant.

Section Infinite_sets.
Variable UType.

Lemma make_new_approximant:
   (A: (Ensemble U)) (X: (Ensemble U)) not (Finite U A® (Approximant U A X®
     (Inhabited U (Setminus U A X)).

Lemma approximants_grow:
   (A: (Ensemble U)) (X: (Ensemble U)) not (Finite U A®
     (nnat) (cardinal U X n® (Included U X A®
     (EXT Y | (cardinal U Y (S n)) & (Included U Y A)).

Lemma approximants_grow':
   (A: (Ensemble U)) (X: (Ensemble U)) not (Finite U A®
     (nnat) (cardinal U X n® (Approximant U A X®
     (EXT Y | (cardinal U Y (S n)) & (Approximant U A Y)).

Lemma approximant_can_be_any_size:
   (A: (Ensemble U)) (X: (Ensemble U)) not (Finite U A®
     (nnat) (EXT Y | (cardinal U Y n) & (Approximant U A Y)).

Variable VType.

Theorem Image_set_continuous:
   (A: (Ensemble U))
   (fU ® V) (X: (Ensemble V)) (Finite V X® (Included V X (Im U V A f)) ®
     (EX n |
     (EXT Y | ((cardinal U Y n) & (Included U Y A)) & (Im U V Y f) == X)).

Theorem Image_set_continuous':
   (A: (Ensemble U))
   (fU ® V) (X: (Ensemble V)) (Approximant V (Im U V A fX®
     (EXT Y | (Approximant U A Y) & (Im U V Y f) == X).

Theorem Pigeonhole_bis:
   (A: (Ensemble U)) (fU ® Vnot (Finite U A® (Finite V (Im U V A f)) ®
     not (injective U V f).

Theorem Pigeonhole_ter:
   (A: (Ensemble U))
   (fU ® V) (nnat) (injective U V f® (Finite V (Im U V A f)) ®
     (Finite U A).

End Infinite_sets.

Module Relations_2_facts

Require Export Relations_1.
Require Export Relations_1_facts.
Require Export Relations_2.

Theorem Rstar_reflexive : 
   (UType) (R: (Relation U)) (Reflexive U (Rstar U R)).

Theorem Rplus_contains_R :
   (UType) (R: (Relation U)) (contains U (Rplus U RR).

Theorem Rstar_contains_R :
   (UType) (R: (Relation U)) (contains U (Rstar U RR).

Theorem Rstar_contains_Rplus :
   (UType) (R: (Relation U)) (contains U (Rstar U R) (Rplus U R)).

Theorem Rstar_transitive :
   (UType) (R: (Relation U)) (Transitive U (Rstar U R)).

Theorem Rstar_cases :
   (UType) (R: (Relation U)) (xyU) (Rstar U R x y®
     x == y or (EXT u | (R x u) & (Rstar U R u y)).

Theorem Rstar_equiv_Rstar1 :
   (UType) (R: (Relation U)) (same_relation U (Rstar U R) (Rstar1 U R)).

Theorem Rsym_imp_Rstarsym :
   (UType) (R: (Relation U)) (Symmetric U R® (Symmetric U (Rstar U R)).

Theorem Sstar_contains_Rstar :
   (UType) (RS: (Relation U)) (contains U (Rstar U SR®
     (contains U (Rstar U S) (Rstar U R)).

Theorem star_monotone :
   (UType) (RS: (Relation U)) (contains U S R®
     (contains U (Rstar U S) (Rstar U R)).

Theorem RstarRplus_RRstar :
   (UType) (R: (Relation U)) (xyzU
     (Rstar U R x y® (Rplus U R y z®
     (EXT u | (R x u) & (Rstar U R u z)).

Theorem Lemma1 : 
   (UType) (R: (Relation U)) (Strongly_confluent U R®
     (xbU) (Rstar U R x b®
     (aU) (R x a® (EXT z | (Rstar U R a z) & (R b z)).

Module Relations_3

Require Export Relations_1.
Require Export Relations_2.

Section Relations_3.
     Variable UType.
     Variable R: (Relation U).

Definition coherent : U ® U ® Prop :=
       [x,yU] (EXT z | (Rstar U R x z) & (Rstar U R y z)).

Definition locally_confluent : U ® Prop :=
       [xU] (y,zU) (R x y® (R x z® (coherent y z).

Definition Locally_confluent : Prop := (xU) (locally_confluent x).

Definition confluent : U ® Prop :=
       [xU] (y,zU) (Rstar U R x y® (Rstar U R x z® (coherent y z).

Definition Confluent : Prop := (xU) (confluent x).

Inductive noetherian : U ® Prop :=
           definition_of_noetherian:
             (xU) ((yU) (R x y® (noetherian y)) ® (noetherian x).

Definition Noetherian : Prop := (xU) (noetherian x).

End Relations_3.
Hints Unfold coherent : sets v62.
Hints Unfold locally_confluent : sets v62.
Hints Unfold confluent : sets v62.
Hints Unfold Confluent : sets v62.
Hints Resolve definition_of_noetherian : sets v62.
Hints Unfold Noetherian : sets v62.

Id: Relations3.v,v 1.2 2001/03/15 13:38:54 filliatr Exp

Module Integers

Id: Integers.v,v 1.2 2001/03/15 13:38:54 filliatr Exp
Require Export Finite_sets.
Require Export Constructive_sets.
Require Export Classical_Type.
Require Export Classical_sets.
Require Export Powerset.
Require Export Powerset_facts.
Require Export Powerset_Classical_facts.
Require Export Gt.
Require Export Lt.
Require Export Le.
Require Export Finite_sets_facts.
Require Export Image.
Require Export Infinite_sets.
Require Export Compare_dec.
Require Export Relations_1.
Require Export Partial_Order.
Require Export Cpo.

Section Integers_sect.

Inductive Nat : Type :=
       mkNatnat ® Nat.

Parameter nat_of_NatNat ® nat.

Axiom nat_of_nat_returns: (nnat) (nat_of_Nat (mkNat n)) = n.

Lemma mkNat_injective: (n1n2nat) (mkNat n1) == (mkNat n2® n1 = n2.

Inductive Integers : (Ensemble Nat) :=
       Integers_defn: (xNat) (In Nat Integers x).
Hints Resolve Integers_defn.

Inductive Le_Nat [xy:Nat]: Prop :=
       Definition_of_Le_nat:
         (n1n2natx == (mkNat n1® y == (mkNat n2® (le n1 n2®
           (Le_Nat x y).

Lemma Le_Nat_direct: (n1n2nat) (le n1 n2® (Le_Nat (mkNat n1) (mkNat n2)).
Hints Resolve Le_Nat_direct.

Lemma Le_Nat_Reflexive: (Reflexive Nat Le_Nat).
Hints Resolve Le_Nat_Reflexive.

Lemma Le_Nat_antisym: (Antisymmetric Nat Le_Nat).

Hints Resolve Le_Nat_antisym.

Lemma Le_Nat_trans: (Transitive Nat Le_Nat).
Hints Resolve Le_Nat_trans.

Lemma Le_Nat_Order: (Order Nat Le_Nat).
Hints Resolve Le_Nat_Order.

Definition Nat_O := (mkNat O).

Lemma triv_Nat: (nnat) (In Nat Integers (mkNat n)).
Hints Resolve triv_Nat.

Definition Nat_po: (PO Nat).
Hints Unfold Nat_po.

Lemma Le_Nat_total_order: (Totally_ordered Nat Nat_po Integers).
Hints Resolve Le_Nat_total_order.

Lemma Finite_subset_has_lub:
   (X: (Ensemble Nat)) (Finite Nat X®
     (EXT mNat | (Upper_Bound Nat Nat_po X m)).

Lemma Integers_has_no_ubnot (EXT m:Nat | (Upper_Bound Nat Nat_po Integers m)).

Lemma Integers_infinitenot (Finite Nat Integers).

End Integers_sect.

Module Multiset

Id: Multiset.v,v 1.3 2001/04/11 12:41:40 filliatr Exp
G. Huet 1-9-95
Require Permut.

Implicit Arguments On.

Section multiset_defs.

Variable A : Set.
Variable eqA : A ® A ® Prop.
Hypothesis Aeq_dec : (x,y:A){(eqA x y)}+{not(eqA x y)}.

Inductive multiset : Set :=
       Bag : (A®nat® multiset.

Definition EmptyBag := (Bag [a:A]O).
Definition SingletonBag := [a:A]
         (Bag [a':A]Cases (Aeq_dec a a'of
                       (left _) Þ (S O)
                     | (right _) Þ O
                     end
         ).

Definition multiplicity : multiset ® A ® nat :=
   [m:multiset][a:A]let (f) = m in (f a).

multiset equality
Definition meq := [m1,m2:multiset]
     (a:A)(multiplicity m1 a)=(multiplicity m2 a).

Hints Unfold meq multiplicity.

Lemma meq_refl : (x:multiset)(meq x x).
Hints Resolve meq_refl.

Lemma meq_trans : (x,y,z:multiset)(meq x y)®(meq y z)®(meq x z).

Lemma meq_sym : (x,y:multiset)(meq x y)®(meq y x).
Hints 
(* multiset union *)
Definition munion := [m1,m2:multiset]
     (Bag [a:A](plus (multiplicity m1 a)(multiplicity m2 a))).

Lemma munion_empty_left :
       (x:multiset)(meq x (munion EmptyBag x)).
Hints Resolve munion_empty_left.

Lemma munion_empty_right :
       (x:multiset)(meq x (munion x EmptyBag)).

Require Plus. (* comm. and ass. of plus *)

Lemma munion_comm : (x,y:multiset)(meq (munion x y) (munion y x)).
Hints Resolve munion_comm.

Lemma munion_ass : 
       (x,y,z:multiset)(meq (munion (munion x yz) (munion x (munion y z))).
Hints Resolve munion_ass.

Lemma meq_left : (x,y,z:multiset)(meq x y)®(meq (munion x z) (munion y z)).
Hints Resolve meq_left.

Lemma meq_right : (x,y,z:multiset)(meq x y)®(meq (munion z x) (munion z y)).
Hints Resolve meq_right.

Here we should make multiset an abstract datatype, by hiding Bag, munion, multiplicity; all further properties are proved abstractly
Lemma munion_rotate :
     (x,y,z:multiset)(meq (munion x (munion y z)) (munion z (munion x y))).

Lemma meq_congr : (x,y,z,t:multiset)(meq x y)®(meq z t)®
                   (meq (munion x z) (munion y t)).

Lemma munion_perm_left :
     (x,y,z:multiset)(meq (munion x (munion y z)) (munion y (munion x z))).

Lemma multiset_twist1 : (x,y,z,t:multiset)
     (meq (munion x (munion (munion y zt)) (munion (munion y (munion x t)) z)).

Lemma multiset_twist2 : (x,y,z,t:multiset)
     (meq (munion x (munion (munion y zt)) (munion (munion y (munion x z)) t)).

specific for treesort
Lemma treesort_twist1 : (x,y,z,t,u:multiset) (meq u (munion y z)) ®
     (meq (munion x (munion u t)) (munion (munion y (munion x t)) z)).

Lemma treesort_twist2 : (x,y,z,t,u:multiset) (meq u (munion y z)) ®
     (meq (munion x (munion u t)) (munion (munion y (munion x z)) t)).

theory of minter to do similarly Require Min. (* multiset intersection *) Definition minter := m1,m2:multiset (Bag a:A(min (multiplicity m1 a)(multiplicity m2 a))).


End multiset_defs.

Implicit Arguments Off.

Hints Unfold meq multiplicity : v62 datatypes.
Hints Resolve munion_empty_right munion_comm munion_ass meq_left meq_right munion_empty_left : v62 datatypes.
Hints 

Module Relations_3_facts

Require Export Relations_1.
Require Export Relations_1_facts.
Require Export Relations_2.
Require Export Relations_2_facts.
Require Export Relations_3.

Theorem Rstar_imp_coherent :
   (UType) (R: (Relation U)) (xU) (yU) (Rstar U R x y®
     (coherent U R x y).
Hints Resolve Rstar_imp_coherent.

Theorem coherent_symmetric :
   (UType) (R: (Relation U)) (Symmetric U (coherent U R)).

Theorem Strong_confluence :
   (UType) (R: (Relation U)) (Strongly_confluent U R® (Confluent U R).

Theorem Strong_confluence_direct :
   (UType) (R: (Relation U)) (Strongly_confluent U R® (Confluent U R).

Theorem Noetherian_contains_Noetherian :
   (UType) (RR': (Relation U)) (Noetherian U R® (contains U R R'®
     (Noetherian U R').

Theorem Newman :
   (UType) (R: (Relation U)) (Noetherian U R® (Locally_confluent U R®
     (Confluent U R).

Module Uniset

Id: Uniset.v,v 1.4 2001/04/11 12:41:40 filliatr Exp
Sets as characteristic functions
G. Huet 1-9-95
Updated Papageno 12/98
Require Bool.

Implicit Arguments On.

Section defs.

Variable A : Set.
Variable eqA : A ® A ® Prop.
Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{not(eqA x y)}.

Inductive uniset : Set :=
       Charac : (A®bool® uniset.

Definition charac : uniset ® A ® bool :=
   [s:uniset][a:A]Case s of [f:A®bool](f aend.

Definition Emptyset := (Charac [a:A]false).

Definition Fullset := (Charac [a:A]true).

Definition Singleton := [a:A](Charac [a':A]
               Case (eqA_dec a a'of
                     [h:(eqA a a')] true
                     [hnot(eqA a a')] false end).

Definition In : uniset ® A ® Prop :=
       [s:uniset][a:A](charac s a)=true.
Hints Unfold In.

uniset inclusion
Definition incl := [s1,s2:uniset]
     (a:A)(leb (charac s1 a) (charac s2 a)).
Hints Unfold incl.

uniset equality
Definition seq := [s1,s2:uniset]
     (a:A)(charac s1 a) = (charac s2 a).
Hints Unfold seq.

Lemma leb_refl : (b:bool)(leb b b).
Hints Resolve leb_refl.

Lemma incl_left : (s1,s2:uniset)(seq s1 s2)®(incl s1 s2).

Lemma incl_right : (s1,s2:uniset)(seq s1 s2)®(incl s2 s1).

Lemma seq_refl : (x:uniset)(seq x x).
Hints Resolve seq_refl.

Lemma seq_trans : (x,y,z:uniset)(seq x y)®(seq y z)®(seq x z).

Lemma seq_sym : (x,y:uniset)(seq x y)®(seq y x).

uniset union
Definition union := [m1,m2:uniset]
     (Charac [a:A](orb (charac m1 a)(charac m2 a))).

Lemma union_empty_left :
       (x:uniset)(seq x (union Emptyset x)).
Hints Resolve union_empty_left.

Lemma union_empty_right :
       (x:uniset)(seq x (union x Emptyset)).
Hints Resolve union_empty_right.

Lemma union_comm : (x,y:uniset)(seq (union x y) (union y x)).
Hints Resolve union_comm.

Lemma union_ass : 
       (x,y,z:uniset)(seq (union (union x yz) (union x (union y z))).
Hints Resolve union_ass.

Lemma seq_left : (x,y,z:uniset)(seq x y)®(seq (union x z) (union y z)).
Hints Resolve seq_left.

Lemma seq_right : (x,y,z:uniset)(seq x y)®(seq (union z x) (union z y)).
Hints Resolve seq_right.

All the proofs that follow duplicate Multiset_of_A
Here we should make uniset an abstract datatype, by hiding Charac, union, charac; all further properties are proved abstractly
Require Permut.

Lemma union_rotate :
     (x,y,z:uniset)(seq (union x (union y z)) (union z (union x y))).

Lemma seq_congr : (x,y,z,t:uniset)(seq x y)®(seq z t)®
                   (seq (union x z) (union y t)).

Lemma union_perm_left :
     (x,y,z:uniset)(seq (union x (union y z)) (union y (union x z))).

Lemma uniset_twist1 : (x,y,z,t:uniset)
     (seq (union x (union (union y zt)) (union (union y (union x t)) z)).

Lemma uniset_twist2 : (x,y,z,t:uniset)
     (seq (union x (union (union y zt)) (union (union y (union x z)) t)).

specific for treesort
Lemma treesort_twist1 : (x,y,z,t,u:uniset) (seq u (union y z)) ®
     (seq (union x (union u t)) (union (union y (union x t)) z)).

Lemma treesort_twist2 : (x,y,z,t,u:uniset) (seq u (union y z)) ®
     (seq (union x (union u t)) (union (union y (union x z)) t)).

theory of minter to do similarly Require Min. (* uniset intersection *) Definition minter := m1,m2:uniset (Charac a:A(andb (charac m1 a)(charac m2 a))).


End defs.

Implicit Arguments Off.

7   Relations

This library develops closure properties of relations.

Module Rstar

Id: Rstar.v,v 1.2 2001/03/15 13:38:53 filliatr Exp
Properties of a binary relation R on type A
Parameter A : Type.
   Parameter R : A®A®Prop.

Definition of the reflexive-transitive closure R* of R
Smallest reflexive P containing R o P
Definition Rstar := [x,y:A](P:A®A®Prop)
     ((u:A)(P u u))®((u:A)(v:A)(w:A)(R u v)®(P v w)®(P u w)) ® (P x y).

Theorem Rstar_reflexive: (x:A)(Rstar x x).

Theorem Rstar_R: (x:A)(y:A)(z:A)(R x y)®(Rstar y z)®(Rstar x z).

We conclude with transitivity of Rstar :
Theorem Rstar_transitive: (x:A)(y:A)(z:A)(Rstar x y)®(Rstar y z)®(Rstar x z).

Another characterization of R*
Smallest reflexive P containing R o R*
Definition Rstar' := [x:A][y:A](P:A®A®Prop)
     ((P x x))®((u:A)(R x u)®(Rstar u y)®(P x y)) ® (P x y).

Theorem Rstar'_reflexive: (x:A)(Rstar' x x).

Theorem Rstar'_R: (x:A)(y:A)(z:A)(R x z)®(Rstar z y)®(Rstar' x y).

Equivalence of the two definitions:
Theorem Rstar'_Rstar: (x:A)(y:A)(Rstar' x y)®(Rstar x y).

Theorem Rstar_Rstar': (x:A)(y:A)(Rstar x y)®(Rstar' x y).

Property of Commutativity of two relations
Definition commut := [A:Set][R1,R2:A®A®Prop]
                         (x,y:A)(R1 y x)®(z:A)(R2 z y)
                         ®(EX y':A |(R2 y' x) & (R1 z y')).

Module Newman

Id: Newman.v,v 1.2 2001/03/15 13:38:53 filliatr Exp
Require Rstar.

Definition coherence := [x:A][y:A] (exT2 ? (Rstar x) (Rstar y)).

Theorem coherence_intro : (x:A)(y:A)(z:A)(Rstar x z)®(Rstar y z)®(coherence x y).

A very simple case of coherence :
Lemma Rstar_coherence : (x:A)(y:A)(Rstar x y)®(coherence x y).

coherence is symmetric
Lemma coherence_sym: (x:A)(y:A)(coherence x y)®(coherence y x).

Definition confluence :=
       [x:A](y:A)(z:A)(Rstar x y)®(Rstar x z)®(coherence y z).

Definition local_confluence :=
       [x:A](y:A)(z:A)(R x y)®(R x z)®(coherence y z).

Definition noetherian :=
       (x:A)(P:A®Prop)((y:A)((z:A)(R y z)®(P z))®(P y))®(P x).

Section Newman_section.

The general hypotheses of the theorem
Hypothesis Hyp1:noetherian.
Hypothesis Hyp2:(x:A)(local_confluence x).

The induction hypothesis
Section Induct.
   Variable x:A.
   Hypothesis hyp_ind:(u:A)(R x u)®(confluence u).

Confluence in x
Variables y,z:A.
   Hypothesis h1:(Rstar x y).
   Hypothesis h2:(Rstar x z).

particular case x->u and u->*y
Section Newman_.
   Variable u:A.
   Hypothesis t1:(R x u).
   Hypothesis t2:(Rstar u y).

In the usual diagram, we assume also x->v and v->*z
Theorem Diagram : (v:A)(u1:(R x v))(u2:(Rstar v z))(coherence y z).

Theorem caseRxy : (coherence y z).
(* case x->v->*z *)
End Newman_.

Theorem Ind_proof : (coherence y z).
(* case x->u->*z *)
End Induct.

Theorem Newman : (x:A)(confluence x).

End Newman_section.

Module Relation_Definitions

Id: RelationDefinitions.v,v 1.2 2001/03/15 13:38:53 filliatr Exp
Section Relation_Definition.

Variable ASet.

Definition relation := A ® A ® Prop.

Variable Rrelation.

Section General_Properties_of_Relations.

Definition reflexive : Prop := (xA) (R x x).
   Definition transitive : Prop := (x,y,zA) (R x y® (R y z® (R x z).
   Definition symmetric : Prop := (x,yA) (R x y® (R y x).
   Definition antisymmetric : Prop := (x,yA) (R x y® (R y x® x=y.

for compatibility with Equivalence in ../PROGRAMS/ALG/
Definition equiv := reflexive & transitive & symmetric.

End General_Properties_of_Relations.

Section Sets_of_Relations.

Record preorder : Prop := {
         preord_refl : reflexive;
         preord_trans : transitive }.

Record order : Prop := {
         ord_refl : reflexive;
         ord_trans : transitive;
         ord_antisym : antisymmetric }.

Record equivalence : Prop := {
         equiv_refl : reflexive;
         equiv_trans : transitive;
         equiv_sym : symmetric }.

Record PER : Prop := {
         per_sym : symmetric;
         per_trans : transitive }.

End Sets_of_Relations.

Section Relations_of_Relations.

Definition inclusion : relation ® relation ® Prop :=
       [R1,R2relation] (x,y:A) (R1 x y® (R2 x y).

Definition same_relation : relation ® relation ® Prop :=
       [R1,R2relation] (inclusion R1 R2) & (inclusion R2 R1).

Definition commut : relation ® relation ® Prop :=
       [R1,R2:relation] (x,y:A) (R1 y x® (z:A) (R2 z y)
                           ® (EX y':A |(R2 y' x) & (R1 z y')).

End Relations_of_Relations.

End Relation_Definition.

Hints Unfold reflexive transitive antisymmetric symmetric : sets v62.

Hints Resolve Build_preorder Build_order Build_equivalence
         Build_PER preord_refl preord_trans
         ord_refl ord_trans ord_antisym
         equiv_refl equiv_trans equiv_sym
         per_sym per_trans : sets v62.

Hints Unfold inclusion same_relation commut : sets v62.

Module Relation_Operators

Id: RelationOperators.v,v 1.4 2001/03/15 13:38:53 filliatr Exp
Bruno Barras Cristina Cornes
Some of these definitons were taken from :
Constructing Recursion Operators in Type Theory
L. Paulson JSC (1986) 2, 325-355
Require Relation_Definitions.
Require PolyList.
Require PolyListSyntax.

Some operators to build relations
Section Transitive_Closure.
   Variable ASet.
   Variable R: (relation A).

Inductive clos_trans : A®A®Prop :=
       t_step: (x,y:A)(R x y)®(clos_trans x y)
     | t_trans: (x,y,z:A)(clos_trans x y)®(clos_trans y z)®(clos_trans x z).
End Transitive_Closure.

Section Reflexive_Transitive_Closure.
   Variable ASet.
   Variable R: (relation A).

Inductive clos_refl_trans: (relation A) :=
     rt_step: (x,y:A)(R x y)®(clos_refl_trans x y)
   | rt_refl: (x:A)(clos_refl_trans x x)
   | rt_trans: (x,y,zA)(clos_refl_trans x y)®(clos_refl_trans y z)
                       ®(clos_refl_trans x z).
End Reflexive_Transitive_Closure.

Section Reflexive_Symetric_Transitive_Closure.
   Variable ASet.
   Variable R: (relation A).

Inductive clos_refl_sym_trans: (relation A) :=
     rst_step: (x,y:A)(R x y)®(clos_refl_sym_trans x y)
   | rst_refl: (x:A)(clos_refl_sym_trans x x)
   | rst_sym: (x,y:A)(clos_refl_sym_trans x y)®(clos_refl_sym_trans y x)
   | rst_trans: (x,y,z:A)(clos_refl_sym_trans x y)®(clos_refl_sym_trans y z)
                       ®(clos_refl_sym_trans x z).
End Reflexive_Symetric_Transitive_Closure.

Section Transposee.
   Variable ASet.
   Variable R: (relation A).

Definition transp := [x,y:A](R y x).
End Transposee.

Section Union.
   Variable ASet.
   Variable R1,R2: (relation A).

Definition union := [x,y:A](R1 x y)or(R2 x y).
End Union.

Section Disjoint_Union.
Variable A,B:Set.
Variable leAA®A®Prop.
Variable leBB®B®Prop.

Inductive le_AsB : A+B®A+B®Prop :=
     le_aa: (x,y:A) (leA x y® (le_AsB (inl A B x) (inl A B y))
le_ab: (x:A)(y:B) (le_AsB (inl A B x) (inr A B y))
le_bb: (x,y:B) (leB x y® (le_AsB (inr A B x) (inr A B y)).

End Disjoint_Union.

Section Lexicographic_Product.
(* Lexicographic order on dependent pairs *)

Variable A:Set.
Variable B:A®Set.
Variable leAA®A®Prop.
Variable leB: (x:A)(B x)®(B x)®Prop.

Inductive lexprod : (sigS A B® (sigS A B®Prop :=
   left_lex : (x,x':A)(y:(B x)) (y':(B x'))
                 (leA x x'®(lexprod (existS A B x y) (existS A B x' y'))
right_lex : (x:A) (y,y':(B x))
                 (leB x y y'® (lexprod (existS A B x y) (existS A B x y')).
End Lexicographic_Product.

Section Symmetric_Product.
   Variable A:Set.
   Variable B:Set.
   Variable leAA®A®Prop.
   Variable leBB®B®Prop.

Inductive symprod : (A×B® (A×B®Prop :=
       left_sym : (x,x':A)(leA x x')®(y:B)(symprod (x,y) (x',y))
   | right_sym : (y,y':B)(leB y y')®(x:A)(symprod (x,y) (x,y')).

End Symmetric_Product.

Section Swap.
   Variable A:Set.
   Variable R:A®A®Prop.

Inductive swapprod: (A×A)®(A×A)®Prop :=
       sp_noswap: (x,x':A×A)(symprod A A R R x x')®(swapprod x x')
     | sp_swap: (x,y:A)(p:A×A)(symprod A A R R (x,yp)®(swapprod (y,xp).
End Swap.

Section Lexicographic_Exponentiation.

Variable A : Set.
Variable leA : A®A®Prop.
Local Nil := (nil A).
Local List := (list A).

Inductive Ltl : List®List®Prop :=
   Lt_nil: (a:A)(x:List)(Ltl Nil (cons a x))
Lt_hd : (a,b:A) (leA a b)® (x,y:(list A))(Ltl (cons a x) (cons b y))
Lt_tl : (a:A)(x,y:List)(Ltl x y® (Ltl (cons a x) (cons a y)).

Inductive Desc : List®Prop :=
     d_nil : (Desc Nil)
d_one : (x:A)(Desc (cons x Nil))
d_conc : (x,y:A)(l:List)(leA x y)
               ® (Desc l^(cons y Nil))®(Desc (l^(cons y Nil))^(cons x Nil)).

Definition Pow :Set := (sig List Desc).

Definition lex_exp : Pow ® Pow ®Prop :=
       [a,b:Pow](Ltl (proj1_sig List Desc a) (proj1_sig List Desc b)).

End Lexicographic_Exponentiation.

Hints Unfold transp union : sets v62.
Hints Resolve t_step rt_step rt_refl rst_step rst_refl : sets v62.
Hints 

Module Operators_Properties

Id: OperatorsProperties.v,v 1.3 2001/03/15 13:38:53 filliatr Exp
Bruno Barras
Require Relation_Definitions.
Require Relation_Operators.

Section Properties.

Variable ASet.
   Variable R: (relation A).

Local incl : (relation A)®(relation A)®Prop :=
       [R1,R2: (relation A)] (x,y:A) (R1 x y® (R2 x y).

Section Clos_Refl_Trans.

Lemma clos_rt_is_preorder: (preorder A (clos_refl_trans A R)).

Lemma clos_rt_idempotent:
         (incl (clos_refl_trans A (clos_refl_trans A R))
                       (clos_refl_trans A R)).

Lemma clos_refl_trans_ind_left: (A:Set)(R:A®A®Prop)(M:A)(P:A®Prop)
             (P M)
             ®((P0,N:A)
                 (clos_refl_trans A R M P0)®(P P0)®(R P0 N)®(P N))
                 ®(a:A)(clos_refl_trans A R M a)®(P a).

End Clos_Refl_Trans.

Section Clos_Refl_Sym_Trans.

Lemma clos_rt_clos_rst: (inclusion A (clos_refl_trans A R)
                                         (clos_refl_sym_trans A R)).

Lemma clos_rst_is_equiv: (equivalence A (clos_refl_sym_trans A R)).

Lemma clos_rst_idempotent:
         (incl (clos_refl_sym_trans A (clos_refl_sym_trans A R))
                       (clos_refl_sym_trans A R)).

End Clos_Refl_Sym_Trans.

End Properties.

Module Relations

Id: Relations.v,v 1.2 2001/03/15 13:38:53 filliatr Exp
Require Export Relation_Definitions.
Require Export Relation_Operators.
Require Export Operators_Properties.

Lemma inverse_image_of_equivalence : (A,B:Set)(f:A®B)
   (r:(relation B))(equivalence B r)®(equivalence A [x,y:A](r (f x) (f y))).

Lemma inverse_image_of_eq : (A,B:Set)(f:A®B)
   (equivalence A [x,y:A](f x)=(f y)).

8   Well-founded relations

This library gives definitions and results about well-founded relations.

Module Inclusion

Id: Inclusion.v,v 1.2 2001/03/15 13:38:55 filliatr Exp
Bruno Barras
Require Relation_Definitions.

Section WfInclusion.
   Variable A:Set.
   Variable R1,R2:A®A®Prop.

Lemma Acc_incl: (inclusion A R1 R2)®(z:A)(Acc A R2 z)®(Acc A R1 z).

Hints Resolve Acc_incl.

Theorem wf_incl
           (inclusion A R1 R2)®(well_founded A R2)®(well_founded A R1).

End WfInclusion.

Module Disjoint_Union

Id: DisjointUnion.v,v 1.3 2001/03/15 13:38:55 filliatr Exp
Cristina Cornes
From : Constructing Recursion Operators in Type Theory
L. Paulson JSC (1986) 2, 325-355
Require Relation_Operators.

Section Wf_Disjoint_Union.
Variable A,B:Set.
Variable leAA®A®Prop.
Variable leBB®B®Prop.

Syntactic Definition Le_AsB := (le_AsB A B leA leB).

Lemma acc_A_sum: (x:A)(Acc A leA x)®(Acc A+B Le_AsB (inl A B x)).

Lemma acc_B_sum: (well_founded A leA®(x:B)(Acc B leB x)
                         ®(Acc A+B Le_AsB (inr A B x)).

Lemma wf_disjoint_sum:
   (well_founded A leA
     ® (well_founded B leB® (well_founded A+B Le_AsB).

End Wf_Disjoint_Union.

Module Transitive_Closure

Id: TransitiveClosure.v,v 1.2 2001/03/15 13:38:55 filliatr Exp
Bruno Barras
Require Relation_Definitions.
Require Relation_Operators.

Section Wf_Transitive_Closure.
   Variable ASet.
   Variable R: (relation A).

Syntactic Definition trans_clos := (clos_trans A R).

Lemma incl_clos_trans: (inclusion A R trans_clos).

Lemma Acc_clos_trans: (x:A)(Acc A R x)®(Acc A trans_clos x).

Hints Resolve Acc_clos_trans.

Lemma Acc_inv_trans: (x,y:A)(trans_clos y x)®(Acc A R x)®(Acc A R y).

Theorem wf_clos_trans: (well_founded A R®(well_founded A trans_clos).

End Wf_Transitive_Closure.

Module Inverse_Image

Id: InverseImage.v,v 1.2 2001/03/15 13:38:55 filliatr Exp
Bruno Barras
Section Inverse_Image.

Variables A,B:Set.
   Variable R : B®B®Prop.
   Variable f:A®B.

Local Rof : A®A®Prop := [x,y:A](R (f x) (f y)).

Remark Acc_lemma : (y:B)(Acc B R y)®(x:A)(y=(f x))®(Acc A Rof x).

Lemma Acc_inverse_image : (x:A)(Acc B R (f x)) ® (Acc A Rof x).

Theorem wf_inverse_image: (well_founded B R)®(well_founded A Rof).

End Inverse_Image.

Id: InverseImage.v,v 1.2 2001/03/15 13:38:55 filliatr Exp

Module Lexicographic_Exponentiation

Id: LexicographicExponentiation.v,v 1.4 2001/03/15 13:38:55 filliatr Exp
Cristina Cornes
From : Constructing Recursion Operators in Type Theory
L. Paulson JSC (1986) 2, 325-355
Require Eqdep.
Require PolyList.
Require PolyListSyntax.
Require Relation_Operators.
Require Transitive_Closure.

Section Wf_Lexicographic_Exponentiation.
Variable A:Set.
Variable leAA®A®Prop.

Syntactic Definition Power := (Pow A leA).
Syntactic Definition Lex_Exp := (lex_exp A leA).
Syntactic Definition ltl := (Ltl A leA).
Syntactic Definition Descl := (Desc A leA).

Syntactic Definition List := (list A).
Syntactic Definition Nil := (nil A).
(* useless but symmetric *)
Syntactic Definition Cons := (cons 1!A).

Hints Resolve d_one d_nil t_step.

Lemma left_prefix : (x,y,z:List)(ltl x^y z)® (ltl x z).

Lemma right_prefix : 
   (x,y,z:List)(ltl x y^z)® (ltl x yor (EX y':List | x=(y^y') & (ltl y' z)).

Lemma desc_prefix: (x:List)(a:A)(Descl x^(Cons a Nil))®(Descl x).

Lemma desc_tail: (x:List)(a,b:A)
           (Descl (Cons b (x^(Cons a Nil))))® (clos_trans A leA a b).

Lemma dist_aux : (z:List)(Descl z)®(x,y:List)z=(x^y)®(Descl x)& (Descl y).

Lemma dist_Desc_concat : (x,y:List)(Descl x^y)®(Descl x)&(Descl y).

Lemma desc_end:(a,b:A)(x:List
     (Descl x^(Cons a Nil)) & (ltl x^(Cons a Nil) (Cons b Nil))
       ® (clos_trans A leA a b).

Lemma ltl_unit: (x:List)(a,b:A)
   (Descl (x^(Cons a Nil))) ® (ltl x^(Cons a Nil) (Cons b Nil))
                 ® (ltl x (Cons b Nil)).

Lemma acc_app
     (x1,x2:List)(y1:(Descl x1^x2))
       (Acc Power Lex_Exp (exist List Descl (x1^x2y1))
       ®(x:List)
         (y:(Descl x))
           (ltl x (x1^x2))®(Acc Power Lex_Exp (exist List Descl x y)).

Theorem wf_lex_exp :
   (well_founded A leA)®(well_founded Power Lex_Exp).

End Wf_Lexicographic_Exponentiation.

Module Union

Id: Union.v,v 1.2 2001/03/15 13:38:55 filliatr Exp
Bruno Barras
Require Relation_Operators.
Require Relation_Definitions.
Require Transitive_Closure.

Section WfUnion.
   Variable ASet.
   Variable R1,R2: (relation A).

Syntactic Definition Union := (union A R1 R2).

Hints Resolve Acc_clos_trans wf_clos_trans.

Remark strip_commut
       (commut A R1 R2)®(x,y:A)(clos_trans A R1 y x)®(z:A)(R2 z y)
             ®(EX y':A | (R2 y' x) & (clos_trans A R1 z y')).

Lemma Acc_union: (commut A R1 R2)®((x:A)(Acc A R2 x)®(Acc A R1 x))
                           ®(a:A)(Acc A R2 a)®(Acc A Union a).

Theorem wf_union: (commut A R1 R2)®(well_founded A R1)®(well_founded A R2)
                   ®(well_founded A Union).

End WfUnion.

Module Well_Ordering

Id: WellOrdering.v,v 1.3 2001/03/15 13:38:55 filliatr Exp
Cristina Cornes
From: Constructing Recursion Operators in Type Theory
L. Paulson JSC (1986) 2, 325-355
Require Eqdep.

Section WellOrdering.
Variable A:Set.
Variable B:A®Set.

Inductive WO : Set :=
     sup : (a:A)(f:(B a)®WO)WO.

Inductive le_WO : WO®WO®Prop :=
   le_sup : (a:A)(f:(B a)®WO)(v:(B a)) (le_WO (f v) (sup a f)).

Theorem wf_WO : (well_founded WO le_WO ).

End WellOrdering.

Section Characterisation_wf_relations.
(* wellfounded relations are the inverse image of wellordering types *)
(* in course of development *)

Variable A:Set.
Variable leA:A®A®Prop.

Definition B:= [a:A] {x:A | (leA x a)}.

Definition wof: (well_founded A leA)® A® (WO A B).

End Characterisation_wf_relations.

Module Lexicographic_Product

Id: LexicographicProduct.v,v 1.5 2001/04/11 12:41:40 filliatr Exp
Bruno Barras Cristina Cornes
Require Eqdep.
Require Relation_Operators.
Require Transitive_Closure.

From : Constructing Recursion Operators in Type Theory L. Paulson JSC (1986) 2, 325-355


Section WfLexicographic_Product.
Variable A:Set.
Variable B:A®Set.
Variable leAA®A®Prop.
Variable leB: (x:A)(B x)®(B x)®Prop.

Syntactic Definition LexProd := (lexprod A B leA leB).

Hints Resolve t_step Acc_clos_trans wf_clos_trans.

Lemma acc_A_B_lexprod : (x:A)(Acc A leA x)
         ®((x0:A)(clos_trans A leA x0 x)®(well_founded (B x0) (leB x0)))
                 ®(y:(B x))(Acc (B x) (leB xy)
                         ®(Acc (sigS A BLexProd (existS A B x y)).

Theorem wf_lexprod
     (well_founded A leA®((x:A) (well_founded (B x) (leB x))) 
               ® (well_founded (sigS A BLexProd).

End WfLexicographic_Product.

Section Wf_Symmetric_Product.
   Variable A:Set.
   Variable B:Set.
   Variable leAA®A®Prop.
   Variable leBB®B®Prop.

Syntactic Definition Symprod := (symprod A B leA leB).

Lemma Acc_symprod: (x:A)(Acc A leA x)®(y:B)(Acc B leB y)
                         ®(Acc (A×BSymprod (x,y)).

Lemma wf_symprod: (well_founded A leA)®(well_founded B leB)
                         ®(well_founded (A×BSymprod).

End Wf_Symmetric_Product.

Section Swap.

Variable A:Set.
   Variable R:A®A®Prop.

Syntactic Definition SwapProd :=(swapprod A R).

Lemma swap_Acc: (x,y:A)(Acc A×A SwapProd (x,y))®(Acc A×A SwapProd (y,x)).

Lemma Acc_swapprod: (x,y:A)(Acc A R x)®(Acc A R y)
                                 ®(Acc A×A SwapProd (x,y)).

Lemma wf_swapprod: (well_founded A R)®(well_founded A×A SwapProd).

End Swap.

Module Wellfounded

Id: Wellfounded.v,v 1.2 2001/03/15 13:38:55 filliatr Exp
Require Export Disjoint_Union.
Require Export Inclusion.
Require Export Inverse_Image.
Require Export Lexicographic_Exponentiation.
Require Export Lexicographic_Product.
Require Export Transitive_Closure.
Require Export Union.
Require Export Well_Ordering.

9   IntMap

This library contains a data structure for finite sets implemented by an efficient structure of map (trees indexed by binary integers).

Module Addr

Representation of adresses by positive the type of binary numbers
Require Bool.
Require ZArith.

Inductive ad : Set :=
     ad_z : ad
   | ad_x : positive ® ad.

Lemma ad_sum : (a:ad) {p:positive | a=(ad_x p)}+{a=ad_z}.

Fixpoint p_xor [p:positive] : positive ® ad :=
   [p2Cases p of
       xH Þ Cases p2 of
                 xH Þ ad_z
               | (xO p'2Þ (ad_x (xI p'2))
               | (xI p'2Þ (ad_x (xO p'2))
             end
     | (xO p'Þ Cases p2 of
                       xH Þ (ad_x (xI p'))
                     | (xO p'2Þ Cases (p_xor p' p'2of
                                       ad_z Þ ad_z
                                     | (ad_x p''Þ (ad_x (xO p''))
                                   end
                     | (xI p'2Þ Cases (p_xor p' p'2of
                                       ad_z Þ (ad_x xH)
                                     | (ad_x p''Þ (ad_x (xI p''))
                                   end
                   end
     | (xI p'Þ Cases p2 of
                       xH Þ (ad_x (xO p'))
                     | (xO p'2Þ Cases (p_xor p' p'2of
                                       ad_z Þ (ad_x xH)
                                     | (ad_x p''Þ (ad_x (xI p''))
                                   end
                     | (xI p'2Þ Cases (p_xor p' p'2of
                                       ad_z Þ ad_z
                                     | (ad_x p''Þ (ad_x (xO p''))
                                   end
                   end
   end.

Definition ad_xor := [a,a':ad]
   Cases a of
       ad_z Þ a'
     | (ad_x pÞ Cases a' of
                       ad_z Þ a
                     | (ad_x p'Þ (p_xor p p')
                   end
   end.

Lemma ad_xor_neutral_left : (a:ad) (ad_xor ad_z a)=a.

Lemma ad_xor_neutral_right : (a:ad) (ad_xor a ad_z)=a.

Lemma ad_xor_comm : (a,a':ad) (ad_xor a a')=(ad_xor a' a).

Lemma ad_xor_nilpotent : (a:ad) (ad_xor a a)=ad_z.

Fixpoint ad_bit_1 [p:positive] : nat ® bool :=
   Cases p of
       xH Þ [n:natCases n of
                         O Þ true
                       | (S _) Þ false
                     end
     | (xO pÞ [n:natCases n of
                             O Þ false
                           | (S n'Þ (ad_bit_1 p n')
                         end
     | (xI pÞ [n:natCases n of
                             O Þ true
                           | (S n'Þ (ad_bit_1 p n')
                         end
   end.

Definition ad_bit := [a:ad]
   Cases a of
       ad_z Þ [_:natfalse
     | (ad_x pÞ (ad_bit_1 p)
   end.

Definition eqf := [f,g:nat®bool] (n:nat) (f n)=(g n).

Lemma ad_faithful_1 : (a:ad) (eqf (ad_bit ad_z) (ad_bit a)) ® ad_z=a.

Lemma ad_faithful_2 : (a:ad) (eqf (ad_bit (ad_x xH)) (ad_bit a)) ® (ad_x xH)=a.

Lemma ad_faithful_3 :
     (a:ad) (p:positive)
       ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) ® p=p')
       ® (eqf (ad_bit (ad_x (xO p))) (ad_bit a))
         ® (ad_x (xO p))=a.

Lemma ad_faithful_4 :
     (a:ad) (p:positive)
       ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) ® p=p')
       ® (eqf (ad_bit (ad_x (xI p))) (ad_bit a))
         ® (ad_x (xI p))=a.

Lemma ad_faithful : (a,a':ad) (eqf (ad_bit a) (ad_bit a')) ® a=a'.

Definition adf_xor := [f,g:nat®booln:nat] (xorb (f n) (g n)).

Lemma ad_xor_sem_1 : (a':ad) (ad_bit (ad_xor ad_z a'O)=(ad_bit a' O).

Lemma ad_xor_sem_2 : (a':ad) (ad_bit (ad_xor (ad_x xHa'O)=(negb (ad_bit a' O)).

Lemma ad_xor_sem_3 : (p:positive) (a':ad) (ad_bit (ad_xor (ad_x (xO p)) a'O)=(ad_bit a' O).

Lemma ad_xor_sem_4 : (p:positive) (a':ad)
     (ad_bit (ad_xor (ad_x (xI p)) a'O)=(negb (ad_bit a' O)).

Lemma ad_xor_sem_5 : (a,a':ad) (ad_bit (ad_xor a a'O)=(adf_xor (ad_bit a) (ad_bit a'O).

Lemma ad_xor_sem_6 : (n:nat)
     ((a,a':ad) (ad_bit (ad_xor a a'n)=(adf_xor (ad_bit a) (ad_bit a'n))
     ® (a,a':ad) (ad_bit (ad_xor a a') (S n))=(adf_xor (ad_bit a) (ad_bit a') (S n)).

Lemma ad_xor_semantics : (a,a':ad) (eqf (ad_bit (ad_xor a a')) (adf_xor (ad_bit a) (ad_bit a'))).

Lemma eqf_sym : (f,f':nat®bool) (eqf f f'® (eqf f' f).

Lemma eqf_refl : (f:nat®bool) (eqf f f).

Lemma eqf_trans : (f,f',f'':nat®bool) (eqf f f'® (eqf f' f''® (eqf f f'').

Lemma adf_xor_eq : (f,f':nat®bool) (eqf (adf_xor f f') [n:natfalse® (eqf f f').

Lemma ad_xor_eq : (a,a':ad) (ad_xor a a')=ad_z ® a=a'.

Lemma adf_xor_assoc : (f,f',f'':nat®bool)
     (eqf (adf_xor (adf_xor f f'f'') (adf_xor f (adf_xor f' f''))).

Lemma eqf_xor_1 : (f,f',f'',f''':nat®bool) (eqf f f'® (eqf f'' f'''®
     (eqf (adf_xor f f'') (adf_xor f' f''')).

Lemma ad_xor_assoc : (a,a',a'':ad) (ad_xor (ad_xor a a'a'')=(ad_xor a (ad_xor a' a'')).

Definition ad_double := [a:ad]
   Cases a of
       ad_z Þ ad_z
     | (ad_x pÞ (ad_x (xO p))
   end.

Definition ad_double_plus_un := [a:ad]
   Cases a of
       ad_z Þ (ad_x xH)
     | (ad_x pÞ (ad_x (xI p))
   end.

Definition ad_div_2 := [a:ad]
   Cases a of
       ad_z Þ ad_z
     | (ad_x xHÞ ad_z
     | (ad_x (xO p)) Þ (ad_x p)
     | (ad_x (xI p)) Þ (ad_x p)
   end.

Lemma ad_double_div_2 : (a:ad) (ad_div_2 (ad_double a))=a.

Lemma ad_double_plus_un_div_2 : (a:ad) (ad_div_2 (ad_double_plus_un a))=a.

Lemma ad_double_inj : (a0,a1:ad) (ad_double a0)=(ad_double a1® a0=a1.

Lemma ad_double_plus_un_inj : (a0,a1:ad) (ad_double_plus_un a0)=(ad_double_plus_un a1® a0=a1.

Definition ad_bit_0 := [a:ad]
   Cases a of
       ad_z Þ false
     | (ad_x (xO _)) Þ false
     | _ Þ true
   end.

Lemma ad_double_bit_0 : (a:ad) (ad_bit_0 (ad_double a))=false.

Lemma ad_double_plus_un_bit_0 : (a:ad) (ad_bit_0 (ad_double_plus_un a))=true.

Lemma ad_div_2_double : (a:ad) (ad_bit_0 a)=false ® (ad_double (ad_div_2 a))=a.

Lemma ad_div_2_double_plus_un : (a:ad) (ad_bit_0 a)=true ® (ad_double_plus_un (ad_div_2 a))=a.

Lemma ad_bit_0_correct : (a:ad) (ad_bit a O)=(ad_bit_0 a).

Lemma ad_div_2_correct : (a:ad) (n:nat) (ad_bit (ad_div_2 an)=(ad_bit a (S n)).

Lemma ad_xor_bit_0 : (a,a':ad) (ad_bit_0 (ad_xor a a'))=(xorb (ad_bit_0 a) (ad_bit_0 a')).

Lemma ad_xor_div_2 : (a,a':ad) (ad_div_2 (ad_xor a a'))=(ad_xor (ad_div_2 a) (ad_div_2 a')).

Lemma ad_neg_bit_0 : (a,a':ad) (ad_bit_0 (ad_xor a a'))=true ®
     (ad_bit_0 a)=(negb (ad_bit_0 a')).

Lemma ad_neg_bit_0_1 : (a,a':ad) (ad_xor a a')=(ad_x xH® (ad_bit_0 a)=(negb (ad_bit_0 a')).

Lemma ad_neg_bit_0_2 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xI p)) ®
     (ad_bit_0 a)=(negb (ad_bit_0 a')).

Lemma ad_same_bit_0 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xO p)) ®
     (ad_bit_0 a)=(ad_bit_0 a').

Module Adist

Require Bool.
Require ZArith.
Require Arith.
Require Min.
Require Addr.

Fixpoint ad_plength_1 [p:positive] : nat :=
   Cases p of
       xH Þ O
     | (xI _) Þ O
     | (xO p'Þ (S (ad_plength_1 p'))
   end.

Inductive natinf : Set :=
     infty : natinf
   | ni : nat ® natinf.

Definition ad_plength := [a:ad]
   Cases a of
       ad_z Þ infty
     | (ad_x pÞ (ni (ad_plength_1 p))
   end.

Lemma ad_plength_infty : (a:ad) (ad_plength a)=infty ® a=ad_z.

Lemma ad_plength_zeros : (a:ad) (n:nat) (ad_plength a)=(ni n®
     (k:nat) (lt k n® (ad_bit a k)=false.

Lemma ad_plength_one : (a:ad) (n:nat) (ad_plength a)=(ni n® (ad_bit a n)=true.

Lemma ad_plength_first_one : (a:ad) (n:nat)
     ((k:nat) (lt k n® (ad_bit a k)=false® (ad_bit a n)=true ® (ad_plength a)=(ni n).

Definition ni_min := [d,d':natinf]
   Cases d of
       infty Þ d'
     | (ni nÞ Cases d' of
                     infty Þ d
                   | (ni n'Þ (ni (min n n'))
                 end
   end.

Lemma ni_min_idemp : (d:natinf) (ni_min d d)=d.

Lemma ni_min_comm : (d,d':natinf) (ni_min d d')=(ni_min d' d).

Lemma ni_min_assoc : (d,d',d'':natinf) (ni_min (ni_min d d'd'')=(ni_min d (ni_min d' d'')).

Lemma ni_min_O_l : (d:natinf) (ni_min (ni Od)=(ni O).

Lemma ni_min_O_r : (d:natinf) (ni_min d (ni O))=(ni O).

Lemma ni_min_inf_l : (d:natinf) (ni_min infty d)=d.

Lemma ni_min_inf_r : (d:natinf) (ni_min d infty)=d.

Definition ni_le := [d,d':natinf] (ni_min d d')=d.

Lemma ni_le_refl : (d:natinf) (ni_le d d).

Lemma ni_le_antisym : (d,d':natinf) (ni_le d d'® (ni_le d' d® d=d'.

Lemma ni_le_trans : (d,d',d'':natinf) (ni_le d d'® (ni_le d' d''® (ni_le d d'').

Lemma ni_le_min_1 : (d,d':natinf) (ni_le (ni_min d d'd).

Lemma ni_le_min_2 : (d,d':natinf) (ni_le (ni_min d d'd').

Lemma ni_min_case : (d,d':natinf) (ni_min d d')=d or (ni_min d d')=d'.

Lemma ni_le_total : (d,d':natinf) (ni_le d d'or (ni_le d' d).

Lemma ni_le_min_induc : (d,d',dm:natinf) (ni_le dm d® (ni_le dm d')
     ® ((d'':natinf) (ni_le d'' d® (ni_le d'' d'® (ni_le d'' dm))
       ® (ni_min d d')=dm.

Lemma le_ni_le : (m,n:nat) (le m n® (ni_le (ni m) (ni n)).

Lemma ni_le_le : (m,n:nat) (ni_le (ni m) (ni n)) ® (le m n).

Lemma ad_plength_lb : (a:ad) (n:nat) ((k:nat) (lt k n® (ad_bit a k)=false)
     ® (ni_le (ni n) (ad_plength a)).

Lemma ad_plength_ub : (a:ad) (n:nat) (ad_bit a n)=true
     ® (ni_le (ad_plength a) (ni n)).
We define an ultrametric distance between addresses: d(a,a')=1/2pd(a,a'), where pd(a,a') is the number of identical bits at the beginning of a and a' (infinity if a=a'). Instead of working with d, we work with pd, namely ad_pdist:
Definition ad_pdist := [a,a':ad] (ad_plength (ad_xor a a')).
d is a distance, so d(a,a')=0 iff a=a'; this means that pd(a,a')=infty iff a=a':
Lemma ad_pdist_eq_1 : (a:ad) (ad_pdist a a)=infty.

Lemma ad_pdist_eq_2 : (a,a':ad) (ad_pdist a a')=infty ® a=a'.
d is a distance, so d(a,a')=d(a',a):
Lemma ad_pdist_comm : (a,a':ad) (ad_pdist a a')=(ad_pdist a' a).
d is an ultrametric distance, that is, not only d(a,a')£ d(a,a'')+d(a'',a'), but in fact d(a,a')£ max(d(a,a''),d(a'',a')). This means that min(pd(a,a''),pd(a'',a'))<=pd(a,a') (lemma ad_pdist_ultra below). This follows from the fact that a Þ |a| = 1/2ad_plength(a)) is an ultrametric norm, i.e. that |a-a'| £ max (|a-a''|, |a''-a'|), or equivalently that |a+b|<=max(|a|,|b|), i.e. that min (ad_plength(a), ad_plength(b)) £ ad_plength (a xor  b) (lemma ad_plength_ultra).


Lemma ad_plength_ultra_1 : (a,a':ad)
     (ni_le (ad_plength a) (ad_plength a'))
       ® (ni_le (ad_plength a) (ad_plength (ad_xor a a'))).

Lemma ad_plength_ultra : (a,a':ad)
     (ni_le (ni_min (ad_plength a) (ad_plength a')) (ad_plength (ad_xor a a'))).

Lemma ad_pdist_ultra : (a,a',a'':ad)
     (ni_le (ni_min (ad_pdist a a'') (ad_pdist a'' a')) (ad_pdist a a')).

Module Addec

Equality on adresses
Require Bool.
Require Sumbool.
Require ZArith.
Require Addr.

Fixpoint ad_eq_1 [p1,p2:positive] : bool :=
   Cases p1 p2 of
       xH xH Þ true
     | (xO p'1) (xO p'2Þ (ad_eq_1 p'1 p'2)
     | (xI p'1) (xI p'2Þ (ad_eq_1 p'1 p'2)
     | _ _ Þ false
   end.

Definition ad_eq := [a,a':ad]
   Cases a a' of
       ad_z ad_z Þ true
     | (ad_x p) (ad_x p'Þ (ad_eq_1 p p')
     | _ _ Þ false
   end.

Lemma ad_eq_correct : (a:ad) (ad_eq a a)=true.

Lemma ad_eq_complete : (a,a':ad) (ad_eq a a')=true ® a=a'.

Lemma ad_eq_comm : (a,a':ad) (ad_eq a a')=(ad_eq a' a).

Lemma ad_xor_eq_true : (a,a':ad) (ad_xor a a')=ad_z ® (ad_eq a a')=true.

Lemma ad_xor_eq_false : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x p® (ad_eq a a')=false.

Lemma ad_bit_0_1_not_double : (a:ad) (ad_bit_0 a)=true ®
       (a0:ad) (ad_eq (ad_double a0a)=false.

Lemma ad_not_div_2_not_double : (a,a0:ad) (ad_eq (ad_div_2 aa0)=false ®
       (ad_eq a (ad_double a0))=false.

Lemma ad_bit_0_0_not_double_plus_un : (a:ad) (ad_bit_0 a)=false ®
       (a0:ad) (ad_eq (ad_double_plus_un a0a)=false.

Lemma ad_not_div_2_not_double_plus_un : (a,a0:ad) (ad_eq (ad_div_2 aa0)=false ®
       (ad_eq (ad_double_plus_un a0a)=false.

Lemma ad_bit_0_neq : (a,a':ad) (ad_bit_0 a)=false ® (ad_bit_0 a')=true ® (ad_eq a a')=false.

Lemma ad_div_eq : (a,a':ad) (ad_eq a a')=true ® (ad_eq (ad_div_2 a) (ad_div_2 a'))=true.

Lemma ad_div_neq : (a,a':ad) (ad_eq (ad_div_2 a) (ad_div_2 a'))=false ® (ad_eq a a')=false.

Lemma ad_div_bit_eq : (a,a':ad) (ad_bit_0 a)=(ad_bit_0 a'®
     (ad_div_2 a)=(ad_div_2 a'® a=a'.

Lemma ad_div_bit_neq : (a,a':ad) (ad_eq a a')=false ® (ad_bit_0 a)=(ad_bit_0 a'®
     (ad_eq (ad_div_2 a) (ad_div_2 a'))=false.

Lemma ad_neq : (a,a':ad) (ad_eq a a')=false ®
     (ad_bit_0 a)=(negb (ad_bit_0 a')) or (ad_eq (ad_div_2 a) (ad_div_2 a'))=false.

Lemma ad_double_or_double_plus_un : (a:ad)
     {a0:ad | a=(ad_double a0)}+{a1:ad | a=(ad_double_plus_un a1)}.

Module Map

Definition of finite sets as trees indexed by adresses
Require Bool.
Require Sumbool.
Require ZArith.
Require Addr.
Require Adist.
Require Addec.

Section MapDefs.
We define maps from ad to A.
Variable A : Set.

Inductive Map : Set :=
       M0 : Map
     | M1 : ad ® A ® Map
     | M2 : Map ® Map ® Map.

Inductive option : Set :=
       NONE : option
     | SOME : A ® option.

Lemma option_sum : (o:option) {y:A | o=(SOME y)}+{o=NONE}.

The semantics of maps is given by the function MapGet. The semantics of a map m is a partial, finite function from ad to A:
Fixpoint MapGet [m:Map] : ad ® option :=
     Cases m of
         M0 Þ [a:adNONE
       | (M1 x yÞ [a:ad]
           if (ad_eq x a)
               then (SOME y)
           else NONE
       | (M2 m1 m2Þ [a:ad]
           Cases a of
               ad_z Þ (MapGet m1 ad_z)
             | (ad_x xHÞ (MapGet m2 ad_z)
             | (ad_x (xO p)) Þ (MapGet m1 (ad_x p))
             | (ad_x (xI p)) Þ (MapGet m2 (ad_x p))
           end
     end.

Definition newMap := M0.
   Definition MapSingleton := M1.

Definition eqm := [g,g':ad®option] (a:ad) (g a)=(g' a).

Lemma newMap_semantics : (eqm (MapGet newMap) [a:adNONE).

Lemma MapSingleton_semantics : (a:ad) (y:A)
       (eqm (MapGet (MapSingleton a y)) [a':adif (ad_eq a a'then (SOME yelse NONE).

Lemma M1_semantics_1 : (a:ad) (y:A) (MapGet (M1 a ya)=(SOME y).

Lemma M1_semantics_2 : (a,a':ad) (y:A) (ad_eq a a')=false ® (MapGet (M1 a ya')=NONE.

Lemma Map2_semantics_1 : (m,m':Map) (eqm (MapGet m) [a:ad] (MapGet (M2 m m') (ad_double a))).

Lemma Map2_semantics_1_eq : (m,m':Map) (f:ad®option) (eqm (MapGet (M2 m m')) f)
       ® (eqm (MapGet m) [a:ad] (f (ad_double a))).

Lemma Map2_semantics_2 : (m,m':Map) (eqm (MapGet m') [a:ad] (MapGet (M2 m m') (ad_double_plus_un a))).

Lemma Map2_semantics_2_eq : (m,m':Map) (f:ad®option) (eqm (MapGet (M2 m m')) f)
       ® (eqm (MapGet m') [a:ad] (f (ad_double_plus_un a))).

Lemma MapGet_M2_bit_0_0 : (a:ad) (ad_bit_0 a)=false
       ® (m,m':Map) (MapGet (M2 m m'a)=(MapGet m (ad_div_2 a)).

Lemma MapGet_M2_bit_0_1 : (a:ad) (ad_bit_0 a)=true
       ® (m,m':Map) (MapGet (M2 m m'a)=(MapGet m' (ad_div_2 a)).

Lemma MapGet_M2_bit_0_if : (m,m':Map) (a:ad) (MapGet (M2 m m'a)=
       (if (ad_bit_0 athen (MapGet m' (ad_div_2 a)) else (MapGet m (ad_div_2 a))).

Lemma MapGet_M2_bit_0 : (m,m',m'':Map)
       (a:ad) (if (ad_bit_0 athen (MapGet (M2 m' maelse (MapGet (M2 m m''a))=
               (MapGet m (ad_div_2 a)).

Lemma Map2_semantics_3 : (m,m':Map) (eqm (MapGet (M2 m m'))
       [a:adCases (ad_bit_0 aof
                   false Þ (MapGet m (ad_div_2 a))
                 | true Þ (MapGet m' (ad_div_2 a))
               end).

Lemma Map2_semantics_3_eq : (m,m':Map) (f,f':ad®option)
       (eqm (MapGet mf® (eqm (MapGet m'f'® (eqm (MapGet (M2 m m'))
       [a:adCases (ad_bit_0 aof
                   false Þ (f (ad_div_2 a))
                 | true Þ (f' (ad_div_2 a))
               end).

Fixpoint MapPut1 [a:ady:Aa':ady':Ap:positive] : Map :=
     Cases p of
         (xO p'Þ let m = (MapPut1 (ad_div_2 ay (ad_div_2 a'y' p'in
                     Cases (ad_bit_0 aof
                         false Þ (M2 m M0)
                       | true Þ (M2 M0 m)
                     end
       | _ Þ Cases (ad_bit_0 aof
                   false Þ (M2 (M1 (ad_div_2 ay) (M1 (ad_div_2 a'y'))
                 | true Þ (M2 (M1 (ad_div_2 a'y') (M1 (ad_div_2 ay))
               end
     end.

Lemma MapGet_if_commute : (b:bool) (m,m':Map) (a:ad)
       (MapGet (if b then m else m'a)=(if b then (MapGet m aelse (MapGet m' a)).

Lemma MapGet_if_same : (m:Map) (b:bool) (a:ad) (MapGet (if b then m else ma)=(MapGet m a).

Lemma MapGet_M2_bit_0_2 : (m,m',m'':Map)
       (a:ad) (MapGet (if (ad_bit_0 athen (M2 m m'else (M2 m' m'')) a)=
               (MapGet m' (ad_div_2 a)).

Lemma MapPut1_semantics_1 : (p:positive) (a,a':ad) (y,y':A)
       (ad_xor a a')=(ad_x p)
         ® (MapGet (MapPut1 a y a' y' pa)=(SOME y).

Lemma MapPut1_semantics_2 : (p:positive) (a,a':ad) (y,y':A)
       (ad_xor a a')=(ad_x p)
         ® (MapGet (MapPut1 a y a' y' pa')=(SOME y').

Lemma MapGet_M2_both_NONE : (m,m':Map) (a:ad)
       (MapGet m (ad_div_2 a))=NONE ® (MapGet m' (ad_div_2 a))=NONE ® (MapGet (M2 m m'a)=NONE.

Lemma MapPut1_semantics_3 : (p:positive) (a,a',a0:ad) (y,y':A)
         (ad_xor a a')=(ad_x p® (ad_eq a a0)=false ® (ad_eq a' a0)=false ®
           (MapGet (MapPut1 a y a' y' pa0)=NONE.

Lemma MapPut1_semantics : (p:positive) (a,a':ad) (y,y':A)
       (ad_xor a a')=(ad_x p)
         ® (eqm (MapGet (MapPut1 a y a' y' p))
                 [a0:adif (ad_eq a a0then (SOME y)
                         else if (ad_eq a' a0then (SOME y'else NONE).

Lemma MapPut1_semantics' : (p:positive) (a,a':ad) (y,y':A)
       (ad_xor a a')=(ad_x p)
         ® (eqm (MapGet (MapPut1 a y a' y' p))
                 [a0:adif (ad_eq a' a0then (SOME y')
                         else if (ad_eq a a0then (SOME yelse NONE).

Fixpoint MapPut [m:Map] : ad ® A ® Map :=
     Cases m of
         M0 Þ M1
       | (M1 a yÞ [a':ady':A]
           Cases (ad_xor a a'of
               ad_z Þ (M1 a' y')
             | (ad_x pÞ (MapPut1 a y a' y' p)
           end
       | (M2 m1 m2Þ [a:ady:A]
           Cases a of
               ad_z Þ (M2 (MapPut m1 ad_z ym2)
             | (ad_x xHÞ (M2 m1 (MapPut m2 ad_z y))
             | (ad_x (xO p)) Þ (M2 (MapPut m1 (ad_x pym2)
             | (ad_x (xI p)) Þ (M2 m1 (MapPut m2 (ad_x py))
           end
     end.

Lemma MapPut_semantics_1 : (a:ad) (y:A) (a0:ad)
       (MapGet (MapPut M0 a ya0)=(MapGet (M1 a ya0).

Lemma MapPut_semantics_2_1 : (a:ad) (y,y':A) (a0:ad)
       (MapGet (MapPut (M1 a ya y'a0)=(if (ad_eq a a0then (SOME y'else NONE).

Lemma MapPut_semantics_2_2 : (a,a':ad) (y,y':A) (a0:ad) (a'':ad) (ad_xor a a')=a'' ®
       (MapGet (MapPut (M1 a ya' y'a0)=
       (if (ad_eq a' a0then (SOME y'else
         if (ad_eq a a0then (SOME yelse NONE).

Lemma MapPut_semantics_2 : (a,a':ad) (y,y':A) (a0:ad)
       (MapGet (MapPut (M1 a ya' y'a0)=
       (if (ad_eq a' a0then (SOME y'else
         if (ad_eq a a0then (SOME yelse NONE).

Lemma MapPut_semantics_3_1 : (m,m':Map) (a:ad) (y:A)
       (MapPut (M2 m m'a y)=(if (ad_bit_0 athen (M2 m (MapPut m' (ad_div_2 ay))
                                               else (M2 (MapPut m (ad_div_2 aym')).

Lemma MapPut_semantics : (m:Map) (a:ad) (y:A)
       (eqm (MapGet (MapPut m a y)) [a':adif (ad_eq a a'then (SOME yelse (MapGet m a')).

Fixpoint MapPut_behind [m:Map] : ad ® A ® Map :=
     Cases m of
         M0 Þ M1
       | (M1 a yÞ [a':ady':A]
           Cases (ad_xor a a'of
               ad_z Þ m
             | (ad_x pÞ (MapPut1 a y a' y' p)
           end
       | (M2 m1 m2Þ [a:ady:A]
           Cases a of
               ad_z Þ (M2 (MapPut_behind m1 ad_z ym2)
             | (ad_x xHÞ (M2 m1 (MapPut_behind m2 ad_z y))
             | (ad_x (xO p)) Þ (M2 (MapPut_behind m1 (ad_x pym2)
             | (ad_x (xI p)) Þ (M2 m1 (MapPut_behind m2 (ad_x py))
           end
     end.

Lemma MapPut_behind_semantics_3_1 : (m,m':Map) (a:ad) (y:A)
       (MapPut_behind (M2 m m'a y)=
       (if (ad_bit_0 athen (M2 m (MapPut_behind m' (ad_div_2 ay))
                         else (M2 (MapPut_behind m (ad_div_2 aym')).

Lemma MapPut_behind_as_before_1 : (a,a',a0:ad) (ad_eq a' a0)=false ®
       (y,y':A) (MapGet (MapPut (M1 a ya' y'a0)
                 =(MapGet (MapPut_behind (M1 a ya' y'a0).

Lemma MapPut_behind_as_before : (m:Map) (a:ad) (y:A)
       (a0:ad) (ad_eq a a0)=false ®
           (MapGet (MapPut m a ya0)=(MapGet (MapPut_behind m a ya0).

Lemma MapPut_behind_new : (m:Map) (a:ad) (y:A)
       (MapGet (MapPut_behind m a ya)=(Cases (MapGet m aof
                                             (SOME y'Þ (SOME y')
                                           | _ Þ (SOME y)
                                         end).

Lemma MapPut_behind_semantics : (m:Map) (a:ad) (y:A)
       (eqm (MapGet (MapPut_behind m a y))
             [a':adCases (MapGet m a'of
                         (SOME y'Þ (SOME y')
                       | _ Þ if (ad_eq a a'then (SOME yelse NONE
                     end).

Definition makeM2 := [m,m':MapCases m m' of
                                       M0 M0 Þ M0
                                     | M0 (M1 a yÞ (M1 (ad_double_plus_un ay)
                                     | (M1 a yM0 Þ (M1 (ad_double ay)
                                     | _ _ Þ (M2 m m')
                                   end.

Lemma makeM2_M2 : (m,m':Map) (eqm (MapGet (makeM2 m m')) (MapGet (M2 m m'))).

Fixpoint MapRemove [m:Map] : ad ® Map :=
     Cases m of
         M0 Þ [_:adM0
       | (M1 a yÞ [a':ad]
           Cases (ad_eq a a'of
               true Þ M0
             | false Þ m
           end
       | (M2 m1 m2Þ [a:ad]
           if (ad_bit_0 a)
           then (makeM2 m1 (MapRemove m2 (ad_div_2 a)))
           else (makeM2 (MapRemove m1 (ad_div_2 a)) m2)
     end.

Lemma MapRemove_semantics : (m:Map) (a:ad)
       (eqm (MapGet (MapRemove m a)) [a':adif (ad_eq a a'then NONE else (MapGet m a')).

Fixpoint MapCard [m:Map] : nat :=
     Cases m of
         M0 Þ O
       | (M1 _ _) Þ (S O)
       | (M2 m m'Þ (plus (MapCard m) (MapCard m'))
     end.

Fixpoint MapMerge [m:Map] : Map ® Map :=
     Cases m of
         M0 Þ [m':Mapm'
       | (M1 a yÞ [m':Map] (MapPut_behind m' a y)
       | (M2 m1 m2Þ [m':MapCases m' of
                                     M0 Þ m
                                   | (M1 a' y'Þ (MapPut m a' y')
                                   | (M2 m'1 m'2Þ (M2 (MapMerge m1 m'1) (MapMerge m2 m'2))
                                 end
     end.

Lemma MapMerge_semantics : (m,m':Map)
       (eqm (MapGet (MapMerge m m'))
             [a0:adCases (MapGet m' a0of
                         (SOME y'Þ (SOME y')
                       | NONE Þ (MapGet m a0)
                     end).

MapInter, MapRngRestrTo, MapRngRestrBy, MapInverse not implemented: need a decidable equality on A.
Fixpoint MapDelta [m:Map] : Map ® Map :=
     Cases m of
         M0 Þ [m':Mapm'
       | (M1 a yÞ [m':MapCases (MapGet m' aof
                                   NONE Þ (MapPut m' a y)
                                 | _ Þ (MapRemove m' a)
                               end
       | (M2 m1 m2Þ [m':MapCases m' of
                                     M0 Þ m
                                   | (M1 a' y'Þ Cases (MapGet m a'of
                                                       NONE Þ (MapPut m a' y')
                                                     | _ Þ (MapRemove m a')
                                                   end
                                   | (M2 m'1 m'2Þ (makeM2 (MapDelta m1 m'1)
                                                             (MapDelta m2 m'2))
                                 end
     end.

Lemma MapDelta_semantics_comm : (m,m':Map)
       (eqm (MapGet (MapDelta m m')) (MapGet (MapDelta m' m))).

Lemma MapDelta_semantics_1_1 : (a:ad) (y:A) (m':Map) (a0:ad)
     (MapGet (M1 a ya0)=NONE ® (MapGet m' a0)=NONE ® (MapGet (MapDelta (M1 a ym'a0)=NONE.

Lemma MapDelta_semantics_1 : (m,m':Map) (a:ad)
     (MapGet m a)=NONE ® (MapGet m' a)=NONE ® (MapGet (MapDelta m m'a)=NONE.

Lemma MapDelta_semantics_2_1 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A)
     (MapGet (M1 a ya0)=NONE ® (MapGet m' a0)=(SOME y0®
       (MapGet (MapDelta (M1 a ym'a0)=(SOME y0).

Lemma MapDelta_semantics_2_2 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A)
     (MapGet (M1 a ya0)=(SOME y0® (MapGet m' a0)=NONE ®
       (MapGet (MapDelta (M1 a ym'a0)=(SOME y0).

Lemma MapDelta_semantics_2 : (m,m':Map) (a:ad) (y:A)
     (MapGet m a)=NONE ® (MapGet m' a)=(SOME y® (MapGet (MapDelta m m'a)=(SOME y).

Lemma MapDelta_semantics_3_1 : (a0:ad) (y0:A) (m':Map) (a:ad) (y,y':A)
     (MapGet (M1 a0 y0a)=(SOME y® (MapGet m' a)=(SOME y'®
       (MapGet (MapDelta (M1 a0 y0m'a)=NONE.

Lemma MapDelta_semantics_3 : (m,m':Map) (a:ad) (y,y':A)
     (MapGet m a)=(SOME y® (MapGet m' a)=(SOME y'® (MapGet (MapDelta m m'a)=NONE.

Lemma MapDelta_semantics : (m,m':Map)
       (eqm (MapGet (MapDelta m m'))
             [a0:adCases (MapGet m a0) (MapGet m' a0of
                         NONE (SOME y'Þ (SOME y')
                       | (SOME yNONE Þ (SOME y)
                       | _ _ Þ NONE
                     end).

Definition MapEmptyp := [m:Map]
     Cases m of
         M0 Þ true
       | _ Þ false
     end.

Lemma MapEmptyp_correct : (MapEmptyp M0)=true.

Lemma MapEmptyp_complete : (m:Map) (MapEmptyp m)=true ® m=M0.

MapSplit not implemented: not the preferred way of recursing over Maps (use MapSweep, MapCollect, or MapFold in Mapiter.v.
End MapDefs.

Module Fset

Sets operations on maps
Require Bool.
Require Sumbool.
Require ZArith.
Require Addr.
Require Adist.
Require Addec.
Require Map.

Section Dom.

Variable AB : Set.

Fixpoint MapDomRestrTo [m:(Map A)] : (Map B® (Map A) :=
     Cases m of
         M0 Þ [_:(Map B)] (M0 A)
       | (M1 a yÞ [m':(Map B)] Cases (MapGet B m' aof
                                   NONE Þ (M0 A)
                                 | _ Þ m
                               end
       | (M2 m1 m2Þ [m':(Map B)] Cases m' of
                                     M0 Þ (M0 A)
                                   | (M1 a' y'Þ Cases (MapGet A m a'of
                                                       NONE Þ (M0 A)
                                                     | (SOME yÞ (M1 A a' y)
                                                   end
                                   | (M2 m'1 m'2Þ (makeM2 A (MapDomRestrTo m1 m'1)
                                                               (MapDomRestrTo m2 m'2))
                                 end
     end.

Lemma MapDomRestrTo_semantics : (m:(Map A)) (m':(Map B))
       (eqm A (MapGet A (MapDomRestrTo m m'))
               [a0:adCases (MapGet B m' a0of
                         NONE Þ (NONE A)
                       | _ Þ (MapGet A m a0)
                     end).

Fixpoint MapDomRestrBy [m:(Map A)] : (Map B® (Map A) :=
     Cases m of
         M0 Þ [_:(Map B)] (M0 A)
       | (M1 a yÞ [m':(Map B)] Cases (MapGet B m' aof
                                   NONE Þ m
                                 | _ Þ (M0 A)
                               end
       | (M2 m1 m2Þ [m':(Map B)] Cases m' of
                                     M0 Þ m
                                   | (M1 a' y'Þ (MapRemove A m a')
                                   | (M2 m'1 m'2Þ (makeM2 A (MapDomRestrBy m1 m'1)
                                                               (MapDomRestrBy m2 m'2))
                                 end
     end.

Lemma MapDomRestrBy_semantics : (m:(Map A)) (m':(Map B))
       (eqm A (MapGet A (MapDomRestrBy m m'))
               [a0:adCases (MapGet B m' a0of
                         NONE Þ (MapGet A m a0)
                       | _ Þ (NONE A)
                     end).

Definition in_dom := [a:adm:(Map A)]
     Cases (MapGet A m aof
         NONE Þ false
       | _ Þ true
     end.

Lemma in_dom_M0 : (a:ad) (in_dom a (M0 A))=false.

Lemma in_dom_M1 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=(ad_eq a a0).

Lemma in_dom_M1_1 : (a:ad) (y:A) (in_dom a (M1 A a y))=true.

Lemma in_dom_M1_2 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=true ® a=a0.

Lemma in_dom_some : (m:(Map A)) (a:ad) (in_dom a m)=true ®
       {y:A | (MapGet A m a)=(SOME A y)}.

Lemma in_dom_none : (m:(Map A)) (a:ad) (in_dom a m)=false ®
       (MapGet A m a)=(NONE A).

Lemma in_dom_put : (m:(Map A)) (a0:ad) (y0:A) (a:ad)
       (in_dom a (MapPut A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)).

Lemma in_dom_put_behind : (m:(Map A)) (a0:ad) (y0:A) (a:ad)
       (in_dom a (MapPut_behind A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)).

Lemma in_dom_remove : (m:(Map A)) (a0:ad) (a:ad)
       (in_dom a (MapRemove A m a0))=(andb (negb (ad_eq a a0)) (in_dom a m)).

Lemma in_dom_merge : (m,m':(Map A)) (a:ad)
       (in_dom a (MapMerge A m m'))=(orb (in_dom a m) (in_dom a m')).

Lemma in_dom_delta : (m,m':(Map A)) (a:ad)
     (in_dom a (MapDelta A m m'))=(xorb (in_dom a m) (in_dom a m')).

End Dom.

Section InDom.

Variable AB : Set.

Lemma in_dom_restrto : (m:(Map A)) (m':(Map B)) (a:ad)
     (in_dom A a (MapDomRestrTo A B m m'))=(andb (in_dom A a m) (in_dom B a m')).

Lemma in_dom_restrby : (m:(Map A)) (m':(Map B)) (a:ad)
     (in_dom A a (MapDomRestrBy A B m m'))=(andb (in_dom A a m) (negb (in_dom B a m'))).

End InDom.

Definition FSet := (Map unit).

Section FSetDefs.

Variable A : Set.

Definition in_FSet : ad ® FSet ® bool := (in_dom unit).

Fixpoint MapDom [m:(Map A)] : FSet :=
     Cases m of
         M0 Þ (M0 unit)
       | (M1 a _) Þ (M1 unit a tt)
       | (M2 m m'Þ (M2 unit (MapDom m) (MapDom m'))
     end.

Lemma MapDom_semantics_1 : (m:(Map A)) (a:ad) (y:A) (MapGet A m a)=(SOME A y®
       (in_FSet a (MapDom m))=true.

Lemma MapDom_semantics_2 : (m:(Map A)) (a:ad) (in_FSet a (MapDom m))=true ®
       {y:A | (MapGet A m a)=(SOME A y)}.

Lemma MapDom_semantics_3 : (m:(Map A)) (a:ad) (MapGet A m a)=(NONE A®
       (in_FSet a (MapDom m))=false.

Lemma MapDom_semantics_4 : (m:(Map A)) (a:ad) (in_FSet a (MapDom m))=false ®
       (MapGet A m a)=(NONE A).

Lemma MapDom_Dom : (m:(Map A)) (a:ad) (in_dom A a m)=(in_FSet a (MapDom m)).

Definition FSetUnion : FSet ® FSet ® FSet := [s,s':FSet] (MapMerge unit s s').

Lemma in_FSet_union : (s,s':FSet) (a:ad)
       (in_FSet a (FSetUnion s s'))=(orb (in_FSet a s) (in_FSet a s')).

Definition FSetInter : FSet ® FSet ® FSet := [s,s':FSet] (MapDomRestrTo unit unit s s').

Lemma in_FSet_inter : (s,s':FSet) (a:ad)
       (in_FSet a (FSetInter s s'))=(andb (in_FSet a s) (in_FSet a s')).

Definition FSetDiff : FSet ® FSet ® FSet := [s,s':FSet] (MapDomRestrBy unit unit s s').

Lemma in_FSet_diff : (s,s':FSet) (a:ad)
       (in_FSet a (FSetDiff s s'))=(andb (in_FSet a s) (negb (in_FSet a s'))).

Definition FSetDelta : FSet ® FSet ® FSet := [s,s':FSet] (MapDelta unit s s').

Lemma in_FSet_delta : (s,s':FSet) (a:ad)
       (in_FSet a (FSetDelta s s'))=(xorb (in_FSet a s) (in_FSet a s')).

End FSetDefs.

Lemma FSet_Dom : (s:FSet) (MapDom unit s)=s.

Module Adalloc

Require Bool.
Require Sumbool.
Require ZArith.
Require Arith.
Require Addr.
Require Adist.
Require Addec.
Require Map.
Require Fset.

Section AdAlloc.

Variable A : Set.

Definition nat_of_ad := [a:adCases a of
                                       ad_z Þ O
                                     | (ad_x pÞ (convert p)
                                   end.

Fixpoint nat_le [m:nat] : nat ® bool :=
     Cases m of
         O Þ [_:nattrue
       | (S m'Þ [n:natCases n of
                               O Þ false
                             | (S n'Þ (nat_le m' n')
                           end
     end.

Lemma nat_le_correct : (m,n:nat) (le m n® (nat_le m n)=true.

Lemma nat_le_complete : (m,n:nat) (nat_le m n)=true ® (le m n).

Lemma nat_le_correct_conv : (m,n:nat) (lt m n® (nat_le n m)=false.

Lemma nat_le_complete_conv : (m,n:nat) (nat_le n m)=false ® (lt m n).

Definition ad_of_nat := [n:natCases n of
                                       O Þ ad_z
                                     | (S n'Þ (ad_x (anti_convert n'))
                                   end.

Lemma ad_of_nat_of_ad : (a:ad) (ad_of_nat (nat_of_ad a))=a.

Lemma nat_of_ad_of_nat : (n:nat) (nat_of_ad (ad_of_nat n))=n.

Definition ad_le := [a,b:ad] (nat_le (nat_of_ad a) (nat_of_ad b)).

Lemma ad_le_refl : (a:ad) (ad_le a a)=true.

Lemma ad_le_antisym : (a,b:ad) (ad_le a b)=true ® (ad_le b a)=true ® a=b.

Lemma ad_le_trans : (a,b,c:ad) (ad_le a b)=true ® (ad_le b c)=true ® (ad_le a c)=true.

Lemma ad_le_lt_trans : (a,b,c:ad) (ad_le a b)=true ® (ad_le c b)=false ® (ad_le c a)=false.

Lemma ad_lt_le_trans : (a,b,c:ad) (ad_le b a)=false ® (ad_le b c)=true ® (ad_le c a)=false.

Lemma ad_lt_trans : (a,b,c:ad) (ad_le b a)=false ® (ad_le c b)=false ® (ad_le c a)=false.

Lemma ad_lt_le_weak : (a,b:ad) (ad_le b a)=false ® (ad_le a b)=true.

Definition ad_min := [a,b:adif (ad_le a bthen a else b.

Lemma ad_min_choice : (a,b:ad) {(ad_min a b)=a}+{(ad_min a b)=b}.

Lemma ad_min_le_1 : (a,b:ad) (ad_le (ad_min a ba)=true.

Lemma ad_min_le_2 : (a,b:ad) (ad_le (ad_min a bb)=true.

Lemma ad_min_le_3 : (a,b,c:ad) (ad_le a (ad_min b c))=true ® (ad_le a b)=true.

Lemma ad_min_le_4 : (a,b,c:ad) (ad_le a (ad_min b c))=true ® (ad_le a c)=true.

Lemma ad_min_le_5 : (a,b,c:ad) (ad_le a b)=true ® (ad_le a c)=true ®
       (ad_le a (ad_min b c))=true.

Lemma ad_min_lt_3 : (a,b,c:ad) (ad_le (ad_min b ca)=false ® (ad_le b a)=false.

Lemma ad_min_lt_4 : (a,b,c:ad) (ad_le (ad_min b ca)=false ® (ad_le c a)=false.

Allocator: returns an address not in the domain of m. This allocator is optimal in that it returns the lowest possible address, in the usual ordering on integers. It is not the most efficient, however.
Fixpoint ad_alloc_opt [m:(Map A)] : ad :=
     Cases m of
         M0 Þ ad_z
       | (M1 a _) Þ if (ad_eq a ad_z)
                     then (ad_x xH)
                     else ad_z
       | (M2 m1 m2Þ (ad_min (ad_double (ad_alloc_opt m1))
                               (ad_double_plus_un (ad_alloc_opt m2)))
     end.

Lemma ad_alloc_opt_allocates_1 : (m:(Map A)) (MapGet A m (ad_alloc_opt m))=(NONE A).

Lemma ad_alloc_opt_allocates : (m:(Map A)) (in_dom A (ad_alloc_opt mm)=false.

Moreover, this is optimal: all addresses below (ad_alloc_opt m) are in dom m:
Lemma convert_xH : (convert xH)=(1).

Lemma positive_to_nat_mult : (p:positive) (n,m:nat)
       (positive_to_nat p (mult m n))=(mult m (positive_to_nat p n)).

Lemma positive_to_nat_2 : (p:positive)
       (positive_to_nat p (2))=(mult (2) (positive_to_nat p (1))).

Lemma positive_to_nat_4 : (p:positive)
       (positive_to_nat p (4))=(mult (2) (positive_to_nat p (2))).

Lemma convert_xO : (p:positive) (convert (xO p))=(mult (2) (convert p)).

Lemma convert_xI : (p:positive) (convert (xI p))=(S (mult (2) (convert p))).

Lemma nat_of_ad_double : (a:ad) (nat_of_ad (ad_double a))=(mult (2) (nat_of_ad a)).

Lemma nat_of_ad_double_plus_un : (a:ad)
       (nat_of_ad (ad_double_plus_un a))=(S (mult (2) (nat_of_ad a))).

Lemma ad_le_double_mono : (a,b:ad) (ad_le a b)=true ® (ad_le (ad_double a) (ad_double b))=true.

Lemma ad_le_double_plus_un_mono : (a,b:ad) (ad_le a b)=true ®
       (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true.

Lemma ad_le_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=true ®
       (ad_le a b)=true.

Lemma ad_le_double_plus_un_mono_conv : (a,b:ad)
       (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true ® (ad_le a b)=true.

Lemma ad_lt_double_mono : (a,b:ad) (ad_le a b)=false ®
       (ad_le (ad_double a) (ad_double b))=false.

Lemma ad_lt_double_plus_un_mono : (a,b:ad) (ad_le a b)=false ®
       (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false.

Lemma ad_lt_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=false ®
       (ad_le a b)=false.

Lemma ad_lt_double_plus_un_mono_conv : (a,b:ad)
       (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false ® (ad_le a b)=false.

Lemma ad_alloc_opt_optimal_1 : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt ma)=false ®
       {y:A | (MapGet A m a)=(SOME A y)}.

Lemma ad_alloc_opt_optimal : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt ma)=false ®
       (in_dom A a m)=true.

End AdAlloc.

Module Mapaxioms

Require Bool.
Require Sumbool.
Require ZArith.
Require Addr.
Require Adist.
Require Addec.
Require Map.
Require Fset.

Section MapAxioms.

Variable ABC : Set.

Lemma eqm_sym : (f,f':ad®(option A)) (eqm A f f'® (eqm A f' f).

Lemma eqm_refl : (f:ad®(option A)) (eqm A f f).

Lemma eqm_trans : (f,f',f'':ad®(option A)) (eqm A f f'® (eqm A f' f''® (eqm A f f'').

Definition eqmap := [m,m':(Map A)] (eqm A (MapGet A m) (MapGet A m')).

Lemma eqmap_sym : (m,m':(Map A)) (eqmap m m'® (eqmap m' m).

Lemma eqmap_refl : (m:(Map A)) (eqmap m m).

Lemma eqmap_trans : (m,m',m'':(Map A)) (eqmap m m'® (eqmap m' m''® (eqmap m m'').

Lemma MapPut_as_Merge : (m:(Map A)) (a:ad) (y:A)
       (eqmap (MapPut A m a y) (MapMerge A m (M1 A a y))).

Lemma MapPut_ext : (m,m':(Map A)) (eqmap m m'®
       (a:ad) (y:A) (eqmap (MapPut A m a y) (MapPut A m' a y)).

Lemma MapPut_behind_as_Merge : (m:(Map A)) (a:ad) (y:A)
       (eqmap (MapPut_behind A m a y) (MapMerge A (M1 A a ym)).

Lemma MapPut_behind_ext : (m,m':(Map A)) (eqmap m m'®
       (a:ad) (y:A) (eqmap (MapPut_behind A m a y) (MapPut_behind A m' a y)).

Lemma MapMerge_empty_m_1 : (m:(Map A)) (MapMerge A (M0 Am)=m.

Lemma MapMerge_empty_m : (m:(Map A)) (eqmap (MapMerge A (M0 Amm).

Lemma MapMerge_m_empty_1 : (m:(Map A)) (MapMerge A m (M0 A))=m.

Lemma MapMerge_m_empty : (m:(Map A)) (eqmap (MapMerge A m (M0 A)) m).

Lemma MapMerge_empty_l : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) ®
       (eqmap m (M0 A)).

Lemma MapMerge_empty_r : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) ®
       (eqmap m' (M0 A)).

Lemma MapMerge_assoc : (m,m',m'':(Map A)) (eqmap
       (MapMerge A (MapMerge A m m'm'')
       (MapMerge A m (MapMerge A m' m''))).

Lemma MapMerge_idempotent : (m:(Map A)) (eqmap (MapMerge A m mm).

Lemma MapMerge_ext : (m1,m2,m'1,m'2:(Map A))
       (eqmap m1 m'1® (eqmap m2 m'2® (eqmap (MapMerge A m1 m2) (MapMerge A m'1 m'2)).

Lemma MapMerge_ext_l : (m1,m'1,m2:(Map A))
       (eqmap m1 m'1® (eqmap (MapMerge A m1 m2) (MapMerge A m'1 m2)).

Lemma MapMerge_ext_r : (m1,m2,m'2:(Map A))
       (eqmap m2 m'2® (eqmap (MapMerge A m1 m2) (MapMerge A m1 m'2)).

Lemma MapMerge_RestrTo_l : (m,m',m'':(Map A))
       (eqmap (MapMerge A (MapDomRestrTo A A m m'm'')
               (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m''))).

Lemma MapRemove_as_RestrBy : (m:(Map A)) (a:ad) (y:B)
       (eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y))).

Lemma MapRemove_ext : (m,m':(Map A)) (eqmap m m'®
       (a:ad) (eqmap (MapRemove A m a) (MapRemove A m' a)).

Lemma MapDomRestrTo_empty_m_1 : (m:(Map B)) (MapDomRestrTo A B (M0 Am)=(M0 A).

Lemma MapDomRestrTo_empty_m : (m:(Map B)) (eqmap (MapDomRestrTo A B (M0 Am) (M0 A)).

Lemma MapDomRestrTo_m_empty_1 : (m:(Map A)) (MapDomRestrTo A B m (M0 B))=(M0 A).

Lemma MapDomRestrTo_m_empty : (m:(Map A)) (eqmap (MapDomRestrTo A B m (M0 B)) (M0 A)).

Lemma MapDomRestrTo_assoc : (m:(Map A)) (m':(Map B)) (m'':(Map C))
       (eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m'm'')
               (MapDomRestrTo A B m (MapDomRestrTo B C m' m''))).

Lemma MapDomRestrTo_idempotent : (m:(Map A)) (eqmap (MapDomRestrTo A A m mm).

Lemma MapDomRestrTo_Dom : (m:(Map A)) (m':(Map B))
       (eqmap (MapDomRestrTo A B m m') (MapDomRestrTo A unit m (MapDom B m'))).

Lemma MapDomRestrBy_empty_m_1 : (m:(Map B)) (MapDomRestrBy A B (M0 Am)=(M0 A).

Lemma MapDomRestrBy_empty_m : (m:(Map B)) (eqmap (MapDomRestrBy A B (M0 Am) (M0 A)).

Lemma MapDomRestrBy_m_empty_1 : (m:(Map A)) (MapDomRestrBy A B m (M0 B))=m.

Lemma MapDomRestrBy_m_empty : (m:(Map A)) (eqmap (MapDomRestrBy A B m (M0 B)) m).

Lemma MapDomRestrBy_Dom : (m:(Map A)) (m':(Map B))
       (eqmap (MapDomRestrBy A B m m') (MapDomRestrBy A unit m (MapDom B m'))).

Lemma MapDomRestrBy_m_m_1 : (m:(Map A)) (eqmap (MapDomRestrBy A A m m) (M0 A)).

Lemma MapDomRestrBy_By : (m:(Map A)) (m':(Map B)) (m'':(Map B))
       (eqmap (MapDomRestrBy A B (MapDomRestrBy A B m m'm'')
               (MapDomRestrBy A B m (MapMerge B m' m''))).

Lemma MapDomRestrBy_By_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
       (eqmap (MapDomRestrBy A C (MapDomRestrBy A B m m'm'')
               (MapDomRestrBy A B (MapDomRestrBy A C m m''m')).

Lemma MapDomRestrBy_To : (m:(Map A)) (m':(Map B)) (m'':(Map C))
       (eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m'm'')
               (MapDomRestrTo A B m (MapDomRestrBy B C m' m''))).

Lemma MapDomRestrBy_To_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
       (eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m'm'')
               (MapDomRestrTo A B (MapDomRestrBy A C m m''m')).

Lemma MapDomRestrTo_By : (m:(Map A)) (m':(Map B)) (m'':(Map C))
       (eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m'm'')
               (MapDomRestrTo A C m (MapDomRestrBy C B m'' m'))).

Lemma MapDomRestrTo_By_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
       (eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m'm'')
               (MapDomRestrBy A B (MapDomRestrTo A C m m''m')).

Lemma MapDomRestrTo_To_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
       (eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m'm'')
               (MapDomRestrTo A B (MapDomRestrTo A C m m''m')).

Lemma MapMerge_DomRestrTo : (m,m':(Map A)) (m'':(Map B))
       (eqmap (MapDomRestrTo A B (MapMerge A m m'm'')
               (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m''))).

Lemma MapMerge_DomRestrBy : (m,m':(Map A)) (m'':(Map B))
       (eqmap (MapDomRestrBy A B (MapMerge A m m'm'')
               (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m''))).

Lemma MapDelta_empty_m_1 : (m:(Map A)) (MapDelta A (M0 Am)=m.

Lemma MapDelta_empty_m : (m:(Map A)) (eqmap (MapDelta A (M0 Amm).

Lemma MapDelta_m_empty_1 : (m:(Map A)) (MapDelta A m (M0 A))=m.

Lemma MapDelta_m_empty : (m:(Map A)) (eqmap (MapDelta A m (M0 A)) m).

Lemma MapDelta_nilpotent : (m:(Map A)) (eqmap (MapDelta A m m) (M0 A)).

Lemma MapDelta_as_Merge : (m,m':(Map A)) (eqmap (MapDelta A m m')
         (MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m))).

Lemma MapDelta_as_DomRestrBy : (m,m':(Map A)) (eqmap (MapDelta A m m')
         (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m'))).

Lemma MapDelta_as_DomRestrBy_2 : (m,m':(Map A)) (eqmap (MapDelta A m m')
         (MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m))).

Lemma MapDelta_sym : (m,m':(Map A)) (eqmap (MapDelta A m m') (MapDelta A m' m)).

Lemma MapDelta_ext : (m1,m2,m'1,m'2:(Map A))
       (eqmap m1 m'1® (eqmap m2 m'2® (eqmap (MapDelta A m1 m2) (MapDelta A m'1 m'2)).

Lemma MapDelta_ext_l : (m1,m'1,m2:(Map A))
       (eqmap m1 m'1® (eqmap (MapDelta A m1 m2) (MapDelta A m'1 m2)).

Lemma MapDelta_ext_r : (m1,m2,m'2:(Map A))
       (eqmap m2 m'2® (eqmap (MapDelta A m1 m2) (MapDelta A m1 m'2)).

Lemma MapDom_Split_1 : (m:(Map A)) (m':(Map B))
       (eqmap m (MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))).

Lemma MapDom_Split_2 : (m:(Map A)) (m':(Map B))
       (eqmap m (MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m'))).

Lemma MapDom_Split_3 : (m:(Map A)) (m':(Map B))
       (eqmap (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')) (M0 A)).

End MapAxioms.

Lemma MapDomRestrTo_ext : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) (m'2:(Map B))
     (eqmap A m1 m'1® (eqmap B m2 m'2®
       (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m'2)).

Lemma MapDomRestrTo_ext_l : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A))
     (eqmap A m1 m'1®
       (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m2)).

Lemma MapDomRestrTo_ext_r : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'2:(Map B))
     (eqmap B m2 m'2®
       (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m1 m'2)).

Lemma MapDomRestrBy_ext : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) (m'2:(Map B))
     (eqmap A m1 m'1® (eqmap B m2 m'2®
       (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m'2)).

Lemma MapDomRestrBy_ext_l : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A))
     (eqmap A m1 m'1®
       (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m2)).

Lemma MapDomRestrBy_ext_r : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'2:(Map B))
     (eqmap B m2 m'2®
       (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m1 m'2)).

Lemma MapDomRestrBy_m_m : (A:Set) (m:(Map A))
     (eqmap A (MapDomRestrBy A unit m (MapDom A m)) (M0 A)).

Lemma FSetDelta_assoc : (s,s',s'':FSet)
     (eqmap unit (MapDelta ? (MapDelta ? s s's'') (MapDelta ? s (MapDelta ? s' s''))).

Lemma FSet_ext : (s,s':FSet) ((a:ad) (in_FSet a s)=(in_FSet a s')) ® (eqmap unit s s').

Lemma FSetUnion_comm : (s,s':FSet) (eqmap unit (FSetUnion s s') (FSetUnion s' s)).

Lemma FSetUnion_assoc : (s,s',s'':FSet) (eqmap unit
       (FSetUnion (FSetUnion s s's'') (FSetUnion s (FSetUnion s' s''))).

Lemma FSetUnion_M0_s : (s:FSet) (eqmap unit (FSetUnion (M0 unitss).

Lemma FSetUnion_s_M0 : (s:FSet) (eqmap unit (FSetUnion s (M0 unit)) s).

Lemma FSetUnion_idempotent : (s:FSet) (eqmap unit (FSetUnion s ss).

Lemma FSetInter_comm : (s,s':FSet) (eqmap unit (FSetInter s s') (FSetInter s' s)).

Lemma FSetInter_assoc : (s,s',s'':FSet) (eqmap unit
       (FSetInter (FSetInter s s's'') (FSetInter s (FSetInter s' s''))).

Lemma FSetInter_M0_s : (s:FSet) (eqmap unit (FSetInter (M0 units) (M0 unit)).

Lemma FSetInter_s_M0 : (s:FSet) (eqmap unit (FSetInter s (M0 unit)) (M0 unit)).

Lemma FSetInter_idempotent : (s:FSet) (eqmap unit (FSetInter s ss).

Lemma FSetUnion_Inter_l : (s,s',s'':FSet) (eqmap unit
       (FSetUnion (FSetInter s s's'') (FSetInter (FSetUnion s s'') (FSetUnion s' s''))).

Lemma FSetUnion_Inter_r : (s,s',s'':FSet) (eqmap unit
       (FSetUnion s (FSetInter s' s'')) (FSetInter (FSetUnion s s') (FSetUnion s s''))).

Lemma FSetInter_Union_l : (s,s',s'':FSet) (eqmap unit
       (FSetInter (FSetUnion s s's'') (FSetUnion (FSetInter s s'') (FSetInter s' s''))).

Lemma FSetInter_Union_r : (s,s',s'':FSet) (eqmap unit
       (FSetInter s (FSetUnion s' s'')) (FSetUnion (FSetInter s s') (FSetInter s s''))).

Module Mapiter

Require Bool.
Require Sumbool.
Require ZArith.
Require Addr.
Require Adist.
Require Addec.
Require Map.
Require Mapaxioms.
Require Fset.
Require PolyList.

Section MapIter.

Variable A : Set.

Section MapSweepDef.

Variable f:ad®A®bool.

Definition MapSweep2 := [a0:ady:Aif (f a0 ythen (SOME ? (a0y)) else (NONE ?).

Fixpoint MapSweep1 [pf:ad®adm:(Map A)] : (option (ad × A)) :=
     Cases m of
         M0 Þ (NONE ?)
       | (M1 a yÞ (MapSweep2 (pf ay)
       | (M2 m m'Þ Cases (MapSweep1 ([a:ad] (pf (ad_double a))) mof
                           (SOME rÞ (SOME ? r)
                         | NONE Þ (MapSweep1 ([a:ad] (pf (ad_double_plus_un a))) m')
                       end
     end.

Definition MapSweep := [m:(Map A)] (MapSweep1 ([a:adam).

Lemma MapSweep_semantics_1_1 : (m:(Map A)) (pf:ad®ad) (a:ad) (y:A)
       (MapSweep1 pf m)=(SOME ? (ay)) ® (f a y)=true.

Lemma MapSweep_semantics_1 : (m:(Map A)) (a:ad) (y:A)
       (MapSweep m)=(SOME ? (ay)) ® (f a y)=true.

Lemma MapSweep_semantics_2_1 : (m:(Map A)) (pf:ad®ad) (a:ad) (y:A)
         (MapSweep1 pf m)=(SOME ? (ay)) ® {a':ad | a=(pf a')}.

Lemma MapSweep_semantics_2_2 : (m:(Map A))
       (pf,fp:ad®ad) ((a0:ad) (fp (pf a0))=a0® (a:ad) (y:A)
         (MapSweep1 pf m)=(SOME ? (ay)) ® (MapGet A m (fp a))=(SOME ? y).

Lemma MapSweep_semantics_2 : (m:(Map A)) (a:ad) (y:A)
       (MapSweep m)=(SOME ? (ay)) ® (MapGet A m a)=(SOME ? y).

Lemma MapSweep_semantics_3_1 : (m:(Map A)) (pf:ad®ad)
       (MapSweep1 pf m)=(NONE ?) ®
         (a:ad) (y:A) (MapGet A m a)=(SOME ? y® (f (pf ay)=false.

Lemma MapSweep_semantics_3 : (m:(Map A))
       (MapSweep m)=(NONE ?) ® (a:ad) (y:A) (MapGet A m a)=(SOME ? y® (f a y)=false.

Lemma MapSweep_semantics_4_1 : (m:(Map A)) (pf:ad®ad) (a:ad) (y:A)
       (MapGet A m a)=(SOME A y® (f (pf ay)=true ®
         {a':ad & {y':A | (MapSweep1 pf m)=(SOME ? (a'y'))}}.

Lemma MapSweep_semantics_4 : (m:(Map A)) (a:ad) (y:A)
       (MapGet A m a)=(SOME A y® (f a y)=true ®
         {a':ad & {y':A | (MapSweep m)=(SOME ? (a'y'))}}.

End MapSweepDef.

Variable B : Set.

Fixpoint MapCollect1 [f:ad®A®(Map B); pf:ad®adm:(Map A)] : (Map B) :=
     Cases m of
         M0 Þ (M0 B)
       | (M1 a yÞ (f (pf ay)
       | (M2 m1 m2Þ (MapMerge B (MapCollect1 f [a0:ad] (pf (ad_double a0)) m1)
                                   (MapCollect1 f [a0:ad] (pf (ad_double_plus_un a0)) m2))
     end.

Definition MapCollect := [f:ad®A®(Map B); m:(Map A)] (MapCollect1 f [a:ad]a m).

Section MapFoldDef.

Variable M : Set.
     Variable neutral : M.
     Variable op : M ® M ® M.

Fixpoint MapFold1 [f:ad®A®Mpf:ad®adm:(Map A)] : M :=
       Cases m of
           M0 Þ neutral
         | (M1 a yÞ (f (pf ay)
         | (M2 m1 m2Þ (op (MapFold1 f [a0:ad] (pf (ad_double a0)) m1)
                             (MapFold1 f [a0:ad] (pf (ad_double_plus_un a0)) m2))
       end.

Definition MapFold := [f:ad®A®Mm:(Map A)] (MapFold1 f [a:ad]a m).

Lemma MapFold_empty : (f:ad®A®M) (MapFold f (M0 A))=neutral.

Lemma MapFold_M1 : (f:ad®A®M) (a:ad) (y:A) (MapFold f (M1 A a y)) = (f a y).

Variable State : Set.
     Variable f:State ® ad ® A ® State × M.

Fixpoint MapFold1_state [state:Statepf:ad®adm:(Map A)]
                             : State × M :=
       Cases m of
           M0 Þ (stateneutral)
         | (M1 a yÞ (f state (pf ay)
         | (M2 m1 m2Þ
           Cases (MapFold1_state state [a0:ad] (pf (ad_double a0)) m1of
               (state1x1Þ
               Cases (MapFold1_state state1 [a0:ad] (pf (ad_double_plus_un a0)) m2of
                   (state2x2Þ (state2, (op x1 x2))
               end
           end
       end.

Definition MapFold_state := [state:State] (MapFold1_state state [a:ad]a).

Lemma pair_sp : (B,C:Set) (x:B×Cx=(Fst xSnd x).

Lemma MapFold_state_stateless_1 : (m:(Map A)) (g:ad®A®M) (pf:ad®ad)
         ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) ®
           (state:State)
             (Snd (MapFold1_state state pf m))=(MapFold1 g pf m).

Lemma MapFold_state_stateless : (g:ad®A®M)
         ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) ®
           (state:State) (m:(Map A))
             (Snd (MapFold_state state m))=(MapFold g m).

End MapFoldDef.

Lemma MapCollect_as_Fold : (f:ad®A®(Map B)) (m:(Map A))
       (MapCollect f m)=(MapFold (Map B) (M0 B) (MapMerge Bf m).

Definition alist := (list (ad×A)).
   Definition anil := (nil (ad×A)).
   Definition acons := (!cons (ad×A)).
   Definition aapp := (!app (ad×A)).

Definition alist_of_Map := (MapFold alist anil aapp [a:ad;y:A] (acons (pair ? ? a yanil)).

Fixpoint alist_semantics [l:alist] : ad ® (option A) :=
     Cases l of
         nil Þ [_:ad] (NONE A)
       | (cons (ayl'Þ [a0:adif (ad_eq a a0then (SOME A yelse (alist_semantics l' a0)
     end.

Lemma alist_semantics_app : (l,l':alist) (a:ad)
       (alist_semantics (aapp l l'a)=
       (Cases (alist_semantics l aof
             NONE Þ (alist_semantics l' a)
           | (SOME yÞ (SOME A y)
         end).

Lemma alist_of_Map_semantics_1_1 : (m:(Map A)) (pf:ad®ad) (a:ad) (y:A)
       (alist_semantics (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,yanilpf ma)
       =(SOME A y® {a':ad | a=(pf a')}.

Definition ad_inj := [pf:ad®ad] (a0,a1:ad) (pf a0)=(pf a1® a0=a1.

Lemma ad_comp_double_inj : (pf:ad®ad) (ad_inj pf® (ad_inj [a0:ad] (pf (ad_double a0))).

Lemma ad_comp_double_plus_un_inj : (pf:ad®ad) (ad_inj pf®
       (ad_inj [a0:ad] (pf (ad_double_plus_un a0))).

Lemma alist_of_Map_semantics_1 : (m:(Map A)) (pf:ad®ad) (ad_inj pf®
       (a:ad) (MapGet A m a)=(alist_semantics (MapFold1 alist anil aapp
                                                     [a0:ad;y:A] (acons (pair ? ? a0 yanilpf m)
                                       (pf a)).

Lemma alist_of_Map_semantics : (m:(Map A))
       (eqm A (MapGet A m) (alist_semantics (alist_of_Map m))).

Fixpoint Map_of_alist [l:alist] : (Map A) :=
     Cases l of
         nil Þ (M0 A)
       | (cons (ayl'Þ (MapPut A (Map_of_alist l'a y)
     end.

Lemma Map_of_alist_semantics : (l:alist)
       (eqm A (alist_semantics l) (MapGet A (Map_of_alist l))).

Lemma Map_of_alist_of_Map : (m:(Map A)) (eqmap A (Map_of_alist (alist_of_Map m)) m).

Lemma alist_of_Map_of_alist : (l:alist)
       (eqm A (alist_semantics (alist_of_Map (Map_of_alist l))) (alist_semantics l)).

Lemma fold_right_aapp : (M:Set) (neutral:M) (op:M®M®M)
       ((a,b,c:M) (op (op a bc)=(op a (op b c))) ®
       ((a:M) (op neutral a)=a®
       (f:ad®A®M) (l,l':alist)
         (fold_right [r:ad×A][m:Mlet (a,y)=r in (op (f a ymneutral
                     (aapp l l'))=
         (op (fold_right [r:ad×A][m:Mlet (a,y)=r in (op (f a ymneutral l)
             (fold_right [r:ad×A][m:Mlet (a,y)=r in (op (f a ymneutral l'))
.

Lemma MapFold_as_fold_1 : (M:Set) (neutral:M) (op:M®M®M)
       ((a,b,c:M) (op (op a bc)=(op a (op b c))) ®
       ((a:M) (op neutral a)=a®
       ((a:M) (op a neutral)=a®
         (f:ad®A®M) (m:(Map A)) (pf:ad®ad)
           (MapFold1 M neutral op f pf m)=
           (fold_right [r:(ad×A)][m:Mlet (a,y)=r in (op (f a ymneutral
                     (MapFold1 alist anil aapp [a:ad;y:A] (acons (pair ? ? 
a yanilpf m)).

Lemma MapFold_as_fold : (M:Set) (neutral:M) (op:M®M®M)
       ((a,b,c:M) (op (op a bc)=(op a (op b c))) ®
       ((a:M) (op neutral a)=a®
       ((a:M) (op a neutral)=a®
         (f:ad®A®M) (m:(Map A))
           (MapFold M neutral op f m)=
           (fold_right [r:(ad×A)][m:Mlet (a,y)=r in (op (f a ymneutral
   (alist_of_Map m)).

Lemma alist_MapMerge_semantics : (m,m':(Map A))
       (eqm A (alist_semantics (aapp (alist_of_Map m') (alist_of_Map m)))
               (alist_semantics (alist_of_Map (MapMerge A m m')))).

Lemma alist_MapMerge_semantics_disjoint : (m,m':(Map A))
         (eqmap A (MapDomRestrTo A A m m') (M0 A)) ®
           (eqm A (alist_semantics (aapp (alist_of_Map m) (alist_of_Map m')))
                   (alist_semantics (alist_of_Map (MapMerge A m m')))).

Lemma alist_semantics_disjoint_comm : (l,l':alist)
       (eqmap A (MapDomRestrTo A A (Map_of_alist l) (Map_of_alist l')) (M0 A)) ®
         (eqm A (alist_semantics (aapp l l')) (alist_semantics (aapp l' l))).

End MapIter.

Module Lsort

Require Bool.
Require Sumbool.
Require Arith.
Require ZArith.
Require Addr.
Require Adist.
Require Addec.
Require Map.
Require PolyList.
Require Mapiter.

Section LSort.

Variable A : Set.

Fixpoint ad_less_1 [a,a':adp:positive] : bool :=
     Cases p of
         (xO p'Þ (ad_less_1 (ad_div_2 a) (ad_div_2 a'p')
       | _ Þ (andb (negb (ad_bit_0 a)) (ad_bit_0 a'))
     end.

Definition ad_less := [a,a':adCases (ad_xor a a'of
                                       ad_z Þ false
                                     | (ad_x pÞ (ad_less_1 a a' p)
                                   end.

Lemma ad_bit_0_less : (a,a':ad) (ad_bit_0 a)=false ® (ad_bit_0 a')=true ® (ad_less a a')=true.

Lemma ad_bit_0_gt : (a,a':ad) (ad_bit_0 a)=true ® (ad_bit_0 a')=false ® (ad_less a a')=false.

Lemma ad_less_not_refl : (a:ad) (ad_less a a)=false.

Lemma ad_ind_double : 
       (a:ad)(P:ad®Prop) (P ad_z®
         ((a:ad) (P a® (P (ad_double a))) ®
         ((a:ad) (P a® (P (ad_double_plus_un a))) ® (P a).

Lemma ad_rec_double : 
       (a:ad)(P:ad®Set) (P ad_z®
         ((a:ad) (P a® (P (ad_double a))) ®
         ((a:ad) (P a® (P (ad_double_plus_un a))) ® (P a).

Lemma ad_less_def_1 : (a,a':ad) (ad_less (ad_double a) (ad_double a'))=(ad_less a a').

Lemma ad_less_def_2 : (a,a':ad)
       (ad_less (ad_double_plus_un a) (ad_double_plus_un a'))=(ad_less a a').

Lemma ad_less_def_3 : (a,a':ad) (ad_less (ad_double a) (ad_double_plus_un a'))=true.

Lemma ad_less_def_4 : (a,a':ad) (ad_less (ad_double_plus_un a) (ad_double a'))=false.

Lemma ad_less_z : (a:ad) (ad_less a ad_z)=false.

Lemma ad_z_less_1 : (a:ad) (ad_less ad_z a)=true ® {p:positive | a=(ad_x p)}.

Lemma ad_z_less_2 : (a:ad) (ad_less ad_z a)=false ® a=ad_z.

Lemma ad_less_trans : (a,a',a'':ad)
       (ad_less a a')=true ® (ad_less a' a'')=true ® (ad_less a a'')=true.

Fixpoint alist_sorted [l:(alist A)] : bool :=
     Cases l of
         nil Þ true
       | (cons (a, _) l'Þ Cases l' of
                                 nil Þ true
                               | (cons (a'y'l''Þ (andb (ad_less a a')
                                                               (alist_sorted l'))
                             end
     end.

Fixpoint alist_nth_ad [n:natl:(alist A)] : ad :=
     Cases l of
         nil Þ ad_z (* dummy *)
       | (cons (ayl'Þ Cases n of
                                 O Þ a
                               | (S n'Þ (alist_nth_ad n' l')
                             end
     end.

Definition alist_sorted_1 := [l:(alist A)]
       (n:nat) (le (S (S n)) (length l)) ®
         (ad_less (alist_nth_ad n l) (alist_nth_ad (S nl))=true.

Lemma alist_sorted_imp_1 : (l:(alist A)) (alist_sorted l)=true ® (alist_sorted_1 l).

Definition alist_sorted_2 := [l:(alist A)]
     (m,n:nat) (lt m n® (le (S n) (length l)) ®
         (ad_less (alist_nth_ad m l) (alist_nth_ad n l))=true.

Lemma alist_sorted_1_imp_2 : (l:(alist A)) (alist_sorted_1 l® (alist_sorted_2 l).

Lemma alist_sorted_2_imp : (l:(alist A)) (alist_sorted_2 l® (alist_sorted l)=true.

Lemma app_length : (C:Set) (l,l':(list C)) (length (app l l'))=(plus (length l) (length l')).

Lemma aapp_length : (l,l':(alist A)) (length (aapp A l l'))=(plus (length l) (length l')).

Lemma alist_nth_ad_aapp_1 : (l,l':(alist A)) (n:nat)
       (le (S n) (length l)) ® (alist_nth_ad n (aapp A l l'))=(alist_nth_ad n l).

Lemma alist_nth_ad_aapp_2 : (l,l':(alist A)) (n:nat)
       (le (S n) (length l')) ®
         (alist_nth_ad (plus (length ln) (aapp A l l'))=(alist_nth_ad n l').

Lemma interval_split : (p,q,n:nat) (le (S n) (plus p q)) ®
       {n' : nat | (le (S n'q) & n=(plus p n')}+{(le (S np)}.

Lemma alist_conc_sorted : (l,l':(alist A)) (alist_sorted_2 l® (alist_sorted_2 l'®
       ((n,n':nat) (le (S n) (length l)) ® (le (S n') (length l')) ®
           (ad_less (alist_nth_ad n l) (alist_nth_ad n' l'))=true®
         (alist_sorted_2 (aapp A l l')).

Lemma alist_nth_ad_semantics : (l:(alist A)) (n:nat) (le (S n) (length l)) ®
       {y:A | (alist_semantics A l (alist_nth_ad n l))=(SOME A y)}.

Lemma alist_of_Map_nth_ad : (m:(Map A)) (pf:ad®ad)
       (l:(alist A)) l=(MapFold1 A (alist A) (anil A) (aapp A)
                                 [a0:ad][y:A](acons A (a0,y) (anil A)) pf m®
         (n:nat) (le (S n) (length l)) ® {a':ad | (alist_nth_ad n l)=(pf a')}.

Definition ad_monotonic := [pf:ad®ad] (a,a':ad)
       (ad_less a a')=true ® (ad_less (pf a) (pf a'))=true.

Lemma ad_double_monotonic : (ad_monotonic ad_double).

Lemma ad_double_plus_un_monotonic : (ad_monotonic ad_double_plus_un).

Lemma ad_comp_monotonic : (pf,pf':ad®ad) (ad_monotonic pf® (ad_monotonic pf'®
       (ad_monotonic [a0:ad] (pf (pf' a0))).

Lemma ad_comp_double_monotonic : (pf:ad®ad) (ad_monotonic pf®
       (ad_monotonic [a0:ad] (pf (ad_double a0))).

Lemma ad_comp_double_plus_un_monotonic : (pf:ad®ad) (ad_monotonic pf®
       (ad_monotonic [a0:ad] (pf (ad_double_plus_un a0))).

Lemma alist_of_Map_sorts_1 : (m:(Map A)) (pf:ad®ad) (ad_monotonic pf®
       (alist_sorted_2 (MapFold1 A (alist A) (anil A) (aapp A)
                                 [a:ad][y:A](acons A (a,y) (anil A)) pf m)).

Lemma alist_of_Map_sorts : (m:(Map A)) (alist_sorted (alist_of_Map A m))=true.

Lemma alist_of_Map_sorts1 : (m:(Map A)) (alist_sorted_1 (alist_of_Map A m)).

Lemma alist_of_Map_sorts2 : (m:(Map A)) (alist_sorted_2 (alist_of_Map A m)).

Lemma ad_less_total : (a,a':ad) {(ad_less a a')=true}+{(ad_less a' a)=true}+{a=a'}.

Lemma alist_too_low : (l:(alist A)) (a,a':ad) (y:A)
       (ad_less a a')=true ® (alist_sorted_2 (cons (a',yl)) ®
         (alist_semantics A (cons (a',yla)=(NONE A).

Lemma alist_semantics_nth_ad : (l:(alist A)) (a:ad) (y:A)
       (alist_semantics A l a)=(SOME A y®
         {n:nat | (le (S n) (length l)) & (alist_nth_ad n l)=a}.

Lemma alist_semantics_tail : (l:(alist A)) (a:ad) (y:A)
       (alist_sorted_2 (cons (a,yl)) ®
         (eqm A (alist_semantics A l) [a0:adif (ad_eq a a0)
                                               then (NONE A)
                                               else (alist_semantics A (cons (a,yla0)).

Lemma alist_semantics_same_tail : (l,l':(alist A)) (a:ad) (y:A)
       (alist_sorted_2 (cons (a,yl)) ® (alist_sorted_2 (cons (a,yl')) ®
         (eqm A (alist_semantics A (cons (a,yl)) (alist_semantics A (cons (a,yl'))) ®
           (eqm A (alist_semantics A l) (alist_semantics A l')).

Lemma alist_sorted_tail : (l:(alist A)) (a:ad) (y:A)
       (alist_sorted_2 (cons (a,yl)) ® (alist_sorted_2 l).

Lemma alist_canonical : (l,l':(alist A))
       (eqm A (alist_semantics A l) (alist_semantics A l')) ®
         (alist_sorted_2 l® (alist_sorted_2 l'® l=l'.

End LSort.

Module Mapsubset

Require Bool.
Require Sumbool.
Require Arith.
Require ZArith.
Require Addr.
Require Adist.
Require Addec.
Require Map.
Require Fset.
Require Mapaxioms.
Require Mapiter.

Section MapSubsetDef.

Variable AB : Set.

Definition MapSubset := [m:(Map A)] [m':(Map B)]
       (a:ad) (in_dom A a m)=true ® (in_dom B a m')=true.

Definition MapSubset_1 := [m:(Map A)] [m':(Map B)]
       Cases (MapSweep A [a:ad][_:A] (negb (in_dom B a m')) mof
           NONE Þ true
         | _ Þ false
       end.

Definition MapSubset_2 := [m:(Map A)] [m':(Map B)] (eqmap A (MapDomRestrBy A B m m') (M0 A)).

Lemma MapSubset_imp_1 : (m:(Map A)) (m':(Map B))
       (MapSubset m m'® (MapSubset_1 m m')=true.

Lemma MapSubset_1_imp : (m:(Map A)) (m':(Map B))
       (MapSubset_1 m m')=true ® (MapSubset m m').

Lemma map_dom_empty_1 : (m:(Map A)) (eqmap A m (M0 A)) ® (a:ad) (in_dom ? a m)=false.

Lemma map_dom_empty_2 : (m:(Map A)) ((a:ad) (in_dom ? a m)=false® (eqmap A m (M0 A)).

Lemma MapSubset_imp_2 : (m:(Map A)) (m':(Map B)) (MapSubset m m'® (MapSubset_2 m m').

Lemma MapSubset_2_imp : (m:(Map A)) (m':(Map B)) (MapSubset_2 m m'® (MapSubset m m').

End MapSubsetDef.

Section MapSubsetOrder.

Variable ABC : Set.

Lemma MapSubset_refl : (m:(Map A)) (MapSubset A A m m).

Lemma MapSubset_antisym : (m:(Map A)) (m':(Map B))
       (MapSubset A B m m'® (MapSubset B A m' m® (eqmap unit (MapDom A m) (MapDom B m')).

Lemma MapSubset_trans : (m:(Map A)) (m':(Map B)) (m'':(Map C))
       (MapSubset A B m m'® (MapSubset B C m' m''® (MapSubset A C m m'').

End MapSubsetOrder.

Section FSubsetOrder.

Lemma FSubset_refl : (s:FSet) (MapSubset ? ? s s).

Lemma FSubset_antisym : (s,s':FSet)
       (MapSubset ? ? s s'® (MapSubset ? ? s' s® (eqmap unit s s').

Lemma FSubset_trans : (s,s',s'':FSet)
       (MapSubset ? ? s s'® (MapSubset ? ? s' s''® (MapSubset ? ? s s'').

End FSubsetOrder.

Section MapSubsetExtra.

Variable AB : Set.

Lemma MapSubset_Dom_1 : (m:(Map A)) (m':(Map B))
       (MapSubset A B m m'® (MapSubset unit unit (MapDom A m) (MapDom B m')).

Lemma MapSubset_Dom_2 : (m:(Map A)) (m':(Map B))
       (MapSubset unit unit (MapDom A m) (MapDom B m')) ® (MapSubset A B m m').

Lemma MapSubset_1_Dom : (m:(Map A)) (m':(Map B))
       (MapSubset_1 A B m m')=(MapSubset_1 unit unit (MapDom A m) (MapDom B m')).

Lemma MapSubset_Put : (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut A m a y)).

Lemma MapSubset_Put_mono : (m:(Map A)) (m':(Map B)) (a:ad) (y:A) (y':B)
       (MapSubset A B m m'® (MapSubset A B (MapPut A m a y) (MapPut B m' a y')).

Lemma MapSubset_Put_behind : (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut_behind A m a y)).

Lemma MapSubset_Put_behind_mono : (m:(Map A)) (m':(Map B)) (a:ad) (y:A) (y':B)
       (MapSubset A B m m'® (MapSubset A B (MapPut_behind A m a y) (MapPut_behind B m' a y')).

Lemma MapSubset_Remove : (m:(Map A)) (a:ad) (MapSubset A A (MapRemove A m am).

Lemma MapSubset_Remove_mono : (m:(Map A)) (m':(Map B)) (a:ad)
       (MapSubset A B m m'® (MapSubset A B (MapRemove A m a) (MapRemove B m' a)).

Lemma MapSubset_Merge_l : (m,m':(Map A)) (MapSubset A A m (MapMerge A m m')).

Lemma MapSubset_Merge_r : (m,m':(Map A)) (MapSubset A A m' (MapMerge A m m')).

Lemma MapSubset_Merge_mono : (m,m':(Map A)) (m'',m''':(Map B))
       (MapSubset A B m m''® (MapSubset A B m' m'''®
         (MapSubset A B (MapMerge A m m') (MapMerge B m'' m''')).

Lemma MapSubset_DomRestrTo_l : (m:(Map A)) (m':(Map B))
       (MapSubset A A (MapDomRestrTo A B m m'm).

Lemma MapSubset_DomRestrTo_r: (m:(Map A)) (m':(Map B))
       (MapSubset A B (MapDomRestrTo A B m m'm').

Lemma MapSubset_ext : (m0,m1:(Map A)) (m2,m3:(Map B))
       (eqmap A m0 m1® (eqmap B m2 m3®
         (MapSubset A B m0 m2® (MapSubset A B m1 m3).

Variable CD : Set.

Lemma MapSubset_DomRestrTo_mono : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
       (MapSubset ? ? m m''® (MapSubset ? ? m' m'''®
         (MapSubset ? ? (MapDomRestrTo ? ? m m') (MapDomRestrTo ? ? m'' m''')).

Lemma MapSubset_DomRestrBy_l : (m:(Map A)) (m':(Map B))
       (MapSubset A A (MapDomRestrBy A B m m'm).

Lemma MapSubset_DomRestrBy_mono : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
       (MapSubset ? ? m m''® (MapSubset ? ? m''' m'®
         (MapSubset ? ? (MapDomRestrBy ? ? m m') (MapDomRestrBy ? ? m'' m''')).

End MapSubsetExtra.

Section MapDisjointDef.

Variable AB : Set.

Definition MapDisjoint := [m:(Map A)] [m':(Map B)]
       (a:ad) (in_dom A a m)=true ® (in_dom B a m')=true ® False.

Definition MapDisjoint_1 := [m:(Map A)] [m':(Map B)]
       Cases (MapSweep A [a:ad][_:A] (in_dom B a m'mof
           NONE Þ true
         | _ Þ false
       end.

Definition MapDisjoint_2 := [m:(Map A)] [m':(Map B)] (eqmap A (MapDomRestrTo A B m m') (M0 A)).

Lemma MapDisjoint_imp_1 : (m:(Map A)) (m':(Map B))
       (MapDisjoint m m'® (MapDisjoint_1 m m')=true.

Lemma MapDisjoint_1_imp : (m:(Map A)) (m':(Map B))
       (MapDisjoint_1 m m')=true ® (MapDisjoint m m').

Lemma MapDisjoint_imp_2 : (m:(Map A)) (m':(Map B)) (MapDisjoint m m'® (MapDisjoint_2 m m').

Lemma MapDisjoint_2_imp : (m:(Map A)) (m':(Map B)) (MapDisjoint_2 m m'® (MapDisjoint m m').

Lemma Map_M0_disjoint : (m:(Map B)) (MapDisjoint (M0 Am).

Lemma Map_disjoint_M0 : (m:(Map A)) (MapDisjoint m (M0 B)).

End MapDisjointDef.

Section MapDisjointExtra.

Variable AB : Set.

Lemma MapDisjoint_ext : (m0,m1:(Map A)) (m2,m3:(Map B))
       (eqmap A m0 m1® (eqmap B m2 m3® (MapDisjoint A B m0 m2® (MapDisjoint A B m1 m3).

Lemma MapMerge_disjoint : (m,m':(Map A)) (MapDisjoint A A m m'®
         (a:ad) (in_dom A a (MapMerge A m m'))=
                 (orb (andb (in_dom A a m) (negb (in_dom A a m')))
                     (andb (in_dom A a m') (negb (in_dom A a m)))).

Lemma MapDisjoint_M2_l : (m0,m1:(Map A)) (m2,m3:(Map B))
       (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)) ® (MapDisjoint A B m0 m2).

Lemma MapDisjoint_M2_r : (m0,m1:(Map A)) (m2,m3:(Map B))
       (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)) ® (MapDisjoint A B m1 m3).

Lemma MapDisjoint_M2 : (m0,m1:(Map A)) (m2,m3:(Map B))
       (MapDisjoint A B m0 m2® (MapDisjoint A B m1 m3®
         (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)).

Lemma MapDisjoint_M1_l : (m:(Map A)) (a:ad) (y:B)
       (MapDisjoint B A (M1 B a ym® (in_dom A a m)=false.

Lemma MapDisjoint_M1_r : (m:(Map A)) (a:ad) (y:B)
       (MapDisjoint A B m (M1 B a y)) ® (in_dom A a m)=false.

Lemma MapDisjoint_M1_conv_l : (m:(Map A)) (a:ad) (y:B)
       (in_dom A a m)=false ® (MapDisjoint B A (M1 B a ym).

Lemma MapDisjoint_M1_conv_r : (m:(Map A)) (a:ad) (y:B)
       (in_dom A a m)=false ® (MapDisjoint A B m (M1 B a y)).

Lemma MapDisjoint_sym : (m:(Map A)) (m':(Map B))
       (MapDisjoint A B m m'® (MapDisjoint B A m' m).

Lemma MapDisjoint_empty : (m:(Map A)) (MapDisjoint A A m m® (eqmap A m (M0 A)).

Lemma MapDelta_disjoint : (m,m':(Map A)) (MapDisjoint A A m m'®
       (eqmap A (MapDelta A m m') (MapMerge A m m')).

Variable C : Set.

Lemma MapDomRestr_disjoint : (m:(Map A)) (m':(Map B)) (m'':(Map C))
       (MapDisjoint A B (MapDomRestrTo A C m m'') (MapDomRestrBy B C m' m'')).

Lemma MapDelta_RestrTo_disjoint : (m,m':(Map A))
       (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m m')).

Lemma MapDelta_RestrTo_disjoint_2 : (m,m':(Map A))
       (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m' m)).

Variable D : Set.

Lemma MapSubset_Disjoint : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
       (MapSubset ? ? m m'® (MapSubset ? ? m'' m'''® (MapDisjoint ? ? m' m'''®
         (MapDisjoint ? ? m m'').

Lemma MapSubset_Disjoint_l : (m:(Map A)) (m':(Map B)) (m'':(Map C))
       (MapSubset ? ? m m'® (MapDisjoint ? ? m' m''®
         (MapDisjoint ? ? m m'').

Lemma MapSubset_Disjoint_r : (m:(Map A)) (m'':(Map C)) (m''':(Map D))
       (MapSubset ? ? m'' m'''® (MapDisjoint ? ? m m'''®
         (MapDisjoint ? ? m m'').

End MapDisjointExtra.

Module Mapcard

Require Bool.
Require Sumbool.
Require Arith.
Require ZArith.
Require Addr.
Require Adist.
Require Addec.
Require Map.
Require Mapaxioms.
Require Mapiter.
Require Fset.
Require Mapsubset.
Require PolyList.
Require Lsort.
Require Peano_dec.

Section MapCard.

Variable AB : Set.

Lemma MapCard_M0 : (MapCard A (M0 A))=O.

Lemma MapCard_M1 : (a:ad) (y:A) (MapCard A (M1 A a y))=(1).

Lemma MapCard_is_O : (m:(Map A)) (MapCard A m)=O ® (a:ad) (MapGet A m a)=(NONE A).

Lemma MapCard_is_not_O : (m:(Map A)) (a:ad) (y:A) (MapGet A m a)=(SOME A y®
       {n:nat | (MapCard A m)=(S n)}.

Lemma MapCard_is_one : (m:(Map A)) (MapCard A m)=(1) ®
       {a:ad & {y:A | (MapGet A m a)=(SOME A y)}}.

Lemma MapCard_is_one_unique : (m:(Map A)) (MapCard A m)=(1) ®
     (a,a':ad) (y,y':A) (MapGet A m a)=(SOME A y® (MapGet A m a')=(SOME A y'®
       a=a' & y=y'.

Lemma length_as_fold : (C:Set) (l:(list C)) (length l)=(fold_right [_:C][n:nat](S nO l).

Lemma length_as_fold_2 : (l:(alist A)) (length l)=
       (fold_right [r:ad×A][n:nat]let (a,y)=r in (plus (1) nO l).

Lemma MapCard_as_Fold_1 : (m:(Map A)) (pf:ad®ad)
       (MapCard A m)=(MapFold1 A nat O plus [_:ad][_:A](1) pf m).

Lemma MapCard_as_Fold : (m:(Map A)) (MapCard A m)=(MapFold A nat O plus [_:ad][_:A](1) m).

Lemma MapCard_as_length : (m:(Map A)) (MapCard A m)=(length (alist_of_Map A m)).

Lemma MapCard_Put1_equals_2 : (p:positive) (a,a':ad) (y,y':A)
       (MapCard A (MapPut1 A a y a' y' p))=(2).

Lemma MapCard_Put_sum : (m,m':(Map A)) (a:ad) (y:A) (n,n':nat)
       m'=(MapPut A m a y® n=(MapCard A m® n'=(MapCard A m'®
         {n'=n}+{n'=(S n)}.

Lemma MapCard_Put_lb : (m:(Map A)) (a:ad) (y:A)
       (ge (MapCard A (MapPut A m a y)) (MapCard A m)).

Lemma MapCard_Put_ub : (m:(Map A)) (a:ad) (y:A)
       (le (MapCard A (MapPut A m a y)) (S (MapCard A m))).

Lemma MapCard_Put_1 : (m:(Map A)) (a:ad) (y:A)
       (MapCard A (MapPut A m a y))=(MapCard A m® {y:A | (MapGet A m a)=(SOME A y)}.

Lemma MapCard_Put_2 : (m:(Map A)) (a:ad) (y:A)
       (MapCard A (MapPut A m a y))=(S (MapCard A m)) ® (MapGet A m a)=(NONE A).

Lemma MapCard_Put_1_conv : (m:(Map A)) (a:ad) (y,y':A)
       (MapGet A m a)=(SOME A y® (MapCard A (MapPut A m a y'))=(MapCard A m).

Lemma MapCard_Put_2_conv : (m:(Map A)) (a:ad) (y:A)
       (MapGet A m a)=(NONE A® (MapCard A (MapPut A m a y))=(S (MapCard A m)).

Lemma MapCard_ext : (m,m':(Map A))
       (eqm A (MapGet A m) (MapGet A m')) ® (MapCard A m)=(MapCard A m').

Lemma MapCard_Dom : (m:(Map A)) (MapCard A m)=(MapCard unit (MapDom A m)).

Lemma MapCard_Dom_Put_behind : (m:(Map A)) (a:ad) (y:A)
     (MapDom A (MapPut_behind A m a y))=(MapDom A (MapPut A m a y)).

Lemma MapCard_Put_behind_Put : (m:(Map A)) (a:ad) (y:A)
       (MapCard A (MapPut_behind A m a y))=(MapCard A (MapPut A m a y)).

Lemma MapCard_Put_behind_sum : (m,m':(Map A)) (a:ad) (y:A) (n,n':nat)
       m'=(MapPut_behind A m a y® n=(MapCard A m® n'=(MapCard A m'®
         {n'=n}+{n'=(S n)}.

Lemma MapCard_makeM2 : (m,m':(Map A))
       (MapCard A (makeM2 A m m'))=(plus (MapCard A m) (MapCard A m')).

Lemma MapCard_Remove_sum : (m,m':(Map A)) (a:ad) (n,n':nat)
       m'=(MapRemove A m a® n=(MapCard A m® n'=(MapCard A m'®
         {n=n'}+{n=(S n')}.

Lemma MapCard_Remove_ub : (m:(Map A)) (a:ad)
       (le (MapCard A (MapRemove A m a)) (MapCard A m)).

Lemma MapCard_Remove_lb : (m:(Map A)) (a:ad)
       (ge (S (MapCard A (MapRemove A m a))) (MapCard A m)).

Lemma MapCard_Remove_1 : (m:(Map A)) (a:ad)
       (MapCard A (MapRemove A m a))=(MapCard A m® (MapGet A m a)=(NONE A).

Lemma MapCard_Remove_2 : (m:(Map A)) (a:ad)
       (S (MapCard A (MapRemove A m a)))=(MapCard A m® {y:A | (MapGet A m a)=(SOME A y)}.

Lemma MapCard_Remove_1_conv : (m:(Map A)) (a:ad)
       (MapGet A m a)=(NONE A® (MapCard A (MapRemove A m a))=(MapCard A m).

Lemma MapCard_Remove_2_conv : (m:(Map A)) (a:ad) (y:A)
       (MapGet A m a)=(SOME A y® (S (MapCard A (MapRemove A m a)))=(MapCard A m).

Lemma MapMerge_Restr_Card : (m,m':(Map A))
       (plus (MapCard A m) (MapCard A m'))=
       (plus (MapCard A (MapMerge A m m')) (MapCard A (MapDomRestrTo A A m m'))).

Lemma MapMerge_disjoint_Card : (m,m':(Map A)) (MapDisjoint A A m m'®
         (MapCard A (MapMerge A m m'))=(plus (MapCard A m) (MapCard A m')).

Lemma MapSplit_Card : (m:(Map A)) (m':(Map B))
       (MapCard A m)=(plus (MapCard A (MapDomRestrTo A B m m'))
                           (MapCard A (MapDomRestrBy A B m m'))).

Lemma MapMerge_Card_ub : (m,m':(Map A))
       (le (MapCard A (MapMerge A m m')) (plus (MapCard A m) (MapCard A m'))).

Lemma MapDomRestrTo_Card_ub_l : (m:(Map A)) (m':(Map B))
       (le (MapCard A (MapDomRestrTo A B m m')) (MapCard A m)).

Lemma MapDomRestrBy_Card_ub_l : (m:(Map A)) (m':(Map B))
       (le (MapCard A (MapDomRestrBy A B m m')) (MapCard A m)).

Lemma MapMerge_Card_disjoint : (m,m':(Map A))
       (MapCard A (MapMerge A m m'))=(plus (MapCard A m) (MapCard A m')) ®
         (MapDisjoint A A m m').

Lemma MapCard_is_Sn : (m:(Map A)) (n:nat) (MapCard ? m)=(S n® {a:ad | (in_dom ? a m)=true}.

End MapCard.

Section MapCard2.

Variable AB : Set.

Lemma MapSubset_card_eq_1 : (n:nat) (m:(Map A)) (m':(Map B))
       (MapSubset ? ? m m'® (MapCard ? m)=n ® (MapCard ? m')=n ®
         (MapSubset ? ? m' m).

Lemma MapDomRestrTo_Card_ub_r : (m:(Map A)) (m':(Map B))
       (le (MapCard A (MapDomRestrTo A B m m')) (MapCard B m')).

End MapCard2.

Section MapCard3.

Variable AB : Set.

Lemma MapMerge_Card_lb_l : (m,m':(Map A))
       (ge (MapCard A (MapMerge A m m')) (MapCard A m)).

Lemma MapMerge_Card_lb_r : (m,m':(Map A))
       (ge (MapCard A (MapMerge A m m')) (MapCard A m')).

Lemma MapDomRestrBy_Card_lb : (m:(Map A)) (m':(Map B))
       (ge (plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))) (MapCard A m)).

Lemma MapSubset_Card_le : (m:(Map A)) (m':(Map B))
       (MapSubset A B m m'® (le (MapCard A m) (MapCard B m')).

Lemma MapSubset_card_eq : (m:(Map A)) (m':(Map B))
       (MapSubset ? ? m m'® (le (MapCard ? m') (MapCard ? m)) ®
         (eqmap ? (MapDom ? m) (MapDom ? m')).

End MapCard3.

Module Mapcanon

Require Bool.
Require Sumbool.
Require Arith.
Require ZArith.
Require Addr.
Require Adist.
Require Addec.
Require Map.
Require Mapaxioms.
Require Mapiter.
Require Fset.
Require PolyList.
Require Lsort.
Require Mapsubset.
Require Mapcard.

Section MapCanon.

Variable A : Set.

Inductive mapcanon : (Map A® Prop :=
       M0_canon : (mapcanon (M0 A))
     | M1_canon : (a:ad) (y:A) (mapcanon (M1 A a y))
     | M2_canon : (m1,m2:(Map A)) (mapcanon m1® (mapcanon m2®
         (le (2) (MapCard A (M2 A m1 m2))) ® (mapcanon (M2 A m1 m2)).

Lemma mapcanon_M2 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) ® (le (2) (MapCard A (M2 A m1 m2))).

Lemma mapcanon_M2_1 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) ® (mapcanon m1).

Lemma mapcanon_M2_2 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) ® (mapcanon m2).

Lemma M2_eqmap_1 : (m0,m1,m2,m3:(Map A)) (eqmap A (M2 A m0 m1) (M2 A m2 m3)) ® (eqmap A m0 m2).

Lemma M2_eqmap_2 : (m0,m1,m2,m3:(Map A)) (eqmap A (M2 A m0 m1) (M2 A m2 m3)) ® (eqmap A m1 m3).

Lemma mapcanon_unique : (m,m':(Map A)) (mapcanon m® (mapcanon m'®
       (eqmap A m m'® m=m'.

Lemma MapPut1_canon : (p:positive) (a,a':ad) (y,y':A) (mapcanon (MapPut1 A a y a' y' p)).

Lemma MapPut_canon : (m:(Map A)) (mapcanon m® (a:ad) (y:A) (mapcanon (MapPut A m a y)).

Lemma MapPut_behind_canon : (m:(Map A)) (mapcanon m®
       (a:ad) (y:A) (mapcanon (MapPut_behind A m a y)).

Lemma makeM2_canon : (m,m':(Map A)) (mapcanon m® (mapcanon m'® (mapcanon (makeM2 A m m')).

Fixpoint MapCanonicalize [m:(Map A)] : (Map A) :=
       Cases m of
           (M2 m0 m1Þ (makeM2 A (MapCanonicalize m0) (MapCanonicalize m1))
         | _ Þ m
       end.

Lemma mapcanon_exists_1 : (m:(Map A)) (eqmap A m (MapCanonicalize m)).

Lemma mapcanon_exists_2 : (m:(Map A)) (mapcanon (MapCanonicalize m)).

Lemma mapcanon_exists : (m:(Map A)) {m':(Map A) | (eqmap A m m') & (mapcanon m')}.

Lemma MapRemove_canon : (m:(Map A)) (mapcanon m® (a:ad) (mapcanon (MapRemove A m a)).

Lemma MapMerge_canon : (m,m':(Map A)) (mapcanon m® (mapcanon m'®
       (mapcanon (MapMerge A m m')).

Lemma MapDelta_canon : (m,m':(Map A)) (mapcanon m® (mapcanon m'®
       (mapcanon (MapDelta A m m')).

Variable B : Set.

Lemma MapDomRestrTo_canon : (m:(Map A)) (mapcanon m®
       (m':(Map B)) (mapcanon (MapDomRestrTo A B m m')).

Lemma MapDomRestrBy_canon : (m:(Map A)) (mapcanon m®
       (m':(Map B)) (mapcanon (MapDomRestrBy A B m m')).

Lemma Map_of_alist_canon : (l:(alist A)) (mapcanon (Map_of_alist A l)).

Lemma MapSubset_c_1 : (m:(Map A)) (m':(Map B)) (mapcanon m®
       (MapSubset A B m m'® (MapDomRestrBy A B m m')=(M0 A).

Lemma MapSubset_c_2 : (m:(Map A)) (m':(Map B))
       (MapDomRestrBy A B m m')=(M0 A® (MapSubset A B m m').

End MapCanon.

Section FSetCanon.

Variable A : Set.

Lemma MapDom_canon : (m:(Map A)) (mapcanon A m® (mapcanon unit (MapDom A m)).

End FSetCanon.

Section MapFoldCanon.

Variable AB : Set.

Lemma MapFold_canon_1 : (m0:(Map B)) (mapcanon B m0®
       (op : (Map B® (Map B® (Map B))
         ((m1:(Map B)) (mapcanon B m1® (m2:(Map B)) (mapcanon B m2®
           (mapcanon B (op m1 m2))) ®
       (f : ad®A®(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ®
         (m:(Map A)) (pf : ad®ad) (mapcanon B (MapFold1 A (Map Bm0 op f pf m)).

Lemma MapFold_canon : (m0:(Map B)) (mapcanon B m0®
       (op : (Map B® (Map B® (Map B))
         ((m1:(Map B)) (mapcanon B m1® (m2:(Map B)) (mapcanon B m2®
           (mapcanon B (op m1 m2))) ®
       (f : ad®A®(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ®
         (m:(Map A)) (mapcanon B (MapFold A (Map Bm0 op f m)).

Lemma MapCollect_canon : (f : ad®A®(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ®
         (m:(Map A)) (mapcanon B (MapCollect A B f m)).

End MapFoldCanon.

Module Mapc

Require Bool.
Require Sumbool.
Require Arith.
Require ZArith.
Require Addr.
Require Adist.
Require Addec.
Require Map.
Require Mapaxioms.
Require Fset.
Require Mapiter.
Require Mapsubset.
Require PolyList.
Require Lsort.
Require Mapcard.
Require Mapcanon.

Section MapC.

Variable ABC : Set.

Lemma MapPut_as_Merge_c : (m:(Map A)) (mapcanon A m®
       (a:ad) (y:A) (MapPut A m a y)=(MapMerge A m (M1 A a y)).

Lemma MapPut_behind_as_Merge_c : (m:(Map A)) (mapcanon A m®
       (a:ad) (y:A) (MapPut_behind A m a y)=(MapMerge A (M1 A a ym).

Lemma MapMerge_empty_m_c : (m:(Map A)) (MapMerge A (M0 Am)=m.

Lemma MapMerge_assoc_c : (m,m',m'':(Map A))
       (mapcanon A m® (mapcanon A m'® (mapcanon A m''®
         (MapMerge A (MapMerge A m m'm'')=(MapMerge A m (MapMerge A m' m'')).

Lemma MapMerge_idempotent_c : (m:(Map A)) (mapcanon A m® (MapMerge A m m)=m.

Lemma MapMerge_RestrTo_l_c : (m,m',m'':(Map A)) (mapcanon A m® (mapcanon A m''®
       (MapMerge A (MapDomRestrTo A A m m'm'')
       =(MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m'')).

Lemma MapRemove_as_RestrBy_c : (m:(Map A)) (mapcanon A m®
       (a:ad) (y:B) (MapRemove A m a)=(MapDomRestrBy A B m (M1 B a y)).

Lemma MapDomRestrTo_assoc_c : (m:(Map A)) (m':(Map B)) (m'':(Map C))
       (mapcanon A m®
         (MapDomRestrTo A C (MapDomRestrTo A B m m'm'')=
         (MapDomRestrTo A B m (MapDomRestrTo B C m' m'')).

Lemma MapDomRestrTo_idempotent_c : (m:(Map A)) (mapcanon A m® (MapDomRestrTo A A m m)=m.

Lemma MapDomRestrTo_Dom_c : (m:(Map A)) (m':(Map B)) (mapcanon A m®
       (MapDomRestrTo A B m m')=(MapDomRestrTo A unit m (MapDom B m')).

Lemma MapDomRestrBy_Dom_c : (m:(Map A)) (m':(Map B)) (mapcanon A m®
       (MapDomRestrBy A B m m')=(MapDomRestrBy A unit m (MapDom B m')).

Lemma MapDomRestrBy_By_c : (m:(Map A)) (m':(Map B)) (m'':(Map B)) (mapcanon A m®
       (MapDomRestrBy A B (MapDomRestrBy A B m m'm'')=
       (MapDomRestrBy A B m (MapMerge B m' m'')).

Lemma MapDomRestrBy_By_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (mapcanon A m®
       (MapDomRestrBy A C (MapDomRestrBy A B m m'm'')=
       (MapDomRestrBy A B (MapDomRestrBy A C m m''m').

Lemma MapDomRestrBy_To_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (mapcanon A m®
       (MapDomRestrBy A C (MapDomRestrTo A B m m'm'')=
       (MapDomRestrTo A B m (MapDomRestrBy B C m' m'')).

Lemma MapDomRestrBy_To_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (mapcanon A m®
       (MapDomRestrBy A C (MapDomRestrTo A B m m'm'')=
       (MapDomRestrTo A B (MapDomRestrBy A C m m''m').

Lemma MapDomRestrTo_By_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (mapcanon A m®
       (MapDomRestrTo A C (MapDomRestrBy A B m m'm'')=
       (MapDomRestrTo A C m (MapDomRestrBy C B m'' m')).

Lemma MapDomRestrTo_By_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (mapcanon A m®
       (MapDomRestrTo A C (MapDomRestrBy A B m m'm'')=
       (MapDomRestrBy A B (MapDomRestrTo A C m m''m').

Lemma MapDomRestrTo_To_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (mapcanon A m®
       (MapDomRestrTo A C (MapDomRestrTo A B m m'm'')=
       (MapDomRestrTo A B (MapDomRestrTo A C m m''m').

Lemma MapMerge_DomRestrTo_c : (m,m':(Map A)) (m'':(Map B))
       (mapcanon A m® (mapcanon A m'®
         (MapDomRestrTo A B (MapMerge A m m'm'')=
         (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'')).

Lemma MapMerge_DomRestrBy_c : (m,m':(Map A)) (m'':(Map B))
       (mapcanon A m® (mapcanon A m'®
         (MapDomRestrBy A B (MapMerge A m m'm'')=
         (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'')).

Lemma MapDelta_nilpotent_c : (m:(Map A)) (mapcanon A m® (MapDelta A m m)=(M0 A).

Lemma MapDelta_as_Merge_c : (m,m':(Map A))
       (mapcanon A m® (mapcanon A m'®
         (MapDelta A m m')=(MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m)).

Lemma MapDelta_as_DomRestrBy_c : (m,m':(Map A))
       (mapcanon A m® (mapcanon A m'®
         (MapDelta A m m')=(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')).

Lemma MapDelta_as_DomRestrBy_2_c : (m,m':(Map A))
       (mapcanon A m® (mapcanon A m'®
         (MapDelta A m m')=(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m)).

Lemma MapDelta_sym_c : (m,m':(Map A))
       (mapcanon A m® (mapcanon A m'® (MapDelta A m m')=(MapDelta A m' m).

Lemma MapDom_Split_1_c : (m:(Map A)) (m':(Map B)) (mapcanon A m®
       m=(MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')).

Lemma MapDom_Split_2_c : (m:(Map A)) (m':(Map B)) (mapcanon A m®
       m=(MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m')).

Lemma MapDom_Split_3_c : (m:(Map A)) (m':(Map B)) (mapcanon A m®
       (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))=(M0 A).

Lemma Map_of_alist_of_Map_c : (m:(Map A)) (mapcanon A m®
       (Map_of_alist A (alist_of_Map A m))=m.

Lemma alist_of_Map_of_alist_c : (l:(alist A)) (alist_sorted_2 A l®
       (alist_of_Map A (Map_of_alist A l))=l.

Lemma MapSubset_antisym_c : (m:(Map A)) (m':(Map B))
       (mapcanon A m® (mapcanon B m'®
       (MapSubset A B m m'® (MapSubset B A m' m® (MapDom A m)=(MapDom B m').

Lemma FSubset_antisym_c : (s,s':FSet) (mapcanon unit s® (mapcanon unit s'®
       (MapSubset ? ? s s'® (MapSubset ? ? s' s® s=s'.

Lemma MapDisjoint_empty_c : (m:(Map A)) (mapcanon A m®
       (MapDisjoint A A m m® m=(M0 A).

Lemma MapDelta_disjoint_c : (m,m':(Map A)) (mapcanon A m® (mapcanon A m'®
       (MapDisjoint A A m m'® (MapDelta A m m')=(MapMerge A m m').

End MapC.

Lemma FSetDelta_assoc_c : (s,s',s'':FSet)
     (mapcanon unit s® (mapcanon unit s'® (mapcanon unit s''®
       (MapDelta ? (MapDelta ? s s's'')=(MapDelta ? s (MapDelta ? s' s'')).

Lemma FSet_ext_c : (s,s':FSet) (mapcanon unit s® (mapcanon unit s'®
       ((a:ad) (in_FSet a s)=(in_FSet a s')) ® s=s'.

Lemma FSetUnion_comm_c : (s,s':FSet) (mapcanon unit s® (mapcanon unit s'®
       (FSetUnion s s')=(FSetUnion s' s).

Lemma FSetUnion_assoc_c : (s,s',s'':FSet)
       (mapcanon unit s® (mapcanon unit s'® (mapcanon unit s''®
         (FSetUnion (FSetUnion s s's'')=(FSetUnion s (FSetUnion s' s'')).

Lemma FSetUnion_M0_s_c : (s:FSet) (FSetUnion (M0 units)=s.

Lemma FSetUnion_s_M0_c : (s:FSet) (FSetUnion s (M0 unit))=s.

Lemma FSetUnion_idempotent : (s:FSet) (mapcanon unit s® (FSetUnion s s)=s.

Lemma FSetInter_comm_c : (s,s':FSet) (mapcanon unit s® (mapcanon unit s'®
       (FSetInter s s')=(FSetInter s' s).

Lemma FSetInter_assoc_c : (s,s',s'':FSet)
       (mapcanon unit s®
         (FSetInter (FSetInter s s's'')=(FSetInter s (FSetInter s' s'')).

Lemma FSetInter_M0_s_c : (s:FSet) (FSetInter (M0 units)=(M0 unit).

Lemma FSetInter_s_M0_c : (s:FSet) (FSetInter s (M0 unit))=(M0 unit).

Lemma FSetInter_idempotent : (s:FSet) (mapcanon unit s® (FSetInter s s)=s.

Lemma FSetUnion_Inter_l_c : (s,s',s'':FSet) (mapcanon unit s® (mapcanon unit s''®
       (FSetUnion (FSetInter s s's'')=(FSetInter (FSetUnion s s'') (FSetUnion s' s'')).

Lemma FSetUnion_Inter_r : (s,s',s'':FSet) (mapcanon unit s® (mapcanon unit s'®
       (FSetUnion s (FSetInter s' s''))=(FSetInter (FSetUnion s s') (FSetUnion s s'')).

Lemma FSetInter_Union_l_c : (s,s',s'':FSet) (mapcanon unit s® (mapcanon unit s'®
       (FSetInter (FSetUnion s s's'')=(FSetUnion (FSetInter s s'') (FSetInter s' s'')).

Lemma FSetInter_Union_r : (s,s',s'':FSet) (mapcanon unit s® (mapcanon unit s'®
       (FSetInter s (FSetUnion s' s''))=(FSetUnion (FSetInter s s') (FSetInter s s'')).

Module Mapfold

Require Bool.
Require Sumbool.
Require ZArith.
Require Addr.
Require Adist.
Require Addec.
Require Map.
Require Fset.
Require Mapaxioms.
Require Mapiter.
Require Lsort.
Require Mapsubset.
Require PolyList.

Section MapFoldResults.

Variable A : Set.

Variable M : Set.
   Variable neutral : M.
   Variable op : M ® M ® M.

Variable nleft : (a:M) (op neutral a)=a.
   Variable nright : (a:M) (op a neutral)=a.
   Variable assoc : (a,b,c:M) (op (op a bc)=(op a (op b c)).

Lemma MapFold_ext : (f:ad®A®M) (m,m':(Map A)) (eqmap A m m'®
       (MapFold ? ? neutral op f m)=(MapFold ? ? neutral op f m').

Lemma MapFold_ext_f_1 : (m:(Map A)) (f,g:ad®A®M) (pf:ad®ad)
       ((a:ad) (y:A) (MapGet ? m a)=(SOME ? y® (f (pf ay)=(g (pf ay)) ®
         (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op g pf m).

Lemma MapFold_ext_f : (f,g:ad®A®M) (m:(Map A))
       ((a:ad) (y:A) (MapGet ? m a)=(SOME ? y® (f a y)=(g a y)) ®
         (MapFold ? ? neutral op f m)=(MapFold ? ? neutral op g m).

Lemma MapFold1_as_Fold_1 : (m:(Map A)) (f,f':ad®A®M) (pfpf':ad®ad)
       ((a:ad) (y:A) (f (pf ay)=(f' (pf' ay)) ®
         (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op f' pf' m).

Lemma MapFold1_as_Fold : (f:ad®A®M) (pf:ad®ad) (m:(Map A))
       (MapFold1 ? ? neutral op f pf m)=(MapFold ? ? neutral op [a:ad][y:A] (f (pf aym).

Lemma MapFold1_ext : (f:ad®A®M) (m,m':(Map A)) (eqmap A m m'® (pf:ad®ad)
       (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op f pf m').

Variable comm : (a,b:M) (op a b)=(op b a).

Lemma MapFold_Put_disjoint_1 : (p:positive)
         (f:ad®A®M) (pf:ad®ad) (a1,a2:ad) (y1,y2:A) (ad_xor a1 a2)=(ad_x p®
             (MapFold1 A M neutral op f pf (MapPut1 A a1 y1 a2 y2 p))=
             (op (f (pf a1y1) (f (pf a2y2)).

Lemma MapFold_Put_disjoint_2 : 
         (f:ad®A®M) (m:(Map A)) (a:ad) (y:A) (pf:ad®ad)
           (MapGet A m a)=(NONE A®
             (MapFold1 A M neutral op f pf (MapPut A m a y))=
             (op (f (pf ay) (MapFold1 A M neutral op f pf m)).

Lemma MapFold_Put_disjoint : 
         (f:ad®A®M) (m:(Map A)) (a:ad) (y:A)
           (MapGet A m a)=(NONE A®
             (MapFold A M neutral op f (MapPut A m a y))=(op (f a y) (MapFold A M neutral op f m)).

Lemma MapFold_Put_behind_disjoint_2 : 
         (f:ad®A®M) (m:(Map A)) (a:ad) (y:A) (pf:ad®ad)
           (MapGet A m a)=(NONE A®
             (MapFold1 A M neutral op f pf (MapPut_behind A m a y))=
             (op (f (pf ay) (MapFold1 A M neutral op f pf m)).

Lemma MapFold_Put_behind_disjoint : 
         (f:ad®A®M) (m:(Map A)) (a:ad) (y:A)
           (MapGet A m a)=(NONE A®
             (MapFold A M neutral op f (MapPut_behind A m a y))
             =(op (f a y) (MapFold A M neutral op f m)).

Lemma MapFold_Merge_disjoint_1 :
         (f:ad®A®M) (m1,m2:(Map A)) (pf:ad®ad)
           (MapDisjoint A A m1 m2®
             (MapFold1 A M neutral op f pf (MapMerge A m1 m2))=
             (op (MapFold1 A M neutral op f pf m1) (MapFold1 A M neutral op f pf m2)).

Lemma MapFold_Merge_disjoint :
         (f:ad®A®M) (m1,m2:(Map A))
           (MapDisjoint A A m1 m2®
             (MapFold A M neutral op f (MapMerge A m1 m2))=
             (op (MapFold A M neutral op f m1) (MapFold A M neutral op f m2)).

End MapFoldResults.

Section MapFoldDistr.

Variable A : Set.

Variable M : Set.
   Variable neutral : M.
   Variable op : M ® M ® M.

Variable M' : Set.
   Variable neutral' : M'.
   Variable op' : M' ® M' ® M'.

Variable N : Set.

Variable times : M ® N ® M'.

Variable absorb : (c:N)(times neutral c)=neutral'.
   Variable distr : (a,b:M) (c:N) (times (op a bc) = (op' (times a c) (times b c)).

Lemma MapFold_distr_r_1 : (f:ad®A®M) (m:(Map A)) (c:N) (pf:ad®ad)
       (times (MapFold1 A M neutral op f pf mc)=
       (MapFold1 A M' neutral' op' [a:ad][y:A] (times (f a ycpf m).

Lemma MapFold_distr_r : (f:ad®A®M) (m:(Map A)) (c:N)
       (times (MapFold A M neutral op f mc)=
       (MapFold A M' neutral' op' [a:ad][y:A] (times (f a ycm).

End MapFoldDistr.

Section MapFoldDistrL.

Variable A : Set.

Variable M : Set.
   Variable neutral : M.
   Variable op : M ® M ® M.

Variable M' : Set.
   Variable neutral' : M'.
   Variable op' : M' ® M' ® M'.

Variable N : Set.

Variable times : N ® M ® M'.

Variable absorb : (c:N)(times c neutral)=neutral'.
   Variable distr : (a,b:M) (c:N) (times c (op a b)) = (op' (times c a) (times c b)).

Lemma MapFold_distr_l : (f:ad®A®M) (m:(Map A)) (c:N)
       (times c (MapFold A M neutral op f m))=
       (MapFold A M' neutral' op' [a:ad][y:A] (times c (f a y)) m).

End MapFoldDistrL.

Section MapFoldExists.

Variable A : Set.

Lemma MapFold_orb_1 : (f:ad®A®bool) (m:(Map A)) (pf:ad®ad)
                       (MapFold1 A bool false orb f pf m)=
                       (Cases (MapSweep1 A f pf mof
                             (SOME _) Þ true
                           | _ Þ false
                         end).

Lemma MapFold_orb : (f:ad®A®bool) (m:(Map A)) (MapFold A bool false orb f m)=
                       (Cases (MapSweep A f mof
                             (SOME _) Þ true
                           | _ Þ false
                         end).

End MapFoldExists.

Section DMergeDef.

Variable A : Set.

Definition DMerge := (MapFold (Map A) (Map A) (M0 A) (MapMerge A) [_:ad][m:(Map A)] m).

Lemma in_dom_DMerge_1 : (m:(Map (Map A))) (a:ad) (in_dom A a (DMerge m))=
                               (Cases (MapSweep ? [_:ad][m0:(Map A)] (in_dom A a m0mof
                                     (SOME _) Þ true
                                   | _ Þ false
                                 end).

Lemma in_dom_DMerge_2 : (m:(Map (Map A))) (a:ad) (in_dom A a (DMerge m))=true ®
                                 {b:ad & {m0:(Map A) | (MapGet ? m b)=(SOME ? m0) &
                                                       (in_dom A a m0)=true}}.

Lemma in_dom_DMerge_3 : (m:(Map (Map A))) (a,b:ad) (m0:(Map A))
       (MapGet ? m a)=(SOME ? m0® (in_dom A b m0)=true ® (in_dom A b (DMerge m))=true.

End DMergeDef.

Module Maplists

Require Addr.
Require Addec.
Require Map.
Require Fset.
Require Mapaxioms.
Require Mapsubset.
Require Mapcard.
Require Mapcanon.
Require Mapc.
Require Bool.
Require Sumbool.
Require PolyList.
Require Arith.
Require Mapiter.
Require Mapfold.

Section MapLists.

Fixpoint ad_in_list [a:ad;l:(list ad)] : bool :=
     Cases l of
         nil Þ false
       | (cons a' l'Þ (orb (ad_eq a a') (ad_in_list a l'))
     end.

Fixpoint ad_list_stutters [l:(list ad)] : bool :=
     Cases l of
         nil Þ false
       | (cons a l'Þ (orb (ad_in_list a l') (ad_list_stutters l'))
     end.

Lemma ad_in_list_forms_circuit : (x:ad) (l:(list ad)) (ad_in_list x l)=true ®
           {l1 : (list ad) & {l2 : (list ad) | l=(app l1 (cons x l2))}}.

Lemma ad_list_stutters_has_circuit : (l:(list ad)) (ad_list_stutters l)=true ®
           {x:ad & {l0 : (list ad) & {l1 : (list ad) & {l2 : (list ad) |
             l=(app l0 (cons x (app l1 (cons x l2))))}}}}.

Fixpoint Elems [l:(list ad)] : FSet :=
     Cases l of
         nil Þ (M0 unit)
       | (cons a l'Þ (MapPut ? (Elems l'a tt)
     end.

Lemma Elems_canon : (l:(list ad)) (mapcanon ? (Elems l)).

Lemma Elems_app : (l,l':(list ad)) (Elems (app l l'))=(FSetUnion (Elems l) (Elems l')).

Lemma Elems_rev : (l:(list ad)) (Elems (rev l))=(Elems l).

Lemma ad_in_elems_in_list : (l:(list ad)) (a:ad) (in_FSet a (Elems l))=(ad_in_list a l).

Lemma ad_list_not_stutters_card : (l:(list ad)) (ad_list_stutters l)=false ®
           (length l)=(MapCard ? (Elems l)).

Lemma ad_list_card : (l:(list ad)) (le (MapCard ? (Elems l)) (length l)).

Lemma ad_list_stutters_card : (l:(list ad)) (ad_list_stutters l)=true ®
           (lt (MapCard ? (Elems l)) (length l)).

Lemma ad_list_not_stutters_card_conv : (l:(list ad)) (length l)=(MapCard ? (Elems l)) ®
       (ad_list_stutters l)=false.

Lemma ad_list_stutters_card_conv : (l:(list ad)) (lt (MapCard ? (Elems l)) (length l)) ®
       (ad_list_stutters l)=true.

Lemma ad_in_list_l : (l,l':(list ad)) (a:ad) (ad_in_list a l)=true ®
       (ad_in_list a (app l l'))=true.

Lemma ad_list_stutters_app_l : (l,l':(list ad)) (ad_list_stutters l)=true
           ® (ad_list_stutters (app l l'))=true.

Lemma ad_in_list_r : (l,l':(list ad)) (a:ad) (ad_in_list a l')=true ®
       (ad_in_list a (app l l'))=true.

Lemma ad_list_stutters_app_r : (l,l':(list ad)) (ad_list_stutters l')=true
           ® (ad_list_stutters (app l l'))=true.

Lemma ad_list_stutters_app_conv_l : (l,l':(list ad)) (ad_list_stutters (app l l'))=false
           ® (ad_list_stutters l)=false.

Lemma ad_list_stutters_app_conv_r : (l,l':(list ad)) (ad_list_stutters (app l l'))=false
           ® (ad_list_stutters l')=false.

Lemma ad_in_list_app_1 : (l,l':(list ad)) (x:ad) (ad_in_list x (app l (cons x l')))=true.

Lemma ad_in_list_app : (l,l':(list ad)) (x:ad)
           (ad_in_list x (app l l'))=(orb (ad_in_list x l) (ad_in_list x l')).

Lemma ad_in_list_rev : (l:(list ad)) (x:ad)
         (ad_in_list x (rev l))=(ad_in_list x l).

Lemma ad_list_has_circuit_stutters : (l0,l1,l2:(list ad)) (x:ad)
       (ad_list_stutters (app l0 (cons x (app l1 (cons x l2)))))=true.

Lemma ad_list_stutters_prev_l : (l,l':(list ad)) (x:ad) (ad_in_list x l)=true ®
           (ad_list_stutters (app l (cons x l')))=true.

Lemma ad_list_stutters_prev_conv_l : (l,l':(list ad)) (x:ad)
           (ad_list_stutters (app l (cons x l')))=false ® (ad_in_list x l)=false.

Lemma ad_list_stutters_prev_r : (l,l':(list ad)) (x:ad) (ad_in_list x l')=true ®
           (ad_list_stutters (app l (cons x l')))=true.

Lemma ad_list_stutters_prev_conv_r : (l,l':(list ad)) (x:ad)
           (ad_list_stutters (app l (cons x l')))=false ® (ad_in_list x l')=false.

Lemma ad_list_Elems : (l,l':(list ad)) (MapCard ? (Elems l))=(MapCard ? (Elems l')) ®
       (length l)=(length l'®
         (ad_list_stutters l)=(ad_list_stutters l').

Lemma ad_list_app_length : (l,l':(list ad)) (length (app l l'))=(plus (length l) (length l')).

Lemma ad_list_stutters_permute : (l,l':(list ad))
       (ad_list_stutters (app l l'))=(ad_list_stutters (app l' l)).

Lemma ad_list_rev_length : (l:(list ad)) (length (rev l))=(length l).

Lemma ad_list_stutters_rev : (l:(list ad)) (ad_list_stutters (rev l))=(ad_list_stutters l).

Lemma ad_list_app_rev : (l,l':(list ad)) (x:ad)
           (app (rev l) (cons x l'))=(app (rev (cons x l)) l').

Section ListOfDomDef.

Variable A : Set.

Definition ad_list_of_dom :=
       (MapFold A (list ad) (nil ad) (!app ad) [a:ad][_:A] (cons a (nil ad))).

Lemma ad_in_list_of_dom_in_dom : (m:(Map A)) (a:ad)
       (ad_in_list a (ad_list_of_dom m))=(in_dom A a m).

Lemma Elems_of_list_of_dom : (m:(Map A)) (eqmap unit (Elems (ad_list_of_dom m)) (MapDom A m)).

Lemma Elems_of_list_of_dom_c : (m:(Map A)) (mapcanon A m®
       (Elems (ad_list_of_dom m))=(MapDom A m).

Lemma ad_list_of_dom_card_1 : (m:(Map A)) (pf:ad®ad)
       (length (MapFold1 A (list ad) (nil ad) (app 1!ad) [a:ad][_:A](cons a (nil ad)) pf m))
       =(MapCard A m).

Lemma ad_list_of_dom_card : (m:(Map A)) (length (ad_list_of_dom m))=(MapCard A m).

Lemma ad_list_of_dom_not_stutters : (m:(Map A)) (ad_list_stutters (ad_list_of_dom m))=false.

End ListOfDomDef.

Lemma ad_list_of_dom_Dom_1 : (A:Set)
     (m:(Map A)) (pf:ad®ad)
       (MapFold1 A (list ad) (nil ad) (app 1!ad)
         [a:ad][_:A](cons a (nil ad)) pf m)
       =(MapFold1 unit (list ad) (nil ad) (app 1!ad)
           [a:ad][_:unit](cons a (nil ad)) pf (MapDom A m)).

Lemma ad_list_of_dom_Dom : (A:Set) (m:(Map A))
       (ad_list_of_dom A m)=(ad_list_of_dom unit (MapDom A m)).

End MapLists.

Module Allmaps

Require Export Addr.
Require Export Adist.
Require Export Addec.
Require Export Map.

Require Export Fset.
Require Export Mapaxioms.
Require Export Mapiter.

Require Export Mapsubset.
Require Export Lsort.
Require Export Mapfold.
Require Export Mapcard.
Require Export Mapcanon.
Require Export Mapc.
Require Export Maplists.
Require Export Adalloc.



10   Index




1
This research was partly supported by ESPRIT Basic Research Action ``Types''

This document was translated from LATEX by HEVEA.