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

« back to all changes in this revision

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