1 (**************************************************************************)
4 (* ||A|| A project by Andrea Asperti *)
6 (* ||I|| Developers: *)
7 (* ||T|| The HELM team. *)
8 (* ||A|| http://helm.cs.unibo.it *)
10 (* \ / This file is distributed under the terms of the *)
11 (* v GNU General Public License Version 2 *)
13 (**************************************************************************)
15 set "baseuri" "cic:/matita/decidable_kit/list_aux/".
17 include "list/list.ma".
18 include "decidable_kit/eqtype.ma".
19 include "nat/plus.ma".
21 (* ### some functions on lists (some can be moved to list.ma ### *)
23 let rec foldr (A,B:Type) (f : A → B → B) (b : B) (l : list A) on l : B :=
24 match l with [ nil ⇒ b | (cons a l) ⇒ f a (foldr ? ? f b l)].
26 definition length ≝ λT:Type.λl:list T.foldr T nat (λx,c.S c) O l.
28 definition count : ∀T : eqType.∀f : T → bool.∀l : list T. nat :=
30 foldr T nat (λx,acc. match (f x) with [ true ⇒ S acc | false ⇒ acc ]) O l.
32 let rec mem (d : eqType) (x : d) (l : list d) on l : bool ≝
35 | cons y tl ⇒ orb (cmp d x y) (mem d x tl)].
37 definition iota : nat → nat → list nat ≝
38 λn,m. nat_rect (λ_.list ?) (nil ?) (λx,acc.cons ? (n+x) acc) m.
40 let rec map (A,B:Type) (f: A → B) (l : list A) on l : list B ≝
41 match l with [ nil ⇒ nil ? | cons x tl ⇒ f x :: (map A B f tl)].
43 (* ### induction principle for functions visiting 2 lists in parallel *)
45 ∀T1,T2:Type.∀l1:list T1.∀l2:list T2.∀P:list T1 → list T2 → Prop.
46 length ? l1 = length ? l2 →
48 (∀tl1,tl2,hd1,hd2. P tl1 tl2 → P (hd1::tl1) (hd2::tl2)) →
50 intros (T1 T2 l1 l2 P Hl Pnil Pcons);
51 generalize in match Hl; clear Hl; generalize in match l2; clear l2;
52 elim l1 1 (l2 x1); [ cases l2; intros (Hl); [assumption| destruct Hl]]
53 intros 3 (tl1 IH l2); cases l2; [1: simplify; intros 1 (Hl); destruct Hl]
54 intros 1 (Hl); apply Pcons; apply IH; destruct Hl; assumption;
57 lemma eq_map : ∀A,B,f,g,l. (∀x.f x = g x) → map A B f l = map A B g l.
58 intros (A B f g l Efg); elim l; simplify; [1: reflexivity ];
59 rewrite > (Efg t); rewrite > H; reflexivity;
62 (* ### eqtype for lists ### *)
63 let rec lcmp (d : eqType) (l1,l2 : list d) on l1 : bool ≝
65 [ nil ⇒ match l2 with [ nil ⇒ true | (cons _ _) ⇒ false]
66 | (cons x1 tl1) ⇒ match l2 with
67 [ nil ⇒ false | (cons x2 tl2) ⇒ andb (cmp d x1 x2) (lcmp d tl1 tl2)]].
70 ∀d:eqType.∀l1,l2:list d.
71 lcmp ? l1 l2 = true → length ? l1 = length ? l2.
72 intros 2 (d l1); elim l1 1 (l2 x1);
73 [1: cases l2; simplify; intros; [reflexivity|destruct H]
74 |2: intros 3 (tl1 IH l2); cases (l2); intros; [1:destruct H]
75 simplify; (* XXX la apply non fa simplify? *)
76 apply congr_S; apply (IH l);
77 (* XXX qualcosa di enorme e' rotto! la regola di convertibilita?! *)
78 simplify in H; cases (b2pT ? ? (andbP ? ?) H); assumption]
81 lemma lcmpP : ∀d:eqType.∀l1,l2:list d. eq_compatible (list d) l1 l2 (lcmp d l1 l2).
83 generalize in match (refl_eq ? (lcmp d l1 l2));
84 generalize in match (lcmp d l1 l2) in ⊢ (? ? ? % → %); intros 1 (c);
85 cases c; intros (H); [ apply reflect_true | apply reflect_false ]
86 [ lapply (lcmp_length ? ? ? H) as Hl;
87 generalize in match H; clear H;
88 apply (list_ind2 ? ? ? ? ? Hl); [1: intros; reflexivity]
89 simplify; intros (tl1 tl2 hd1 hd2 IH H); cases (b2pT ? ? (andbP ? ?) H);
90 rewrite > (IH H2); rewrite > (b2pT ? ? (eqP d ? ?) H1); reflexivity
91 | generalize in match H; clear H; generalize in match l2; clear l2;
93 [ cases l1; [intros; destruct H | unfold Not; intros; destruct H1;]
94 | intros 3 (tl1 IH l2); cases l2;
95 [ unfold Not; intros; destruct H1;
97 cases (b2pT ? ? (andbPF ? ?) (p2bT ? ? (negbP ?) H)); clear H;
98 [ intros; lapply (b2pF ? ? (eqP d ? ?) H1) as H'; clear H1;
99 destruct H; rewrite > Hcut in H'; apply H'; reflexivity;
100 | intros; lapply (IH ? H1) as H'; destruct H;
101 rewrite > Hcut1 in H'; apply H'; reflexivity;]]]]
104 definition list_eqType : eqType → eqType ≝ λd:eqType.mk_eqType ? ? (lcmpP d).