source: src/ASM/Util.ma @ 1964

Last change on this file since 1964 was 1964, checked in by tranquil, 7 years ago

introduced as_label_of_cost and adapted accordingly. Equality of cost mapping sums

File size: 33.1 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 [ ] }.
14notation "Ⓧ" with precedence 90
15  for @{ λabs.match abs in False with [ ] }.
16
17
18definition ltb ≝
19  λm, n: nat.
20    leb (S m) n.
21   
22definition geb ≝
23  λm, n: nat.
24    leb n m.
25
26definition gtb ≝
27  λm, n: nat.
28    ltb n m.
29
30(* dpm: unless I'm being stupid, this isn't defined in the stdlib? *)
31let rec eq_nat (n: nat) (m: nat) on n: bool ≝
32  match n with
33  [ O ⇒ match m with [ O ⇒ true | _ ⇒ false ]
34  | S n' ⇒ match m with [ S m' ⇒ eq_nat n' m' | _ ⇒ false ]
35  ].
36
37let rec forall
38  (A: Type[0]) (f: A → bool) (l: list A)
39    on l ≝
40  match l with
41  [ nil        ⇒ true
42  | cons hd tl ⇒ f hd ∧ forall A f tl
43  ].
44
45let rec prefix
46  (A: Type[0]) (k: nat) (l: list A)
47    on l ≝
48  match l with
49  [ nil ⇒ [ ]
50  | cons hd tl ⇒
51    match k with
52    [ O ⇒ [ ]
53    | S k' ⇒ hd :: prefix A k' tl
54    ]
55  ].
56 
57let rec fold_left2
58  (A: Type[0]) (B: Type[0]) (C: Type[0]) (f: A → B → C → A) (accu: A)
59  (left: list B) (right: list C) (proof: |left| = |right|)
60    on left: A ≝
61  match left return λx. |x| = |right| → A with
62  [ nil ⇒ λnil_prf.
63    match right return λx. |[ ]| = |x| → A with
64    [ nil ⇒ λnil_nil_prf. accu
65    | cons hd tl ⇒ λcons_nil_absrd. ?
66    ] nil_prf
67  | cons hd tl ⇒ λcons_prf.
68    match right return λx. |hd::tl| = |x| → A with
69    [ nil ⇒ λcons_nil_absrd. ?
70    | cons hd' tl' ⇒ λcons_cons_prf.
71        fold_left2 …  f (f accu hd hd') tl tl' ?
72    ] cons_prf
73  ] proof.
74  [ 1: normalize in cons_nil_absrd;
75       destruct(cons_nil_absrd)
76  | 2: normalize in cons_nil_absrd;
77       destruct(cons_nil_absrd)
78  | 3: normalize in cons_cons_prf;
79       @injective_S
80       assumption
81  ]
82qed.
83
84let rec remove_n_first_internal
85  (i: nat) (A: Type[0]) (l: list A) (n: nat)
86    on l ≝
87  match l with
88  [ nil ⇒ [ ]
89  | cons hd tl ⇒
90    match eq_nat i n with
91    [ true ⇒ l
92    | _ ⇒ remove_n_first_internal (S i) A tl n
93    ]
94  ].
95
96definition remove_n_first ≝
97  λA: Type[0].
98  λn: nat.
99  λl: list A.
100    remove_n_first_internal 0 A l n.
101   
102let rec foldi_from_until_internal
103  (A: Type[0]) (i: nat) (res: ?) (rem: list A) (m: nat) (f: nat → list A → A → list A)
104    on rem ≝
105  match rem with
106  [ nil ⇒ res
107  | cons e tl ⇒
108    match geb i m with
109    [ true ⇒ res
110    | _ ⇒ foldi_from_until_internal A (S i) (f i res e) tl m f
111    ]
112  ].
113
114definition foldi_from_until ≝
115  λA: Type[0].
116  λn: nat.
117  λm: nat.
118  λf: ?.
119  λa: ?.
120  λl: ?.
121    foldi_from_until_internal A 0 a (remove_n_first A n l) m f.
122
123definition foldi_from ≝
124  λA: Type[0].
125  λn.
126  λf.
127  λa.
128  λl.
129    foldi_from_until A n (|l|) f a l.
130
131definition foldi_until ≝
132  λA: Type[0].
133  λm.
134  λf.
135  λa.
136  λl.
137    foldi_from_until A 0 m f a l.
138
139definition foldi ≝
140  λA: Type[0].
141  λf.
142  λa.
143  λl.
144    foldi_from_until A 0 (|l|) f a l.
145
146definition hd_safe ≝
147  λA: Type[0].
148  λl: list A.
149  λproof: 0 < |l|.
150  match l return λx. 0 < |x| → A with
151  [ nil ⇒ λnil_absrd. ?
152  | cons hd tl ⇒ λcons_prf. hd
153  ] proof.
154  normalize in nil_absrd;
155  cases(not_le_Sn_O 0)
156  #HYP
157  cases(HYP nil_absrd)
158qed.
159
160definition tail_safe ≝
161  λA: Type[0].
162  λl: list A.
163  λproof: 0 < |l|.
164  match l return λx. 0 < |x| → list A with
165  [ nil ⇒ λnil_absrd. ?
166  | cons hd tl ⇒ λcons_prf. tl
167  ] proof.
168  normalize in nil_absrd;
169  cases(not_le_Sn_O 0)
170  #HYP
171  cases(HYP nil_absrd)
172qed.
173
174let rec split
175  (A: Type[0]) (l: list A) (index: nat) (proof: index ≤ |l|)
176    on index ≝
177  match index return λx. x ≤ |l| → (list A) × (list A) with
178  [ O ⇒ λzero_prf. 〈[], l〉
179  | S index' ⇒ λsucc_prf.
180    match l return λx. S index' ≤ |x| → (list A) × (list A) with
181    [ nil ⇒ λnil_absrd. ?
182    | cons hd tl ⇒ λcons_prf.
183      let 〈l1, l2〉 ≝ split A tl index' ? in
184        〈hd :: l1, l2〉
185    ] succ_prf
186  ] proof.
187  [1: normalize in nil_absrd;
188      cases(not_le_Sn_O index')
189      #HYP
190      cases(HYP nil_absrd)
191  |2: normalize in cons_prf;
192      @le_S_S_to_le
193      assumption
194  ]
195qed.
196
197let rec nth_safe
198  (elt_type: Type[0]) (index: nat) (the_list: list elt_type)
199  (proof: index < | the_list |)
200    on index ≝
201  match index return λs. s < | the_list | → elt_type with
202  [ O ⇒
203    match the_list return λt. 0 < | t | → elt_type with
204    [ nil        ⇒ λnil_absurd. ?
205    | cons hd tl ⇒ λcons_proof. hd
206    ]
207  | S index' ⇒
208    match the_list return λt. S index' < | t | → elt_type with
209    [ nil ⇒ λnil_absurd. ?
210    | cons hd tl ⇒
211      λcons_proof. nth_safe elt_type index' tl ?
212    ]
213  ] proof.
214  [ normalize in nil_absurd;
215    cases (not_le_Sn_O 0)
216    #ABSURD
217    elim (ABSURD nil_absurd)
218  | normalize in nil_absurd;
219    cases (not_le_Sn_O (S index'))
220    #ABSURD
221    elim (ABSURD nil_absurd)
222  | normalize in cons_proof;
223    @le_S_S_to_le
224    assumption
225  ]
226qed.
227
228definition last_safe ≝
229  λelt_type: Type[0].
230  λthe_list: list elt_type.
231  λproof   : 0 < | the_list |.
232    nth_safe elt_type (|the_list| - 1) the_list ?.
233  normalize /2 by lt_plus_to_minus/
234qed.
235
236let rec reduce
237  (A: Type[0]) (B: Type[0]) (left: list A) (right: list B) on left ≝
238  match left with
239  [ nil ⇒ 〈〈[ ], [ ]〉, 〈[ ], right〉〉
240  | cons hd tl ⇒
241    match right with
242    [ nil ⇒ 〈〈[ ], left〉, 〈[ ], [ ]〉〉
243    | cons hd' tl' ⇒
244      let 〈cleft, cright〉 ≝ reduce A B tl tl' in
245      let 〈commonl, restl〉 ≝ cleft in
246      let 〈commonr, restr〉 ≝ cright in
247        〈〈hd :: commonl, restl〉, 〈hd' :: commonr, restr〉〉
248    ]
249  ].
250
251(*
252axiom reduce_strong:
253  ∀A: Type[0].
254  ∀left: list A.
255  ∀right: list A.
256    Σret: ((list A) × (list A)) × ((list A) × (list A)). | \fst (\fst ret) | = | \fst (\snd ret) |.
257*)
258
259let rec reduce_strong
260  (A: Type[0]) (B: Type[0]) (left: list A) (right: list B)
261    on left : Σret: ((list A) × (list A)) × ((list B) × (list B)). |\fst (\fst ret)| = |\fst (\snd ret)|  ≝
262  match left with
263  [ nil ⇒ 〈〈[ ], [ ]〉, 〈[ ], right〉〉
264  | cons hd tl ⇒
265    match right with
266    [ nil ⇒ 〈〈[ ], left〉, 〈[ ], [ ]〉〉
267    | cons hd' tl' ⇒
268      let 〈cleft, cright〉 ≝ reduce_strong A B tl tl' in
269      let 〈commonl, restl〉 ≝ cleft in
270      let 〈commonr, restr〉 ≝ cright in
271        〈〈hd :: commonl, restl〉, 〈hd' :: commonr, restr〉〉
272    ]
273  ].
274  [ 1: normalize %
275  | 2: normalize %
276  | 3: normalize >p3 in p2; >p4 cases (reduce_strong … tl tl1) normalize
277       #X #H #EQ destruct // ]
278qed.
279   
280let rec map2_opt
281  (A: Type[0]) (B: Type[0]) (C: Type[0]) (f: A → B → C)
282  (left: list A) (right: list B) on left ≝
283  match left with
284  [ nil ⇒
285    match right with
286    [ nil ⇒ Some ? (nil C)
287    | _ ⇒ None ?
288    ]
289  | cons hd tl ⇒
290    match right with
291    [ nil ⇒ None ?
292    | cons hd' tl' ⇒
293      match map2_opt A B C f tl tl' with
294      [ None ⇒ None ?
295      | Some tail ⇒ Some ? (f hd hd' :: tail)
296      ]
297    ]
298  ].
299
300let rec map2
301  (A: Type[0]) (B: Type[0]) (C: Type[0]) (f: A → B → C)
302  (left: list A) (right: list B) (proof: | left | = | right |) on left ≝
303  match left return λx. | x | = | right | → list C with
304  [ nil ⇒
305    match right return λy. | [] | = | y | → list C with
306    [ nil ⇒ λnil_prf. nil C
307    | _ ⇒ λcons_absrd. ?
308    ]
309  | cons hd tl ⇒
310    match right return λy. | hd::tl | = | y | → list C with
311    [ nil ⇒ λnil_absrd. ?
312    | cons hd' tl' ⇒ λcons_prf. (f hd hd') :: map2 A B C f tl tl' ?
313    ]
314  ] proof.
315  [1: normalize in cons_absrd;
316      destruct(cons_absrd)
317  |2: normalize in nil_absrd;
318      destruct(nil_absrd)
319  |3: normalize in cons_prf;
320      destruct(cons_prf)
321      assumption
322  ]
323qed.
324
325let rec map3
326  (A: Type[0]) (B: Type[0]) (C: Type[0]) (D: Type[0]) (f: A → B → C → D)
327  (left: list A) (centre: list B) (right: list C)
328  (prflc: |left| = |centre|) (prfcr: |centre| = |right|) on left ≝
329  match left return λx. |x| = |centre| → list D with
330  [ nil ⇒ λnil_prf.
331    match centre return λx. |x| = |right| → list D with
332    [ nil ⇒ λnil_nil_prf.
333      match right return λx. |nil ?| = |x| → list D with
334      [ nil        ⇒ λnil_nil_nil_prf. nil D
335      | cons hd tl ⇒ λcons_nil_nil_absrd. ?
336      ] nil_nil_prf
337    | cons hd tl ⇒ λnil_cons_absrd. ?
338    ] prfcr
339  | cons hd tl ⇒ λcons_prf.
340    match centre return λx. |x| = |right| → list D with
341    [ nil ⇒ λcons_nil_absrd. ?
342    | cons hd' tl' ⇒ λcons_cons_prf.
343      match right return λx. |right| = |x| → |cons ? hd' tl'| = |x| → list D with
344      [ nil ⇒ λrefl_prf. λcons_cons_nil_absrd. ?
345      | cons hd'' tl'' ⇒ λrefl_prf. λcons_cons_cons_prf.
346        (f hd hd' hd'') :: (map3 A B C D f tl tl' tl'' ? ?)
347      ] (refl ? (|right|)) cons_cons_prf
348    ] prfcr
349  ] prflc.
350  [ 1: normalize in cons_nil_nil_absrd;
351       destruct(cons_nil_nil_absrd)
352  | 2: generalize in match nil_cons_absrd;
353       <prfcr <nil_prf #HYP
354       normalize in HYP;
355       destruct(HYP)
356  | 3: generalize in match cons_nil_absrd;
357       <prfcr <cons_prf #HYP
358       normalize in HYP;
359       destruct(HYP)
360  | 4: normalize in cons_cons_nil_absrd;
361       destruct(cons_cons_nil_absrd)
362  | 5: normalize in cons_cons_cons_prf;
363       destruct(cons_cons_cons_prf)
364       assumption
365  | 6: generalize in match cons_cons_cons_prf;
366       <refl_prf <prfcr <cons_prf #HYP
367       normalize in HYP;
368       destruct(HYP)
369       @sym_eq assumption
370  ]
371qed.
372 
373lemma eq_rect_Type0_r :
374  ∀A: Type[0].
375  ∀a:A.
376  ∀P: ∀x:A. eq ? x a → Type[0]. P a (refl A a) → ∀x: A.∀p:eq ? x a. P x p.
377  #A #a #P #H #x #p lapply H lapply P cases p //
378qed.
379 
380let rec safe_nth (A: Type[0]) (n: nat) (l: list A) (p: n < length A l) on n: A ≝
381  match n return λo. o < length A l → A with
382  [ O ⇒
383    match l return λm. 0 < length A m → A with
384    [ nil ⇒ λabsd1. ?
385    | cons hd tl ⇒ λprf1. hd
386    ]
387  | S n' ⇒
388    match l return λm. S n' < length A m → A with
389    [ nil ⇒ λabsd2. ?
390    | cons hd tl ⇒ λprf2. safe_nth A n' tl ?
391    ]
392  ] ?.
393  [ 1:
394    @ p
395  | 4:
396    normalize in prf2;
397    normalize
398    @ le_S_S_to_le
399    assumption
400  | 2:
401    normalize in absd1;
402    cases (not_le_Sn_O O)
403    # H
404    elim (H absd1)
405  | 3:
406    normalize in absd2;
407    cases (not_le_Sn_O (S n'))
408    # H
409    elim (H absd2)
410  ]
411qed.
412 
413let rec nub_by_internal (A: Type[0]) (f: A → A → bool) (l: list A) (n: nat) on n ≝
414  match n with
415  [ O ⇒
416    match l with
417    [ nil ⇒ [ ]
418    | cons hd tl ⇒ l
419    ]
420  | S n ⇒
421    match l with
422    [ nil ⇒ [ ]
423    | cons hd tl ⇒
424      hd :: nub_by_internal A f (filter ? (λy. notb (f y hd)) tl) n
425    ]
426  ].
427 
428definition nub_by ≝
429  λA: Type[0].
430  λf: A → A → bool.
431  λl: list A.
432    nub_by_internal A f l (length ? l).
433 
434let rec member (A: Type[0]) (eq: A → A → bool) (a: A) (l: list A) on l ≝
435  match l with
436  [ nil ⇒ false
437  | cons hd tl ⇒ orb (eq a hd) (member A eq a tl)
438  ].
439 
440let rec take (A: Type[0]) (n: nat) (l: list A) on n: list A ≝
441  match n with
442  [ O ⇒ [ ]
443  | S n ⇒
444    match l with
445    [ nil ⇒ [ ]
446    | cons hd tl ⇒ hd :: take A n tl
447    ]
448  ].
449 
450let rec drop (A: Type[0]) (n: nat) (l: list A) on n ≝
451  match n with
452  [ O ⇒ l
453  | S n ⇒
454    match l with
455    [ nil ⇒ [ ]
456    | cons hd tl ⇒ drop A n tl
457    ]
458  ].
459 
460definition list_split ≝
461  λA: Type[0].
462  λn: nat.
463  λl: list A.
464    〈take A n l, drop A n l〉.
465 
466let rec mapi_internal (A: Type[0]) (B: Type[0]) (n: nat) (f: nat → A → B)
467                      (l: list A) on l: list B ≝
468  match l with
469  [ nil ⇒ nil ?
470  | cons hd tl ⇒ (f n hd) :: (mapi_internal A B (n + 1) f tl)
471  ]. 
472
473definition mapi ≝
474  λA, B: Type[0].
475  λf: nat → A → B.
476  λl: list A.
477    mapi_internal A B 0 f l.
478
479let rec zip_pottier
480  (A: Type[0]) (B: Type[0]) (left: list A) (right: list B)
481    on left ≝
482  match left with
483  [ nil ⇒ [ ]
484  | cons hd tl ⇒
485    match right with
486    [ nil ⇒ [ ]
487    | cons hd' tl' ⇒ 〈hd, hd'〉 :: zip_pottier A B tl tl'
488    ]
489  ].
490
491let rec zip_safe
492  (A: Type[0]) (B: Type[0]) (left: list A) (right: list B) (prf: |left| = |right|)
493    on left ≝
494  match left return λx. |x| = |right| → list (A × B) with
495  [ nil ⇒ λnil_prf.
496    match right return λx. |[ ]| = |x| → list (A × B) with
497    [ nil ⇒ λnil_nil_prf. [ ]
498    | cons hd tl ⇒ λnil_cons_absrd. ?
499    ] nil_prf
500  | cons hd tl ⇒ λcons_prf.
501    match right return λx. |hd::tl| = |x| → list (A × B) with
502    [ nil ⇒ λcons_nil_absrd. ?
503    | cons hd' tl' ⇒ λcons_cons_prf. 〈hd, hd'〉 :: zip_safe A B tl tl' ?
504    ] cons_prf
505  ] prf.
506  [ 1: normalize in nil_cons_absrd;
507       destruct(nil_cons_absrd)
508  | 2: normalize in cons_nil_absrd;
509       destruct(cons_nil_absrd)
510  | 3: normalize in cons_cons_prf;
511       @injective_S
512       assumption
513  ]
514qed.
515
516let rec zip (A: Type[0]) (B: Type[0]) (l: list A) (r: list B) on l: option (list (A × B)) ≝
517  match l with
518  [ nil ⇒ Some ? (nil (A × B))
519  | cons hd tl ⇒
520    match r with
521    [ nil ⇒ None ?
522    | cons hd' tl' ⇒
523      match zip ? ? tl tl' with
524      [ None ⇒ None ?
525      | Some tail ⇒ Some ? (〈hd, hd'〉 :: tail)
526      ]
527    ]
528  ].
529
530let rec foldl (A: Type[0]) (B: Type[0]) (f: A → B → A) (a: A) (l: list B) on l ≝
531  match l with
532  [ nil ⇒ a
533  | cons hd tl ⇒ foldl A B f (f a hd) tl
534  ].
535
536lemma foldl_step:
537 ∀A:Type[0].
538  ∀B: Type[0].
539   ∀H: A → B → A.
540    ∀acc: A.
541     ∀pre: list B.
542      ∀hd:B.
543       foldl A B H acc (pre@[hd]) = (H (foldl A B H acc pre) hd).
544 #A #B #H #acc #pre generalize in match acc; -acc; elim pre
545  [ normalize; //
546  | #hd #tl #IH #acc #X normalize; @IH ]
547qed.
548
549lemma foldl_append:
550 ∀A:Type[0].
551  ∀B: Type[0].
552   ∀H: A → B → A.
553    ∀acc: A.
554     ∀suff,pre: list B.
555      foldl A B H acc (pre@suff) = (foldl A B H (foldl A B H acc pre) suff).
556 #A #B #H #acc #suff elim suff
557  [ #pre >append_nil %
558  | #hd #tl #IH #pre whd in ⊢ (???%); <(foldl_step … H ??) applyS (IH (pre@[hd])) ]
559qed.
560
561definition flatten ≝
562  λA: Type[0].
563  λl: list (list A).
564    foldr ? ? (append ?) [ ] l.
565
566(* redirecting to library reverse *)
567definition rev ≝ reverse.
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 normalize #IH
597    >rev_append_def
598    >rev_append_def
599    >rev_append_def
600    >append_nil
601    normalize
602    >IH
603    @associative_append
604  ]
605qed.
606
607lemma rev_length:
608  ∀A: Type[0].
609  ∀l: list A.
610    |rev A l| = |l|.
611  #A #L
612  elim L
613  [ %
614  | #HD #TL normalize #IH
615    >rev_append_def
616    >(append_length A (rev A TL) [HD])
617    normalize /2 by /
618  ]
619qed.
620
621lemma nth_append_first:
622 ∀A:Type[0].
623 ∀n:nat.∀l1,l2:list A.∀d:A.
624   n < |l1| → nth n A (l1@l2) d = nth n A l1 d.
625 #A #n #l1 #l2 #d
626 generalize in match n; -n; elim l1
627 [ normalize #k #Hk @⊥ @(absurd … Hk) @not_le_Sn_O
628 | #h #t #Hind #k normalize
629   cases k -k
630   [ #Hk normalize @refl
631   | #k #Hk normalize @(Hind k) @le_S_S_to_le @Hk
632   ] 
633 ]
634qed.
635
636lemma nth_append_second:
637 ∀A: Type[0].∀n.∀l1,l2:list A.∀d.n ≥ length A l1 ->
638  nth n A (l1@l2) d = nth (n - length A l1) A l2 d.
639 #A #n #l1 #l2 #d
640 generalize in match n; -n; elim l1
641 [ normalize #k #Hk <(minus_n_O) @refl
642 | #h #t #Hind #k normalize
643   cases k -k;
644   [ #Hk @⊥ @(absurd (S (|t|) ≤ 0)) [ @Hk | @not_le_Sn_O ]
645   | #k #Hk normalize @(Hind k) @le_S_S_to_le @Hk
646   ]
647 ]
648qed.
649
650   
651let rec fold_left_i_aux (A: Type[0]) (B: Type[0])
652                        (f: nat → A → B → A) (x: A) (i: nat) (l: list B) on l ≝
653  match l with
654    [ nil ⇒ x
655    | cons hd tl ⇒ fold_left_i_aux A B f (f i x hd) (S i) tl
656    ].
657
658definition fold_left_i ≝ λA,B,f,x. fold_left_i_aux A B f x O.
659
660notation "hvbox(t⌈o ↦ h⌉)"
661  with precedence 45
662  for @{ match (? : $o=$h) with [ refl ⇒ $t ] }.
663
664definition function_apply ≝
665  λA, B: Type[0].
666  λf: A → B.
667  λa: A.
668    f a.
669   
670notation "f break $ x"
671  left associative with precedence 99
672  for @{ 'function_apply $f $x }.
673 
674interpretation "Function application" 'function_apply f x = (function_apply ? ? f x).
675
676let rec iterate (A: Type[0]) (f: A → A) (a: A) (n: nat) on n ≝
677  match n with
678    [ O ⇒ a
679    | S o ⇒ f (iterate A f a o)
680    ].
681
682let rec division_aux (m: nat) (n : nat) (p: nat) ≝
683  match ltb n (S p) with
684    [ true ⇒ O
685    | false ⇒
686      match m with
687        [ O ⇒ O
688        | (S q) ⇒ S (division_aux q (n - (S p)) p)
689        ]
690    ].
691   
692definition division ≝
693  λm, n: nat.
694    match n with
695      [ O ⇒ S m
696      | S o ⇒ division_aux m m o
697      ].
698     
699notation "hvbox(n break ÷ m)"
700  right associative with precedence 47
701  for @{ 'division $n $m }.
702 
703interpretation "Nat division" 'division n m = (division n m).
704
705let rec modulus_aux (m: nat) (n: nat) (p: nat) ≝
706  match leb n p with
707    [ true ⇒ n
708    | false ⇒
709      match m with
710        [ O ⇒ n
711        | S o ⇒ modulus_aux o (n - (S p)) p
712        ]
713    ].
714   
715definition modulus ≝
716  λm, n: nat.
717    match n with
718      [ O ⇒ m
719      | S o ⇒ modulus_aux m m o
720      ].
721   
722notation "hvbox(n break 'mod' m)"
723  right associative with precedence 47
724  for @{ 'modulus $n $m }.
725 
726interpretation "Nat modulus" 'modulus m n = (modulus m n).
727
728definition divide_with_remainder ≝
729  λm, n: nat.
730    mk_Prod … (m ÷ n) (modulus m n).
731   
732let rec exponential (m: nat) (n: nat) on n ≝
733  match n with
734    [ O ⇒ S O
735    | S o ⇒ m * exponential m o
736    ].
737
738interpretation "Nat exponential" 'exp n m = (exponential n m).
739   
740notation "hvbox(a break ⊎ b)"
741 left associative with precedence 55
742for @{ 'disjoint_union $a $b }.
743interpretation "sum" 'disjoint_union A B = (Sum A B).
744
745theorem less_than_or_equal_monotone:
746  ∀m, n: nat.
747    m ≤ n → (S m) ≤ (S n).
748 #m #n #H
749 elim H
750 /2 by le_n, le_S/
751qed.
752
753theorem less_than_or_equal_b_complete:
754  ∀m, n: nat.
755    leb m n = false → ¬(m ≤ n).
756 #m;
757 elim m;
758 normalize
759 [ #n #H
760   destruct
761 | #y #H1 #z
762   cases z
763   normalize
764   [ #H
765     /2 by /
766   | /3 by not_le_to_not_le_S_S/
767   ]
768 ]
769qed.
770
771theorem less_than_or_equal_b_correct:
772  ∀m, n: nat.
773    leb m n = true → m ≤ n.
774 #m
775 elim m
776 //
777 #y #H1 #z
778 cases z
779 normalize
780 [ #H
781   destruct
782 | #n #H lapply (H1 … H) /2 by le_S_S/
783 ]
784qed.
785
786definition less_than_or_equal_b_elim:
787 ∀m, n: nat.
788 ∀P: bool → Type[0].
789   (m ≤ n → P true) → (¬(m ≤ n) → P false) → P (leb m n).
790 #m #n #P #H1 #H2;
791 lapply (less_than_or_equal_b_correct m n)
792 lapply (less_than_or_equal_b_complete m n)
793 cases (leb m n)
794 /3 by /
795qed.
796
797lemma lt_m_n_to_exists_o_plus_m_n:
798  ∀m, n: nat.
799    m < n → ∃o: nat. m + o = n.
800  #m #n
801  cases m
802  [1:
803    #irrelevant
804    %{n} %
805  |2:
806    #m' #lt_hyp
807    %{(n - S m')}
808    >commutative_plus in ⊢ (??%?);
809    <plus_minus_m_m
810    [1:
811      %
812    |2:
813      @lt_S_to_lt
814      assumption
815    ]
816  ]
817qed.
818
819lemma lt_O_n_to_S_pred_n_n:
820  ∀n: nat.
821    0 < n → S (pred n) = n.
822  #n
823  cases n
824  [1:
825    #absurd
826    cases(lt_to_not_zero 0 0 absurd)
827  |2:
828    #n' #lt_hyp %
829  ]
830qed.
831
832lemma exists_plus_m_n_to_exists_Sn:
833  ∀m, n: nat.
834    m < n → ∃p: nat. S p = n.
835  #m #n
836  cases m
837  [1:
838    #lt_hyp %{(pred n)}
839    @(lt_O_n_to_S_pred_n_n … lt_hyp)
840  |2:
841    #m' #lt_hyp %{(pred n)}
842    @(lt_O_n_to_S_pred_n_n)
843    @(transitive_le … (S m') …)
844    [1:
845      //
846    |2:
847      @lt_S_to_lt
848      assumption
849    ]
850  ]
851qed.
852
853lemma plus_right_monotone:
854  ∀m, n, o: nat.
855    m = n → m + o = n + o.
856  #m #n #o #refl >refl %
857qed.
858
859lemma plus_left_monotone:
860  ∀m, n, o: nat.
861    m = n → o + m = o + n.
862  #m #n #o #refl destruct %
863qed.
864
865lemma minus_plus_cancel:
866  ∀m, n : nat.
867  ∀proof: n ≤ m.
868    (m - n) + n = m.
869  #m #n #proof /2 by plus_minus/
870qed.
871
872lemma lt_to_le_to_le:
873  ∀n, m, p: nat.
874    n < m → m ≤ p → n ≤ p.
875  #n #m #p #H #H1
876  elim H
877  [1:
878    @(transitive_le n m p) /2/
879  |2:
880    /2/
881  ]
882qed.
883
884lemma eqb_decidable:
885  ∀l, r: nat.
886    (eqb l r = true) ∨ (eqb l r = false).
887  #l #r //
888qed.
889
890lemma r_Sr_and_l_r_to_Sl_r:
891  ∀r, l: nat.
892    (∃r': nat. r = S r' ∧ l = r') → S l = r.
893  #r #l #exists_hyp
894  cases exists_hyp #r'
895  #and_hyp cases and_hyp
896  #left_hyp #right_hyp
897  destruct %
898qed.
899
900lemma eqb_Sn_to_exists_n':
901  ∀m, n: nat.
902    eqb (S m) n = true → ∃n': nat. n = S n'.
903  #m #n
904  cases n
905  [1:
906    normalize #absurd
907    destruct(absurd)
908  |2:
909    #n' #_ %{n'} %
910  ]
911qed.
912
913lemma eqb_true_to_eqb_S_S_true:
914  ∀m, n: nat.
915    eqb m n = true → eqb (S m) (S n) = true.
916  #m #n normalize #assm assumption
917qed.
918
919lemma eqb_S_S_true_to_eqb_true:
920  ∀m, n: nat.
921    eqb (S m) (S n) = true → eqb m n = true.
922  #m #n normalize #assm assumption
923qed.
924
925lemma eqb_true_to_refl:
926  ∀l, r: nat.
927    eqb l r = true → l = r.
928  #l
929  elim l
930  [1:
931    #r cases r
932    [1:
933      #_ %
934    |2:
935      #l' normalize
936      #absurd destruct(absurd)
937    ]
938  |2:
939    #l' #inductive_hypothesis #r
940    #eqb_refl @r_Sr_and_l_r_to_Sl_r
941    %{(pred r)} @conj
942    [1:
943      cases (eqb_Sn_to_exists_n' … eqb_refl)
944      #r' #S_assm >S_assm %
945    |2:
946      cases (eqb_Sn_to_exists_n' … eqb_refl)
947      #r' #refl_assm destruct normalize
948      @inductive_hypothesis
949      normalize in eqb_refl; assumption
950    ]
951  ]
952qed.
953
954lemma r_O_or_exists_r_r_Sr_and_l_neq_r_to_Sl_neq_r:
955  ∀r, l: nat.
956    r = O ∨ (∃r': nat. r = S r' ∧ l ≠ r') → S l ≠ r.
957  #r #l #disj_hyp
958  cases disj_hyp
959  [1:
960    #r_O_refl destruct @nmk
961    #absurd destruct(absurd)
962  |2:
963    #exists_hyp cases exists_hyp #r'
964    #conj_hyp cases conj_hyp #left_conj #right_conj
965    destruct @nmk #S_S_refl_hyp
966    elim right_conj #hyp @hyp //
967  ]
968qed.
969
970lemma neq_l_r_to_neq_Sl_Sr:
971  ∀l, r: nat.
972    l ≠ r → S l ≠ S r.
973  #l #r #l_neq_r_assm
974  @nmk #Sl_Sr_assm cases l_neq_r_assm
975  #assm @assm //
976qed.
977
978lemma eqb_false_to_not_refl:
979  ∀l, r: nat.
980    eqb l r = false → l ≠ r.
981  #l
982  elim l
983  [1:
984    #r cases r
985    [1:
986      normalize #absurd destruct(absurd)
987    |2:
988      #r' #_ @nmk
989      #absurd destruct(absurd)
990    ]
991  |2:
992    #l' #inductive_hypothesis #r
993    cases r
994    [1:
995      #eqb_false_assm
996      @r_O_or_exists_r_r_Sr_and_l_neq_r_to_Sl_neq_r
997      @or_introl %
998    |2:
999      #r' #eqb_false_assm
1000      @neq_l_r_to_neq_Sl_Sr
1001      @inductive_hypothesis
1002      assumption
1003    ]
1004  ]
1005qed.
1006
1007lemma le_to_lt_or_eq:
1008  ∀m, n: nat.
1009    m ≤ n → m = n ∨ m < n.
1010  #m #n #le_hyp
1011  cases le_hyp
1012  [1:
1013    @or_introl %
1014  |2:
1015    #m' #le_hyp'
1016    @or_intror
1017    normalize
1018    @le_S_S assumption
1019  ]
1020qed.
1021
1022lemma le_neq_to_lt:
1023  ∀m, n: nat.
1024    m ≤ n → m ≠ n → m < n.
1025  #m #n #le_hyp #neq_hyp
1026  cases neq_hyp
1027  #eq_absurd_hyp
1028  generalize in match (le_to_lt_or_eq m n le_hyp);
1029  #disj_assm cases disj_assm
1030  [1:
1031    #absurd cases (eq_absurd_hyp absurd)
1032  |2:
1033    #assm assumption
1034  ]
1035qed.
1036
1037inverter nat_jmdiscr for nat.
1038
1039lemma plus_lt_to_lt:
1040  ∀m, n, o: nat.
1041    m + n < o → m < o.
1042  #m #n #o
1043  elim n
1044  [1:
1045    <(plus_n_O m) in ⊢ (% → ?);
1046    #assumption assumption
1047  |2:
1048    #n' #inductive_hypothesis
1049    <(plus_n_Sm m n') in ⊢ (% → ?);
1050    #assm @inductive_hypothesis
1051    normalize in assm; normalize
1052    /2 by lt_S_to_lt/
1053  ]
1054qed.
1055
1056include "arithmetics/div_and_mod.ma".
1057
1058lemma n_plus_1_n_to_False:
1059  ∀n: nat.
1060    n + 1 = n → False.
1061  #n elim n
1062  [1:
1063    normalize #absurd destruct(absurd)
1064  |2:
1065    #n' #inductive_hypothesis normalize
1066    #absurd @inductive_hypothesis /2 by injective_S/
1067  ]
1068qed.
1069
1070lemma one_two_times_n_to_False:
1071  ∀n: nat.
1072    1=2*n→False.
1073  #n cases n
1074  [1:
1075    normalize #absurd destruct(absurd)
1076  |2:
1077    #n' normalize #absurd
1078    lapply (injective_S … absurd) -absurd #absurd
1079    /2/
1080  ]
1081qed.
1082
1083let rec odd_p
1084  (n: nat)
1085    on n ≝
1086  match n with
1087  [ O ⇒ False
1088  | S n' ⇒ even_p n'
1089  ]
1090and even_p
1091  (n: nat)
1092    on n ≝
1093  match n with
1094  [ O ⇒ True
1095  | S n' ⇒ odd_p n'
1096  ].
1097
1098let rec n_even_p_to_n_plus_2_even_p
1099  (n: nat)
1100    on n: even_p n → even_p (n + 2) ≝
1101  match n with
1102  [ O ⇒ ?
1103  | S n' ⇒ ?
1104  ]
1105and n_odd_p_to_n_plus_2_odd_p
1106  (n: nat)
1107    on n: odd_p n → odd_p (n + 2) ≝
1108  match n with
1109  [ O ⇒ ?
1110  | S n' ⇒ ?
1111  ].
1112  [1,3:
1113    normalize #assm assumption
1114  |2:
1115    normalize @n_odd_p_to_n_plus_2_odd_p
1116  |4:
1117    normalize @n_even_p_to_n_plus_2_even_p
1118  ]
1119qed.
1120
1121let rec two_times_n_even_p
1122  (n: nat)
1123    on n: even_p (2 * n) ≝
1124  match n with
1125  [ O ⇒ ?
1126  | S n' ⇒ ?
1127  ]
1128and two_times_n_plus_one_odd_p
1129  (n: nat)
1130    on n: odd_p ((2 * n) + 1) ≝
1131  match n with
1132  [ O ⇒ ?
1133  | S n' ⇒ ?
1134  ].
1135  [1,3:
1136    normalize @I
1137  |2:
1138    normalize
1139    >plus_n_Sm
1140    <(associative_plus n' n' 1)
1141    >(plus_n_O (n' + n'))
1142    cut(n' + n' + 0 + 1 = 2 * n' + 1)
1143    [1:
1144      //
1145    |2:
1146      #refl_assm >refl_assm
1147      @two_times_n_plus_one_odd_p     
1148    ]
1149  |4:
1150    normalize
1151    >plus_n_Sm
1152    cut(n' + (n' + 1) + 1 = (2 * n') + 2)
1153    [1:
1154      normalize /2/
1155    |2:
1156      #refl_assm >refl_assm
1157      @n_even_p_to_n_plus_2_even_p
1158      @two_times_n_even_p
1159    ]
1160  ]
1161qed.
1162
1163include alias "basics/logic.ma".
1164
1165let rec even_p_to_not_odd_p
1166  (n: nat)
1167    on n: even_p n → ¬ odd_p n ≝
1168  match n with
1169  [ O ⇒ ?
1170  | S n' ⇒ ?
1171  ]
1172and odd_p_to_not_even_p
1173  (n: nat)
1174    on n: odd_p n → ¬ even_p n ≝
1175  match n with
1176  [ O ⇒ ?
1177  | S n' ⇒ ?
1178  ].
1179  [1:
1180    normalize #_
1181    @nmk #assm assumption
1182  |3:
1183    normalize #absurd
1184    cases absurd
1185  |2:
1186    normalize
1187    @odd_p_to_not_even_p
1188  |4:
1189    normalize
1190    @even_p_to_not_odd_p
1191  ]
1192qed.
1193
1194lemma even_p_odd_p_cases:
1195  ∀n: nat.
1196    even_p n ∨ odd_p n.
1197  #n elim n
1198  [1:
1199    normalize @or_introl @I
1200  |2:
1201    #n' #inductive_hypothesis
1202    normalize
1203    cases inductive_hypothesis
1204    #assm
1205    try (@or_introl assumption)
1206    try (@or_intror assumption)
1207  ]
1208qed.
1209
1210lemma two_times_n_plus_one_refl_two_times_n_to_False:
1211  ∀m, n: nat.
1212    2 * m + 1 = 2 * n → False.
1213  #m #n
1214  #assm
1215  cut (even_p (2 * n) ∧ even_p ((2 * m) + 1))
1216  [1:
1217    >assm
1218    @conj
1219    @two_times_n_even_p
1220  |2:
1221    * #_ #absurd
1222    cases (even_p_to_not_odd_p … absurd)
1223    #assm @assm
1224    @two_times_n_plus_one_odd_p
1225  ]
1226qed.
1227
1228lemma not_Some_neq_None_to_False:
1229  ∀a: Type[0].
1230  ∀e: a.
1231    ¬ (Some a e ≠ None a) → False.
1232  #a #e #absurd cases absurd -absurd
1233  #absurd @absurd @nmk -absurd
1234  #absurd destruct(absurd)
1235qed.
1236
1237lemma not_None_to_Some:
1238  ∀A: Type[0].
1239  ∀o: option A.
1240    o ≠ None A → ∃v: A. o = Some A v.
1241  #A #o cases o
1242  [1:
1243    #absurd cases absurd #absurd' cases (absurd' (refl …))
1244  |2:
1245    #v' #ignore /2/
1246  ]
1247qed.
1248
1249lemma inclusive_disjunction_true:
1250  ∀b, c: bool.
1251    (orb b c) = true → b = true ∨ c = true.
1252  # b
1253  # c
1254  elim b
1255  [ normalize
1256    # H
1257    @ or_introl
1258    %
1259  | normalize
1260    /3 by trans_eq, orb_true_l/
1261  ]
1262qed.
1263
1264lemma conjunction_true:
1265  ∀b, c: bool.
1266    andb b c = true → b = true ∧ c = true.
1267  # b
1268  # c
1269  elim b
1270  normalize
1271  [ /2 by conj/
1272  | # K
1273    destruct
1274  ]
1275qed.
1276
1277lemma eq_true_false: false=true → False.
1278 # K
1279 destruct
1280qed.
1281
1282lemma inclusive_disjunction_b_true: ∀b. orb b true = true.
1283 # b
1284 cases b
1285 %
1286qed.
1287
1288(* XXX: to be moved into logic/basics.ma *)
1289lemma and_intro_right:
1290  ∀a, b: Prop.
1291    a → (a → b) → a ∧ b.
1292  #a #b /3/
1293qed.
1294
1295definition bool_to_Prop ≝
1296 λb. match b with [ true ⇒ True | false ⇒ False ].
1297
1298coercion bool_to_Prop: ∀b:bool. Prop ≝ bool_to_Prop on _b:bool to Type[0].
1299
1300lemma bool_as_Prop_to_eq : ∀b : bool. b → b = true.
1301**%
1302qed.
1303
1304(* with this you can use prf : b with b : bool with rewriting
1305   >prf rewrites b as true *)
1306coercion bool_to_Prop_to_eq : ∀b : bool.∀prf : b.b = true
1307 ≝ bool_as_Prop_to_eq on _prf : bool_to_Prop ? to (? = true).
1308
1309lemma andb_Prop : ∀b,d : bool.b → d → b∧d.
1310#b #d #btrue #dtrue >btrue >dtrue %
1311qed.
1312
1313lemma andb_Prop_true : ∀b,d : bool. (b∧d) → And (bool_to_Prop b) (bool_to_Prop d).
1314#b #d #bdtrue elim (andb_true … bdtrue) #btrue #dtrue >btrue >dtrue % %
1315qed.
1316
1317lemma orb_Prop_l : ∀b,d : bool.b → b∨d.
1318#b #d #btrue >btrue %
1319qed.
1320
1321lemma orb_Prop_r : ∀b,d : bool.d → b∨d.
1322#b #d #dtrue >dtrue elim b %
1323qed.
1324
1325lemma orb_Prop_true : ∀b,d : bool. (b∨d) → Or (bool_to_Prop b) (bool_to_Prop d).
1326#b #d #bdtrue elim (orb_true_l … bdtrue) #xtrue >xtrue [%1 | %2] %
1327qed.
1328
1329lemma notb_Prop : ∀b : bool. Not (bool_to_Prop b) → notb b.
1330* * #H [@H % | %]
1331qed.
1332
1333lemma eq_false_to_notb: ∀b. b = false → ¬ b.
1334 *; /2 by eq_true_false, I/
1335qed.
1336
1337lemma not_b_to_eq_false : ∀b : bool. Not (bool_to_Prop b) → b = false.
1338** #H [elim (H ?) % | %]
1339qed.
1340
1341(* with this you can use prf : ¬b with b : bool with rewriting
1342   >prf rewrites b as false *)
1343coercion not_bool_to_Prop_to_eq : ∀b : bool.∀prf : Not (bool_to_Prop b).b = false
1344 ≝ not_b_to_eq_false on _prf : Not (bool_to_Prop ?) to (? = false).
1345
1346
1347lemma true_or_false_Prop : ∀b : bool.Or (bool_to_Prop b) (¬(bool_to_Prop b)).
1348* [%1 % | %2 % *]
1349qed.
1350
1351lemma eq_true_to_b : ∀b. b = true → b.
1352#b #btrue >btrue %
1353qed.
1354
1355definition if_then_else_safe : ∀A : Type[0].∀b : bool.(b → A) → (¬(bool_to_Prop b) → A) → A ≝
1356  λA,b,f,g.
1357  match b return λx.match x with [true ⇒ bool_to_Prop b | false ⇒ ¬bool_to_Prop b] → A with
1358  [ true ⇒ f
1359  | false ⇒ g
1360  ] ?. elim b % *
1361qed.
1362
1363notation > "'If' b 'then' 'with' ident prf1 'do' f 'else' 'with' ident prf2 'do' g" with precedence 46 for
1364  @{'if_then_else_safe $b (λ${ident prf1}.$f) (λ${ident prf2}.$g)}.
1365notation > "'If' b 'then' 'with' ident prf1 : ty1 'do' f 'else' 'with' ident prf2 : ty2 'do' g" with precedence 46 for
1366  @{'if_then_else_safe $b (λ${ident prf1}:$ty1.$f) (λ${ident prf2}:$ty2.$g)}.
1367notation > "'If' b 'then' f 'else' 'with' ident prf2 'do' g" with precedence 46 for
1368  @{'if_then_else_safe $b (λ_.$f) (λ${ident prf2}.$g)}.
1369notation > "'If' b 'then' f 'else' 'with' ident prf2 : ty2 'do' g" with precedence 46 for
1370  @{'if_then_else_safe $b (λ_.$f) (λ${ident prf2}:$ty2.$g)}.
1371notation > "'If' b 'then' 'with' ident prf1 'do' f 'else' g" with precedence 46 for
1372  @{'if_then_else_safe $b (λ${ident prf1}.$f) (λ_.$g)}.
1373notation > "'If' b 'then' 'with' ident prf1 : ty1 'do' f 'else' g" with precedence 46 for
1374  @{'if_then_else_safe $b (λ${ident prf1}:$ty1.$f) (λ_.$g)}.
1375
1376notation < "hvbox('If' \nbsp b \nbsp 'then' \nbsp break 'with' \nbsp ident prf1 : ty1 \nbsp 'do' \nbsp break f \nbsp break 'else' \nbsp break 'with' \nbsp ident prf2 : ty2 \nbsp 'do' \nbsp break g)" with precedence 46 for
1377  @{'if_then_else_safe $b (λ${ident prf1}:$ty1.$f) (λ${ident prf2}:$ty2.$g)}.
1378notation < "hvbox('If' \nbsp b \nbsp 'then' \nbsp break f \nbsp break 'else' \nbsp break 'with' \nbsp ident prf2 : ty2 \nbsp 'do' \nbsp break g)" with precedence 46 for
1379  @{'if_then_else_safe $b (λ_:$ty1.$f) (λ${ident prf2}:$ty2.$g)}.
1380notation < "hvbox('If' \nbsp b \nbsp 'then' \nbsp break 'with' \nbsp ident prf1 : ty1 \nbsp 'do' \nbsp break f \nbsp break 'else' \nbsp break g)" with precedence 46 for
1381  @{'if_then_else_safe $b (λ${ident prf1}:$ty1.$f) (λ_:$ty2.$g)}.
1382 
1383interpretation "dependent if then else" 'if_then_else_safe b f g = (if_then_else_safe ? b f g).
1384
1385(* Also extracts an equality proof (useful when not using Russell). *)
1386notation > "hvbox('let' 〈ident x,ident y〉 'as' ident E 'return' ty ≝ t 'in' s)"
1387 with precedence 10
1388for @{ match $t return λx.∀${ident E}: x = $t. $ty with [ mk_Prod ${ident x} ${ident y} ⇒
1389        λ${ident E}.$s ] (refl ? $t) }.
1390
1391notation > "hvbox('deplet' 〈ident x,ident y〉 'as' ident E  ≝ t 'in' s)"
1392 with precedence 10
1393for @{ match $t return λx.∀${ident E}: x = $t. Σz: ?. ? with [ mk_Prod ${ident x} ${ident y} ⇒
1394        λ${ident E}.$s ] (refl ? $t) }.
1395
1396notation > "hvbox('deplet' 〈ident x,ident y,ident z〉 'as' ident E ≝ t 'in' s)"
1397 with precedence 10
1398for @{ match $t return λx.∀${fresh w}:x = $t. Σq: ?. ? with [ mk_Prod ${fresh xy} ${ident z} ⇒
1399       match ${fresh xy} return λx.∀${ident E}:? = $t. Σu: ?. ? with [ mk_Prod ${ident x} ${ident y} ⇒
1400        λ${ident E}.$s ] ] (refl ? $t) }.
1401
1402notation > "hvbox('let' 〈ident x,ident y,ident z〉 'as' ident E 'return' ty ≝ t 'in' s)"
1403 with precedence 10
1404for @{ match $t return λx.∀${fresh w}:x = $t. Σq: ?. ? with [ mk_Prod ${fresh xy} ${ident z} ⇒
1405       match ${fresh xy} return λx.∀${ident E}:? = $t. $ty with [ mk_Prod ${ident x} ${ident y} ⇒
1406        λ${ident E}.$s ] ] (refl ? $t) }.
1407
1408lemma length_append:
1409 ∀A.∀l1,l2:list A.
1410  |l1 @ l2| = |l1| + |l2|.
1411 #A #l1 elim l1
1412  [ //
1413  | #hd #tl #IH #l2 normalize <IH //]
1414qed.
1415
1416lemma nth_cons:
1417  ∀n,A,h,t,y.
1418  nth (S n) A (h::t) y = nth n A t y.
1419 #n #A #h #t #y /2 by refl/
1420qed.
1421
1422lemma option_destruct_Some: ∀A,a,b. Some A a = Some A b → a=b.
1423 #A #a #b #EQ destruct //
1424qed.
1425
1426lemma pi1_eq: ∀A:Type[0].∀P:A->Prop.∀s1:Σa1:A.P a1.∀s2:Σa2:A.P a2.
1427  s1 = s2 → (pi1 ?? s1) = (pi1 ?? s2).
1428 #A #P #s1 #s2 / by /
1429qed.
1430
1431lemma Some_eq:
1432 ∀T:Type[0].∀x,y:T. Some T x = Some T y → x = y.
1433 #T #x #y #H @option_destruct_Some @H
1434qed.
1435
1436lemma not_neq_None_to_eq : ∀A.∀a : option A.¬a≠None ? → a = None ?.
1437#A * [2: #a] * // #ABS elim (ABS ?) % #ABS' destruct(ABS')
1438qed.
1439
1440coercion not_neq_None : ∀A.∀a : option A.∀prf : ¬a≠None ?.a = None ? ≝
1441  not_neq_None_to_eq on _prf : ¬?≠None ? to ? = None ?.
Note: See TracBrowser for help on using the repository browser.