summaryrefslogtreecommitdiff
path: root/test-suite/modules/Przyklad.v
blob: ece1b47b4f1c944f0c479793199136820c20898e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
Definition ifte (T : Set) (A B : Prop) (s : {A} + {B})
  (th el : T) := if s then th else el.

Arguments ifte : default implicits.

Lemma Reflexivity_provable :
 forall (A : Set) (a : A) (s : {a = a} + {a <> a}),
 exists x : _, s = left _ x.
intros.
elim s.
intro x.
split with x; reflexivity.

intro.
 absurd (a = a); auto.

Qed.

Lemma Disequality_provable :
 forall (A : Set) (a b : A),
 a <> b -> forall s : {a = b} + {a <> b}, exists x : _, s = right _ x.
intros.
elim s.
intro.
 absurd (a = a); auto.

intro.
split with b0; reflexivity.

Qed.

Module Type ELEM.
  Parameter T : Set.
  Parameter eq_dec : forall a a' : T, {a = a'} + {a <> a'}.
End ELEM.

Module Type SET (Elt: ELEM).
  Parameter T : Set.
  Parameter empty : T.
  Parameter add : Elt.T -> T -> T.
  Parameter find : Elt.T -> T -> bool.

  (* Axioms *)

  Axiom find_empty_false : forall e : Elt.T, find e empty = false.

  Axiom find_add_true : forall (s : T) (e : Elt.T), find e (add e s) = true.

  Axiom
    find_add_false :
      forall (s : T) (e e' : Elt.T), e <> e' -> find e (add e' s) = find e s.

End SET.

Module FuncDict (E: ELEM).
  Definition T := E.T -> bool.
  Definition empty (e' : E.T) := false.
  Definition find (e' : E.T) (s : T) := s e'.
  Definition add (e : E.T) (s : T) (e' : E.T) :=
    ifte (E.eq_dec e e') true (find e' s).

  Lemma find_empty_false : forall e : E.T, find e empty = false.
    auto.
  Qed.

  Lemma find_add_true : forall (s : T) (e : E.T), find e (add e s) = true.

    intros.
    unfold find, add.
    elim (Reflexivity_provable _ _ (E.eq_dec e e)).
    intros.
     rewrite H.
    auto.

  Qed.

  Lemma find_add_false :
   forall (s : T) (e e' : E.T), e <> e' -> find e (add e' s) = find e s.
    intros.
    unfold add, find.
    cut (exists x : _, E.eq_dec e' e = right _ x).
    intros.
    elim H0.
    intros.
     rewrite H1.
    unfold ifte.
    reflexivity.

    apply Disequality_provable.
    auto.

  Qed.

End FuncDict.

Module F : SET := FuncDict.


Module Nat.
  Definition T := nat.
  Lemma eq_dec : forall a a' : T, {a = a'} + {a <> a'}.
     decide equality.
  Qed.
End Nat.


Module SetNat := F Nat.


Lemma no_zero_in_empty : SetNat.find 0 SetNat.empty = false.
apply SetNat.find_empty_false.
Qed.

(***************************************************************************)
Module Lemmas (G: SET) (E: ELEM).

  Module ESet := G E.

  Lemma commute :
   forall (S : ESet.T) (a1 a2 : E.T),
   let S1 := ESet.add a1 (ESet.add a2 S) in
   let S2 := ESet.add a2 (ESet.add a1 S) in
   forall a : E.T, ESet.find a S1 = ESet.find a S2.

    intros.
    unfold S1, S2.
    elim (E.eq_dec a a1); elim (E.eq_dec a a2); intros H1 H2;
     try  rewrite <- H1; try  rewrite <- H2;
     repeat
      (try ( rewrite ESet.find_add_true; auto);
        try ( rewrite ESet.find_add_false; auto); auto).
  Qed.
End Lemmas.


Inductive list (A : Set) : Set :=
  | nil : list A
  | cons : A -> list A -> list A.

Module ListDict (E: ELEM).
  Definition T := list E.T.
  Definition elt := E.T.

  Definition empty := nil elt.
  Definition add (e : elt) (s : T) := cons elt e s.
  Fixpoint find (e : elt) (s : T) {struct s} : bool :=
    match s with
    | nil _ => false
    | cons _ e' s' => ifte (E.eq_dec e e') true (find e s')
    end.

  Definition find_empty_false (e : elt) := refl_equal false.

  Lemma find_add_true : forall (s : T) (e : E.T), find e (add e s) = true.
    intros.
    simpl.
    elim (Reflexivity_provable _ _ (E.eq_dec e e)).
    intros.
     rewrite H.
    auto.

  Qed.


  Lemma find_add_false :
   forall (s : T) (e e' : E.T), e <> e' -> find e (add e' s) = find e s.
    intros.
    simpl.
    elim (Disequality_provable _ _ _ H (E.eq_dec e e')).
    intros.
     rewrite H0.
    simpl.
    reflexivity.
  Qed.


End ListDict.


Module L : SET := ListDict.