# source:src/ASM/FoldStuff.ma@1061

Last change on this file since 1061 was 1014, checked in by sacerdot, 9 years ago

The main theorem is completely broken (again).

File size: 3.0 KB
Line
1(* RUSSEL **)
2
3include "basics/jmeq.ma".
4include "basics/types.ma".
5include "basics/list.ma".
6
7notation > "hvbox(a break ≃ b)"
8  non associative with precedence 45
9for @{ 'jmeq ? \$a ? \$b }.
10
11notation < "hvbox(term 46 a break maction (≃) (≃\sub(t,u)) term 46 b)"
12  non associative with precedence 45
13for @{ 'jmeq \$t \$a \$u \$b }.
14
15interpretation "john major's equality" 'jmeq t x u y = (jmeq t x u y).
16
17lemma eq_to_jmeq:
18  ∀A: Type[0].
19  ∀x, y: A.
20    x = y → x ≃ y.
21  //
22qed.
23
24definition inject : ∀A.∀P:A → Prop.∀a.∀p:P a.Σx:A.P x ≝ λA,P,a,p. dp … a p.
25definition eject : ∀A.∀P: A → Prop.(Σx:A.P x) → A ≝ λA,P,c.match c with [ dp w p ⇒ w].
26
27coercion inject nocomposites: ∀A.∀P:A → Prop.∀a.∀p:P a.Σx:A.P x ≝ inject on a:? to Σx:?.?.
28coercion eject nocomposites: ∀A.∀P:A → Prop.∀c:Σx:A.P x.A ≝ eject on _c:Σx:?.? to ?.
29
30(*axiom VOID: Type[0].
31axiom assert_false: VOID.
32definition bigbang: ∀A:Type[0].False → VOID → A.
33 #A #abs cases abs
34qed.
35
36coercion bigbang nocomposites: ∀A:Type[0].False → ∀v:VOID.A ≝ bigbang on _v:VOID to ?.*)
37
38lemma sig2: ∀A.∀P:A → Prop. ∀p:Σx:A.P x. P (eject … p).
39 #A #P #p cases p #w #q @q
40qed.
41
42lemma jmeq_to_eq: ∀A:Type[0]. ∀x,y:A. x≃y → x=y.
43 #A #x #y #JMEQ @(jmeq_elim ? x … JMEQ) %
44qed.
45
46coercion jmeq_to_eq: ∀A:Type[0]. ∀x,y:A. ∀p:x≃y.x=y ≝ jmeq_to_eq on _p:?≃? to ?=?.
47
48(* END RUSSELL **)
49
50include "ASM/Util.ma".
51
52let rec foldl_strong_internal
53  (A: Type[0]) (P: list A → Type[0]) (l: list A)
54  (H: ∀prefix. ∀hd. ∀tl. l = prefix @ [hd] @ tl → P prefix → P (prefix @ [hd]))
55  (prefix: list A) (suffix: list A) (acc: P prefix) on suffix:
56    l = prefix @ suffix → P(prefix @ suffix) ≝
57  match suffix return λl'. l = prefix @ l' → P (prefix @ l') with
58  [ nil ⇒ λprf. ?
59  | cons hd tl ⇒ λprf. ?
60  ].
61  [ > (append_nil ?)
62    @ acc
63  | applyS (foldl_strong_internal A P l H (prefix @ [hd]) tl ? ?)
64    [ @ (H prefix hd tl prf acc)
65    | applyS prf
66    ]
67  ]
68qed.
69
70definition foldl_strong ≝
71  λA: Type[0].
72  λP: list A → Type[0].
73  λl: list A.
74  λH: ∀prefix. ∀hd. ∀tl. l = prefix @ [hd] @ tl → P prefix → P (prefix @ [hd]).
75  λacc: P [ ].
76    foldl_strong_internal A P l H [ ] l acc (refl …).
77
78let rec foldr_strong_internal
79 (A:Type[0])
80 (P: list A → Type[0])
81 (l: list A)
82 (H: ∀prefix,hd,tl. l = prefix @ [hd] @ tl → P tl → P (hd::tl))
83 (prefix: list A) (suffix: list A) (acc: P [ ]) on suffix : l = prefix@suffix → P suffix ≝
84  match suffix return λl'. l = prefix @ l' → P (l') with
85   [ nil ⇒ λprf. acc
86   | cons hd tl ⇒ λprf. H prefix hd tl prf (foldr_strong_internal A P l H (prefix @ [hd]) tl acc ?) ].
87 applyS prf
88qed.
89
90lemma foldr_strong:
91 ∀A:Type[0].
92  ∀P: list A → Type[0].
93   ∀l: list A.
94    ∀H: ∀prefix,hd,tl. l = prefix @ [hd] @ tl → P tl → P (hd::tl).
95     ∀acc:P [ ]. P l
96 ≝ λA,P,l,H,acc. foldr_strong_internal A P l H [ ] l acc (refl …).
97
98lemma pair_destruct: ∀A,B,a1,a2,b1,b2. pair A B a1 a2 = 〈b1,b2〉 → a1=b1 ∧ a2=b2.
99 #A #B #a1 #a2 #b1 #b2 #EQ destruct /2/
100qed.
Note: See TracBrowser for help on using the repository browser.