source: src/ASM/Util.ma @ 1602

Last change on this file since 1602 was 1602, checked in by mulligan, 8 years ago

giving up on fetch proofs for time being

File size: 19.5 KB
Line 
1include "basics/lists/list.ma".
2include "basics/types.ma".
3include "arithmetics/nat.ma".
4include "basics/russell.ma".
5
6(* let's implement a daemon not used by automation *)
7inductive DAEMONXXX: Type[0] ≝ K1DAEMONXXX: DAEMONXXX | K2DAEMONXXX: DAEMONXXX.
8axiom IMPOSSIBLE: K1DAEMONXXX = K2DAEMONXXX.
9example daemon: False. generalize in match IMPOSSIBLE; #IMPOSSIBLE destruct(IMPOSSIBLE) qed.
10example not_implemented: False. cases daemon qed.
11
12notation "⊥" with precedence 90
13  for @{ match ? in False with [ ] }.
14
15definition ltb ≝
16  λm, n: nat.
17    leb (S m) n.
18   
19definition geb ≝
20  λm, n: nat.
21    ltb n m.
22
23definition gtb ≝
24  λm, n: nat.
25    ltb n m.
26
27(* dpm: unless I'm being stupid, this isn't defined in the stdlib? *)
28let rec eq_nat (n: nat) (m: nat) on n: bool ≝
29  match n with
30  [ O ⇒ match m with [ O ⇒ true | _ ⇒ false ]
31  | S n' ⇒ match m with [ S m' ⇒ eq_nat n' m' | _ ⇒ false ]
32  ].
33
34let rec forall
35  (A: Type[0]) (f: A → bool) (l: list A)
36    on l ≝
37  match l with
38  [ nil        ⇒ true
39  | cons hd tl ⇒ f hd ∧ forall A f tl
40  ].
41
42let rec prefix
43  (A: Type[0]) (k: nat) (l: list A)
44    on l ≝
45  match l with
46  [ nil ⇒ [ ]
47  | cons hd tl ⇒
48    match k with
49    [ O ⇒ [ ]
50    | S k' ⇒ hd :: prefix A k' tl
51    ]
52  ].
53 
54let rec fold_left2
55  (A: Type[0]) (B: Type[0]) (C: Type[0]) (f: A → B → C → A) (accu: A)
56  (left: list B) (right: list C) (proof: |left| = |right|)
57    on left: A ≝
58  match left return λx. |x| = |right| → A with
59  [ nil ⇒ λnil_prf.
60    match right return λx. |[ ]| = |x| → A with
61    [ nil ⇒ λnil_nil_prf. accu
62    | cons hd tl ⇒ λcons_nil_absrd. ?
63    ] nil_prf
64  | cons hd tl ⇒ λcons_prf.
65    match right return λx. |hd::tl| = |x| → A with
66    [ nil ⇒ λcons_nil_absrd. ?
67    | cons hd' tl' ⇒ λcons_cons_prf.
68        fold_left2 …  f (f accu hd hd') tl tl' ?
69    ] cons_prf
70  ] proof.
71  [ 1: normalize in cons_nil_absrd;
72       destruct(cons_nil_absrd)
73  | 2: normalize in cons_nil_absrd;
74       destruct(cons_nil_absrd)
75  | 3: normalize in cons_cons_prf;
76       @injective_S
77       assumption
78  ]
79qed.
80
81let rec remove_n_first_internal
82  (i: nat) (A: Type[0]) (l: list A) (n: nat)
83    on l ≝
84  match l with
85  [ nil ⇒ [ ]
86  | cons hd tl ⇒
87    match eq_nat i n with
88    [ true ⇒ l
89    | _ ⇒ remove_n_first_internal (S i) A tl n
90    ]
91  ].
92
93definition remove_n_first ≝
94  λA: Type[0].
95  λn: nat.
96  λl: list A.
97    remove_n_first_internal 0 A l n.
98   
99let rec foldi_from_until_internal
100  (A: Type[0]) (i: nat) (res: ?) (rem: list A) (m: nat) (f: nat → list A → A → list A)
101    on rem ≝
102  match rem with
103  [ nil ⇒ res
104  | cons e tl ⇒
105    match geb i m with
106    [ true ⇒ res
107    | _ ⇒ foldi_from_until_internal A (S i) (f i res e) tl m f
108    ]
109  ].
110
111definition foldi_from_until ≝
112  λA: Type[0].
113  λn: nat.
114  λm: nat.
115  λf: ?.
116  λa: ?.
117  λl: ?.
118    foldi_from_until_internal A 0 a (remove_n_first A n l) m f.
119
120definition foldi_from ≝
121  λA: Type[0].
122  λn.
123  λf.
124  λa.
125  λl.
126    foldi_from_until A n (|l|) f a l.
127
128definition foldi_until ≝
129  λA: Type[0].
130  λm.
131  λf.
132  λa.
133  λl.
134    foldi_from_until A 0 m f a l.
135
136definition foldi ≝
137  λA: Type[0].
138  λf.
139  λa.
140  λl.
141    foldi_from_until A 0 (|l|) f a l.
142
143definition hd_safe ≝
144  λA: Type[0].
145  λl: list A.
146  λproof: 0 < |l|.
147  match l return λx. 0 < |x| → A with
148  [ nil ⇒ λnil_absrd. ?
149  | cons hd tl ⇒ λcons_prf. hd
150  ] proof.
151  normalize in nil_absrd;
152  cases(not_le_Sn_O 0)
153  #HYP
154  cases(HYP nil_absrd)
155qed.
156
157definition tail_safe ≝
158  λA: Type[0].
159  λl: list A.
160  λproof: 0 < |l|.
161  match l return λx. 0 < |x| → list A with
162  [ nil ⇒ λnil_absrd. ?
163  | cons hd tl ⇒ λcons_prf. tl
164  ] proof.
165  normalize in nil_absrd;
166  cases(not_le_Sn_O 0)
167  #HYP
168  cases(HYP nil_absrd)
169qed.
170
171let rec split
172  (A: Type[0]) (l: list A) (index: nat) (proof: index ≤ |l|)
173    on index ≝
174  match index return λx. x ≤ |l| → (list A) × (list A) with
175  [ O ⇒ λzero_prf. 〈[], l〉
176  | S index' ⇒ λsucc_prf.
177    match l return λx. S index' ≤ |x| → (list A) × (list A) with
178    [ nil ⇒ λnil_absrd. ?
179    | cons hd tl ⇒ λcons_prf.
180      let 〈l1, l2〉 ≝ split A tl index' ? in
181        〈hd :: l1, l2〉
182    ] succ_prf
183  ] proof.
184  [1: normalize in nil_absrd;
185      cases(not_le_Sn_O index')
186      #HYP
187      cases(HYP nil_absrd)
188  |2: normalize in cons_prf;
189      @le_S_S_to_le
190      assumption
191  ]
192qed.
193
194let rec nth_safe
195  (elt_type: Type[0]) (index: nat) (the_list: list elt_type)
196  (proof: index < | the_list |)
197    on index ≝
198  match index return λs. s < | the_list | → elt_type with
199  [ O ⇒
200    match the_list return λt. 0 < | t | → elt_type with
201    [ nil        ⇒ λnil_absurd. ?
202    | cons hd tl ⇒ λcons_proof. hd
203    ]
204  | S index' ⇒
205    match the_list return λt. S index' < | t | → elt_type with
206    [ nil ⇒ λnil_absurd. ?
207    | cons hd tl ⇒
208      λcons_proof. nth_safe elt_type index' tl ?
209    ]
210  ] proof.
211  [ normalize in nil_absurd;
212    cases (not_le_Sn_O 0)
213    #ABSURD
214    elim (ABSURD nil_absurd)
215  | normalize in nil_absurd;
216    cases (not_le_Sn_O (S index'))
217    #ABSURD
218    elim (ABSURD nil_absurd)
219  | normalize in cons_proof;
220    @le_S_S_to_le
221    assumption
222  ]
223qed.
224
225definition last_safe ≝
226  λelt_type: Type[0].
227  λthe_list: list elt_type.
228  λproof   : 0 < | the_list |.
229    nth_safe elt_type (|the_list| - 1) the_list ?.
230  normalize /2/
231qed.
232
233let rec reduce
234  (A: Type[0]) (B: Type[0]) (left: list A) (right: list B) on left ≝
235  match left with
236  [ nil ⇒ 〈〈[ ], [ ]〉, 〈[ ], right〉〉
237  | cons hd tl ⇒
238    match right with
239    [ nil ⇒ 〈〈[ ], left〉, 〈[ ], [ ]〉〉
240    | cons hd' tl' ⇒
241      let 〈cleft, cright〉 ≝ reduce A B tl tl' in
242      let 〈commonl, restl〉 ≝ cleft in
243      let 〈commonr, restr〉 ≝ cright in
244        〈〈hd :: commonl, restl〉, 〈hd' :: commonr, restr〉〉
245    ]
246  ].
247
248(*
249axiom reduce_strong:
250  ∀A: Type[0].
251  ∀left: list A.
252  ∀right: list A.
253    Σret: ((list A) × (list A)) × ((list A) × (list A)). | \fst (\fst ret) | = | \fst (\snd ret) |.
254*)
255
256let rec reduce_strong
257  (A: Type[0]) (B: Type[0]) (left: list A) (right: list B)
258    on left : Σret: ((list A) × (list A)) × ((list B) × (list B)). |\fst (\fst ret)| = |\fst (\snd ret)|  ≝
259  match left with
260  [ nil ⇒ 〈〈[ ], [ ]〉, 〈[ ], right〉〉
261  | cons hd tl ⇒
262    match right with
263    [ nil ⇒ 〈〈[ ], left〉, 〈[ ], [ ]〉〉
264    | cons hd' tl' ⇒
265      let 〈cleft, cright〉 ≝ reduce_strong A B tl tl' in
266      let 〈commonl, restl〉 ≝ cleft in
267      let 〈commonr, restr〉 ≝ cright in
268        〈〈hd :: commonl, restl〉, 〈hd' :: commonr, restr〉〉
269    ]
270  ].
271  [ 1: normalize %
272  | 2: normalize %
273  | 3: normalize >p3 in p2; >p4 cases (reduce_strong … tl tl1) normalize
274       #X #H #EQ destruct // ]
275qed.
276   
277let rec map2_opt
278  (A: Type[0]) (B: Type[0]) (C: Type[0]) (f: A → B → C)
279  (left: list A) (right: list B) on left ≝
280  match left with
281  [ nil ⇒
282    match right with
283    [ nil ⇒ Some ? (nil C)
284    | _ ⇒ None ?
285    ]
286  | cons hd tl ⇒
287    match right with
288    [ nil ⇒ None ?
289    | cons hd' tl' ⇒
290      match map2_opt A B C f tl tl' with
291      [ None ⇒ None ?
292      | Some tail ⇒ Some ? (f hd hd' :: tail)
293      ]
294    ]
295  ].
296
297let rec map2
298  (A: Type[0]) (B: Type[0]) (C: Type[0]) (f: A → B → C)
299  (left: list A) (right: list B) (proof: | left | = | right |) on left ≝
300  match left return λx. | x | = | right | → list C with
301  [ nil ⇒
302    match right return λy. | [] | = | y | → list C with
303    [ nil ⇒ λnil_prf. nil C
304    | _ ⇒ λcons_absrd. ?
305    ]
306  | cons hd tl ⇒
307    match right return λy. | hd::tl | = | y | → list C with
308    [ nil ⇒ λnil_absrd. ?
309    | cons hd' tl' ⇒ λcons_prf. (f hd hd') :: map2 A B C f tl tl' ?
310    ]
311  ] proof.
312  [1: normalize in cons_absrd;
313      destruct(cons_absrd)
314  |2: normalize in nil_absrd;
315      destruct(nil_absrd)
316  |3: normalize in cons_prf;
317      destruct(cons_prf)
318      assumption
319  ]
320qed.
321
322let rec map3
323  (A: Type[0]) (B: Type[0]) (C: Type[0]) (D: Type[0]) (f: A → B → C → D)
324  (left: list A) (centre: list B) (right: list C)
325  (prflc: |left| = |centre|) (prfcr: |centre| = |right|) on left ≝
326  match left return λx. |x| = |centre| → list D with
327  [ nil ⇒ λnil_prf.
328    match centre return λx. |x| = |right| → list D with
329    [ nil ⇒ λnil_nil_prf.
330      match right return λx. |nil ?| = |x| → list D with
331      [ nil        ⇒ λnil_nil_nil_prf. nil D
332      | cons hd tl ⇒ λcons_nil_nil_absrd. ?
333      ] nil_nil_prf
334    | cons hd tl ⇒ λnil_cons_absrd. ?
335    ] prfcr
336  | cons hd tl ⇒ λcons_prf.
337    match centre return λx. |x| = |right| → list D with
338    [ nil ⇒ λcons_nil_absrd. ?
339    | cons hd' tl' ⇒ λcons_cons_prf.
340      match right return λx. |right| = |x| → |cons ? hd' tl'| = |x| → list D with
341      [ nil ⇒ λrefl_prf. λcons_cons_nil_absrd. ?
342      | cons hd'' tl'' ⇒ λrefl_prf. λcons_cons_cons_prf.
343        (f hd hd' hd'') :: (map3 A B C D f tl tl' tl'' ? ?)
344      ] (refl ? (|right|)) cons_cons_prf
345    ] prfcr
346  ] prflc.
347  [ 1: normalize in cons_nil_nil_absrd;
348       destruct(cons_nil_nil_absrd)
349  | 2: generalize in match nil_cons_absrd;
350       <prfcr <nil_prf #HYP
351       normalize in HYP;
352       destruct(HYP)
353  | 3: generalize in match cons_nil_absrd;
354       <prfcr <cons_prf #HYP
355       normalize in HYP;
356       destruct(HYP)
357  | 4: normalize in cons_cons_nil_absrd;
358       destruct(cons_cons_nil_absrd)
359  | 5: normalize in cons_cons_cons_prf;
360       destruct(cons_cons_cons_prf)
361       assumption
362  | 6: generalize in match cons_cons_cons_prf;
363       <refl_prf <prfcr <cons_prf #HYP
364       normalize in HYP;
365       destruct(HYP)
366       @sym_eq assumption
367  ]
368qed.
369 
370lemma eq_rect_Type0_r :
371  ∀A: Type[0].
372  ∀a:A.
373  ∀P: ∀x:A. eq ? x a → Type[0]. P a (refl A a) → ∀x: A.∀p:eq ? x a. P x p.
374  #A #a #P #H #x #p lapply H lapply P cases p //
375qed.
376 
377let rec safe_nth (A: Type[0]) (n: nat) (l: list A) (p: n < length A l) on n: A ≝
378  match n return λo. o < length A l → A with
379  [ O ⇒
380    match l return λm. 0 < length A m → A with
381    [ nil ⇒ λabsd1. ?
382    | cons hd tl ⇒ λprf1. hd
383    ]
384  | S n' ⇒
385    match l return λm. S n' < length A m → A with
386    [ nil ⇒ λabsd2. ?
387    | cons hd tl ⇒ λprf2. safe_nth A n' tl ?
388    ]
389  ] ?.
390  [ 1:
391    @ p
392  | 4:
393    normalize in prf2;
394    normalize
395    @ le_S_S_to_le
396    assumption
397  | 2:
398    normalize in absd1;
399    cases (not_le_Sn_O O)
400    # H
401    elim (H absd1)
402  | 3:
403    normalize in absd2;
404    cases (not_le_Sn_O (S n'))
405    # H
406    elim (H absd2)
407  ]
408qed.
409 
410let rec nub_by_internal (A: Type[0]) (f: A → A → bool) (l: list A) (n: nat) on n ≝
411  match n with
412  [ O ⇒
413    match l with
414    [ nil ⇒ [ ]
415    | cons hd tl ⇒ l
416    ]
417  | S n ⇒
418    match l with
419    [ nil ⇒ [ ]
420    | cons hd tl ⇒
421      hd :: nub_by_internal A f (filter ? (λy. notb (f y hd)) tl) n
422    ]
423  ].
424 
425definition nub_by ≝
426  λA: Type[0].
427  λf: A → A → bool.
428  λl: list A.
429    nub_by_internal A f l (length ? l).
430 
431let rec member (A: Type[0]) (eq: A → A → bool) (a: A) (l: list A) on l ≝
432  match l with
433  [ nil ⇒ false
434  | cons hd tl ⇒ orb (eq a hd) (member A eq a tl)
435  ].
436 
437let rec take (A: Type[0]) (n: nat) (l: list A) on n: list A ≝
438  match n with
439  [ O ⇒ [ ]
440  | S n ⇒
441    match l with
442    [ nil ⇒ [ ]
443    | cons hd tl ⇒ hd :: take A n tl
444    ]
445  ].
446 
447let rec drop (A: Type[0]) (n: nat) (l: list A) on n ≝
448  match n with
449  [ O ⇒ l
450  | S n ⇒
451    match l with
452    [ nil ⇒ [ ]
453    | cons hd tl ⇒ drop A n tl
454    ]
455  ].
456 
457definition list_split ≝
458  λA: Type[0].
459  λn: nat.
460  λl: list A.
461    〈take A n l, drop A n l〉.
462 
463let rec mapi_internal (A: Type[0]) (B: Type[0]) (n: nat) (f: nat → A → B)
464                      (l: list A) on l: list B ≝
465  match l with
466  [ nil ⇒ nil ?
467  | cons hd tl ⇒ (f n hd) :: (mapi_internal A B (n + 1) f tl)
468  ]. 
469
470definition mapi ≝
471  λA, B: Type[0].
472  λf: nat → A → B.
473  λl: list A.
474    mapi_internal A B 0 f l.
475
476let rec zip_pottier
477  (A: Type[0]) (B: Type[0]) (left: list A) (right: list B)
478    on left ≝
479  match left with
480  [ nil ⇒ [ ]
481  | cons hd tl ⇒
482    match right with
483    [ nil ⇒ [ ]
484    | cons hd' tl' ⇒ 〈hd, hd'〉 :: zip_pottier A B tl tl'
485    ]
486  ].
487
488let rec zip_safe
489  (A: Type[0]) (B: Type[0]) (left: list A) (right: list B) (prf: |left| = |right|)
490    on left ≝
491  match left return λx. |x| = |right| → list (A × B) with
492  [ nil ⇒ λnil_prf.
493    match right return λx. |[ ]| = |x| → list (A × B) with
494    [ nil ⇒ λnil_nil_prf. [ ]
495    | cons hd tl ⇒ λnil_cons_absrd. ?
496    ] nil_prf
497  | cons hd tl ⇒ λcons_prf.
498    match right return λx. |hd::tl| = |x| → list (A × B) with
499    [ nil ⇒ λcons_nil_absrd. ?
500    | cons hd' tl' ⇒ λcons_cons_prf. 〈hd, hd'〉 :: zip_safe A B tl tl' ?
501    ] cons_prf
502  ] prf.
503  [ 1: normalize in nil_cons_absrd;
504       destruct(nil_cons_absrd)
505  | 2: normalize in cons_nil_absrd;
506       destruct(cons_nil_absrd)
507  | 3: normalize in cons_cons_prf;
508       @injective_S
509       assumption
510  ]
511qed.
512
513let rec zip (A: Type[0]) (B: Type[0]) (l: list A) (r: list B) on l: option (list (A × B)) ≝
514  match l with
515  [ nil ⇒ Some ? (nil (A × B))
516  | cons hd tl ⇒
517    match r with
518    [ nil ⇒ None ?
519    | cons hd' tl' ⇒
520      match zip ? ? tl tl' with
521      [ None ⇒ None ?
522      | Some tail ⇒ Some ? (〈hd, hd'〉 :: tail)
523      ]
524    ]
525  ].
526
527let rec foldl (A: Type[0]) (B: Type[0]) (f: A → B → A) (a: A) (l: list B) on l ≝
528  match l with
529  [ nil ⇒ a
530  | cons hd tl ⇒ foldl A B f (f a hd) tl
531  ].
532
533lemma foldl_step:
534 ∀A:Type[0].
535  ∀B: Type[0].
536   ∀H: A → B → A.
537    ∀acc: A.
538     ∀pre: list B.
539      ∀hd:B.
540       foldl A B H acc (pre@[hd]) = (H (foldl A B H acc pre) hd).
541 #A #B #H #acc #pre generalize in match acc; -acc; elim pre
542  [ normalize; //
543  | #hd #tl #IH #acc #X normalize; @IH ]
544qed.
545
546lemma foldl_append:
547 ∀A:Type[0].
548  ∀B: Type[0].
549   ∀H: A → B → A.
550    ∀acc: A.
551     ∀suff,pre: list B.
552      foldl A B H acc (pre@suff) = (foldl A B H (foldl A B H acc pre) suff).
553 #A #B #H #acc #suff elim suff
554  [ #pre >append_nil %
555  | #hd #tl #IH #pre whd in ⊢ (???%); <(foldl_step … H ??) applyS (IH (pre@[hd])) ]
556qed.
557
558definition flatten ≝
559  λA: Type[0].
560  λl: list (list A).
561    foldr ? ? (append ?) [ ] l.
562
563let rec rev (A: Type[0]) (l: list A) on l ≝
564  match l with
565  [ nil ⇒ nil A
566  | cons hd tl ⇒ (rev A tl) @ [ hd ]
567  ].
568
569lemma append_length:
570  ∀A: Type[0].
571  ∀l, r: list A.
572    |(l @ r)| = |l| + |r|.
573  #A #L #R
574  elim L
575  [ %
576  | #HD #TL #IH
577    normalize >IH %
578  ]
579qed.
580
581lemma append_nil:
582  ∀A: Type[0].
583  ∀l: list A.
584    l @ [ ] = l.
585  #A #L
586  elim L //
587qed.
588
589lemma rev_append:
590  ∀A: Type[0].
591  ∀l, r: list A.
592    rev A (l @ r) = rev A r @ rev A l.
593  #A #L #R
594  elim L
595  [ normalize >append_nil %
596  | #HD #TL #IH
597    normalize >IH
598    @associative_append
599  ]
600qed.
601
602lemma rev_length:
603  ∀A: Type[0].
604  ∀l: list A.
605    |rev A l| = |l|.
606  #A #L
607  elim L
608  [ %
609  | #HD #TL #IH
610    normalize
611    >(append_length A (rev A TL) [HD])
612    normalize /2/
613  ]
614qed.
615
616lemma nth_append_first:
617 ∀A:Type[0].
618 ∀n:nat.∀l1,l2:list A.∀d:A.
619   n < |l1| → nth n A (l1@l2) d = nth n A l1 d.
620 #A #n #l1 #l2 #d
621 generalize in match n; -n; elim l1
622 [ normalize #k #Hk @⊥ @(absurd … Hk) @not_le_Sn_O
623 | #h #t #Hind #k normalize
624   cases k -k
625   [ #Hk normalize @refl
626   | #k #Hk normalize @(Hind k) @le_S_S_to_le @Hk
627   ] 
628 ]
629qed.
630
631lemma nth_append_second:
632 ∀A: Type[0].∀n.∀l1,l2:list A.∀d.n ≥ length A l1 ->
633  nth n A (l1@l2) d = nth (n - length A l1) A l2 d.
634 #A #n #l1 #l2 #d
635 generalize in match n; -n; elim l1
636 [ normalize #k #Hk <(minus_n_O) @refl
637 | #h #t #Hind #k normalize
638   cases k -k;
639   [ #Hk @⊥ @(absurd (S (|t|) ≤ 0)) [ @Hk | @not_le_Sn_O ]
640   | #k #Hk normalize @(Hind k) @le_S_S_to_le @Hk
641   ]
642 ]
643qed.
644
645   
646let rec fold_left_i_aux (A: Type[0]) (B: Type[0])
647                        (f: nat → A → B → A) (x: A) (i: nat) (l: list B) on l ≝
648  match l with
649    [ nil ⇒ x
650    | cons hd tl ⇒ fold_left_i_aux A B f (f i x hd) (S i) tl
651    ].
652
653definition fold_left_i ≝ λA,B,f,x. fold_left_i_aux A B f x O.
654
655notation "hvbox(t⌈o ↦ h⌉)"
656  with precedence 45
657  for @{ match (? : $o=$h) with [ refl ⇒ $t ] }.
658
659definition function_apply ≝
660  λA, B: Type[0].
661  λf: A → B.
662  λa: A.
663    f a.
664   
665notation "f break $ x"
666  left associative with precedence 99
667  for @{ 'function_apply $f $x }.
668 
669interpretation "Function application" 'function_apply f x = (function_apply ? ? f x).
670
671let rec iterate (A: Type[0]) (f: A → A) (a: A) (n: nat) on n ≝
672  match n with
673    [ O ⇒ a
674    | S o ⇒ f (iterate A f a o)
675    ].
676
677let rec division_aux (m: nat) (n : nat) (p: nat) ≝
678  match ltb n (S p) with
679    [ true ⇒ O
680    | false ⇒
681      match m with
682        [ O ⇒ O
683        | (S q) ⇒ S (division_aux q (n - (S p)) p)
684        ]
685    ].
686   
687definition division ≝
688  λm, n: nat.
689    match n with
690      [ O ⇒ S m
691      | S o ⇒ division_aux m m o
692      ].
693     
694notation "hvbox(n break ÷ m)"
695  right associative with precedence 47
696  for @{ 'division $n $m }.
697 
698interpretation "Nat division" 'division n m = (division n m).
699
700let rec modulus_aux (m: nat) (n: nat) (p: nat) ≝
701  match leb n p with
702    [ true ⇒ n
703    | false ⇒
704      match m with
705        [ O ⇒ n
706        | S o ⇒ modulus_aux o (n - (S p)) p
707        ]
708    ].
709   
710definition modulus ≝
711  λm, n: nat.
712    match n with
713      [ O ⇒ m
714      | S o ⇒ modulus_aux m m o
715      ].
716   
717notation "hvbox(n break 'mod' m)"
718  right associative with precedence 47
719  for @{ 'modulus $n $m }.
720 
721interpretation "Nat modulus" 'modulus m n = (modulus m n).
722
723definition divide_with_remainder ≝
724  λm, n: nat.
725    mk_Prod … (m ÷ n) (modulus m n).
726   
727let rec exponential (m: nat) (n: nat) on n ≝
728  match n with
729    [ O ⇒ S O
730    | S o ⇒ m * exponential m o
731    ].
732
733interpretation "Nat exponential" 'exp n m = (exponential n m).
734   
735notation "hvbox(a break ⊎ b)"
736 left associative with precedence 50
737for @{ 'disjoint_union $a $b }.
738interpretation "sum" 'disjoint_union A B = (Sum A B).
739
740theorem less_than_or_equal_monotone:
741  ∀m, n: nat.
742    m ≤ n → (S m) ≤ (S n).
743 #m #n #H
744 elim H
745 /2/
746qed.
747
748theorem less_than_or_equal_b_complete:
749  ∀m, n: nat.
750    leb m n = false → ¬(m ≤ n).
751 #m;
752 elim m;
753 normalize
754 [ #n #H
755   destruct
756 | #y #H1 #z
757   cases z
758   normalize
759   [ #H
760     /2/
761   | /3/
762   ]
763 ]
764qed.
765
766theorem less_than_or_equal_b_correct:
767  ∀m, n: nat.
768    leb m n = true → m ≤ n.
769 #m
770 elim m
771 //
772 #y #H1 #z
773 cases z
774 normalize
775 [ #H
776   destruct
777 | #n #H lapply (H1 … H) /2/
778 ]
779qed.
780
781definition less_than_or_equal_b_elim:
782 ∀m, n: nat.
783 ∀P: bool → Type[0].
784   (m ≤ n → P true) → (¬(m ≤ n) → P false) → P (leb m n).
785 #m #n #P #H1 #H2;
786 lapply (less_than_or_equal_b_correct m n)
787 lapply (less_than_or_equal_b_complete m n)
788 cases (leb m n)
789 /3/
790qed.
791
792lemma inclusive_disjunction_true:
793  ∀b, c: bool.
794    (orb b c) = true → b = true ∨ c = true.
795  # b
796  # c
797  elim b
798  [ normalize
799    # H
800    @ or_introl
801    %
802  | normalize
803    /3 by trans_eq, orb_true_l/
804  ]
805qed.
806
807lemma conjunction_true:
808  ∀b, c: bool.
809    andb b c = true → b = true ∧ c = true.
810  # b
811  # c
812  elim b
813  normalize
814  [ /2 by conj/
815  | # K
816    destruct
817  ]
818qed.
819
820lemma eq_true_false: false=true → False.
821 # K
822 destruct
823qed.
824
825lemma inclusive_disjunction_b_true: ∀b. orb b true = true.
826 # b
827 cases b
828 %
829qed.
830
831definition bool_to_Prop ≝
832 λb. match b with [ true ⇒ True | false ⇒ False ].
833
834coercion bool_to_Prop: ∀b:bool. Prop ≝ bool_to_Prop on _b:bool to Type[0].
835
836lemma eq_false_to_notb: ∀b. b = false → ¬ b.
837 *; /2/
838qed.
839
840lemma length_append:
841 ∀A.∀l1,l2:list A.
842  |l1 @ l2| = |l1| + |l2|.
843 #A #l1 elim l1
844  [ //
845  | #hd #tl #IH #l2 normalize <IH //]
846qed.
Note: See TracBrowser for help on using the repository browser.