source: src/ASM/Util.ma @ 1161

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

changes from today: merged ertl, ltl and lin into one datatype to simplify semantics

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