~ubuntu-branches/ubuntu/wily/coq-doc/wily

« back to all changes in this revision

Viewing changes to RecTutorial/RecTutorial.v

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu, Stéphane Glondu, Samuel Mimram
  • Date: 2010-01-07 22:50:39 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20100107225039-n3cq82589u0qt0s2
Tags: 8.2pl1-1
[ Stéphane Glondu ]
* New upstream release (Closes: #563669)
  - remove patches
* Packaging overhaul:
  - use git, advertise it in Vcs-* fields of debian/control
  - use debhelper 7 and dh with override
  - use source format 3.0 (quilt)
* debian/control:
  - set Maintainer to d-o-m, set Uploaders to Sam and myself
  - add Homepage field
  - bump Standards-Version to 3.8.3
* Register PDF documentation into doc-base
* Add debian/watch
* Update debian/copyright

[ Samuel Mimram ]
* Change coq-doc's description to mention that it provides documentation in
  pdf format, not postscript, closes: #543545.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
Check (forall A:Type, (exists x:A, forall (y:A), x <> y) -> 2 = 3).
2
 
 
3
 
 
4
 
 
5
 
Inductive nat : Set := 
6
 
 | O : nat 
7
 
 | S : nat->nat.
8
 
Check nat.
9
 
Check O.
10
 
Check S.
11
 
 
12
 
Reset nat.
13
 
Print nat.
14
 
 
15
 
 
16
 
Print le.
17
 
 
18
 
Theorem zero_leq_three: 0 <= 3.
19
 
 
20
 
Proof.
21
 
 constructor 2. 
22
 
 constructor 2.  
23
 
 constructor 2.
24
 
 constructor 1.
25
 
 
26
 
Qed.
27
 
 
28
 
Print zero_leq_three.
29
 
 
30
 
 
31
 
Lemma zero_leq_three': 0 <= 3.
32
 
 repeat constructor.
33
 
Qed.
34
 
 
35
 
 
36
 
Lemma zero_lt_three : 0 < 3.
37
 
Proof.
38
 
 repeat constructor. 
39
 
Qed.
40
 
 
41
 
Print zero_lt_three.
42
 
 
43
 
Inductive le'(n:nat):nat -> Prop :=
44
 
 | le'_n : le' n n
45
 
 | le'_S : forall p, le' (S n) p -> le' n p.
46
 
 
47
 
Hint Constructors le'.
48
 
 
49
 
 
50
 
Require Import List.
51
 
 
52
 
Print list.
53
 
 
54
 
Check list.
55
 
 
56
 
Check (nil (A:=nat)).
57
 
 
58
 
Check (nil (A:= nat -> nat)).
59
 
 
60
 
Check (fun A: Type => (cons (A:=A))).
61
 
 
62
 
Check (cons 3 (cons 2 nil)).
63
 
 
64
 
Check (nat :: bool ::nil).
65
 
 
66
 
Check ((3<=4) :: True ::nil).
67
 
 
68
 
Check (Prop::Set::nil).
69
 
 
70
 
Require Import Bvector.
71
 
 
72
 
Print vector.
73
 
 
74
 
Check (Vnil nat).
75
 
 
76
 
Check (fun (A:Type)(a:A)=> Vcons _ a _ (Vnil _)).
77
 
 
78
 
Check (Vcons _ 5 _ (Vcons _ 3 _ (Vnil _))).
79
 
 
80
 
Lemma eq_3_3 : 2 + 1 = 3.
81
 
Proof.
82
 
 reflexivity.
83
 
Qed.
84
 
Print eq_3_3.
85
 
 
86
 
Lemma eq_proof_proof : refl_equal (2*6) = refl_equal (3*4).
87
 
Proof.
88
 
 reflexivity.
89
 
Qed.
90
 
Print eq_proof_proof.
91
 
 
92
 
Lemma eq_lt_le : ( 2 < 4) = (3 <= 4).
93
 
Proof.
94
 
 reflexivity.
95
 
Qed.
96
 
 
97
 
Lemma eq_nat_nat : nat = nat.
98
 
Proof.
99
 
 reflexivity.
100
 
Qed.
101
 
 
102
 
Lemma eq_Set_Set : Set = Set.
103
 
Proof.
104
 
 reflexivity.
105
 
Qed.
106
 
 
107
 
Lemma eq_Type_Type : Type = Type.
108
 
Proof.
109
 
 reflexivity.
110
 
Qed.
111
 
 
112
 
 
113
 
Check (2 + 1 = 3).
114
 
 
115
 
 
116
 
Check (Type = Type).
117
 
 
118
 
Goal Type = Type.
119
 
reflexivity.
120
 
Qed.
121
 
 
122
 
 
123
 
Print or.
124
 
 
125
 
Print and.
126
 
 
127
 
 
128
 
Print sumbool.
129
 
 
130
 
Print ex.
131
 
 
132
 
Require Import ZArith.
133
 
Require Import Compare_dec.
134
 
 
135
 
Check le_lt_dec.
136
 
 
137
 
Definition max (n p :nat) := match le_lt_dec n p with 
138
 
                             | left _ => p
139
 
                             | right _ => n
140
 
                             end.
141
 
 
142
 
Theorem le_max : forall n p, n <= p -> max n p = p.
143
 
Proof.
144
 
 intros n p ; unfold max ; case (le_lt_dec n p); simpl.
145
 
 trivial.
146
 
 intros; absurd (p < p); eauto with arith.
147
 
Qed.
148
 
 
149
 
Extraction max.
150
 
 
151
 
 
152
 
 
153
 
 
154
 
 
155
 
 
156
 
Inductive tree(A:Type)   : Type :=
157
 
    node : A -> forest A -> tree A 
158
 
with
159
 
  forest (A: Type)    : Type := 
160
 
    nochild  : forest A |
161
 
    addchild : tree A -> forest A -> forest A.
162
 
 
163
 
 
164
 
 
165
 
 
166
 
 
167
 
Inductive 
168
 
  even    : nat->Prop :=
169
 
    evenO : even  O |
170
 
    evenS : forall n, odd n -> even (S n)
171
 
with
172
 
  odd    : nat->Prop :=
173
 
    oddS : forall n, even n -> odd (S n).
174
 
 
175
 
Lemma odd_49 : odd (7 * 7).
176
 
 simpl; repeat constructor.
177
 
Qed.
178
 
 
179
 
 
180
 
 
181
 
Definition nat_case := 
182
 
 fun (Q : Type)(g0 : Q)(g1 : nat -> Q)(n:nat) =>
183
 
    match n return Q with
184
 
    | 0 => g0 
185
 
    | S p => g1 p 
186
 
    end.
187
 
 
188
 
Eval simpl in (nat_case nat 0 (fun p => p) 34).
189
 
 
190
 
Eval simpl in (fun g0 g1 => nat_case nat g0 g1 34).
191
 
 
192
 
Eval simpl in (fun g0 g1 => nat_case nat g0 g1 0).
193
 
 
194
 
 
195
 
Definition pred (n:nat) := match n with O => O | S m => m end.
196
 
 
197
 
Eval simpl in pred 56.
198
 
 
199
 
Eval simpl in pred 0.
200
 
 
201
 
Eval simpl in fun p => pred (S p).
202
 
 
203
 
 
204
 
Definition xorb (b1 b2:bool) :=
205
 
match b1, b2 with 
206
 
 | false, true => true
207
 
 | true, false => true
208
 
 | _ , _       => false
209
 
end.
210
 
 
211
 
 
212
 
 Definition pred_spec (n:nat) := {m:nat | n=0 /\ m=0  \/ n = S m}.
213
 
  
214
 
 
215
 
 Definition predecessor : forall n:nat, pred_spec n.
216
 
  intro n;case n.
217
 
  unfold pred_spec;exists 0;auto.
218
 
  unfold pred_spec; intro n0;exists n0; auto.
219
 
 Defined.
220
 
 
221
 
Print predecessor.
222
 
 
223
 
Extraction predecessor.
224
 
 
225
 
Theorem nat_expand : 
226
 
  forall n:nat, n = match n with 0 => 0 | S p => S p end.
227
 
 intro n;case n;simpl;auto.
228
 
Qed.
229
 
 
230
 
Check (fun p:False => match p return 2=3 with end).
231
 
 
232
 
Theorem fromFalse : False -> 0=1.
233
 
 intro absurd. 
234
 
 contradiction.
235
 
Qed.
236
 
 
237
 
Section equality_elimination.
238
 
 Variables (A: Type)
239
 
           (a b : A)
240
 
           (p : a = b)
241
 
           (Q : A -> Type).
242
 
 Check (fun H : Q a =>
243
 
  match p in (eq _  y) return Q y with
244
 
     refl_equal => H
245
 
  end).
246
 
 
247
 
End equality_elimination.
248
 
 
249
 
           
250
 
Theorem trans : forall n m p:nat, n=m -> m=p -> n=p.
251
 
Proof.
252
 
 intros n m p eqnm.  
253
 
 case eqnm.
254
 
 trivial.        
255
 
Qed.
256
 
 
257
 
Lemma Rw :  forall x y: nat, y = y * x -> y * x * x = y.
258
 
 intros x y e; do 2 rewrite <- e.
259
 
 reflexivity.
260
 
Qed.
261
 
 
262
 
 
263
 
Require Import Arith.
264
 
 
265
 
Check mult_1_l.
266
 
(*
267
 
mult_1_l
268
 
     : forall n : nat, 1 * n = n
269
 
*)
270
 
 
271
 
Check mult_plus_distr_r.
272
 
(*
273
 
mult_plus_distr_r
274
 
     : forall n m p : nat, (n + m) * p = n * p + m * p
275
 
 
276
 
*)
277
 
 
278
 
Lemma mult_distr_S : forall n p : nat, n * p + p = (S n)* p.
279
 
 simpl;auto with arith.
280
 
Qed.
281
 
 
282
 
Lemma four_n : forall n:nat, n+n+n+n = 4*n.
283
 
 intro n;rewrite <- (mult_1_l n).
284
 
 
285
 
 Undo.
286
 
 intro n; pattern n at 1.
287
 
 
288
 
 
289
 
 rewrite <- mult_1_l.
290
 
 repeat rewrite   mult_distr_S.
291
 
 trivial.
292
 
Qed.
293
 
 
294
 
 
295
 
Section Le_case_analysis.
296
 
 Variables (n p : nat)
297
 
           (H : n <= p)
298
 
           (Q : nat -> Prop)
299
 
           (H0 : Q n)
300
 
           (HS : forall m, n <= m -> Q (S m)).
301
 
 Check (
302
 
    match H in (_ <= q) return (Q q)  with
303
 
    | le_n => H0
304
 
    | le_S m Hm => HS m Hm
305
 
    end
306
 
  ).
307
 
 
308
 
 
309
 
End Le_case_analysis.
310
 
 
311
 
 
312
 
Lemma predecessor_of_positive : forall n, 1 <= n ->  exists p:nat, n = S p.
313
 
Proof.
314
 
 intros n  H; case H.
315
 
 exists 0; trivial.
316
 
 intros m Hm; exists m;trivial.
317
 
Qed.
318
 
 
319
 
Definition Vtail_total 
320
 
   (A : Type) (n : nat) (v : vector A n) : vector A (pred n):=
321
 
match v in (vector _ n0) return (vector A (pred n0)) with
322
 
| Vnil => Vnil A
323
 
| Vcons _ n0 v0 => v0
324
 
end.
325
 
 
326
 
Definition Vtail' (A:Type)(n:nat)(v:vector A n) : vector A (pred n).
327
 
 intros A n v; case v.  
328
 
 simpl.
329
 
 exact (Vnil A).
330
 
 simpl.
331
 
 auto.
332
 
Defined.
333
 
 
334
 
(*
335
 
Inductive Lambda : Set :=
336
 
  lambda : (Lambda -> False) -> Lambda. 
337
 
 
338
 
 
339
 
Error: Non strictly positive occurrence of "Lambda" in
340
 
 "(Lambda -> False) -> Lambda"
341
 
 
342
 
*)
343
 
 
344
 
Section Paradox.
345
 
 Variable Lambda : Set.
346
 
 Variable lambda : (Lambda -> False) ->Lambda.
347
 
 
348
 
 Variable matchL  : Lambda -> forall Q:Prop, ((Lambda ->False) -> Q) -> Q.
349
 
 (*
350
 
  understand matchL Q l (fun h : Lambda -> False => t)
351
 
 
352
 
  as match l return Q with lambda h => t end 
353
 
 *)
354
 
 
355
 
 Definition application (f x: Lambda) :False :=
356
 
   matchL f False (fun h => h x).
357
 
 
358
 
 Definition Delta : Lambda := lambda (fun x : Lambda => application x x).
359
 
 
360
 
 Definition loop : False := application Delta Delta.
361
 
 
362
 
 Theorem two_is_three : 2 = 3.
363
 
 Proof.
364
 
  elim loop.
365
 
 Qed.
366
 
 
367
 
End Paradox.
368
 
 
369
 
 
370
 
Require Import ZArith.
371
 
 
372
 
 
373
 
 
374
 
Inductive itree : Set :=
375
 
| ileaf : itree
376
 
| inode : Z-> (nat -> itree) -> itree.
377
 
 
378
 
Definition isingle l := inode l (fun i => ileaf).
379
 
 
380
 
Definition t1 := inode 0 (fun n => isingle (Z_of_nat (2*n))).
381
 
 
382
 
Definition t2 := inode 0 
383
 
                      (fun n : nat => 
384
 
                               inode (Z_of_nat n)
385
 
                                     (fun p => isingle (Z_of_nat (n*p)))).
386
 
 
387
 
 
388
 
Inductive itree_le : itree-> itree -> Prop :=
389
 
  | le_leaf : forall t, itree_le  ileaf t
390
 
  | le_node  : forall l l' s s', 
391
 
                       Zle l l' -> 
392
 
                      (forall i, exists j:nat, itree_le (s i) (s' j)) -> 
393
 
                      itree_le  (inode  l s) (inode  l' s').
394
 
 
395
 
 
396
 
Theorem itree_le_trans : 
397
 
  forall t t', itree_le t t' ->
398
 
               forall t'', itree_le t' t'' -> itree_le t t''.
399
 
 induction t.
400
 
 constructor 1.
401
 
 
402
 
 intros t'; case t'.
403
 
 inversion 1.
404
 
 intros z0 i0 H0.
405
 
 intro t'';case t''.
406
 
 inversion 1.
407
 
 intros.
408
 
 inversion_clear H1.
409
 
 constructor 2.
410
 
 inversion_clear H0;eauto with zarith.
411
 
 inversion_clear H0.
412
 
 intro i2; case (H4 i2).
413
 
 intros.
414
 
 generalize (H i2 _ H0). 
415
 
 intros.
416
 
 case (H3 x);intros.
417
 
 generalize (H5 _ H6).
418
 
 exists x0;auto.
419
 
Qed.
420
 
 
421
 
 
422
 
 
423
 
Inductive itree_le' : itree-> itree -> Prop :=
424
 
  | le_leaf' : forall t, itree_le'  ileaf t
425
 
  | le_node' : forall l l' s s' g, 
426
 
                       Zle l l' ->  
427
 
                      (forall i, itree_le' (s i) (s' (g i))) -> 
428
 
                       itree_le'  (inode  l s) (inode  l' s').
429
 
 
430
 
 
431
 
 
432
 
 
433
 
 
434
 
Lemma t1_le_t2 : itree_le t1 t2.
435
 
 unfold t1, t2.
436
 
 constructor.
437
 
 auto with zarith.
438
 
 intro i; exists (2 * i).
439
 
 unfold isingle. 
440
 
 constructor.
441
 
 auto with zarith.
442
 
 exists i;constructor.
443
 
Qed.
444
 
 
445
 
 
446
 
 
447
 
Lemma t1_le'_t2 :  itree_le' t1 t2.
448
 
 unfold t1, t2.
449
 
 constructor 2  with (fun i : nat => 2 * i).
450
 
 auto with zarith.
451
 
 unfold isingle;
452
 
 intro i ; constructor 2 with (fun i :nat => i).
453
 
 auto with zarith.
454
 
 constructor .
455
 
Qed.
456
 
 
457
 
 
458
 
Require Import List.
459
 
 
460
 
Inductive ltree  (A:Set) : Set :=  
461
 
          lnode   : A -> list (ltree A) -> ltree A.
462
 
 
463
 
Inductive prop : Prop :=
464
 
 prop_intro : Prop -> prop.
465
 
 
466
 
Check (prop_intro prop).
467
 
 
468
 
Inductive ex_Prop  (P : Prop -> Prop) : Prop :=
469
 
  exP_intro : forall X : Prop, P X -> ex_Prop P.
470
 
 
471
 
Lemma ex_Prop_inhabitant : ex_Prop (fun P => P -> P).
472
 
Proof.
473
 
  exists (ex_Prop (fun P => P -> P)).
474
 
 trivial.
475
 
Qed.
476
 
 
477
 
 
478
 
 
479
 
 
480
 
(*
481
 
 
482
 
Check (fun (P:Prop->Prop)(p: ex_Prop P) =>
483
 
      match p with exP_intro X HX => X end).
484
 
Error:
485
 
Incorrect elimination of "p" in the inductive type  
486
 
"ex_Prop", the return type has sort "Type" while it should be 
487
 
"Prop"
488
 
 
489
 
Elimination of an inductive object of sort "Prop"
490
 
is not allowed on a predicate in sort "Type"
491
 
because proofs can be eliminated only to build proofs
492
 
 
493
 
*)
494
 
 
495
 
 
496
 
Inductive  typ : Type := 
497
 
  typ_intro : Type -> typ. 
498
 
 
499
 
Definition typ_inject: typ.
500
 
split. 
501
 
exact typ.
502
 
(*
503
 
Defined.
504
 
 
505
 
Error: Universe Inconsistency.
506
 
*)
507
 
Abort.
508
 
(*
509
 
 
510
 
Inductive aSet : Set :=
511
 
  aSet_intro: Set -> aSet.
512
 
 
513
 
 
514
 
User error: Large non-propositional inductive types must be in Type
515
 
 
516
 
*)
517
 
 
518
 
Inductive ex_Set  (P : Set -> Prop) : Type :=
519
 
  exS_intro : forall X : Set, P X -> ex_Set P.
520
 
 
521
 
 
522
 
Inductive comes_from_the_left (P Q:Prop): P \/ Q -> Prop :=
523
 
  c1 : forall p, comes_from_the_left P Q (or_introl (A:=P) Q p).
524
 
 
525
 
Goal (comes_from_the_left _ _ (or_introl  True I)).
526
 
split.
527
 
Qed.
528
 
 
529
 
Goal ~(comes_from_the_left _ _ (or_intror True I)).
530
 
 red;inversion 1.
531
 
 (* discriminate H0.
532
 
 *)
533
 
Abort.
534
 
 
535
 
Reset comes_from_the_left.
536
 
 
537
 
(*
538
 
 
539
 
 
540
 
 
541
 
 
542
 
 
543
 
 
544
 
 Definition comes_from_the_left (P Q:Prop)(H:P \/ Q): Prop :=
545
 
  match H with
546
 
         |  or_introl p => True 
547
 
         |  or_intror q => False
548
 
  end.
549
 
 
550
 
Error:
551
 
Incorrect elimination of "H" in the inductive type  
552
 
"or", the return type has sort "Type" while it should be 
553
 
"Prop"
554
 
 
555
 
Elimination of an inductive object of sort "Prop"
556
 
is not allowed on a predicate in sort "Type"
557
 
because proofs can be eliminated only to build proofs
558
 
 
559
 
*)
560
 
 
561
 
Definition comes_from_the_left_sumbool
562
 
            (P Q:Prop)(x:{P}+{Q}): Prop :=
563
 
  match x with
564
 
         |  left  p => True 
565
 
         |  right q => False
566
 
  end.
567
 
 
568
 
 
569
 
 
570
 
                    
571
 
Close Scope Z_scope.
572
 
 
573
 
 
574
 
 
575
 
 
576
 
 
577
 
Theorem S_is_not_O : forall n, S n <> 0. 
578
 
 
579
 
Definition Is_zero (x:nat):= match x with 
580
 
                                     | 0 => True  
581
 
                                     | _ => False
582
 
                             end.
583
 
 Lemma O_is_zero : forall m, m = 0 -> Is_zero m.
584
 
 Proof.
585
 
  intros m H; subst m.
586
 
  (*  
587
 
  ============================
588
 
   Is_zero 0
589
 
  *)
590
 
  simpl;trivial.
591
 
 Qed.
592
 
 
593
 
 red; intros n Hn.
594
 
 apply O_is_zero with (m := S n).
595
 
 assumption.
596
 
Qed.
597
 
 
598
 
Theorem disc2 : forall n, S (S n) <> 1. 
599
 
Proof.
600
 
 intros n Hn; discriminate.
601
 
Qed.
602
 
 
603
 
 
604
 
Theorem disc3 : forall n, S (S n) = 0 -> forall Q:Prop, Q.
605
 
Proof.
606
 
  intros n Hn Q.
607
 
  discriminate.
608
 
Qed.
609
 
 
610
 
 
611
 
 
612
 
Theorem inj_succ  : forall n m, S n = S m -> n = m.
613
 
Proof.
614
 
 
615
 
 
616
 
Lemma inj_pred : forall n m, n = m -> pred n = pred m.
617
 
Proof.
618
 
 intros n m eq_n_m.
619
 
 rewrite eq_n_m.
620
 
 trivial.
621
 
Qed.
622
 
 
623
 
 intros n m eq_Sn_Sm.
624
 
 apply inj_pred with (n:= S n) (m := S m); assumption.
625
 
Qed.
626
 
 
627
 
Lemma list_inject : forall (A:Type)(a b :A)(l l':list A),
628
 
                     a :: b :: l = b :: a :: l' -> a = b /\ l = l'.
629
 
Proof.
630
 
 intros A a b l l' e.
631
 
 injection e.
632
 
 auto.
633
 
Qed.
634
 
 
635
 
 
636
 
Theorem not_le_Sn_0 : forall n:nat, ~ (S n <= 0).
637
 
Proof.
638
 
 red; intros n H.
639
 
 case H.
640
 
Undo.
641
 
 
642
 
Lemma not_le_Sn_0_with_constraints :
643
 
  forall n p , S n <= p ->  p = 0 -> False.
644
 
Proof.
645
 
 intros n p H; case H ;
646
 
   intros; discriminate.
647
 
Qed.
648
 
   
649
 
eapply not_le_Sn_0_with_constraints; eauto.
650
 
Qed. 
651
 
 
652
 
 
653
 
Theorem not_le_Sn_0' : forall n:nat, ~ (S n <= 0).
654
 
Proof.
655
 
 red; intros n H ; inversion H.
656
 
Qed.
657
 
 
658
 
Derive Inversion le_Sn_0_inv with (forall n :nat, S n <=  0).
659
 
Check le_Sn_0_inv.
660
 
 
661
 
Theorem le_Sn_0'' : forall n p : nat, ~ S n <= 0 .
662
 
Proof.
663
 
 intros n p H; 
664
 
 inversion H using le_Sn_0_inv.
665
 
Qed.
666
 
 
667
 
Derive Inversion_clear le_Sn_0_inv' with (forall n :nat, S n <=  0).
668
 
Check le_Sn_0_inv'.
669
 
 
670
 
 
671
 
Theorem le_reverse_rules : 
672
 
 forall n m:nat, n <= m -> 
673
 
                   n = m \/  
674
 
                   exists p, n <=  p /\ m = S p.
675
 
Proof.
676
 
  intros n m H; inversion H.
677
 
  left;trivial.
678
 
  right; exists m0; split; trivial.
679
 
Restart.
680
 
  intros n m H; inversion_clear H.
681
 
  left;trivial.
682
 
  right; exists m0; split; trivial.
683
 
Qed.
684
 
 
685
 
Inductive ArithExp : Set :=
686
 
     Zero : ArithExp 
687
 
   | Succ : ArithExp -> ArithExp
688
 
   | Plus : ArithExp -> ArithExp -> ArithExp.
689
 
 
690
 
Inductive RewriteRel : ArithExp -> ArithExp -> Prop :=
691
 
     RewSucc  : forall e1 e2 :ArithExp,
692
 
                  RewriteRel e1 e2 -> RewriteRel (Succ e1) (Succ e2) 
693
 
  |  RewPlus0 : forall e:ArithExp,
694
 
                  RewriteRel (Plus Zero e) e 
695
 
  |  RewPlusS : forall e1 e2:ArithExp,
696
 
                  RewriteRel e1 e2 ->
697
 
                  RewriteRel (Plus (Succ e1) e2) (Succ (Plus e1 e2)).
698
 
 
699
 
 
700
 
  
701
 
Fixpoint plus (n p:nat) {struct n} : nat :=
702
 
  match n with
703
 
          | 0 => p
704
 
          | S m => S (plus m p)
705
 
 end.
706
 
 
707
 
Fixpoint plus' (n p:nat) {struct p} : nat :=
708
 
    match p with
709
 
          | 0 => n
710
 
          | S q => S (plus' n q)
711
 
    end.
712
 
 
713
 
Fixpoint plus'' (n p:nat) {struct n} : nat :=
714
 
  match n with
715
 
          | 0 => p
716
 
          | S m => plus'' m (S p)
717
 
 end.
718
 
 
719
 
 
720
 
Fixpoint even_test (n:nat) : bool :=
721
 
  match n 
722
 
  with 0 =>  true
723
 
     | 1 =>  false
724
 
     | S (S p) => even_test p
725
 
  end.
726
 
 
727
 
 
728
 
Reset even_test.
729
 
 
730
 
Fixpoint even_test (n:nat) : bool :=
731
 
  match n 
732
 
  with 
733
 
      | 0 =>  true
734
 
      | S p => odd_test p
735
 
  end
736
 
with odd_test (n:nat) : bool :=
737
 
  match n
738
 
  with 
739
 
     | 0 => false
740
 
     | S p => even_test p
741
 
 end.
742
 
 
743
 
 
744
 
  
745
 
Eval simpl in even_test.
746
 
 
747
 
 
748
 
 
749
 
Eval simpl in (fun x : nat => even_test x).
750
 
 
751
 
Eval simpl in (fun x : nat => plus 5 x).
752
 
Eval simpl in (fun x : nat => even_test (plus 5 x)).
753
 
 
754
 
Eval simpl in (fun x : nat => even_test (plus x 5)).
755
 
 
756
 
 
757
 
Section Principle_of_Induction.
758
 
Variable    P               : nat -> Prop.
759
 
Hypothesis  base_case       : P 0.
760
 
Hypothesis  inductive_step   : forall n:nat, P n -> P (S n).
761
 
Fixpoint nat_ind  (n:nat)    : (P n) := 
762
 
   match n return P n with
763
 
          | 0 => base_case
764
 
          | S m => inductive_step m (nat_ind m)
765
 
   end. 
766
 
 
767
 
End Principle_of_Induction.
768
 
 
769
 
Scheme Even_induction := Minimality for even Sort Prop
770
 
with   Odd_induction  := Minimality for odd  Sort Prop.
771
 
 
772
 
Theorem even_plus_four : forall n:nat, even n -> even (4+n).
773
 
Proof.
774
 
 intros n H.
775
 
 elim H using Even_induction with (P0 := fun n => odd (4+n));
776
 
 simpl;repeat constructor;assumption.
777
 
Qed.
778
 
 
779
 
 
780
 
Section Principle_of_Double_Induction.
781
 
Variable    P               : nat -> nat ->Prop.
782
 
Hypothesis  base_case1      : forall x:nat, P 0 x.
783
 
Hypothesis  base_case2      : forall x:nat, P (S x) 0.
784
 
Hypothesis  inductive_step   : forall n m:nat, P n m -> P (S n) (S m).
785
 
Fixpoint nat_double_ind (n m:nat){struct n} : P n m := 
786
 
  match n, m return P n m with 
787
 
         |  0 ,     x    =>  base_case1 x 
788
 
         |  (S x),    0  =>  base_case2 x
789
 
         |  (S x), (S y) =>  inductive_step x y (nat_double_ind x y)
790
 
     end.
791
 
End Principle_of_Double_Induction.
792
 
 
793
 
Section Principle_of_Double_Recursion.
794
 
Variable    P               : nat -> nat -> Type.
795
 
Hypothesis  base_case1      : forall x:nat, P 0 x.
796
 
Hypothesis  base_case2      : forall x:nat, P (S x) 0.
797
 
Hypothesis  inductive_step   : forall n m:nat, P n m -> P (S n) (S m).
798
 
Fixpoint nat_double_rect (n m:nat){struct n} : P n m := 
799
 
  match n, m return P n m with 
800
 
         |   0 ,     x    =>  base_case1 x 
801
 
         |  (S x),    0   => base_case2 x
802
 
         |  (S x), (S y)  => inductive_step x y (nat_double_rect x y)
803
 
     end.
804
 
End Principle_of_Double_Recursion.
805
 
 
806
 
Definition min : nat -> nat -> nat  := 
807
 
  nat_double_rect (fun (x y:nat) => nat)
808
 
                 (fun (x:nat) => 0)
809
 
                 (fun (y:nat) => 0)
810
 
                 (fun (x y r:nat) => S r).
811
 
 
812
 
Eval compute in (min 5 8).
813
 
Eval compute in (min 8 5).
814
 
 
815
 
 
816
 
 
817
 
Lemma not_circular : forall n:nat, n <> S n.
818
 
Proof.
819
 
 intro n.
820
 
 apply nat_ind with (P:= fun n => n <> S n).
821
 
 discriminate.
822
 
 red; intros n0 Hn0 eqn0Sn0;injection eqn0Sn0;trivial.
823
 
Qed.
824
 
 
825
 
Definition eq_nat_dec : forall n p:nat , {n=p}+{n <> p}.
826
 
Proof.
827
 
 intros n p.
828
 
 apply nat_double_rect with (P:= fun (n q:nat) => {q=p}+{q <> p}).
829
 
Undo.
830
 
 pattern p,n.
831
 
 elim n using nat_double_rect.
832
 
 destruct x; auto.
833
 
 destruct x; auto.
834
 
 intros n0 m H; case H.
835
 
 intro eq; rewrite eq ; auto.
836
 
 intro neg; right; red ; injection 1; auto.
837
 
Defined.
838
 
 
839
 
Definition eq_nat_dec' : forall n p:nat, {n=p}+{n <> p}.
840
 
 decide equality.
841
 
Defined.
842
 
 
843
 
 
844
 
 
845
 
Require Import Le.
846
 
Lemma le'_le : forall n p, le' n p -> n <= p.
847
 
Proof.
848
 
 induction 1;auto with arith.
849
 
Qed.
850
 
 
851
 
Lemma le'_n_Sp : forall n p, le' n p -> le' n (S p).
852
 
Proof.
853
 
 induction 1;auto.
854
 
Qed.
855
 
 
856
 
Hint Resolve le'_n_Sp.
857
 
 
858
 
 
859
 
Lemma le_le' : forall n p, n<=p -> le' n p.
860
 
Proof.
861
 
 induction 1;auto with arith.
862
 
Qed. 
863
 
 
864
 
 
865
 
Print Acc.
866
 
 
867
 
 
868
 
Require Import Minus.
869
 
 
870
 
(*
871
 
Fixpoint div (x y:nat){struct x}: nat :=
872
 
 if eq_nat_dec x 0 
873
 
  then 0
874
 
  else if eq_nat_dec y 0
875
 
       then x
876
 
       else S (div (x-y) y).
877
 
 
878
 
Error:
879
 
Recursive definition of div is ill-formed.
880
 
In environment
881
 
div : nat -> nat -> nat
882
 
x : nat
883
 
y : nat
884
 
_ : x <> 0
885
 
_ : y <> 0
886
 
 
887
 
Recursive call to div has principal argument equal to
888
 
"x - y"
889
 
instead of a subterm of x
890
 
 
891
 
*)
892
 
 
893
 
Lemma minus_smaller_S: forall x y:nat, x - y < S x.
894
 
Proof.
895
 
 intros x y; pattern y, x;
896
 
 elim x using nat_double_ind.
897
 
 destruct x0; auto with arith.
898
 
 simpl; auto with arith.
899
 
 simpl; auto with arith.
900
 
Qed.
901
 
 
902
 
Lemma minus_smaller_positive : forall x y:nat, x <>0 -> y <> 0 ->
903
 
                                     x - y < x.
904
 
Proof.
905
 
 destruct x; destruct y; 
906
 
 ( simpl;intros; apply minus_smaller_S || 
907
 
   intros; absurd (0=0); auto).
908
 
Qed.
909
 
 
910
 
Definition minus_decrease : forall x y:nat, Acc lt x -> 
911
 
                                         x <> 0 -> 
912
 
                                         y <> 0 ->
913
 
                                         Acc lt (x-y).
914
 
Proof.
915
 
 intros x y H; case H.
916
 
 intros Hz posz posy. 
917
 
 apply Hz; apply minus_smaller_positive; assumption.
918
 
Defined.
919
 
 
920
 
Print minus_decrease.
921
 
 
922
 
 
923
 
 
924
 
Definition div_aux (x y:nat)(H: Acc lt x):nat.
925
 
 fix 3.
926
 
 intros.
927
 
  refine (if eq_nat_dec x 0 
928
 
         then 0 
929
 
         else if eq_nat_dec y 0 
930
 
              then y
931
 
              else div_aux (x-y) y _).
932
 
 apply (minus_decrease x y H);assumption. 
933
 
Defined.
934
 
 
935
 
 
936
 
Print div_aux.
937
 
(*
938
 
div_aux = 
939
 
(fix div_aux (x y : nat) (H : Acc lt x) {struct H} : nat :=
940
 
   match eq_nat_dec x 0 with
941
 
   | left _ => 0
942
 
   | right _ =>
943
 
       match eq_nat_dec y 0 with
944
 
       | left _ => y
945
 
       | right _0 => div_aux (x - y) y (minus_decrease x y H _ _0)
946
 
       end
947
 
   end)
948
 
     : forall x : nat, nat -> Acc lt x -> nat
949
 
*)
950
 
 
951
 
Require Import Wf_nat.
952
 
Definition div x y := div_aux x y (lt_wf x). 
953
 
 
954
 
Extraction div.
955
 
(*
956
 
let div x y =
957
 
  div_aux x y
958
 
*)
959
 
 
960
 
Extraction div_aux.
961
 
 
962
 
(*
963
 
let rec div_aux x y =
964
 
  match eq_nat_dec x O with
965
 
    | Left -> O
966
 
    | Right ->
967
 
        (match eq_nat_dec y O with
968
 
           | Left -> y
969
 
           | Right -> div_aux (minus x y) y)
970
 
*)
971
 
 
972
 
Lemma vector0_is_vnil : forall (A:Type)(v:vector A 0), v = Vnil A.
973
 
Proof.
974
 
 intros A v;inversion v.
975
 
Abort.
976
 
 
977
 
(*
978
 
 Lemma vector0_is_vnil_aux : forall (A:Type)(n:nat)(v:vector A n), 
979
 
                                  n= 0 -> v = Vnil A.
980
 
 
981
 
Toplevel input, characters 40281-40287
982
 
> Lemma vector0_is_vnil_aux : forall (A:Set)(n:nat)(v:vector A n),                                    n= 0 -> v = Vnil A.
983
 
>                                                                                                                 ^^^^^^
984
 
Error: In environment
985
 
A : Set
986
 
n : nat
987
 
v : vector A n
988
 
e : n = 0
989
 
The term "Vnil A" has type "vector A 0" while it is expected to have type
990
 
 "vector A n"
991
 
*)
992
 
 Require Import JMeq.
993
 
 
994
 
 
995
 
(* On devrait changer Set en Type ? *)
996
 
 
997
 
Lemma vector0_is_vnil_aux : forall (A:Type)(n:nat)(v:vector A n), 
998
 
                                  n= 0 -> JMeq v (Vnil A).
999
 
Proof.
1000
 
 destruct v.
1001
 
 auto.
1002
 
 intro; discriminate.
1003
 
Qed.
1004
 
 
1005
 
Lemma vector0_is_vnil : forall (A:Type)(v:vector A 0), v = Vnil A.
1006
 
Proof.
1007
 
 intros a v;apply JMeq_eq.
1008
 
 apply vector0_is_vnil_aux.
1009
 
 trivial.
1010
 
Qed.
1011
 
 
1012
 
 
1013
 
Implicit Arguments Vcons [A n].
1014
 
Implicit Arguments Vnil [A].
1015
 
Implicit Arguments Vhead [A n].
1016
 
Implicit Arguments Vtail [A n].
1017
 
 
1018
 
Definition Vid : forall (A : Type)(n:nat), vector A n -> vector A n.
1019
 
Proof.
1020
 
 destruct n; intro v.
1021
 
 exact Vnil.
1022
 
 exact (Vcons  (Vhead v) (Vtail v)).
1023
 
Defined.
1024
 
 
1025
 
Eval simpl in (fun (A:Type)(v:vector A 0) => (Vid _ _ v)).
1026
 
 
1027
 
Eval simpl in (fun (A:Type)(v:vector A 0) => v).
1028
 
 
1029
 
 
1030
 
 
1031
 
Lemma Vid_eq : forall (n:nat) (A:Type)(v:vector A n), v=(Vid _ n v).
1032
 
Proof.
1033
 
 destruct v. 
1034
 
 reflexivity.
1035
 
 reflexivity.
1036
 
Defined.
1037
 
 
1038
 
Theorem zero_nil : forall A (v:vector A 0), v = Vnil.
1039
 
Proof.
1040
 
 intros.
1041
 
 change (Vnil (A:=A)) with (Vid _ 0 v). 
1042
 
 apply Vid_eq.
1043
 
Defined.
1044
 
 
1045
 
 
1046
 
Theorem decomp :
1047
 
  forall (A : Type) (n : nat) (v : vector A (S n)),
1048
 
  v = Vcons (Vhead v) (Vtail v).
1049
 
Proof.
1050
 
 intros.
1051
 
 change (Vcons (Vhead v) (Vtail v)) with (Vid _  (S n) v).
1052
 
 apply Vid_eq.
1053
 
Defined.
1054
 
 
1055
 
 
1056
 
 
1057
 
Definition vector_double_rect : 
1058
 
    forall (A:Type) (P: forall (n:nat),(vector A n)->(vector A n) -> Type),
1059
 
        P 0 Vnil Vnil ->
1060
 
        (forall n (v1 v2 : vector A n) a b, P n v1 v2 ->
1061
 
             P (S n) (Vcons a v1) (Vcons  b v2)) ->
1062
 
        forall n (v1 v2 : vector A n), P n v1 v2.
1063
 
 induction n.
1064
 
 intros; rewrite (zero_nil _ v1); rewrite (zero_nil _ v2).
1065
 
 auto.
1066
 
 intros v1 v2; rewrite (decomp _ _ v1);rewrite (decomp _ _ v2).
1067
 
 apply X0; auto.
1068
 
Defined.
1069
 
 
1070
 
Require Import Bool.
1071
 
 
1072
 
Definition bitwise_or n v1 v2 : vector bool n :=
1073
 
   vector_double_rect bool  (fun n v1 v2 => vector bool n)
1074
 
                        Vnil
1075
 
                        (fun n v1 v2 a b r => Vcons (orb a b) r) n v1 v2.
1076
 
 
1077
 
 
1078
 
Fixpoint vector_nth (A:Type)(n:nat)(p:nat)(v:vector A p){struct v}
1079
 
                  : option A :=
1080
 
  match n,v  with
1081
 
    _   , Vnil => None
1082
 
  | 0   , Vcons b  _ _ => Some b
1083
 
  | S n', Vcons _  p' v' => vector_nth A n'  p' v'
1084
 
  end.
1085
 
 
1086
 
Implicit Arguments vector_nth [A p].
1087
 
 
1088
 
 
1089
 
Lemma nth_bitwise : forall (n:nat) (v1 v2: vector bool n) i  a b,
1090
 
      vector_nth i v1 = Some a ->
1091
 
      vector_nth i v2 = Some b ->
1092
 
      vector_nth i (bitwise_or _ v1 v2) = Some (orb a b).
1093
 
Proof.
1094
 
 intros  n v1 v2; pattern n,v1,v2.
1095
 
 apply vector_double_rect.
1096
 
 simpl.
1097
 
 destruct i; discriminate 1.
1098
 
 destruct i; simpl;auto.
1099
 
 injection 1; injection 2;intros; subst a; subst b; auto.
1100
 
Qed.
1101
 
 
1102
 
 Set Implicit Arguments.
1103
 
 
1104
 
 CoInductive Stream (A:Type) : Type   :=
1105
 
 |  Cons : A -> Stream A -> Stream A.
1106
 
 
1107
 
 CoInductive LList (A: Type) : Type :=
1108
 
 |  LNil : LList A
1109
 
 |  LCons : A -> LList A -> LList A.
1110
 
 
1111
 
 
1112
 
 
1113
 
 
1114
 
 
1115
 
 Definition head (A:Type)(s : Stream A) := match s with Cons a s' => a end.
1116
 
 
1117
 
 Definition tail (A : Type)(s : Stream A) :=
1118
 
      match s with Cons a s' => s' end.
1119
 
 
1120
 
 CoFixpoint repeat (A:Type)(a:A) : Stream A := Cons a (repeat a).
1121
 
 
1122
 
 CoFixpoint iterate (A: Type)(f: A -> A)(a : A) : Stream A:=
1123
 
    Cons a (iterate f (f a)).
1124
 
 
1125
 
 CoFixpoint map (A B:Type)(f: A -> B)(s : Stream A) : Stream B:=
1126
 
  match s with Cons a tl => Cons (f a) (map f tl) end.
1127
 
 
1128
 
Eval simpl in (fun (A:Type)(a:A) => repeat a).
1129
 
 
1130
 
Eval simpl in (fun (A:Type)(a:A) => head (repeat a)).
1131
 
 
1132
 
 
1133
 
CoInductive EqSt (A: Type) : Stream A -> Stream A -> Prop :=
1134
 
  eqst : forall s1 s2: Stream A,
1135
 
      head s1 = head s2 ->
1136
 
      EqSt (tail s1) (tail s2) ->
1137
 
      EqSt s1 s2.
1138
 
 
1139
 
 
1140
 
Section Parks_Principle.
1141
 
Variable A : Type.
1142
 
Variable    R      : Stream A -> Stream A -> Prop.
1143
 
Hypothesis  bisim1 : forall s1 s2:Stream A, R s1 s2 ->
1144
 
                                          head s1 = head s2.
1145
 
Hypothesis  bisim2 : forall s1 s2:Stream A, R s1 s2 ->
1146
 
                                          R (tail s1) (tail s2).
1147
 
 
1148
 
CoFixpoint park_ppl     : forall s1 s2:Stream A, R s1 s2 ->
1149
 
                                               EqSt s1 s2 :=
1150
 
 fun s1 s2 (p : R s1 s2) =>
1151
 
      eqst s1 s2 (bisim1  p) 
1152
 
                 (park_ppl  (bisim2  p)).
1153
 
End Parks_Principle.
1154
 
 
1155
 
 
1156
 
Theorem map_iterate : forall (A:Type)(f:A->A)(x:A),
1157
 
                       EqSt (iterate f (f x)) (map f (iterate f x)).
1158
 
Proof.
1159
 
 intros A f x.
1160
 
 apply park_ppl with
1161
 
   (R:=  fun s1 s2 => exists x: A, 
1162
 
                      s1 = iterate f (f x) /\ s2 = map f (iterate f x)).
1163
 
 
1164
 
 intros s1 s2 (x0,(eqs1,eqs2));rewrite eqs1;rewrite eqs2;reflexivity.
1165
 
 intros s1 s2 (x0,(eqs1,eqs2)).
1166
 
 exists (f x0);split;[rewrite eqs1|rewrite eqs2]; reflexivity.
1167
 
 exists x;split; reflexivity.
1168
 
Qed.
1169
 
 
1170
 
Ltac infiniteproof f :=
1171
 
  cofix f; constructor; [clear f| simpl; try (apply f; clear f)].
1172
 
 
1173
 
 
1174
 
Theorem map_iterate' : forall (A:Type)(f:A->A)(x:A),
1175
 
                       EqSt (iterate f (f x)) (map f (iterate f x)).
1176
 
infiniteproof map_iterate'.
1177
 
 reflexivity.
1178
 
Qed.
1179
 
 
1180
 
 
1181
 
Implicit Arguments LNil [A].
1182
 
 
1183
 
Lemma Lnil_not_Lcons : forall (A:Type)(a:A)(l:LList A),
1184
 
                               LNil <> (LCons a l).
1185
 
 intros;discriminate.
1186
 
Qed.
1187
 
 
1188
 
Lemma injection_demo : forall (A:Type)(a b : A)(l l': LList A),
1189
 
                       LCons a (LCons b l) = LCons b (LCons a l') ->
1190
 
                       a = b /\ l = l'.
1191
 
Proof.
1192
 
 intros A a b l l' e; injection e; auto.
1193
 
Qed.
1194
 
 
1195
 
 
1196
 
Inductive Finite (A:Type) : LList A -> Prop :=
1197
 
|  Lnil_fin : Finite (LNil (A:=A))
1198
 
|  Lcons_fin : forall a l, Finite l -> Finite (LCons a l).
1199
 
 
1200
 
CoInductive Infinite  (A:Type) : LList A -> Prop :=
1201
 
| LCons_inf : forall a l, Infinite l -> Infinite (LCons a l).
1202
 
 
1203
 
Lemma LNil_not_Infinite : forall (A:Type), ~ Infinite (LNil (A:=A)).
1204
 
Proof.
1205
 
  intros A H;inversion H.
1206
 
Qed.
1207
 
 
1208
 
Lemma Finite_not_Infinite : forall (A:Type)(l:LList A),
1209
 
                                Finite l -> ~ Infinite l.
1210
 
Proof.
1211
 
 intros A l H; elim H.
1212
 
 apply LNil_not_Infinite.
1213
 
 intros a l0 F0 I0' I1.
1214
 
 case I0'; inversion_clear I1.
1215
 
 trivial.
1216
 
Qed.
1217
 
 
1218
 
Lemma Not_Finite_Infinite : forall (A:Type)(l:LList A),
1219
 
                            ~ Finite l -> Infinite l.
1220
 
Proof.
1221
 
 cofix H.
1222
 
 destruct l.
1223
 
 intro; absurd (Finite (LNil (A:=A)));[auto|constructor].
1224
 
 constructor.
1225
 
 apply H.
1226
 
 red; intro H1;case H0.
1227
 
 constructor.
1228
 
 trivial.
1229
 
Qed.
1230
 
 
1231
 
 
1232