+++ /dev/null
-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) | $<
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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 }.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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).
-
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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 }.
-
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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).
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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_lift_le //
-qed.
-
-lemma pl_sred_inv_lift: ∀p. deliftable_sn (pl_sred p).
-#p #h #N1 #N2 #H elim H -p -N1 -N2
-[ #D #C #d #M1 #H
- elim (lift_inv_appl … H) -H #B #M #H0 #HM #H destruct
- elim (lift_inv_abst … HM) -HM #A #H0 #H destruct /3 width=3/
-| #p #C1 #C2 #_ #IHC12 #d #M1 #H
- elim (lift_inv_abst … H) -H #A1 #HAC1 #H
- elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
- @(ex2_intro … (𝛌.A2)) // /2 width=1/
-| #p #D1 #D2 #C1 #_ #IHD12 #d #M1 #H
- elim (lift_inv_appl … H) -H #B1 #A #HBD1 #H1 #H2
- elim (IHD12 … HBD1) -D1 #B2 #HB12 #HBD2 destruct
- @(ex2_intro … (@B2.A)) // /2 width=1/
-| #p #D1 #C1 #C2 #_ #IHC12 #d #M1 #H
- elim (lift_inv_appl … H) -H #B #A1 #H1 #HAC1 #H2
- elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
- @(ex2_intro … (@B.A2)) // /2 width=1/
-]
-qed-.
-
-lemma pl_sred_dsubst: ∀p. dsubstable_dx (pl_sred p).
-#p #D1 #M1 #M2 #H elim H -p -M1 -M2 normalize /2 width=1/
-#D2 #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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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_slift_le //
-| #b #p #V1 #V2 #T #_ #IHV12 #d
- whd in ⊢ (??%%); <booleanized_lift /2 width=1/ (**) (* auto needs some help here *)
-]
-qed.
-
-lemma pl_st_inv_lift: ∀p. sdeliftable_sn (pl_st p).
-#p #h #G1 #G2 #H elim H -p -G1 -G2
-[ #W #U #d #F1 #H
- elim (slift_inv_appl … H) -H #V #F #H0 #HF #H destruct
- elim (slift_inv_abst … HF) -HF #T #H0 #H destruct /3 width=3/
-| #b #p #U1 #U2 #_ #IHU12 #d #F1 #H
- elim (slift_inv_abst … H) -H #T1 #HTU1 #H
- elim (IHU12 … HTU1) -U1 #T2 #HT12 #HTU2 destruct
- @(ex2_intro … ({⊥}𝛌.T2)) // /2 width=1/
-| #b #p #W1 #W2 #U1 #_ #IHW12 #d #F1 #H
- elim (slift_inv_appl … H) -H #V1 #T #HVW1 #H1 #H2
- elim (IHW12 … HVW1) -W1 #V2 #HV12 #HVW2 destruct
- @(ex2_intro … ({⊥}@V2.{⊥}⇕T)) [ /2 width=1/ ]
- whd in ⊢ (??%%); // (**) (* auto needs some help here *)
-| #b #p #W1 #U1 #U2 #_ #IHU12 #d #F1 #H
- elim (slift_inv_appl … H) -H #V #T1 #H1 #HTU1 #H2
- elim (IHU12 … HTU1) -U1 #T2 #HT12 #HTU2 destruct
- @(ex2_intro … ({b}@V.T2)) // /2 width=1/
-]
-qed-.
-
-lemma pl_st_dsubst: ∀p. sdsubstable_f_dx … (booleanized ⊥) (pl_st p).
-#p #W1 #F1 #F2 #H elim H -p -F1 -F2 /2 width=1/
-[ #W2 #T #d normalize >sdsubst_sdsubst_ge //
-| #b #p #V1 #V2 #T #_ #IHV12 #d
- whd in ⊢ (??%%); <(booleanized_booleanized ⊥) in ⊢ (???(???%)); <booleanized_dsubst /2 width=1/ (**) (* auto needs some help here *)
-]
-qed.
-
-lemma pl_st_inv_empty: ∀p,F1,F2. F1 Ⓡ↦[p] F2 → ∀M1. {⊥}⇑M1 = F1 → ⊥.
-#p #F1 #F2 #H elim H -p -F1 -F2
-[ #V #T #M1 #H
- elim (boolean_inv_appl … H) -H #B #A #H destruct
-| #b #p #T1 #T2 #_ #IHT12 #M1 #H
- elim (boolean_inv_abst … H) -H /2 width=2/
-| #b #p #V1 #V2 #T #_ #IHV12 #M1 #H
- elim (boolean_inv_appl … H) -H /2 width=2/
-| #b #p #V #T1 #T2 #_ #IHT12 #M1 #H
- elim (boolean_inv_appl … H) -H /2 width=2/
-]
-qed-.
-
-theorem pl_st_mono: ∀p. singlevalued … (pl_st p).
-#p #F #G1 #H elim H -p -F -G1
-[ #V #T #G2 #H elim (pl_st_inv_nil … H …) -H //
- #W #U #H #HG2 destruct //
-| #b #p #T1 #T2 #_ #IHT12 #G2 #H elim (pl_st_inv_rc … H …) -H [3: // |2: skip ] (**) (* simplify line *)
- #c #U1 #U2 #HU12 #H #HG2 destruct /3 width=1/
-| #b #p #V1 #V2 #T #_ #IHV12 #G2 #H elim (pl_st_inv_sn … H …) -H [3: // |2: skip ] (**) (* simplify line *)
- #c #W1 #W2 #U #HW12 #H #HG2 destruct /3 width=1/
-| #b #p #V #T1 #T2 #_ #IHT12 #G2 #H elim (pl_st_inv_dx … H …) -H [3: // |2: skip ] (**) (* simplify line *)
- #c #W #U1 #U2 #HU12 #H #HG2 destruct /3 width=1/
-]
-qed-.
-
-theorem pl_st_fwd_sle: ∀p1,F1,F. F1 Ⓡ↦[p1] F →
- ∀p2,F2. F Ⓡ↦[p2] F2 → p1 ≤ p2.
-#p1 #F1 #F #H elim H -p1 -F1 -F //
-[ #b #p #T1 #T #_ #IHT1 #p2 #F2 #H elim (pl_st_inv_abst … H …) -H [3: // |2,4: skip ] (**) (* simplify line *)
- #q #T2 #HT2 #H1 #H2 destruct /3 width=2/
-| #b #p #V1 #V #T #_ #IHV1 #p2 #F2 #H elim (pl_st_inv_appl … H …) -H [7: // |2,3,4: skip ] * (**) (* simplify line *)
- [ #U #H destruct
- | #q #V2 #H1 #HV2 #H2 destruct /3 width=2/
- | #q #U #_ #H elim (pl_st_inv_empty … H …) [ // | skip ] (**) (* simplify line *)
- ]
-| #b #p #V #T1 #T #HT1 #IHT1 #p2 #F2 #H elim (pl_st_inv_appl … H …) -H [7: // |2,3,4: skip ] * (**) (* simplify line *)
- [ #U #_ #H1 #H2 #_ -b -V -F2 -IHT1
- elim (pl_st_fwd_abst … HT1 … H2) // -H1 * #q #H
- elim (pl_st_inv_rc … HT1 … H) -HT1 -H #b #U1 #U2 #_ #_ #H -b -q -T1 -U1 destruct
- | #q #V2 #H1 #_ #_ -b -F2 -T1 -T -V -V2 destruct //
- | #q #T2 #H1 #HT2 #H2 -b -F2 -T1 -V /3 width=2/
- ]
-]
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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/term.ma".
-
-(* PATH *********************************************************************)
-
-(* Policy: path step metavariables: o *)
-(* Note: this is a step of a path in the tree representation of a term:
- rc (rectus) : proceed on the argument of an abstraction
- sn (sinister): proceed on the left argument of an application
- dx (dexter) : proceed on the right argument of an application
-*)
-inductive step: Type[0] ≝
-| rc: step
-| sn: step
-| dx: step
-.
-
-definition is_dx: predicate step ≝ λo. dx = o.
-
-(* Policy: path metavariables: p, q *)
-(* Note: this is a path in the tree representation of a term, heading to a redex *)
-definition path: Type[0] ≝ list step.
-
-definition compatible_rc: predicate (path→relation term) ≝ λR.
- ∀p,A1,A2. R p A1 A2 → R (rc::p) (𝛌.A1) (𝛌.A2).
-
-definition compatible_sn: predicate (path→relation term) ≝ λR.
- ∀p,B1,B2,A. R p B1 B2 → R (sn::p) (@B1.A) (@B2.A).
-
-definition compatible_dx: predicate (path→relation term) ≝ λR.
- ∀p,B,A1,A2. R p A1 A2 → R (dx::p) (@B.A1) (@B.A2).
-
-(* Note: a redex is "in the whd" when is not under an abstraction nor in the left argument of an application *)
-definition in_whd: predicate path ≝ All … is_dx.
-
-lemma in_whd_ind: ∀R:predicate path. R (◊) →
- (∀p. in_whd p → R p → R (dx::p)) →
- ∀p. in_whd p → R p.
-#R #H #IH #p elim p -p // -H *
-#p #IHp * #H1 #H2 destruct /3 width=1/
-qed-.
-
-(* Note: a redex is "inner" when is not in the whd *)
-definition in_inner: predicate path ≝ λp. in_whd p → ⊥.
-
-lemma in_inner_rc: ∀p. in_inner (rc::p).
-#p * normalize #H destruct
-qed.
-
-lemma in_inner_sn: ∀p. in_inner (sn::p).
-#p * normalize #H destruct
-qed.
-
-lemma in_inner_cons: ∀o,p. in_inner p → in_inner (o::p).
-#o #p #H1p * /2 width=1/
-qed.
-
-lemma in_inner_inv_dx: ∀p. in_inner (dx::p) → in_inner p.
-/3 width=1/
-qed-.
-
-lemma in_whd_or_in_inner: ∀p. in_whd p ∨ in_inner p.
-#p elim p -p /2 width=1/ #o #p * #Hp /3 width=1/ cases o -o /2 width=1/ /3 width=1/
-qed-.
-
-lemma in_inner_ind: ∀R:predicate path.
- (∀p. R (rc::p)) → (∀p. R (sn::p)) →
- (∀p. in_inner p → R p → R (dx::p)) →
- ∀p. in_inner p → R p.
-#R #H1 #H2 #IH #p elim p -p
-[ #H elim (H …) -H //
-| * #p #IHp // #H
- lapply (in_inner_inv_dx … H) -H /3 width=1/
-]
-qed-.
-
-lemma in_inner_inv: ∀p. in_inner p →
- ∨∨ ∃q. rc::q = p | ∃q. sn::q = p
- | ∃∃q. in_inner q & dx::q = p.
-@in_inner_ind /3 width=2/ /3 width=3/
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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".
-
-(* STANDARD ORDER ************************************************************)
-
-(* Note: this is p ≤ q *)
-definition sle: relation path ≝ star … sprec.
-
-interpretation "standard 'less or equal to' on paths"
- 'leq p q = (sle p q).
-
-lemma sle_step_rc: ∀p,q. p ≺ q → p ≤ q.
-/2 width=1/
-qed.
-
-lemma sle_step_sn: ∀p1,p,p2. p1 ≺ p → p ≤ p2 → p1 ≤ p2.
-/2 width=3/
-qed-.
-
-lemma sle_rc: ∀p,q. dx::p ≤ rc::q.
-/2 width=1/
-qed.
-
-lemma sle_sn: ∀p,q. rc::p ≤ sn::q.
-/2 width=1/
-qed.
-
-lemma sle_skip: dx::◊ ≤ ◊.
-/2 width=1/
-qed.
-
-lemma sle_nil: ∀p. ◊ ≤ p.
-* // /2 width=1/
-qed.
-
-lemma sle_comp: ∀p1,p2. p1 ≤ p2 → ∀o. (o::p1) ≤ (o::p2).
-#p1 #p2 #H elim H -p2 // /3 width=3/
-qed.
-
-lemma sle_skip_sle: ∀p. p ≤ ◊ → dx::p ≤ ◊.
-#p #H @(star_ind_l … p H) -p //
-#p #q #Hpq #_ #H @(sle_step_sn … H) -H /2 width=1/
-qed.
-
-theorem sle_trans: transitive … sle.
-/2 width=3/
-qed-.
-
-lemma sle_cons: ∀p,q. dx::p ≤ sn::q.
-#p #q
-@(sle_trans … (rc::q)) /2 width=1/
-qed.
-
-lemma sle_dichotomy: ∀p1,p2:path. p1 ≤ p2 ∨ p2 ≤ p1.
-#p1 elim p1 -p1
-[ * /2 width=1/
-| #o1 #p1 #IHp1 * /2 width=1/
- * #p2 cases o1 -o1 /2 width=1/
- elim (IHp1 p2) -IHp1 /3 width=1/
-]
-qed-.
-
-lemma sle_inv_dx: ∀p,q. p ≤ q → ∀q0. dx::q0 = q →
- in_whd p ∨ ∃∃p0. p0 ≤ q0 & dx::p0 = p.
-#p #q #H @(star_ind_l … p H) -p [ /3 width=3/ ]
-#p0 #p #Hp0 #_ #IHpq #q1 #H destruct
-elim (IHpq …) -IHpq [4: // |3: skip ] (**) (* simplify line *)
-[ lapply (sprec_fwd_in_whd … Hp0) -Hp0 /3 width=1/
-| * #p1 #Hpq1 #H elim (sprec_inv_dx … Hp0 … H) -p
- [ #H destruct /2 width=1/
- | * /4 width=3/
- ]
-]
-qed-.
-
-lemma sle_inv_rc: ∀p,q. p ≤ q → ∀p0. rc::p0 = p →
- (∃∃q0. p0 ≤ q0 & rc::q0 = q) ∨
- ∃q0. sn::q0 = q.
-#p #q #H elim H -q /3 width=3/
-#q #q0 #_ #Hq0 #IHpq #p0 #H destruct
-elim (IHpq p0 …) -IHpq // *
-[ #p1 #Hp01 #H
- elim (sprec_inv_rc … Hq0 … H) -q * /3 width=3/ /4 width=3/
-| #p1 #H elim (sprec_inv_sn … Hq0 … H) -q /3 width=2/
-]
-qed-.
-
-lemma sle_inv_sn: ∀p,q. p ≤ q → ∀p0. sn::p0 = p →
- ∃∃q0. p0 ≤ q0 & sn::q0 = q.
-#p #q #H elim H -q /2 width=3/
-#q #q0 #_ #Hq0 #IHpq #p0 #H destruct
-elim (IHpq p0 …) -IHpq // #p1 #Hp01 #H
-elim (sprec_inv_sn … Hq0 … H) -q /3 width=3/
-qed-.
-
-lemma in_whd_sle_nil: ∀p. in_whd p → p ≤ ◊.
-#p #H @(in_whd_ind … H) -p // /2 width=1/
-qed.
-
-theorem in_whd_sle: ∀p. in_whd p → ∀q. p ≤ q.
-#p #H @(in_whd_ind … H) -p //
-#p #_ #IHp * /3 width=1/ * #q /2 width=1/
-qed.
-
-lemma sle_nil_inv_in_whd: ∀p. p ≤ ◊ → in_whd p.
-#p #H @(star_ind_l … p H) -p // /2 width=3 by sprec_fwd_in_whd/
-qed-.
-
-lemma sle_inv_in_whd: ∀p. (∀q. p ≤ q) → in_whd p.
-/2 width=1 by sle_nil_inv_in_whd/
-qed-.
-
-lemma sle_fwd_in_whd: ∀p,q. p ≤ q → in_whd q → in_whd p.
-#p #q #H @(star_ind_l … p H) -p // /3 width=3 by sprec_fwd_in_whd/
-qed-.
-
-lemma sle_fwd_in_inner: ∀p,q. p ≤ q → in_inner p → in_inner q.
-/3 width=3 by sle_fwd_in_whd/
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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".
-
-(* STANDARD PRECEDENCE ******************************************************)
-
-(* Note: standard precedence relation on paths: p ≺ q
- to serve as base for the order relations: p < q and p ≤ q *)
-inductive sprec: relation path ≝
-| sprec_nil : ∀o,q. sprec (◊) (o::q)
-| sprec_rc : ∀p,q. sprec (dx::p) (rc::q)
-| sprec_sn : ∀p,q. sprec (rc::p) (sn::q)
-| sprec_comp: ∀o,p,q. sprec p q → sprec (o::p) (o::q)
-| sprec_skip: sprec (dx::◊) ◊
-.
-
-interpretation "standard 'precedes' on paths"
- 'prec p q = (sprec p q).
-
-lemma sprec_inv_sn: ∀p,q. p ≺ q → ∀p0. sn::p0 = p →
- ∃∃q0. p0 ≺ q0 & sn::q0 = q.
-#p #q * -p -q
-[ #o #q #p0 #H destruct
-| #p #q #p0 #H destruct
-| #p #q #p0 #H destruct
-| #o #p #q #Hpq #p0 #H destruct /2 width=3/
-| #p0 #H destruct
-]
-qed-.
-
-lemma sprec_inv_dx: ∀p,q. p ≺ q → ∀q0. dx::q0 = q →
- ◊ = p ∨ ∃∃p0. p0 ≺ q0 & dx::p0 = p.
-#p #q * -p -q
-[ #o #q #q0 #H destruct /2 width=1/
-| #p #q #q0 #H destruct
-| #p #q #q0 #H destruct
-| #o #p #q #Hpq #q0 #H destruct /3 width=3/
-| #q0 #H destruct
-]
-qed-.
-
-lemma sprec_inv_rc: ∀p,q. p ≺ q → ∀p0. rc::p0 = p →
- (∃∃q0. p0 ≺ q0 & rc::q0 = q) ∨
- ∃q0. sn::q0 = q.
-#p #q * -p -q
-[ #o #q #p0 #H destruct
-| #p #q #p0 #H destruct
-| #p #q #p0 #H destruct /3 width=2/
-| #o #p #q #Hpq #p0 #H destruct /3 width=3/
-| #p0 #H destruct
-]
-qed-.
-
-lemma sprec_inv_comp: ∀p1,p2. p1 ≺ p2 →
- ∀o,q1,q2. o::q1 = p1 → o::q2 = p2 → q1 ≺ q2.
-#p1 #p2 * -p1 -p2
-[ #o #q #o0 #q1 #q2 #H destruct
-| #p #q #o0 #q1 #q2 #H1 #H2 destruct
-| #p #q #o0 #q1 #q2 #H1 #H2 destruct
-| #o #p #q #Hpq #o0 #q1 #q2 #H1 #H2 destruct //
-| #o0 #q1 #q2 #_ #H destruct
-]
-qed-.
-
-lemma sprec_fwd_in_whd: ∀p,q. p ≺ q → in_whd q → in_whd p.
-#p #q #H elim H -p -q // /2 width=1/
-[ #p #q * #H destruct
-| #p #q * #H destruct
-| #o #p #q #_ #IHpq * #H destruct /3 width=1/
-]
-qed-.
-
-lemma sprec_fwd_in_inner: ∀p,q. p ≺ q → in_inner p → in_inner q.
-/3 width=3 by sprec_fwd_in_whd/
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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".
-include "paths/standard_order.ma".
-
-(* STANDARD TRACE ***********************************************************)
-
-(* Note: to us, a "standard" computation contracts redexes in non-decreasing positions *)
-definition is_standard: predicate trace ≝ Allr … sle.
-
-lemma is_standard_fwd_append_sn: ∀s,r. is_standard (s@r) → is_standard s.
-/2 width=2 by Allr_fwd_append_sn/
-qed-.
-
-lemma is_standard_fwd_cons: ∀p,s. is_standard (p::s) → is_standard s.
-/2 width=2 by Allr_fwd_cons/
-qed-.
-
-lemma is_standard_fwd_append_dx: ∀s,r. is_standard (s@r) → is_standard r.
-/2 width=2 by Allr_fwd_append_dx/
-qed-.
-
-lemma is_standard_compatible: ∀o,s. is_standard s → is_standard (o:::s).
-#o #s elim s -s // #p * //
-#q #s #IHs * /3 width=1/
-qed.
-
-lemma is_standard_cons: ∀p,s. is_standard s → is_standard ((dx::p)::sn:::s).
-#p #s elim s -s // #q1 * /2 width=1/
-#q2 #s #IHs * /4 width=1/
-qed.
-
-lemma is_standard_append: ∀r. is_standard r → ∀s. is_standard s → is_standard ((dx:::r)@sn:::s).
-#r elim r -r /3 width=1/ #p * /2 width=1/
-#q #r #IHr * /3 width=1/
-qed.
-
-lemma is_standard_inv_compatible_sn: ∀s. is_standard (sn:::s) → is_standard s.
-#s elim s -s // #a1 * // #a2 #s #IHs * #H
-elim (sle_inv_sn … H …) -H [3: // |2: skip ] (**) (* simplify line *)
-#a #Ha1 #H destruct /3 width=1/
-qed-.
-
-lemma is_standard_inv_compatible_rc: ∀s. is_standard (rc:::s) → is_standard s.
-#s elim s -s // #a1 * // #a2 #s #IHs * #H
-elim (sle_inv_rc … H …) -H [4: // |2: skip ] * (**) (* simplify line *)
-[ #a #Ha1 #H destruct /3 width=1/
-| #a #H destruct
-]
-qed-.
-
-lemma is_standard_inv_compatible_dx: ∀s. is_standard (dx:::s) →
- is_inner s → is_standard s.
-#s elim s -s // #a1 * // #a2 #s #IHs * #H
-elim (sle_inv_dx … H …) -H [4: // |3: skip ] (**) (* simplify line *)
-[ * #_ #H1a1 #_ * #H2a1 #_ -IHs
- elim (H2a1 …) -H2a1 -a2 -s //
-| * #a #Ha2 #H destruct #H * #_ /3 width=1/
-qed-.
-
-lemma is_standard_fwd_sle: ∀s2,p2,s1,p1. is_standard ((p1::s1)@(p2::s2)) → p1 ≤ p2.
-#s2 #p2 #s1 elim s1 -s1
-[ #p1 * //
-| #q1 #s1 #IHs1 #p1 * /3 width=3 by sle_trans/
-]
-qed-.
-
-lemma is_standard_in_whd: ∀p. in_whd p → ∀s. is_standard s → is_standard (p::s).
-#p #Hp * // /3 width=1/
-qed.
-
-theorem is_whd_is_standard: ∀s. is_whd s → is_standard s.
-#s elim s -s // #p * //
-#q #s #IHs * /3 width=1/
-qed.
-
-theorem is_whd_is_standard_trans: ∀r. is_whd r → ∀s. is_standard s → is_standard (r@s).
-#r elim r -r // #p *
-[ #_ * /2 width=1/
-| #q #r #IHr * /3 width=1/
-]
-qed.
-
-lemma is_standard_fwd_is_whd: ∀s,p,r. in_whd p → is_standard (r@(p::s)) → is_whd r.
-#s #p #r elim r -r // #q #r #IHr #Hp #H
-lapply (is_standard_fwd_cons … H)
-lapply (is_standard_fwd_sle … H) #Hqp
-lapply (sle_fwd_in_whd … Hqp Hp) /3 width=1/
-qed-.
-
-lemma is_standard_fwd_in_inner: ∀s,p. is_standard (p::s) → in_inner p → is_inner s.
-#s elim s -s // #q #s #IHs #p * #Hpq #Hs #Hp
-lapply (sle_fwd_in_inner … Hpq ?) // -p /3 width=3/
-qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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".
-
-(* TRACE ********************************************************************)
-
-(* Policy: trace metavariables: r, s *)
-definition trace: Type[0] ≝ list path.
-
-definition ho_compatible_rc: predicate (trace→relation term) ≝ λR.
- ∀s,A1,A2. R s A1 A2 → R (rc:::s) (𝛌.A1) (𝛌.A2).
-
-definition ho_compatible_sn: predicate (trace→relation term) ≝ λR.
- ∀s,B1,B2,A. R s B1 B2 → R (sn:::s) (@B1.A) (@B2.A).
-
-definition ho_compatible_dx: predicate (trace→relation term) ≝ λR.
- ∀s,B,A1,A2. R s A1 A2 → R (dx:::s) (@B.A1) (@B.A2).
-
-lemma lstar_compatible_rc: ∀R. compatible_rc R → ho_compatible_rc (lstar … R).
-#R #HR #s #A1 #A2 #H @(lstar_ind_l … s A1 H) -s -A1 // /3 width=3/
-qed.
-
-lemma lstar_compatible_sn: ∀R. compatible_sn R → ho_compatible_sn (lstar … R).
-#R #HR #s #B1 #B2 #A #H @(lstar_ind_l … s B1 H) -s -B1 // /3 width=3/
-qed.
-
-lemma lstar_compatible_dx: ∀R. compatible_dx R → ho_compatible_dx (lstar … R).
-#R #HR #s #B #A1 #A2 #H @(lstar_ind_l … s A1 H) -s -A1 // /3 width=3/
-qed.
-
-(* Note: a "whd" computation contracts just redexes in the whd *)
-definition is_whd: predicate trace ≝ All … in_whd.
-
-lemma is_whd_dx: ∀s. is_whd s → is_whd (dx:::s).
-#s elim s -s //
-#p #s #IHs * /3 width=1/
-qed.
-
-lemma is_whd_append: ∀r. is_whd r → ∀s. is_whd s → is_whd (r@s).
-/2 width=1 by All_append/
-qed.
-
-lemma is_whd_inv_dx: ∀s. is_whd (dx:::s) → is_whd s.
-#s elim s -s //
-#p #s #IHs * * #_ /3 width=1/
-qed-.
-
-lemma is_whd_inv_append: ∀r,s. is_whd (r@s) → is_whd r ∧ is_whd s.
-/2 width=1 by All_inv_append/
-qed-.
-
-(* Note: an "inner" computation contracts just redexes not in the whd *)
-definition is_inner: predicate trace ≝ All … in_inner.
-
-lemma is_inner_append: ∀r. is_inner r → ∀s. is_inner s → is_inner (r@s).
-/2 width=1 by All_append/
-qed.
-
-lemma is_whd_is_inner_inv: ∀s. is_whd s → is_inner s → ◊ = s.
-* // #p #s * #H1p #_ * #H2p #_ elim (H2p …) -H2p //
-qed-.
+++ /dev/null
-NAMING CONVENTIONS FOR METAVARIABLES
-
-A, B, C, D: term
-F,G : subset of subterms
-H : transient premise
-IH : inductive premise
-M, N : term
-P, Q : pointer tree
-R : arbitrary relation
-S : arbitrary small type
-T, U, V, W: subset of subterms
-
-a : arbitrary element
-b,c : boolean mark
-d, e : variable reference level
-f : arbitrary function
-h : relocation height
-i, j : variable reference depth (de Bruijn index)
-k : relocation height
-l : arbitrary list
-m, n : measures on terms
-o : pointer step
-p, q : pointer
-r, s : pointer sequence
+++ /dev/null
-#!/bin/sh
-for MA in `find -name "*.ma"`; do
- echo ${MA}; sed "s!$1!$2!g" ${MA} > ${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
+++ /dev/null
-baseuri=cic:/matita/lambda/
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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 // <plus_minus_m_m //
- | elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #_
- lapply (le_to_lt_to_lt … Hd12 Hid2h) -Hd12 #Hid1
- lapply (ltn_to_ltO … Hid2h) #Hi
- >(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/ <plus_minus //
-| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd12
- >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/ <plus_minus_m_m //
-qed.
-
-definition sdsubstable_f_dx: ∀S:Type[0]. (S → ?) → predicate (relation subterms) ≝ λS,f,R.
- ∀G,F1,F2. R F1 F2 → ∀d. R ([d ↙ (f G)] F1) ([d ↙ (f G)] F2).
-
-lemma lstar_sdsubstable_f_dx: ∀S1,f,S2,R. (∀a. sdsubstable_f_dx S1 f (R a)) →
- ∀l. sdsubstable_f_dx S1 f (lstar S2 … R l).
-#S1 #f #S2 #R #HR #l #G #F1 #F2 #H
-@(lstar_ind_l … l F1 H) -l -F1 // /3 width=3/
-qed.
-(*
-definition sdsubstable_dx: predicate (relation subterms) ≝ λR.
- ∀G,F1,F2. R F1 F2 → ∀d. R ([d ↙ G] F1) ([d ↙ G] F2).
-
-definition sdsubstable: predicate (relation subterms) ≝ λR.
- ∀G1,G2. R G1 G2 → ∀F1,F2. R F1 F2 → ∀d. R ([d ↙ G1] F1) ([d ↙ G2] F2).
-
-lemma star_sdsubstable_dx: ∀R. sdsubstable_dx R → sdsubstable_dx (star … R).
-#R #HR #G #F1 #F2 #H elim H -F2 // /3 width=3/
-qed.
-
-lemma lstar_sdsubstable_dx: ∀S,R. (∀a. sdsubstable_dx (R a)) →
- ∀l. sdsubstable_dx (lstar S … R l).
-#S #R #HR #l #G #F1 #F2 #H
-@(lstar_ind_l … l F1 H) -l -F1 // /3 width=3/
-qed.
-
-lemma star_sdsubstable: ∀R. reflexive ? R →
- sdsubstable R → sdsubstable (star … R).
-#R #H1R #H2 #G1 #G2 #H elim H -G2 /3 width=1/ /3 width=5/
-qed.
-*)
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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/subterms.ma".
-
-(* RELOCATION FOR SUBTERMS **************************************************)
-
-let rec slift h d E on E ≝ match E with
-[ SVRef b i ⇒ {b}#(tri … i d i (i + h) (i + h))
-| SAbst b T ⇒ {b}𝛌.(slift h (d+1) T)
-| SAppl b V T ⇒ {b}@(slift h d V).(slift h d T)
-].
-
-interpretation "relocation for subterms" 'Lift h d E = (slift h d E).
-
-lemma slift_vref_lt: ∀b,d,h,i. i < d → ↑[d, h] {b}#i = {b}#i.
-normalize /3 width=1/
-qed.
-
-lemma slift_vref_ge: ∀b,d,h,i. d ≤ i → ↑[d, h] {b}#i = {b}#(i+h).
-#b #d #h #i #H elim (le_to_or_lt_eq … H) -H
-normalize // /3 width=1/
-qed.
-
-lemma slift_id: ∀E,d. ↑[d, 0] E = E.
-#E elim E -E
-[ #b #i #d elim (lt_or_ge i d) /2 width=1/
-| /3 width=1/
-| /3 width=1/
-]
-qed.
-
-lemma slift_inv_vref_lt: ∀c,j,d. j < d → ∀h,E. ↑[d, h] E = {c}#j → E = {c}#j.
-#c #j #d #Hjd #h * normalize
-[ #b #i elim (lt_or_eq_or_gt i d) #Hid
- [ >(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/ <plus_minus_m_m // /2 width=2/
-qed.
-
-(* Note: this is "∀h,d. injective … (slift h d)" *)
-theorem slift_inj: ∀h,E1,E2,d. ↑[d, h] E2 = ↑[d, h] E1 → E2 = E1.
-#h #E1 elim E1 -E1
-[ #b #i #E2 #d #H elim (lt_or_ge i d) #Hid
- [ >(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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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.
-*)
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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_lift_le // /2 width=1/
-qed.
-
-lemma pred_inv_lift: deliftable_sn pred.
-#h #N1 #N2 #H elim H -N1 -N2 /2 width=3/
-[ #C1 #C2 #_ #IHC12 #d #M1 #H
- elim (lift_inv_abst … H) -H #A1 #HAC1 #H
- elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
- @(ex2_intro … (𝛌.A2)) // /2 width=1/
-| #D1 #D2 #C1 #C2 #_ #_ #IHD12 #IHC12 #d #M1 #H
- elim (lift_inv_appl … H) -H #B1 #A1 #HBD1 #HAC1 #H
- elim (IHD12 … HBD1) -D1 #B2 #HB12 #HBD2
- elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
- @(ex2_intro … (@B2.A2)) // /2 width=1/
-| #D1 #D2 #C1 #C2 #_ #_ #IHD12 #IHC12 #d #M1 #H
- elim (lift_inv_appl … H) -H #B1 #M #HBD1 #HM #H1
- elim (lift_inv_abst … HM) -HM #A1 #HAC1 #H
- elim (IHD12 … HBD1) -D1 #B2 #HB12 #HBD2
- elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
- @(ex2_intro … ([↙B2]A2)) /2 width=1/
-]
-qed-.
-
-lemma pred_dsubst: dsubstable pred.
-#N1 #N2 #HN12 #M1 #M2 #H elim H -M1 -M2
-[ #i #d elim (lt_or_eq_or_gt i d) #Hid
- [ >(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.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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 // <plus_minus_m_m //
- | elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #_
- lapply (le_to_lt_to_lt … Hd12 Hid2h) -Hd12 #Hid1
- lapply (ltn_to_ltO … Hid2h) #Hi
- >(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/ <plus_minus //
-| normalize #B #A #IHB #IHA #d1 #d2 #Hd12
- >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/ <plus_minus_m_m //
-qed.
-
-definition dsubstable_dx: predicate (relation term) ≝ λR.
- ∀N,M1,M2. R M1 M2 → ∀d. R ([d ↙ N] M1) ([d ↙ N] M2).
-
-definition dsubstable: predicate (relation term) ≝ λR.
- ∀N1,N2. R N1 N2 → ∀M1,M2. R M1 M2 → ∀d. R ([d ↙ N1] M1) ([d ↙ N2] M2).
-
-lemma star_dsubstable_dx: ∀R. dsubstable_dx R → dsubstable_dx (star … R).
-#R #HR #N #M1 #M2 #H elim H -M2 // /3 width=3/
-qed.
-
-lemma lstar_dsubstable_dx: ∀S,R. (∀a. dsubstable_dx (R a)) →
- ∀l. dsubstable_dx (lstar S … R l).
-#S #R #HR #l #N #M1 #M2 #H
-@(lstar_ind_l … l M1 H) -l -M1 // /3 width=3/
-qed.
-
-lemma star_dsubstable: ∀R. reflexive ? R →
- dsubstable R → dsubstable (star … R).
-#R #H1R #H2 #N1 #N2 #H elim H -N2 /3 width=1/ /3 width=5/
-qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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/term.ma".
-
-(* RELOCATION ***************************************************************)
-
-(* Policy: level metavariables : d, e
- height metavariables: h, k
-*)
-(* Note: indexes start at zero *)
-let rec lift h d M on M ≝ match M with
-[ VRef i ⇒ #(tri … i d i (i + h) (i + h))
-| Abst A ⇒ 𝛌. (lift h (d+1) A)
-| Appl B A ⇒ @(lift h d B). (lift h d A)
-].
-
-interpretation "relocation" 'Lift h d M = (lift h d M).
-
-lemma lift_vref_lt: ∀d,h,i. i < d → ↑[d, h] #i = #i.
-normalize /3 width=1/
-qed.
-
-lemma lift_vref_ge: ∀d,h,i. d ≤ i → ↑[d, h] #i = #(i+h).
-#d #h #i #H elim (le_to_or_lt_eq … H) -H
-normalize // /3 width=1/
-qed.
-
-lemma lift_id: ∀M,d. ↑[d, 0] M = M.
-#M elim M -M
-[ #i #d elim (lt_or_ge i d) /2 width=1/
-| /3 width=1/
-| /3 width=1/
-]
-qed.
-
-lemma lift_inv_vref_lt: ∀j,d. j < d → ∀h,M. ↑[d, h] M = #j → M = #j.
-#j #d #Hjd #h * normalize
-[ #i elim (lt_or_eq_or_gt i d) #Hid
- [ >(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/ <plus_minus_m_m // /2 width=2/
-qed.
-
-(* Note: this is "∀h,d. injective … (lift h d)" *)
-theorem lift_inj: ∀h,M1,M2,d. ↑[d, h] M2 = ↑[d, h] M1 → M2 = M1.
-#h #M1 elim M1 -M1
-[ #i #M2 #d #H elim (lt_or_ge i d) #Hid
- [ >(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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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_lift_le //
-qed.
-
-lemma sred_inv_lift: deliftable_sn sred.
-#h #N1 #N2 #H elim H -N1 -N2
-[ #D #C #d #M1 #H
- elim (lift_inv_appl … H) -H #B #M #H0 #HM #H destruct
- elim (lift_inv_abst … HM) -HM #A #H0 #H destruct /3 width=3/
-| #C1 #C2 #_ #IHC12 #d #M1 #H
- elim (lift_inv_abst … H) -H #A1 #HAC1 #H
- elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
- @(ex2_intro … (𝛌.A2)) // /2 width=1/
-| #D1 #D2 #C1 #_ #IHD12 #d #M1 #H
- elim (lift_inv_appl … H) -H #B1 #A #HBD1 #H1 #H2
- elim (IHD12 … HBD1) -D1 #B2 #HB12 #HBD2 destruct
- @(ex2_intro … (@B2.A)) // /2 width=1/
-| #D1 #C1 #C2 #_ #IHC12 #d #M1 #H
- elim (lift_inv_appl … H) -H #B #A1 #H1 #HAC1 #H2
- elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
- @(ex2_intro … (@B.A2)) // /2 width=1/
-]
-qed-.
-
-lemma sred_dsubst: dsubstable_dx sred.
-#D1 #M1 #M2 #H elim H -M1 -M2 normalize /2 width=1/
-#D2 #A #d >dsubst_dsubst_ge //
-qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||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.
+++ /dev/null
-<?xml version="1.0" encoding="utf-8"?>
-<helm_registry>
- <section name="matita">
- <key name="rt_base_dir">$(MATITA_RT_BASE_DIR)</key>
- </section>
- <section name="xoa">
- <key name="output_dir">contribs/lambda/background/</key>
- <key name="objects">xoa</key>
- <key name="notations">xoa_notation</key>
- <key name="include">basics/pts.ma</key>
- <key name="ex">1 2</key>
- <key name="ex">2 2</key>
- <key name="ex">2 3</key>
- <key name="ex">3 1</key>
- <key name="ex">3 2</key>
- <key name="ex">3 3</key>
- <key name="ex">3 4</key>
- <key name="ex">4 1</key>
- <key name="ex">4 2</key>
- <key name="ex">4 3</key>
- <key name="or">3</key>
- </section>
-</helm_registry>
--- /dev/null
+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) | $<
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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 }.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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).
+
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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 }.
+
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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).
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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_lift_le //
+qed.
+
+lemma pl_sred_inv_lift: ∀p. deliftable_sn (pl_sred p).
+#p #h #N1 #N2 #H elim H -p -N1 -N2
+[ #D #C #d #M1 #H
+ elim (lift_inv_appl … H) -H #B #M #H0 #HM #H destruct
+ elim (lift_inv_abst … HM) -HM #A #H0 #H destruct /3 width=3/
+| #p #C1 #C2 #_ #IHC12 #d #M1 #H
+ elim (lift_inv_abst … H) -H #A1 #HAC1 #H
+ elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
+ @(ex2_intro … (𝛌.A2)) // /2 width=1/
+| #p #D1 #D2 #C1 #_ #IHD12 #d #M1 #H
+ elim (lift_inv_appl … H) -H #B1 #A #HBD1 #H1 #H2
+ elim (IHD12 … HBD1) -D1 #B2 #HB12 #HBD2 destruct
+ @(ex2_intro … (@B2.A)) // /2 width=1/
+| #p #D1 #C1 #C2 #_ #IHC12 #d #M1 #H
+ elim (lift_inv_appl … H) -H #B #A1 #H1 #HAC1 #H2
+ elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
+ @(ex2_intro … (@B.A2)) // /2 width=1/
+]
+qed-.
+
+lemma pl_sred_dsubst: ∀p. dsubstable_dx (pl_sred p).
+#p #D1 #M1 #M2 #H elim H -p -M1 -M2 normalize /2 width=1/
+#D2 #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-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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_slift_le //
+| #b #p #V1 #V2 #T #_ #IHV12 #d
+ whd in ⊢ (??%%); <booleanized_lift /2 width=1/ (**) (* auto needs some help here *)
+]
+qed.
+
+lemma pl_st_inv_lift: ∀p. sdeliftable_sn (pl_st p).
+#p #h #G1 #G2 #H elim H -p -G1 -G2
+[ #W #U #d #F1 #H
+ elim (slift_inv_appl … H) -H #V #F #H0 #HF #H destruct
+ elim (slift_inv_abst … HF) -HF #T #H0 #H destruct /3 width=3/
+| #b #p #U1 #U2 #_ #IHU12 #d #F1 #H
+ elim (slift_inv_abst … H) -H #T1 #HTU1 #H
+ elim (IHU12 … HTU1) -U1 #T2 #HT12 #HTU2 destruct
+ @(ex2_intro … ({⊥}𝛌.T2)) // /2 width=1/
+| #b #p #W1 #W2 #U1 #_ #IHW12 #d #F1 #H
+ elim (slift_inv_appl … H) -H #V1 #T #HVW1 #H1 #H2
+ elim (IHW12 … HVW1) -W1 #V2 #HV12 #HVW2 destruct
+ @(ex2_intro … ({⊥}@V2.{⊥}⇕T)) [ /2 width=1/ ]
+ whd in ⊢ (??%%); // (**) (* auto needs some help here *)
+| #b #p #W1 #U1 #U2 #_ #IHU12 #d #F1 #H
+ elim (slift_inv_appl … H) -H #V #T1 #H1 #HTU1 #H2
+ elim (IHU12 … HTU1) -U1 #T2 #HT12 #HTU2 destruct
+ @(ex2_intro … ({b}@V.T2)) // /2 width=1/
+]
+qed-.
+
+lemma pl_st_dsubst: ∀p. sdsubstable_f_dx … (booleanized ⊥) (pl_st p).
+#p #W1 #F1 #F2 #H elim H -p -F1 -F2 /2 width=1/
+[ #W2 #T #d normalize >sdsubst_sdsubst_ge //
+| #b #p #V1 #V2 #T #_ #IHV12 #d
+ whd in ⊢ (??%%); <(booleanized_booleanized ⊥) in ⊢ (???(???%)); <booleanized_dsubst /2 width=1/ (**) (* auto needs some help here *)
+]
+qed.
+
+lemma pl_st_inv_empty: ∀p,F1,F2. F1 Ⓡ↦[p] F2 → ∀M1. {⊥}⇑M1 = F1 → ⊥.
+#p #F1 #F2 #H elim H -p -F1 -F2
+[ #V #T #M1 #H
+ elim (boolean_inv_appl … H) -H #B #A #H destruct
+| #b #p #T1 #T2 #_ #IHT12 #M1 #H
+ elim (boolean_inv_abst … H) -H /2 width=2/
+| #b #p #V1 #V2 #T #_ #IHV12 #M1 #H
+ elim (boolean_inv_appl … H) -H /2 width=2/
+| #b #p #V #T1 #T2 #_ #IHT12 #M1 #H
+ elim (boolean_inv_appl … H) -H /2 width=2/
+]
+qed-.
+
+theorem pl_st_mono: ∀p. singlevalued … (pl_st p).
+#p #F #G1 #H elim H -p -F -G1
+[ #V #T #G2 #H elim (pl_st_inv_nil … H …) -H //
+ #W #U #H #HG2 destruct //
+| #b #p #T1 #T2 #_ #IHT12 #G2 #H elim (pl_st_inv_rc … H …) -H [3: // |2: skip ] (**) (* simplify line *)
+ #c #U1 #U2 #HU12 #H #HG2 destruct /3 width=1/
+| #b #p #V1 #V2 #T #_ #IHV12 #G2 #H elim (pl_st_inv_sn … H …) -H [3: // |2: skip ] (**) (* simplify line *)
+ #c #W1 #W2 #U #HW12 #H #HG2 destruct /3 width=1/
+| #b #p #V #T1 #T2 #_ #IHT12 #G2 #H elim (pl_st_inv_dx … H …) -H [3: // |2: skip ] (**) (* simplify line *)
+ #c #W #U1 #U2 #HU12 #H #HG2 destruct /3 width=1/
+]
+qed-.
+
+theorem pl_st_fwd_sle: ∀p1,F1,F. F1 Ⓡ↦[p1] F →
+ ∀p2,F2. F Ⓡ↦[p2] F2 → p1 ≤ p2.
+#p1 #F1 #F #H elim H -p1 -F1 -F //
+[ #b #p #T1 #T #_ #IHT1 #p2 #F2 #H elim (pl_st_inv_abst … H …) -H [3: // |2,4: skip ] (**) (* simplify line *)
+ #q #T2 #HT2 #H1 #H2 destruct /3 width=2/
+| #b #p #V1 #V #T #_ #IHV1 #p2 #F2 #H elim (pl_st_inv_appl … H …) -H [7: // |2,3,4: skip ] * (**) (* simplify line *)
+ [ #U #H destruct
+ | #q #V2 #H1 #HV2 #H2 destruct /3 width=2/
+ | #q #U #_ #H elim (pl_st_inv_empty … H …) [ // | skip ] (**) (* simplify line *)
+ ]
+| #b #p #V #T1 #T #HT1 #IHT1 #p2 #F2 #H elim (pl_st_inv_appl … H …) -H [7: // |2,3,4: skip ] * (**) (* simplify line *)
+ [ #U #_ #H1 #H2 #_ -b -V -F2 -IHT1
+ elim (pl_st_fwd_abst … HT1 … H2) // -H1 * #q #H
+ elim (pl_st_inv_rc … HT1 … H) -HT1 -H #b #U1 #U2 #_ #_ #H -b -q -T1 -U1 destruct
+ | #q #V2 #H1 #_ #_ -b -F2 -T1 -T -V -V2 destruct //
+ | #q #T2 #H1 #HT2 #H2 -b -F2 -T1 -V /3 width=2/
+ ]
+]
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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/term.ma".
+
+(* PATH *********************************************************************)
+
+(* Policy: path step metavariables: o *)
+(* Note: this is a step of a path in the tree representation of a term:
+ rc (rectus) : proceed on the argument of an abstraction
+ sn (sinister): proceed on the left argument of an application
+ dx (dexter) : proceed on the right argument of an application
+*)
+inductive step: Type[0] ≝
+| rc: step
+| sn: step
+| dx: step
+.
+
+definition is_dx: predicate step ≝ λo. dx = o.
+
+(* Policy: path metavariables: p, q *)
+(* Note: this is a path in the tree representation of a term, heading to a redex *)
+definition path: Type[0] ≝ list step.
+
+definition compatible_rc: predicate (path→relation term) ≝ λR.
+ ∀p,A1,A2. R p A1 A2 → R (rc::p) (𝛌.A1) (𝛌.A2).
+
+definition compatible_sn: predicate (path→relation term) ≝ λR.
+ ∀p,B1,B2,A. R p B1 B2 → R (sn::p) (@B1.A) (@B2.A).
+
+definition compatible_dx: predicate (path→relation term) ≝ λR.
+ ∀p,B,A1,A2. R p A1 A2 → R (dx::p) (@B.A1) (@B.A2).
+
+(* Note: a redex is "in the whd" when is not under an abstraction nor in the left argument of an application *)
+definition in_whd: predicate path ≝ All … is_dx.
+
+lemma in_whd_ind: ∀R:predicate path. R (◊) →
+ (∀p. in_whd p → R p → R (dx::p)) →
+ ∀p. in_whd p → R p.
+#R #H #IH #p elim p -p // -H *
+#p #IHp * #H1 #H2 destruct /3 width=1/
+qed-.
+
+(* Note: a redex is "inner" when is not in the whd *)
+definition in_inner: predicate path ≝ λp. in_whd p → ⊥.
+
+lemma in_inner_rc: ∀p. in_inner (rc::p).
+#p * normalize #H destruct
+qed.
+
+lemma in_inner_sn: ∀p. in_inner (sn::p).
+#p * normalize #H destruct
+qed.
+
+lemma in_inner_cons: ∀o,p. in_inner p → in_inner (o::p).
+#o #p #H1p * /2 width=1/
+qed.
+
+lemma in_inner_inv_dx: ∀p. in_inner (dx::p) → in_inner p.
+/3 width=1/
+qed-.
+
+lemma in_whd_or_in_inner: ∀p. in_whd p ∨ in_inner p.
+#p elim p -p /2 width=1/ #o #p * #Hp /3 width=1/ cases o -o /2 width=1/ /3 width=1/
+qed-.
+
+lemma in_inner_ind: ∀R:predicate path.
+ (∀p. R (rc::p)) → (∀p. R (sn::p)) →
+ (∀p. in_inner p → R p → R (dx::p)) →
+ ∀p. in_inner p → R p.
+#R #H1 #H2 #IH #p elim p -p
+[ #H elim (H …) -H //
+| * #p #IHp // #H
+ lapply (in_inner_inv_dx … H) -H /3 width=1/
+]
+qed-.
+
+lemma in_inner_inv: ∀p. in_inner p →
+ ∨∨ ∃q. rc::q = p | ∃q. sn::q = p
+ | ∃∃q. in_inner q & dx::q = p.
+@in_inner_ind /3 width=2/ /3 width=3/
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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".
+
+(* STANDARD ORDER ************************************************************)
+
+(* Note: this is p ≤ q *)
+definition sle: relation path ≝ star … sprec.
+
+interpretation "standard 'less or equal to' on paths"
+ 'leq p q = (sle p q).
+
+lemma sle_step_rc: ∀p,q. p ≺ q → p ≤ q.
+/2 width=1/
+qed.
+
+lemma sle_step_sn: ∀p1,p,p2. p1 ≺ p → p ≤ p2 → p1 ≤ p2.
+/2 width=3/
+qed-.
+
+lemma sle_rc: ∀p,q. dx::p ≤ rc::q.
+/2 width=1/
+qed.
+
+lemma sle_sn: ∀p,q. rc::p ≤ sn::q.
+/2 width=1/
+qed.
+
+lemma sle_skip: dx::◊ ≤ ◊.
+/2 width=1/
+qed.
+
+lemma sle_nil: ∀p. ◊ ≤ p.
+* // /2 width=1/
+qed.
+
+lemma sle_comp: ∀p1,p2. p1 ≤ p2 → ∀o. (o::p1) ≤ (o::p2).
+#p1 #p2 #H elim H -p2 // /3 width=3/
+qed.
+
+lemma sle_skip_sle: ∀p. p ≤ ◊ → dx::p ≤ ◊.
+#p #H @(star_ind_l … p H) -p //
+#p #q #Hpq #_ #H @(sle_step_sn … H) -H /2 width=1/
+qed.
+
+theorem sle_trans: transitive … sle.
+/2 width=3/
+qed-.
+
+lemma sle_cons: ∀p,q. dx::p ≤ sn::q.
+#p #q
+@(sle_trans … (rc::q)) /2 width=1/
+qed.
+
+lemma sle_dichotomy: ∀p1,p2:path. p1 ≤ p2 ∨ p2 ≤ p1.
+#p1 elim p1 -p1
+[ * /2 width=1/
+| #o1 #p1 #IHp1 * /2 width=1/
+ * #p2 cases o1 -o1 /2 width=1/
+ elim (IHp1 p2) -IHp1 /3 width=1/
+]
+qed-.
+
+lemma sle_inv_dx: ∀p,q. p ≤ q → ∀q0. dx::q0 = q →
+ in_whd p ∨ ∃∃p0. p0 ≤ q0 & dx::p0 = p.
+#p #q #H @(star_ind_l … p H) -p [ /3 width=3/ ]
+#p0 #p #Hp0 #_ #IHpq #q1 #H destruct
+elim (IHpq …) -IHpq [4: // |3: skip ] (**) (* simplify line *)
+[ lapply (sprec_fwd_in_whd … Hp0) -Hp0 /3 width=1/
+| * #p1 #Hpq1 #H elim (sprec_inv_dx … Hp0 … H) -p
+ [ #H destruct /2 width=1/
+ | * /4 width=3/
+ ]
+]
+qed-.
+
+lemma sle_inv_rc: ∀p,q. p ≤ q → ∀p0. rc::p0 = p →
+ (∃∃q0. p0 ≤ q0 & rc::q0 = q) ∨
+ ∃q0. sn::q0 = q.
+#p #q #H elim H -q /3 width=3/
+#q #q0 #_ #Hq0 #IHpq #p0 #H destruct
+elim (IHpq p0 …) -IHpq // *
+[ #p1 #Hp01 #H
+ elim (sprec_inv_rc … Hq0 … H) -q * /3 width=3/ /4 width=3/
+| #p1 #H elim (sprec_inv_sn … Hq0 … H) -q /3 width=2/
+]
+qed-.
+
+lemma sle_inv_sn: ∀p,q. p ≤ q → ∀p0. sn::p0 = p →
+ ∃∃q0. p0 ≤ q0 & sn::q0 = q.
+#p #q #H elim H -q /2 width=3/
+#q #q0 #_ #Hq0 #IHpq #p0 #H destruct
+elim (IHpq p0 …) -IHpq // #p1 #Hp01 #H
+elim (sprec_inv_sn … Hq0 … H) -q /3 width=3/
+qed-.
+
+lemma in_whd_sle_nil: ∀p. in_whd p → p ≤ ◊.
+#p #H @(in_whd_ind … H) -p // /2 width=1/
+qed.
+
+theorem in_whd_sle: ∀p. in_whd p → ∀q. p ≤ q.
+#p #H @(in_whd_ind … H) -p //
+#p #_ #IHp * /3 width=1/ * #q /2 width=1/
+qed.
+
+lemma sle_nil_inv_in_whd: ∀p. p ≤ ◊ → in_whd p.
+#p #H @(star_ind_l … p H) -p // /2 width=3 by sprec_fwd_in_whd/
+qed-.
+
+lemma sle_inv_in_whd: ∀p. (∀q. p ≤ q) → in_whd p.
+/2 width=1 by sle_nil_inv_in_whd/
+qed-.
+
+lemma sle_fwd_in_whd: ∀p,q. p ≤ q → in_whd q → in_whd p.
+#p #q #H @(star_ind_l … p H) -p // /3 width=3 by sprec_fwd_in_whd/
+qed-.
+
+lemma sle_fwd_in_inner: ∀p,q. p ≤ q → in_inner p → in_inner q.
+/3 width=3 by sle_fwd_in_whd/
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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".
+
+(* STANDARD PRECEDENCE ******************************************************)
+
+(* Note: standard precedence relation on paths: p ≺ q
+ to serve as base for the order relations: p < q and p ≤ q *)
+inductive sprec: relation path ≝
+| sprec_nil : ∀o,q. sprec (◊) (o::q)
+| sprec_rc : ∀p,q. sprec (dx::p) (rc::q)
+| sprec_sn : ∀p,q. sprec (rc::p) (sn::q)
+| sprec_comp: ∀o,p,q. sprec p q → sprec (o::p) (o::q)
+| sprec_skip: sprec (dx::◊) ◊
+.
+
+interpretation "standard 'precedes' on paths"
+ 'prec p q = (sprec p q).
+
+lemma sprec_inv_sn: ∀p,q. p ≺ q → ∀p0. sn::p0 = p →
+ ∃∃q0. p0 ≺ q0 & sn::q0 = q.
+#p #q * -p -q
+[ #o #q #p0 #H destruct
+| #p #q #p0 #H destruct
+| #p #q #p0 #H destruct
+| #o #p #q #Hpq #p0 #H destruct /2 width=3/
+| #p0 #H destruct
+]
+qed-.
+
+lemma sprec_inv_dx: ∀p,q. p ≺ q → ∀q0. dx::q0 = q →
+ ◊ = p ∨ ∃∃p0. p0 ≺ q0 & dx::p0 = p.
+#p #q * -p -q
+[ #o #q #q0 #H destruct /2 width=1/
+| #p #q #q0 #H destruct
+| #p #q #q0 #H destruct
+| #o #p #q #Hpq #q0 #H destruct /3 width=3/
+| #q0 #H destruct
+]
+qed-.
+
+lemma sprec_inv_rc: ∀p,q. p ≺ q → ∀p0. rc::p0 = p →
+ (∃∃q0. p0 ≺ q0 & rc::q0 = q) ∨
+ ∃q0. sn::q0 = q.
+#p #q * -p -q
+[ #o #q #p0 #H destruct
+| #p #q #p0 #H destruct
+| #p #q #p0 #H destruct /3 width=2/
+| #o #p #q #Hpq #p0 #H destruct /3 width=3/
+| #p0 #H destruct
+]
+qed-.
+
+lemma sprec_inv_comp: ∀p1,p2. p1 ≺ p2 →
+ ∀o,q1,q2. o::q1 = p1 → o::q2 = p2 → q1 ≺ q2.
+#p1 #p2 * -p1 -p2
+[ #o #q #o0 #q1 #q2 #H destruct
+| #p #q #o0 #q1 #q2 #H1 #H2 destruct
+| #p #q #o0 #q1 #q2 #H1 #H2 destruct
+| #o #p #q #Hpq #o0 #q1 #q2 #H1 #H2 destruct //
+| #o0 #q1 #q2 #_ #H destruct
+]
+qed-.
+
+lemma sprec_fwd_in_whd: ∀p,q. p ≺ q → in_whd q → in_whd p.
+#p #q #H elim H -p -q // /2 width=1/
+[ #p #q * #H destruct
+| #p #q * #H destruct
+| #o #p #q #_ #IHpq * #H destruct /3 width=1/
+]
+qed-.
+
+lemma sprec_fwd_in_inner: ∀p,q. p ≺ q → in_inner p → in_inner q.
+/3 width=3 by sprec_fwd_in_whd/
+qed-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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".
+include "paths/standard_order.ma".
+
+(* STANDARD TRACE ***********************************************************)
+
+(* Note: to us, a "standard" computation contracts redexes in non-decreasing positions *)
+definition is_standard: predicate trace ≝ Allr … sle.
+
+lemma is_standard_fwd_append_sn: ∀s,r. is_standard (s@r) → is_standard s.
+/2 width=2 by Allr_fwd_append_sn/
+qed-.
+
+lemma is_standard_fwd_cons: ∀p,s. is_standard (p::s) → is_standard s.
+/2 width=2 by Allr_fwd_cons/
+qed-.
+
+lemma is_standard_fwd_append_dx: ∀s,r. is_standard (s@r) → is_standard r.
+/2 width=2 by Allr_fwd_append_dx/
+qed-.
+
+lemma is_standard_compatible: ∀o,s. is_standard s → is_standard (o:::s).
+#o #s elim s -s // #p * //
+#q #s #IHs * /3 width=1/
+qed.
+
+lemma is_standard_cons: ∀p,s. is_standard s → is_standard ((dx::p)::sn:::s).
+#p #s elim s -s // #q1 * /2 width=1/
+#q2 #s #IHs * /4 width=1/
+qed.
+
+lemma is_standard_append: ∀r. is_standard r → ∀s. is_standard s → is_standard ((dx:::r)@sn:::s).
+#r elim r -r /3 width=1/ #p * /2 width=1/
+#q #r #IHr * /3 width=1/
+qed.
+
+lemma is_standard_inv_compatible_sn: ∀s. is_standard (sn:::s) → is_standard s.
+#s elim s -s // #a1 * // #a2 #s #IHs * #H
+elim (sle_inv_sn … H …) -H [3: // |2: skip ] (**) (* simplify line *)
+#a #Ha1 #H destruct /3 width=1/
+qed-.
+
+lemma is_standard_inv_compatible_rc: ∀s. is_standard (rc:::s) → is_standard s.
+#s elim s -s // #a1 * // #a2 #s #IHs * #H
+elim (sle_inv_rc … H …) -H [4: // |2: skip ] * (**) (* simplify line *)
+[ #a #Ha1 #H destruct /3 width=1/
+| #a #H destruct
+]
+qed-.
+
+lemma is_standard_inv_compatible_dx: ∀s. is_standard (dx:::s) →
+ is_inner s → is_standard s.
+#s elim s -s // #a1 * // #a2 #s #IHs * #H
+elim (sle_inv_dx … H …) -H [4: // |3: skip ] (**) (* simplify line *)
+[ * #_ #H1a1 #_ * #H2a1 #_ -IHs
+ elim (H2a1 …) -H2a1 -a2 -s //
+| * #a #Ha2 #H destruct #H * #_ /3 width=1/
+qed-.
+
+lemma is_standard_fwd_sle: ∀s2,p2,s1,p1. is_standard ((p1::s1)@(p2::s2)) → p1 ≤ p2.
+#s2 #p2 #s1 elim s1 -s1
+[ #p1 * //
+| #q1 #s1 #IHs1 #p1 * /3 width=3 by sle_trans/
+]
+qed-.
+
+lemma is_standard_in_whd: ∀p. in_whd p → ∀s. is_standard s → is_standard (p::s).
+#p #Hp * // /3 width=1/
+qed.
+
+theorem is_whd_is_standard: ∀s. is_whd s → is_standard s.
+#s elim s -s // #p * //
+#q #s #IHs * /3 width=1/
+qed.
+
+theorem is_whd_is_standard_trans: ∀r. is_whd r → ∀s. is_standard s → is_standard (r@s).
+#r elim r -r // #p *
+[ #_ * /2 width=1/
+| #q #r #IHr * /3 width=1/
+]
+qed.
+
+lemma is_standard_fwd_is_whd: ∀s,p,r. in_whd p → is_standard (r@(p::s)) → is_whd r.
+#s #p #r elim r -r // #q #r #IHr #Hp #H
+lapply (is_standard_fwd_cons … H)
+lapply (is_standard_fwd_sle … H) #Hqp
+lapply (sle_fwd_in_whd … Hqp Hp) /3 width=1/
+qed-.
+
+lemma is_standard_fwd_in_inner: ∀s,p. is_standard (p::s) → in_inner p → is_inner s.
+#s elim s -s // #q #s #IHs #p * #Hpq #Hs #Hp
+lapply (sle_fwd_in_inner … Hpq ?) // -p /3 width=3/
+qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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".
+
+(* TRACE ********************************************************************)
+
+(* Policy: trace metavariables: r, s *)
+definition trace: Type[0] ≝ list path.
+
+definition ho_compatible_rc: predicate (trace→relation term) ≝ λR.
+ ∀s,A1,A2. R s A1 A2 → R (rc:::s) (𝛌.A1) (𝛌.A2).
+
+definition ho_compatible_sn: predicate (trace→relation term) ≝ λR.
+ ∀s,B1,B2,A. R s B1 B2 → R (sn:::s) (@B1.A) (@B2.A).
+
+definition ho_compatible_dx: predicate (trace→relation term) ≝ λR.
+ ∀s,B,A1,A2. R s A1 A2 → R (dx:::s) (@B.A1) (@B.A2).
+
+lemma lstar_compatible_rc: ∀R. compatible_rc R → ho_compatible_rc (lstar … R).
+#R #HR #s #A1 #A2 #H @(lstar_ind_l … s A1 H) -s -A1 // /3 width=3/
+qed.
+
+lemma lstar_compatible_sn: ∀R. compatible_sn R → ho_compatible_sn (lstar … R).
+#R #HR #s #B1 #B2 #A #H @(lstar_ind_l … s B1 H) -s -B1 // /3 width=3/
+qed.
+
+lemma lstar_compatible_dx: ∀R. compatible_dx R → ho_compatible_dx (lstar … R).
+#R #HR #s #B #A1 #A2 #H @(lstar_ind_l … s A1 H) -s -A1 // /3 width=3/
+qed.
+
+(* Note: a "whd" computation contracts just redexes in the whd *)
+definition is_whd: predicate trace ≝ All … in_whd.
+
+lemma is_whd_dx: ∀s. is_whd s → is_whd (dx:::s).
+#s elim s -s //
+#p #s #IHs * /3 width=1/
+qed.
+
+lemma is_whd_append: ∀r. is_whd r → ∀s. is_whd s → is_whd (r@s).
+/2 width=1 by All_append/
+qed.
+
+lemma is_whd_inv_dx: ∀s. is_whd (dx:::s) → is_whd s.
+#s elim s -s //
+#p #s #IHs * * #_ /3 width=1/
+qed-.
+
+lemma is_whd_inv_append: ∀r,s. is_whd (r@s) → is_whd r ∧ is_whd s.
+/2 width=1 by All_inv_append/
+qed-.
+
+(* Note: an "inner" computation contracts just redexes not in the whd *)
+definition is_inner: predicate trace ≝ All … in_inner.
+
+lemma is_inner_append: ∀r. is_inner r → ∀s. is_inner s → is_inner (r@s).
+/2 width=1 by All_append/
+qed.
+
+lemma is_whd_is_inner_inv: ∀s. is_whd s → is_inner s → ◊ = s.
+* // #p #s * #H1p #_ * #H2p #_ elim (H2p …) -H2p //
+qed-.
--- /dev/null
+NAMING CONVENTIONS FOR METAVARIABLES
+
+A, B, C, D: term
+F,G : subset of subterms
+H : transient premise
+IH : inductive premise
+M, N : term
+P, Q : pointer tree
+R : arbitrary relation
+S : arbitrary small type
+T, U, V, W: subset of subterms
+
+a : arbitrary element
+b,c : boolean mark
+d, e : variable reference level
+f : arbitrary function
+h : relocation height
+i, j : variable reference depth (de Bruijn index)
+k : relocation height
+l : arbitrary list
+m, n : measures on terms
+o : pointer step
+p, q : pointer
+r, s : pointer sequence
--- /dev/null
+#!/bin/sh
+for MA in `find -name "*.ma"`; do
+ echo ${MA}; sed "s!$1!$2!g" ${MA} > ${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
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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 // <plus_minus_m_m //
+ | elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #_
+ lapply (le_to_lt_to_lt … Hd12 Hid2h) -Hd12 #Hid1
+ lapply (ltn_to_ltO … Hid2h) #Hi
+ >(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/ <plus_minus //
+| normalize #b #V #T #IHV #IHT #d1 #d2 #Hd12
+ >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/ <plus_minus_m_m //
+qed.
+
+definition sdsubstable_f_dx: ∀S:Type[0]. (S → ?) → predicate (relation subterms) ≝ λS,f,R.
+ ∀G,F1,F2. R F1 F2 → ∀d. R ([d ↙ (f G)] F1) ([d ↙ (f G)] F2).
+
+lemma lstar_sdsubstable_f_dx: ∀S1,f,S2,R. (∀a. sdsubstable_f_dx S1 f (R a)) →
+ ∀l. sdsubstable_f_dx S1 f (lstar S2 … R l).
+#S1 #f #S2 #R #HR #l #G #F1 #F2 #H
+@(lstar_ind_l … l F1 H) -l -F1 // /3 width=3/
+qed.
+(*
+definition sdsubstable_dx: predicate (relation subterms) ≝ λR.
+ ∀G,F1,F2. R F1 F2 → ∀d. R ([d ↙ G] F1) ([d ↙ G] F2).
+
+definition sdsubstable: predicate (relation subterms) ≝ λR.
+ ∀G1,G2. R G1 G2 → ∀F1,F2. R F1 F2 → ∀d. R ([d ↙ G1] F1) ([d ↙ G2] F2).
+
+lemma star_sdsubstable_dx: ∀R. sdsubstable_dx R → sdsubstable_dx (star … R).
+#R #HR #G #F1 #F2 #H elim H -F2 // /3 width=3/
+qed.
+
+lemma lstar_sdsubstable_dx: ∀S,R. (∀a. sdsubstable_dx (R a)) →
+ ∀l. sdsubstable_dx (lstar S … R l).
+#S #R #HR #l #G #F1 #F2 #H
+@(lstar_ind_l … l F1 H) -l -F1 // /3 width=3/
+qed.
+
+lemma star_sdsubstable: ∀R. reflexive ? R →
+ sdsubstable R → sdsubstable (star … R).
+#R #H1R #H2 #G1 #G2 #H elim H -G2 /3 width=1/ /3 width=5/
+qed.
+*)
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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/subterms.ma".
+
+(* RELOCATION FOR SUBTERMS **************************************************)
+
+let rec slift h d E on E ≝ match E with
+[ SVRef b i ⇒ {b}#(tri … i d i (i + h) (i + h))
+| SAbst b T ⇒ {b}𝛌.(slift h (d+1) T)
+| SAppl b V T ⇒ {b}@(slift h d V).(slift h d T)
+].
+
+interpretation "relocation for subterms" 'Lift h d E = (slift h d E).
+
+lemma slift_vref_lt: ∀b,d,h,i. i < d → ↑[d, h] {b}#i = {b}#i.
+normalize /3 width=1/
+qed.
+
+lemma slift_vref_ge: ∀b,d,h,i. d ≤ i → ↑[d, h] {b}#i = {b}#(i+h).
+#b #d #h #i #H elim (le_to_or_lt_eq … H) -H
+normalize // /3 width=1/
+qed.
+
+lemma slift_id: ∀E,d. ↑[d, 0] E = E.
+#E elim E -E
+[ #b #i #d elim (lt_or_ge i d) /2 width=1/
+| /3 width=1/
+| /3 width=1/
+]
+qed.
+
+lemma slift_inv_vref_lt: ∀c,j,d. j < d → ∀h,E. ↑[d, h] E = {c}#j → E = {c}#j.
+#c #j #d #Hjd #h * normalize
+[ #b #i elim (lt_or_eq_or_gt i d) #Hid
+ [ >(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/ <plus_minus_m_m // /2 width=2/
+qed.
+
+(* Note: this is "∀h,d. injective … (slift h d)" *)
+theorem slift_inj: ∀h,E1,E2,d. ↑[d, h] E2 = ↑[d, h] E1 → E2 = E1.
+#h #E1 elim E1 -E1
+[ #b #i #E2 #d #H elim (lt_or_ge i d) #Hid
+ [ >(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-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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.
+*)
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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_lift_le // /2 width=1/
+qed.
+
+lemma pred_inv_lift: deliftable_sn pred.
+#h #N1 #N2 #H elim H -N1 -N2 /2 width=3/
+[ #C1 #C2 #_ #IHC12 #d #M1 #H
+ elim (lift_inv_abst … H) -H #A1 #HAC1 #H
+ elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
+ @(ex2_intro … (𝛌.A2)) // /2 width=1/
+| #D1 #D2 #C1 #C2 #_ #_ #IHD12 #IHC12 #d #M1 #H
+ elim (lift_inv_appl … H) -H #B1 #A1 #HBD1 #HAC1 #H
+ elim (IHD12 … HBD1) -D1 #B2 #HB12 #HBD2
+ elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
+ @(ex2_intro … (@B2.A2)) // /2 width=1/
+| #D1 #D2 #C1 #C2 #_ #_ #IHD12 #IHC12 #d #M1 #H
+ elim (lift_inv_appl … H) -H #B1 #M #HBD1 #HM #H1
+ elim (lift_inv_abst … HM) -HM #A1 #HAC1 #H
+ elim (IHD12 … HBD1) -D1 #B2 #HB12 #HBD2
+ elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
+ @(ex2_intro … ([↙B2]A2)) /2 width=1/
+]
+qed-.
+
+lemma pred_dsubst: dsubstable pred.
+#N1 #N2 #HN12 #M1 #M2 #H elim H -M1 -M2
+[ #i #d elim (lt_or_eq_or_gt i d) #Hid
+ [ >(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.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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 // <plus_minus_m_m //
+ | elim (le_inv_plus_l … Hd12) -Hd12 #Hd12 #_
+ lapply (le_to_lt_to_lt … Hd12 Hid2h) -Hd12 #Hid1
+ lapply (ltn_to_ltO … Hid2h) #Hi
+ >(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/ <plus_minus //
+| normalize #B #A #IHB #IHA #d1 #d2 #Hd12
+ >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/ <plus_minus_m_m //
+qed.
+
+definition dsubstable_dx: predicate (relation term) ≝ λR.
+ ∀N,M1,M2. R M1 M2 → ∀d. R ([d ↙ N] M1) ([d ↙ N] M2).
+
+definition dsubstable: predicate (relation term) ≝ λR.
+ ∀N1,N2. R N1 N2 → ∀M1,M2. R M1 M2 → ∀d. R ([d ↙ N1] M1) ([d ↙ N2] M2).
+
+lemma star_dsubstable_dx: ∀R. dsubstable_dx R → dsubstable_dx (star … R).
+#R #HR #N #M1 #M2 #H elim H -M2 // /3 width=3/
+qed.
+
+lemma lstar_dsubstable_dx: ∀S,R. (∀a. dsubstable_dx (R a)) →
+ ∀l. dsubstable_dx (lstar S … R l).
+#S #R #HR #l #N #M1 #M2 #H
+@(lstar_ind_l … l M1 H) -l -M1 // /3 width=3/
+qed.
+
+lemma star_dsubstable: ∀R. reflexive ? R →
+ dsubstable R → dsubstable (star … R).
+#R #H1R #H2 #N1 #N2 #H elim H -N2 /3 width=1/ /3 width=5/
+qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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/term.ma".
+
+(* RELOCATION ***************************************************************)
+
+(* Policy: level metavariables : d, e
+ height metavariables: h, k
+*)
+(* Note: indexes start at zero *)
+let rec lift h d M on M ≝ match M with
+[ VRef i ⇒ #(tri … i d i (i + h) (i + h))
+| Abst A ⇒ 𝛌. (lift h (d+1) A)
+| Appl B A ⇒ @(lift h d B). (lift h d A)
+].
+
+interpretation "relocation" 'Lift h d M = (lift h d M).
+
+lemma lift_vref_lt: ∀d,h,i. i < d → ↑[d, h] #i = #i.
+normalize /3 width=1/
+qed.
+
+lemma lift_vref_ge: ∀d,h,i. d ≤ i → ↑[d, h] #i = #(i+h).
+#d #h #i #H elim (le_to_or_lt_eq … H) -H
+normalize // /3 width=1/
+qed.
+
+lemma lift_id: ∀M,d. ↑[d, 0] M = M.
+#M elim M -M
+[ #i #d elim (lt_or_ge i d) /2 width=1/
+| /3 width=1/
+| /3 width=1/
+]
+qed.
+
+lemma lift_inv_vref_lt: ∀j,d. j < d → ∀h,M. ↑[d, h] M = #j → M = #j.
+#j #d #Hjd #h * normalize
+[ #i elim (lt_or_eq_or_gt i d) #Hid
+ [ >(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/ <plus_minus_m_m // /2 width=2/
+qed.
+
+(* Note: this is "∀h,d. injective … (lift h d)" *)
+theorem lift_inj: ∀h,M1,M2,d. ↑[d, h] M2 = ↑[d, h] M1 → M2 = M1.
+#h #M1 elim M1 -M1
+[ #i #M2 #d #H elim (lt_or_ge i d) #Hid
+ [ >(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-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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-.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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_lift_le //
+qed.
+
+lemma sred_inv_lift: deliftable_sn sred.
+#h #N1 #N2 #H elim H -N1 -N2
+[ #D #C #d #M1 #H
+ elim (lift_inv_appl … H) -H #B #M #H0 #HM #H destruct
+ elim (lift_inv_abst … HM) -HM #A #H0 #H destruct /3 width=3/
+| #C1 #C2 #_ #IHC12 #d #M1 #H
+ elim (lift_inv_abst … H) -H #A1 #HAC1 #H
+ elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
+ @(ex2_intro … (𝛌.A2)) // /2 width=1/
+| #D1 #D2 #C1 #_ #IHD12 #d #M1 #H
+ elim (lift_inv_appl … H) -H #B1 #A #HBD1 #H1 #H2
+ elim (IHD12 … HBD1) -D1 #B2 #HB12 #HBD2 destruct
+ @(ex2_intro … (@B2.A)) // /2 width=1/
+| #D1 #C1 #C2 #_ #IHC12 #d #M1 #H
+ elim (lift_inv_appl … H) -H #B #A1 #H1 #HAC1 #H2
+ elim (IHC12 … HAC1) -C1 #A2 #HA12 #HAC2 destruct
+ @(ex2_intro … (@B.A2)) // /2 width=1/
+]
+qed-.
+
+lemma sred_dsubst: dsubstable_dx sred.
+#D1 #M1 #M2 #H elim H -M1 -M2 normalize /2 width=1/
+#D2 #A #d >dsubst_dsubst_ge //
+qed.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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.
--- /dev/null
+(**************************************************************************)
+(* ___ *)
+(* ||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.
--- /dev/null
+<?xml version="1.0" encoding="utf-8"?>
+<helm_registry>
+ <section name="matita">
+ <key name="rt_base_dir">$(MATITA_RT_BASE_DIR)</key>
+ </section>
+ <section name="xoa">
+ <key name="output_dir">contribs/lambda/background/</key>
+ <key name="objects">xoa</key>
+ <key name="notations">xoa_notation</key>
+ <key name="include">basics/pts.ma</key>
+ <key name="ex">1 2</key>
+ <key name="ex">2 2</key>
+ <key name="ex">2 3</key>
+ <key name="ex">3 1</key>
+ <key name="ex">3 2</key>
+ <key name="ex">3 3</key>
+ <key name="ex">3 4</key>
+ <key name="ex">4 1</key>
+ <key name="ex">4 2</key>
+ <key name="ex">4 3</key>
+ <key name="or">3</key>
+ </section>
+</helm_registry>
projects / helm.git / commitdiff