From: Ferruccio Guidi Date: Fri, 1 Feb 2013 16:37:41 +0000 (+0000) Subject: lambda finaly moved in lib X-Git-Tag: make_still_working~1290 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=aa9654656f7d0aeb9345e0b86a9e35f861687580;p=helm.git lambda finaly moved in lib --- diff --git a/matita/matita/contribs/lambda/Makefile b/matita/matita/contribs/lambda/Makefile deleted file mode 100644 index b8f68bb83..000000000 --- a/matita/matita/contribs/lambda/Makefile +++ /dev/null @@ -1,29 +0,0 @@ -H = @ -XOA_DIR = ../../../components/binaries/xoa -XOA = xoa.native -DEP_DIR = ../../../components/binaries/matitadep -DEP = matitadep.native -MAC_DIR = ../../../components/binaries/mac -MAC = mac.native - -XOA_CONF = xoa.conf.xml -XOA_TARGETS = background/xoa_notation.ma background/xoa.ma - -all: xoa - $(H)../../matitac.opt - -# xoa ######################################################################## - -xoa: $(XOA_TARGETS) - -$(XOA_TARGETS): $(XOA_CONF) - @echo " EXEC $(XOA) $(XOA_CONF)" - $(H)MATITA_RT_BASE_DIR=../.. $(XOA_DIR)/$(XOA) $(XOA_CONF) - -# dep ######################################################################## - -deps: MAS = $(shell find $* -name "*.ma") - -deps: $(DEP_DIR)/$(DEP) - @echo " MATITADEP" - $(H)grep "include \"" $(MAS) | $< diff --git a/matita/matita/contribs/lambda/background/notation.ma b/matita/matita/contribs/lambda/background/notation.ma deleted file mode 100644 index 62b8b2dca..000000000 --- a/matita/matita/contribs/lambda/background/notation.ma +++ /dev/null @@ -1,100 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -(* GENERIC NOTATION *********************************************************) - -(* Note: this should go to core_notation *) -notation "⊥" - non associative with precedence 90 - for @{'false}. - -(* Note: this should go to core_notation *) -notation "⊤" - non associative with precedence 90 - for @{'true}. - -(* Note: this should go to core_notation *) -notation "hvbox(a break ≺ b)" - non associative with precedence 45 - for @{ 'prec $a $b }. - -notation "hvbox( # term 90 i )" - non associative with precedence 46 - for @{ 'VariableReferenceByIndex $i }. - -notation "hvbox( { term 46 b } # break term 90 i )" - non associative with precedence 46 - for @{ 'VariableReferenceByIndex $b $i }. - -notation "hvbox( 𝛌 . term 46 A )" - non associative with precedence 46 - for @{ 'Abstraction $A }. - -notation "hvbox( { term 46 b } 𝛌 . break term 46 T)" - non associative with precedence 46 - for @{ 'Abstraction $b $T }. - -notation "hvbox( @ term 46 C . break term 46 A )" - non associative with precedence 46 - for @{ 'Application $C $A }. - -notation "hvbox( { term 46 b } @ break term 46 V . break term 46 T )" - non associative with precedence 46 - for @{ 'Application $b $V $T }. - -notation "hvbox( ↑ [ term 46 d , break term 46 h ] break term 46 M )" - non associative with precedence 46 - for @{ 'Lift $h $d $M }. - -notation > "hvbox( ↑ [ term 46 h ] break term 46 M )" - non associative with precedence 46 - for @{ 'Lift $h 0 $M }. - -notation > "hvbox( ↑ term 46 M )" - non associative with precedence 46 - for @{ 'Lift 1 0 $M }. - -(* Note: the notation with "/" does not work *) -notation "hvbox( [ term 46 d break ↙ term 46 N ] break term 46 M )" - non associative with precedence 46 - for @{ 'DSubst $N $d $M }. - -notation > "hvbox( [ ↙ term 46 N ] break term 46 M )" - non associative with precedence 46 - for @{ 'DSubst $N 0 $M }. - -(* Note: we do not use → since it is reserved by CIC *) -notation "hvbox( M break ↦ term 46 N )" - non associative with precedence 45 - for @{ 'SeqRed $M $N }. - -notation "hvbox( M break ↦ [ term 46 p ] break term 46 N )" - non associative with precedence 45 - for @{ 'SeqRed $M $p $N }. - -notation "hvbox( M break ↦* term 46 N )" - non associative with precedence 45 - for @{ 'SeqRedStar $M $N }. - -notation "hvbox( M break ↦* [ term 46 s ] break term 46 N )" - non associative with precedence 45 - for @{ 'SeqRedStar $M $s $N }. - -notation "hvbox( M break ⤇ term 46 N )" - non associative with precedence 45 - for @{ 'ParRed $M $N }. - -notation "hvbox( M break ⤇* term 46 N )" - non associative with precedence 45 - for @{ 'ParRedStar $M $N }. diff --git a/matita/matita/contribs/lambda/background/preamble.ma b/matita/matita/contribs/lambda/background/preamble.ma deleted file mode 100644 index 6455bfcf4..000000000 --- a/matita/matita/contribs/lambda/background/preamble.ma +++ /dev/null @@ -1,129 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "basics/star.ma". -include "basics/lists/lstar.ma". -include "arithmetics/exp.ma". - -include "background/xoa_notation.ma". -include "background/xoa.ma". -include "background/notation.ma". - -(* logic *) - -(* Note: For some reason this cannot be in the standard library *) -interpretation "logical false" 'false = False. - -(* booleans *) - -(* Note: For some reason this cannot be in the standard library *) -interpretation "boolean false" 'false = false. - -(* Note: For some reason this cannot be in the standard library *) -interpretation "boolean true" 'true = true. - -(* arithmetics *) - -lemma lt_refl_false: ∀n. n < n → ⊥. -#n #H elim (lt_to_not_eq … H) -H /2 width=1/ -qed-. - -lemma lt_zero_false: ∀n. n < 0 → ⊥. -#n #H elim (lt_to_not_le … H) -H /2 width=1/ -qed-. - -lemma plus_lt_false: ∀m,n. m + n < m → ⊥. -#m #n #H elim (lt_to_not_le … H) -H /2 width=1/ -qed-. - -lemma lt_or_eq_or_gt: ∀m,n. ∨∨ m < n | n = m | n < m. -#m #n elim (lt_or_ge m n) /2 width=1/ -#H elim H -m /2 width=1/ -#m #Hm * #H /2 width=1/ /3 width=1/ -qed-. - -(* trichotomy operator *) - -(* Note: this is "if eqb n1 n2 then a2 else if leb n1 n2 then a1 else a3" *) -let rec tri (A:Type[0]) n1 n2 a1 a2 a3 on n1 : A ≝ - match n1 with - [ O ⇒ match n2 with [ O ⇒ a2 | S n2 ⇒ a1 ] - | S n1 ⇒ match n2 with [ O ⇒ a3 | S n2 ⇒ tri A n1 n2 a1 a2 a3 ] - ]. - -lemma tri_lt: ∀A,a1,a2,a3,n2,n1. n1 < n2 → tri A n1 n2 a1 a2 a3 = a1. -#A #a1 #a2 #a3 #n2 elim n2 -n2 -[ #n1 #H elim (lt_zero_false … H) -| #n2 #IH #n1 elim n1 -n1 // /3 width=1/ -] -qed. - -lemma tri_eq: ∀A,a1,a2,a3,n. tri A n n a1 a2 a3 = a2. -#A #a1 #a2 #a3 #n elim n -n normalize // -qed. - -lemma tri_gt: ∀A,a1,a2,a3,n1,n2. n2 < n1 → tri A n1 n2 a1 a2 a3 = a3. -#A #a1 #a2 #a3 #n1 elim n1 -n1 -[ #n2 #H elim (lt_zero_false … H) -| #n1 #IH #n2 elim n2 -n2 // /3 width=1/ -] -qed. - -(* lists *) - -(* Note: notation for nil not involving brackets *) -notation > "◊" - non associative with precedence 90 - for @{'nil}. - -lemma list_inv: ∀A. ∀l:list A. ◊ = l ∨ ∃∃a0,l0. a0 :: l0 = l. -#A * /2 width=1/ /3 width=3/ -qed-. - -definition map_cons: ∀A. A → list (list A) → list (list A) ≝ λA,a. - map … (cons … a). - -interpretation "map_cons" 'ho_cons a l = (map_cons ? a l). - -notation "hvbox(a ::: break l)" - right associative with precedence 47 - for @{'ho_cons $a $l}. - -lemma map_cons_inv_nil: ∀A,a,l1. map_cons A a l1 = ◊ → ◊ = l1. -#A #a * // normalize #a1 #l1 #H destruct -qed-. - -lemma map_cons_inv_cons: ∀A,a,a2,l2,l1. map_cons A a l1 = a2::l2 → - ∃∃a1,l. a::a1 = a2 & a:::l = l2 & a1::l = l1. -#A #a #a2 #l2 * normalize -[ #H destruct -| #a1 #l1 #H destruct /2 width=5/ -] -qed-. - -lemma map_cons_append: ∀A,a,l1,l2. map_cons A a (l1@l2) = - map_cons A a l1 @ map_cons A a l2. -#A #a #l1 elim l1 -l1 // normalize /2 width=1/ -qed. - -(* lstar *) - -(* Note: this cannot be in lib because of the missing xoa quantifier *) -lemma lstar_inv_pos: ∀A,B,R,l,b1,b2. lstar A B R l b1 b2 → 0 < |l| → - ∃∃a,ll,b. a::ll = l & R a b1 b & lstar A B R ll b b2. -#A #B #R #l #b1 #b2 #H @(lstar_ind_l … l b1 H) -l -b1 -[ #H elim (lt_refl_false … H) -| #a #ll #b1 #b #Hb1 #Hb2 #_ #_ /2 width=6/ (**) (* auto fail if we do not remove the inductive premise *) -] -qed-. diff --git a/matita/matita/contribs/lambda/background/xoa.ma b/matita/matita/contribs/lambda/background/xoa.ma deleted file mode 100644 index a2f19a6b7..000000000 --- a/matita/matita/contribs/lambda/background/xoa.ma +++ /dev/null @@ -1,108 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -(* This file was generated by xoa.native: do not edit *********************) - -include "basics/pts.ma". - -(* multiple existental quantifier (1, 2) *) - -inductive ex1_2 (A0,A1:Type[0]) (P0:A0→A1→Prop) : Prop ≝ - | ex1_2_intro: ∀x0,x1. P0 x0 x1 → ex1_2 ? ? ? -. - -interpretation "multiple existental quantifier (1, 2)" 'Ex P0 = (ex1_2 ? ? P0). - -(* multiple existental quantifier (2, 2) *) - -inductive ex2_2 (A0,A1:Type[0]) (P0,P1:A0→A1→Prop) : Prop ≝ - | ex2_2_intro: ∀x0,x1. P0 x0 x1 → P1 x0 x1 → ex2_2 ? ? ? ? -. - -interpretation "multiple existental quantifier (2, 2)" 'Ex P0 P1 = (ex2_2 ? ? P0 P1). - -(* multiple existental quantifier (2, 3) *) - -inductive ex2_3 (A0,A1,A2:Type[0]) (P0,P1:A0→A1→A2→Prop) : Prop ≝ - | ex2_3_intro: ∀x0,x1,x2. P0 x0 x1 x2 → P1 x0 x1 x2 → ex2_3 ? ? ? ? ? -. - -interpretation "multiple existental quantifier (2, 3)" 'Ex P0 P1 = (ex2_3 ? ? ? P0 P1). - -(* multiple existental quantifier (3, 1) *) - -inductive ex3 (A0:Type[0]) (P0,P1,P2:A0→Prop) : Prop ≝ - | ex3_intro: ∀x0. P0 x0 → P1 x0 → P2 x0 → ex3 ? ? ? ? -. - -interpretation "multiple existental quantifier (3, 1)" 'Ex P0 P1 P2 = (ex3 ? P0 P1 P2). - -(* multiple existental quantifier (3, 2) *) - -inductive ex3_2 (A0,A1:Type[0]) (P0,P1,P2:A0→A1→Prop) : Prop ≝ - | ex3_2_intro: ∀x0,x1. P0 x0 x1 → P1 x0 x1 → P2 x0 x1 → ex3_2 ? ? ? ? ? -. - -interpretation "multiple existental quantifier (3, 2)" 'Ex P0 P1 P2 = (ex3_2 ? ? P0 P1 P2). - -(* multiple existental quantifier (3, 3) *) - -inductive ex3_3 (A0,A1,A2:Type[0]) (P0,P1,P2:A0→A1→A2→Prop) : Prop ≝ - | ex3_3_intro: ∀x0,x1,x2. P0 x0 x1 x2 → P1 x0 x1 x2 → P2 x0 x1 x2 → ex3_3 ? ? ? ? ? ? -. - -interpretation "multiple existental quantifier (3, 3)" 'Ex P0 P1 P2 = (ex3_3 ? ? ? P0 P1 P2). - -(* multiple existental quantifier (3, 4) *) - -inductive ex3_4 (A0,A1,A2,A3:Type[0]) (P0,P1,P2:A0→A1→A2→A3→Prop) : Prop ≝ - | ex3_4_intro: ∀x0,x1,x2,x3. P0 x0 x1 x2 x3 → P1 x0 x1 x2 x3 → P2 x0 x1 x2 x3 → ex3_4 ? ? ? ? ? ? ? -. - -interpretation "multiple existental quantifier (3, 4)" 'Ex P0 P1 P2 = (ex3_4 ? ? ? ? P0 P1 P2). - -(* multiple existental quantifier (4, 1) *) - -inductive ex4 (A0:Type[0]) (P0,P1,P2,P3:A0→Prop) : Prop ≝ - | ex4_intro: ∀x0. P0 x0 → P1 x0 → P2 x0 → P3 x0 → ex4 ? ? ? ? ? -. - -interpretation "multiple existental quantifier (4, 1)" 'Ex P0 P1 P2 P3 = (ex4 ? P0 P1 P2 P3). - -(* multiple existental quantifier (4, 2) *) - -inductive ex4_2 (A0,A1:Type[0]) (P0,P1,P2,P3:A0→A1→Prop) : Prop ≝ - | ex4_2_intro: ∀x0,x1. P0 x0 x1 → P1 x0 x1 → P2 x0 x1 → P3 x0 x1 → ex4_2 ? ? ? ? ? ? -. - -interpretation "multiple existental quantifier (4, 2)" 'Ex P0 P1 P2 P3 = (ex4_2 ? ? P0 P1 P2 P3). - -(* multiple existental quantifier (4, 3) *) - -inductive ex4_3 (A0,A1,A2:Type[0]) (P0,P1,P2,P3:A0→A1→A2→Prop) : Prop ≝ - | ex4_3_intro: ∀x0,x1,x2. P0 x0 x1 x2 → P1 x0 x1 x2 → P2 x0 x1 x2 → P3 x0 x1 x2 → ex4_3 ? ? ? ? ? ? ? -. - -interpretation "multiple existental quantifier (4, 3)" 'Ex P0 P1 P2 P3 = (ex4_3 ? ? ? P0 P1 P2 P3). - -(* multiple disjunction connective (3) *) - -inductive or3 (P0,P1,P2:Prop) : Prop ≝ - | or3_intro0: P0 → or3 ? ? ? - | or3_intro1: P1 → or3 ? ? ? - | or3_intro2: P2 → or3 ? ? ? -. - -interpretation "multiple disjunction connective (3)" 'Or P0 P1 P2 = (or3 P0 P1 P2). - diff --git a/matita/matita/contribs/lambda/background/xoa_notation.ma b/matita/matita/contribs/lambda/background/xoa_notation.ma deleted file mode 100644 index 240c1dd5d..000000000 --- a/matita/matita/contribs/lambda/background/xoa_notation.ma +++ /dev/null @@ -1,122 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -(* This file was generated by xoa.native: do not edit *********************) - -(* multiple existental quantifier (1, 2) *) - -notation > "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}.λ${ident x1}.$P0) }. - -notation < "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.$P0) }. - -(* multiple existental quantifier (2, 2) *) - -notation > "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}.λ${ident x1}.$P0) (λ${ident x0}.λ${ident x1}.$P1) }. - -notation < "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P1) }. - -(* multiple existental quantifier (2, 3) *) - -notation > "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P0) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P1) }. - -notation < "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P1) }. - -(* multiple existental quantifier (3, 1) *) - -notation > "hvbox(∃∃ ident x0 break . term 19 P0 break & term 19 P1 break & term 19 P2)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}.$P0) (λ${ident x0}.$P1) (λ${ident x0}.$P2) }. - -notation < "hvbox(∃∃ ident x0 break . term 19 P0 break & term 19 P1 break & term 19 P2)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}:$T0.$P0) (λ${ident x0}:$T0.$P1) (λ${ident x0}:$T0.$P2) }. - -(* multiple existental quantifier (3, 2) *) - -notation > "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1 break & term 19 P2)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}.λ${ident x1}.$P0) (λ${ident x0}.λ${ident x1}.$P1) (λ${ident x0}.λ${ident x1}.$P2) }. - -notation < "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1 break & term 19 P2)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P1) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P2) }. - -(* multiple existental quantifier (3, 3) *) - -notation > "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1 break & term 19 P2)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P0) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P1) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P2) }. - -notation < "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1 break & term 19 P2)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P1) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P2) }. - -(* multiple existental quantifier (3, 4) *) - -notation > "hvbox(∃∃ ident x0 , ident x1 , ident x2 , ident x3 break . term 19 P0 break & term 19 P1 break & term 19 P2)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}.λ${ident x1}.λ${ident x2}.λ${ident x3}.$P0) (λ${ident x0}.λ${ident x1}.λ${ident x2}.λ${ident x3}.$P1) (λ${ident x0}.λ${ident x1}.λ${ident x2}.λ${ident x3}.$P2) }. - -notation < "hvbox(∃∃ ident x0 , ident x1 , ident x2 , ident x3 break . term 19 P0 break & term 19 P1 break & term 19 P2)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.λ${ident x3}:$T3.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.λ${ident x3}:$T3.$P1) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.λ${ident x3}:$T3.$P2) }. - -(* multiple existental quantifier (4, 1) *) - -notation > "hvbox(∃∃ ident x0 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}.$P0) (λ${ident x0}.$P1) (λ${ident x0}.$P2) (λ${ident x0}.$P3) }. - -notation < "hvbox(∃∃ ident x0 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}:$T0.$P0) (λ${ident x0}:$T0.$P1) (λ${ident x0}:$T0.$P2) (λ${ident x0}:$T0.$P3) }. - -(* multiple existental quantifier (4, 2) *) - -notation > "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}.λ${ident x1}.$P0) (λ${ident x0}.λ${ident x1}.$P1) (λ${ident x0}.λ${ident x1}.$P2) (λ${ident x0}.λ${ident x1}.$P3) }. - -notation < "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P1) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P2) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P3) }. - -(* multiple existental quantifier (4, 3) *) - -notation > "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P0) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P1) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P2) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P3) }. - -notation < "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" - non associative with precedence 20 - for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P1) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P2) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P3) }. - -(* multiple disjunction connective (3) *) - -notation "hvbox(∨∨ term 29 P0 break | term 29 P1 break | term 29 P2)" - non associative with precedence 30 - for @{ 'Or $P0 $P1 $P2 }. - diff --git a/matita/matita/contribs/lambda/paths/alternative_standard_order.ma b/matita/matita/contribs/lambda/paths/alternative_standard_order.ma deleted file mode 100644 index e8eca4f11..000000000 --- a/matita/matita/contribs/lambda/paths/alternative_standard_order.ma +++ /dev/null @@ -1,48 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "paths/standard_precedence.ma". - -(* ALTERNATIVE STANDARD ORDER ***********************************************) - -(* Note: this is p < q *) -definition slt: relation path ≝ TC … sprec. - -interpretation "standard 'less than' on paths" - 'lt p q = (slt p q). - -lemma slt_step_rc: ∀p,q. p ≺ q → p < q. -/2 width=1/ -qed. - -lemma slt_nil: ∀o,p. ◊ < o::p. -/2 width=1/ -qed. - -lemma slt_skip: dx::◊ < ◊. -/2 width=1/ -qed. - -lemma slt_comp: ∀o,p,q. p < q → o::p < o::q. -#o #p #q #H elim H -q /3 width=1/ /3 width=3/ -qed. - -theorem slt_trans: transitive … slt. -/2 width=3/ -qed-. - -lemma slt_refl: ∀p. p < p. -#p elim p -p /2 width=1/ -@(slt_trans … (dx::◊)) // -qed. diff --git a/matita/matita/contribs/lambda/paths/decomposed_trace.ma b/matita/matita/contribs/lambda/paths/decomposed_trace.ma deleted file mode 100644 index 2241fab10..000000000 --- a/matita/matita/contribs/lambda/paths/decomposed_trace.ma +++ /dev/null @@ -1,31 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "paths/trace.ma". - -(* DECOMPOSED TRACE *********************************************************) - -(* Policy: decomposed trace metavariables: P, Q *) -(* Note: this is a binary tree on traces *) -inductive dtrace: Type[0] ≝ -| tree_nil : dtrace -| tree_cons: trace → dtrace → dtrace → dtrace -. - -let rec size (P:dtrace) on P ≝ match P with -[ tree_nil ⇒ 0 -| tree_cons s Q1 Q2 ⇒ size Q2 + size Q1 + |s| -]. - -interpretation "decomposed trace size" 'card P = (size P). diff --git a/matita/matita/contribs/lambda/paths/dst_computation.ma b/matita/matita/contribs/lambda/paths/dst_computation.ma deleted file mode 100644 index a532e7b15..000000000 --- a/matita/matita/contribs/lambda/paths/dst_computation.ma +++ /dev/null @@ -1,214 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "paths/standard_trace.ma". -include "paths/labeled_sequential_computation.ma". - -(* DECOMPOSED STANDARD COMPUTATION ***********************************************) - -(* Note: this is the "standard" computation of: - R. Kashima: "A proof of the Standization Theorem in λ-Calculus". (2000). -*) -inductive dst: relation term ≝ -| dst_vref: ∀s,M,i. is_whd s → M ↦*[s] #i → dst M (#i) -| dst_abst: ∀s,M,A1,A2. is_whd s → M ↦*[s] 𝛌.A1 → dst A1 A2 → dst M (𝛌.A2) -| dst_appl: ∀s,M,B1,B2,A1,A2. is_whd s → M ↦*[s] @B1.A1 → dst B1 B2 → dst A1 A2 → dst M (@B2.A2) -. - -interpretation "decomposed standard computation" - 'DecomposedStd M N = (dst M N). - -notation "hvbox( M break ⓢ↦* term 46 N )" - non associative with precedence 45 - for @{ 'DecomposedStd $M $N }. - -lemma dst_inv_lref: ∀M,N. M ⓢ↦* N → ∀j. #j = N → - ∃∃s. is_whd s & M ↦*[s] #j. -#M #N * -M -N -[ /2 width=3/ -| #s #M #A1 #A2 #_ #_ #_ #j #H destruct -| #s #M #B1 #B2 #A1 #A2 #_ #_ #_ #_ #j #H destruct -] -qed-. - -lemma dst_inv_abst: ∀M,N. M ⓢ↦* N → ∀C2. 𝛌.C2 = N → - ∃∃s,C1. is_whd s & M ↦*[s] 𝛌.C1 & C1 ⓢ↦* C2. -#M #N * -M -N -[ #s #M #i #_ #_ #C2 #H destruct -| #s #M #A1 #A2 #Hs #HM #A12 #C2 #H destruct /2 width=5/ -| #s #M #B1 #B2 #A1 #A2 #_ #_ #_ #_ #C2 #H destruct -] -qed-. - -lemma dst_inv_appl: ∀M,N. M ⓢ↦* N → ∀D2,C2. @D2.C2 = N → - ∃∃s,D1,C1. is_whd s & M ↦*[s] @D1.C1 & D1 ⓢ↦* D2 & C1 ⓢ↦* C2. -#M #N * -M -N -[ #s #M #i #_ #_ #D2 #C2 #H destruct -| #s #M #A1 #A2 #_ #_ #_ #D2 #C2 #H destruct -| #s #M #B1 #B2 #A1 #A2 #Hs #HM #HB12 #HA12 #D2 #C2 #H destruct /2 width=7/ -] -qed-. - -lemma dst_refl: reflexive … dst. -#M elim M -M /2 width=3/ /2 width=5/ /2 width=7/ -qed. - -lemma dst_step_sn: ∀N1,N2. N1 ⓢ↦* N2 → ∀s,M. is_whd s → M ↦*[s] N1 → M ⓢ↦* N2. -#N1 #N2 #H elim H -N1 -N2 -[ #r #N #i #Hr #HN #s #M #Hs #HMN - lapply (pl_sreds_trans … HMN … HN) -N /3 width=3/ -| #r #N #C1 #C2 #Hr #HN #_ #IHC12 #s #M #Hs #HMN - lapply (pl_sreds_trans … HMN … HN) -N /3 width=7/ -| #r #N #D1 #D2 #C1 #C2 #Hr #HN #_ #_ #IHD12 #IHC12 #s #M #Hs #HMN - lapply (pl_sreds_trans … HMN … HN) -N /3 width=9/ -] -qed-. - -lemma dst_step_rc: ∀s,M1,M2. is_whd s → M1 ↦*[s] M2 → M1 ⓢ↦* M2. -/3 width=5 by dst_step_sn/ -qed. - -lemma dst_lift: liftable dst. -#h #M1 #M2 #H elim H -M1 -M2 -[ /3 width=3/ -| #s #M #A1 #A2 #Hs #HM #_ #IHA12 #d - @(dst_abst … Hs) [2: @(pl_sreds_lift … HM) | skip ] -M // (**) (* auto fails here *) -| #s #M #B1 #B2 #A1 #A2 #Hs #HM #_ #_ #IHB12 #IHA12 #d - @(dst_appl … Hs) [3: @(pl_sreds_lift … HM) |1,2: skip ] -M // (**) (* auto fails here *) -] -qed. - -lemma dst_inv_lift: deliftable_sn dst. -#h #N1 #N2 #H elim H -N1 -N2 -[ #s #N1 #i #Hs #HN1 #d #M1 #HMN1 - elim (pl_sreds_inv_lift … HN1 … HMN1) -N1 /3 width=3/ -| #s #N1 #C1 #C2 #Hs #HN1 #_ #IHC12 #d #M1 #HMN1 - elim (pl_sreds_inv_lift … HN1 … HMN1) -N1 #M2 #HM12 #HM2 - elim (lift_inv_abst … HM2) -HM2 #A1 #HAC1 #HM2 destruct - elim (IHC12 …) -IHC12 [4: // |2,3: skip ] #A2 #HA12 #HAC2 destruct (**) (* simplify line *) - @(ex2_intro … (𝛌.A2)) // /2 width=5/ -| #s #N1 #D1 #D2 #C1 #C2 #Hs #HN1 #_ #_ #IHD12 #IHC12 #d #M1 #HMN1 - elim (pl_sreds_inv_lift … HN1 … HMN1) -N1 #M2 #HM12 #HM2 - elim (lift_inv_appl … HM2) -HM2 #B1 #A1 #HBD1 #HAC1 #HM2 destruct - elim (IHD12 …) -IHD12 [4: // |2,3: skip ] #B2 #HB12 #HBD2 destruct (**) (* simplify line *) - elim (IHC12 …) -IHC12 [4: // |2,3: skip ] #A2 #HA12 #HAC2 destruct (**) (* simplify line *) - @(ex2_intro … (@B2.A2)) // /2 width=7/ -] -qed-. - -lemma dst_dsubst: dsubstable dst. -#N1 #N2 #HN12 #M1 #M2 #H elim H -M1 -M2 -[ #s #M #i #Hs #HM #d elim (lt_or_eq_or_gt i d) #Hid - [ lapply (pl_sreds_dsubst … N1 … HM d) -HM - >(dsubst_vref_lt … Hid) >(dsubst_vref_lt … Hid) /2 width=3/ - | destruct >dsubst_vref_eq - @(dst_step_sn (↑[0,i]N1) … s) /2 width=1/ - | lapply (pl_sreds_dsubst … N1 … HM d) -HM - >(dsubst_vref_gt … Hid) >(dsubst_vref_gt … Hid) /2 width=3/ - ] -| #s #M #A1 #A2 #Hs #HM #_ #IHA12 #d - lapply (pl_sreds_dsubst … N1 … HM d) -HM /2 width=5/ (**) (* auto needs some help here *) -| #s #M #B1 #B2 #A1 #A2 #Hs #HM #_ #_ #IHB12 #IHA12 #d - lapply (pl_sreds_dsubst … N1 … HM d) -HM /2 width=7/ (**) (* auto needs some help here *) -] -qed. - -lemma dst_step_dx: ∀p,M,M2. M ↦[p] M2 → ∀M1. M1 ⓢ↦* M → M1 ⓢ↦* M2. -#p #M #M2 #H elim H -p -M -M2 -[ #B #A #M1 #H - elim (dst_inv_appl … H …) -H [4: // |2,3: skip ] #s #B1 #M #Hs #HM1 #HB1 #H (**) (* simplify line *) - elim (dst_inv_abst … H …) -H [3: // |2: skip ] #r #A1 #Hr #HM #HA1 (**) (* simplify line *) - lapply (pl_sreds_trans … HM1 … (dx:::r) (@B1.𝛌.A1) ?) /2 width=1/ -M #HM1 - lapply (pl_sreds_step_dx … HM1 (◊) ([↙B1]A1) ?) -HM1 // #HM1 - @(dst_step_sn … HM1) /2 width=1/ /4 width=1/ -| #p #A #A2 #_ #IHA2 #M1 #H - elim (dst_inv_abst … H …) -H [3: // |2: skip ] /3 width=5/ (**) (* simplify line *) -| #p #B #B2 #A #_ #IHB2 #M1 #H - elim (dst_inv_appl … H …) -H [4: // |2,3: skip ] /3 width=7/ (**) (* simplify line *) -| #p #B #A #A2 #_ #IHA2 #M1 #H - elim (dst_inv_appl … H …) -H [4: // |2,3: skip ] /3 width=7/ (**) (* simplify line *) -] -qed-. - -lemma pl_sreds_dst: ∀s,M1,M2. M1 ↦*[s] M2 → M1 ⓢ↦* M2. -#s #M1 #M2 #H @(lstar_ind_r … s M2 H) -s -M2 // /2 width=4 by dst_step_dx/ -qed. - -lemma dst_inv_pl_sreds_is_standard: ∀M,N. M ⓢ↦* N → - ∃∃r. M ↦*[r] N & is_standard r. -#M #N #H elim H -M -N -[ #s #M #i #Hs #HM - lapply (is_whd_is_standard … Hs) -Hs /2 width=3/ -| #s #M #A1 #A2 #Hs #HM #_ * #r #HA12 #Hr - lapply (pl_sreds_trans … HM (rc:::r) (𝛌.A2) ?) /2 width=1/ -A1 #HM - @(ex2_intro … HM) -M -A2 /3 width=1/ -| #s #M #B1 #B2 #A1 #A2 #Hs #HM #_ #_ * #rb #HB12 #Hrb * #ra #HA12 #Hra - lapply (pl_sreds_trans … HM (dx:::ra) (@B1.A2) ?) /2 width=1/ -A1 #HM - lapply (pl_sreds_trans … HM (sn:::rb) (@B2.A2) ?) /2 width=1/ -B1 #HM - @(ex2_intro … HM) -M -B2 -A2 >associative_append /3 width=1/ -] -qed-. - -theorem dst_trans: transitive … dst. -#M1 #M #M2 #HM1 #HM2 -elim (dst_inv_pl_sreds_is_standard … HM1) -HM1 #s1 #HM1 #_ -elim (dst_inv_pl_sreds_is_standard … HM2) -HM2 #s2 #HM2 #_ -lapply (pl_sreds_trans … HM1 … HM2) -M /2 width=2/ -qed-. - -theorem pl_sreds_standard: ∀s,M,N. M ↦*[s] N → ∃∃r. M ↦*[r] N & is_standard r. -#s #M #N #H -@dst_inv_pl_sreds_is_standard /2 width=2/ -qed-. - -(* Note: we use "lapply (rewrite_r ?? is_whd … Hq)" (procedural) - in place of "cut (is_whd (q::r)) [ >Hq ]" (declarative) -*) -lemma dst_in_whd_swap: ∀p. in_whd p → ∀N1,N2. N1 ↦[p] N2 → ∀M1. M1 ⓢ↦* N1 → - ∃∃q,M2. in_whd q & M1 ↦[q] M2 & M2 ⓢ↦* N2. -#p #H @(in_whd_ind … H) -p -[ #N1 #N2 #H1 #M1 #H2 - elim (pl_sred_inv_nil … H1 …) -H1 // #D #C #HN1 #HN2 - elim (dst_inv_appl … H2 … HN1) -N1 #s1 #D1 #N #Hs1 #HM1 #HD1 #H - elim (dst_inv_abst … H …) -H [3: // |2: skip ] #s2 #C1 #Hs2 #HN #HC1 (**) (* simplify line *) - lapply (pl_sreds_trans … HM1 … (dx:::s2) (@D1.𝛌.C1) ?) /2 width=1/ -N #HM1 - lapply (pl_sreds_step_dx … HM1 (◊) ([↙D1]C1) ?) -HM1 // #HM1 - elim (pl_sreds_inv_pos … HM1 …) -HM1 - [2: >length_append normalize in ⊢ (??(??%)); // ] - #q #r #M #Hq #HM1 #HM - lapply (rewrite_r ?? is_whd … Hq) -Hq /4 width=1/ -s1 -s2 * #Hq #Hr - @(ex3_2_intro … HM1) -M1 // -q - @(dst_step_sn … HM) /2 width=1/ -| #p #_ #IHp #N1 #N2 #H1 #M1 #H2 - elim (pl_sred_inv_dx … H1 …) -H1 [3: // |2: skip ] #D #C1 #C2 #HC12 #HN1 #HN2 (**) (* simplify line *) - elim (dst_inv_appl … H2 … HN1) -N1 #s #B #A1 #Hs #HM1 #HBD #HAC1 - elim (IHp … HC12 … HAC1) -p -C1 #p #C1 #Hp #HAC1 #HC12 - lapply (pl_sreds_step_dx … HM1 (dx::p) (@B.C1) ?) -HM1 /2 width=1/ -A1 #HM1 - elim (pl_sreds_inv_pos … HM1 …) -HM1 - [2: >length_append normalize in ⊢ (??(??%)); // ] - #q #r #M #Hq #HM1 #HM - lapply (rewrite_r ?? is_whd … Hq) -Hq /4 width=1/ -p -s * #Hq #Hr - @(ex3_2_intro … HM1) -M1 // -q /2 width=7/ -] -qed-. - -theorem pl_sreds_in_whd_swap: ∀s,M1,N1. M1 ↦*[s] N1 → - ∀p,N2. in_whd p → N1 ↦[p] N2 → - ∃∃q,r,M2. in_whd q & M1 ↦[q] M2 & M2 ↦*[r] N2 & - is_standard (q::r). -#s #M1 #N1 #HMN1 #p #N2 #Hp #HN12 -lapply (pl_sreds_dst … HMN1) -s #HMN1 -elim (dst_in_whd_swap … Hp … HN12 … HMN1) -p -N1 #q #M2 #Hq #HM12 #HMN2 -elim (dst_inv_pl_sreds_is_standard … HMN2) -HMN2 /3 width=8/ -qed-. diff --git a/matita/matita/contribs/lambda/paths/labeled_sequential_computation.ma b/matita/matita/contribs/lambda/paths/labeled_sequential_computation.ma deleted file mode 100644 index 57a88baa8..000000000 --- a/matita/matita/contribs/lambda/paths/labeled_sequential_computation.ma +++ /dev/null @@ -1,112 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "terms/labeled_sequential_computation.ma". -include "paths/trace.ma". -include "paths/labeled_sequential_reduction.ma". - -(* PATH-LABELED SEQUENTIAL COMPUTATION (MULTISTEP) *******************************) - -(* Note: lstar shuld be replaced by l_sreds *) -definition pl_sreds: trace → relation term ≝ lstar … pl_sred. - -interpretation "path-labeled sequential computation" - 'SeqRedStar M s N = (pl_sreds s M N). - -lemma sreds_pl_sreds: ∀M,N. M ↦* N → ∃s. M ↦*[s] N. -/3 width=1 by sreds_l_sreds, sred_pl_sred/ -qed-. - -lemma pl_sreds_inv_sreds: ∀s,M,N. M ↦*[s] N → M ↦* N. -/3 width=5 by l_sreds_inv_sreds, pl_sred_inv_sred/ -qed-. - -lemma pl_sreds_refl: reflexive … (pl_sreds (◊)). -// -qed. - -lemma pl_sreds_step_sn: ∀p,M1,M. M1 ↦[p] M → ∀s,M2. M ↦*[s] M2 → M1 ↦*[p::s] M2. -/2 width=3/ -qed-. - -lemma pl_sreds_step_dx: ∀s,M1,M. M1 ↦*[s] M → ∀p,M2. M ↦[p] M2 → M1 ↦*[s@p::◊] M2. -/2 width=3/ -qed-. - -lemma pl_sreds_step_rc: ∀p,M1,M2. M1 ↦[p] M2 → M1 ↦*[p::◊] M2. -/2 width=1/ -qed. - -lemma pl_sreds_inv_nil: ∀s,M1,M2. M1 ↦*[s] M2 → ◊ = s → M1 = M2. -/2 width=5 by lstar_inv_nil/ -qed-. - -lemma pl_sreds_inv_cons: ∀s,M1,M2. M1 ↦*[s] M2 → ∀q,r. q::r = s → - ∃∃M. M1 ↦[q] M & M ↦*[r] M2. -/2 width=3 by lstar_inv_cons/ -qed-. - -lemma pl_sreds_inv_step_rc: ∀p,M1,M2. M1 ↦*[p::◊] M2 → M1 ↦[p] M2. -/2 width=1 by lstar_inv_step/ -qed-. - -lemma pl_sreds_inv_pos: ∀s,M1,M2. M1 ↦*[s] M2 → 0 < |s| → - ∃∃p,r,M. p::r = s & M1 ↦[p] M & M ↦*[r] M2. -/2 width=1 by lstar_inv_pos/ -qed-. - -lemma lsred_compatible_rc: ho_compatible_rc pl_sreds. -/3 width=1/ -qed. - -lemma pl_sreds_compatible_sn: ho_compatible_sn pl_sreds. -/3 width=1/ -qed. - -lemma pl_sreds_compatible_dx: ho_compatible_dx pl_sreds. -/3 width=1/ -qed. - -lemma pl_sreds_lift: ∀s. liftable (pl_sreds s). -/2 width=1/ -qed. - -lemma pl_sreds_inv_lift: ∀s. deliftable_sn (pl_sreds s). -/3 width=3 by lstar_deliftable_sn, pl_sred_inv_lift/ -qed-. - -lemma pl_sreds_dsubst: ∀s. dsubstable_dx (pl_sreds s). -/2 width=1/ -qed. - -theorem pl_sreds_mono: ∀s. singlevalued … (pl_sreds s). -/3 width=7 by lstar_singlevalued, pl_sred_mono/ -qed-. - -theorem pl_sreds_trans: ltransitive … pl_sreds. -/2 width=3 by lstar_ltransitive/ -qed-. - -lemma pl_sreds_compatible_appl: ∀r,B1,B2. B1 ↦*[r] B2 → ∀s,A1,A2. A1 ↦*[s] A2 → - @B1.A1 ↦*[(sn:::r)@dx:::s] @B2.A2. -#r #B1 #B2 #HB12 #s #A1 #A2 #HA12 -@(pl_sreds_trans … (@B2.A1)) /2 width=1/ -qed. - -lemma pl_sreds_compatible_beta: ∀r,B1,B2. B1 ↦*[r] B2 → ∀s,A1,A2. A1 ↦*[s] A2 → - @B1.𝛌.A1 ↦*[(sn:::r)@(dx:::rc:::s)@◊::◊] [↙B2] A2. -#r #B1 #B2 #HB12 #s #A1 #A2 #HA12 -@(pl_sreds_trans … (@B2.𝛌.A1)) /2 width=1/ -r -B1 -@(pl_sreds_step_dx … (@B2.𝛌.A2)) // /3 width=1/ -qed. diff --git a/matita/matita/contribs/lambda/paths/labeled_sequential_reduction.ma b/matita/matita/contribs/lambda/paths/labeled_sequential_reduction.ma deleted file mode 100644 index 8864a708e..000000000 --- a/matita/matita/contribs/lambda/paths/labeled_sequential_reduction.ma +++ /dev/null @@ -1,128 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "paths/path.ma". -include "terms/sequential_reduction.ma". - -(* PATH-LABELED SEQUENTIAL REDUCTION (SINGLE STEP) **************************) - -inductive pl_sred: path → relation term ≝ -| pl_sred_beta : ∀B,A. pl_sred (◊) (@B.𝛌.A) ([↙B]A) -| pl_sred_abst : ∀p,A1,A2. pl_sred p A1 A2 → pl_sred (rc::p) (𝛌.A1) (𝛌.A2) -| pl_sred_appl_sn: ∀p,B1,B2,A. pl_sred p B1 B2 → pl_sred (sn::p) (@B1.A) (@B2.A) -| pl_sred_appl_dx: ∀p,B,A1,A2. pl_sred p A1 A2 → pl_sred (dx::p) (@B.A1) (@B.A2) -. - -interpretation "path-labeled sequential reduction" - 'SeqRed M p N = (pl_sred p M N). - -lemma sred_pl_sred: ∀M,N. M ↦ N → ∃p. M ↦[p] N. -#M #N #H elim H -M -N -[ /2 width=2/ -| #A1 #A2 #_ * /3 width=2/ -| #B1 #B2 #A #_ * /3 width=2/ -| #B #A1 #A2 #_ * /3 width=2/ -] -qed-. - -lemma pl_sred_inv_sred: ∀p,M,N. M ↦[p] N → M ↦ N. -#p #M #N #H elim H -p -M -N // /2 width=1/ -qed-. - -lemma pl_sred_inv_vref: ∀p,M,N. M ↦[p] N → ∀i. #i = M → ⊥. -/3 width=5 by pl_sred_inv_sred, sred_inv_vref/ -qed-. - -lemma pl_sred_inv_nil: ∀p,M,N. M ↦[p] N → ◊ = p → - ∃∃B,A. @B. 𝛌.A = M & [↙B] A = N. -#p #M #N * -p -M -N -[ #B #A #_ destruct /2 width=4/ -| #p #A1 #A2 #_ #H destruct -| #p #B1 #B2 #A #_ #H destruct -| #p #B #A1 #A2 #_ #H destruct -] -qed-. - -lemma pl_sred_inv_rc: ∀p,M,N. M ↦[p] N → ∀q. rc::q = p → - ∃∃A1,A2. A1 ↦[q] A2 & 𝛌.A1 = M & 𝛌.A2 = N. -#p #M #N * -p -M -N -[ #B #A #q #H destruct -| #p #A1 #A2 #HA12 #q #H destruct /2 width=5/ -| #p #B1 #B2 #A #_ #q #H destruct -| #p #B #A1 #A2 #_ #q #H destruct -] -qed-. - -lemma pl_sred_inv_sn: ∀p,M,N. M ↦[p] N → ∀q. sn::q = p → - ∃∃B1,B2,A. B1 ↦[q] B2 & @B1.A = M & @B2.A = N. -#p #M #N * -p -M -N -[ #B #A #q #H destruct -| #p #A1 #A2 #_ #q #H destruct -| #p #B1 #B2 #A #HB12 #q #H destruct /2 width=6/ -| #p #B #A1 #A2 #_ #q #H destruct -] -qed-. - -lemma pl_sred_inv_dx: ∀p,M,N. M ↦[p] N → ∀q. dx::q = p → - ∃∃B,A1,A2. A1 ↦[q] A2 & @B.A1 = M & @B.A2 = N. -#p #M #N * -p -M -N -[ #B #A #q #H destruct -| #p #A1 #A2 #_ #q #H destruct -| #p #B1 #B2 #A #_ #q #H destruct -| #p #B #A1 #A2 #HA12 #q #H destruct /2 width=6/ -] -qed-. - -lemma pl_sred_lift: ∀p. liftable (pl_sred p). -#p #h #M1 #M2 #H elim H -p -M1 -M2 normalize /2 width=1/ -#B #A #d dsubst_dsubst_ge // -qed. - -theorem pl_sred_mono: ∀p. singlevalued … (pl_sred p). -#p #M #N1 #H elim H -p -M -N1 -[ #B #A #N2 #H elim (pl_sred_inv_nil … H …) -H // - #D #C #H #HN2 destruct // -| #p #A1 #A2 #_ #IHA12 #N2 #H elim (pl_sred_inv_rc … H …) -H [3: // |2: skip ] (**) (* simplify line *) - #C1 #C2 #HC12 #H #HN2 destruct /3 width=1/ -| #p #B1 #B2 #A #_ #IHB12 #N2 #H elim (pl_sred_inv_sn … H …) -H [3: // |2: skip ] (**) (* simplify line *) - #D1 #D2 #C #HD12 #H #HN2 destruct /3 width=1/ -| #p #B #A1 #A2 #_ #IHA12 #N2 #H elim (pl_sred_inv_dx … H …) -H [3: // |2: skip ] (**) (* simplify line *) - #D #C1 #C2 #HC12 #H #HN2 destruct /3 width=1/ -] -qed-. diff --git a/matita/matita/contribs/lambda/paths/labeled_st_computation.ma b/matita/matita/contribs/lambda/paths/labeled_st_computation.ma deleted file mode 100644 index 29dd72769..000000000 --- a/matita/matita/contribs/lambda/paths/labeled_st_computation.ma +++ /dev/null @@ -1,320 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "paths/standard_trace.ma". -include "paths/labeled_sequential_computation.ma". -include "paths/labeled_st_reduction.ma". - -(* PATH-LABELED STANDARD COMPUTATION (MULTISTEP) ****************************) - -(* Note: lstar shuld be replaced by l_sreds *) -definition pl_sts: trace → relation subterms ≝ lstar … pl_st. - -interpretation "path-labeled standard reduction" - 'StdStar F p G = (pl_sts p F G). - -notation "hvbox( F break Ⓡ ↦* [ term 46 p ] break term 46 G )" - non associative with precedence 45 - for @{ 'StdStar $F $p $G }. - -lemma pl_sts_fwd_pl_sreds: ∀s,F1,F2. F1 Ⓡ↦*[s] F2 → ⇓F1 ↦*[s] ⇓F2. -#s #F1 #F2 #H @(lstar_ind_r … s F2 H) -s -F2 // -#p #s #F #F2 #_ #HF2 #IHF1 -lapply (pl_st_fwd_pl_sred … HF2) -HF2 /2 width=3/ -qed-. - -lemma pl_sts_inv_pl_sreds: ∀s,M1,F2. {⊤}⇑M1 Ⓡ↦*[s] F2 → is_whd s → - ∃∃M2. M1 ↦*[s] M2 & {⊤}⇑M2 = F2. -#s #M1 #F2 #H @(lstar_ind_r … s F2 H) -s -F2 /2 width=3/ -#p #s #F #F2 #_ #HF2 #IHF #H -elim (is_whd_inv_append … H) -H #Hs * #Hp #_ -elim (IHF Hs) -IHF -Hs #M #HM #H destruct -elim (pl_st_inv_pl_sred … HF2) -HF2 // -Hp #M2 #HM2 #H -lapply (pl_sreds_step_dx … HM … HM2) -M /2 width=3/ -qed-. - -lemma pl_sts_inv_empty: ∀s,M1,F2. {⊥}⇑M1 Ⓡ↦*[s] F2 → ◊ = s ∧ {⊥}⇑M1 = F2. -#s #M1 #F2 #H @(lstar_ind_r … s F2 H) -s -F2 /2 width=1/ #p #s #F #F2 #_ #HF2 * #_ #H -elim (pl_st_inv_empty … HF2 … H) -qed-. - -lemma pl_sts_refl: reflexive … (pl_sts (◊)). -// -qed. - -lemma pl_sts_step_sn: ∀p,F1,F. F1 Ⓡ↦[p] F → ∀s,F2. F Ⓡ↦*[s] F2 → F1 Ⓡ↦*[p::s] F2. -/2 width=3/ -qed-. - -lemma pl_sts_step_dx: ∀s,F1,F. F1 Ⓡ↦*[s] F → ∀p,F2. F Ⓡ↦[p] F2 → F1 Ⓡ↦*[s@p::◊] F2. -/2 width=3/ -qed-. - -lemma pl_sts_step_rc: ∀p,F1,F2. F1 Ⓡ↦[p] F2 → F1 Ⓡ↦*[p::◊] F2. -/2 width=1/ -qed. - -lemma pl_sts_inv_nil: ∀s,F1,F2. F1 Ⓡ↦*[s] F2 → ◊ = s → F1 = F2. -/2 width=5 by lstar_inv_nil/ -qed-. - -lemma pl_sts_inv_cons: ∀s,F1,F2. F1 Ⓡ↦*[s] F2 → ∀q,r. q::r = s → - ∃∃F. F1 Ⓡ↦[q] F & F Ⓡ↦*[r] F2. -/2 width=3 by lstar_inv_cons/ -qed-. - -lemma pl_sts_inv_step_rc: ∀p,F1,F2. F1 Ⓡ↦*[p::◊] F2 → F1 Ⓡ↦[p] F2. -/2 width=1 by lstar_inv_step/ -qed-. - -lemma pl_sts_inv_pos: ∀s,F1,F2. F1 Ⓡ↦*[s] F2 → 0 < |s| → - ∃∃p,r,F. p::r = s & F1 Ⓡ↦[p] F & F Ⓡ↦*[r] F2. -/2 width=1 by lstar_inv_pos/ -qed-. - -lemma pl_sts_inv_rc_abst_dx: ∀b2,s,F1,T2. F1 Ⓡ↦*[s] {b2}𝛌.T2 → ∀r. rc:::r = s → - ∃∃b1,T1. T1 Ⓡ↦*[r] T2 & {b1}𝛌.T1 = F1. -#b2 #s #F1 #T2 #H @(lstar_ind_l … s F1 H) -s -F1 -[ #r #H lapply (map_cons_inv_nil … r H) -H #H destruct /2 width=4/ -| #p #s #F1 #F #HF1 #_ #IHF2 #r #H -b2 - elim (map_cons_inv_cons … r H) -H #q #r0 #Hp #Hs #Hr - elim (pl_st_inv_rc … HF1 … Hp) -HF1 -p #b1 #T1 #T #HT1 #HF1 #HF destruct - elim (IHF2 …) -IHF2 [3: // |2: skip ] (**) (* simplify line *) - #b0 #T0 #HT02 #H destruct - lapply (pl_sts_step_sn … HT1 … HT02) -T /2 width=4/ -] -qed-. - -lemma pl_sts_inv_sn_appl_dx: ∀b2,s,F1,V2,T2. F1 Ⓡ↦*[s] {b2}@V2.T2 → ∀r. sn:::r = s → - ∃∃b1,V1,T1. V1 Ⓡ↦*[r] V2 & {b1}@V1.T1 = F1. -#b2 #s #F1 #V2 #T2 #H @(lstar_ind_l … s F1 H) -s -F1 -[ #r #H lapply (map_cons_inv_nil … r H) -H #H destruct /2 width=5/ -| #p #s #F1 #F #HF1 #_ #IHF2 #r #H -b2 - elim (map_cons_inv_cons … r H) -H #q #r0 #Hp #Hs #Hr - elim (pl_st_inv_sn … HF1 … Hp) -HF1 -p #b1 #V1 #V #T1 #HV1 #HF1 #HF destruct - elim (IHF2 …) -IHF2 [3: // |2: skip ] (**) (* simplify line *) - #b0 #V0 #T0 #HV02 #H destruct - lapply (pl_sts_step_sn … HV1 … HV02) -V /2 width=5/ -] -qed-. - -lemma pl_sts_inv_dx_appl_dx: ∀b,s,F1,V,T2. F1 Ⓡ↦*[s] {b}@V.T2 → ∀r. dx:::r = s → - ∃∃T1. T1 Ⓡ↦*[r] T2 & {b}@V.T1 = F1. -#b #s #F1 #V #T2 #H @(lstar_ind_l … s F1 H) -s -F1 -[ #r #H lapply (map_cons_inv_nil … r H) -H #H destruct /2 width=3/ -| #p #s #F1 #F #HF1 #_ #IHF2 #r #H - elim (map_cons_inv_cons … r H) -H #q #r0 #Hp #Hs #Hr - elim (pl_st_inv_dx … HF1 … Hp) -HF1 -p #b0 #V0 #T1 #T #HT1 #HF1 #HF destruct - elim (IHF2 …) -IHF2 [3: // |2: skip ] (**) (* simplify line *) - #T0 #HT02 #H destruct - lapply (pl_sts_step_sn … HT1 … HT02) -T /2 width=3/ -] -qed-. - -lemma pl_sts_lift: ∀s. sliftable (pl_sts s). -/2 width=1/ -qed. - -lemma pl_sts_inv_lift: ∀s. sdeliftable_sn (pl_sts s). -/3 width=3 by lstar_sdeliftable_sn, pl_st_inv_lift/ -qed-. - -lemma pl_sts_dsubst: ∀s. sdsubstable_f_dx … (booleanized ⊥) (pl_sts s). -/2 width=1/ -qed. - -theorem pl_sts_mono: ∀s. singlevalued … (pl_sts s). -/3 width=7 by lstar_singlevalued, pl_st_mono/ -qed-. - -theorem pl_sts_trans: ltransitive … pl_sts. -/2 width=3 by lstar_ltransitive/ -qed-. - -lemma pl_sts_inv_trans: inv_ltransitive … pl_sts. -/2 width=3 by lstar_inv_ltransitive/ -qed-. - -lemma pl_sts_fwd_dx_sn_appl_dx: ∀b2,s,r,F1,V2,T2. F1 Ⓡ↦*[(dx:::s)@(sn:::r)] {b2}@V2.T2 → - ∃∃b1,V1,T1,T0. V1 Ⓡ↦*[r] V2 & T1 Ⓡ↦*[s] T0 & {b1}@V1.T1 = F1. -#b2 #s #r #F1 #V2 #T2 #H -elim (pl_sts_inv_trans … H) -H #F #HF1 #H -elim (pl_sts_inv_sn_appl_dx … H …) -H [3: // |2: skip ] (**) (* simplify line *) -#b #V #T #HV2 #H destruct -elim (pl_sts_inv_dx_appl_dx … HF1 …) -HF1 [3: // |2: skip ] (**) (* simplify line *) -#T1 #HT1 #H destruct /2 width=7/ -qed-. - -theorem pl_sts_fwd_is_standard: ∀s,F1,F2. F1 Ⓡ↦*[s] F2 → is_standard s. -#s elim s -s // #p1 * // -#p2 #s #IHs #F1 #F2 #H -elim (pl_sts_inv_cons … H …) -H [4: // |2,3: skip ] #F3 #HF13 #H (**) (* simplify line *) -elim (pl_sts_inv_cons … H …) [2: // |3,4: skip ] #F4 #HF34 #_ (**) (* simplify line *) -lapply (pl_st_fwd_sle … HF13 … HF34) -F1 -F4 /3 width=3/ -qed-. - -lemma pl_sts_fwd_abst_dx: ∀b2,s,F1,T2. F1 Ⓡ↦*[s] {b2}𝛌.T2 → - ∃∃r1,r2. is_whd r1 & r1@rc:::r2 = s. -#b2 #s #F1 #T2 #H -lapply (pl_sts_fwd_is_standard … H) -@(lstar_ind_l … s F1 H) -s -F1 -[ #_ @(ex2_2_intro … ◊ ◊) // (**) (* auto needs some help here *) -| #p #s #F1 #F #HF1 #HF2 #IHF1 #Hs - lapply (is_standard_fwd_cons … Hs) #H - elim (IHF1 …) // -IHF1 -H #r1 #r2 #Hr1 #H destruct - elim (in_whd_or_in_inner p) #Hp - [ -Hs -F1 -F -T2 -b2 - @(ex2_2_intro … (p::r1) r2) // /2 width=1/ (**) (* auto needs some help here *) - | lapply (is_standard_fwd_append_sn (p::r1) ? Hs) -Hs #H - lapply (is_standard_fwd_in_inner … H ?) -H // #H - lapply (is_whd_is_inner_inv … Hr1 ?) -Hr1 // -H #H destruct - elim (in_inner_inv … Hp) -Hp * #q [3: #IHq ] #Hp -(* case 1: dx *) - [ -IHq - elim (pl_sts_inv_rc_abst_dx … HF2 …) -b2 [3: // |2: skip ] (**) (* simplify line *) - #b #T #_ #HT -T2 - elim (pl_st_inv_dx … HF1 …) -HF1 [3: // |2: skip ] (**) (* simplify line *) - #c #V #T1 #T0 #_ #_ #HT0 -q -T1 -F1 destruct -(* case 2: rc *) - | destruct -F1 -F -T2 -b2 - @(ex2_2_intro … ◊ (q::r2)) // (**) (* auto needs some help here *) -(* case 3: sn *) - | elim (pl_sts_inv_rc_abst_dx … HF2 …) -b2 [3: // |2: skip ] (**) (* simplify line *) - #b #T #_ #HT -T2 - elim (pl_st_inv_sn … HF1 …) -HF1 [3: // |2: skip ] (**) (* simplify line *) - #c #V1 #V #T0 #_ #_ #HT0 -c -q -V1 -F1 destruct - ] - ] -] -qed-. - -lemma pl_sts_fwd_appl_dx: ∀b2,s,F1,V2,T2. F1 Ⓡ↦*[s] {b2}@V2.T2 → - ∃∃r1,r2,r3. is_whd r1 & is_inner r2 & - r1@(dx:::r2)@sn:::r3 = s. -#b2 #s #F1 #V2 #T2 #H -lapply (pl_sts_fwd_is_standard … H) -@(lstar_ind_l … s F1 H) -s -F1 -[ #_ @(ex3_3_intro … ◊ ◊ ◊) // (**) (* auto needs some help here *) -| #p #s #F1 #F #HF1 #HF2 #IHF1 #Hs - lapply (is_standard_fwd_cons … Hs) #H - elim (IHF1 …) // -IHF1 -H #r1 #r2 #r3 #Hr1 #Hr2 #H destruct - elim (in_whd_or_in_inner p) #Hp - [ -Hs -F1 -F -V2 -T2 -b2 - @(ex3_3_intro … (p::r1) r2 r3) // /2 width=1/ (**) (* auto needs some help here *) - | lapply (is_standard_fwd_append_sn (p::r1) ? Hs) -Hs #H - lapply (is_standard_fwd_in_inner … H ?) -H // #H - lapply (is_whd_is_inner_inv … Hr1 ?) -Hr1 // -H #H destruct - elim (in_inner_inv … Hp) -Hp * #q [3: #IHq ] #Hp -(* case 1: dx *) - [ destruct -F1 -F -V2 -T2 -b2 - @(ex3_3_intro … ◊ (q::r2) r3) // /2 width=1/ (**) (* auto needs some help here *) -(* case 2: rc *) - | -Hr2 - elim (pl_sts_fwd_dx_sn_appl_dx … HF2) -b2 #b #V #T #T0 #_ #_ #HT -V2 -T2 -T0 - elim (pl_st_inv_rc … HF1 … Hp) -HF1 #c #V0 #T0 #_ #_ #HT0 -c -V0 -q -F1 destruct -(* case 3: sn *) - | -Hr2 - elim (pl_sts_fwd_dx_sn_appl_dx … HF2) -b2 #b #V #T #T0 #_ #HT0 #HT -V2 -T2 - elim (pl_st_inv_sn … HF1 … Hp) -HF1 #c #V1 #V0 #T1 #_ #_ #H -c -V1 -F1 destruct -V - elim (pl_sts_inv_empty … HT0) -HT0 #H #_ -T0 -T1 destruct - @(ex3_3_intro … ◊ ◊ (q::r3)) // (**) (* auto needs some help here *) - ] - ] -] -qed-. - -lemma pl_sred_is_standard_pl_st: ∀p,M,M2. M ↦[p] M2 → ∀F. ⇓F = M → - ∀s,M1.{⊤}⇑ M1 Ⓡ↦*[s] F → - is_standard (s@(p::◊)) → - ∃∃F2. F Ⓡ↦[p] F2 & ⇓F2 = M2. -#p #M #M2 #H elim H -p -M -M2 -[ #B #A #F #HF #s #M1 #HM1 #Hs - lapply (is_standard_fwd_is_whd … Hs) -Hs // #Hs - elim (pl_sts_inv_pl_sreds … HM1 Hs) -HM1 -Hs #M #_ #H -s -M1 destruct - >carrier_boolean in HF; #H destruct normalize /2 width=3/ -| #p #A1 #A2 #_ #IHA12 #F #HF #s #M1 #HM1 #Hs - elim (carrier_inv_abst … HF) -HF #b #T #HT #HF destruct - elim (pl_sts_fwd_abst_dx … HM1) #r1 #r2 #Hr1 #H destruct - elim (pl_sts_inv_trans … HM1) -HM1 #F0 #HM1 #HT - elim (pl_sts_inv_pl_sreds … HM1 …) // #M0 #_ #H -M1 -Hr1 destruct - >associative_append in Hs; #Hs - lapply (is_standard_fwd_append_dx … Hs) -r1 - <(map_cons_append … r2 (p::◊)) #H - lapply (is_standard_inv_compatible_rc … H) -H #Hp - elim (pl_sts_inv_rc_abst_dx … HT …) -HT [3: // |2: skip ] #b0 #T0 #HT02 #H (**) (* simplify line *) - elim (boolean_inv_abst … (sym_eq … H)) -H #A0 #_ #H #_ -b0 -M0 destruct - elim (IHA12 … HT02 …) // -r2 -A0 -IHA12 #F2 #HF2 #H - @(ex2_intro … ({⊥}𝛌.F2)) normalize // /2 width=1/ (**) (* auto needs some help here *) -| #p #B1 #B2 #A #_ #IHB12 #F #HF #s #M1 #HM1 #Hs - elim (carrier_inv_appl … HF) -HF #b #V #T #HV #HT #HF destruct - elim (pl_sts_fwd_appl_dx … HM1) #r1 #r2 #r3 #Hr1 #_ #H destruct - elim (pl_sts_inv_trans … HM1) -HM1 #F0 #HM1 #HT - elim (pl_sts_inv_pl_sreds … HM1 …) // #M0 #_ #H -M1 -Hr1 destruct - >associative_append in Hs; #Hs - lapply (is_standard_fwd_append_dx … Hs) -r1 - >associative_append #Hs - lapply (is_standard_fwd_append_dx … Hs) -Hs - <(map_cons_append … r3 (p::◊)) #H - lapply (is_standard_inv_compatible_sn … H) -H #Hp - elim (pl_sts_fwd_dx_sn_appl_dx … HT) -HT #b0 #V0 #T0 #T1 #HV0 #_ #H -T1 -r2 - elim (boolean_inv_appl … (sym_eq … H)) -H #B0 #A0 #_ #H #_ #_ -b0 -M0 -T0 destruct - elim (IHB12 … HV0 …) // -r3 -B0 -IHB12 #G2 #HG2 #H - @(ex2_intro … ({⊥}@G2.{⊥}⇕T)) normalize // /2 width=1/ (**) (* auto needs some help here *) -| #p #B #A1 #A2 #_ #IHA12 #F #HF #s #M1 #HM1 #Hs - elim (carrier_inv_appl … HF) -HF #b #V #T #HV #HT #HF destruct - elim (pl_sts_fwd_appl_dx … HM1) #r1 #r2 #r3 #Hr1 #Hr2 #H destruct - elim (pl_sts_inv_trans … HM1) -HM1 #F0 #HM1 #HT - elim (pl_sts_inv_pl_sreds … HM1 …) // #M0 #_ #H -M1 -Hr1 destruct - >associative_append in Hs; #Hs - lapply (is_standard_fwd_append_dx … Hs) -r1 - >associative_append #Hs - elim (list_inv … r3) - [ #H destruct - elim (in_whd_or_in_inner p) #Hp - [ lapply (is_standard_fwd_is_whd … Hs) -Hs /2 width=1/ -Hp #Hs - lapply (is_whd_inv_dx … Hs) -Hs #H - lapply (is_whd_is_inner_inv … Hr2) -Hr2 // -H #H destruct - lapply (pl_sts_inv_nil … HT ?) -HT // #H - elim (boolean_inv_appl … H) -H #B0 #A0 #_ #_ #H #_ -M0 -B0 destruct - elim (IHA12 … A0 …) -IHA12 [3,5,6: // |2,4: skip ] (* simplify line *) - #F2 #HF2 #H - @(ex2_intro … ({b}@V.F2)) normalize // /2 width=1/ (**) (* auto needs some help here *) - | <(map_cons_append … r2 (p::◊)) in Hs; #H - lapply (is_standard_inv_compatible_dx … H ?) -H /3 width=1/ -Hp #Hp - >append_nil in HT; #HT - elim (pl_sts_inv_dx_appl_dx … HT …) -HT [3: // |2: skip ] (* simplify line *) - #T0 #HT0 #H - elim (boolean_inv_appl … (sym_eq … H)) -H #B0 #A0 #_ #_ #H #_ -M0 -B0 destruct - elim (IHA12 … HT0 …) // -r2 -A0 -IHA12 #F2 #HF2 #H - @(ex2_intro … ({b}@V.F2)) normalize // /2 width=1/ (**) (* auto needs some help here *) - ] - | -IHA12 -Hr2 -M0 * #q #r #H destruct - lapply (is_standard_fwd_append_dx … Hs) -r2 #Hs - lapply (is_standard_fwd_sle … Hs) -r #H - elim (sle_inv_sn … H …) -H [3: // |2: skip ] (**) (* simplify line *) - #q0 #_ #H destruct - ] -] -qed-. - -theorem pl_sreds_is_standard_pl_sts: ∀s,M1,M2. M1 ↦*[s] M2 → is_standard s → - ∃∃F2. {⊤}⇑ M1 Ⓡ↦*[s] F2 & ⇓F2 = M2. -#s #M1 #M2 #H @(lstar_ind_r … s M2 H) -s -M2 /2 width=3/ -#p #s #M #M2 #_ #HM2 #IHM1 #Hsp -lapply (is_standard_fwd_append_sn … Hsp) #Hs -elim (IHM1 Hs) -IHM1 -Hs #F #HM1 #H -elim (pl_sred_is_standard_pl_st … HM2 … HM1 …) -HM2 // -M -Hsp #F2 #HF2 #HFM2 -lapply (pl_sts_step_dx … HM1 … HF2) -F -#H @(ex2_intro … F2) // (**) (* auto needs some help here *) -qed-. diff --git a/matita/matita/contribs/lambda/paths/labeled_st_reduction.ma b/matita/matita/contribs/lambda/paths/labeled_st_reduction.ma deleted file mode 100644 index 2f93b35af..000000000 --- a/matita/matita/contribs/lambda/paths/labeled_st_reduction.ma +++ /dev/null @@ -1,217 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "subterms/booleanized.ma". -include "paths/labeled_sequential_reduction.ma". -include "paths/standard_order.ma". - -(* PATH-LABELED STANDARD REDUCTION ON SUBTERMS (SINGLE STEP) ****************) - -(* Note: this is standard reduction on marked redexes, - left residuals are unmarked in the reductum -*) -inductive pl_st: path → relation subterms ≝ -| pl_st_beta : ∀V,T. pl_st (◊) ({⊤}@V.{⊤}𝛌.T) ([↙V]T) -| pl_st_abst : ∀b,p,T1,T2. pl_st p T1 T2 → pl_st (rc::p) ({b}𝛌.T1) ({⊥}𝛌.T2) -| pl_st_appl_sn: ∀b,p,V1,V2,T. pl_st p V1 V2 → pl_st (sn::p) ({b}@V1.T) ({⊥}@V2.{⊥}⇕T) -| pl_st_appl_dx: ∀b,p,V,T1,T2. pl_st p T1 T2 → pl_st (dx::p) ({b}@V.T1) ({b}@V.T2) -. - -interpretation "path-labeled standard reduction" - 'Std F p G = (pl_st p F G). - -notation "hvbox( F break Ⓡ ↦ [ term 46 p ] break term 46 G )" - non associative with precedence 45 - for @{ 'Std $F $p $G }. - -lemma pl_st_fwd_pl_sred: ∀p,F1,F2. F1 Ⓡ↦[p] F2 → ⇓F1 ↦[p] ⇓F2. -#p #F1 #F2 #H elim H -p -F1 -F2 normalize /2 width=1/ -qed-. - -lemma pl_st_inv_vref: ∀p,F,G. F Ⓡ↦[p] G → ∀b,i. {b}#i = F → ⊥. -#p #F #G #HFG #b #i #H -lapply (pl_st_fwd_pl_sred … HFG) -HFG #HFG -lapply (eq_f … carrier … H) -H normalize #H -/2 width=6 by pl_sred_inv_vref/ -qed-. - -lemma pl_st_inv_abst: ∀p,F,G. F Ⓡ↦[p] G → ∀c,U1. {c}𝛌.U1 = F → - ∃∃q,U2. U1 Ⓡ↦[q] U2 & rc::q = p & {⊥}𝛌.U2 = G. -#p #F #G * -p -F -G -[ #V #T #c #U1 #H destruct -| #b #p #T1 #T2 #HT12 #c #U1 #H destruct /2 width=5/ -| #b #p #V1 #V2 #T #_ #c #U1 #H destruct -| #b #p #V #T1 #T2 #_ #c #U1 #H destruct -] -qed-. - -lemma pl_st_inv_appl: ∀p,F,G. F Ⓡ↦[p] G → ∀c,W,U. {c}@W.U = F → - ∨∨ (∃∃U0. ⊤ = c & ◊ = p & {⊤}𝛌.U0 = U & [↙W] U0 = G) - | (∃∃q,W0. sn::q = p & W Ⓡ↦[q] W0 & {⊥}@W0.{⊥}⇕U = G) - | (∃∃q,U0. dx::q = p & U Ⓡ↦[q] U0 & {c}@W.U0 = G). -#p #F #G * -p -F -G -[ #V #T #c #W #U #H destruct /3 width=3/ -| #b #p #T1 #T2 #_ #c #W #U #H destruct -| #b #p #V1 #V2 #T #HV12 #c #W #U #H destruct /3 width=5/ -| #b #p #V #T1 #T2 #HT12 #c #W #U #H destruct /3 width=5/ -] -qed-. - -lemma pl_st_fwd_abst: ∀p,F,G. F Ⓡ↦[p] G → ∀c,U2. {c}𝛌.U2 = G → - ◊ = p ∨ ∃q. rc::q = p. -#p #F #G * -p -F -G -[ /2 width=1/ -| /3 width=2/ -| #b #p #V1 #V2 #T #_ #c #U2 #H destruct -| #b #p #V #T1 #T2 #_ #c #U2 #H destruct -] -qed-. - -lemma pl_st_inv_nil: ∀p,F,G. F Ⓡ↦[p] G → ◊ = p → - ∃∃V,T. {⊤}@V.{⊤} 𝛌.T = F & [↙V] T = G. -#p #F #G * -p -F -G -[ #V #T #_ destruct /2 width=4/ -| #b #p #T1 #T2 #_ #H destruct -| #b #p #V1 #V2 #T #_ #H destruct -| #b #p #V #T1 #T2 #_ #H destruct -] -qed-. - -lemma pl_st_inv_rc: ∀p,F,G. F Ⓡ↦[p] G → ∀q. rc::q = p → - ∃∃b,T1,T2. T1 Ⓡ↦[q] T2 & {b}𝛌.T1 = F & {⊥}𝛌.T2 = G. -#p #F #G * -p -F -G -[ #V #T #q #H destruct -| #b #p #T1 #T2 #HT12 #q #H destruct /2 width=6/ -| #b #p #V1 #V2 #T #_ #q #H destruct -| #b #p #V #T1 #T2 #_ #q #H destruct -] -qed-. - -lemma pl_st_inv_sn: ∀p,F,G. F Ⓡ↦[p] G → ∀q. sn::q = p → - ∃∃b,V1,V2,T. V1 Ⓡ↦[q] V2 & {b}@V1.T = F & {⊥}@V2.{⊥}⇕T = G. -#p #F #G * -p -F -G -[ #V #T #q #H destruct -| #b #p #T1 #T2 #_ #q #H destruct -| #b #p #V1 #V2 #T #HV12 #q #H destruct /2 width=7/ -| #b #p #V #T1 #T2 #_ #q #H destruct -] -qed-. - -lemma pl_st_inv_dx: ∀p,F,G. F Ⓡ↦[p] G → ∀q. dx::q = p → - ∃∃b,V,T1,T2. T1 Ⓡ↦[q] T2 & {b}@V.T1 = F & {b}@V.T2 = G. -#p #F #G * -p -F -G -[ #V #T #q #H destruct -| #b #p #T1 #T2 #_ #q #H destruct -| #b #p #V1 #V2 #T #_ #q #H destruct -| #b #p #V #T1 #T2 #HT12 #q #H destruct /2 width=7/ -] -qed-. - -lemma pl_st_inv_pl_sred: ∀p. in_whd p → ∀M1,F2. {⊤}⇑M1 Ⓡ↦[p] F2 → - ∃∃M2. M1 ↦[p] M2 & {⊤}⇑M2 = F2. -#p @(in_whd_ind … p) -p -[ #M1 #F2 #H - elim (pl_st_inv_nil … H …) -H // #V #T #HM1 #H - elim (boolean_inv_appl … (sym_eq … HM1)) -HM1 #B #N #_ #HB #HN #HM1 - elim (boolean_inv_abst … HN) -HN #A #_ #HA #HN destruct /2 width=3/ -| #p #_ #IHp #M1 #F2 #H - elim (pl_st_inv_dx … H …) -H [3: // |2:skip ] #b #V #T1 #T2 #HT12 #HM1 #H (**) (* simplify line *) - elim (boolean_inv_appl … (sym_eq … HM1)) -HM1 #B #A #Hb #HB #HA #HM1 destruct - elim (IHp … HT12) -IHp -HT12 #C #HAC #H destruct - @(ex2_intro … (@B.C)) // /2 width=1/ (**) (* auto needs some help here *) -] -qed-. - -lemma pl_st_lift: ∀p. sliftable (pl_st p). -#p #h #F1 #F2 #H elim H -p -F1 -F2 /2 width=1/ -[ #V #T #d normalize sdsubst_sdsubst_ge // -| #b #p #V1 #V2 #T #_ #IHV12 #d - whd in ⊢ (??%%); <(booleanized_booleanized ⊥) in ⊢ (???(???%)); ${MA}.new - if diff ${MA} ${MA}.new > /dev/null; - then rm -f ${MA}.new; - else mv -f ${MA} ${MA}.old; mv -f ${MA}.new ${MA}; - fi -done - -unset MA diff --git a/matita/matita/contribs/lambda/root b/matita/matita/contribs/lambda/root deleted file mode 100644 index 183f1bc68..000000000 --- a/matita/matita/contribs/lambda/root +++ /dev/null @@ -1 +0,0 @@ -baseuri=cic:/matita/lambda/ diff --git a/matita/matita/contribs/lambda/subterms/boolean.ma b/matita/matita/contribs/lambda/subterms/boolean.ma deleted file mode 100644 index f49b23b29..000000000 --- a/matita/matita/contribs/lambda/subterms/boolean.ma +++ /dev/null @@ -1,73 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "subterms/carrier.ma". - -(* BOOLEAN (EMPTY OR FULL) SUBSET *******************************************) - -let rec boolean b M on M ≝ match M with -[ VRef i ⇒ {b}#i -| Abst A ⇒ {b}𝛌.(boolean b A) -| Appl B A ⇒ {b}@(boolean b B).(boolean b A) -]. - -interpretation "boolean subset (subterms)" - 'ProjectUp b M = (boolean b M). - -notation "hvbox( { term 46 b } ⇑ break term 46 M)" - non associative with precedence 46 - for @{ 'ProjectUp $b $M }. - -lemma boolean_inv_vref: ∀j,c,b,M. {b}⇑ M = {c}#j → b = c ∧ M = #j. -#j #c #b * normalize -[ #i #H destruct /2 width=1/ -| #A #H destruct -| #B #A #H destruct -] -qed-. - -lemma boolean_inv_abst: ∀U,c,b,M. {b}⇑ M = {c}𝛌.U → - ∃∃C. b = c & {b}⇑C = U & M = 𝛌.C. -#U #c #b * normalize -[ #i #H destruct -| #A #H destruct /2 width=3/ -| #B #A #H destruct -] -qed-. - -lemma boolean_inv_appl: ∀W,U,c,b,M. {b}⇑ M = {c}@W.U → - ∃∃D,C. b = c & {b}⇑D = W & {b}⇑C = U & M = @D.C. -#W #U #c #b * normalize -[ #i #H destruct -| #A #H destruct -| #B #A #H destruct /2 width=5/ -] -qed-. - -lemma boolean_lift: ∀b,h,M,d. {b}⇑ ↑[d, h] M = ↑[d, h] {b}⇑ M. -#b #h #M elim M -M normalize // -qed. - -lemma boolean_dsubst: ∀b,N,M,d. {b}⇑ [d ↙ N] M = [d ↙ {b}⇑ N] {b}⇑ M. -#b #N #M elim M -M [2,3: normalize // ] -#i #d elim (lt_or_eq_or_gt i d) #Hid -[ >(sdsubst_vref_lt … Hid) >(dsubst_vref_lt … Hid) // -| destruct normalize // -| >(sdsubst_vref_gt … Hid) >(dsubst_vref_gt … Hid) // -] -qed. - -lemma carrier_boolean: ∀b,M. ⇓ {b}⇑ M = M. -#b #M elim M -M normalize // -qed. diff --git a/matita/matita/contribs/lambda/subterms/booleanized.ma b/matita/matita/contribs/lambda/subterms/booleanized.ma deleted file mode 100644 index b3258d224..000000000 --- a/matita/matita/contribs/lambda/subterms/booleanized.ma +++ /dev/null @@ -1,60 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "subterms/boolean.ma". - -(* BOOLEANIZED SUBSET (EMPTY OR FULL) ***************************************) - -definition booleanized: bool → subterms → subterms ≝ - λb,F. {b}⇑⇓F. - -interpretation "booleanized (subterms)" - 'ProjectSame b F = (booleanized b F). - -notation "hvbox( { term 46 b } ⇕ break term 46 F)" - non associative with precedence 46 - for @{ 'ProjectSame $b $F }. - -lemma booleanized_inv_vref: ∀j,c,b,F. {b}⇕ F = {c}#j → - ∃∃b1. b = c & F = {b1}#j. -#j #c #b #F #H -elim (boolean_inv_vref … H) -H #H0 #H -elim (carrier_inv_vref … H) -H /2 width=2/ -qed-. - -lemma booleanized_inv_abst: ∀U,c,b,F. {b}⇕ F = {c}𝛌.U → - ∃∃b1,T. b = c & {b}⇕T = U & F = {b1}𝛌.T. -#U #c #b #F #H -elim (boolean_inv_abst … H) -H #C #H0 #H1 #H -elim (carrier_inv_abst … H) -H #b1 #U1 #H3 destruct /2 width=4/ -qed-. - -lemma booleanized_inv_appl: ∀W,U,c,b,F. {b}⇕ F = {c}@W.U → - ∃∃b1,V,T. b = c & {b}⇕V = W & {b}⇕T = U & F = {b1}@V.T. -#W #U #c #b #F #H -elim (boolean_inv_appl … H) -H #D #C #H0 #H1 #H2 #H -elim (carrier_inv_appl … H) -H #b1 #W1 #U1 #H3 #H4 destruct /2 width=6/ -qed-. - -lemma booleanized_booleanized: ∀c,b,F. {b}⇕ {c}⇕ F = {b}⇕ F. -normalize // -qed. - -lemma booleanized_lift: ∀b,h,F,d. {b}⇕ ↑[d, h] F = ↑[d, h] {b}⇕ F. -normalize // -qed. - -lemma booleanized_dsubst: ∀b,G,F,d. {b}⇕ [d ↙ G] F = [d ↙ {b}⇕ G] {b}⇕ F. -normalize // -qed. diff --git a/matita/matita/contribs/lambda/subterms/carrier.ma b/matita/matita/contribs/lambda/subterms/carrier.ma deleted file mode 100644 index 8936792e2..000000000 --- a/matita/matita/contribs/lambda/subterms/carrier.ma +++ /dev/null @@ -1,69 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "terms/relocating_substitution.ma". -include "subterms/relocating_substitution.ma". - -(* CARRIER (UNDERLYING TERM) ************************************************) - -let rec carrier F on F ≝ match F with -[ SVRef _ i ⇒ #i -| SAbst _ T ⇒ 𝛌.(carrier T) -| SAppl _ V T ⇒ @(carrier V).(carrier T) -]. - -interpretation "carrier (subterms)" - 'ProjectDown F = (carrier F). - -notation "hvbox(⇓ term 46 F)" - non associative with precedence 46 - for @{ 'ProjectDown $F }. - -lemma carrier_inv_vref: ∀j,F. ⇓F = #j → ∃b. F = {b}#j. -#j * normalize -[ #b #i #H destruct /2 width=2/ -| #b #T #H destruct -| #b #V #T #H destruct -] -qed-. - -lemma carrier_inv_abst: ∀C,F. ⇓F = 𝛌.C → ∃∃b,U. ⇓U = C & F = {b}𝛌.U. -#C * normalize -[ #b #i #H destruct -| #b #T #H destruct /2 width=4/ -| #b #V #T #H destruct -] -qed-. - -lemma carrier_inv_appl: ∀D,C,F. ⇓F = @D.C → - ∃∃b,W,U. ⇓W = D & ⇓U = C & F = {b}@W.U. -#D #C * normalize -[ #b #i #H destruct -| #b #T #H destruct -| #b #V #T #H destruct /2 width=6/ -] -qed-. - -lemma carrier_lift: ∀h,F,d. ⇓ ↑[d, h] F = ↑[d, h] ⇓F. -#h #F elim F -F normalize // -qed. - -lemma carrier_dsubst: ∀G,F,d. ⇓ [d ↙ G] F = [d ↙ ⇓G] ⇓F. -#G #F elim F -F [2,3: normalize // ] -#b #i #d elim (lt_or_eq_or_gt i d) #Hid -[ >(sdsubst_vref_lt … Hid) >(dsubst_vref_lt … Hid) // -| destruct normalize // -| >(sdsubst_vref_gt … Hid) >(dsubst_vref_gt … Hid) // -] -qed. diff --git a/matita/matita/contribs/lambda/subterms/relocating_substitution.ma b/matita/matita/contribs/lambda/subterms/relocating_substitution.ma deleted file mode 100644 index af5efe023..000000000 --- a/matita/matita/contribs/lambda/subterms/relocating_substitution.ma +++ /dev/null @@ -1,164 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "subterms/relocation.ma". - -(* RELOCATING SUBSTITUTION **************************************************) - -(* Policy: depth (level) metavariables: d, e (as for lift) *) -let rec sdsubst G d F on F ≝ match F with -[ SVRef b i ⇒ tri … i d ({b}#i) (↑[i] G) ({b}#(i-1)) -| SAbst b T ⇒ {b}𝛌. (sdsubst G (d+1) T) -| SAppl b V T ⇒ {b}@ (sdsubst G d V). (sdsubst G d T) -]. - -interpretation "relocating substitution for subterms" - 'DSubst G d F = (sdsubst G d F). - -lemma sdsubst_vref_lt: ∀b,i,d,G. i < d → [d ↙ G] {b}#i = {b}#i. -normalize /2 width=1/ -qed. - -lemma sdsubst_vref_eq: ∀b,i,G. [i ↙ G] {b}#i = ↑[i]G. -normalize // -qed. - -lemma sdsubst_vref_gt: ∀b,i,d,G. d < i → [d ↙ G] {b}#i = {b}#(i-1). -normalize /2 width=1/ -qed. - -theorem sdsubst_slift_le: ∀h,G,F,d1,d2. d2 ≤ d1 → - [d2 ↙ ↑[d1 - d2, h] G] ↑[d1 + 1, h] F = ↑[d1, h] [d2 ↙ G] F. -#h #G #F elim F -F -[ #b #i #d1 #d2 #Hd21 elim (lt_or_eq_or_gt i d2) #Hid2 - [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 #Hid1 - >(sdsubst_vref_lt … Hid2) >(slift_vref_lt … Hid1) >slift_vref_lt /2 width=1/ - | destruct >sdsubst_vref_eq >slift_vref_lt /2 width=1/ - | >(sdsubst_vref_gt … Hid2) -Hd21 elim (lt_or_ge (i-1) d1) #Hi1d1 - [ >(slift_vref_lt … Hi1d1) >slift_vref_lt /2 width=1/ - | lapply (ltn_to_ltO … Hid2) #Hi - >(slift_vref_ge … Hi1d1) >slift_vref_ge /2 width=1/ -Hi1d1 >plus_minus // /3 width=1/ - ] - ] -| normalize #b #T #IHT #d1 #d2 #Hd21 - lapply (IHT (d1+1) (d2+1) ?) -IHT /2 width=1/ -| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd21 - >IHV -IHV // >IHT -IHT // -] -qed. - -theorem sdsubst_slift_be: ∀h,G,F,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h → - [d2 ↙ G] ↑[d1, h + 1] F = ↑[d1, h] F. -#h #G #F elim F -F -[ #b #i #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 - [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 - >(slift_vref_lt … Hid1) >(slift_vref_lt … Hid1) /2 width=1/ - | lapply (transitive_le … (i+h) Hd21 ?) -Hd12 -Hd21 /2 width=1/ #Hd2 - >(slift_vref_ge … Hid1) >(slift_vref_ge … Hid1) -Hid1 - >sdsubst_vref_gt // /2 width=1/ - ] -| normalize #b #T #IHT #d1 #d2 #Hd12 #Hd21 - >IHT -IHT // /2 width=1/ -| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd12 #Hd21 - >IHV -IHV // >IHT -IHT // -] -qed. - -theorem sdsubst_slift_ge: ∀h,G,F,d1,d2. d1 + h ≤ d2 → - [d2 ↙ G] ↑[d1, h] F = ↑[d1, h] [d2 - h ↙ G] F. -#h #G #F elim F -F -[ #b #i #d1 #d2 #Hd12 elim (lt_or_eq_or_gt i (d2-h)) #Hid2h - [ >(sdsubst_vref_lt … Hid2h) elim (lt_or_ge i d1) #Hid1 - [ lapply (lt_to_le_to_lt … (d1+h) Hid1 ?) -Hid2h // #Hid1h - lapply (lt_to_le_to_lt … Hid1h Hd12) -Hid1h -Hd12 #Hid2 - >(slift_vref_lt … Hid1) -Hid1 /2 width=1/ - | >(slift_vref_ge … Hid1) -Hid1 -Hd12 /3 width=1/ - ] - | destruct elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #Hhd2 - >sdsubst_vref_eq >slift_vref_ge // >slift_slift_be // (sdsubst_vref_gt … Hid2h) - >slift_vref_ge /2 width=1/ >slift_vref_ge /2 width=1/ -Hid1 - >sdsubst_vref_gt /2 width=1/ -Hid2h >plus_minus // - ] -| normalize #b #T #IHT #d1 #d2 #Hd12 - elim (le_inv_plus_l … Hd12) #_ #Hhd2 - >IHT -IHT /2 width=1/ IHV -IHV // >IHT -IHT // -] -qed. - -theorem sdsubst_sdsubst_ge: ∀G1,G2,F,d1,d2. d1 ≤ d2 → - [d2 ↙ G2] [d1 ↙ G1] F = [d1 ↙ [d2 - d1 ↙ G2] G1] [d2 + 1 ↙ G2] F. -#G1 #G2 #F elim F -F -[ #b #i #d1 #d2 #Hd12 elim (lt_or_eq_or_gt i d1) #Hid1 - [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 - >(sdsubst_vref_lt … Hid1) >(sdsubst_vref_lt … Hid2) >sdsubst_vref_lt /2 width=1/ - | destruct >sdsubst_vref_eq >sdsubst_vref_lt /2 width=1/ - | >(sdsubst_vref_gt … Hid1) elim (lt_or_eq_or_gt i (d2+1)) #Hid2 - [ lapply (ltn_to_ltO … Hid1) #Hi - >(sdsubst_vref_lt … Hid2) >sdsubst_vref_lt /2 width=1/ - | destruct /2 width=1/ - | lapply (le_to_lt_to_lt (d1+1) … Hid2) -Hid1 /2 width=1/ -Hd12 #Hid1 - >(sdsubst_vref_gt … Hid2) >sdsubst_vref_gt /2 width=1/ - >sdsubst_vref_gt // /2 width=1/ - ] - ] -| normalize #b #T #IHT #d1 #d2 #Hd12 - lapply (IHT (d1+1) (d2+1) ?) -IHT /2 width=1/ -| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd12 - >IHV -IHV // >IHT -IHT // -] -qed. - -theorem sdsubst_sdsubst_lt: ∀G1,G2,F,d1,d2. d2 < d1 → - [d2 ↙ [d1 - d2 -1 ↙ G1] G2] [d1 ↙ G1] F = [d1 - 1 ↙ G1] [d2 ↙ G2] F. -#G1 #G2 #F #d1 #d2 #Hd21 -lapply (ltn_to_ltO … Hd21) #Hd1 ->sdsubst_sdsubst_ge in ⊢ (???%); /2 width=1/ (tri_lt ???? … Hid) -Hid -Hjd // - | #H destruct >tri_eq in Hjd; #H - elim (plus_lt_false … H) - | >(tri_gt ???? … Hid) - lapply (transitive_lt … Hjd Hid) -d #H #H0 destruct - elim (plus_lt_false … H) - ] -| #b #T #H destruct -| #b #V #T #H destruct -] -qed. - -lemma slift_inv_vref_ge: ∀c,j,d. d ≤ j → ∀h,E. ↑[d, h] E = {c}#j → - d + h ≤ j ∧ E = {c}#(j-h). -#c #j #d #Hdj #h * normalize -[ #b #i elim (lt_or_eq_or_gt i d) #Hid - [ >(tri_lt ???? … Hid) #H destruct - lapply (le_to_lt_to_lt … Hdj Hid) -Hdj -Hid #H - elim (lt_refl_false … H) - | #H -Hdj destruct /2 width=1/ - | >(tri_gt ???? … Hid) #H -Hdj destruct /4 width=1/ - ] -| #b #T #H destruct -| #b #V #T #H destruct -] -qed-. - -lemma slift_inv_vref_be: ∀c,j,d,h. d ≤ j → j < d + h → ∀E. ↑[d, h] E = {c}#j → ⊥. -#c #j #d #h #Hdj #Hjdh #E #H elim (slift_inv_vref_ge … H) -H // -Hdj #Hdhj #_ -E -lapply (lt_to_le_to_lt … Hjdh Hdhj) -d -h #H -elim (lt_refl_false … H) -qed-. - -lemma slift_inv_vref_ge_plus: ∀c,j,d,h. d + h ≤ j → - ∀E. ↑[d, h] E = {c}#j → E = {c}#(j-h). -#c #j #d #h #Hdhj #E #H elim (slift_inv_vref_ge … H) -H // -E /2 width=2/ -qed. - -lemma slift_inv_abst: ∀c,U,d,h,E. ↑[d, h] E = {c}𝛌.U → - ∃∃T. ↑[d+1, h] T = U & E = {c}𝛌.T. -#c #U #d #h * normalize -[ #b #i #H destruct -| #b #T #H destruct /2 width=3/ -| #b #V #T #H destruct -] -qed-. - -lemma slift_inv_appl: ∀c,W,U,d,h,E. ↑[d, h] E = {c}@W.U → - ∃∃V,T. ↑[d, h] V = W & ↑[d, h] T = U & E = {c}@V.T. -#c #W #U #d #h * normalize -[ #b #i #H destruct -| #b #T #H destruct -| #b #V #T #H destruct /2 width=5/ -] -qed-. - -theorem slift_slift_le: ∀h1,h2,E,d1,d2. d2 ≤ d1 → - ↑[d2, h2] ↑[d1, h1] E = ↑[d1 + h2, h1] ↑[d2, h2] E. -#h1 #h2 #E elim E -E -[ #b #i #d1 #d2 #Hd21 elim (lt_or_ge i d2) #Hid2 - [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 #Hid1 - >(slift_vref_lt … Hid1) >(slift_vref_lt … Hid2) - >slift_vref_lt // /2 width=1/ - | >(slift_vref_ge … Hid2) elim (lt_or_ge i d1) #Hid1 - [ >(slift_vref_lt … Hid1) >(slift_vref_ge … Hid2) - >slift_vref_lt // -d2 /2 width=1/ - | >(slift_vref_ge … Hid1) >slift_vref_ge /2 width=1/ - >slift_vref_ge // /2 width=1/ - ] - ] -| normalize #b #T #IHT #d1 #d2 #Hd21 >IHT // /2 width=1/ -| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd21 >IHV >IHT // -] -qed. - -theorem slift_slift_be: ∀h1,h2,E,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h1 → - ↑[d2, h2] ↑[d1, h1] E = ↑[d1, h1 + h2] E. -#h1 #h2 #E elim E -E -[ #b #i #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 - [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 - >(slift_vref_lt … Hid1) >(slift_vref_lt … Hid1) /2 width=1/ - | lapply (transitive_le … (i+h1) Hd21 ?) -Hd21 -Hd12 /2 width=1/ #Hd2 - >(slift_vref_ge … Hid1) >(slift_vref_ge … Hid1) /2 width=1/ - ] -| normalize #b #T #IHT #d1 #d2 #Hd12 #Hd21 >IHT // /2 width=1/ -| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd12 #Hd21 >IHV >IHT // -] -qed. - -theorem slift_slift_ge: ∀h1,h2,E,d1,d2. d1 + h1 ≤ d2 → - ↑[d2, h2] ↑[d1, h1] E = ↑[d1, h1] ↑[d2 - h1, h2] E. -#h1 #h2 #E #d1 #d2 #Hd12 ->(slift_slift_le h2 h1) /2 width=1/ (slift_vref_lt … Hid) in H; #H - >(slift_inv_vref_lt … Hid … H) -E2 -d -h // - | >(slift_vref_ge … Hid) in H; #H - >(slift_inv_vref_ge_plus … H) -E2 // /2 width=1/ - ] -| normalize #b #T1 #IHT1 #E2 #d #H - elim (slift_inv_abst … H) -H #T2 #HT12 #H destruct - >(IHT1 … HT12) -IHT1 -T2 // -| normalize #b #V1 #T1 #IHV1 #IHT1 #E2 #d #H - elim (slift_inv_appl … H) -H #V2 #T2 #HV12 #HT12 #H destruct - >(IHV1 … HV12) -IHV1 -V2 >(IHT1 … HT12) -IHT1 -T2 // -] -qed-. - -theorem slift_inv_slift_le: ∀h1,h2,E1,E2,d1,d2. d2 ≤ d1 → - ↑[d2, h2] E2 = ↑[d1 + h2, h1] E1 → - ∃∃E. ↑[d1, h1] E = E2 & ↑[d2, h2] E = E1. -#h1 #h2 #E1 elim E1 -E1 -[ #b #i #E2 #d1 #d2 #Hd21 elim (lt_or_ge i (d1+h2)) #Hid1 - [ >(slift_vref_lt … Hid1) elim (lt_or_ge i d2) #Hid2 #H - [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 -Hid1 #Hid1 - >(slift_inv_vref_lt … Hid2 … H) -E2 /3 width=3/ - | elim (slift_inv_vref_ge … H) -H -Hd21 // -Hid2 #Hdh2i #H destruct - elim (le_inv_plus_l … Hdh2i) -Hdh2i #Hd2i #Hh2i - @(ex2_intro … ({b}#(i-h2))) [ /4 width=1/ ] -Hid1 - >slift_vref_ge // -Hd2i /3 width=1/ (**) (* auto: needs some help here *) - ] - | elim (le_inv_plus_l … Hid1) #Hd1i #Hh2i - lapply (transitive_le (d2+h2) … Hid1) /2 width=1/ -Hd21 #Hdh2i - elim (le_inv_plus_l … Hdh2i) #Hd2i #_ - >(slift_vref_ge … Hid1) #H -Hid1 - >(slift_inv_vref_ge_plus … H) -H /2 width=3/ -Hdh2i - @(ex2_intro … ({b}#(i-h2))) (**) (* auto: needs some help here *) - [ >slift_vref_ge // -Hd1i /3 width=1/ - | >slift_vref_ge // -Hd2i -Hd1i /3 width=1/ - ] - ] -| normalize #b #T1 #IHT1 #E2 #d1 #d2 #Hd21 #H - elim (slift_inv_abst … H) -H >plus_plus_comm_23 #T2 #HT12 #H destruct - elim (IHT1 … HT12) -IHT1 -HT12 /2 width=1/ -Hd21 #T #HT2 #HT1 - @(ex2_intro … ({b}𝛌.T)) normalize // -| normalize #b #V1 #T1 #IHV1 #IHT1 #E2 #d1 #d2 #Hd21 #H - elim (slift_inv_appl … H) -H #V2 #T2 #HV12 #HT12 #H destruct - elim (IHV1 … HV12) -IHV1 -HV12 // #V #HV2 #HV1 - elim (IHT1 … HT12) -IHT1 -HT12 // -Hd21 #T #HT2 #HT1 - @(ex2_intro … ({b}@V.T)) normalize // -] -qed-. - -theorem slift_inv_slift_be: ∀h1,h2,E1,E2,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h1 → - ↑[d2, h2] E2 = ↑[d1, h1 + h2] E1 → ↑[d1, h1] E1 = E2. -#h1 #h2 #E1 elim E1 -E1 -[ #b #i #E2 #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 - [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 - >(slift_vref_lt … Hid1) #H >(slift_inv_vref_lt … Hid2 … H) -h2 -E2 -d2 /2 width=1/ - | lapply (transitive_le … (i+h1) Hd21 ?) -Hd12 -Hd21 /2 width=1/ #Hd2 - >(slift_vref_ge … Hid1) #H >(slift_inv_vref_ge_plus … H) -E2 /2 width=1/ - ] -| normalize #b #T1 #IHT1 #E2 #d1 #d2 #Hd12 #Hd21 #H - elim (slift_inv_abst … H) -H #T #HT12 #H destruct - >(IHT1 … HT12) -IHT1 -HT12 // /2 width=1/ -| normalize #b #V1 #T1 #IHV1 #IHT1 #E2 #d1 #d2 #Hd12 #Hd21 #H - elim (slift_inv_appl … H) -H #V #T #HV12 #HT12 #H destruct - >(IHV1 … HV12) -IHV1 -HV12 // >(IHT1 … HT12) -IHT1 -HT12 // -] -qed-. - -theorem slift_inv_slift_ge: ∀h1,h2,E1,E2,d1,d2. d1 + h1 ≤ d2 → - ↑[d2, h2] E2 = ↑[d1, h1] E1 → - ∃∃E. ↑[d1, h1] E = E2 & ↑[d2 - h1, h2] E = E1. -#h1 #h2 #E1 #E2 #d1 #d2 #Hd12 #H -elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #Hh1d2 -lapply (sym_eq subterms … H) -H >(plus_minus_m_m … Hh1d2) in ⊢ (???%→?); -Hh1d2 #H -elim (slift_inv_slift_le … Hd12 … H) -H -Hd12 /2 width=3/ -qed-. - -definition sliftable: predicate (relation subterms) ≝ λR. - ∀h,F1,F2. R F1 F2 → ∀d. R (↑[d, h] F1) (↑[d, h] F2). - -definition sdeliftable_sn: predicate (relation subterms) ≝ λR. - ∀h,G1,G2. R G1 G2 → ∀d,F1. ↑[d, h] F1 = G1 → - ∃∃F2. R F1 F2 & ↑[d, h] F2 = G2. -(* -lemma star_sliftable: ∀R. sliftable R → sliftable (star … R). -#R #HR #h #F1 #F2 #H elim H -F2 // /3 width=3/ -qed. - -lemma star_deliftable_sn: ∀R. sdeliftable_sn R → sdeliftable_sn (star … R). -#R #HR #h #G1 #G2 #H elim H -G2 /2 width=3/ -#G #G2 #_ #HG2 #IHG1 #d #F1 #HFG1 -elim (IHG1 … HFG1) -G1 #F #HF1 #HFG -elim (HR … HG2 … HFG) -G /3 width=3/ -qed-. -*) -lemma lstar_sliftable: ∀S,R. (∀a. sliftable (R a)) → - ∀l. sliftable (lstar S … R l). -#S #R #HR #l #h #F1 #F2 #H -@(lstar_ind_l … l F1 H) -l -F1 // /3 width=3/ -qed. - -lemma lstar_sdeliftable_sn: ∀S,R. (∀a. sdeliftable_sn (R a)) → - ∀l. sdeliftable_sn (lstar S … R l). -#S #R #HR #l #h #G1 #G2 #H -@(lstar_ind_l … l G1 H) -l -G1 /2 width=3/ -#a #l #G1 #G #HG1 #_ #IHG2 #d #F1 #HFG1 -elim (HR … HG1 … HFG1) -G1 #F #HF1 #HFG -elim (IHG2 … HFG) -G /3 width=3/ -qed-. diff --git a/matita/matita/contribs/lambda/subterms/subterms.ma b/matita/matita/contribs/lambda/subterms/subterms.ma deleted file mode 100644 index 6c75a3f4c..000000000 --- a/matita/matita/contribs/lambda/subterms/subterms.ma +++ /dev/null @@ -1,68 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "background/preamble.ma". - -(* SUBSETS OF SUBTERMS ******************************************************) - -(* Policy: boolean marks metavariables: b,c - subterms metavariables: F,G,T,U,V,W -*) -(* Note: each subterm is marked with true if it belongs to the subset *) -inductive subterms: Type[0] ≝ -| SVRef: bool → nat → subterms -| SAbst: bool → subterms → subterms -| SAppl: bool → subterms → subterms → subterms -. - -interpretation "subterms construction (variable reference by index)" - 'VariableReferenceByIndex b i = (SVRef b i). - -interpretation "subterms construction (abstraction)" - 'Abstraction b T = (SAbst b T). - -interpretation "subterms construction (application)" - 'Application b V T = (SAppl b V T). - -(* -definition compatible_abst: predicate (relation term) ≝ λR. - ∀A1,A2. R A1 A2 → R (𝛌.A1) (𝛌.A2). - -definition compatible_sn: predicate (relation term) ≝ λR. - ∀A,B1,B2. R B1 B2 → R (@B1.A) (@B2.A). - -definition compatible_dx: predicate (relation term) ≝ λR. - ∀B,A1,A2. R A1 A2 → R (@B.A1) (@B.A2). - -definition compatible_appl: predicate (relation term) ≝ λR. - ∀B1,B2. R B1 B2 → ∀A1,A2. R A1 A2 → - R (@B1.A1) (@B2.A2). - -lemma star_compatible_abst: ∀R. compatible_abst R → compatible_abst (star … R). -#R #HR #A1 #A2 #H elim H -A2 // /3 width=3/ -qed. - -lemma star_compatible_sn: ∀R. compatible_sn R → compatible_sn (star … R). -#R #HR #A #B1 #B2 #H elim H -B2 // /3 width=3/ -qed. - -lemma star_compatible_dx: ∀R. compatible_dx R → compatible_dx (star … R). -#R #HR #B #A1 #A2 #H elim H -A2 // /3 width=3/ -qed. - -lemma star_compatible_appl: ∀R. reflexive ? R → - compatible_appl R → compatible_appl (star … R). -#R #H1R #H2R #B1 #B2 #H elim H -B2 /3 width=1/ /3 width=5/ -qed. -*) diff --git a/matita/matita/contribs/lambda/terms/labeled_sequential_computation.ma b/matita/matita/contribs/lambda/terms/labeled_sequential_computation.ma deleted file mode 100644 index 2287c6b81..000000000 --- a/matita/matita/contribs/lambda/terms/labeled_sequential_computation.ma +++ /dev/null @@ -1,46 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "terms/sequential_computation.ma". - -(* ABSTRACT LABELED SEQUENTIAL COMPUTATION (MULTISTEP) **********************) - -definition l_sreds: ∀S. (S→relation term) → list S → relation term ≝ - λS,R. lstar … R. - -lemma sreds_l_sreds: ∀S,R. (∀M,N. M ↦ N → ∃a. R a M N) → - ∀M,N. M ↦* N → ∃l. l_sreds S R l M N. -#S #R #HR #M #N #H elim H -N -[ #N #N0 #_ #HN0 * #l #HMN - elim (HR … HN0) -HR -HN0 /3 width=5/ -| /2 width=2/ -] -qed-. - -lemma l_sreds_inv_sreds: ∀S,R. (∀a,M,N. R a M N → M ↦ N) → - ∀l,M,N. l_sreds S R l M N → M ↦* N. -#S #R #HR #l #M #N #H elim H -N // /3 by star_compl/ -qed-. - -(* Note: "|s|" should be unparetesized *) -lemma l_sreds_fwd_mult: ∀S,R. (∀a,M,N. R a M N → M ↦ N) → - ∀l,M1,M2. l_sreds S R l M1 M2 → - ♯{M2} ≤ ♯{M1} ^ (2 ^ (|l|)). -#S #R #HR #l #M1 #M2 #H @(lstar_ind_l … l M1 H) -l -M1 normalize // -#a #l #M1 #M #HM1 #_ #IHM2 -lapply (HR … HM1) -HR -a #HM1 -lapply (sred_fwd_mult … HM1) #HM1 -@(transitive_le … IHM2) -M2 -/3 width=1 by le_exp1, lt_O_exp, lt_to_le/ (**) (* auto: slow without trace *) -qed-. diff --git a/matita/matita/contribs/lambda/terms/multiplicity.ma b/matita/matita/contribs/lambda/terms/multiplicity.ma deleted file mode 100644 index 4f41b75db..000000000 --- a/matita/matita/contribs/lambda/terms/multiplicity.ma +++ /dev/null @@ -1,52 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "terms/relocating_substitution.ma". - -(* MULTIPLICITY *************************************************************) - -(* Note: this gives the number of variable references in M *) -let rec mult M on M ≝ match M with -[ VRef i ⇒ 1 -| Abst A ⇒ mult A -| Appl B A ⇒ (mult B) + (mult A) -]. - -interpretation "term multiplicity" - 'Multiplicity M = (mult M). - -notation "hvbox( ♯{ term 46 M } )" - non associative with precedence 90 - for @{ 'Multiplicity $M }. - -lemma mult_positive: ∀M. 0 < ♯{M}. -#M elim M -M // /2 width=1/ -qed. - -lemma mult_lift: ∀h,M,d. ♯{↑[d, h] M} = ♯{M}. -#h #M elim M -M normalize // -qed. - -theorem mult_dsubst: ∀D,M,d. ♯{[d ↙ D] M} ≤ ♯{M} * ♯{D}. -#D #M elim M -M -[ #i #d elim (lt_or_eq_or_gt i d) #Hid - [ >(dsubst_vref_lt … Hid) normalize // - | destruct >dsubst_vref_eq normalize // - | >(dsubst_vref_gt … Hid) normalize // - ] -| normalize // -| normalize #B #A #IHB #IHA #d - >distributive_times_plus_r /2 width=1/ -] -qed. diff --git a/matita/matita/contribs/lambda/terms/parallel_computation.ma b/matita/matita/contribs/lambda/terms/parallel_computation.ma deleted file mode 100644 index 3b048d133..000000000 --- a/matita/matita/contribs/lambda/terms/parallel_computation.ma +++ /dev/null @@ -1,83 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "terms/parallel_reduction.ma". - -(* PARALLEL COMPUTATION (MULTISTEP) *****************************************) - -definition preds: relation term ≝ star … pred. - -interpretation "parallel computation" - 'ParRedStar M N = (preds M N). - -lemma preds_refl: reflexive … preds. -// -qed. - -lemma preds_step_sn: ∀M1,M. M1 ⤇ M → ∀M2. M ⤇* M2 → M1 ⤇* M2. -/2 width=3/ -qed-. - -lemma preds_step_dx: ∀M1,M. M1 ⤇* M → ∀M2. M ⤇ M2 → M1 ⤇* M2. -/2 width=3/ -qed-. - -lemma preds_step_rc: ∀M1,M2. M1 ⤇ M2 → M1 ⤇* M2. -/2 width=1/ -qed. - -lemma preds_compatible_abst: compatible_abst preds. -/3 width=1/ -qed. - -lemma preds_compatible_sn: compatible_sn preds. -/3 width=1/ -qed. - -lemma preds_compatible_dx: compatible_dx preds. -/3 width=1/ -qed. - -lemma preds_compatible_appl: compatible_appl preds. -/3 width=1/ -qed. - -lemma preds_lift: liftable preds. -/2 width=1/ -qed. - -lemma preds_inv_lift: deliftable_sn preds. -/3 width=3 by star_deliftable_sn, pred_inv_lift/ -qed-. - -lemma preds_dsubst_dx: dsubstable_dx preds. -/2 width=1/ -qed. - -lemma preds_dsubst: dsubstable preds. -/2 width=1/ -qed. - -theorem preds_trans: transitive … preds. -/2 width=3 by trans_star/ -qed-. - -lemma preds_strip: ∀M0,M1. M0 ⤇* M1 → ∀M2. M0 ⤇ M2 → - ∃∃M. M1 ⤇ M & M2 ⤇* M. -/3 width=3 by star_strip, pred_conf/ -qed-. - -theorem preds_conf: confluent … preds. -/3 width=3 by star_confluent, pred_conf/ -qed-. diff --git a/matita/matita/contribs/lambda/terms/parallel_reduction.ma b/matita/matita/contribs/lambda/terms/parallel_reduction.ma deleted file mode 100644 index b54c4bc57..000000000 --- a/matita/matita/contribs/lambda/terms/parallel_reduction.ma +++ /dev/null @@ -1,152 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "terms/size.ma". -include "terms/sequential_reduction.ma". - -(* PARALLEL REDUCTION (SINGLE STEP) *****************************************) - -(* Note: the application "(A B)" is represented by "@B.A" - as for sequential reduction -*) -inductive pred: relation term ≝ -| pred_vref: ∀i. pred (#i) (#i) -| pred_abst: ∀A1,A2. pred A1 A2 → pred (𝛌.A1) (𝛌.A2) -| pred_appl: ∀B1,B2,A1,A2. pred B1 B2 → pred A1 A2 → pred (@B1.A1) (@B2.A2) -| pred_beta: ∀B1,B2,A1,A2. pred B1 B2 → pred A1 A2 → pred (@B1.𝛌.A1) ([↙B2]A2) -. - -interpretation "parallel reduction" - 'ParRed M N = (pred M N). - -lemma pred_refl: reflexive … pred. -#M elim M -M // /2 width=1/ -qed. - -lemma pred_inv_vref: ∀M,N. M ⤇ N → ∀i. #i = M → #i = N. -#M #N * -M -N // -[ #A1 #A2 #_ #i #H destruct -| #B1 #B2 #A1 #A2 #_ #_ #i #H destruct -| #B1 #B2 #A1 #A2 #_ #_ #i #H destruct -] -qed-. - -lemma pred_inv_abst: ∀M,N. M ⤇ N → ∀A. 𝛌.A = M → - ∃∃C. A ⤇ C & 𝛌.C = N. -#M #N * -M -N -[ #i #A0 #H destruct -| #A1 #A2 #HA12 #A0 #H destruct /2 width=3/ -| #B1 #B2 #A1 #A2 #_ #_ #A0 #H destruct -| #B1 #B2 #A1 #A2 #_ #_ #A0 #H destruct -] -qed-. - -lemma pred_inv_appl: ∀M,N. M ⤇ N → ∀B,A. @B.A = M → - (∃∃D,C. B ⤇ D & A ⤇ C & @D.C = N) ∨ - ∃∃A0,D,C0. B ⤇ D & A0 ⤇ C0 & 𝛌.A0 = A & [↙D]C0 = N. -#M #N * -M -N -[ #i #B0 #A0 #H destruct -| #A1 #A2 #_ #B0 #A0 #H destruct -| #B1 #B2 #A1 #A2 #HB12 #HA12 #B0 #A0 #H destruct /3 width=5/ -| #B1 #B2 #A1 #A2 #HB12 #HA12 #B0 #A0 #H destruct /3 width=7/ -] -qed-. - -lemma pred_lift: liftable pred. -#h #M1 #M2 #H elim H -M1 -M2 normalize // /2 width=1/ -#B1 #B2 #A1 #A2 #_ #_ #IHB12 #IHC12 #d (dsubst_vref_lt … Hid) >(dsubst_vref_lt … Hid) // - | destruct >dsubst_vref_eq >dsubst_vref_eq /2 width=1/ - | >(dsubst_vref_gt … Hid) >(dsubst_vref_gt … Hid) // - ] -| normalize /2 width=1/ -| normalize /2 width=1/ -| normalize #B1 #B2 #A1 #A2 #_ #_ #IHB12 #IHC12 #d - >dsubst_dsubst_ge // /2 width=1/ -] -qed. - -lemma pred_conf1_vref: ∀i. confluent1 … pred (#i). -#i #M1 #H1 #M2 #H2 -<(pred_inv_vref … H1) -H1 [3: // |2: skip ] (**) (* simplify line *) -<(pred_inv_vref … H2) -H2 [3: // |2: skip ] (**) (* simplify line *) -/2 width=3/ -qed-. - -lemma pred_conf1_abst: ∀A. confluent1 … pred A → confluent1 … pred (𝛌.A). -#A #IH #M1 #H1 #M2 #H2 -elim (pred_inv_abst … H1 …) -H1 [3: // |2: skip ] #A1 #HA1 #H destruct (**) (* simplify line *) -elim (pred_inv_abst … H2 …) -H2 [3: // |2: skip ] #A2 #HA2 #H destruct (**) (* simplify line *) -elim (IH … HA1 … HA2) -A /3 width=3/ -qed-. - -lemma pred_conf1_appl_beta: ∀B,B1,B2,C,C2,M1. - (∀M0. |M0| < |B|+|𝛌.C|+1 → confluent1 ? pred M0) → (**) (* ? needed in place of … *) - B ⤇ B1 → B ⤇ B2 → 𝛌.C ⤇ M1 → C ⤇ C2 → - ∃∃M. @B1.M1 ⤇ M & [↙B2]C2 ⤇ M. -#B #B1 #B2 #C #C2 #M1 #IH #HB1 #HB2 #H1 #HC2 -elim (pred_inv_abst … H1 …) -H1 [3: // |2: skip ] #C1 #HC1 #H destruct (**) (* simplify line *) -elim (IH B … HB1 … HB2) -HB1 -HB2 // -elim (IH C … HC1 … HC2) normalize // -B -C /3 width=5/ -qed-. - -theorem pred_conf: confluent … pred. -#M @(f_ind … size … M) -M #n #IH * normalize -[ /2 width=3 by pred_conf1_vref/ -| /3 width=4 by pred_conf1_abst/ -| #B #A #H #M1 #H1 #M2 #H2 destruct - elim (pred_inv_appl … H1 …) -H1 [5: // |2,3: skip ] * (**) (* simplify line *) - elim (pred_inv_appl … H2 …) -H2 [5,10: // |2,3,7,8: skip ] * (**) (* simplify line *) - [ #B2 #A2 #HB2 #HA2 #H2 #B1 #A1 #HB1 #HA1 #H1 destruct - elim (IH A … HA1 … HA2) -HA1 -HA2 // - elim (IH B … HB1 … HB2) // -A -B /3 width=5/ - | #C #B2 #C2 #HB2 #HC2 #H2 #HM2 #B1 #N #HB1 #H #HM1 destruct - @(pred_conf1_appl_beta … IH) // (**) (* /2 width=7 by pred_conf1_appl_beta/ does not work *) - | #B2 #N #B2 #H #HM2 #C #B1 #C1 #HB1 #HC1 #H1 #HM1 destruct - @ex2_commute @(pred_conf1_appl_beta … IH) // - | #C #B2 #C2 #HB2 #HC2 #H2 #HM2 #C0 #B1 #C1 #HB1 #HC1 #H1 #HM1 destruct - elim (IH B … HB1 … HB2) -HB1 -HB2 // - elim (IH C … HC1 … HC2) normalize // -B -C /3 width=5/ - ] -] -qed-. - -lemma sred_pred: ∀M,N. M ↦ N → M ⤇ N. -#M #N #H elim H -M -N /2 width=1/ -qed. diff --git a/matita/matita/contribs/lambda/terms/relocating_substitution.ma b/matita/matita/contribs/lambda/terms/relocating_substitution.ma deleted file mode 100644 index 4f813396f..000000000 --- a/matita/matita/contribs/lambda/terms/relocating_substitution.ma +++ /dev/null @@ -1,154 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "terms/relocation.ma". - -(* RELOCATING SUBSTITUTION **************************************************) - -(* Policy: depth (level) metavariables: d, e (as for lift) *) -let rec dsubst N d M on M ≝ match M with -[ VRef i ⇒ tri … i d (#i) (↑[i] N) (#(i-1)) -| Abst A ⇒ 𝛌. (dsubst N (d+1) A) -| Appl B A ⇒ @ (dsubst N d B). (dsubst N d A) -]. - -interpretation "relocating substitution" - 'DSubst N d M = (dsubst N d M). - -lemma dsubst_vref_lt: ∀i,d,N. i < d → [d ↙ N] #i = #i. -normalize /2 width=1/ -qed. - -lemma dsubst_vref_eq: ∀i,N. [i ↙ N] #i = ↑[i]N. -normalize // -qed. - -lemma dsubst_vref_gt: ∀i,d,N. d < i → [d ↙ N] #i = #(i-1). -normalize /2 width=1/ -qed. - -theorem dsubst_lift_le: ∀h,N,M,d1,d2. d2 ≤ d1 → - [d2 ↙ ↑[d1 - d2, h] N] ↑[d1 + 1, h] M = ↑[d1, h] [d2 ↙ N] M. -#h #N #M elim M -M -[ #i #d1 #d2 #Hd21 elim (lt_or_eq_or_gt i d2) #Hid2 - [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 #Hid1 - >(dsubst_vref_lt … Hid2) >(lift_vref_lt … Hid1) >lift_vref_lt /2 width=1/ - | destruct >dsubst_vref_eq >lift_vref_lt /2 width=1/ - | >(dsubst_vref_gt … Hid2) -Hd21 elim (lt_or_ge (i-1) d1) #Hi1d1 - [ >(lift_vref_lt … Hi1d1) >lift_vref_lt /2 width=1/ - | lapply (ltn_to_ltO … Hid2) #Hi - >(lift_vref_ge … Hi1d1) >lift_vref_ge /2 width=1/ -Hi1d1 >plus_minus // /3 width=1/ - ] - ] -| normalize #A #IHA #d1 #d2 #Hd21 - lapply (IHA (d1+1) (d2+1) ?) -IHA /2 width=1/ -| normalize #B #A #IHB #IHA #d1 #d2 #Hd21 - >IHB -IHB // >IHA -IHA // -] -qed. - -theorem dsubst_lift_be: ∀h,N,M,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h → - [d2 ↙ N] ↑[d1, h + 1] M = ↑[d1, h] M. -#h #N #M elim M -M -[ #i #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 - [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 - >(lift_vref_lt … Hid1) >(lift_vref_lt … Hid1) /2 width=1/ - | lapply (transitive_le … (i+h) Hd21 ?) -Hd12 -Hd21 /2 width=1/ #Hd2 - >(lift_vref_ge … Hid1) >(lift_vref_ge … Hid1) -Hid1 - >dsubst_vref_gt // /2 width=1/ - ] -| normalize #A #IHA #d1 #d2 #Hd12 #Hd21 - >IHA -IHA // /2 width=1/ -| normalize #B #A #IHB #IHA #d1 #d2 #Hd12 #Hd21 - >IHB -IHB // >IHA -IHA // -] -qed. - -theorem dsubst_lift_ge: ∀h,N,M,d1,d2. d1 + h ≤ d2 → - [d2 ↙ N] ↑[d1, h] M = ↑[d1, h] [d2 - h ↙ N] M. -#h #N #M elim M -M -[ #i #d1 #d2 #Hd12 elim (lt_or_eq_or_gt i (d2-h)) #Hid2h - [ >(dsubst_vref_lt … Hid2h) elim (lt_or_ge i d1) #Hid1 - [ lapply (lt_to_le_to_lt … (d1+h) Hid1 ?) -Hid2h // #Hid1h - lapply (lt_to_le_to_lt … Hid1h Hd12) -Hid1h -Hd12 #Hid2 - >(lift_vref_lt … Hid1) -Hid1 /2 width=1/ - | >(lift_vref_ge … Hid1) -Hid1 -Hd12 /3 width=1/ - ] - | destruct elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #Hhd2 - >dsubst_vref_eq >lift_vref_ge // >lift_lift_be // (dsubst_vref_gt … Hid2h) - >lift_vref_ge /2 width=1/ >lift_vref_ge /2 width=1/ -Hid1 - >dsubst_vref_gt /2 width=1/ -Hid2h >plus_minus // - ] -| normalize #A #IHA #d1 #d2 #Hd12 - elim (le_inv_plus_l … Hd12) #_ #Hhd2 - >IHA -IHA /2 width=1/ IHB -IHB // >IHA -IHA // -] -qed. - -theorem dsubst_dsubst_ge: ∀N1,N2,M,d1,d2. d1 ≤ d2 → - [d2 ↙ N2] [d1 ↙ N1] M = [d1 ↙ [d2 - d1 ↙ N2] N1] [d2 + 1 ↙ N2] M. -#N1 #N2 #M elim M -M -[ #i #d1 #d2 #Hd12 elim (lt_or_eq_or_gt i d1) #Hid1 - [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 - >(dsubst_vref_lt … Hid1) >(dsubst_vref_lt … Hid2) >dsubst_vref_lt /2 width=1/ - | destruct >dsubst_vref_eq >dsubst_vref_lt /2 width=1/ - | >(dsubst_vref_gt … Hid1) elim (lt_or_eq_or_gt i (d2+1)) #Hid2 - [ lapply (ltn_to_ltO … Hid1) #Hi - >(dsubst_vref_lt … Hid2) >dsubst_vref_lt /2 width=1/ - | destruct /2 width=1/ - | lapply (le_to_lt_to_lt (d1+1) … Hid2) -Hid1 /2 width=1/ -Hd12 #Hid1 - >(dsubst_vref_gt … Hid2) >dsubst_vref_gt /2 width=1/ - >dsubst_vref_gt // /2 width=1/ - ] - ] -| normalize #A #IHA #d1 #d2 #Hd12 - lapply (IHA (d1+1) (d2+1) ?) -IHA /2 width=1/ -| normalize #B #A #IHB #IHA #d1 #d2 #Hd12 - >IHB -IHB // >IHA -IHA // -] -qed. - -theorem dsubst_dsubst_lt: ∀N1,N2,M,d1,d2. d2 < d1 → - [d2 ↙ [d1 - d2 -1 ↙ N1] N2] [d1 ↙ N1] M = [d1 - 1 ↙ N1] [d2 ↙ N2] M. -#N1 #N2 #M #d1 #d2 #Hd21 -lapply (ltn_to_ltO … Hd21) #Hd1 ->dsubst_dsubst_ge in ⊢ (???%); /2 width=1/ (tri_lt ???? … Hid) -Hid -Hjd // - | #H destruct >tri_eq in Hjd; #H - elim (plus_lt_false … H) - | >(tri_gt ???? … Hid) - lapply (transitive_lt … Hjd Hid) -d #H #H0 destruct - elim (plus_lt_false … H) - ] -| #A #H destruct -| #B #A #H destruct -] -qed. - -lemma lift_inv_vref_ge: ∀j,d. d ≤ j → ∀h,M. ↑[d, h] M = #j → - d + h ≤ j ∧ M = #(j-h). -#j #d #Hdj #h * normalize -[ #i elim (lt_or_eq_or_gt i d) #Hid - [ >(tri_lt ???? … Hid) #H destruct - lapply (le_to_lt_to_lt … Hdj Hid) -Hdj -Hid #H - elim (lt_refl_false … H) - | #H -Hdj destruct /2 width=1/ - | >(tri_gt ???? … Hid) #H -Hdj destruct /4 width=1/ - ] -| #A #H destruct -| #B #A #H destruct -] -qed-. - -lemma lift_inv_vref_be: ∀j,d,h. d ≤ j → j < d + h → ∀M. ↑[d, h] M = #j → ⊥. -#j #d #h #Hdj #Hjdh #M #H elim (lift_inv_vref_ge … H) -H // -Hdj #Hdhj #_ -M -lapply (lt_to_le_to_lt … Hjdh Hdhj) -d -h #H -elim (lt_refl_false … H) -qed-. - -lemma lift_inv_vref_ge_plus: ∀j,d,h. d + h ≤ j → - ∀M. ↑[d, h] M = #j → M = #(j-h). -#j #d #h #Hdhj #M #H elim (lift_inv_vref_ge … H) -H // -M /2 width=2/ -qed. - -lemma lift_inv_abst: ∀C,d,h,M. ↑[d, h] M = 𝛌.C → - ∃∃A. ↑[d+1, h] A = C & M = 𝛌.A. -#C #d #h * normalize -[ #i #H destruct -| #A #H destruct /2 width=3/ -| #B #A #H destruct -] -qed-. - -lemma lift_inv_appl: ∀D,C,d,h,M. ↑[d, h] M = @D.C → - ∃∃B,A. ↑[d, h] B = D & ↑[d, h] A = C & M = @B.A. -#D #C #d #h * normalize -[ #i #H destruct -| #A #H destruct -| #B #A #H destruct /2 width=5/ -] -qed-. - -theorem lift_lift_le: ∀h1,h2,M,d1,d2. d2 ≤ d1 → - ↑[d2, h2] ↑[d1, h1] M = ↑[d1 + h2, h1] ↑[d2, h2] M. -#h1 #h2 #M elim M -M -[ #i #d1 #d2 #Hd21 elim (lt_or_ge i d2) #Hid2 - [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 #Hid1 - >(lift_vref_lt … Hid1) >(lift_vref_lt … Hid2) - >lift_vref_lt // /2 width=1/ - | >(lift_vref_ge … Hid2) elim (lt_or_ge i d1) #Hid1 - [ >(lift_vref_lt … Hid1) >(lift_vref_ge … Hid2) - >lift_vref_lt // -d2 /2 width=1/ - | >(lift_vref_ge … Hid1) >lift_vref_ge /2 width=1/ - >lift_vref_ge // /2 width=1/ - ] - ] -| normalize #A #IHA #d1 #d2 #Hd21 >IHA // /2 width=1/ -| normalize #B #A #IHB #IHA #d1 #d2 #Hd21 >IHB >IHA // -] -qed. - -theorem lift_lift_be: ∀h1,h2,M,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h1 → - ↑[d2, h2] ↑[d1, h1] M = ↑[d1, h1 + h2] M. -#h1 #h2 #M elim M -M -[ #i #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 - [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 - >(lift_vref_lt … Hid1) >(lift_vref_lt … Hid1) /2 width=1/ - | lapply (transitive_le … (i+h1) Hd21 ?) -Hd21 -Hd12 /2 width=1/ #Hd2 - >(lift_vref_ge … Hid1) >(lift_vref_ge … Hid1) /2 width=1/ - ] -| normalize #A #IHA #d1 #d2 #Hd12 #Hd21 >IHA // /2 width=1/ -| normalize #B #A #IHB #IHA #d1 #d2 #Hd12 #Hd21 >IHB >IHA // -] -qed. - -theorem lift_lift_ge: ∀h1,h2,M,d1,d2. d1 + h1 ≤ d2 → - ↑[d2, h2] ↑[d1, h1] M = ↑[d1, h1] ↑[d2 - h1, h2] M. -#h1 #h2 #M #d1 #d2 #Hd12 ->(lift_lift_le h2 h1) /2 width=1/ (lift_vref_lt … Hid) in H; #H - >(lift_inv_vref_lt … Hid … H) -M2 -d -h // - | >(lift_vref_ge … Hid) in H; #H - >(lift_inv_vref_ge_plus … H) -M2 // /2 width=1/ - ] -| normalize #A1 #IHA1 #M2 #d #H - elim (lift_inv_abst … H) -H #A2 #HA12 #H destruct - >(IHA1 … HA12) -IHA1 -A2 // -| normalize #B1 #A1 #IHB1 #IHA1 #M2 #d #H - elim (lift_inv_appl … H) -H #B2 #A2 #HB12 #HA12 #H destruct - >(IHB1 … HB12) -IHB1 -B2 >(IHA1 … HA12) -IHA1 -A2 // -] -qed-. - -theorem lift_inv_lift_le: ∀h1,h2,M1,M2,d1,d2. d2 ≤ d1 → - ↑[d2, h2] M2 = ↑[d1 + h2, h1] M1 → - ∃∃M. ↑[d1, h1] M = M2 & ↑[d2, h2] M = M1. -#h1 #h2 #M1 elim M1 -M1 -[ #i #M2 #d1 #d2 #Hd21 elim (lt_or_ge i (d1+h2)) #Hid1 - [ >(lift_vref_lt … Hid1) elim (lt_or_ge i d2) #Hid2 #H - [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 -Hid1 #Hid1 - >(lift_inv_vref_lt … Hid2 … H) -M2 /3 width=3/ - | elim (lift_inv_vref_ge … H) -H -Hd21 // -Hid2 #Hdh2i #H destruct - elim (le_inv_plus_l … Hdh2i) -Hdh2i #Hd2i #Hh2i - @(ex2_intro … (#(i-h2))) [ /4 width=1/ ] -Hid1 - >lift_vref_ge // -Hd2i /3 width=1/ (**) (* auto: needs some help here *) - ] - | elim (le_inv_plus_l … Hid1) #Hd1i #Hh2i - lapply (transitive_le (d2+h2) … Hid1) /2 width=1/ -Hd21 #Hdh2i - elim (le_inv_plus_l … Hdh2i) #Hd2i #_ - >(lift_vref_ge … Hid1) #H -Hid1 - >(lift_inv_vref_ge_plus … H) -H /2 width=3/ -Hdh2i - @(ex2_intro … (#(i-h2))) (**) (* auto: needs some help here *) - [ >lift_vref_ge // -Hd1i /3 width=1/ - | >lift_vref_ge // -Hd2i -Hd1i /3 width=1/ - ] - ] -| normalize #A1 #IHA1 #M2 #d1 #d2 #Hd21 #H - elim (lift_inv_abst … H) -H >plus_plus_comm_23 #A2 #HA12 #H destruct - elim (IHA1 … HA12) -IHA1 -HA12 /2 width=1/ -Hd21 #A #HA2 #HA1 - @(ex2_intro … (𝛌.A)) normalize // -| normalize #B1 #A1 #IHB1 #IHA1 #M2 #d1 #d2 #Hd21 #H - elim (lift_inv_appl … H) -H #B2 #A2 #HB12 #HA12 #H destruct - elim (IHB1 … HB12) -IHB1 -HB12 // #B #HB2 #HB1 - elim (IHA1 … HA12) -IHA1 -HA12 // -Hd21 #A #HA2 #HA1 - @(ex2_intro … (@B.A)) normalize // -] -qed-. - -theorem lift_inv_lift_be: ∀h1,h2,M1,M2,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h1 → - ↑[d2, h2] M2 = ↑[d1, h1 + h2] M1 → ↑[d1, h1] M1 = M2. -#h1 #h2 #M1 elim M1 -M1 -[ #i #M2 #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 - [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 - >(lift_vref_lt … Hid1) #H >(lift_inv_vref_lt … Hid2 … H) -h2 -M2 -d2 /2 width=1/ - | lapply (transitive_le … (i+h1) Hd21 ?) -Hd12 -Hd21 /2 width=1/ #Hd2 - >(lift_vref_ge … Hid1) #H >(lift_inv_vref_ge_plus … H) -M2 /2 width=1/ - ] -| normalize #A1 #IHA1 #M2 #d1 #d2 #Hd12 #Hd21 #H - elim (lift_inv_abst … H) -H #A #HA12 #H destruct - >(IHA1 … HA12) -IHA1 -HA12 // /2 width=1/ -| normalize #B1 #A1 #IHB1 #IHA1 #M2 #d1 #d2 #Hd12 #Hd21 #H - elim (lift_inv_appl … H) -H #B #A #HB12 #HA12 #H destruct - >(IHB1 … HB12) -IHB1 -HB12 // >(IHA1 … HA12) -IHA1 -HA12 // -] -qed-. - -theorem lift_inv_lift_ge: ∀h1,h2,M1,M2,d1,d2. d1 + h1 ≤ d2 → - ↑[d2, h2] M2 = ↑[d1, h1] M1 → - ∃∃M. ↑[d1, h1] M = M2 & ↑[d2 - h1, h2] M = M1. -#h1 #h2 #M1 #M2 #d1 #d2 #Hd12 #H -elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #Hh1d2 -lapply (sym_eq term … H) -H >(plus_minus_m_m … Hh1d2) in ⊢ (???%→?); -Hh1d2 #H -elim (lift_inv_lift_le … Hd12 … H) -H -Hd12 /2 width=3/ -qed-. - -definition liftable: predicate (relation term) ≝ λR. - ∀h,M1,M2. R M1 M2 → ∀d. R (↑[d, h] M1) (↑[d, h] M2). - -definition deliftable_sn: predicate (relation term) ≝ λR. - ∀h,N1,N2. R N1 N2 → ∀d,M1. ↑[d, h] M1 = N1 → - ∃∃M2. R M1 M2 & ↑[d, h] M2 = N2. - -lemma star_liftable: ∀R. liftable R → liftable (star … R). -#R #HR #h #M1 #M2 #H elim H -M2 // /3 width=3/ -qed. - -lemma star_deliftable_sn: ∀R. deliftable_sn R → deliftable_sn (star … R). -#R #HR #h #N1 #N2 #H elim H -N2 /2 width=3/ -#N #N2 #_ #HN2 #IHN1 #d #M1 #HMN1 -elim (IHN1 … HMN1) -N1 #M #HM1 #HMN -elim (HR … HN2 … HMN) -N /3 width=3/ -qed-. - -lemma lstar_liftable: ∀S,R. (∀a. liftable (R a)) → - ∀l. liftable (lstar S … R l). -#S #R #HR #l #h #M1 #M2 #H -@(lstar_ind_l … l M1 H) -l -M1 // /3 width=3/ -qed. - -lemma lstar_deliftable_sn: ∀S,R. (∀a. deliftable_sn (R a)) → - ∀l. deliftable_sn (lstar S … R l). -#S #R #HR #l #h #N1 #N2 #H -@(lstar_ind_l … l N1 H) -l -N1 /2 width=3/ -#a #l #N1 #N #HN1 #_ #IHN2 #d #M1 #HMN1 -elim (HR … HN1 … HMN1) -N1 #M #HM1 #HMN -elim (IHN2 … HMN) -N /3 width=3/ -qed-. diff --git a/matita/matita/contribs/lambda/terms/sequential_computation.ma b/matita/matita/contribs/lambda/terms/sequential_computation.ma deleted file mode 100644 index b248e6027..000000000 --- a/matita/matita/contribs/lambda/terms/sequential_computation.ma +++ /dev/null @@ -1,105 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "terms/parallel_computation.ma". - -(* SEQUENTIAL COMPUTATION (MULTISTEP) ***************************************) - -definition sreds: relation term ≝ star … sred. - -interpretation "sequential computation" - 'SeqRedStar M N = (sreds M N). - -lemma sreds_refl: reflexive … sreds. -// -qed. - -lemma sreds_step_sn: ∀M1,M. M1 ↦ M → ∀M2. M ↦* M2 → M1 ↦* M2. -/2 width=3/ -qed-. - -lemma sreds_step_dx: ∀M1,M. M1 ↦* M → ∀M2. M ↦ M2 → M1 ↦* M2. -/2 width=3/ -qed-. - -lemma sreds_step_rc: ∀M1,M2. M1 ↦ M2 → M1 ↦* M2. -/2 width=1/ -qed. - -lemma lsred_compatible_abst: compatible_abst sreds. -/3 width=1/ -qed. - -lemma sreds_compatible_sn: compatible_sn sreds. -/3 width=1/ -qed. - -lemma sreds_compatible_dx: compatible_dx sreds. -/3 width=1/ -qed. - -lemma sreds_compatible_appl: compatible_appl sreds. -/3 width=3/ -qed. - -lemma sreds_lift: liftable sreds. -/2 width=1/ -qed. - -lemma sreds_inv_lift: deliftable_sn sreds. -/3 width=3 by star_deliftable_sn, sred_inv_lift/ -qed-. - -lemma sreds_dsubst: dsubstable_dx sreds. -/2 width=1/ -qed. - -theorem sreds_trans: transitive … sreds. -/2 width=3 by trans_star/ -qed-. - -(* Note: the substitution should be unparentesized *) -lemma sreds_compatible_beta: ∀B1,B2. B1 ↦* B2 → ∀A1,A2. A1 ↦* A2 → - @B1.𝛌.A1 ↦* ([↙B2] A2). -#B1 #B2 #HB12 #A1 #A2 #HA12 -@(sreds_trans … (@B2.𝛌.A1)) /2 width=1/ -B1 -@(sreds_step_dx … (@B2.𝛌.A2)) // /3 width=1/ -qed. - -theorem sreds_preds: ∀M1,M2. M1 ↦* M2 → M1 ⤇* M2. -#M1 #M2 #H @(star_ind_l … M1 H) -M1 // -#M1 #M #HM1 #_ #IHM2 -@(preds_step_sn … IHM2) -M2 /2 width=2/ -qed. - -lemma pred_sreds: ∀M1,M2. M1 ⤇ M2 → M1 ↦* M2. -#M1 #M2 #H elim H -M1 -M2 // /2 width=1/ -qed-. - -theorem preds_sreds: ∀M1,M2. M1 ⤇* M2 → M1 ↦* M2. -#M1 #M2 #H elim H -M2 // -#M #M2 #_ #HM2 #HM1 -lapply (pred_sreds … HM2) -HM2 #HM2 -@(sreds_trans … HM1 … HM2) -qed-. - -theorem sreds_conf: ∀M0,M1. M0 ↦* M1 → ∀M2. M0 ↦* M2 → - ∃∃M. M1 ↦* M & M2 ↦* M. -#M0 #M1 #HM01 #M2 #HM02 -lapply (sreds_preds … HM01) #HM01 -lapply (sreds_preds … HM02) #HM02 -elim (preds_conf … HM01 … HM02) -M0 #M #HM1 #HM2 -lapply (preds_sreds … HM1) -HM1 -lapply (preds_sreds … HM2) -HM2 /2 width=3/ -qed-. diff --git a/matita/matita/contribs/lambda/terms/sequential_reduction.ma b/matita/matita/contribs/lambda/terms/sequential_reduction.ma deleted file mode 100644 index becaaac78..000000000 --- a/matita/matita/contribs/lambda/terms/sequential_reduction.ma +++ /dev/null @@ -1,106 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "terms/multiplicity.ma". - -(* SEQUENTIAL REDUCTION (SINGLE STEP) ***************************************) - -(* Note: the application "(A B)" is represented by "@B.A" following: - F. Kamareddine and R.P. Nederpelt: "A useful λ-notation". - Theoretical Computer Science 155(1), Elsevier (1996), pp. 85-109. -*) -inductive sred: relation term ≝ -| sred_beta : ∀B,A. sred (@B.𝛌.A) ([↙B]A) -| sred_abst : ∀A1,A2. sred A1 A2 → sred (𝛌.A1) (𝛌.A2) -| sred_appl_sn: ∀B1,B2,A. sred B1 B2 → sred (@B1.A) (@B2.A) -| sred_appl_dx: ∀B,A1,A2. sred A1 A2 → sred (@B.A1) (@B.A2) -. - -interpretation "sequential reduction" - 'SeqRed M N = (sred M N). - -lemma sred_inv_vref: ∀M,N. M ↦ N → ∀i. #i = M → ⊥. -#M #N * -M -N -[ #B #A #i #H destruct -| #A1 #A2 #_ #i #H destruct -| #B1 #B2 #A #_ #i #H destruct -| #B #A1 #A2 #_ #i #H destruct -] -qed-. - -lemma sred_inv_abst: ∀M,N. M ↦ N → ∀C1. 𝛌.C1 = M → - ∃∃C2. C1 ↦ C2 & 𝛌.C2 = N. -#M #N * -M -N -[ #B #A #C1 #H destruct -| #A1 #A2 #HA12 #C1 #H destruct /2 width=3/ -| #B1 #B2 #A #_ #C1 #H destruct -| #B #A1 #A2 #_ #C1 #H destruct -] -qed-. - -lemma sred_inv_appl: ∀M,N. M ↦ N → ∀D,C. @D.C = M → - ∨∨ (∃∃C0. 𝛌.C0 = C & [↙D] C0 = N) - | (∃∃D0. D ↦ D0 & @D0.C = N) - | (∃∃C0. C ↦ C0 & @D.C0 = N). -#M #N * -M -N -[ #B #A #D #C #H destruct /3 width=3/ -| #A1 #A2 #_ #D #C #H destruct -| #B1 #B2 #A #HB12 #D #C #H destruct /3 width=3/ -| #B #A1 #A2 #HA12 #D #C #H destruct /3 width=3/ -] -qed-. - -lemma sred_fwd_mult: ∀M,N. M ↦ N → ♯{N} < ♯{M} * ♯{M}. -#M #N #H elim H -M -N -[ #B #A @(le_to_lt_to_lt … (♯{A}*♯{B})) // - normalize /3 width=1 by lt_minus_to_plus_r, lt_times/ (**) (* auto: too slow without trace *) -| // -| #B #D #A #_ #IHBD - @(lt_to_le_to_lt … (♯{B}*♯{B}+♯{A})) [ /2 width=1/ ] -D -| #B #A #C #_ #IHAC - @(lt_to_le_to_lt … (♯{B}+♯{A}*♯{A})) [ /2 width=1/ ] -C -] -@(transitive_le … (♯{B}*♯{B}+♯{A}*♯{A})) [ /2 width=1/ ] ->distributive_times_plus normalize /2 width=1/ -qed-. - -lemma sred_lift: liftable sred. -#h #M1 #M2 #H elim H -M1 -M2 normalize /2 width=1/ -#B #A #d dsubst_dsubst_ge // -qed. diff --git a/matita/matita/contribs/lambda/terms/size.ma b/matita/matita/contribs/lambda/terms/size.ma deleted file mode 100644 index 1fd9a060e..000000000 --- a/matita/matita/contribs/lambda/terms/size.ma +++ /dev/null @@ -1,31 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -include "terms/relocation.ma". - -(* SIZE *********************************************************************) - -(* Note: this gives the number of abstractions and applications in M *) -let rec size M on M ≝ match M with -[ VRef i ⇒ 0 -| Abst A ⇒ size A + 1 -| Appl B A ⇒ (size B) + (size A) + 1 -]. - -interpretation "term size" - 'card M = (size M). - -lemma size_lift: ∀h,M,d. |↑[d, h] M| = |M|. -#h #M elim M -M normalize // -qed. diff --git a/matita/matita/contribs/lambda/terms/term.ma b/matita/matita/contribs/lambda/terms/term.ma deleted file mode 100644 index c831236a3..000000000 --- a/matita/matita/contribs/lambda/terms/term.ma +++ /dev/null @@ -1,67 +0,0 @@ -(**************************************************************************) -(* ___ *) -(* ||M|| *) -(* ||A|| A project by Andrea Asperti *) -(* ||T|| *) -(* ||I|| Developers: *) -(* ||T|| The HELM team. *) -(* ||A|| http://helm.cs.unibo.it *) -(* \ / *) -(* \ / This file is distributed under the terms of the *) -(* v GNU General Public License Version 2 *) -(* *) -(**************************************************************************) - -(* Initial invocation: - Patience on us to gain peace and perfection! - *) - -include "background/preamble.ma". - -(* TERM STRUCTURE ***********************************************************) - -(* Policy: term metavariables : A, B, C, D, M, N - depth metavariables: i, j -*) -inductive term: Type[0] ≝ -| VRef: nat → term (* variable reference by depth *) -| Abst: term → term (* function formation *) -| Appl: term → term → term (* function application *) -. - -interpretation "term construction (variable reference by index)" - 'VariableReferenceByIndex i = (VRef i). - -interpretation "term construction (abstraction)" - 'Abstraction A = (Abst A). - -interpretation "term construction (application)" - 'Application C A = (Appl C A). - -definition compatible_abst: predicate (relation term) ≝ λR. - ∀A1,A2. R A1 A2 → R (𝛌.A1) (𝛌.A2). - -definition compatible_sn: predicate (relation term) ≝ λR. - ∀A,B1,B2. R B1 B2 → R (@B1.A) (@B2.A). - -definition compatible_dx: predicate (relation term) ≝ λR. - ∀B,A1,A2. R A1 A2 → R (@B.A1) (@B.A2). - -definition compatible_appl: predicate (relation term) ≝ λR. - ∀B1,B2. R B1 B2 → ∀A1,A2. R A1 A2 → - R (@B1.A1) (@B2.A2). - -lemma star_compatible_abst: ∀R. compatible_abst R → compatible_abst (star … R). -#R #HR #A1 #A2 #H elim H -A2 // /3 width=3/ -qed. - -lemma star_compatible_sn: ∀R. compatible_sn R → compatible_sn (star … R). -#R #HR #A #B1 #B2 #H elim H -B2 // /3 width=3/ -qed. - -lemma star_compatible_dx: ∀R. compatible_dx R → compatible_dx (star … R). -#R #HR #B #A1 #A2 #H elim H -A2 // /3 width=3/ -qed. - -lemma star_compatible_appl: ∀R. reflexive ? R → - compatible_appl R → compatible_appl (star … R). -#R #H1R #H2R #B1 #B2 #H elim H -B2 /3 width=1/ /3 width=5/ -qed. diff --git a/matita/matita/contribs/lambda/xoa.conf.xml b/matita/matita/contribs/lambda/xoa.conf.xml deleted file mode 100644 index 04cbcf59e..000000000 --- a/matita/matita/contribs/lambda/xoa.conf.xml +++ /dev/null @@ -1,23 +0,0 @@ - - -
- $(MATITA_RT_BASE_DIR) -
-
- contribs/lambda/background/ - xoa - xoa_notation - basics/pts.ma - 1 2 - 2 2 - 2 3 - 3 1 - 3 2 - 3 3 - 3 4 - 4 1 - 4 2 - 4 3 - 3 -
-
diff --git a/matita/matita/lib/lambda/Makefile b/matita/matita/lib/lambda/Makefile new file mode 100644 index 000000000..b715eb42a --- /dev/null +++ b/matita/matita/lib/lambda/Makefile @@ -0,0 +1,29 @@ +H = @ +XOA_DIR = ../../../components/binaries/xoa +XOA = xoa.native +DEP_DIR = ../../../components/binaries/matitadep +DEP = matitadep.native +MAC_DIR = ../../../components/binaries/mac +MAC = mac.native + +XOA_CONF = xoa.conf.xml +XOA_TARGETS = background/xoa_notation.ma background/xoa.ma + +all: xoa + $(H)../../matitac.opt */*.ma + +# xoa ######################################################################## + +xoa: $(XOA_TARGETS) + +$(XOA_TARGETS): $(XOA_CONF) + @echo " EXEC $(XOA) $(XOA_CONF)" + $(H)MATITA_RT_BASE_DIR=../.. $(XOA_DIR)/$(XOA) $(XOA_CONF) + +# dep ######################################################################## + +deps: MAS = $(shell find $* -name "*.ma") + +deps: $(DEP_DIR)/$(DEP) + @echo " MATITADEP" + $(H)grep "include \"" $(MAS) | $< diff --git a/matita/matita/lib/lambda/background/notation.ma b/matita/matita/lib/lambda/background/notation.ma new file mode 100644 index 000000000..62b8b2dca --- /dev/null +++ b/matita/matita/lib/lambda/background/notation.ma @@ -0,0 +1,100 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +(* GENERIC NOTATION *********************************************************) + +(* Note: this should go to core_notation *) +notation "⊥" + non associative with precedence 90 + for @{'false}. + +(* Note: this should go to core_notation *) +notation "⊤" + non associative with precedence 90 + for @{'true}. + +(* Note: this should go to core_notation *) +notation "hvbox(a break ≺ b)" + non associative with precedence 45 + for @{ 'prec $a $b }. + +notation "hvbox( # term 90 i )" + non associative with precedence 46 + for @{ 'VariableReferenceByIndex $i }. + +notation "hvbox( { term 46 b } # break term 90 i )" + non associative with precedence 46 + for @{ 'VariableReferenceByIndex $b $i }. + +notation "hvbox( 𝛌 . term 46 A )" + non associative with precedence 46 + for @{ 'Abstraction $A }. + +notation "hvbox( { term 46 b } 𝛌 . break term 46 T)" + non associative with precedence 46 + for @{ 'Abstraction $b $T }. + +notation "hvbox( @ term 46 C . break term 46 A )" + non associative with precedence 46 + for @{ 'Application $C $A }. + +notation "hvbox( { term 46 b } @ break term 46 V . break term 46 T )" + non associative with precedence 46 + for @{ 'Application $b $V $T }. + +notation "hvbox( ↑ [ term 46 d , break term 46 h ] break term 46 M )" + non associative with precedence 46 + for @{ 'Lift $h $d $M }. + +notation > "hvbox( ↑ [ term 46 h ] break term 46 M )" + non associative with precedence 46 + for @{ 'Lift $h 0 $M }. + +notation > "hvbox( ↑ term 46 M )" + non associative with precedence 46 + for @{ 'Lift 1 0 $M }. + +(* Note: the notation with "/" does not work *) +notation "hvbox( [ term 46 d break ↙ term 46 N ] break term 46 M )" + non associative with precedence 46 + for @{ 'DSubst $N $d $M }. + +notation > "hvbox( [ ↙ term 46 N ] break term 46 M )" + non associative with precedence 46 + for @{ 'DSubst $N 0 $M }. + +(* Note: we do not use → since it is reserved by CIC *) +notation "hvbox( M break ↦ term 46 N )" + non associative with precedence 45 + for @{ 'SeqRed $M $N }. + +notation "hvbox( M break ↦ [ term 46 p ] break term 46 N )" + non associative with precedence 45 + for @{ 'SeqRed $M $p $N }. + +notation "hvbox( M break ↦* term 46 N )" + non associative with precedence 45 + for @{ 'SeqRedStar $M $N }. + +notation "hvbox( M break ↦* [ term 46 s ] break term 46 N )" + non associative with precedence 45 + for @{ 'SeqRedStar $M $s $N }. + +notation "hvbox( M break ⤇ term 46 N )" + non associative with precedence 45 + for @{ 'ParRed $M $N }. + +notation "hvbox( M break ⤇* term 46 N )" + non associative with precedence 45 + for @{ 'ParRedStar $M $N }. diff --git a/matita/matita/lib/lambda/background/preamble.ma b/matita/matita/lib/lambda/background/preamble.ma new file mode 100644 index 000000000..6455bfcf4 --- /dev/null +++ b/matita/matita/lib/lambda/background/preamble.ma @@ -0,0 +1,129 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "basics/star.ma". +include "basics/lists/lstar.ma". +include "arithmetics/exp.ma". + +include "background/xoa_notation.ma". +include "background/xoa.ma". +include "background/notation.ma". + +(* logic *) + +(* Note: For some reason this cannot be in the standard library *) +interpretation "logical false" 'false = False. + +(* booleans *) + +(* Note: For some reason this cannot be in the standard library *) +interpretation "boolean false" 'false = false. + +(* Note: For some reason this cannot be in the standard library *) +interpretation "boolean true" 'true = true. + +(* arithmetics *) + +lemma lt_refl_false: ∀n. n < n → ⊥. +#n #H elim (lt_to_not_eq … H) -H /2 width=1/ +qed-. + +lemma lt_zero_false: ∀n. n < 0 → ⊥. +#n #H elim (lt_to_not_le … H) -H /2 width=1/ +qed-. + +lemma plus_lt_false: ∀m,n. m + n < m → ⊥. +#m #n #H elim (lt_to_not_le … H) -H /2 width=1/ +qed-. + +lemma lt_or_eq_or_gt: ∀m,n. ∨∨ m < n | n = m | n < m. +#m #n elim (lt_or_ge m n) /2 width=1/ +#H elim H -m /2 width=1/ +#m #Hm * #H /2 width=1/ /3 width=1/ +qed-. + +(* trichotomy operator *) + +(* Note: this is "if eqb n1 n2 then a2 else if leb n1 n2 then a1 else a3" *) +let rec tri (A:Type[0]) n1 n2 a1 a2 a3 on n1 : A ≝ + match n1 with + [ O ⇒ match n2 with [ O ⇒ a2 | S n2 ⇒ a1 ] + | S n1 ⇒ match n2 with [ O ⇒ a3 | S n2 ⇒ tri A n1 n2 a1 a2 a3 ] + ]. + +lemma tri_lt: ∀A,a1,a2,a3,n2,n1. n1 < n2 → tri A n1 n2 a1 a2 a3 = a1. +#A #a1 #a2 #a3 #n2 elim n2 -n2 +[ #n1 #H elim (lt_zero_false … H) +| #n2 #IH #n1 elim n1 -n1 // /3 width=1/ +] +qed. + +lemma tri_eq: ∀A,a1,a2,a3,n. tri A n n a1 a2 a3 = a2. +#A #a1 #a2 #a3 #n elim n -n normalize // +qed. + +lemma tri_gt: ∀A,a1,a2,a3,n1,n2. n2 < n1 → tri A n1 n2 a1 a2 a3 = a3. +#A #a1 #a2 #a3 #n1 elim n1 -n1 +[ #n2 #H elim (lt_zero_false … H) +| #n1 #IH #n2 elim n2 -n2 // /3 width=1/ +] +qed. + +(* lists *) + +(* Note: notation for nil not involving brackets *) +notation > "◊" + non associative with precedence 90 + for @{'nil}. + +lemma list_inv: ∀A. ∀l:list A. ◊ = l ∨ ∃∃a0,l0. a0 :: l0 = l. +#A * /2 width=1/ /3 width=3/ +qed-. + +definition map_cons: ∀A. A → list (list A) → list (list A) ≝ λA,a. + map … (cons … a). + +interpretation "map_cons" 'ho_cons a l = (map_cons ? a l). + +notation "hvbox(a ::: break l)" + right associative with precedence 47 + for @{'ho_cons $a $l}. + +lemma map_cons_inv_nil: ∀A,a,l1. map_cons A a l1 = ◊ → ◊ = l1. +#A #a * // normalize #a1 #l1 #H destruct +qed-. + +lemma map_cons_inv_cons: ∀A,a,a2,l2,l1. map_cons A a l1 = a2::l2 → + ∃∃a1,l. a::a1 = a2 & a:::l = l2 & a1::l = l1. +#A #a #a2 #l2 * normalize +[ #H destruct +| #a1 #l1 #H destruct /2 width=5/ +] +qed-. + +lemma map_cons_append: ∀A,a,l1,l2. map_cons A a (l1@l2) = + map_cons A a l1 @ map_cons A a l2. +#A #a #l1 elim l1 -l1 // normalize /2 width=1/ +qed. + +(* lstar *) + +(* Note: this cannot be in lib because of the missing xoa quantifier *) +lemma lstar_inv_pos: ∀A,B,R,l,b1,b2. lstar A B R l b1 b2 → 0 < |l| → + ∃∃a,ll,b. a::ll = l & R a b1 b & lstar A B R ll b b2. +#A #B #R #l #b1 #b2 #H @(lstar_ind_l … l b1 H) -l -b1 +[ #H elim (lt_refl_false … H) +| #a #ll #b1 #b #Hb1 #Hb2 #_ #_ /2 width=6/ (**) (* auto fail if we do not remove the inductive premise *) +] +qed-. diff --git a/matita/matita/lib/lambda/background/xoa.ma b/matita/matita/lib/lambda/background/xoa.ma new file mode 100644 index 000000000..a2f19a6b7 --- /dev/null +++ b/matita/matita/lib/lambda/background/xoa.ma @@ -0,0 +1,108 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +(* This file was generated by xoa.native: do not edit *********************) + +include "basics/pts.ma". + +(* multiple existental quantifier (1, 2) *) + +inductive ex1_2 (A0,A1:Type[0]) (P0:A0→A1→Prop) : Prop ≝ + | ex1_2_intro: ∀x0,x1. P0 x0 x1 → ex1_2 ? ? ? +. + +interpretation "multiple existental quantifier (1, 2)" 'Ex P0 = (ex1_2 ? ? P0). + +(* multiple existental quantifier (2, 2) *) + +inductive ex2_2 (A0,A1:Type[0]) (P0,P1:A0→A1→Prop) : Prop ≝ + | ex2_2_intro: ∀x0,x1. P0 x0 x1 → P1 x0 x1 → ex2_2 ? ? ? ? +. + +interpretation "multiple existental quantifier (2, 2)" 'Ex P0 P1 = (ex2_2 ? ? P0 P1). + +(* multiple existental quantifier (2, 3) *) + +inductive ex2_3 (A0,A1,A2:Type[0]) (P0,P1:A0→A1→A2→Prop) : Prop ≝ + | ex2_3_intro: ∀x0,x1,x2. P0 x0 x1 x2 → P1 x0 x1 x2 → ex2_3 ? ? ? ? ? +. + +interpretation "multiple existental quantifier (2, 3)" 'Ex P0 P1 = (ex2_3 ? ? ? P0 P1). + +(* multiple existental quantifier (3, 1) *) + +inductive ex3 (A0:Type[0]) (P0,P1,P2:A0→Prop) : Prop ≝ + | ex3_intro: ∀x0. P0 x0 → P1 x0 → P2 x0 → ex3 ? ? ? ? +. + +interpretation "multiple existental quantifier (3, 1)" 'Ex P0 P1 P2 = (ex3 ? P0 P1 P2). + +(* multiple existental quantifier (3, 2) *) + +inductive ex3_2 (A0,A1:Type[0]) (P0,P1,P2:A0→A1→Prop) : Prop ≝ + | ex3_2_intro: ∀x0,x1. P0 x0 x1 → P1 x0 x1 → P2 x0 x1 → ex3_2 ? ? ? ? ? +. + +interpretation "multiple existental quantifier (3, 2)" 'Ex P0 P1 P2 = (ex3_2 ? ? P0 P1 P2). + +(* multiple existental quantifier (3, 3) *) + +inductive ex3_3 (A0,A1,A2:Type[0]) (P0,P1,P2:A0→A1→A2→Prop) : Prop ≝ + | ex3_3_intro: ∀x0,x1,x2. P0 x0 x1 x2 → P1 x0 x1 x2 → P2 x0 x1 x2 → ex3_3 ? ? ? ? ? ? +. + +interpretation "multiple existental quantifier (3, 3)" 'Ex P0 P1 P2 = (ex3_3 ? ? ? P0 P1 P2). + +(* multiple existental quantifier (3, 4) *) + +inductive ex3_4 (A0,A1,A2,A3:Type[0]) (P0,P1,P2:A0→A1→A2→A3→Prop) : Prop ≝ + | ex3_4_intro: ∀x0,x1,x2,x3. P0 x0 x1 x2 x3 → P1 x0 x1 x2 x3 → P2 x0 x1 x2 x3 → ex3_4 ? ? ? ? ? ? ? +. + +interpretation "multiple existental quantifier (3, 4)" 'Ex P0 P1 P2 = (ex3_4 ? ? ? ? P0 P1 P2). + +(* multiple existental quantifier (4, 1) *) + +inductive ex4 (A0:Type[0]) (P0,P1,P2,P3:A0→Prop) : Prop ≝ + | ex4_intro: ∀x0. P0 x0 → P1 x0 → P2 x0 → P3 x0 → ex4 ? ? ? ? ? +. + +interpretation "multiple existental quantifier (4, 1)" 'Ex P0 P1 P2 P3 = (ex4 ? P0 P1 P2 P3). + +(* multiple existental quantifier (4, 2) *) + +inductive ex4_2 (A0,A1:Type[0]) (P0,P1,P2,P3:A0→A1→Prop) : Prop ≝ + | ex4_2_intro: ∀x0,x1. P0 x0 x1 → P1 x0 x1 → P2 x0 x1 → P3 x0 x1 → ex4_2 ? ? ? ? ? ? +. + +interpretation "multiple existental quantifier (4, 2)" 'Ex P0 P1 P2 P3 = (ex4_2 ? ? P0 P1 P2 P3). + +(* multiple existental quantifier (4, 3) *) + +inductive ex4_3 (A0,A1,A2:Type[0]) (P0,P1,P2,P3:A0→A1→A2→Prop) : Prop ≝ + | ex4_3_intro: ∀x0,x1,x2. P0 x0 x1 x2 → P1 x0 x1 x2 → P2 x0 x1 x2 → P3 x0 x1 x2 → ex4_3 ? ? ? ? ? ? ? +. + +interpretation "multiple existental quantifier (4, 3)" 'Ex P0 P1 P2 P3 = (ex4_3 ? ? ? P0 P1 P2 P3). + +(* multiple disjunction connective (3) *) + +inductive or3 (P0,P1,P2:Prop) : Prop ≝ + | or3_intro0: P0 → or3 ? ? ? + | or3_intro1: P1 → or3 ? ? ? + | or3_intro2: P2 → or3 ? ? ? +. + +interpretation "multiple disjunction connective (3)" 'Or P0 P1 P2 = (or3 P0 P1 P2). + diff --git a/matita/matita/lib/lambda/background/xoa_notation.ma b/matita/matita/lib/lambda/background/xoa_notation.ma new file mode 100644 index 000000000..240c1dd5d --- /dev/null +++ b/matita/matita/lib/lambda/background/xoa_notation.ma @@ -0,0 +1,122 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +(* This file was generated by xoa.native: do not edit *********************) + +(* multiple existental quantifier (1, 2) *) + +notation > "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}.λ${ident x1}.$P0) }. + +notation < "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.$P0) }. + +(* multiple existental quantifier (2, 2) *) + +notation > "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}.λ${ident x1}.$P0) (λ${ident x0}.λ${ident x1}.$P1) }. + +notation < "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P1) }. + +(* multiple existental quantifier (2, 3) *) + +notation > "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P0) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P1) }. + +notation < "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P1) }. + +(* multiple existental quantifier (3, 1) *) + +notation > "hvbox(∃∃ ident x0 break . term 19 P0 break & term 19 P1 break & term 19 P2)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}.$P0) (λ${ident x0}.$P1) (λ${ident x0}.$P2) }. + +notation < "hvbox(∃∃ ident x0 break . term 19 P0 break & term 19 P1 break & term 19 P2)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}:$T0.$P0) (λ${ident x0}:$T0.$P1) (λ${ident x0}:$T0.$P2) }. + +(* multiple existental quantifier (3, 2) *) + +notation > "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1 break & term 19 P2)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}.λ${ident x1}.$P0) (λ${ident x0}.λ${ident x1}.$P1) (λ${ident x0}.λ${ident x1}.$P2) }. + +notation < "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1 break & term 19 P2)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P1) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P2) }. + +(* multiple existental quantifier (3, 3) *) + +notation > "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1 break & term 19 P2)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P0) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P1) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P2) }. + +notation < "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1 break & term 19 P2)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P1) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P2) }. + +(* multiple existental quantifier (3, 4) *) + +notation > "hvbox(∃∃ ident x0 , ident x1 , ident x2 , ident x3 break . term 19 P0 break & term 19 P1 break & term 19 P2)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}.λ${ident x1}.λ${ident x2}.λ${ident x3}.$P0) (λ${ident x0}.λ${ident x1}.λ${ident x2}.λ${ident x3}.$P1) (λ${ident x0}.λ${ident x1}.λ${ident x2}.λ${ident x3}.$P2) }. + +notation < "hvbox(∃∃ ident x0 , ident x1 , ident x2 , ident x3 break . term 19 P0 break & term 19 P1 break & term 19 P2)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.λ${ident x3}:$T3.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.λ${ident x3}:$T3.$P1) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.λ${ident x3}:$T3.$P2) }. + +(* multiple existental quantifier (4, 1) *) + +notation > "hvbox(∃∃ ident x0 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}.$P0) (λ${ident x0}.$P1) (λ${ident x0}.$P2) (λ${ident x0}.$P3) }. + +notation < "hvbox(∃∃ ident x0 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}:$T0.$P0) (λ${ident x0}:$T0.$P1) (λ${ident x0}:$T0.$P2) (λ${ident x0}:$T0.$P3) }. + +(* multiple existental quantifier (4, 2) *) + +notation > "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}.λ${ident x1}.$P0) (λ${ident x0}.λ${ident x1}.$P1) (λ${ident x0}.λ${ident x1}.$P2) (λ${ident x0}.λ${ident x1}.$P3) }. + +notation < "hvbox(∃∃ ident x0 , ident x1 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P1) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P2) (λ${ident x0}:$T0.λ${ident x1}:$T1.$P3) }. + +(* multiple existental quantifier (4, 3) *) + +notation > "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P0) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P1) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P2) (λ${ident x0}.λ${ident x1}.λ${ident x2}.$P3) }. + +notation < "hvbox(∃∃ ident x0 , ident x1 , ident x2 break . term 19 P0 break & term 19 P1 break & term 19 P2 break & term 19 P3)" + non associative with precedence 20 + for @{ 'Ex (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P0) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P1) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P2) (λ${ident x0}:$T0.λ${ident x1}:$T1.λ${ident x2}:$T2.$P3) }. + +(* multiple disjunction connective (3) *) + +notation "hvbox(∨∨ term 29 P0 break | term 29 P1 break | term 29 P2)" + non associative with precedence 30 + for @{ 'Or $P0 $P1 $P2 }. + diff --git a/matita/matita/lib/lambda/paths/alternative_standard_order.ma b/matita/matita/lib/lambda/paths/alternative_standard_order.ma new file mode 100644 index 000000000..e8eca4f11 --- /dev/null +++ b/matita/matita/lib/lambda/paths/alternative_standard_order.ma @@ -0,0 +1,48 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "paths/standard_precedence.ma". + +(* ALTERNATIVE STANDARD ORDER ***********************************************) + +(* Note: this is p < q *) +definition slt: relation path ≝ TC … sprec. + +interpretation "standard 'less than' on paths" + 'lt p q = (slt p q). + +lemma slt_step_rc: ∀p,q. p ≺ q → p < q. +/2 width=1/ +qed. + +lemma slt_nil: ∀o,p. ◊ < o::p. +/2 width=1/ +qed. + +lemma slt_skip: dx::◊ < ◊. +/2 width=1/ +qed. + +lemma slt_comp: ∀o,p,q. p < q → o::p < o::q. +#o #p #q #H elim H -q /3 width=1/ /3 width=3/ +qed. + +theorem slt_trans: transitive … slt. +/2 width=3/ +qed-. + +lemma slt_refl: ∀p. p < p. +#p elim p -p /2 width=1/ +@(slt_trans … (dx::◊)) // +qed. diff --git a/matita/matita/lib/lambda/paths/decomposed_trace.ma b/matita/matita/lib/lambda/paths/decomposed_trace.ma new file mode 100644 index 000000000..2241fab10 --- /dev/null +++ b/matita/matita/lib/lambda/paths/decomposed_trace.ma @@ -0,0 +1,31 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "paths/trace.ma". + +(* DECOMPOSED TRACE *********************************************************) + +(* Policy: decomposed trace metavariables: P, Q *) +(* Note: this is a binary tree on traces *) +inductive dtrace: Type[0] ≝ +| tree_nil : dtrace +| tree_cons: trace → dtrace → dtrace → dtrace +. + +let rec size (P:dtrace) on P ≝ match P with +[ tree_nil ⇒ 0 +| tree_cons s Q1 Q2 ⇒ size Q2 + size Q1 + |s| +]. + +interpretation "decomposed trace size" 'card P = (size P). diff --git a/matita/matita/lib/lambda/paths/dst_computation.ma b/matita/matita/lib/lambda/paths/dst_computation.ma new file mode 100644 index 000000000..a532e7b15 --- /dev/null +++ b/matita/matita/lib/lambda/paths/dst_computation.ma @@ -0,0 +1,214 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "paths/standard_trace.ma". +include "paths/labeled_sequential_computation.ma". + +(* DECOMPOSED STANDARD COMPUTATION ***********************************************) + +(* Note: this is the "standard" computation of: + R. Kashima: "A proof of the Standization Theorem in λ-Calculus". (2000). +*) +inductive dst: relation term ≝ +| dst_vref: ∀s,M,i. is_whd s → M ↦*[s] #i → dst M (#i) +| dst_abst: ∀s,M,A1,A2. is_whd s → M ↦*[s] 𝛌.A1 → dst A1 A2 → dst M (𝛌.A2) +| dst_appl: ∀s,M,B1,B2,A1,A2. is_whd s → M ↦*[s] @B1.A1 → dst B1 B2 → dst A1 A2 → dst M (@B2.A2) +. + +interpretation "decomposed standard computation" + 'DecomposedStd M N = (dst M N). + +notation "hvbox( M break ⓢ↦* term 46 N )" + non associative with precedence 45 + for @{ 'DecomposedStd $M $N }. + +lemma dst_inv_lref: ∀M,N. M ⓢ↦* N → ∀j. #j = N → + ∃∃s. is_whd s & M ↦*[s] #j. +#M #N * -M -N +[ /2 width=3/ +| #s #M #A1 #A2 #_ #_ #_ #j #H destruct +| #s #M #B1 #B2 #A1 #A2 #_ #_ #_ #_ #j #H destruct +] +qed-. + +lemma dst_inv_abst: ∀M,N. M ⓢ↦* N → ∀C2. 𝛌.C2 = N → + ∃∃s,C1. is_whd s & M ↦*[s] 𝛌.C1 & C1 ⓢ↦* C2. +#M #N * -M -N +[ #s #M #i #_ #_ #C2 #H destruct +| #s #M #A1 #A2 #Hs #HM #A12 #C2 #H destruct /2 width=5/ +| #s #M #B1 #B2 #A1 #A2 #_ #_ #_ #_ #C2 #H destruct +] +qed-. + +lemma dst_inv_appl: ∀M,N. M ⓢ↦* N → ∀D2,C2. @D2.C2 = N → + ∃∃s,D1,C1. is_whd s & M ↦*[s] @D1.C1 & D1 ⓢ↦* D2 & C1 ⓢ↦* C2. +#M #N * -M -N +[ #s #M #i #_ #_ #D2 #C2 #H destruct +| #s #M #A1 #A2 #_ #_ #_ #D2 #C2 #H destruct +| #s #M #B1 #B2 #A1 #A2 #Hs #HM #HB12 #HA12 #D2 #C2 #H destruct /2 width=7/ +] +qed-. + +lemma dst_refl: reflexive … dst. +#M elim M -M /2 width=3/ /2 width=5/ /2 width=7/ +qed. + +lemma dst_step_sn: ∀N1,N2. N1 ⓢ↦* N2 → ∀s,M. is_whd s → M ↦*[s] N1 → M ⓢ↦* N2. +#N1 #N2 #H elim H -N1 -N2 +[ #r #N #i #Hr #HN #s #M #Hs #HMN + lapply (pl_sreds_trans … HMN … HN) -N /3 width=3/ +| #r #N #C1 #C2 #Hr #HN #_ #IHC12 #s #M #Hs #HMN + lapply (pl_sreds_trans … HMN … HN) -N /3 width=7/ +| #r #N #D1 #D2 #C1 #C2 #Hr #HN #_ #_ #IHD12 #IHC12 #s #M #Hs #HMN + lapply (pl_sreds_trans … HMN … HN) -N /3 width=9/ +] +qed-. + +lemma dst_step_rc: ∀s,M1,M2. is_whd s → M1 ↦*[s] M2 → M1 ⓢ↦* M2. +/3 width=5 by dst_step_sn/ +qed. + +lemma dst_lift: liftable dst. +#h #M1 #M2 #H elim H -M1 -M2 +[ /3 width=3/ +| #s #M #A1 #A2 #Hs #HM #_ #IHA12 #d + @(dst_abst … Hs) [2: @(pl_sreds_lift … HM) | skip ] -M // (**) (* auto fails here *) +| #s #M #B1 #B2 #A1 #A2 #Hs #HM #_ #_ #IHB12 #IHA12 #d + @(dst_appl … Hs) [3: @(pl_sreds_lift … HM) |1,2: skip ] -M // (**) (* auto fails here *) +] +qed. + +lemma dst_inv_lift: deliftable_sn dst. +#h #N1 #N2 #H elim H -N1 -N2 +[ #s #N1 #i #Hs #HN1 #d #M1 #HMN1 + elim (pl_sreds_inv_lift … HN1 … HMN1) -N1 /3 width=3/ +| #s #N1 #C1 #C2 #Hs #HN1 #_ #IHC12 #d #M1 #HMN1 + elim (pl_sreds_inv_lift … HN1 … HMN1) -N1 #M2 #HM12 #HM2 + elim (lift_inv_abst … HM2) -HM2 #A1 #HAC1 #HM2 destruct + elim (IHC12 …) -IHC12 [4: // |2,3: skip ] #A2 #HA12 #HAC2 destruct (**) (* simplify line *) + @(ex2_intro … (𝛌.A2)) // /2 width=5/ +| #s #N1 #D1 #D2 #C1 #C2 #Hs #HN1 #_ #_ #IHD12 #IHC12 #d #M1 #HMN1 + elim (pl_sreds_inv_lift … HN1 … HMN1) -N1 #M2 #HM12 #HM2 + elim (lift_inv_appl … HM2) -HM2 #B1 #A1 #HBD1 #HAC1 #HM2 destruct + elim (IHD12 …) -IHD12 [4: // |2,3: skip ] #B2 #HB12 #HBD2 destruct (**) (* simplify line *) + elim (IHC12 …) -IHC12 [4: // |2,3: skip ] #A2 #HA12 #HAC2 destruct (**) (* simplify line *) + @(ex2_intro … (@B2.A2)) // /2 width=7/ +] +qed-. + +lemma dst_dsubst: dsubstable dst. +#N1 #N2 #HN12 #M1 #M2 #H elim H -M1 -M2 +[ #s #M #i #Hs #HM #d elim (lt_or_eq_or_gt i d) #Hid + [ lapply (pl_sreds_dsubst … N1 … HM d) -HM + >(dsubst_vref_lt … Hid) >(dsubst_vref_lt … Hid) /2 width=3/ + | destruct >dsubst_vref_eq + @(dst_step_sn (↑[0,i]N1) … s) /2 width=1/ + | lapply (pl_sreds_dsubst … N1 … HM d) -HM + >(dsubst_vref_gt … Hid) >(dsubst_vref_gt … Hid) /2 width=3/ + ] +| #s #M #A1 #A2 #Hs #HM #_ #IHA12 #d + lapply (pl_sreds_dsubst … N1 … HM d) -HM /2 width=5/ (**) (* auto needs some help here *) +| #s #M #B1 #B2 #A1 #A2 #Hs #HM #_ #_ #IHB12 #IHA12 #d + lapply (pl_sreds_dsubst … N1 … HM d) -HM /2 width=7/ (**) (* auto needs some help here *) +] +qed. + +lemma dst_step_dx: ∀p,M,M2. M ↦[p] M2 → ∀M1. M1 ⓢ↦* M → M1 ⓢ↦* M2. +#p #M #M2 #H elim H -p -M -M2 +[ #B #A #M1 #H + elim (dst_inv_appl … H …) -H [4: // |2,3: skip ] #s #B1 #M #Hs #HM1 #HB1 #H (**) (* simplify line *) + elim (dst_inv_abst … H …) -H [3: // |2: skip ] #r #A1 #Hr #HM #HA1 (**) (* simplify line *) + lapply (pl_sreds_trans … HM1 … (dx:::r) (@B1.𝛌.A1) ?) /2 width=1/ -M #HM1 + lapply (pl_sreds_step_dx … HM1 (◊) ([↙B1]A1) ?) -HM1 // #HM1 + @(dst_step_sn … HM1) /2 width=1/ /4 width=1/ +| #p #A #A2 #_ #IHA2 #M1 #H + elim (dst_inv_abst … H …) -H [3: // |2: skip ] /3 width=5/ (**) (* simplify line *) +| #p #B #B2 #A #_ #IHB2 #M1 #H + elim (dst_inv_appl … H …) -H [4: // |2,3: skip ] /3 width=7/ (**) (* simplify line *) +| #p #B #A #A2 #_ #IHA2 #M1 #H + elim (dst_inv_appl … H …) -H [4: // |2,3: skip ] /3 width=7/ (**) (* simplify line *) +] +qed-. + +lemma pl_sreds_dst: ∀s,M1,M2. M1 ↦*[s] M2 → M1 ⓢ↦* M2. +#s #M1 #M2 #H @(lstar_ind_r … s M2 H) -s -M2 // /2 width=4 by dst_step_dx/ +qed. + +lemma dst_inv_pl_sreds_is_standard: ∀M,N. M ⓢ↦* N → + ∃∃r. M ↦*[r] N & is_standard r. +#M #N #H elim H -M -N +[ #s #M #i #Hs #HM + lapply (is_whd_is_standard … Hs) -Hs /2 width=3/ +| #s #M #A1 #A2 #Hs #HM #_ * #r #HA12 #Hr + lapply (pl_sreds_trans … HM (rc:::r) (𝛌.A2) ?) /2 width=1/ -A1 #HM + @(ex2_intro … HM) -M -A2 /3 width=1/ +| #s #M #B1 #B2 #A1 #A2 #Hs #HM #_ #_ * #rb #HB12 #Hrb * #ra #HA12 #Hra + lapply (pl_sreds_trans … HM (dx:::ra) (@B1.A2) ?) /2 width=1/ -A1 #HM + lapply (pl_sreds_trans … HM (sn:::rb) (@B2.A2) ?) /2 width=1/ -B1 #HM + @(ex2_intro … HM) -M -B2 -A2 >associative_append /3 width=1/ +] +qed-. + +theorem dst_trans: transitive … dst. +#M1 #M #M2 #HM1 #HM2 +elim (dst_inv_pl_sreds_is_standard … HM1) -HM1 #s1 #HM1 #_ +elim (dst_inv_pl_sreds_is_standard … HM2) -HM2 #s2 #HM2 #_ +lapply (pl_sreds_trans … HM1 … HM2) -M /2 width=2/ +qed-. + +theorem pl_sreds_standard: ∀s,M,N. M ↦*[s] N → ∃∃r. M ↦*[r] N & is_standard r. +#s #M #N #H +@dst_inv_pl_sreds_is_standard /2 width=2/ +qed-. + +(* Note: we use "lapply (rewrite_r ?? is_whd … Hq)" (procedural) + in place of "cut (is_whd (q::r)) [ >Hq ]" (declarative) +*) +lemma dst_in_whd_swap: ∀p. in_whd p → ∀N1,N2. N1 ↦[p] N2 → ∀M1. M1 ⓢ↦* N1 → + ∃∃q,M2. in_whd q & M1 ↦[q] M2 & M2 ⓢ↦* N2. +#p #H @(in_whd_ind … H) -p +[ #N1 #N2 #H1 #M1 #H2 + elim (pl_sred_inv_nil … H1 …) -H1 // #D #C #HN1 #HN2 + elim (dst_inv_appl … H2 … HN1) -N1 #s1 #D1 #N #Hs1 #HM1 #HD1 #H + elim (dst_inv_abst … H …) -H [3: // |2: skip ] #s2 #C1 #Hs2 #HN #HC1 (**) (* simplify line *) + lapply (pl_sreds_trans … HM1 … (dx:::s2) (@D1.𝛌.C1) ?) /2 width=1/ -N #HM1 + lapply (pl_sreds_step_dx … HM1 (◊) ([↙D1]C1) ?) -HM1 // #HM1 + elim (pl_sreds_inv_pos … HM1 …) -HM1 + [2: >length_append normalize in ⊢ (??(??%)); // ] + #q #r #M #Hq #HM1 #HM + lapply (rewrite_r ?? is_whd … Hq) -Hq /4 width=1/ -s1 -s2 * #Hq #Hr + @(ex3_2_intro … HM1) -M1 // -q + @(dst_step_sn … HM) /2 width=1/ +| #p #_ #IHp #N1 #N2 #H1 #M1 #H2 + elim (pl_sred_inv_dx … H1 …) -H1 [3: // |2: skip ] #D #C1 #C2 #HC12 #HN1 #HN2 (**) (* simplify line *) + elim (dst_inv_appl … H2 … HN1) -N1 #s #B #A1 #Hs #HM1 #HBD #HAC1 + elim (IHp … HC12 … HAC1) -p -C1 #p #C1 #Hp #HAC1 #HC12 + lapply (pl_sreds_step_dx … HM1 (dx::p) (@B.C1) ?) -HM1 /2 width=1/ -A1 #HM1 + elim (pl_sreds_inv_pos … HM1 …) -HM1 + [2: >length_append normalize in ⊢ (??(??%)); // ] + #q #r #M #Hq #HM1 #HM + lapply (rewrite_r ?? is_whd … Hq) -Hq /4 width=1/ -p -s * #Hq #Hr + @(ex3_2_intro … HM1) -M1 // -q /2 width=7/ +] +qed-. + +theorem pl_sreds_in_whd_swap: ∀s,M1,N1. M1 ↦*[s] N1 → + ∀p,N2. in_whd p → N1 ↦[p] N2 → + ∃∃q,r,M2. in_whd q & M1 ↦[q] M2 & M2 ↦*[r] N2 & + is_standard (q::r). +#s #M1 #N1 #HMN1 #p #N2 #Hp #HN12 +lapply (pl_sreds_dst … HMN1) -s #HMN1 +elim (dst_in_whd_swap … Hp … HN12 … HMN1) -p -N1 #q #M2 #Hq #HM12 #HMN2 +elim (dst_inv_pl_sreds_is_standard … HMN2) -HMN2 /3 width=8/ +qed-. diff --git a/matita/matita/lib/lambda/paths/labeled_sequential_computation.ma b/matita/matita/lib/lambda/paths/labeled_sequential_computation.ma new file mode 100644 index 000000000..57a88baa8 --- /dev/null +++ b/matita/matita/lib/lambda/paths/labeled_sequential_computation.ma @@ -0,0 +1,112 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "terms/labeled_sequential_computation.ma". +include "paths/trace.ma". +include "paths/labeled_sequential_reduction.ma". + +(* PATH-LABELED SEQUENTIAL COMPUTATION (MULTISTEP) *******************************) + +(* Note: lstar shuld be replaced by l_sreds *) +definition pl_sreds: trace → relation term ≝ lstar … pl_sred. + +interpretation "path-labeled sequential computation" + 'SeqRedStar M s N = (pl_sreds s M N). + +lemma sreds_pl_sreds: ∀M,N. M ↦* N → ∃s. M ↦*[s] N. +/3 width=1 by sreds_l_sreds, sred_pl_sred/ +qed-. + +lemma pl_sreds_inv_sreds: ∀s,M,N. M ↦*[s] N → M ↦* N. +/3 width=5 by l_sreds_inv_sreds, pl_sred_inv_sred/ +qed-. + +lemma pl_sreds_refl: reflexive … (pl_sreds (◊)). +// +qed. + +lemma pl_sreds_step_sn: ∀p,M1,M. M1 ↦[p] M → ∀s,M2. M ↦*[s] M2 → M1 ↦*[p::s] M2. +/2 width=3/ +qed-. + +lemma pl_sreds_step_dx: ∀s,M1,M. M1 ↦*[s] M → ∀p,M2. M ↦[p] M2 → M1 ↦*[s@p::◊] M2. +/2 width=3/ +qed-. + +lemma pl_sreds_step_rc: ∀p,M1,M2. M1 ↦[p] M2 → M1 ↦*[p::◊] M2. +/2 width=1/ +qed. + +lemma pl_sreds_inv_nil: ∀s,M1,M2. M1 ↦*[s] M2 → ◊ = s → M1 = M2. +/2 width=5 by lstar_inv_nil/ +qed-. + +lemma pl_sreds_inv_cons: ∀s,M1,M2. M1 ↦*[s] M2 → ∀q,r. q::r = s → + ∃∃M. M1 ↦[q] M & M ↦*[r] M2. +/2 width=3 by lstar_inv_cons/ +qed-. + +lemma pl_sreds_inv_step_rc: ∀p,M1,M2. M1 ↦*[p::◊] M2 → M1 ↦[p] M2. +/2 width=1 by lstar_inv_step/ +qed-. + +lemma pl_sreds_inv_pos: ∀s,M1,M2. M1 ↦*[s] M2 → 0 < |s| → + ∃∃p,r,M. p::r = s & M1 ↦[p] M & M ↦*[r] M2. +/2 width=1 by lstar_inv_pos/ +qed-. + +lemma lsred_compatible_rc: ho_compatible_rc pl_sreds. +/3 width=1/ +qed. + +lemma pl_sreds_compatible_sn: ho_compatible_sn pl_sreds. +/3 width=1/ +qed. + +lemma pl_sreds_compatible_dx: ho_compatible_dx pl_sreds. +/3 width=1/ +qed. + +lemma pl_sreds_lift: ∀s. liftable (pl_sreds s). +/2 width=1/ +qed. + +lemma pl_sreds_inv_lift: ∀s. deliftable_sn (pl_sreds s). +/3 width=3 by lstar_deliftable_sn, pl_sred_inv_lift/ +qed-. + +lemma pl_sreds_dsubst: ∀s. dsubstable_dx (pl_sreds s). +/2 width=1/ +qed. + +theorem pl_sreds_mono: ∀s. singlevalued … (pl_sreds s). +/3 width=7 by lstar_singlevalued, pl_sred_mono/ +qed-. + +theorem pl_sreds_trans: ltransitive … pl_sreds. +/2 width=3 by lstar_ltransitive/ +qed-. + +lemma pl_sreds_compatible_appl: ∀r,B1,B2. B1 ↦*[r] B2 → ∀s,A1,A2. A1 ↦*[s] A2 → + @B1.A1 ↦*[(sn:::r)@dx:::s] @B2.A2. +#r #B1 #B2 #HB12 #s #A1 #A2 #HA12 +@(pl_sreds_trans … (@B2.A1)) /2 width=1/ +qed. + +lemma pl_sreds_compatible_beta: ∀r,B1,B2. B1 ↦*[r] B2 → ∀s,A1,A2. A1 ↦*[s] A2 → + @B1.𝛌.A1 ↦*[(sn:::r)@(dx:::rc:::s)@◊::◊] [↙B2] A2. +#r #B1 #B2 #HB12 #s #A1 #A2 #HA12 +@(pl_sreds_trans … (@B2.𝛌.A1)) /2 width=1/ -r -B1 +@(pl_sreds_step_dx … (@B2.𝛌.A2)) // /3 width=1/ +qed. diff --git a/matita/matita/lib/lambda/paths/labeled_sequential_reduction.ma b/matita/matita/lib/lambda/paths/labeled_sequential_reduction.ma new file mode 100644 index 000000000..8864a708e --- /dev/null +++ b/matita/matita/lib/lambda/paths/labeled_sequential_reduction.ma @@ -0,0 +1,128 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "paths/path.ma". +include "terms/sequential_reduction.ma". + +(* PATH-LABELED SEQUENTIAL REDUCTION (SINGLE STEP) **************************) + +inductive pl_sred: path → relation term ≝ +| pl_sred_beta : ∀B,A. pl_sred (◊) (@B.𝛌.A) ([↙B]A) +| pl_sred_abst : ∀p,A1,A2. pl_sred p A1 A2 → pl_sred (rc::p) (𝛌.A1) (𝛌.A2) +| pl_sred_appl_sn: ∀p,B1,B2,A. pl_sred p B1 B2 → pl_sred (sn::p) (@B1.A) (@B2.A) +| pl_sred_appl_dx: ∀p,B,A1,A2. pl_sred p A1 A2 → pl_sred (dx::p) (@B.A1) (@B.A2) +. + +interpretation "path-labeled sequential reduction" + 'SeqRed M p N = (pl_sred p M N). + +lemma sred_pl_sred: ∀M,N. M ↦ N → ∃p. M ↦[p] N. +#M #N #H elim H -M -N +[ /2 width=2/ +| #A1 #A2 #_ * /3 width=2/ +| #B1 #B2 #A #_ * /3 width=2/ +| #B #A1 #A2 #_ * /3 width=2/ +] +qed-. + +lemma pl_sred_inv_sred: ∀p,M,N. M ↦[p] N → M ↦ N. +#p #M #N #H elim H -p -M -N // /2 width=1/ +qed-. + +lemma pl_sred_inv_vref: ∀p,M,N. M ↦[p] N → ∀i. #i = M → ⊥. +/3 width=5 by pl_sred_inv_sred, sred_inv_vref/ +qed-. + +lemma pl_sred_inv_nil: ∀p,M,N. M ↦[p] N → ◊ = p → + ∃∃B,A. @B. 𝛌.A = M & [↙B] A = N. +#p #M #N * -p -M -N +[ #B #A #_ destruct /2 width=4/ +| #p #A1 #A2 #_ #H destruct +| #p #B1 #B2 #A #_ #H destruct +| #p #B #A1 #A2 #_ #H destruct +] +qed-. + +lemma pl_sred_inv_rc: ∀p,M,N. M ↦[p] N → ∀q. rc::q = p → + ∃∃A1,A2. A1 ↦[q] A2 & 𝛌.A1 = M & 𝛌.A2 = N. +#p #M #N * -p -M -N +[ #B #A #q #H destruct +| #p #A1 #A2 #HA12 #q #H destruct /2 width=5/ +| #p #B1 #B2 #A #_ #q #H destruct +| #p #B #A1 #A2 #_ #q #H destruct +] +qed-. + +lemma pl_sred_inv_sn: ∀p,M,N. M ↦[p] N → ∀q. sn::q = p → + ∃∃B1,B2,A. B1 ↦[q] B2 & @B1.A = M & @B2.A = N. +#p #M #N * -p -M -N +[ #B #A #q #H destruct +| #p #A1 #A2 #_ #q #H destruct +| #p #B1 #B2 #A #HB12 #q #H destruct /2 width=6/ +| #p #B #A1 #A2 #_ #q #H destruct +] +qed-. + +lemma pl_sred_inv_dx: ∀p,M,N. M ↦[p] N → ∀q. dx::q = p → + ∃∃B,A1,A2. A1 ↦[q] A2 & @B.A1 = M & @B.A2 = N. +#p #M #N * -p -M -N +[ #B #A #q #H destruct +| #p #A1 #A2 #_ #q #H destruct +| #p #B1 #B2 #A #_ #q #H destruct +| #p #B #A1 #A2 #HA12 #q #H destruct /2 width=6/ +] +qed-. + +lemma pl_sred_lift: ∀p. liftable (pl_sred p). +#p #h #M1 #M2 #H elim H -p -M1 -M2 normalize /2 width=1/ +#B #A #d dsubst_dsubst_ge // +qed. + +theorem pl_sred_mono: ∀p. singlevalued … (pl_sred p). +#p #M #N1 #H elim H -p -M -N1 +[ #B #A #N2 #H elim (pl_sred_inv_nil … H …) -H // + #D #C #H #HN2 destruct // +| #p #A1 #A2 #_ #IHA12 #N2 #H elim (pl_sred_inv_rc … H …) -H [3: // |2: skip ] (**) (* simplify line *) + #C1 #C2 #HC12 #H #HN2 destruct /3 width=1/ +| #p #B1 #B2 #A #_ #IHB12 #N2 #H elim (pl_sred_inv_sn … H …) -H [3: // |2: skip ] (**) (* simplify line *) + #D1 #D2 #C #HD12 #H #HN2 destruct /3 width=1/ +| #p #B #A1 #A2 #_ #IHA12 #N2 #H elim (pl_sred_inv_dx … H …) -H [3: // |2: skip ] (**) (* simplify line *) + #D #C1 #C2 #HC12 #H #HN2 destruct /3 width=1/ +] +qed-. diff --git a/matita/matita/lib/lambda/paths/labeled_st_computation.ma b/matita/matita/lib/lambda/paths/labeled_st_computation.ma new file mode 100644 index 000000000..29dd72769 --- /dev/null +++ b/matita/matita/lib/lambda/paths/labeled_st_computation.ma @@ -0,0 +1,320 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "paths/standard_trace.ma". +include "paths/labeled_sequential_computation.ma". +include "paths/labeled_st_reduction.ma". + +(* PATH-LABELED STANDARD COMPUTATION (MULTISTEP) ****************************) + +(* Note: lstar shuld be replaced by l_sreds *) +definition pl_sts: trace → relation subterms ≝ lstar … pl_st. + +interpretation "path-labeled standard reduction" + 'StdStar F p G = (pl_sts p F G). + +notation "hvbox( F break Ⓡ ↦* [ term 46 p ] break term 46 G )" + non associative with precedence 45 + for @{ 'StdStar $F $p $G }. + +lemma pl_sts_fwd_pl_sreds: ∀s,F1,F2. F1 Ⓡ↦*[s] F2 → ⇓F1 ↦*[s] ⇓F2. +#s #F1 #F2 #H @(lstar_ind_r … s F2 H) -s -F2 // +#p #s #F #F2 #_ #HF2 #IHF1 +lapply (pl_st_fwd_pl_sred … HF2) -HF2 /2 width=3/ +qed-. + +lemma pl_sts_inv_pl_sreds: ∀s,M1,F2. {⊤}⇑M1 Ⓡ↦*[s] F2 → is_whd s → + ∃∃M2. M1 ↦*[s] M2 & {⊤}⇑M2 = F2. +#s #M1 #F2 #H @(lstar_ind_r … s F2 H) -s -F2 /2 width=3/ +#p #s #F #F2 #_ #HF2 #IHF #H +elim (is_whd_inv_append … H) -H #Hs * #Hp #_ +elim (IHF Hs) -IHF -Hs #M #HM #H destruct +elim (pl_st_inv_pl_sred … HF2) -HF2 // -Hp #M2 #HM2 #H +lapply (pl_sreds_step_dx … HM … HM2) -M /2 width=3/ +qed-. + +lemma pl_sts_inv_empty: ∀s,M1,F2. {⊥}⇑M1 Ⓡ↦*[s] F2 → ◊ = s ∧ {⊥}⇑M1 = F2. +#s #M1 #F2 #H @(lstar_ind_r … s F2 H) -s -F2 /2 width=1/ #p #s #F #F2 #_ #HF2 * #_ #H +elim (pl_st_inv_empty … HF2 … H) +qed-. + +lemma pl_sts_refl: reflexive … (pl_sts (◊)). +// +qed. + +lemma pl_sts_step_sn: ∀p,F1,F. F1 Ⓡ↦[p] F → ∀s,F2. F Ⓡ↦*[s] F2 → F1 Ⓡ↦*[p::s] F2. +/2 width=3/ +qed-. + +lemma pl_sts_step_dx: ∀s,F1,F. F1 Ⓡ↦*[s] F → ∀p,F2. F Ⓡ↦[p] F2 → F1 Ⓡ↦*[s@p::◊] F2. +/2 width=3/ +qed-. + +lemma pl_sts_step_rc: ∀p,F1,F2. F1 Ⓡ↦[p] F2 → F1 Ⓡ↦*[p::◊] F2. +/2 width=1/ +qed. + +lemma pl_sts_inv_nil: ∀s,F1,F2. F1 Ⓡ↦*[s] F2 → ◊ = s → F1 = F2. +/2 width=5 by lstar_inv_nil/ +qed-. + +lemma pl_sts_inv_cons: ∀s,F1,F2. F1 Ⓡ↦*[s] F2 → ∀q,r. q::r = s → + ∃∃F. F1 Ⓡ↦[q] F & F Ⓡ↦*[r] F2. +/2 width=3 by lstar_inv_cons/ +qed-. + +lemma pl_sts_inv_step_rc: ∀p,F1,F2. F1 Ⓡ↦*[p::◊] F2 → F1 Ⓡ↦[p] F2. +/2 width=1 by lstar_inv_step/ +qed-. + +lemma pl_sts_inv_pos: ∀s,F1,F2. F1 Ⓡ↦*[s] F2 → 0 < |s| → + ∃∃p,r,F. p::r = s & F1 Ⓡ↦[p] F & F Ⓡ↦*[r] F2. +/2 width=1 by lstar_inv_pos/ +qed-. + +lemma pl_sts_inv_rc_abst_dx: ∀b2,s,F1,T2. F1 Ⓡ↦*[s] {b2}𝛌.T2 → ∀r. rc:::r = s → + ∃∃b1,T1. T1 Ⓡ↦*[r] T2 & {b1}𝛌.T1 = F1. +#b2 #s #F1 #T2 #H @(lstar_ind_l … s F1 H) -s -F1 +[ #r #H lapply (map_cons_inv_nil … r H) -H #H destruct /2 width=4/ +| #p #s #F1 #F #HF1 #_ #IHF2 #r #H -b2 + elim (map_cons_inv_cons … r H) -H #q #r0 #Hp #Hs #Hr + elim (pl_st_inv_rc … HF1 … Hp) -HF1 -p #b1 #T1 #T #HT1 #HF1 #HF destruct + elim (IHF2 …) -IHF2 [3: // |2: skip ] (**) (* simplify line *) + #b0 #T0 #HT02 #H destruct + lapply (pl_sts_step_sn … HT1 … HT02) -T /2 width=4/ +] +qed-. + +lemma pl_sts_inv_sn_appl_dx: ∀b2,s,F1,V2,T2. F1 Ⓡ↦*[s] {b2}@V2.T2 → ∀r. sn:::r = s → + ∃∃b1,V1,T1. V1 Ⓡ↦*[r] V2 & {b1}@V1.T1 = F1. +#b2 #s #F1 #V2 #T2 #H @(lstar_ind_l … s F1 H) -s -F1 +[ #r #H lapply (map_cons_inv_nil … r H) -H #H destruct /2 width=5/ +| #p #s #F1 #F #HF1 #_ #IHF2 #r #H -b2 + elim (map_cons_inv_cons … r H) -H #q #r0 #Hp #Hs #Hr + elim (pl_st_inv_sn … HF1 … Hp) -HF1 -p #b1 #V1 #V #T1 #HV1 #HF1 #HF destruct + elim (IHF2 …) -IHF2 [3: // |2: skip ] (**) (* simplify line *) + #b0 #V0 #T0 #HV02 #H destruct + lapply (pl_sts_step_sn … HV1 … HV02) -V /2 width=5/ +] +qed-. + +lemma pl_sts_inv_dx_appl_dx: ∀b,s,F1,V,T2. F1 Ⓡ↦*[s] {b}@V.T2 → ∀r. dx:::r = s → + ∃∃T1. T1 Ⓡ↦*[r] T2 & {b}@V.T1 = F1. +#b #s #F1 #V #T2 #H @(lstar_ind_l … s F1 H) -s -F1 +[ #r #H lapply (map_cons_inv_nil … r H) -H #H destruct /2 width=3/ +| #p #s #F1 #F #HF1 #_ #IHF2 #r #H + elim (map_cons_inv_cons … r H) -H #q #r0 #Hp #Hs #Hr + elim (pl_st_inv_dx … HF1 … Hp) -HF1 -p #b0 #V0 #T1 #T #HT1 #HF1 #HF destruct + elim (IHF2 …) -IHF2 [3: // |2: skip ] (**) (* simplify line *) + #T0 #HT02 #H destruct + lapply (pl_sts_step_sn … HT1 … HT02) -T /2 width=3/ +] +qed-. + +lemma pl_sts_lift: ∀s. sliftable (pl_sts s). +/2 width=1/ +qed. + +lemma pl_sts_inv_lift: ∀s. sdeliftable_sn (pl_sts s). +/3 width=3 by lstar_sdeliftable_sn, pl_st_inv_lift/ +qed-. + +lemma pl_sts_dsubst: ∀s. sdsubstable_f_dx … (booleanized ⊥) (pl_sts s). +/2 width=1/ +qed. + +theorem pl_sts_mono: ∀s. singlevalued … (pl_sts s). +/3 width=7 by lstar_singlevalued, pl_st_mono/ +qed-. + +theorem pl_sts_trans: ltransitive … pl_sts. +/2 width=3 by lstar_ltransitive/ +qed-. + +lemma pl_sts_inv_trans: inv_ltransitive … pl_sts. +/2 width=3 by lstar_inv_ltransitive/ +qed-. + +lemma pl_sts_fwd_dx_sn_appl_dx: ∀b2,s,r,F1,V2,T2. F1 Ⓡ↦*[(dx:::s)@(sn:::r)] {b2}@V2.T2 → + ∃∃b1,V1,T1,T0. V1 Ⓡ↦*[r] V2 & T1 Ⓡ↦*[s] T0 & {b1}@V1.T1 = F1. +#b2 #s #r #F1 #V2 #T2 #H +elim (pl_sts_inv_trans … H) -H #F #HF1 #H +elim (pl_sts_inv_sn_appl_dx … H …) -H [3: // |2: skip ] (**) (* simplify line *) +#b #V #T #HV2 #H destruct +elim (pl_sts_inv_dx_appl_dx … HF1 …) -HF1 [3: // |2: skip ] (**) (* simplify line *) +#T1 #HT1 #H destruct /2 width=7/ +qed-. + +theorem pl_sts_fwd_is_standard: ∀s,F1,F2. F1 Ⓡ↦*[s] F2 → is_standard s. +#s elim s -s // #p1 * // +#p2 #s #IHs #F1 #F2 #H +elim (pl_sts_inv_cons … H …) -H [4: // |2,3: skip ] #F3 #HF13 #H (**) (* simplify line *) +elim (pl_sts_inv_cons … H …) [2: // |3,4: skip ] #F4 #HF34 #_ (**) (* simplify line *) +lapply (pl_st_fwd_sle … HF13 … HF34) -F1 -F4 /3 width=3/ +qed-. + +lemma pl_sts_fwd_abst_dx: ∀b2,s,F1,T2. F1 Ⓡ↦*[s] {b2}𝛌.T2 → + ∃∃r1,r2. is_whd r1 & r1@rc:::r2 = s. +#b2 #s #F1 #T2 #H +lapply (pl_sts_fwd_is_standard … H) +@(lstar_ind_l … s F1 H) -s -F1 +[ #_ @(ex2_2_intro … ◊ ◊) // (**) (* auto needs some help here *) +| #p #s #F1 #F #HF1 #HF2 #IHF1 #Hs + lapply (is_standard_fwd_cons … Hs) #H + elim (IHF1 …) // -IHF1 -H #r1 #r2 #Hr1 #H destruct + elim (in_whd_or_in_inner p) #Hp + [ -Hs -F1 -F -T2 -b2 + @(ex2_2_intro … (p::r1) r2) // /2 width=1/ (**) (* auto needs some help here *) + | lapply (is_standard_fwd_append_sn (p::r1) ? Hs) -Hs #H + lapply (is_standard_fwd_in_inner … H ?) -H // #H + lapply (is_whd_is_inner_inv … Hr1 ?) -Hr1 // -H #H destruct + elim (in_inner_inv … Hp) -Hp * #q [3: #IHq ] #Hp +(* case 1: dx *) + [ -IHq + elim (pl_sts_inv_rc_abst_dx … HF2 …) -b2 [3: // |2: skip ] (**) (* simplify line *) + #b #T #_ #HT -T2 + elim (pl_st_inv_dx … HF1 …) -HF1 [3: // |2: skip ] (**) (* simplify line *) + #c #V #T1 #T0 #_ #_ #HT0 -q -T1 -F1 destruct +(* case 2: rc *) + | destruct -F1 -F -T2 -b2 + @(ex2_2_intro … ◊ (q::r2)) // (**) (* auto needs some help here *) +(* case 3: sn *) + | elim (pl_sts_inv_rc_abst_dx … HF2 …) -b2 [3: // |2: skip ] (**) (* simplify line *) + #b #T #_ #HT -T2 + elim (pl_st_inv_sn … HF1 …) -HF1 [3: // |2: skip ] (**) (* simplify line *) + #c #V1 #V #T0 #_ #_ #HT0 -c -q -V1 -F1 destruct + ] + ] +] +qed-. + +lemma pl_sts_fwd_appl_dx: ∀b2,s,F1,V2,T2. F1 Ⓡ↦*[s] {b2}@V2.T2 → + ∃∃r1,r2,r3. is_whd r1 & is_inner r2 & + r1@(dx:::r2)@sn:::r3 = s. +#b2 #s #F1 #V2 #T2 #H +lapply (pl_sts_fwd_is_standard … H) +@(lstar_ind_l … s F1 H) -s -F1 +[ #_ @(ex3_3_intro … ◊ ◊ ◊) // (**) (* auto needs some help here *) +| #p #s #F1 #F #HF1 #HF2 #IHF1 #Hs + lapply (is_standard_fwd_cons … Hs) #H + elim (IHF1 …) // -IHF1 -H #r1 #r2 #r3 #Hr1 #Hr2 #H destruct + elim (in_whd_or_in_inner p) #Hp + [ -Hs -F1 -F -V2 -T2 -b2 + @(ex3_3_intro … (p::r1) r2 r3) // /2 width=1/ (**) (* auto needs some help here *) + | lapply (is_standard_fwd_append_sn (p::r1) ? Hs) -Hs #H + lapply (is_standard_fwd_in_inner … H ?) -H // #H + lapply (is_whd_is_inner_inv … Hr1 ?) -Hr1 // -H #H destruct + elim (in_inner_inv … Hp) -Hp * #q [3: #IHq ] #Hp +(* case 1: dx *) + [ destruct -F1 -F -V2 -T2 -b2 + @(ex3_3_intro … ◊ (q::r2) r3) // /2 width=1/ (**) (* auto needs some help here *) +(* case 2: rc *) + | -Hr2 + elim (pl_sts_fwd_dx_sn_appl_dx … HF2) -b2 #b #V #T #T0 #_ #_ #HT -V2 -T2 -T0 + elim (pl_st_inv_rc … HF1 … Hp) -HF1 #c #V0 #T0 #_ #_ #HT0 -c -V0 -q -F1 destruct +(* case 3: sn *) + | -Hr2 + elim (pl_sts_fwd_dx_sn_appl_dx … HF2) -b2 #b #V #T #T0 #_ #HT0 #HT -V2 -T2 + elim (pl_st_inv_sn … HF1 … Hp) -HF1 #c #V1 #V0 #T1 #_ #_ #H -c -V1 -F1 destruct -V + elim (pl_sts_inv_empty … HT0) -HT0 #H #_ -T0 -T1 destruct + @(ex3_3_intro … ◊ ◊ (q::r3)) // (**) (* auto needs some help here *) + ] + ] +] +qed-. + +lemma pl_sred_is_standard_pl_st: ∀p,M,M2. M ↦[p] M2 → ∀F. ⇓F = M → + ∀s,M1.{⊤}⇑ M1 Ⓡ↦*[s] F → + is_standard (s@(p::◊)) → + ∃∃F2. F Ⓡ↦[p] F2 & ⇓F2 = M2. +#p #M #M2 #H elim H -p -M -M2 +[ #B #A #F #HF #s #M1 #HM1 #Hs + lapply (is_standard_fwd_is_whd … Hs) -Hs // #Hs + elim (pl_sts_inv_pl_sreds … HM1 Hs) -HM1 -Hs #M #_ #H -s -M1 destruct + >carrier_boolean in HF; #H destruct normalize /2 width=3/ +| #p #A1 #A2 #_ #IHA12 #F #HF #s #M1 #HM1 #Hs + elim (carrier_inv_abst … HF) -HF #b #T #HT #HF destruct + elim (pl_sts_fwd_abst_dx … HM1) #r1 #r2 #Hr1 #H destruct + elim (pl_sts_inv_trans … HM1) -HM1 #F0 #HM1 #HT + elim (pl_sts_inv_pl_sreds … HM1 …) // #M0 #_ #H -M1 -Hr1 destruct + >associative_append in Hs; #Hs + lapply (is_standard_fwd_append_dx … Hs) -r1 + <(map_cons_append … r2 (p::◊)) #H + lapply (is_standard_inv_compatible_rc … H) -H #Hp + elim (pl_sts_inv_rc_abst_dx … HT …) -HT [3: // |2: skip ] #b0 #T0 #HT02 #H (**) (* simplify line *) + elim (boolean_inv_abst … (sym_eq … H)) -H #A0 #_ #H #_ -b0 -M0 destruct + elim (IHA12 … HT02 …) // -r2 -A0 -IHA12 #F2 #HF2 #H + @(ex2_intro … ({⊥}𝛌.F2)) normalize // /2 width=1/ (**) (* auto needs some help here *) +| #p #B1 #B2 #A #_ #IHB12 #F #HF #s #M1 #HM1 #Hs + elim (carrier_inv_appl … HF) -HF #b #V #T #HV #HT #HF destruct + elim (pl_sts_fwd_appl_dx … HM1) #r1 #r2 #r3 #Hr1 #_ #H destruct + elim (pl_sts_inv_trans … HM1) -HM1 #F0 #HM1 #HT + elim (pl_sts_inv_pl_sreds … HM1 …) // #M0 #_ #H -M1 -Hr1 destruct + >associative_append in Hs; #Hs + lapply (is_standard_fwd_append_dx … Hs) -r1 + >associative_append #Hs + lapply (is_standard_fwd_append_dx … Hs) -Hs + <(map_cons_append … r3 (p::◊)) #H + lapply (is_standard_inv_compatible_sn … H) -H #Hp + elim (pl_sts_fwd_dx_sn_appl_dx … HT) -HT #b0 #V0 #T0 #T1 #HV0 #_ #H -T1 -r2 + elim (boolean_inv_appl … (sym_eq … H)) -H #B0 #A0 #_ #H #_ #_ -b0 -M0 -T0 destruct + elim (IHB12 … HV0 …) // -r3 -B0 -IHB12 #G2 #HG2 #H + @(ex2_intro … ({⊥}@G2.{⊥}⇕T)) normalize // /2 width=1/ (**) (* auto needs some help here *) +| #p #B #A1 #A2 #_ #IHA12 #F #HF #s #M1 #HM1 #Hs + elim (carrier_inv_appl … HF) -HF #b #V #T #HV #HT #HF destruct + elim (pl_sts_fwd_appl_dx … HM1) #r1 #r2 #r3 #Hr1 #Hr2 #H destruct + elim (pl_sts_inv_trans … HM1) -HM1 #F0 #HM1 #HT + elim (pl_sts_inv_pl_sreds … HM1 …) // #M0 #_ #H -M1 -Hr1 destruct + >associative_append in Hs; #Hs + lapply (is_standard_fwd_append_dx … Hs) -r1 + >associative_append #Hs + elim (list_inv … r3) + [ #H destruct + elim (in_whd_or_in_inner p) #Hp + [ lapply (is_standard_fwd_is_whd … Hs) -Hs /2 width=1/ -Hp #Hs + lapply (is_whd_inv_dx … Hs) -Hs #H + lapply (is_whd_is_inner_inv … Hr2) -Hr2 // -H #H destruct + lapply (pl_sts_inv_nil … HT ?) -HT // #H + elim (boolean_inv_appl … H) -H #B0 #A0 #_ #_ #H #_ -M0 -B0 destruct + elim (IHA12 … A0 …) -IHA12 [3,5,6: // |2,4: skip ] (* simplify line *) + #F2 #HF2 #H + @(ex2_intro … ({b}@V.F2)) normalize // /2 width=1/ (**) (* auto needs some help here *) + | <(map_cons_append … r2 (p::◊)) in Hs; #H + lapply (is_standard_inv_compatible_dx … H ?) -H /3 width=1/ -Hp #Hp + >append_nil in HT; #HT + elim (pl_sts_inv_dx_appl_dx … HT …) -HT [3: // |2: skip ] (* simplify line *) + #T0 #HT0 #H + elim (boolean_inv_appl … (sym_eq … H)) -H #B0 #A0 #_ #_ #H #_ -M0 -B0 destruct + elim (IHA12 … HT0 …) // -r2 -A0 -IHA12 #F2 #HF2 #H + @(ex2_intro … ({b}@V.F2)) normalize // /2 width=1/ (**) (* auto needs some help here *) + ] + | -IHA12 -Hr2 -M0 * #q #r #H destruct + lapply (is_standard_fwd_append_dx … Hs) -r2 #Hs + lapply (is_standard_fwd_sle … Hs) -r #H + elim (sle_inv_sn … H …) -H [3: // |2: skip ] (**) (* simplify line *) + #q0 #_ #H destruct + ] +] +qed-. + +theorem pl_sreds_is_standard_pl_sts: ∀s,M1,M2. M1 ↦*[s] M2 → is_standard s → + ∃∃F2. {⊤}⇑ M1 Ⓡ↦*[s] F2 & ⇓F2 = M2. +#s #M1 #M2 #H @(lstar_ind_r … s M2 H) -s -M2 /2 width=3/ +#p #s #M #M2 #_ #HM2 #IHM1 #Hsp +lapply (is_standard_fwd_append_sn … Hsp) #Hs +elim (IHM1 Hs) -IHM1 -Hs #F #HM1 #H +elim (pl_sred_is_standard_pl_st … HM2 … HM1 …) -HM2 // -M -Hsp #F2 #HF2 #HFM2 +lapply (pl_sts_step_dx … HM1 … HF2) -F +#H @(ex2_intro … F2) // (**) (* auto needs some help here *) +qed-. diff --git a/matita/matita/lib/lambda/paths/labeled_st_reduction.ma b/matita/matita/lib/lambda/paths/labeled_st_reduction.ma new file mode 100644 index 000000000..2f93b35af --- /dev/null +++ b/matita/matita/lib/lambda/paths/labeled_st_reduction.ma @@ -0,0 +1,217 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "subterms/booleanized.ma". +include "paths/labeled_sequential_reduction.ma". +include "paths/standard_order.ma". + +(* PATH-LABELED STANDARD REDUCTION ON SUBTERMS (SINGLE STEP) ****************) + +(* Note: this is standard reduction on marked redexes, + left residuals are unmarked in the reductum +*) +inductive pl_st: path → relation subterms ≝ +| pl_st_beta : ∀V,T. pl_st (◊) ({⊤}@V.{⊤}𝛌.T) ([↙V]T) +| pl_st_abst : ∀b,p,T1,T2. pl_st p T1 T2 → pl_st (rc::p) ({b}𝛌.T1) ({⊥}𝛌.T2) +| pl_st_appl_sn: ∀b,p,V1,V2,T. pl_st p V1 V2 → pl_st (sn::p) ({b}@V1.T) ({⊥}@V2.{⊥}⇕T) +| pl_st_appl_dx: ∀b,p,V,T1,T2. pl_st p T1 T2 → pl_st (dx::p) ({b}@V.T1) ({b}@V.T2) +. + +interpretation "path-labeled standard reduction" + 'Std F p G = (pl_st p F G). + +notation "hvbox( F break Ⓡ ↦ [ term 46 p ] break term 46 G )" + non associative with precedence 45 + for @{ 'Std $F $p $G }. + +lemma pl_st_fwd_pl_sred: ∀p,F1,F2. F1 Ⓡ↦[p] F2 → ⇓F1 ↦[p] ⇓F2. +#p #F1 #F2 #H elim H -p -F1 -F2 normalize /2 width=1/ +qed-. + +lemma pl_st_inv_vref: ∀p,F,G. F Ⓡ↦[p] G → ∀b,i. {b}#i = F → ⊥. +#p #F #G #HFG #b #i #H +lapply (pl_st_fwd_pl_sred … HFG) -HFG #HFG +lapply (eq_f … carrier … H) -H normalize #H +/2 width=6 by pl_sred_inv_vref/ +qed-. + +lemma pl_st_inv_abst: ∀p,F,G. F Ⓡ↦[p] G → ∀c,U1. {c}𝛌.U1 = F → + ∃∃q,U2. U1 Ⓡ↦[q] U2 & rc::q = p & {⊥}𝛌.U2 = G. +#p #F #G * -p -F -G +[ #V #T #c #U1 #H destruct +| #b #p #T1 #T2 #HT12 #c #U1 #H destruct /2 width=5/ +| #b #p #V1 #V2 #T #_ #c #U1 #H destruct +| #b #p #V #T1 #T2 #_ #c #U1 #H destruct +] +qed-. + +lemma pl_st_inv_appl: ∀p,F,G. F Ⓡ↦[p] G → ∀c,W,U. {c}@W.U = F → + ∨∨ (∃∃U0. ⊤ = c & ◊ = p & {⊤}𝛌.U0 = U & [↙W] U0 = G) + | (∃∃q,W0. sn::q = p & W Ⓡ↦[q] W0 & {⊥}@W0.{⊥}⇕U = G) + | (∃∃q,U0. dx::q = p & U Ⓡ↦[q] U0 & {c}@W.U0 = G). +#p #F #G * -p -F -G +[ #V #T #c #W #U #H destruct /3 width=3/ +| #b #p #T1 #T2 #_ #c #W #U #H destruct +| #b #p #V1 #V2 #T #HV12 #c #W #U #H destruct /3 width=5/ +| #b #p #V #T1 #T2 #HT12 #c #W #U #H destruct /3 width=5/ +] +qed-. + +lemma pl_st_fwd_abst: ∀p,F,G. F Ⓡ↦[p] G → ∀c,U2. {c}𝛌.U2 = G → + ◊ = p ∨ ∃q. rc::q = p. +#p #F #G * -p -F -G +[ /2 width=1/ +| /3 width=2/ +| #b #p #V1 #V2 #T #_ #c #U2 #H destruct +| #b #p #V #T1 #T2 #_ #c #U2 #H destruct +] +qed-. + +lemma pl_st_inv_nil: ∀p,F,G. F Ⓡ↦[p] G → ◊ = p → + ∃∃V,T. {⊤}@V.{⊤} 𝛌.T = F & [↙V] T = G. +#p #F #G * -p -F -G +[ #V #T #_ destruct /2 width=4/ +| #b #p #T1 #T2 #_ #H destruct +| #b #p #V1 #V2 #T #_ #H destruct +| #b #p #V #T1 #T2 #_ #H destruct +] +qed-. + +lemma pl_st_inv_rc: ∀p,F,G. F Ⓡ↦[p] G → ∀q. rc::q = p → + ∃∃b,T1,T2. T1 Ⓡ↦[q] T2 & {b}𝛌.T1 = F & {⊥}𝛌.T2 = G. +#p #F #G * -p -F -G +[ #V #T #q #H destruct +| #b #p #T1 #T2 #HT12 #q #H destruct /2 width=6/ +| #b #p #V1 #V2 #T #_ #q #H destruct +| #b #p #V #T1 #T2 #_ #q #H destruct +] +qed-. + +lemma pl_st_inv_sn: ∀p,F,G. F Ⓡ↦[p] G → ∀q. sn::q = p → + ∃∃b,V1,V2,T. V1 Ⓡ↦[q] V2 & {b}@V1.T = F & {⊥}@V2.{⊥}⇕T = G. +#p #F #G * -p -F -G +[ #V #T #q #H destruct +| #b #p #T1 #T2 #_ #q #H destruct +| #b #p #V1 #V2 #T #HV12 #q #H destruct /2 width=7/ +| #b #p #V #T1 #T2 #_ #q #H destruct +] +qed-. + +lemma pl_st_inv_dx: ∀p,F,G. F Ⓡ↦[p] G → ∀q. dx::q = p → + ∃∃b,V,T1,T2. T1 Ⓡ↦[q] T2 & {b}@V.T1 = F & {b}@V.T2 = G. +#p #F #G * -p -F -G +[ #V #T #q #H destruct +| #b #p #T1 #T2 #_ #q #H destruct +| #b #p #V1 #V2 #T #_ #q #H destruct +| #b #p #V #T1 #T2 #HT12 #q #H destruct /2 width=7/ +] +qed-. + +lemma pl_st_inv_pl_sred: ∀p. in_whd p → ∀M1,F2. {⊤}⇑M1 Ⓡ↦[p] F2 → + ∃∃M2. M1 ↦[p] M2 & {⊤}⇑M2 = F2. +#p @(in_whd_ind … p) -p +[ #M1 #F2 #H + elim (pl_st_inv_nil … H …) -H // #V #T #HM1 #H + elim (boolean_inv_appl … (sym_eq … HM1)) -HM1 #B #N #_ #HB #HN #HM1 + elim (boolean_inv_abst … HN) -HN #A #_ #HA #HN destruct /2 width=3/ +| #p #_ #IHp #M1 #F2 #H + elim (pl_st_inv_dx … H …) -H [3: // |2:skip ] #b #V #T1 #T2 #HT12 #HM1 #H (**) (* simplify line *) + elim (boolean_inv_appl … (sym_eq … HM1)) -HM1 #B #A #Hb #HB #HA #HM1 destruct + elim (IHp … HT12) -IHp -HT12 #C #HAC #H destruct + @(ex2_intro … (@B.C)) // /2 width=1/ (**) (* auto needs some help here *) +] +qed-. + +lemma pl_st_lift: ∀p. sliftable (pl_st p). +#p #h #F1 #F2 #H elim H -p -F1 -F2 /2 width=1/ +[ #V #T #d normalize sdsubst_sdsubst_ge // +| #b #p #V1 #V2 #T #_ #IHV12 #d + whd in ⊢ (??%%); <(booleanized_booleanized ⊥) in ⊢ (???(???%)); ${MA}.new + if diff ${MA} ${MA}.new > /dev/null; + then rm -f ${MA}.new; + else mv -f ${MA} ${MA}.old; mv -f ${MA}.new ${MA}; + fi +done + +unset MA diff --git a/matita/matita/lib/lambda/subterms/boolean.ma b/matita/matita/lib/lambda/subterms/boolean.ma new file mode 100644 index 000000000..f49b23b29 --- /dev/null +++ b/matita/matita/lib/lambda/subterms/boolean.ma @@ -0,0 +1,73 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "subterms/carrier.ma". + +(* BOOLEAN (EMPTY OR FULL) SUBSET *******************************************) + +let rec boolean b M on M ≝ match M with +[ VRef i ⇒ {b}#i +| Abst A ⇒ {b}𝛌.(boolean b A) +| Appl B A ⇒ {b}@(boolean b B).(boolean b A) +]. + +interpretation "boolean subset (subterms)" + 'ProjectUp b M = (boolean b M). + +notation "hvbox( { term 46 b } ⇑ break term 46 M)" + non associative with precedence 46 + for @{ 'ProjectUp $b $M }. + +lemma boolean_inv_vref: ∀j,c,b,M. {b}⇑ M = {c}#j → b = c ∧ M = #j. +#j #c #b * normalize +[ #i #H destruct /2 width=1/ +| #A #H destruct +| #B #A #H destruct +] +qed-. + +lemma boolean_inv_abst: ∀U,c,b,M. {b}⇑ M = {c}𝛌.U → + ∃∃C. b = c & {b}⇑C = U & M = 𝛌.C. +#U #c #b * normalize +[ #i #H destruct +| #A #H destruct /2 width=3/ +| #B #A #H destruct +] +qed-. + +lemma boolean_inv_appl: ∀W,U,c,b,M. {b}⇑ M = {c}@W.U → + ∃∃D,C. b = c & {b}⇑D = W & {b}⇑C = U & M = @D.C. +#W #U #c #b * normalize +[ #i #H destruct +| #A #H destruct +| #B #A #H destruct /2 width=5/ +] +qed-. + +lemma boolean_lift: ∀b,h,M,d. {b}⇑ ↑[d, h] M = ↑[d, h] {b}⇑ M. +#b #h #M elim M -M normalize // +qed. + +lemma boolean_dsubst: ∀b,N,M,d. {b}⇑ [d ↙ N] M = [d ↙ {b}⇑ N] {b}⇑ M. +#b #N #M elim M -M [2,3: normalize // ] +#i #d elim (lt_or_eq_or_gt i d) #Hid +[ >(sdsubst_vref_lt … Hid) >(dsubst_vref_lt … Hid) // +| destruct normalize // +| >(sdsubst_vref_gt … Hid) >(dsubst_vref_gt … Hid) // +] +qed. + +lemma carrier_boolean: ∀b,M. ⇓ {b}⇑ M = M. +#b #M elim M -M normalize // +qed. diff --git a/matita/matita/lib/lambda/subterms/booleanized.ma b/matita/matita/lib/lambda/subterms/booleanized.ma new file mode 100644 index 000000000..b3258d224 --- /dev/null +++ b/matita/matita/lib/lambda/subterms/booleanized.ma @@ -0,0 +1,60 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "subterms/boolean.ma". + +(* BOOLEANIZED SUBSET (EMPTY OR FULL) ***************************************) + +definition booleanized: bool → subterms → subterms ≝ + λb,F. {b}⇑⇓F. + +interpretation "booleanized (subterms)" + 'ProjectSame b F = (booleanized b F). + +notation "hvbox( { term 46 b } ⇕ break term 46 F)" + non associative with precedence 46 + for @{ 'ProjectSame $b $F }. + +lemma booleanized_inv_vref: ∀j,c,b,F. {b}⇕ F = {c}#j → + ∃∃b1. b = c & F = {b1}#j. +#j #c #b #F #H +elim (boolean_inv_vref … H) -H #H0 #H +elim (carrier_inv_vref … H) -H /2 width=2/ +qed-. + +lemma booleanized_inv_abst: ∀U,c,b,F. {b}⇕ F = {c}𝛌.U → + ∃∃b1,T. b = c & {b}⇕T = U & F = {b1}𝛌.T. +#U #c #b #F #H +elim (boolean_inv_abst … H) -H #C #H0 #H1 #H +elim (carrier_inv_abst … H) -H #b1 #U1 #H3 destruct /2 width=4/ +qed-. + +lemma booleanized_inv_appl: ∀W,U,c,b,F. {b}⇕ F = {c}@W.U → + ∃∃b1,V,T. b = c & {b}⇕V = W & {b}⇕T = U & F = {b1}@V.T. +#W #U #c #b #F #H +elim (boolean_inv_appl … H) -H #D #C #H0 #H1 #H2 #H +elim (carrier_inv_appl … H) -H #b1 #W1 #U1 #H3 #H4 destruct /2 width=6/ +qed-. + +lemma booleanized_booleanized: ∀c,b,F. {b}⇕ {c}⇕ F = {b}⇕ F. +normalize // +qed. + +lemma booleanized_lift: ∀b,h,F,d. {b}⇕ ↑[d, h] F = ↑[d, h] {b}⇕ F. +normalize // +qed. + +lemma booleanized_dsubst: ∀b,G,F,d. {b}⇕ [d ↙ G] F = [d ↙ {b}⇕ G] {b}⇕ F. +normalize // +qed. diff --git a/matita/matita/lib/lambda/subterms/carrier.ma b/matita/matita/lib/lambda/subterms/carrier.ma new file mode 100644 index 000000000..8936792e2 --- /dev/null +++ b/matita/matita/lib/lambda/subterms/carrier.ma @@ -0,0 +1,69 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "terms/relocating_substitution.ma". +include "subterms/relocating_substitution.ma". + +(* CARRIER (UNDERLYING TERM) ************************************************) + +let rec carrier F on F ≝ match F with +[ SVRef _ i ⇒ #i +| SAbst _ T ⇒ 𝛌.(carrier T) +| SAppl _ V T ⇒ @(carrier V).(carrier T) +]. + +interpretation "carrier (subterms)" + 'ProjectDown F = (carrier F). + +notation "hvbox(⇓ term 46 F)" + non associative with precedence 46 + for @{ 'ProjectDown $F }. + +lemma carrier_inv_vref: ∀j,F. ⇓F = #j → ∃b. F = {b}#j. +#j * normalize +[ #b #i #H destruct /2 width=2/ +| #b #T #H destruct +| #b #V #T #H destruct +] +qed-. + +lemma carrier_inv_abst: ∀C,F. ⇓F = 𝛌.C → ∃∃b,U. ⇓U = C & F = {b}𝛌.U. +#C * normalize +[ #b #i #H destruct +| #b #T #H destruct /2 width=4/ +| #b #V #T #H destruct +] +qed-. + +lemma carrier_inv_appl: ∀D,C,F. ⇓F = @D.C → + ∃∃b,W,U. ⇓W = D & ⇓U = C & F = {b}@W.U. +#D #C * normalize +[ #b #i #H destruct +| #b #T #H destruct +| #b #V #T #H destruct /2 width=6/ +] +qed-. + +lemma carrier_lift: ∀h,F,d. ⇓ ↑[d, h] F = ↑[d, h] ⇓F. +#h #F elim F -F normalize // +qed. + +lemma carrier_dsubst: ∀G,F,d. ⇓ [d ↙ G] F = [d ↙ ⇓G] ⇓F. +#G #F elim F -F [2,3: normalize // ] +#b #i #d elim (lt_or_eq_or_gt i d) #Hid +[ >(sdsubst_vref_lt … Hid) >(dsubst_vref_lt … Hid) // +| destruct normalize // +| >(sdsubst_vref_gt … Hid) >(dsubst_vref_gt … Hid) // +] +qed. diff --git a/matita/matita/lib/lambda/subterms/relocating_substitution.ma b/matita/matita/lib/lambda/subterms/relocating_substitution.ma new file mode 100644 index 000000000..af5efe023 --- /dev/null +++ b/matita/matita/lib/lambda/subterms/relocating_substitution.ma @@ -0,0 +1,164 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "subterms/relocation.ma". + +(* RELOCATING SUBSTITUTION **************************************************) + +(* Policy: depth (level) metavariables: d, e (as for lift) *) +let rec sdsubst G d F on F ≝ match F with +[ SVRef b i ⇒ tri … i d ({b}#i) (↑[i] G) ({b}#(i-1)) +| SAbst b T ⇒ {b}𝛌. (sdsubst G (d+1) T) +| SAppl b V T ⇒ {b}@ (sdsubst G d V). (sdsubst G d T) +]. + +interpretation "relocating substitution for subterms" + 'DSubst G d F = (sdsubst G d F). + +lemma sdsubst_vref_lt: ∀b,i,d,G. i < d → [d ↙ G] {b}#i = {b}#i. +normalize /2 width=1/ +qed. + +lemma sdsubst_vref_eq: ∀b,i,G. [i ↙ G] {b}#i = ↑[i]G. +normalize // +qed. + +lemma sdsubst_vref_gt: ∀b,i,d,G. d < i → [d ↙ G] {b}#i = {b}#(i-1). +normalize /2 width=1/ +qed. + +theorem sdsubst_slift_le: ∀h,G,F,d1,d2. d2 ≤ d1 → + [d2 ↙ ↑[d1 - d2, h] G] ↑[d1 + 1, h] F = ↑[d1, h] [d2 ↙ G] F. +#h #G #F elim F -F +[ #b #i #d1 #d2 #Hd21 elim (lt_or_eq_or_gt i d2) #Hid2 + [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 #Hid1 + >(sdsubst_vref_lt … Hid2) >(slift_vref_lt … Hid1) >slift_vref_lt /2 width=1/ + | destruct >sdsubst_vref_eq >slift_vref_lt /2 width=1/ + | >(sdsubst_vref_gt … Hid2) -Hd21 elim (lt_or_ge (i-1) d1) #Hi1d1 + [ >(slift_vref_lt … Hi1d1) >slift_vref_lt /2 width=1/ + | lapply (ltn_to_ltO … Hid2) #Hi + >(slift_vref_ge … Hi1d1) >slift_vref_ge /2 width=1/ -Hi1d1 >plus_minus // /3 width=1/ + ] + ] +| normalize #b #T #IHT #d1 #d2 #Hd21 + lapply (IHT (d1+1) (d2+1) ?) -IHT /2 width=1/ +| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd21 + >IHV -IHV // >IHT -IHT // +] +qed. + +theorem sdsubst_slift_be: ∀h,G,F,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h → + [d2 ↙ G] ↑[d1, h + 1] F = ↑[d1, h] F. +#h #G #F elim F -F +[ #b #i #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 + [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 + >(slift_vref_lt … Hid1) >(slift_vref_lt … Hid1) /2 width=1/ + | lapply (transitive_le … (i+h) Hd21 ?) -Hd12 -Hd21 /2 width=1/ #Hd2 + >(slift_vref_ge … Hid1) >(slift_vref_ge … Hid1) -Hid1 + >sdsubst_vref_gt // /2 width=1/ + ] +| normalize #b #T #IHT #d1 #d2 #Hd12 #Hd21 + >IHT -IHT // /2 width=1/ +| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd12 #Hd21 + >IHV -IHV // >IHT -IHT // +] +qed. + +theorem sdsubst_slift_ge: ∀h,G,F,d1,d2. d1 + h ≤ d2 → + [d2 ↙ G] ↑[d1, h] F = ↑[d1, h] [d2 - h ↙ G] F. +#h #G #F elim F -F +[ #b #i #d1 #d2 #Hd12 elim (lt_or_eq_or_gt i (d2-h)) #Hid2h + [ >(sdsubst_vref_lt … Hid2h) elim (lt_or_ge i d1) #Hid1 + [ lapply (lt_to_le_to_lt … (d1+h) Hid1 ?) -Hid2h // #Hid1h + lapply (lt_to_le_to_lt … Hid1h Hd12) -Hid1h -Hd12 #Hid2 + >(slift_vref_lt … Hid1) -Hid1 /2 width=1/ + | >(slift_vref_ge … Hid1) -Hid1 -Hd12 /3 width=1/ + ] + | destruct elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #Hhd2 + >sdsubst_vref_eq >slift_vref_ge // >slift_slift_be // (sdsubst_vref_gt … Hid2h) + >slift_vref_ge /2 width=1/ >slift_vref_ge /2 width=1/ -Hid1 + >sdsubst_vref_gt /2 width=1/ -Hid2h >plus_minus // + ] +| normalize #b #T #IHT #d1 #d2 #Hd12 + elim (le_inv_plus_l … Hd12) #_ #Hhd2 + >IHT -IHT /2 width=1/ IHV -IHV // >IHT -IHT // +] +qed. + +theorem sdsubst_sdsubst_ge: ∀G1,G2,F,d1,d2. d1 ≤ d2 → + [d2 ↙ G2] [d1 ↙ G1] F = [d1 ↙ [d2 - d1 ↙ G2] G1] [d2 + 1 ↙ G2] F. +#G1 #G2 #F elim F -F +[ #b #i #d1 #d2 #Hd12 elim (lt_or_eq_or_gt i d1) #Hid1 + [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 + >(sdsubst_vref_lt … Hid1) >(sdsubst_vref_lt … Hid2) >sdsubst_vref_lt /2 width=1/ + | destruct >sdsubst_vref_eq >sdsubst_vref_lt /2 width=1/ + | >(sdsubst_vref_gt … Hid1) elim (lt_or_eq_or_gt i (d2+1)) #Hid2 + [ lapply (ltn_to_ltO … Hid1) #Hi + >(sdsubst_vref_lt … Hid2) >sdsubst_vref_lt /2 width=1/ + | destruct /2 width=1/ + | lapply (le_to_lt_to_lt (d1+1) … Hid2) -Hid1 /2 width=1/ -Hd12 #Hid1 + >(sdsubst_vref_gt … Hid2) >sdsubst_vref_gt /2 width=1/ + >sdsubst_vref_gt // /2 width=1/ + ] + ] +| normalize #b #T #IHT #d1 #d2 #Hd12 + lapply (IHT (d1+1) (d2+1) ?) -IHT /2 width=1/ +| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd12 + >IHV -IHV // >IHT -IHT // +] +qed. + +theorem sdsubst_sdsubst_lt: ∀G1,G2,F,d1,d2. d2 < d1 → + [d2 ↙ [d1 - d2 -1 ↙ G1] G2] [d1 ↙ G1] F = [d1 - 1 ↙ G1] [d2 ↙ G2] F. +#G1 #G2 #F #d1 #d2 #Hd21 +lapply (ltn_to_ltO … Hd21) #Hd1 +>sdsubst_sdsubst_ge in ⊢ (???%); /2 width=1/ (tri_lt ???? … Hid) -Hid -Hjd // + | #H destruct >tri_eq in Hjd; #H + elim (plus_lt_false … H) + | >(tri_gt ???? … Hid) + lapply (transitive_lt … Hjd Hid) -d #H #H0 destruct + elim (plus_lt_false … H) + ] +| #b #T #H destruct +| #b #V #T #H destruct +] +qed. + +lemma slift_inv_vref_ge: ∀c,j,d. d ≤ j → ∀h,E. ↑[d, h] E = {c}#j → + d + h ≤ j ∧ E = {c}#(j-h). +#c #j #d #Hdj #h * normalize +[ #b #i elim (lt_or_eq_or_gt i d) #Hid + [ >(tri_lt ???? … Hid) #H destruct + lapply (le_to_lt_to_lt … Hdj Hid) -Hdj -Hid #H + elim (lt_refl_false … H) + | #H -Hdj destruct /2 width=1/ + | >(tri_gt ???? … Hid) #H -Hdj destruct /4 width=1/ + ] +| #b #T #H destruct +| #b #V #T #H destruct +] +qed-. + +lemma slift_inv_vref_be: ∀c,j,d,h. d ≤ j → j < d + h → ∀E. ↑[d, h] E = {c}#j → ⊥. +#c #j #d #h #Hdj #Hjdh #E #H elim (slift_inv_vref_ge … H) -H // -Hdj #Hdhj #_ -E +lapply (lt_to_le_to_lt … Hjdh Hdhj) -d -h #H +elim (lt_refl_false … H) +qed-. + +lemma slift_inv_vref_ge_plus: ∀c,j,d,h. d + h ≤ j → + ∀E. ↑[d, h] E = {c}#j → E = {c}#(j-h). +#c #j #d #h #Hdhj #E #H elim (slift_inv_vref_ge … H) -H // -E /2 width=2/ +qed. + +lemma slift_inv_abst: ∀c,U,d,h,E. ↑[d, h] E = {c}𝛌.U → + ∃∃T. ↑[d+1, h] T = U & E = {c}𝛌.T. +#c #U #d #h * normalize +[ #b #i #H destruct +| #b #T #H destruct /2 width=3/ +| #b #V #T #H destruct +] +qed-. + +lemma slift_inv_appl: ∀c,W,U,d,h,E. ↑[d, h] E = {c}@W.U → + ∃∃V,T. ↑[d, h] V = W & ↑[d, h] T = U & E = {c}@V.T. +#c #W #U #d #h * normalize +[ #b #i #H destruct +| #b #T #H destruct +| #b #V #T #H destruct /2 width=5/ +] +qed-. + +theorem slift_slift_le: ∀h1,h2,E,d1,d2. d2 ≤ d1 → + ↑[d2, h2] ↑[d1, h1] E = ↑[d1 + h2, h1] ↑[d2, h2] E. +#h1 #h2 #E elim E -E +[ #b #i #d1 #d2 #Hd21 elim (lt_or_ge i d2) #Hid2 + [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 #Hid1 + >(slift_vref_lt … Hid1) >(slift_vref_lt … Hid2) + >slift_vref_lt // /2 width=1/ + | >(slift_vref_ge … Hid2) elim (lt_or_ge i d1) #Hid1 + [ >(slift_vref_lt … Hid1) >(slift_vref_ge … Hid2) + >slift_vref_lt // -d2 /2 width=1/ + | >(slift_vref_ge … Hid1) >slift_vref_ge /2 width=1/ + >slift_vref_ge // /2 width=1/ + ] + ] +| normalize #b #T #IHT #d1 #d2 #Hd21 >IHT // /2 width=1/ +| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd21 >IHV >IHT // +] +qed. + +theorem slift_slift_be: ∀h1,h2,E,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h1 → + ↑[d2, h2] ↑[d1, h1] E = ↑[d1, h1 + h2] E. +#h1 #h2 #E elim E -E +[ #b #i #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 + [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 + >(slift_vref_lt … Hid1) >(slift_vref_lt … Hid1) /2 width=1/ + | lapply (transitive_le … (i+h1) Hd21 ?) -Hd21 -Hd12 /2 width=1/ #Hd2 + >(slift_vref_ge … Hid1) >(slift_vref_ge … Hid1) /2 width=1/ + ] +| normalize #b #T #IHT #d1 #d2 #Hd12 #Hd21 >IHT // /2 width=1/ +| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd12 #Hd21 >IHV >IHT // +] +qed. + +theorem slift_slift_ge: ∀h1,h2,E,d1,d2. d1 + h1 ≤ d2 → + ↑[d2, h2] ↑[d1, h1] E = ↑[d1, h1] ↑[d2 - h1, h2] E. +#h1 #h2 #E #d1 #d2 #Hd12 +>(slift_slift_le h2 h1) /2 width=1/ (slift_vref_lt … Hid) in H; #H + >(slift_inv_vref_lt … Hid … H) -E2 -d -h // + | >(slift_vref_ge … Hid) in H; #H + >(slift_inv_vref_ge_plus … H) -E2 // /2 width=1/ + ] +| normalize #b #T1 #IHT1 #E2 #d #H + elim (slift_inv_abst … H) -H #T2 #HT12 #H destruct + >(IHT1 … HT12) -IHT1 -T2 // +| normalize #b #V1 #T1 #IHV1 #IHT1 #E2 #d #H + elim (slift_inv_appl … H) -H #V2 #T2 #HV12 #HT12 #H destruct + >(IHV1 … HV12) -IHV1 -V2 >(IHT1 … HT12) -IHT1 -T2 // +] +qed-. + +theorem slift_inv_slift_le: ∀h1,h2,E1,E2,d1,d2. d2 ≤ d1 → + ↑[d2, h2] E2 = ↑[d1 + h2, h1] E1 → + ∃∃E. ↑[d1, h1] E = E2 & ↑[d2, h2] E = E1. +#h1 #h2 #E1 elim E1 -E1 +[ #b #i #E2 #d1 #d2 #Hd21 elim (lt_or_ge i (d1+h2)) #Hid1 + [ >(slift_vref_lt … Hid1) elim (lt_or_ge i d2) #Hid2 #H + [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 -Hid1 #Hid1 + >(slift_inv_vref_lt … Hid2 … H) -E2 /3 width=3/ + | elim (slift_inv_vref_ge … H) -H -Hd21 // -Hid2 #Hdh2i #H destruct + elim (le_inv_plus_l … Hdh2i) -Hdh2i #Hd2i #Hh2i + @(ex2_intro … ({b}#(i-h2))) [ /4 width=1/ ] -Hid1 + >slift_vref_ge // -Hd2i /3 width=1/ (**) (* auto: needs some help here *) + ] + | elim (le_inv_plus_l … Hid1) #Hd1i #Hh2i + lapply (transitive_le (d2+h2) … Hid1) /2 width=1/ -Hd21 #Hdh2i + elim (le_inv_plus_l … Hdh2i) #Hd2i #_ + >(slift_vref_ge … Hid1) #H -Hid1 + >(slift_inv_vref_ge_plus … H) -H /2 width=3/ -Hdh2i + @(ex2_intro … ({b}#(i-h2))) (**) (* auto: needs some help here *) + [ >slift_vref_ge // -Hd1i /3 width=1/ + | >slift_vref_ge // -Hd2i -Hd1i /3 width=1/ + ] + ] +| normalize #b #T1 #IHT1 #E2 #d1 #d2 #Hd21 #H + elim (slift_inv_abst … H) -H >plus_plus_comm_23 #T2 #HT12 #H destruct + elim (IHT1 … HT12) -IHT1 -HT12 /2 width=1/ -Hd21 #T #HT2 #HT1 + @(ex2_intro … ({b}𝛌.T)) normalize // +| normalize #b #V1 #T1 #IHV1 #IHT1 #E2 #d1 #d2 #Hd21 #H + elim (slift_inv_appl … H) -H #V2 #T2 #HV12 #HT12 #H destruct + elim (IHV1 … HV12) -IHV1 -HV12 // #V #HV2 #HV1 + elim (IHT1 … HT12) -IHT1 -HT12 // -Hd21 #T #HT2 #HT1 + @(ex2_intro … ({b}@V.T)) normalize // +] +qed-. + +theorem slift_inv_slift_be: ∀h1,h2,E1,E2,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h1 → + ↑[d2, h2] E2 = ↑[d1, h1 + h2] E1 → ↑[d1, h1] E1 = E2. +#h1 #h2 #E1 elim E1 -E1 +[ #b #i #E2 #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 + [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 + >(slift_vref_lt … Hid1) #H >(slift_inv_vref_lt … Hid2 … H) -h2 -E2 -d2 /2 width=1/ + | lapply (transitive_le … (i+h1) Hd21 ?) -Hd12 -Hd21 /2 width=1/ #Hd2 + >(slift_vref_ge … Hid1) #H >(slift_inv_vref_ge_plus … H) -E2 /2 width=1/ + ] +| normalize #b #T1 #IHT1 #E2 #d1 #d2 #Hd12 #Hd21 #H + elim (slift_inv_abst … H) -H #T #HT12 #H destruct + >(IHT1 … HT12) -IHT1 -HT12 // /2 width=1/ +| normalize #b #V1 #T1 #IHV1 #IHT1 #E2 #d1 #d2 #Hd12 #Hd21 #H + elim (slift_inv_appl … H) -H #V #T #HV12 #HT12 #H destruct + >(IHV1 … HV12) -IHV1 -HV12 // >(IHT1 … HT12) -IHT1 -HT12 // +] +qed-. + +theorem slift_inv_slift_ge: ∀h1,h2,E1,E2,d1,d2. d1 + h1 ≤ d2 → + ↑[d2, h2] E2 = ↑[d1, h1] E1 → + ∃∃E. ↑[d1, h1] E = E2 & ↑[d2 - h1, h2] E = E1. +#h1 #h2 #E1 #E2 #d1 #d2 #Hd12 #H +elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #Hh1d2 +lapply (sym_eq subterms … H) -H >(plus_minus_m_m … Hh1d2) in ⊢ (???%→?); -Hh1d2 #H +elim (slift_inv_slift_le … Hd12 … H) -H -Hd12 /2 width=3/ +qed-. + +definition sliftable: predicate (relation subterms) ≝ λR. + ∀h,F1,F2. R F1 F2 → ∀d. R (↑[d, h] F1) (↑[d, h] F2). + +definition sdeliftable_sn: predicate (relation subterms) ≝ λR. + ∀h,G1,G2. R G1 G2 → ∀d,F1. ↑[d, h] F1 = G1 → + ∃∃F2. R F1 F2 & ↑[d, h] F2 = G2. +(* +lemma star_sliftable: ∀R. sliftable R → sliftable (star … R). +#R #HR #h #F1 #F2 #H elim H -F2 // /3 width=3/ +qed. + +lemma star_deliftable_sn: ∀R. sdeliftable_sn R → sdeliftable_sn (star … R). +#R #HR #h #G1 #G2 #H elim H -G2 /2 width=3/ +#G #G2 #_ #HG2 #IHG1 #d #F1 #HFG1 +elim (IHG1 … HFG1) -G1 #F #HF1 #HFG +elim (HR … HG2 … HFG) -G /3 width=3/ +qed-. +*) +lemma lstar_sliftable: ∀S,R. (∀a. sliftable (R a)) → + ∀l. sliftable (lstar S … R l). +#S #R #HR #l #h #F1 #F2 #H +@(lstar_ind_l … l F1 H) -l -F1 // /3 width=3/ +qed. + +lemma lstar_sdeliftable_sn: ∀S,R. (∀a. sdeliftable_sn (R a)) → + ∀l. sdeliftable_sn (lstar S … R l). +#S #R #HR #l #h #G1 #G2 #H +@(lstar_ind_l … l G1 H) -l -G1 /2 width=3/ +#a #l #G1 #G #HG1 #_ #IHG2 #d #F1 #HFG1 +elim (HR … HG1 … HFG1) -G1 #F #HF1 #HFG +elim (IHG2 … HFG) -G /3 width=3/ +qed-. diff --git a/matita/matita/lib/lambda/subterms/subterms.ma b/matita/matita/lib/lambda/subterms/subterms.ma new file mode 100644 index 000000000..6c75a3f4c --- /dev/null +++ b/matita/matita/lib/lambda/subterms/subterms.ma @@ -0,0 +1,68 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "background/preamble.ma". + +(* SUBSETS OF SUBTERMS ******************************************************) + +(* Policy: boolean marks metavariables: b,c + subterms metavariables: F,G,T,U,V,W +*) +(* Note: each subterm is marked with true if it belongs to the subset *) +inductive subterms: Type[0] ≝ +| SVRef: bool → nat → subterms +| SAbst: bool → subterms → subterms +| SAppl: bool → subterms → subterms → subterms +. + +interpretation "subterms construction (variable reference by index)" + 'VariableReferenceByIndex b i = (SVRef b i). + +interpretation "subterms construction (abstraction)" + 'Abstraction b T = (SAbst b T). + +interpretation "subterms construction (application)" + 'Application b V T = (SAppl b V T). + +(* +definition compatible_abst: predicate (relation term) ≝ λR. + ∀A1,A2. R A1 A2 → R (𝛌.A1) (𝛌.A2). + +definition compatible_sn: predicate (relation term) ≝ λR. + ∀A,B1,B2. R B1 B2 → R (@B1.A) (@B2.A). + +definition compatible_dx: predicate (relation term) ≝ λR. + ∀B,A1,A2. R A1 A2 → R (@B.A1) (@B.A2). + +definition compatible_appl: predicate (relation term) ≝ λR. + ∀B1,B2. R B1 B2 → ∀A1,A2. R A1 A2 → + R (@B1.A1) (@B2.A2). + +lemma star_compatible_abst: ∀R. compatible_abst R → compatible_abst (star … R). +#R #HR #A1 #A2 #H elim H -A2 // /3 width=3/ +qed. + +lemma star_compatible_sn: ∀R. compatible_sn R → compatible_sn (star … R). +#R #HR #A #B1 #B2 #H elim H -B2 // /3 width=3/ +qed. + +lemma star_compatible_dx: ∀R. compatible_dx R → compatible_dx (star … R). +#R #HR #B #A1 #A2 #H elim H -A2 // /3 width=3/ +qed. + +lemma star_compatible_appl: ∀R. reflexive ? R → + compatible_appl R → compatible_appl (star … R). +#R #H1R #H2R #B1 #B2 #H elim H -B2 /3 width=1/ /3 width=5/ +qed. +*) diff --git a/matita/matita/lib/lambda/terms/labeled_sequential_computation.ma b/matita/matita/lib/lambda/terms/labeled_sequential_computation.ma new file mode 100644 index 000000000..2287c6b81 --- /dev/null +++ b/matita/matita/lib/lambda/terms/labeled_sequential_computation.ma @@ -0,0 +1,46 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "terms/sequential_computation.ma". + +(* ABSTRACT LABELED SEQUENTIAL COMPUTATION (MULTISTEP) **********************) + +definition l_sreds: ∀S. (S→relation term) → list S → relation term ≝ + λS,R. lstar … R. + +lemma sreds_l_sreds: ∀S,R. (∀M,N. M ↦ N → ∃a. R a M N) → + ∀M,N. M ↦* N → ∃l. l_sreds S R l M N. +#S #R #HR #M #N #H elim H -N +[ #N #N0 #_ #HN0 * #l #HMN + elim (HR … HN0) -HR -HN0 /3 width=5/ +| /2 width=2/ +] +qed-. + +lemma l_sreds_inv_sreds: ∀S,R. (∀a,M,N. R a M N → M ↦ N) → + ∀l,M,N. l_sreds S R l M N → M ↦* N. +#S #R #HR #l #M #N #H elim H -N // /3 by star_compl/ +qed-. + +(* Note: "|s|" should be unparetesized *) +lemma l_sreds_fwd_mult: ∀S,R. (∀a,M,N. R a M N → M ↦ N) → + ∀l,M1,M2. l_sreds S R l M1 M2 → + ♯{M2} ≤ ♯{M1} ^ (2 ^ (|l|)). +#S #R #HR #l #M1 #M2 #H @(lstar_ind_l … l M1 H) -l -M1 normalize // +#a #l #M1 #M #HM1 #_ #IHM2 +lapply (HR … HM1) -HR -a #HM1 +lapply (sred_fwd_mult … HM1) #HM1 +@(transitive_le … IHM2) -M2 +/3 width=1 by le_exp1, lt_O_exp, lt_to_le/ (**) (* auto: slow without trace *) +qed-. diff --git a/matita/matita/lib/lambda/terms/multiplicity.ma b/matita/matita/lib/lambda/terms/multiplicity.ma new file mode 100644 index 000000000..4f41b75db --- /dev/null +++ b/matita/matita/lib/lambda/terms/multiplicity.ma @@ -0,0 +1,52 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "terms/relocating_substitution.ma". + +(* MULTIPLICITY *************************************************************) + +(* Note: this gives the number of variable references in M *) +let rec mult M on M ≝ match M with +[ VRef i ⇒ 1 +| Abst A ⇒ mult A +| Appl B A ⇒ (mult B) + (mult A) +]. + +interpretation "term multiplicity" + 'Multiplicity M = (mult M). + +notation "hvbox( ♯{ term 46 M } )" + non associative with precedence 90 + for @{ 'Multiplicity $M }. + +lemma mult_positive: ∀M. 0 < ♯{M}. +#M elim M -M // /2 width=1/ +qed. + +lemma mult_lift: ∀h,M,d. ♯{↑[d, h] M} = ♯{M}. +#h #M elim M -M normalize // +qed. + +theorem mult_dsubst: ∀D,M,d. ♯{[d ↙ D] M} ≤ ♯{M} * ♯{D}. +#D #M elim M -M +[ #i #d elim (lt_or_eq_or_gt i d) #Hid + [ >(dsubst_vref_lt … Hid) normalize // + | destruct >dsubst_vref_eq normalize // + | >(dsubst_vref_gt … Hid) normalize // + ] +| normalize // +| normalize #B #A #IHB #IHA #d + >distributive_times_plus_r /2 width=1/ +] +qed. diff --git a/matita/matita/lib/lambda/terms/parallel_computation.ma b/matita/matita/lib/lambda/terms/parallel_computation.ma new file mode 100644 index 000000000..3b048d133 --- /dev/null +++ b/matita/matita/lib/lambda/terms/parallel_computation.ma @@ -0,0 +1,83 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "terms/parallel_reduction.ma". + +(* PARALLEL COMPUTATION (MULTISTEP) *****************************************) + +definition preds: relation term ≝ star … pred. + +interpretation "parallel computation" + 'ParRedStar M N = (preds M N). + +lemma preds_refl: reflexive … preds. +// +qed. + +lemma preds_step_sn: ∀M1,M. M1 ⤇ M → ∀M2. M ⤇* M2 → M1 ⤇* M2. +/2 width=3/ +qed-. + +lemma preds_step_dx: ∀M1,M. M1 ⤇* M → ∀M2. M ⤇ M2 → M1 ⤇* M2. +/2 width=3/ +qed-. + +lemma preds_step_rc: ∀M1,M2. M1 ⤇ M2 → M1 ⤇* M2. +/2 width=1/ +qed. + +lemma preds_compatible_abst: compatible_abst preds. +/3 width=1/ +qed. + +lemma preds_compatible_sn: compatible_sn preds. +/3 width=1/ +qed. + +lemma preds_compatible_dx: compatible_dx preds. +/3 width=1/ +qed. + +lemma preds_compatible_appl: compatible_appl preds. +/3 width=1/ +qed. + +lemma preds_lift: liftable preds. +/2 width=1/ +qed. + +lemma preds_inv_lift: deliftable_sn preds. +/3 width=3 by star_deliftable_sn, pred_inv_lift/ +qed-. + +lemma preds_dsubst_dx: dsubstable_dx preds. +/2 width=1/ +qed. + +lemma preds_dsubst: dsubstable preds. +/2 width=1/ +qed. + +theorem preds_trans: transitive … preds. +/2 width=3 by trans_star/ +qed-. + +lemma preds_strip: ∀M0,M1. M0 ⤇* M1 → ∀M2. M0 ⤇ M2 → + ∃∃M. M1 ⤇ M & M2 ⤇* M. +/3 width=3 by star_strip, pred_conf/ +qed-. + +theorem preds_conf: confluent … preds. +/3 width=3 by star_confluent, pred_conf/ +qed-. diff --git a/matita/matita/lib/lambda/terms/parallel_reduction.ma b/matita/matita/lib/lambda/terms/parallel_reduction.ma new file mode 100644 index 000000000..b54c4bc57 --- /dev/null +++ b/matita/matita/lib/lambda/terms/parallel_reduction.ma @@ -0,0 +1,152 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "terms/size.ma". +include "terms/sequential_reduction.ma". + +(* PARALLEL REDUCTION (SINGLE STEP) *****************************************) + +(* Note: the application "(A B)" is represented by "@B.A" + as for sequential reduction +*) +inductive pred: relation term ≝ +| pred_vref: ∀i. pred (#i) (#i) +| pred_abst: ∀A1,A2. pred A1 A2 → pred (𝛌.A1) (𝛌.A2) +| pred_appl: ∀B1,B2,A1,A2. pred B1 B2 → pred A1 A2 → pred (@B1.A1) (@B2.A2) +| pred_beta: ∀B1,B2,A1,A2. pred B1 B2 → pred A1 A2 → pred (@B1.𝛌.A1) ([↙B2]A2) +. + +interpretation "parallel reduction" + 'ParRed M N = (pred M N). + +lemma pred_refl: reflexive … pred. +#M elim M -M // /2 width=1/ +qed. + +lemma pred_inv_vref: ∀M,N. M ⤇ N → ∀i. #i = M → #i = N. +#M #N * -M -N // +[ #A1 #A2 #_ #i #H destruct +| #B1 #B2 #A1 #A2 #_ #_ #i #H destruct +| #B1 #B2 #A1 #A2 #_ #_ #i #H destruct +] +qed-. + +lemma pred_inv_abst: ∀M,N. M ⤇ N → ∀A. 𝛌.A = M → + ∃∃C. A ⤇ C & 𝛌.C = N. +#M #N * -M -N +[ #i #A0 #H destruct +| #A1 #A2 #HA12 #A0 #H destruct /2 width=3/ +| #B1 #B2 #A1 #A2 #_ #_ #A0 #H destruct +| #B1 #B2 #A1 #A2 #_ #_ #A0 #H destruct +] +qed-. + +lemma pred_inv_appl: ∀M,N. M ⤇ N → ∀B,A. @B.A = M → + (∃∃D,C. B ⤇ D & A ⤇ C & @D.C = N) ∨ + ∃∃A0,D,C0. B ⤇ D & A0 ⤇ C0 & 𝛌.A0 = A & [↙D]C0 = N. +#M #N * -M -N +[ #i #B0 #A0 #H destruct +| #A1 #A2 #_ #B0 #A0 #H destruct +| #B1 #B2 #A1 #A2 #HB12 #HA12 #B0 #A0 #H destruct /3 width=5/ +| #B1 #B2 #A1 #A2 #HB12 #HA12 #B0 #A0 #H destruct /3 width=7/ +] +qed-. + +lemma pred_lift: liftable pred. +#h #M1 #M2 #H elim H -M1 -M2 normalize // /2 width=1/ +#B1 #B2 #A1 #A2 #_ #_ #IHB12 #IHC12 #d (dsubst_vref_lt … Hid) >(dsubst_vref_lt … Hid) // + | destruct >dsubst_vref_eq >dsubst_vref_eq /2 width=1/ + | >(dsubst_vref_gt … Hid) >(dsubst_vref_gt … Hid) // + ] +| normalize /2 width=1/ +| normalize /2 width=1/ +| normalize #B1 #B2 #A1 #A2 #_ #_ #IHB12 #IHC12 #d + >dsubst_dsubst_ge // /2 width=1/ +] +qed. + +lemma pred_conf1_vref: ∀i. confluent1 … pred (#i). +#i #M1 #H1 #M2 #H2 +<(pred_inv_vref … H1) -H1 [3: // |2: skip ] (**) (* simplify line *) +<(pred_inv_vref … H2) -H2 [3: // |2: skip ] (**) (* simplify line *) +/2 width=3/ +qed-. + +lemma pred_conf1_abst: ∀A. confluent1 … pred A → confluent1 … pred (𝛌.A). +#A #IH #M1 #H1 #M2 #H2 +elim (pred_inv_abst … H1 …) -H1 [3: // |2: skip ] #A1 #HA1 #H destruct (**) (* simplify line *) +elim (pred_inv_abst … H2 …) -H2 [3: // |2: skip ] #A2 #HA2 #H destruct (**) (* simplify line *) +elim (IH … HA1 … HA2) -A /3 width=3/ +qed-. + +lemma pred_conf1_appl_beta: ∀B,B1,B2,C,C2,M1. + (∀M0. |M0| < |B|+|𝛌.C|+1 → confluent1 ? pred M0) → (**) (* ? needed in place of … *) + B ⤇ B1 → B ⤇ B2 → 𝛌.C ⤇ M1 → C ⤇ C2 → + ∃∃M. @B1.M1 ⤇ M & [↙B2]C2 ⤇ M. +#B #B1 #B2 #C #C2 #M1 #IH #HB1 #HB2 #H1 #HC2 +elim (pred_inv_abst … H1 …) -H1 [3: // |2: skip ] #C1 #HC1 #H destruct (**) (* simplify line *) +elim (IH B … HB1 … HB2) -HB1 -HB2 // +elim (IH C … HC1 … HC2) normalize // -B -C /3 width=5/ +qed-. + +theorem pred_conf: confluent … pred. +#M @(f_ind … size … M) -M #n #IH * normalize +[ /2 width=3 by pred_conf1_vref/ +| /3 width=4 by pred_conf1_abst/ +| #B #A #H #M1 #H1 #M2 #H2 destruct + elim (pred_inv_appl … H1 …) -H1 [5: // |2,3: skip ] * (**) (* simplify line *) + elim (pred_inv_appl … H2 …) -H2 [5,10: // |2,3,7,8: skip ] * (**) (* simplify line *) + [ #B2 #A2 #HB2 #HA2 #H2 #B1 #A1 #HB1 #HA1 #H1 destruct + elim (IH A … HA1 … HA2) -HA1 -HA2 // + elim (IH B … HB1 … HB2) // -A -B /3 width=5/ + | #C #B2 #C2 #HB2 #HC2 #H2 #HM2 #B1 #N #HB1 #H #HM1 destruct + @(pred_conf1_appl_beta … IH) // (**) (* /2 width=7 by pred_conf1_appl_beta/ does not work *) + | #B2 #N #B2 #H #HM2 #C #B1 #C1 #HB1 #HC1 #H1 #HM1 destruct + @ex2_commute @(pred_conf1_appl_beta … IH) // + | #C #B2 #C2 #HB2 #HC2 #H2 #HM2 #C0 #B1 #C1 #HB1 #HC1 #H1 #HM1 destruct + elim (IH B … HB1 … HB2) -HB1 -HB2 // + elim (IH C … HC1 … HC2) normalize // -B -C /3 width=5/ + ] +] +qed-. + +lemma sred_pred: ∀M,N. M ↦ N → M ⤇ N. +#M #N #H elim H -M -N /2 width=1/ +qed. diff --git a/matita/matita/lib/lambda/terms/relocating_substitution.ma b/matita/matita/lib/lambda/terms/relocating_substitution.ma new file mode 100644 index 000000000..4f813396f --- /dev/null +++ b/matita/matita/lib/lambda/terms/relocating_substitution.ma @@ -0,0 +1,154 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "terms/relocation.ma". + +(* RELOCATING SUBSTITUTION **************************************************) + +(* Policy: depth (level) metavariables: d, e (as for lift) *) +let rec dsubst N d M on M ≝ match M with +[ VRef i ⇒ tri … i d (#i) (↑[i] N) (#(i-1)) +| Abst A ⇒ 𝛌. (dsubst N (d+1) A) +| Appl B A ⇒ @ (dsubst N d B). (dsubst N d A) +]. + +interpretation "relocating substitution" + 'DSubst N d M = (dsubst N d M). + +lemma dsubst_vref_lt: ∀i,d,N. i < d → [d ↙ N] #i = #i. +normalize /2 width=1/ +qed. + +lemma dsubst_vref_eq: ∀i,N. [i ↙ N] #i = ↑[i]N. +normalize // +qed. + +lemma dsubst_vref_gt: ∀i,d,N. d < i → [d ↙ N] #i = #(i-1). +normalize /2 width=1/ +qed. + +theorem dsubst_lift_le: ∀h,N,M,d1,d2. d2 ≤ d1 → + [d2 ↙ ↑[d1 - d2, h] N] ↑[d1 + 1, h] M = ↑[d1, h] [d2 ↙ N] M. +#h #N #M elim M -M +[ #i #d1 #d2 #Hd21 elim (lt_or_eq_or_gt i d2) #Hid2 + [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 #Hid1 + >(dsubst_vref_lt … Hid2) >(lift_vref_lt … Hid1) >lift_vref_lt /2 width=1/ + | destruct >dsubst_vref_eq >lift_vref_lt /2 width=1/ + | >(dsubst_vref_gt … Hid2) -Hd21 elim (lt_or_ge (i-1) d1) #Hi1d1 + [ >(lift_vref_lt … Hi1d1) >lift_vref_lt /2 width=1/ + | lapply (ltn_to_ltO … Hid2) #Hi + >(lift_vref_ge … Hi1d1) >lift_vref_ge /2 width=1/ -Hi1d1 >plus_minus // /3 width=1/ + ] + ] +| normalize #A #IHA #d1 #d2 #Hd21 + lapply (IHA (d1+1) (d2+1) ?) -IHA /2 width=1/ +| normalize #B #A #IHB #IHA #d1 #d2 #Hd21 + >IHB -IHB // >IHA -IHA // +] +qed. + +theorem dsubst_lift_be: ∀h,N,M,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h → + [d2 ↙ N] ↑[d1, h + 1] M = ↑[d1, h] M. +#h #N #M elim M -M +[ #i #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 + [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 + >(lift_vref_lt … Hid1) >(lift_vref_lt … Hid1) /2 width=1/ + | lapply (transitive_le … (i+h) Hd21 ?) -Hd12 -Hd21 /2 width=1/ #Hd2 + >(lift_vref_ge … Hid1) >(lift_vref_ge … Hid1) -Hid1 + >dsubst_vref_gt // /2 width=1/ + ] +| normalize #A #IHA #d1 #d2 #Hd12 #Hd21 + >IHA -IHA // /2 width=1/ +| normalize #B #A #IHB #IHA #d1 #d2 #Hd12 #Hd21 + >IHB -IHB // >IHA -IHA // +] +qed. + +theorem dsubst_lift_ge: ∀h,N,M,d1,d2. d1 + h ≤ d2 → + [d2 ↙ N] ↑[d1, h] M = ↑[d1, h] [d2 - h ↙ N] M. +#h #N #M elim M -M +[ #i #d1 #d2 #Hd12 elim (lt_or_eq_or_gt i (d2-h)) #Hid2h + [ >(dsubst_vref_lt … Hid2h) elim (lt_or_ge i d1) #Hid1 + [ lapply (lt_to_le_to_lt … (d1+h) Hid1 ?) -Hid2h // #Hid1h + lapply (lt_to_le_to_lt … Hid1h Hd12) -Hid1h -Hd12 #Hid2 + >(lift_vref_lt … Hid1) -Hid1 /2 width=1/ + | >(lift_vref_ge … Hid1) -Hid1 -Hd12 /3 width=1/ + ] + | destruct elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #Hhd2 + >dsubst_vref_eq >lift_vref_ge // >lift_lift_be // (dsubst_vref_gt … Hid2h) + >lift_vref_ge /2 width=1/ >lift_vref_ge /2 width=1/ -Hid1 + >dsubst_vref_gt /2 width=1/ -Hid2h >plus_minus // + ] +| normalize #A #IHA #d1 #d2 #Hd12 + elim (le_inv_plus_l … Hd12) #_ #Hhd2 + >IHA -IHA /2 width=1/ IHB -IHB // >IHA -IHA // +] +qed. + +theorem dsubst_dsubst_ge: ∀N1,N2,M,d1,d2. d1 ≤ d2 → + [d2 ↙ N2] [d1 ↙ N1] M = [d1 ↙ [d2 - d1 ↙ N2] N1] [d2 + 1 ↙ N2] M. +#N1 #N2 #M elim M -M +[ #i #d1 #d2 #Hd12 elim (lt_or_eq_or_gt i d1) #Hid1 + [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 #Hid2 + >(dsubst_vref_lt … Hid1) >(dsubst_vref_lt … Hid2) >dsubst_vref_lt /2 width=1/ + | destruct >dsubst_vref_eq >dsubst_vref_lt /2 width=1/ + | >(dsubst_vref_gt … Hid1) elim (lt_or_eq_or_gt i (d2+1)) #Hid2 + [ lapply (ltn_to_ltO … Hid1) #Hi + >(dsubst_vref_lt … Hid2) >dsubst_vref_lt /2 width=1/ + | destruct /2 width=1/ + | lapply (le_to_lt_to_lt (d1+1) … Hid2) -Hid1 /2 width=1/ -Hd12 #Hid1 + >(dsubst_vref_gt … Hid2) >dsubst_vref_gt /2 width=1/ + >dsubst_vref_gt // /2 width=1/ + ] + ] +| normalize #A #IHA #d1 #d2 #Hd12 + lapply (IHA (d1+1) (d2+1) ?) -IHA /2 width=1/ +| normalize #B #A #IHB #IHA #d1 #d2 #Hd12 + >IHB -IHB // >IHA -IHA // +] +qed. + +theorem dsubst_dsubst_lt: ∀N1,N2,M,d1,d2. d2 < d1 → + [d2 ↙ [d1 - d2 -1 ↙ N1] N2] [d1 ↙ N1] M = [d1 - 1 ↙ N1] [d2 ↙ N2] M. +#N1 #N2 #M #d1 #d2 #Hd21 +lapply (ltn_to_ltO … Hd21) #Hd1 +>dsubst_dsubst_ge in ⊢ (???%); /2 width=1/ (tri_lt ???? … Hid) -Hid -Hjd // + | #H destruct >tri_eq in Hjd; #H + elim (plus_lt_false … H) + | >(tri_gt ???? … Hid) + lapply (transitive_lt … Hjd Hid) -d #H #H0 destruct + elim (plus_lt_false … H) + ] +| #A #H destruct +| #B #A #H destruct +] +qed. + +lemma lift_inv_vref_ge: ∀j,d. d ≤ j → ∀h,M. ↑[d, h] M = #j → + d + h ≤ j ∧ M = #(j-h). +#j #d #Hdj #h * normalize +[ #i elim (lt_or_eq_or_gt i d) #Hid + [ >(tri_lt ???? … Hid) #H destruct + lapply (le_to_lt_to_lt … Hdj Hid) -Hdj -Hid #H + elim (lt_refl_false … H) + | #H -Hdj destruct /2 width=1/ + | >(tri_gt ???? … Hid) #H -Hdj destruct /4 width=1/ + ] +| #A #H destruct +| #B #A #H destruct +] +qed-. + +lemma lift_inv_vref_be: ∀j,d,h. d ≤ j → j < d + h → ∀M. ↑[d, h] M = #j → ⊥. +#j #d #h #Hdj #Hjdh #M #H elim (lift_inv_vref_ge … H) -H // -Hdj #Hdhj #_ -M +lapply (lt_to_le_to_lt … Hjdh Hdhj) -d -h #H +elim (lt_refl_false … H) +qed-. + +lemma lift_inv_vref_ge_plus: ∀j,d,h. d + h ≤ j → + ∀M. ↑[d, h] M = #j → M = #(j-h). +#j #d #h #Hdhj #M #H elim (lift_inv_vref_ge … H) -H // -M /2 width=2/ +qed. + +lemma lift_inv_abst: ∀C,d,h,M. ↑[d, h] M = 𝛌.C → + ∃∃A. ↑[d+1, h] A = C & M = 𝛌.A. +#C #d #h * normalize +[ #i #H destruct +| #A #H destruct /2 width=3/ +| #B #A #H destruct +] +qed-. + +lemma lift_inv_appl: ∀D,C,d,h,M. ↑[d, h] M = @D.C → + ∃∃B,A. ↑[d, h] B = D & ↑[d, h] A = C & M = @B.A. +#D #C #d #h * normalize +[ #i #H destruct +| #A #H destruct +| #B #A #H destruct /2 width=5/ +] +qed-. + +theorem lift_lift_le: ∀h1,h2,M,d1,d2. d2 ≤ d1 → + ↑[d2, h2] ↑[d1, h1] M = ↑[d1 + h2, h1] ↑[d2, h2] M. +#h1 #h2 #M elim M -M +[ #i #d1 #d2 #Hd21 elim (lt_or_ge i d2) #Hid2 + [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 #Hid1 + >(lift_vref_lt … Hid1) >(lift_vref_lt … Hid2) + >lift_vref_lt // /2 width=1/ + | >(lift_vref_ge … Hid2) elim (lt_or_ge i d1) #Hid1 + [ >(lift_vref_lt … Hid1) >(lift_vref_ge … Hid2) + >lift_vref_lt // -d2 /2 width=1/ + | >(lift_vref_ge … Hid1) >lift_vref_ge /2 width=1/ + >lift_vref_ge // /2 width=1/ + ] + ] +| normalize #A #IHA #d1 #d2 #Hd21 >IHA // /2 width=1/ +| normalize #B #A #IHB #IHA #d1 #d2 #Hd21 >IHB >IHA // +] +qed. + +theorem lift_lift_be: ∀h1,h2,M,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h1 → + ↑[d2, h2] ↑[d1, h1] M = ↑[d1, h1 + h2] M. +#h1 #h2 #M elim M -M +[ #i #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 + [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 + >(lift_vref_lt … Hid1) >(lift_vref_lt … Hid1) /2 width=1/ + | lapply (transitive_le … (i+h1) Hd21 ?) -Hd21 -Hd12 /2 width=1/ #Hd2 + >(lift_vref_ge … Hid1) >(lift_vref_ge … Hid1) /2 width=1/ + ] +| normalize #A #IHA #d1 #d2 #Hd12 #Hd21 >IHA // /2 width=1/ +| normalize #B #A #IHB #IHA #d1 #d2 #Hd12 #Hd21 >IHB >IHA // +] +qed. + +theorem lift_lift_ge: ∀h1,h2,M,d1,d2. d1 + h1 ≤ d2 → + ↑[d2, h2] ↑[d1, h1] M = ↑[d1, h1] ↑[d2 - h1, h2] M. +#h1 #h2 #M #d1 #d2 #Hd12 +>(lift_lift_le h2 h1) /2 width=1/ (lift_vref_lt … Hid) in H; #H + >(lift_inv_vref_lt … Hid … H) -M2 -d -h // + | >(lift_vref_ge … Hid) in H; #H + >(lift_inv_vref_ge_plus … H) -M2 // /2 width=1/ + ] +| normalize #A1 #IHA1 #M2 #d #H + elim (lift_inv_abst … H) -H #A2 #HA12 #H destruct + >(IHA1 … HA12) -IHA1 -A2 // +| normalize #B1 #A1 #IHB1 #IHA1 #M2 #d #H + elim (lift_inv_appl … H) -H #B2 #A2 #HB12 #HA12 #H destruct + >(IHB1 … HB12) -IHB1 -B2 >(IHA1 … HA12) -IHA1 -A2 // +] +qed-. + +theorem lift_inv_lift_le: ∀h1,h2,M1,M2,d1,d2. d2 ≤ d1 → + ↑[d2, h2] M2 = ↑[d1 + h2, h1] M1 → + ∃∃M. ↑[d1, h1] M = M2 & ↑[d2, h2] M = M1. +#h1 #h2 #M1 elim M1 -M1 +[ #i #M2 #d1 #d2 #Hd21 elim (lt_or_ge i (d1+h2)) #Hid1 + [ >(lift_vref_lt … Hid1) elim (lt_or_ge i d2) #Hid2 #H + [ lapply (lt_to_le_to_lt … Hid2 Hd21) -Hd21 -Hid1 #Hid1 + >(lift_inv_vref_lt … Hid2 … H) -M2 /3 width=3/ + | elim (lift_inv_vref_ge … H) -H -Hd21 // -Hid2 #Hdh2i #H destruct + elim (le_inv_plus_l … Hdh2i) -Hdh2i #Hd2i #Hh2i + @(ex2_intro … (#(i-h2))) [ /4 width=1/ ] -Hid1 + >lift_vref_ge // -Hd2i /3 width=1/ (**) (* auto: needs some help here *) + ] + | elim (le_inv_plus_l … Hid1) #Hd1i #Hh2i + lapply (transitive_le (d2+h2) … Hid1) /2 width=1/ -Hd21 #Hdh2i + elim (le_inv_plus_l … Hdh2i) #Hd2i #_ + >(lift_vref_ge … Hid1) #H -Hid1 + >(lift_inv_vref_ge_plus … H) -H /2 width=3/ -Hdh2i + @(ex2_intro … (#(i-h2))) (**) (* auto: needs some help here *) + [ >lift_vref_ge // -Hd1i /3 width=1/ + | >lift_vref_ge // -Hd2i -Hd1i /3 width=1/ + ] + ] +| normalize #A1 #IHA1 #M2 #d1 #d2 #Hd21 #H + elim (lift_inv_abst … H) -H >plus_plus_comm_23 #A2 #HA12 #H destruct + elim (IHA1 … HA12) -IHA1 -HA12 /2 width=1/ -Hd21 #A #HA2 #HA1 + @(ex2_intro … (𝛌.A)) normalize // +| normalize #B1 #A1 #IHB1 #IHA1 #M2 #d1 #d2 #Hd21 #H + elim (lift_inv_appl … H) -H #B2 #A2 #HB12 #HA12 #H destruct + elim (IHB1 … HB12) -IHB1 -HB12 // #B #HB2 #HB1 + elim (IHA1 … HA12) -IHA1 -HA12 // -Hd21 #A #HA2 #HA1 + @(ex2_intro … (@B.A)) normalize // +] +qed-. + +theorem lift_inv_lift_be: ∀h1,h2,M1,M2,d1,d2. d1 ≤ d2 → d2 ≤ d1 + h1 → + ↑[d2, h2] M2 = ↑[d1, h1 + h2] M1 → ↑[d1, h1] M1 = M2. +#h1 #h2 #M1 elim M1 -M1 +[ #i #M2 #d1 #d2 #Hd12 #Hd21 elim (lt_or_ge i d1) #Hid1 + [ lapply (lt_to_le_to_lt … Hid1 Hd12) -Hd12 -Hd21 #Hid2 + >(lift_vref_lt … Hid1) #H >(lift_inv_vref_lt … Hid2 … H) -h2 -M2 -d2 /2 width=1/ + | lapply (transitive_le … (i+h1) Hd21 ?) -Hd12 -Hd21 /2 width=1/ #Hd2 + >(lift_vref_ge … Hid1) #H >(lift_inv_vref_ge_plus … H) -M2 /2 width=1/ + ] +| normalize #A1 #IHA1 #M2 #d1 #d2 #Hd12 #Hd21 #H + elim (lift_inv_abst … H) -H #A #HA12 #H destruct + >(IHA1 … HA12) -IHA1 -HA12 // /2 width=1/ +| normalize #B1 #A1 #IHB1 #IHA1 #M2 #d1 #d2 #Hd12 #Hd21 #H + elim (lift_inv_appl … H) -H #B #A #HB12 #HA12 #H destruct + >(IHB1 … HB12) -IHB1 -HB12 // >(IHA1 … HA12) -IHA1 -HA12 // +] +qed-. + +theorem lift_inv_lift_ge: ∀h1,h2,M1,M2,d1,d2. d1 + h1 ≤ d2 → + ↑[d2, h2] M2 = ↑[d1, h1] M1 → + ∃∃M. ↑[d1, h1] M = M2 & ↑[d2 - h1, h2] M = M1. +#h1 #h2 #M1 #M2 #d1 #d2 #Hd12 #H +elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #Hh1d2 +lapply (sym_eq term … H) -H >(plus_minus_m_m … Hh1d2) in ⊢ (???%→?); -Hh1d2 #H +elim (lift_inv_lift_le … Hd12 … H) -H -Hd12 /2 width=3/ +qed-. + +definition liftable: predicate (relation term) ≝ λR. + ∀h,M1,M2. R M1 M2 → ∀d. R (↑[d, h] M1) (↑[d, h] M2). + +definition deliftable_sn: predicate (relation term) ≝ λR. + ∀h,N1,N2. R N1 N2 → ∀d,M1. ↑[d, h] M1 = N1 → + ∃∃M2. R M1 M2 & ↑[d, h] M2 = N2. + +lemma star_liftable: ∀R. liftable R → liftable (star … R). +#R #HR #h #M1 #M2 #H elim H -M2 // /3 width=3/ +qed. + +lemma star_deliftable_sn: ∀R. deliftable_sn R → deliftable_sn (star … R). +#R #HR #h #N1 #N2 #H elim H -N2 /2 width=3/ +#N #N2 #_ #HN2 #IHN1 #d #M1 #HMN1 +elim (IHN1 … HMN1) -N1 #M #HM1 #HMN +elim (HR … HN2 … HMN) -N /3 width=3/ +qed-. + +lemma lstar_liftable: ∀S,R. (∀a. liftable (R a)) → + ∀l. liftable (lstar S … R l). +#S #R #HR #l #h #M1 #M2 #H +@(lstar_ind_l … l M1 H) -l -M1 // /3 width=3/ +qed. + +lemma lstar_deliftable_sn: ∀S,R. (∀a. deliftable_sn (R a)) → + ∀l. deliftable_sn (lstar S … R l). +#S #R #HR #l #h #N1 #N2 #H +@(lstar_ind_l … l N1 H) -l -N1 /2 width=3/ +#a #l #N1 #N #HN1 #_ #IHN2 #d #M1 #HMN1 +elim (HR … HN1 … HMN1) -N1 #M #HM1 #HMN +elim (IHN2 … HMN) -N /3 width=3/ +qed-. diff --git a/matita/matita/lib/lambda/terms/sequential_computation.ma b/matita/matita/lib/lambda/terms/sequential_computation.ma new file mode 100644 index 000000000..b248e6027 --- /dev/null +++ b/matita/matita/lib/lambda/terms/sequential_computation.ma @@ -0,0 +1,105 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "terms/parallel_computation.ma". + +(* SEQUENTIAL COMPUTATION (MULTISTEP) ***************************************) + +definition sreds: relation term ≝ star … sred. + +interpretation "sequential computation" + 'SeqRedStar M N = (sreds M N). + +lemma sreds_refl: reflexive … sreds. +// +qed. + +lemma sreds_step_sn: ∀M1,M. M1 ↦ M → ∀M2. M ↦* M2 → M1 ↦* M2. +/2 width=3/ +qed-. + +lemma sreds_step_dx: ∀M1,M. M1 ↦* M → ∀M2. M ↦ M2 → M1 ↦* M2. +/2 width=3/ +qed-. + +lemma sreds_step_rc: ∀M1,M2. M1 ↦ M2 → M1 ↦* M2. +/2 width=1/ +qed. + +lemma lsred_compatible_abst: compatible_abst sreds. +/3 width=1/ +qed. + +lemma sreds_compatible_sn: compatible_sn sreds. +/3 width=1/ +qed. + +lemma sreds_compatible_dx: compatible_dx sreds. +/3 width=1/ +qed. + +lemma sreds_compatible_appl: compatible_appl sreds. +/3 width=3/ +qed. + +lemma sreds_lift: liftable sreds. +/2 width=1/ +qed. + +lemma sreds_inv_lift: deliftable_sn sreds. +/3 width=3 by star_deliftable_sn, sred_inv_lift/ +qed-. + +lemma sreds_dsubst: dsubstable_dx sreds. +/2 width=1/ +qed. + +theorem sreds_trans: transitive … sreds. +/2 width=3 by trans_star/ +qed-. + +(* Note: the substitution should be unparentesized *) +lemma sreds_compatible_beta: ∀B1,B2. B1 ↦* B2 → ∀A1,A2. A1 ↦* A2 → + @B1.𝛌.A1 ↦* ([↙B2] A2). +#B1 #B2 #HB12 #A1 #A2 #HA12 +@(sreds_trans … (@B2.𝛌.A1)) /2 width=1/ -B1 +@(sreds_step_dx … (@B2.𝛌.A2)) // /3 width=1/ +qed. + +theorem sreds_preds: ∀M1,M2. M1 ↦* M2 → M1 ⤇* M2. +#M1 #M2 #H @(star_ind_l … M1 H) -M1 // +#M1 #M #HM1 #_ #IHM2 +@(preds_step_sn … IHM2) -M2 /2 width=2/ +qed. + +lemma pred_sreds: ∀M1,M2. M1 ⤇ M2 → M1 ↦* M2. +#M1 #M2 #H elim H -M1 -M2 // /2 width=1/ +qed-. + +theorem preds_sreds: ∀M1,M2. M1 ⤇* M2 → M1 ↦* M2. +#M1 #M2 #H elim H -M2 // +#M #M2 #_ #HM2 #HM1 +lapply (pred_sreds … HM2) -HM2 #HM2 +@(sreds_trans … HM1 … HM2) +qed-. + +theorem sreds_conf: ∀M0,M1. M0 ↦* M1 → ∀M2. M0 ↦* M2 → + ∃∃M. M1 ↦* M & M2 ↦* M. +#M0 #M1 #HM01 #M2 #HM02 +lapply (sreds_preds … HM01) #HM01 +lapply (sreds_preds … HM02) #HM02 +elim (preds_conf … HM01 … HM02) -M0 #M #HM1 #HM2 +lapply (preds_sreds … HM1) -HM1 +lapply (preds_sreds … HM2) -HM2 /2 width=3/ +qed-. diff --git a/matita/matita/lib/lambda/terms/sequential_reduction.ma b/matita/matita/lib/lambda/terms/sequential_reduction.ma new file mode 100644 index 000000000..becaaac78 --- /dev/null +++ b/matita/matita/lib/lambda/terms/sequential_reduction.ma @@ -0,0 +1,106 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "terms/multiplicity.ma". + +(* SEQUENTIAL REDUCTION (SINGLE STEP) ***************************************) + +(* Note: the application "(A B)" is represented by "@B.A" following: + F. Kamareddine and R.P. Nederpelt: "A useful λ-notation". + Theoretical Computer Science 155(1), Elsevier (1996), pp. 85-109. +*) +inductive sred: relation term ≝ +| sred_beta : ∀B,A. sred (@B.𝛌.A) ([↙B]A) +| sred_abst : ∀A1,A2. sred A1 A2 → sred (𝛌.A1) (𝛌.A2) +| sred_appl_sn: ∀B1,B2,A. sred B1 B2 → sred (@B1.A) (@B2.A) +| sred_appl_dx: ∀B,A1,A2. sred A1 A2 → sred (@B.A1) (@B.A2) +. + +interpretation "sequential reduction" + 'SeqRed M N = (sred M N). + +lemma sred_inv_vref: ∀M,N. M ↦ N → ∀i. #i = M → ⊥. +#M #N * -M -N +[ #B #A #i #H destruct +| #A1 #A2 #_ #i #H destruct +| #B1 #B2 #A #_ #i #H destruct +| #B #A1 #A2 #_ #i #H destruct +] +qed-. + +lemma sred_inv_abst: ∀M,N. M ↦ N → ∀C1. 𝛌.C1 = M → + ∃∃C2. C1 ↦ C2 & 𝛌.C2 = N. +#M #N * -M -N +[ #B #A #C1 #H destruct +| #A1 #A2 #HA12 #C1 #H destruct /2 width=3/ +| #B1 #B2 #A #_ #C1 #H destruct +| #B #A1 #A2 #_ #C1 #H destruct +] +qed-. + +lemma sred_inv_appl: ∀M,N. M ↦ N → ∀D,C. @D.C = M → + ∨∨ (∃∃C0. 𝛌.C0 = C & [↙D] C0 = N) + | (∃∃D0. D ↦ D0 & @D0.C = N) + | (∃∃C0. C ↦ C0 & @D.C0 = N). +#M #N * -M -N +[ #B #A #D #C #H destruct /3 width=3/ +| #A1 #A2 #_ #D #C #H destruct +| #B1 #B2 #A #HB12 #D #C #H destruct /3 width=3/ +| #B #A1 #A2 #HA12 #D #C #H destruct /3 width=3/ +] +qed-. + +lemma sred_fwd_mult: ∀M,N. M ↦ N → ♯{N} < ♯{M} * ♯{M}. +#M #N #H elim H -M -N +[ #B #A @(le_to_lt_to_lt … (♯{A}*♯{B})) // + normalize /3 width=1 by lt_minus_to_plus_r, lt_times/ (**) (* auto: too slow without trace *) +| // +| #B #D #A #_ #IHBD + @(lt_to_le_to_lt … (♯{B}*♯{B}+♯{A})) [ /2 width=1/ ] -D +| #B #A #C #_ #IHAC + @(lt_to_le_to_lt … (♯{B}+♯{A}*♯{A})) [ /2 width=1/ ] -C +] +@(transitive_le … (♯{B}*♯{B}+♯{A}*♯{A})) [ /2 width=1/ ] +>distributive_times_plus normalize /2 width=1/ +qed-. + +lemma sred_lift: liftable sred. +#h #M1 #M2 #H elim H -M1 -M2 normalize /2 width=1/ +#B #A #d dsubst_dsubst_ge // +qed. diff --git a/matita/matita/lib/lambda/terms/size.ma b/matita/matita/lib/lambda/terms/size.ma new file mode 100644 index 000000000..1fd9a060e --- /dev/null +++ b/matita/matita/lib/lambda/terms/size.ma @@ -0,0 +1,31 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +include "terms/relocation.ma". + +(* SIZE *********************************************************************) + +(* Note: this gives the number of abstractions and applications in M *) +let rec size M on M ≝ match M with +[ VRef i ⇒ 0 +| Abst A ⇒ size A + 1 +| Appl B A ⇒ (size B) + (size A) + 1 +]. + +interpretation "term size" + 'card M = (size M). + +lemma size_lift: ∀h,M,d. |↑[d, h] M| = |M|. +#h #M elim M -M normalize // +qed. diff --git a/matita/matita/lib/lambda/terms/term.ma b/matita/matita/lib/lambda/terms/term.ma new file mode 100644 index 000000000..c831236a3 --- /dev/null +++ b/matita/matita/lib/lambda/terms/term.ma @@ -0,0 +1,67 @@ +(**************************************************************************) +(* ___ *) +(* ||M|| *) +(* ||A|| A project by Andrea Asperti *) +(* ||T|| *) +(* ||I|| Developers: *) +(* ||T|| The HELM team. *) +(* ||A|| http://helm.cs.unibo.it *) +(* \ / *) +(* \ / This file is distributed under the terms of the *) +(* v GNU General Public License Version 2 *) +(* *) +(**************************************************************************) + +(* Initial invocation: - Patience on us to gain peace and perfection! - *) + +include "background/preamble.ma". + +(* TERM STRUCTURE ***********************************************************) + +(* Policy: term metavariables : A, B, C, D, M, N + depth metavariables: i, j +*) +inductive term: Type[0] ≝ +| VRef: nat → term (* variable reference by depth *) +| Abst: term → term (* function formation *) +| Appl: term → term → term (* function application *) +. + +interpretation "term construction (variable reference by index)" + 'VariableReferenceByIndex i = (VRef i). + +interpretation "term construction (abstraction)" + 'Abstraction A = (Abst A). + +interpretation "term construction (application)" + 'Application C A = (Appl C A). + +definition compatible_abst: predicate (relation term) ≝ λR. + ∀A1,A2. R A1 A2 → R (𝛌.A1) (𝛌.A2). + +definition compatible_sn: predicate (relation term) ≝ λR. + ∀A,B1,B2. R B1 B2 → R (@B1.A) (@B2.A). + +definition compatible_dx: predicate (relation term) ≝ λR. + ∀B,A1,A2. R A1 A2 → R (@B.A1) (@B.A2). + +definition compatible_appl: predicate (relation term) ≝ λR. + ∀B1,B2. R B1 B2 → ∀A1,A2. R A1 A2 → + R (@B1.A1) (@B2.A2). + +lemma star_compatible_abst: ∀R. compatible_abst R → compatible_abst (star … R). +#R #HR #A1 #A2 #H elim H -A2 // /3 width=3/ +qed. + +lemma star_compatible_sn: ∀R. compatible_sn R → compatible_sn (star … R). +#R #HR #A #B1 #B2 #H elim H -B2 // /3 width=3/ +qed. + +lemma star_compatible_dx: ∀R. compatible_dx R → compatible_dx (star … R). +#R #HR #B #A1 #A2 #H elim H -A2 // /3 width=3/ +qed. + +lemma star_compatible_appl: ∀R. reflexive ? R → + compatible_appl R → compatible_appl (star … R). +#R #H1R #H2R #B1 #B2 #H elim H -B2 /3 width=1/ /3 width=5/ +qed. diff --git a/matita/matita/lib/lambda/xoa.conf.xml b/matita/matita/lib/lambda/xoa.conf.xml new file mode 100644 index 000000000..04cbcf59e --- /dev/null +++ b/matita/matita/lib/lambda/xoa.conf.xml @@ -0,0 +1,23 @@ + + +
+ $(MATITA_RT_BASE_DIR) +
+
+ contribs/lambda/background/ + xoa + xoa_notation + basics/pts.ma + 1 2 + 2 2 + 2 3 + 3 1 + 3 2 + 3 3 + 3 4 + 4 1 + 4 2 + 4 3 + 3 +
+