X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fmatita%2Fcontribs%2Flambdadelta%2Fbasic_2%2Fstatic%2Fsd.ma;h=a16d19042f255cb88a34ec19517afbe257bc0ade;hb=ae22633ad934bba5fb32143f1726cdfbd255b899;hp=0c899ad444fca856e47f68de32d0cfcaea081996;hpb=f62eeb3c7824564ccbe4fff6e75ddee46ca39cc0;p=helm.git diff --git a/matita/matita/contribs/lambdadelta/basic_2/static/sd.ma b/matita/matita/contribs/lambdadelta/basic_2/static/sd.ma index 0c899ad44..a16d19042 100644 --- a/matita/matita/contribs/lambdadelta/basic_2/static/sd.ma +++ b/matita/matita/contribs/lambdadelta/basic_2/static/sd.ma @@ -19,110 +19,113 @@ include "basic_2/static/sh.ma". (* sort degree specification *) record sd (h:sh): Type[0] ≝ { deg : relation nat; (* degree of the sort *) - deg_total: ∀k. ∃l. deg k l; (* functional relation axioms *) - deg_mono : ∀k,l1,l2. deg k l1 → deg k l2 → l1 = l2; - deg_next : ∀k,l. deg k l → deg (next h k) (l - 1) (* compatibility condition *) + deg_total: ∀k. ∃d. deg k d; (* functional relation axioms *) + deg_mono : ∀k,d1,d2. deg k d1 → deg k d2 → d1 = d2; + deg_next : ∀k,d. deg k d → deg (next h k) (d - 1) (* compatibility condition *) }. (* Notable specifications ***************************************************) -definition deg_O: relation nat ≝ λk,l. l = 0. +definition deg_O: relation nat ≝ λk,d. d = 0. definition sd_O: ∀h. sd h ≝ λh. mk_sd h deg_O …. -// /2 width=1/ /2 width=2/ qed. +/2 width=2 by le_n_O_to_eq, le_n, ex_intro/ defined. inductive deg_SO (h:sh) (k:nat) (k0:nat): predicate nat ≝ -| deg_SO_pos : ∀l0. (next h)^l0 k0 = k → deg_SO h k k0 (l0 + 1) -| deg_SO_zero: ((∃l0. (next h)^l0 k0 = k) → ⊥) → deg_SO h k k0 0 +| deg_SO_pos : ∀d0. (next h)^d0 k0 = k → deg_SO h k k0 (d0 + 1) +| deg_SO_zero: ((∃d0. (next h)^d0 k0 = k) → ⊥) → deg_SO h k k0 0 . -fact deg_SO_inv_pos_aux: ∀h,k,k0,l0. deg_SO h k k0 l0 → ∀l. l0 = l + 1 → - (next h)^l k0 = k. -#h #k #k0 #l0 * -l0 -[ #l0 #Hl0 #l #H +fact deg_SO_inv_pos_aux: ∀h,k,k0,d0. deg_SO h k k0 d0 → ∀d. d0 = d + 1 → + (next h)^d k0 = k. +#h #k #k0 #d0 * -d0 +[ #d0 #Hd0 #d #H lapply (injective_plus_l … H) -H #H destruct // -| #_ #l0 H -H #H +| #d #_ #H + lapply (next_lt h ((next h)^d k2)) >H -H #H lapply (transitive_lt … H HK12) -k1 #H1 - lapply (nexts_le h k2 l) #H2 - lapply (le_to_lt_to_lt … H2 H1) -h -l #H + lapply (nexts_le h k2 d) #H2 + lapply (le_to_lt_to_lt … H2 H1) -h -d #H elim (lt_refl_false … H) +] qed. definition sd_SO: ∀h. nat → sd h ≝ λh,k. mk_sd h (deg_SO h k) …. [ #k0 - lapply (nexts_dec h k0 k) * [ * /3 width=2/ | /4 width=2/ ] -| #K0 #l1 #l2 * [ #l01 ] #H1 * [1,3: #l02 ] #H2 // + lapply (nexts_dec h k0 k) * + [ * /3 width=2 by deg_SO_pos, ex_intro/ | /4 width=2 by deg_SO_zero, ex_intro/ ] +| #K0 #d1 #d2 * [ #d01 ] #H1 * [1,3: #d02 ] #H2 // [ < H2 in H1; -H2 #H lapply (nexts_inj … H) -H #H destruct // - | elim (H1 ?) /2 width=2/ - | elim (H2 ?) /2 width=2/ + | elim H1 /2 width=2 by ex_intro/ + | elim H2 /2 width=2 by ex_intro/ ] -| #k0 #l0 * - [ #l #H destruct elim l -l normalize /2 width=1/ - | #H1 @deg_SO_zero * #l #H2 destruct - @H1 -H1 @(ex_intro … (S l)) /2 width=1/ (**) (* explicit constructor *) +| #k0 #d0 * + [ #d #H destruct elim d -d normalize + /2 width=1 by deg_SO_gt, deg_SO_pos, next_lt/ + | #H1 @deg_SO_zero * #d #H2 destruct + @H1 -H1 @(ex_intro … (S d)) /2 width=1 by sym_eq/ (**) (* explicit constructor *) ] ] -qed. +defined. -let rec sd_l (h:sh) (k:nat) (l:nat) on l : sd h ≝ - match l with +let rec sd_d (h:sh) (k:nat) (d:nat) on d : sd h ≝ + match d with [ O ⇒ sd_O h - | S l ⇒ match l with + | S d ⇒ match d with [ O ⇒ sd_SO h k - | _ ⇒ sd_l h (next h k) l + | _ ⇒ sd_d h (next h k) d ] ]. (* Basic inversion lemmas ***************************************************) -lemma deg_inv_pred: ∀h,g,k,l. deg h g (next h k) (l+1) → deg h g k (l+2). -#h #g #k #l #H1 -elim (deg_total h g k) #l0 #H0 +lemma deg_inv_pred: ∀h,g,k,d. deg h g (next h k) (d+1) → deg h g k (d+2). +#h #g #k #d #H1 +elim (deg_total h g k) #d0 #H0 lapply (deg_next … H0) #H2 lapply (deg_mono … H1 H2) -H1 -H2 #H -<(associative_plus l 1 1) >H H iter_SO #H -lapply (deg_inv_pred … H) -H <(associative_plus l0 1 1) #H -lapply (IHl … H) -IHl -H // +lemma deg_inv_prec: ∀h,g,k,d,d0. deg h g ((next h)^d k) (d0+1) → deg h g k (d+d0+1). +#h #g #k #d @(nat_ind_plus … d) -d // +#d #IHd #d0 >iter_SO #H +lapply (deg_inv_pred … H) -H <(associative_plus d0 1 1) #H +lapply (IHd … H) -IHd -H // qed-. (* Basic properties *********************************************************) -lemma deg_iter: ∀h,g,k,l1,l2. deg h g k l1 → deg h g ((next h)^l2 k) (l1-l2). -#h #g #k #l1 #l2 @(nat_ind_plus … l2) -l2 [ iter_SO iter_SO