matita/matita/contribs/lambdadelta/.depend
matita/matita/contribs/lambdadelta/bin/recomm/srcs
matita/matita/contribs/lambdadelta/bin/recomm/log.txt
+matita/matita/contribs/lambdadelta/bin/recomm/subst.txt
+matita/matita/contribs/lambdadelta/bin/recomm/subst_cn.txt
matita/matita/contribs/lambdadelta/bin/nodes
matita/matita/contribs/lambdadelta/bin/token
matita/matita/contribs/lambdadelta/*/probe.txt
(* Forward lemmas with generic relocation ***********************************)
fact lifts_fwd_vpush_aux (M): is_model M → is_extensional M →
- â\88\80f,T1,T2. â\87§*[f] T1 â\89\98 T2 â\86\92 â\88\80m. ð\9d\90\81❨m,1❩ = f →
+ â\88\80f,T1,T2. â\87§*[f] T1 â\89\98 T2 â\86\92 â\88\80m. ð\9d\90\9b❨m,1❩ = f →
∀gv,lv,d. ⟦T1⟧[gv,lv] ≗{M} ⟦T2⟧[gv,⫯[m←d]lv].
#M #H1M #H2M #f #T1 #T2 #H elim H -f -T1 -T2
[ #f #s #m #Hf #gv #lv #d
elim (lt_or_eq_or_gt i j) #Hij
[ /3 width=4 by lifts_lref_ge_minus, cpr_refl, ex2_2_intro/
| elim (lifts_total V (𝐔❨↑i❩)) #U2 #HU2
- elim (lifts_split_trans â\80¦ HU2 (ð\9d\90\94â\9d¨iâ\9d©) (ð\9d\90\81❨i,1❩)) [2: @(after_basic_rc i 0) ]
+ elim (lifts_split_trans â\80¦ HU2 (ð\9d\90\94â\9d¨iâ\9d©) (ð\9d\90\9b❨i,1❩)) [2: @(after_basic_rc i 0) ]
/3 width=7 by cpm_delta_drops, ex2_2_intro/
| /3 width=4 by lifts_lref_lt, cpr_refl, ex2_2_intro/
]
elim (lt_or_eq_or_gt i j) #Hij
[ /3 width=4 by lifts_lref_ge_minus, cpx_refl, ex2_2_intro/
| elim (lifts_total V (𝐔❨↑i❩)) #U2 #HU2
- elim (lifts_split_trans â\80¦ HU2 (ð\9d\90\94â\9d¨iâ\9d©) (ð\9d\90\81❨i,1❩)) [2: @(after_basic_rc i 0) ]
+ elim (lifts_split_trans â\80¦ HU2 (ð\9d\90\94â\9d¨iâ\9d©) (ð\9d\90\9b❨i,1❩)) [2: @(after_basic_rc i 0) ]
/3 width=7 by cpx_delta_drops, ex2_2_intro/
| /3 width=4 by lifts_lref_lt, cpx_refl, ex2_2_intro/
]
mrc: $(MRCS:%.mrc=recommGc%.ml)
@./mrc.native .
+subst: subst.txt
+ @sed s/://g <subst_cn.txt >subst.txt
+ @cd ../token; . ./subst.sh
+
recommGc%.ml recommGc%.mli: %.mrc mrc*.ml mrc*.mli
@./mrc.native $<
-.PHONY: test mrc
+.PHONY: test mrc subst
PcsAnd b "" true false
+ple
+plt
niter
ntri
nsucc
lsub
compose, function composition
ctc, contextual transitive closure
+stream_eq
--- /dev/null
+PcsAnd b "" true false
+gr_eq
+gr_tl, tl, tail
+gr_pushs, pushs, iterated push
+gr_nexts, nexts, iterated next
+gr_tls, tls, iterated tail
+gr_id, id
+gr_uni, uni, uniform relocations
+gr_basic, basic relocation
+gr_pat, pat, at
+gr_nat, nat
+gr_isi, isi, isid, test for identity
+gr_isu, isuni, test for uniform relocations
+gr_fcla, fcla, finite colength assignment, finite colength
+gr_isf, isf, isfin, test for finite colength
+gr_ist, ist, istot
+gr_isd, isdiv
+gr_after, after
+gr_coafter, coafter
+gr_sle, sle, inclusion
+gr_sdj, sdj
+gr_sand, sand
+gr_sor, sor
--- /dev/null
+PccFor d "" true false
+FINITE RELOCATION MAPS
+FINITE RELOCATION MAPS WITH PAIRS
+GENERIC RELOCATION MAPS
--- /dev/null
+PcsPar p "" true false
+(specific)
LABELLED TRANSITIVE CLOSURE
NAT-LABELED REFLEXIVE AND TRANSITIVE CLOSURE
HEAD AND TAIL
+TAIL
ITERATED TAIL
LENGTH
+CONCATENATION, APPEND
--- /dev/null
+PccFor r "" true false
+BASIC ELEMENTS
+DISJOINTNESS
+DIVERGENCE CONDITION
+FINITE COLENGTH ASSIGNMENT
+FINITE COLENGTH CONDITION
+IDENTITY CONDITION
+IDENTITY ELEMENT
+INCLUSION
+ITERATED PUSH
+ITERATED NEXT
+NON-NEGATIVE APPLICATION
+POSITIVE APPLICATION
+RELATIONAL CO-COMPOSITION
+RELATIONAL COMPOSITION
+RELATIONAL INTERSECTION
+RELATIONAL SUBTRACTION
+RELATIONAL UNION
+TOTALITY CONDITION
+UNIFORM ELEMENTS
+UNIFORMITY CONDITION
Sys.chdir path
let start_substs () =
- subst := Some (open_out "subst.txt")
+ subst := Some (open_out "subst_cn.txt")
let write_substs lint = function
| None -> ()
module G01 = RecommGcbGroundArith
module G02 = RecommGcbGroundCounters
module G03 = RecommGcbGroundLib
-module G04 = RecommGcdGroundArith
-module G05 = RecommGcdGroundCounters
-module G06 = RecommGcdGroundLib
-module G07 = RecommGcpGroundArith
-module G08 = RecommGcpGroundLib
-module G09 = RecommGcrGroundArith
-module G10 = RecommGcrGroundCounters
-module G11 = RecommGcrGroundLib
-module G12 = RecommGcsAttr
-module G13 = RecommGcsMain
-module G14 = RecommGcsWith
+module G04 = RecommGcbGroundRelocation
+module G05 = RecommGcdGroundArith
+module G06 = RecommGcdGroundCounters
+module G07 = RecommGcdGroundLib
+module G08 = RecommGcdGroundRelocation
+module G09 = RecommGcpGroundArith
+module G10 = RecommGcpGroundLib
+module G11 = RecommGcpGroundRelocation
+module G12 = RecommGcrGroundArith
+module G13 = RecommGcrGroundCounters
+module G14 = RecommGcrGroundLib
+module G15 = RecommGcrGroundRelocation
+module G16 = RecommGcsAttr
+module G17 = RecommGcsMain
+module G18 = RecommGcsWith
| "nsucc" :: tl -> k T.OK ("nsucc" :: outs) tl
| "ntri" :: tl -> k T.OK ("ntri" :: outs) tl
| "niter" :: tl -> k T.OK ("niter" :: outs) tl
+ | "plt" :: tl -> k T.OK ("plt" :: outs) tl
+ | "ple" :: tl -> k T.OK ("ple" :: outs) tl
| _ -> k T.OO outs ins
let main =
let step k st outs ins =
if st <> T.OO then k st outs ins else
match ins with
+ | "stream_eq" :: tl -> k T.OK ("stream_eq" :: outs) tl
| "ctc" :: tl -> k T.OK ("ctc" :: outs) tl
| "contextual" :: "transitive" :: "closure" :: tl -> k T.OK ("ctc" :: outs) tl
| "compose" :: tl -> k T.OK ("compose" :: outs) tl
--- /dev/null
+module T = RecommTypes
+module R = RecommPcsAnd
+
+let step k st outs ins =
+ if st <> T.OO then k st outs ins else
+ match ins with
+ | "gr_sor" :: tl -> k T.OK ("gr_sor" :: outs) tl
+ | "sor" :: tl -> k T.OK ("gr_sor" :: outs) tl
+ | "gr_sand" :: tl -> k T.OK ("gr_sand" :: outs) tl
+ | "sand" :: tl -> k T.OK ("gr_sand" :: outs) tl
+ | "gr_sdj" :: tl -> k T.OK ("gr_sdj" :: outs) tl
+ | "sdj" :: tl -> k T.OK ("gr_sdj" :: outs) tl
+ | "gr_sle" :: tl -> k T.OK ("gr_sle" :: outs) tl
+ | "sle" :: tl -> k T.OK ("gr_sle" :: outs) tl
+ | "inclusion" :: tl -> k T.OK ("gr_sle" :: outs) tl
+ | "gr_coafter" :: tl -> k T.OK ("gr_coafter" :: outs) tl
+ | "coafter" :: tl -> k T.OK ("gr_coafter" :: outs) tl
+ | "gr_after" :: tl -> k T.OK ("gr_after" :: outs) tl
+ | "after" :: tl -> k T.OK ("gr_after" :: outs) tl
+ | "gr_isd" :: tl -> k T.OK ("gr_isd" :: outs) tl
+ | "isdiv" :: tl -> k T.OK ("gr_isd" :: outs) tl
+ | "gr_ist" :: tl -> k T.OK ("gr_ist" :: outs) tl
+ | "ist" :: tl -> k T.OK ("gr_ist" :: outs) tl
+ | "istot" :: tl -> k T.OK ("gr_ist" :: outs) tl
+ | "gr_isf" :: tl -> k T.OK ("gr_isf" :: outs) tl
+ | "isf" :: tl -> k T.OK ("gr_isf" :: outs) tl
+ | "isfin" :: tl -> k T.OK ("gr_isf" :: outs) tl
+ | "test" :: "for" :: "finite" :: "colength" :: tl -> k T.OK ("gr_isf" :: outs) tl
+ | "gr_fcla" :: tl -> k T.OK ("gr_fcla" :: outs) tl
+ | "fcla" :: tl -> k T.OK ("gr_fcla" :: outs) tl
+ | "finite" :: "colength" :: "assignment" :: tl -> k T.OK ("gr_fcla" :: outs) tl
+ | "finite" :: "colength" :: tl -> k T.OK ("gr_fcla" :: outs) tl
+ | "gr_isu" :: tl -> k T.OK ("gr_isu" :: outs) tl
+ | "isuni" :: tl -> k T.OK ("gr_isu" :: outs) tl
+ | "test" :: "for" :: "uniform" :: "relocations" :: tl -> k T.OK ("gr_isu" :: outs) tl
+ | "gr_isi" :: tl -> k T.OK ("gr_isi" :: outs) tl
+ | "isi" :: tl -> k T.OK ("gr_isi" :: outs) tl
+ | "isid" :: tl -> k T.OK ("gr_isi" :: outs) tl
+ | "test" :: "for" :: "identity" :: tl -> k T.OK ("gr_isi" :: outs) tl
+ | "gr_nat" :: tl -> k T.OK ("gr_nat" :: outs) tl
+ | "nat" :: tl -> k T.OK ("gr_nat" :: outs) tl
+ | "gr_pat" :: tl -> k T.OK ("gr_pat" :: outs) tl
+ | "pat" :: tl -> k T.OK ("gr_pat" :: outs) tl
+ | "at" :: tl -> k T.OK ("gr_pat" :: outs) tl
+ | "gr_basic" :: tl -> k T.OK ("gr_basic" :: outs) tl
+ | "basic" :: "relocation" :: tl -> k T.OK ("gr_basic" :: outs) tl
+ | "gr_uni" :: tl -> k T.OK ("gr_uni" :: outs) tl
+ | "uni" :: tl -> k T.OK ("gr_uni" :: outs) tl
+ | "uniform" :: "relocations" :: tl -> k T.OK ("gr_uni" :: outs) tl
+ | "gr_id" :: tl -> k T.OK ("gr_id" :: outs) tl
+ | "id" :: tl -> k T.OK ("gr_id" :: outs) tl
+ | "gr_tls" :: tl -> k T.OK ("gr_tls" :: outs) tl
+ | "tls" :: tl -> k T.OK ("gr_tls" :: outs) tl
+ | "iterated" :: "tail" :: tl -> k T.OK ("gr_tls" :: outs) tl
+ | "gr_nexts" :: tl -> k T.OK ("gr_nexts" :: outs) tl
+ | "nexts" :: tl -> k T.OK ("gr_nexts" :: outs) tl
+ | "iterated" :: "next" :: tl -> k T.OK ("gr_nexts" :: outs) tl
+ | "gr_pushs" :: tl -> k T.OK ("gr_pushs" :: outs) tl
+ | "pushs" :: tl -> k T.OK ("gr_pushs" :: outs) tl
+ | "iterated" :: "push" :: tl -> k T.OK ("gr_pushs" :: outs) tl
+ | "gr_tl" :: tl -> k T.OK ("gr_tl" :: outs) tl
+ | "tl" :: tl -> k T.OK ("gr_tl" :: outs) tl
+ | "tail" :: tl -> k T.OK ("gr_tl" :: outs) tl
+ | "gr_eq" :: tl -> k T.OK ("gr_eq" :: outs) tl
+ | _ -> k T.OO outs ins
+
+let main =
+ R.register_b step
--- /dev/null
+module T = RecommTypes
+module R = RecommPccFor
+
+let step k st outs ins =
+ if st <> T.OO then k st outs ins else
+ match ins with
+ | "GENERIC" :: "RELOCATION" :: "MAPS" :: tl -> k T.OK ("MAPS" :: "RELOCATION" :: "GENERIC" :: outs) tl
+ | "FINITE" :: "RELOCATION" :: "MAPS" :: "WITH" :: "PAIRS" :: tl -> k T.OK ("PAIRS" :: "WITH" :: "MAPS" :: "RELOCATION" :: "FINITE" :: outs) tl
+ | "FINITE" :: "RELOCATION" :: "MAPS" :: tl -> k T.OK ("MAPS" :: "RELOCATION" :: "FINITE" :: outs) tl
+ | _ -> k T.OO outs ins
+
+let main =
+ R.register_d step
--- /dev/null
+module T = RecommTypes
+module R = RecommPcsPar
+
+let step k st outs ins =
+ if st <> T.OO then k st outs ins else
+ match ins with
+ | "(specific)" :: tl -> k T.OK ("(specific)" :: outs) tl
+ | _ -> k T.OO outs ins
+
+let main =
+ R.register_p step
let step k st outs ins =
if st <> T.OO then k st outs ins else
match ins with
+ | "CONCATENATION" :: tl -> k T.OK ("CONCATENATION" :: outs) tl
+ | "APPEND" :: tl -> k T.OK ("CONCATENATION" :: outs) tl
| "LENGTH" :: tl -> k T.OK ("LENGTH" :: outs) tl
| "ITERATED" :: "TAIL" :: tl -> k T.OK ("TAIL" :: "ITERATED" :: outs) tl
+ | "TAIL" :: tl -> k T.OK ("TAIL" :: outs) tl
| "HEAD" :: "AND" :: "TAIL" :: tl -> k T.OK ("TAIL" :: "AND" :: "HEAD" :: outs) tl
| "NAT-LABELED" :: "REFLEXIVE" :: "AND" :: "TRANSITIVE" :: "CLOSURE" :: tl -> k T.OK ("CLOSURE" :: "TRANSITIVE" :: "AND" :: "REFLEXIVE" :: "NAT-LABELED" :: outs) tl
| "LABELLED" :: "TRANSITIVE" :: "CLOSURE" :: tl -> k T.OK ("CLOSURE" :: "TRANSITIVE" :: "LABELLED" :: outs) tl
--- /dev/null
+module T = RecommTypes
+module R = RecommPccFor
+
+let step k st outs ins =
+ if st <> T.OO then k st outs ins else
+ match ins with
+ | "UNIFORMITY" :: "CONDITION" :: tl -> k T.OK ("CONDITION" :: "UNIFORMITY" :: outs) tl
+ | "UNIFORM" :: "ELEMENTS" :: tl -> k T.OK ("ELEMENTS" :: "UNIFORM" :: outs) tl
+ | "TOTALITY" :: "CONDITION" :: tl -> k T.OK ("CONDITION" :: "TOTALITY" :: outs) tl
+ | "RELATIONAL" :: "UNION" :: tl -> k T.OK ("UNION" :: "RELATIONAL" :: outs) tl
+ | "RELATIONAL" :: "SUBTRACTION" :: tl -> k T.OK ("SUBTRACTION" :: "RELATIONAL" :: outs) tl
+ | "RELATIONAL" :: "INTERSECTION" :: tl -> k T.OK ("INTERSECTION" :: "RELATIONAL" :: outs) tl
+ | "RELATIONAL" :: "COMPOSITION" :: tl -> k T.OK ("COMPOSITION" :: "RELATIONAL" :: outs) tl
+ | "RELATIONAL" :: "CO-COMPOSITION" :: tl -> k T.OK ("CO-COMPOSITION" :: "RELATIONAL" :: outs) tl
+ | "POSITIVE" :: "APPLICATION" :: tl -> k T.OK ("APPLICATION" :: "POSITIVE" :: outs) tl
+ | "NON-NEGATIVE" :: "APPLICATION" :: tl -> k T.OK ("APPLICATION" :: "NON-NEGATIVE" :: outs) tl
+ | "ITERATED" :: "NEXT" :: tl -> k T.OK ("NEXT" :: "ITERATED" :: outs) tl
+ | "ITERATED" :: "PUSH" :: tl -> k T.OK ("PUSH" :: "ITERATED" :: outs) tl
+ | "INCLUSION" :: tl -> k T.OK ("INCLUSION" :: outs) tl
+ | "IDENTITY" :: "ELEMENT" :: tl -> k T.OK ("ELEMENT" :: "IDENTITY" :: outs) tl
+ | "IDENTITY" :: "CONDITION" :: tl -> k T.OK ("CONDITION" :: "IDENTITY" :: outs) tl
+ | "FINITE" :: "COLENGTH" :: "CONDITION" :: tl -> k T.OK ("CONDITION" :: "COLENGTH" :: "FINITE" :: outs) tl
+ | "FINITE" :: "COLENGTH" :: "ASSIGNMENT" :: tl -> k T.OK ("ASSIGNMENT" :: "COLENGTH" :: "FINITE" :: outs) tl
+ | "DIVERGENCE" :: "CONDITION" :: tl -> k T.OK ("CONDITION" :: "DIVERGENCE" :: outs) tl
+ | "DISJOINTNESS" :: tl -> k T.OK ("DISJOINTNESS" :: outs) tl
+ | "BASIC" :: "ELEMENTS" :: tl -> k T.OK ("ELEMENTS" :: "BASIC" :: outs) tl
+ | _ -> k T.OO outs ins
+
+let main =
+ R.register_r step
| "inversion" :: tl -> k T.OK ("inversions" :: outs) tl
| "constructions" :: tl -> k T.OK ("constructions" :: outs) tl
| "properties" :: tl -> k T.OK ("constructions" :: outs) tl
+ | "alternative" :: "definition" :: tl -> k T.OK ("definition" :: "alternative" :: outs) tl
| _ -> k T.KO outs ins
let main =
| "with" :: tl -> k T.OK ("with" :: outs) tl
| "of" :: tl -> k T.OK ("with" :: outs) tl
| "for" :: tl -> k T.OK ("with" :: outs) tl
+ | "on" :: tl -> k T.OK ("with" :: outs) tl
| _ -> k T.OO outs ins
let main =
let heads = [|
"Advanced";
+ "Alternative";
"Basic";
"Constructions";
"Forward";
| _ :: tl -> write_fst och tl
and write_snd och tl s = function
+ | "axiom" :: n :: _
| "definition" :: n :: _
+ | "corec" :: "definition" :: n :: _
+ | "rec" :: "definition" :: n :: _
| "fact" :: n :: _
+ | "corec" :: "fact" :: n :: _
| "lemma" :: n :: _
+ | "corec" :: "lemma" :: n :: _
+ | "theorem" :: n :: _
+ | "corec" :: "theorem" :: n :: _
| "inductive" :: n :: _
- | "theorem" :: n :: _ ->
+ | "coinductive" :: n :: _
+ | "|" :: n :: _ ->
let ss = EL.split_on_char ' ' s in
List.iter (write_subst och n) (List.tl ss);
write_fst och tl
| CW { $1 }
| HW { $1 }
+inn_w:
+ | inn { $1 }
+ | SR { $1 }
+
inns_r:
| inn_r { $1 }
| inn_r inns { $1 ^ $2 }
| inn { $1 }
| inn inns { $1 ^ $2 }
+inns_w:
+ | inn_w { $1 }
+ | inn_w inns_w { $1 ^ $2 }
+
out:
| SP { $1 }
| SR { $1 }
| SP sw sws { $2 :: $3 }
src_l:
- | NL { ET.Line $1 }
- | OP sp PP inns CP { ET.Mark $4 }
- | OP sp KW inns CP { ET.Key ($3, $4) }
- | OP sp CW cws CP { ET.Title ($3 :: $4) }
- | OP sp HW sws CP { ET.Slice (lc $3 :: $4) }
- | OP sp CP { ET.Other (0, $1, $2, $3) }
- | OP sp inns_r CP { ET.Other (0, $1, $2 ^ $3, $4) }
- | OP SR inns CP { ET.Other (1, $1, $2 ^ $3, $4) }
- | OP SR SR inns CP { ET.Other (2, $1, $2 ^ $3 ^ $4, $5) }
- | OP SP SR inns CP { ET.Mark $4 }
+ | NL { ET.Line $1 }
+ | OP sp PP inns CP { ET.Mark $4 }
+ | OP sp KW inns_w CP { ET.Key ($3, $4) }
+ | OP sp CW cws CP { ET.Title ($3 :: $4) }
+ | OP sp HW sws CP { ET.Slice (lc $3 :: $4) }
+ | OP sp CP { ET.Other (0, $1, $2, $3) }
+ | OP sp inns_r CP { ET.Other (0, $1, $2 ^ $3, $4) }
+ | OP SR inns CP { ET.Other (1, $1, $2 ^ $3, $4) }
+ | OP SR SR inns CP { ET.Other (2, $1, $2 ^ $3 ^ $4, $5) }
+ | OP SP SR inns CP { ET.Mark $4 }
src:
| outs { ET.Text $1 }
check s "GcsAttr" false true
+alternative definition
constructions, properties
inversions, inversion properties, inversion lemmas, inversion
destructions, forward properties, forward lemmas
check s "GcsMain" false false
-with, of, for
+with, of, for, on
(* Iterators ****************************************************************)
-lemma iter_SO: ∀B:Type[0]. ∀f:B→B. ∀b,l. f^(l+𝟏) b = f (f^l b).
+lemma iter_SO: ∀B:Type[0]. ∀f:B→B. ∀b,l. (f^(l+𝟏)) b = f ((f^l) b).
#B #f #b #l
<niter_succ //
qed.
definition niter (n:nat) (A:Type[0]) (f:A→A) (a:A) ≝
match n with
[ nzero ⇒ a
-| ninj p ⇒ f^{A}p a
+| ninj p ⇒ (f^{A}p) a
]
.
(*** minus *)
definition nminus: nat → nat → nat ≝
- λm,n. npred^n m.
+ λm,n. (npred^n) m.
interpretation
"minus (non-negative integers)"
(*** plus *)
definition nplus: nat → nat → nat ≝
- λm,n. nsucc^n m.
+ λm,n. (nsucc^n) m.
interpretation
"plus (non-negative integers)"
#m #n @(niter_appl … nsucc)
qed.
-(*** plus_O_n.con *)
+(*** plus_O_n *)
lemma nplus_zero_sn (m): m = 𝟎 + m.
#m @(nat_ind_succ … m) -m //
qed.
(* RIGHT ADDITION FOR NON-NEGATIVE INTEGERS *********************************)
definition nrplus: pnat → nat → pnat ≝
- λp,n. psucc^n p.
+ λp,n. (psucc^n) p.
interpretation
"right plus (non-negative integers)"
(* ADDITION FOR POSITIVE INTEGERS *******************************************)
definition pplus: pnat → pnat → pnat ≝
- λp,q. psucc^q p.
+ λp,q. (psucc^q) p.
interpretation
"plus (positive integers)"
(*** yminus_sn *)
definition ylminus (x) (n): ynat ≝
- ypred^n x.
+ (ypred^n) x.
interpretation
"left minus (non-negative integers with infinity)"
(* ADDITION FOR NON-NEGATIVE INTEGERS WITH INFINITY *************************)
definition yplus_aux (x) (n): ynat ≝
- ysucc^n x.
+ (ysucc^n) x.
(*** yplus *)
definition yplus (x): ynat → ynat ≝
(* Basic constructions ******************************************************)
lemma yplus_inj_dx (x) (n):
- ysucc^n x = x + yinj_nat n.
+ (ysucc^n) x = x + yinj_nat n.
#x @(ynat_bind_nat_inj (yplus_aux x))
qed.
}.
interpretation
- "constructor (rtc)"
+ "construction (rt-transition counters)"
'Tuple ri rs ti ts = (mk_rtc ri rs ti ts).
interpretation
- "one structural step (rtc)"
+ "one structural step (rt-transition counters)"
'ZeroZero = (mk_rtc nzero nzero nzero nzero).
interpretation
- "one r-step (rtc)"
+ "one r-step (rt-transition counters)"
'OneZero = (mk_rtc nzero (ninj punit) nzero nzero).
interpretation
- "one t-step (rtc)"
+ "one t-step (rt-transition counters)"
'ZeroOne = (mk_rtc nzero nzero nzero (ninj punit)).
definition rtc_eq_f: relation rtc ≝ λc1,c2. ⊤.
(* Basic constructions ******************************************************)
-lemma rtc_eq_t_refl: reflexive … rtc_eq_t.
+lemma rtc_eq_t_refl:
+ reflexive … rtc_eq_t.
* // qed.
(* Basic inversions *********************************************************)
(* *)
(**************************************************************************)
-include "ground/notation/relations/ism_2.ma".
+include "ground/notation/relations/predicate_m_2.ma".
include "ground/counters/rtc.ma".
(* T-BOUND RT-TRANSITION COUNTERS *******************************************)
∃∃ri,rs. 〈ri,rs,𝟎,ts〉 = c.
interpretation
- "t-bound rt-transition counters (rtc)"
- 'IsM ts c = (rtc_ism ts c).
+ "construction (t-bound rt-transition counters)"
+ 'PredicateM ts c = (rtc_ism ts c).
(* Basic constructions ******************************************************)
(* *)
(**************************************************************************)
-include "ground/notation/relations/ist_2.ma".
+include "ground/notation/relations/predicate_t_2.ma".
include "ground/counters/rtc.ma".
(* T-TRANSITION COUNTERS ****************************************************)
λts,c. 〈𝟎,𝟎,𝟎,ts〉 = c.
interpretation
- "t-transition counters (rtc)"
- 'IsT ts c = (rtc_ist ts c).
+ "construction (t-transition counters)"
+ 'PredicateT ts c = (rtc_ist ts c).
(* Basic constructions ******************************************************)
].
interpretation
- "maximum (rtc)"
+ "maximum (rt-transition counters)"
'or c1 c2 = (rtc_max c1 c2).
(* Basic constructions ******************************************************)
-lemma rtc_max_rew (ri1) (ri2) (rs1) (rs2) (ti1) (ti2) (ts1) (ts2):
+(*** rtc_max_rew *)
+lemma rtc_max_unfold (ri1) (ri2) (rs1) (rs2) (ti1) (ti2) (ts1) (ts2):
〈ri1∨ri2,rs1∨rs2,ti1∨ti2,ts1∨ts2〉 =
(〈ri1,rs1,ti1,ts1〉 ∨ 〈ri2,rs2,ti2,ts2〉).
// qed.
lemma rtc_max_zz_dx (c): c = (c ∨ 𝟘𝟘).
-* #ri #rs #ti #ts <rtc_max_rew //
+* #ri #rs #ti #ts <rtc_max_unfold //
qed.
lemma rtc_max_idem (c): c = (c ∨ c).
-* #ri #rs #ti #ts <rtc_max_rew //
+* #ri #rs #ti #ts <rtc_max_unfold //
qed.
(* Basic inversions *********************************************************)
(ri1∨ri2) = ri & (rs1∨rs2) = rs & (ti1∨ti2) = ti & (ts1∨ts2) = ts &
〈ri1,rs1,ti1,ts1〉 = c1 & 〈ri2,rs2,ti2,ts2〉 = c2.
#ri #rs #ti #ts * #ri1 #rs1 #ti1 #ts1 * #ri2 #rs2 #ti2 #ts2
-<rtc_max_rew #H destruct /2 width=14 by ex6_8_intro/
+<rtc_max_unfold #H destruct /2 width=14 by ex6_8_intro/
qed-.
(* Main constructions *******************************************************)
theorem rtc_max_assoc: associative … rtc_max.
* #ri1 #rs1 #ti1 #ts1 * #ri2 #rs2 #ti2 #ts2 * #ri3 #rs3 #ti3 #ts3
-<rtc_max_rew <rtc_max_rew //
+<rtc_max_unfold <rtc_max_unfold //
qed.
lemma rtc_max_shift (c1) (c2): ((↕*c1) ∨ (↕*c2)) = ↕*(c1∨c2).
* #ri1 #rs1 #ti1 #ts1 * #ri2 #rs2 #ti2 #ts2
-<rtc_shift_rew <rtc_shift_rew <rtc_shift_rew <rtc_max_rew
+<rtc_shift_unfold <rtc_shift_unfold <rtc_shift_unfold <rtc_max_unfold
<nmax_assoc <nmax_assoc <nmax_assoc <nmax_assoc //
qed.
].
interpretation
- "plus (rtc)"
+ "addition (rt-transition counters)"
'plus c1 c2 = (rtc_plus c1 c2).
(* Basic constructions ******************************************************)
-lemma rtc_plus_rew (ri1) (ri2) (rs1) (rs2) (ti1) (ti2) (ts1) (ts2):
+(*** rtc_plus_rew *)
+lemma rtc_plus_unfold (ri1) (ri2) (rs1) (rs2) (ti1) (ti2) (ts1) (ts2):
〈ri1+ri2,rs1+rs2,ti1+ti2,ts1+ts2〉 = 〈ri1,rs1,ti1,ts1〉+〈ri2,rs2,ti2,ts2〉.
// qed.
lemma rtc_plus_zz_dx (c): c = c + 𝟘𝟘.
-* #ri #rs #ti #ts <rtc_plus_rew //
+* #ri #rs #ti #ts <rtc_plus_unfold //
qed.
(* Basic inversions *********************************************************)
ri1+ri2 = ri & rs1+rs2 = rs & ti1+ti2 = ti & ts1+ts2 = ts &
〈ri1,rs1,ti1,ts1〉 = c1 & 〈ri2,rs2,ti2,ts2〉 = c2.
#ri #rs #ti #ts * #ri1 #rs1 #ti1 #ts1 * #ri2 #rs2 #ti2 #ts2
-<rtc_plus_rew #H destruct /2 width=14 by ex6_8_intro/
+<rtc_plus_unfold #H destruct /2 width=14 by ex6_8_intro/
qed-.
(* Main constructions *******************************************************)
theorem rtc_plus_assoc: associative … rtc_plus.
* #ri1 #rs1 #ti1 #ts1 * #ri2 #rs2 #ti2 #ts2 * #ri3 #rs3 #ti3 #ts3
-<rtc_plus_rew //
+<rtc_plus_unfold //
qed.
].
interpretation
- "shift (rtc)"
+ "shift (rt-transition counters)"
'UpDownArrowStar c = (rtc_shift c).
(* Basic constructions ******************************************************)
-lemma rtc_shift_rew (ri) (rs) (ti) (ts):
+(*** rtc_shift_rew *)
+lemma rtc_shift_unfold (ri) (rs) (ti) (ts):
〈ri ∨ rs, 𝟎, ti ∨ ts, 𝟎〉 = ↕*〈ri,rs,ti,ts〉.
//
qed.
〈ri,rs,ti,ts〉 = ↕*c →
∃∃ri0,rs0,ti0,ts0.
(ri0∨rs0) = ri & 𝟎 = rs & (ti0∨ts0) = ti & 𝟎 = ts & 〈ri0,rs0,ti0,ts0〉 = c.
-#ri #rs #ti #ts * #ri0 #rs0 #ti0 #ts0 <rtc_shift_rew #H destruct
+#ri #rs #ti #ts * #ri0 #rs0 #ti0 #ts0 <rtc_shift_unfold #H destruct
/2 width=7 by ex5_4_intro/
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 "ground/notation/functions/upspoon_1.ma".
+include "ground/lib/stream.ma".
+include "ground/arith/pnat.ma".
+
+(* RELOCATION P-STREAM ******************************************************)
+
+definition gr_map: Type[0] ≝ stream pnat.
+
+definition gr_push: gr_map → gr_map ≝ λf. 𝟏⨮f.
+
+interpretation "push (pstream)" 'UpSpoon f = (gr_push f).
+
+definition gr_next: gr_map → gr_map.
+* #p #f @(↑p⨮f)
+defined.
+
+interpretation "next (pstream)" 'UpArrow f = (gr_next f).
+
+(* Basic properties *********************************************************)
+
+lemma gr_push_unfold: ∀f. 𝟏⨮f = ⫯f.
+// qed.
+
+lemma gr_next_unfold: ∀f,p. (↑p)⨮f = ↑(p⨮f).
+// qed.
+
+(* Basic inversion lemmas ***************************************************)
+
+lemma eq_inv_gr_push_bi: injective ? ? gr_push.
+#f1 #f2 <gr_push_unfold <gr_push_unfold #H destruct //
+qed-.
+
+lemma eq_inv_gr_push_next: ∀f1,f2. ⫯f1 = ↑f2 → ⊥.
+#f1 * #p2 #f2 <gr_push_unfold <gr_next_unfold #H destruct
+qed-.
+
+lemma eq_inv_gr_next_push: ∀f1,f2. ↑f1 = ⫯f2 → ⊥.
+* #p1 #f1 #f2 <gr_next_unfold <gr_push_unfold #H destruct
+qed-.
+
+lemma eq_inv_gr_next_bi: injective ? ? gr_next.
+* #p1 #f1 * #p2 #f2 <gr_next_unfold <gr_next_unfold #H destruct //
+qed-.
+
+lemma push_inv_seq_sn: ∀f,g,p. p⨮g = ⫯f → ∧∧ 𝟏 = p & g = f.
+#f #g #p <gr_push_unfold #H destruct /2 width=1 by conj/
+qed-.
+
+lemma push_inv_seq_dx: ∀f,g,p. ⫯f = p⨮g → ∧∧ 𝟏 = p & g = f.
+#f #g #p <gr_push_unfold #H destruct /2 width=1 by conj/
+qed-.
+
+lemma next_inv_seq_sn: ∀f,g,p. p⨮g = ↑f → ∃∃q. q⨮g = f & ↑q = p.
+* #q #f #g #p <gr_next_unfold #H destruct /2 width=3 by ex2_intro/
+qed-.
+
+lemma next_inv_seq_dx: ∀f,g,p. ↑f = p⨮g → ∃∃q. q⨮g = f & ↑q = p.
+* #q #f #g #p <gr_next_unfold #H destruct /2 width=3 by ex2_intro/
+qed-.
+
+lemma case_prop (Q:predicate gr_map):
+ (∀f. Q (⫯f)) → (∀f. Q (↑f)) → ∀f. Q f.
+#Q #H1 #H2 * * //
+qed-.
+
+lemma case_type0 (Q:gr_map→Type[0]):
+ (∀f. Q (⫯f)) → (∀f. Q (↑f)) → ∀f. Q f.
+#Q #H1 #H2 * * //
+qed-.
+
+lemma iota_push: ∀Q,a,b,f. a f = case_type0 Q a b (⫯f).
+// qed.
+
+lemma iota_next: ∀Q,a,b,f. b f = case_type0 Q a b (↑f).
+#Q #a #b * //
+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 "ground/relocation/pstream_tls.ma".
+include "ground/relocation/pstream_istot.ma".
+include "ground/relocation/rtmap_after.ma".
+
+(* RELOCATION P-STREAM ******************************************************)
+
+corec definition compose: gr_map → gr_map → gr_map.
+#f2 * #p1 #f1 @(stream_cons … (f2@❨p1❩)) @(compose ? f1) -compose -f1
+@(⫰*[p1]f2)
+defined.
+
+interpretation "functional composition (nstream)"
+ 'compose f2 f1 = (compose f2 f1).
+
+(* Basic properties on compose ***********************************************)
+
+lemma compose_rew: ∀f2,f1,p1. f2@❨p1❩⨮(⫰*[p1]f2)∘f1 = f2∘(p1⨮f1).
+#f2 #f1 #p1 <(stream_rew … (f2∘(p1⨮f1))) normalize //
+qed.
+
+lemma compose_next: ∀f2,f1,f. f2∘f1 = f → (↑f2)∘f1 = ↑f.
+#f2 * #p1 #f1 #f <compose_rew <compose_rew
+* -f /2 width=1 by eq_f2/
+qed.
+
+(* Basic inversion lemmas on compose ****************************************)
+
+lemma compose_inv_rew: ∀f2,f1,f,p1,p. f2∘(p1⨮f1) = p⨮f →
+ f2@❨p1❩ = p ∧ (⫰*[p1]f2)∘f1 = f.
+#f2 #f1 #f #p1 #p <compose_rew
+#H destruct /2 width=1 by conj/
+qed-.
+
+lemma compose_inv_O2: ∀f2,f1,f,p2,p. (p2⨮f2)∘(⫯f1) = p⨮f →
+ p2 = p ∧ f2∘f1 = f.
+#f2 #f1 #f #p2 #p <compose_rew
+#H destruct /2 width=1 by conj/
+qed-.
+
+lemma compose_inv_S2: ∀f2,f1,f,p2,p1,p. (p2⨮f2)∘(↑p1⨮f1) = p⨮f →
+ f2@❨p1❩+p2 = p ∧ f2∘(p1⨮f1) = f2@❨p1❩⨮f.
+#f2 #f1 #f #p2 #p1 #p <compose_rew
+#H destruct >nsucc_inj <stream_tls_swap
+/2 width=1 by conj/
+qed-.
+
+lemma compose_inv_S1: ∀f2,f1,f,p1,p. (↑f2)∘(p1⨮f1) = p⨮f →
+ ↑(f2@❨p1❩) = p ∧ f2∘(p1⨮f1) = f2@❨p1❩⨮f.
+#f2 #f1 #f #p1 #p <compose_rew
+#H destruct /2 width=1 by conj/
+qed-.
+
+(* Properties on after (specific) *********************************************)
+
+lemma after_O2: ∀f2,f1,f. f2 ⊚ f1 ≘ f →
+ ∀p. p⨮f2 ⊚ ⫯f1 ≘ p⨮f.
+#f2 #f1 #f #Hf #p elim p -p
+/2 width=7 by gr_after_refl, gr_after_next/
+qed.
+
+lemma after_S2: ∀f2,f1,f,p1,p. f2 ⊚ p1⨮f1 ≘ p⨮f →
+ ∀p2. p2⨮f2 ⊚ ↑p1⨮f1 ≘ (p+p2)⨮f.
+#f2 #f1 #f #p1 #p #Hf #p2 elim p2 -p2
+/2 width=7 by gr_after_next, gr_after_push/
+qed.
+
+lemma after_apply: ∀p1,f2,f1,f.
+ (⫰*[ninj p1] f2) ⊚ f1 ≘ f → f2 ⊚ p1⨮f1 ≘ f2@❨p1❩⨮f.
+#p1 elim p1 -p1
+[ * /2 width=1 by after_O2/
+| #p1 #IH * #p2 #f2 >nsucc_inj <stream_tls_swap
+ /3 width=1 by after_S2/
+]
+qed-.
+
+corec lemma after_total_aux: ∀f2,f1,f. f2 ∘ f1 = f → f2 ⊚ f1 ≘ f.
+* #p2 #f2 * #p1 #f1 * #p #f cases p2 -p2
+[ cases p1 -p1
+ [ #H cases (compose_inv_O2 … H) -H /3 width=7 by gr_after_refl, eq_f2/
+ | #p1 #H cases (compose_inv_S2 … H) -H * -p /3 width=7 by gr_after_push/
+ ]
+| #p2 >gr_next_unfold #H cases (compose_inv_S1 … H) -H * -p >gr_next_unfold
+ /3 width=5 by gr_after_next/
+]
+qed-.
+
+theorem after_total: ∀f1,f2. f2 ⊚ f1 ≘ f2 ∘ f1.
+/2 width=1 by after_total_aux/ qed.
+
+(* Inversion lemmas on after (specific) ***************************************)
+
+lemma after_inv_xpx: ∀f2,g2,f,p2,p. p2⨮f2 ⊚ g2 ≘ p⨮f → ∀f1. ⫯f1 = g2 →
+ f2 ⊚ f1 ≘ f ∧ p2 = p.
+#f2 #g2 #f #p2 elim p2 -p2
+[ #p #Hf #f1 #H2 elim (gr_after_inv_push_bi … Hf … H2) -g2 [|*: // ]
+ #g #Hf #H elim (push_inv_seq_dx … H) -H destruct /2 width=1 by conj/
+| #p2 #IH #p #Hf #f1 #H2 elim (gr_after_inv_next_sn … Hf) -Hf [|*: // ]
+ #g1 #Hg #H1 elim (next_inv_seq_dx … H1) -H1
+ #x #Hx #H destruct elim (IH … Hg) [|*: // ] -IH -Hg
+ #H destruct /2 width=1 by conj/
+]
+qed-.
+
+lemma after_inv_xnx: ∀f2,g2,f,p2,p. p2⨮f2 ⊚ g2 ≘ p⨮f → ∀f1. ↑f1 = g2 →
+ ∃∃q. f2 ⊚ f1 ≘ q⨮f & q+p2 = p.
+#f2 #g2 #f #p2 elim p2 -p2
+[ #p #Hf #f1 #H2 elim (gr_after_inv_push_next … Hf … H2) -g2 [|*: // ]
+ #g #Hf #H elim (next_inv_seq_dx … H) -H
+ #x #Hx #Hg destruct /2 width=3 by ex2_intro/
+| #p2 #IH #p #Hf #f1 #H2 elim (gr_after_inv_next_sn … Hf) -Hf [|*: // ]
+ #g #Hg #H elim (next_inv_seq_dx … H) -H
+ #x #Hx #H destruct elim (IH … Hg) -IH -Hg [|*: // ]
+ #m #Hf #Hm destruct /2 width=3 by ex2_intro/
+]
+qed-.
+
+lemma after_inv_const: ∀f2,f1,f,p1,p.
+ p⨮f2 ⊚ p1⨮f1 ≘ p⨮f → f2 ⊚ f1 ≘ f ∧ 𝟏 = p1.
+#f2 #f1 #f #p1 #p elim p -p
+[ #H elim (gr_after_inv_push_sn_push … H) -H [|*: // ]
+ #g2 #Hf #H elim (push_inv_seq_dx … H) -H /2 width=1 by conj/
+| #p #IH #H lapply (gr_after_inv_next_sn_next … H ????) -H /2 width=5 by/
+]
+qed-.
+
+lemma after_inv_total: ∀f2,f1,f. f2 ⊚ f1 ≘ f → f2 ∘ f1 ≡ f.
+/2 width=4 by gr_after_mono/ qed-.
+
+(* Forward lemmas on after (specific) *****************************************)
+
+lemma after_fwd_hd: ∀f2,f1,f,p1,p. f2 ⊚ p1⨮f1 ≘ p⨮f → f2@❨p1❩ = p.
+#f2 #f1 #f #p1 #p #H lapply (gr_after_des_pat ? p1 (𝟏) … H) -H [4:|*: // ]
+/3 width=2 by at_inv_O1, sym_eq/
+qed-.
+
+lemma after_fwd_tls: ∀f,f1,p1,f2,p2,p. p2⨮f2 ⊚ p1⨮f1 ≘ p⨮f →
+ (⫰*[↓p1]f2) ⊚ f1 ≘ f.
+#f #f1 #p1 elim p1 -p1
+[ #f2 #p2 #p #H elim (after_inv_xpx … H) -H //
+| #p1 #IH * #q2 #f2 #p2 #p #H elim (after_inv_xnx … H) -H [|*: // ]
+ #x #Hx #H destruct /2 width=3 by/
+]
+qed-.
+
+lemma after_inv_apply: ∀f2,f1,f,p2,p1,p. p2⨮f2 ⊚ p1⨮f1 ≘ p⨮f →
+ (p2⨮f2)@❨p1❩ = p ∧ (⫰*[↓p1]f2) ⊚ f1 ≘ f.
+/3 width=3 by after_fwd_tls, after_fwd_hd, conj/ qed-.
+
+(* Properties on apply ******************************************************)
+
+lemma compose_apply (f2) (f1) (i): f2@❨f1@❨i❩❩ = (f2∘f1)@❨i❩.
+/4 width=6 by gr_after_des_pat, at_inv_total, sym_eq/ 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 "ground/arith/nat_lt_plus.ma".
+include "ground/relocation/rtmap_basic_at.ma".
+include "ground/relocation/pstream_after.ma".
+
+(* RELOCATION P-STREAM ******************************************************)
+
+(* Properties on basic relocation (specific) **********************************)
+
+lemma apply_basic_lt: ∀m,n,i. ninj i ≤ m → 𝐛❨m,n❩@❨i❩ = i.
+/3 width=1 by at_inv_total, gr_pat_basic_lt/ qed-.
+
+lemma apply_basic_ge: ∀m,n,i. m < ninj i → 𝐛❨m,n❩@❨i❩ = i+n.
+/3 width=1 by at_inv_total, gr_pat_basic_ge/ qed-.
+
+(* Main properties on basic relocation (specific) *****************************)
+
+theorem basic_swap: ∀d1,d2. d2 ≤ d1 →
+ ∀h1,h2. 𝐛❨d2,h2❩∘𝐛❨d1,h1❩ ≡ 𝐛❨d1+h2,h1❩∘𝐛❨d2,h2❩.
+#d1 #d2 #Hd21 #h1 #h2
+@nstream_inv_eq
+@nstream_eq_inv_ext #i
+<compose_apply <compose_apply
+elim (nat_split_lt_ge d2 i) #Hd2
+[ elim (nat_split_lt_ge d1 i) -Hd21 #Hd1
+ [ >(apply_basic_ge … Hd1) >(apply_basic_ge … Hd2) >apply_basic_ge
+ [ >apply_basic_ge // >nrplus_inj_sn /2 width=1 by nlt_plus_bi_sn/
+ | >nrplus_inj_sn /2 width=2 by nlt_plus_dx_dx/
+ ]
+ | >(apply_basic_lt … Hd1) >(apply_basic_ge … Hd2)
+ >apply_basic_lt // >nrplus_inj_sn /2 width=1 by nle_plus_bi_dx/
+ ]
+| lapply (nle_trans … Hd2 … Hd21) -Hd21 #Hd1
+ >(apply_basic_lt … Hd1) >(apply_basic_lt … Hd2)
+ >apply_basic_lt /2 width=1 by nle_plus_dx_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 "ground/notation/functions/cocompose_2.ma".
+include "ground/relocation/rtmap_coafter.ma".
+
+(* RELOCATION P-STREAM ******************************************************)
+
+rec definition fun0 (p1:pnat) on p1: gr_map → pnat.
+* * [ | #p2 #f2 @(𝟏) ]
+#f2 cases p1 -p1 [ @(𝟏) ]
+#p1 @(↑(fun0 p1 f2))
+defined.
+
+rec definition fun2 (p1:pnat) on p1: gr_map → gr_map.
+* * [ | #p2 #f2 @(p2⨮f2) ]
+#f2 cases p1 -p1 [ @f2 ]
+#p1 @(fun2 p1 f2)
+defined.
+
+rec definition fun1 (p1:pnat) (f1:gr_map) on p1: gr_map → gr_map.
+* * [ | #p2 #f2 @(p1⨮f1) ]
+#f2 cases p1 -p1 [ @f1 ]
+#p1 @(fun1 p1 f1 f2)
+defined.
+
+corec definition cocompose: gr_map → gr_map → gr_map.
+#f2 * #p1 #f1
+@(stream_cons … (fun0 p1 f2)) @(cocompose (fun2 p1 f2) (fun1 p1 f1 f2))
+defined.
+
+interpretation "functional co-composition (nstream)"
+ 'CoCompose f1 f2 = (cocompose f1 f2).
+
+(* Basic properties on funs *************************************************)
+
+(* Note: we need theese since matita blocks recursive δ when ι is blocked *)
+lemma fun0_xn: ∀f2,p1. 𝟏 = fun0 p1 (↑f2).
+* #p2 #f2 * //
+qed.
+
+lemma fun2_xn: ∀f2,p1. f2 = fun2 p1 (↑f2).
+* #p2 #f2 * //
+qed.
+
+lemma fun1_xxn: ∀f2,f1,p1. fun1 p1 f1 (↑f2) = p1⨮f1.
+* #p2 #f2 #f1 * //
+qed.
+
+(* Basic properties on cocompose *********************************************)
+
+lemma cocompose_rew: ∀f2,f1,p1. (fun0 p1 f2)⨮(fun2 p1 f2)~∘(fun1 p1 f1 f2) = f2 ~∘ (p1⨮f1).
+#f2 #f1 #p1 <(stream_rew … (f2~∘(p1⨮f1))) normalize //
+qed.
+
+(* Basic inversion lemmas on compose ****************************************)
+
+lemma cocompose_inv_ppx: ∀f2,f1,f,x. (⫯f2) ~∘ (⫯f1) = x⨮f →
+ ∧∧ 𝟏 = x & f2 ~∘ f1 = f.
+#f2 #f1 #f #x
+<cocompose_rew #H destruct
+normalize /2 width=1 by conj/
+qed-.
+
+lemma cocompose_inv_pnx: ∀f2,f1,f,p1,x. (⫯f2) ~∘ (↑p1⨮f1) = x⨮f →
+ ∃∃p. ↑p = x & f2 ~∘ (p1⨮f1) = p⨮f.
+#f2 #f1 #f #p1 #x
+<cocompose_rew #H destruct
+@(ex2_intro … (fun0 p1 f2)) // <cocompose_rew
+/3 width=1 by eq_f2/
+qed-.
+
+lemma cocompose_inv_nxx: ∀f2,f1,f,p1,x. (↑f2) ~∘ (p1⨮f1) = x⨮f →
+ ∧∧ 𝟏 = x & f2 ~∘ (p1⨮f1) = f.
+#f2 #f1 #f #p1 #x
+<cocompose_rew #H destruct
+/2 width=1 by conj/
+qed-.
+
+(* Properties on coafter (specific) *******************************************)
+
+corec lemma coafter_total_aux: ∀f2,f1,f. f2 ~∘ f1 = f → f2 ~⊚ f1 ≘ f.
+* #p2 #f2 * #p1 #f1 * #p #f cases p2 -p2
+[ cases p1 -p1
+ [ #H cases (cocompose_inv_ppx … H) -H /3 width=7 by gr_coafter_refl, eq_f2/
+ | #p1 #H cases (cocompose_inv_pnx … H) -H /3 width=7 by gr_coafter_push/
+ ]
+| #p2 >gr_next_unfold #H cases (cocompose_inv_nxx … H) -H /3 width=5 by gr_coafter_next/
+]
+qed-.
+
+theorem coafter_total: ∀f2,f1. f2 ~⊚ f1 ≘ f2 ~∘ f1.
+/2 width=1 by coafter_total_aux/ 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 "ground/lib/stream_eq.ma".
+include "ground/relocation/rtmap_eq.ma".
+
+(* RELOCATION P-STREAM ******************************************************)
+
+(* Properties (specific) ******************************************************)
+
+fact eq_inv_seq_aux: ∀f1,f2,p1,p2. p1⨮f1 ≡ p2⨮f2 → p1 = p2 ∧ f1 ≡ f2.
+#f1 #f2 #p1 #p2 @(pnat_ind_2 … p1 p2) -p1 -p2
+[ #p2 #H elim (gr_eq_inv_push_sn … H) -H [2,3: // ]
+ #g1 #H1 #H elim (push_inv_seq_dx … H) -H /2 width=1 by conj/
+| #p1 #_ #H elim (gr_eq_inv_next_push … H) -H //
+| #p1 #p2 #IH #H lapply (gr_eq_inv_next_bi … H ????) -H [5:|*: // ]
+ #H elim (IH H) -IH -H /2 width=1 by conj/
+]
+qed-.
+
+lemma eq_inv_seq: ∀g1,g2. g1 ≡ g2 → ∀f1,f2,p1,p2. p1⨮f1 = g1 → p2⨮f2 = g2 →
+ p1 = p2 ∧ f1 ≡ f2.
+/2 width=1 by eq_inv_seq_aux/ qed-.
+
+corec lemma nstream_eq: ∀f1,f2. f1 ≡ f2 → f1 ≗ f2.
+* #p1 #f1 * #p2 #f2 #Hf cases (gr_eq_inv_gen … Hf) -Hf *
+#g1 #g2 #Hg #H1 #H2
+[ cases (push_inv_seq_dx … H1) -H1 * -p1 #H1
+ cases (push_inv_seq_dx … H2) -H2 * -p2 #H2
+ @stream_eq_cons /2 width=1 by/
+| cases (next_inv_seq_dx … H1) -H1 #m1 #H1 * -p1
+ cases (next_inv_seq_dx … H2) -H2 #m2 #H2 * -p2
+ cases (eq_inv_seq … Hg … H1 H2) -g1 -g2 #Hm #Hf
+ @stream_eq_cons /2 width=1 by/
+]
+qed-.
+
+corec lemma nstream_inv_eq: ∀f1,f2. f1 ≗ f2 → f1 ≡ f2.
+* #p1 #f1 * #p2 #f2 #H cases (stream_eq_inv_cons ??? H) -H [|*: // ]
+#Hf * -p2 cases p1 -p1 /3 width=5 by gr_eq_next/
+#n @gr_eq_next /3 width=5 by stream_eq_cons/
+qed.
+
+lemma eq_seq_id: ∀f1,f2. f1 ≡ f2 → ∀n. n⨮f1 ≡ n⨮f2.
+/4 width=1 by nstream_inv_eq, nstream_eq, stream_eq_cons/ 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 "ground/relocation/rtmap_isid.ma".
+
+(* RELOCATION P-STREAM ******************************************************)
+
+(* Inversion lemmas (specific) ************************************************)
+
+lemma isid_inv_seq: ∀f,p. 𝐈❪p⨮f❫ → 𝐈❪f❫ ∧ 𝟏 = p.
+#f #p #H elim (gr_isi_inv_gen … H) -H
+#g #Hg #H elim (push_inv_seq_dx … H) -H /2 width=1 by conj/
+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 "ground/notation/functions/apply_2.ma".
+include "ground/arith/pnat_le_plus.ma".
+include "ground/relocation/pstream_eq.ma".
+include "ground/relocation/rtmap_istot.ma".
+
+(* RELOCATION P-STREAM ******************************************************)
+
+rec definition apply (i: pnat) on i: gr_map → pnat.
+* #p #f cases i -i
+[ @p
+| #i lapply (apply i f) -apply -i -f
+ #i @(i+p)
+]
+defined.
+
+interpretation "functional application (nstream)"
+ 'Apply f i = (apply i f).
+
+(* Properties on at (specific) ************************************************)
+
+lemma at_O1: ∀i2,f. @❪𝟏, i2⨮f❫ ≘ i2.
+#i2 elim i2 -i2 /2 width=5 by gr_pat_refl, gr_pat_next/
+qed.
+
+lemma at_S1: ∀p,f,i1,i2. @❪i1, f❫ ≘ i2 → @❪↑i1, p⨮f❫ ≘ i2+p.
+#p elim p -p /3 width=7 by gr_pat_push, gr_pat_next/
+qed.
+
+lemma at_total: ∀i1,f. @❪i1, f❫ ≘ f@❨i1❩.
+#i1 elim i1 -i1
+[ * // | #i #IH * /3 width=1 by at_S1/ ]
+qed.
+
+lemma at_istot: ∀f. 𝐓❪f❫.
+/2 width=2 by ex_intro/ qed.
+
+lemma at_plus2: ∀f,i1,i,p,q. @❪i1, p⨮f❫ ≘ i → @❪i1, (p+q)⨮f❫ ≘ i+q.
+#f #i1 #i #p #q #H elim q -q
+/2 width=5 by gr_pat_next/
+qed.
+
+(* Inversion lemmas on at (specific) ******************************************)
+
+lemma at_inv_O1: ∀f,p,i2. @❪𝟏, p⨮f❫ ≘ i2 → p = i2.
+#f #p elim p -p /2 width=6 by gr_pat_inv_unit_push/
+#p #IH #i2 #H elim (gr_pat_inv_next … H) -H [|*: // ]
+#j2 #Hj * -i2 /3 width=1 by eq_f/
+qed-.
+
+lemma at_inv_S1: ∀f,p,j1,i2. @❪↑j1, p⨮f❫ ≘ i2 →
+ ∃∃j2. @❪j1, f❫ ≘ j2 & j2+p = i2.
+#f #p elim p -p /2 width=5 by gr_pat_inv_succ_push/
+#p #IH #j1 #i2 #H elim (gr_pat_inv_next … H) -H [|*: // ]
+#j2 #Hj * -i2 elim (IH … Hj) -IH -Hj
+#i2 #Hi * -j2 /2 width=3 by ex2_intro/
+qed-.
+
+lemma at_inv_total: ∀f,i1,i2. @❪i1, f❫ ≘ i2 → f@❨i1❩ = i2.
+/2 width=6 by fr2_nat_mono/ qed-.
+
+(* Forward lemmas on at (specific) *******************************************)
+
+lemma at_increasing_plus: ∀f,p,i1,i2. @❪i1, p⨮f❫ ≘ i2 → i1 + p ≤ ↑i2.
+#f #p *
+[ #i2 #H <(at_inv_O1 … H) -i2 //
+| #i1 #i2 #H elim (at_inv_S1 … H) -H
+ #j1 #Ht * -i2 <pplus_succ_sn
+ /4 width=2 by gr_pat_increasing, ple_plus_bi_dx, ple_succ_bi/
+]
+qed-.
+
+lemma at_fwd_id: ∀f,p,i. @❪i, p⨮f❫ ≘ i → 𝟏 = p.
+#f #p #i #H elim (gr_pat_des_id … H) -H
+#g #H elim (push_inv_seq_dx … H) -H //
+qed-.
+
+(* Basic properties *********************************************************)
+
+lemma apply_O1: ∀p,f. (p⨮f)@❨𝟏❩ = p.
+// qed.
+
+lemma apply_S1: ∀p,f,i. (p⨮f)@❨↑i❩ = f@❨i❩+p.
+// qed.
+
+lemma apply_eq_repl (i): gr_eq_repl … (λf1,f2. f1@❨i❩ = f2@❨i❩).
+#i elim i -i [2: #i #IH ] * #p1 #f1 * #p2 #f2 #H
+elim (eq_inv_seq_aux … H) -H #Hp #Hf //
+>apply_S1 >apply_S1 /3 width=1 by eq_f2/
+qed.
+
+lemma apply_S2: ∀f,i. (↑f)@❨i❩ = ↑(f@❨i❩).
+* #p #f * //
+qed.
+
+(* Main inversion lemmas ****************************************************)
+
+theorem apply_inj: ∀f,i1,i2,j. f@❨i1❩ = j → f@❨i2❩ = j → i1 = i2.
+/2 width=4 by gr_pat_inj/ qed-.
+
+corec theorem nstream_eq_inv_ext: ∀f1,f2. (∀i. f1@❨i❩ = f2@❨i❩) → f1 ≗ f2.
+* #p1 #f1 * #p2 #f2 #Hf @stream_eq_cons
+[ @(Hf (𝟏))
+| @nstream_eq_inv_ext -nstream_eq_inv_ext #i
+ lapply (Hf (𝟏)) >apply_O1 >apply_O1 #H destruct
+ lapply (Hf (↑i)) >apply_S1 >apply_S1 #H
+ /3 width=2 by eq_inv_pplus_bi_dx, eq_inv_psucc_bi/
+]
+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 "ground/relocation/rtmap_sor.ma".
+
+(* RELOCATION P-STREAM ******************************************************)
+
+axiom union: gr_map → gr_map → gr_map.
+
+interpretation "union (nstream)"
+ 'union f1 f2 = (union f1 f2).
+
+(* Properties on sor (specific) ***********************************************)
+
+axiom sor_total: ∀f1,f2. f1 ⋓ f2 ≘ f1 ∪ f2.
--- /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 "ground/lib/stream_hdtl.ma".
+include "ground/relocation/pstream.ma".
+
+(* RELOCATION P-STREAM ******************************************************)
+
+(* Properties with stream_tl *************************************************)
+
+lemma tl_push: ∀f. f = ⫰⫯f.
+// qed.
+
+lemma tl_next: ∀f. ⫰f = ⫰↑f.
+* // 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 "ground/lib/stream_tls.ma".
+include "ground/arith/nat_pred_succ.ma".
+include "ground/relocation/pstream_tl.ma".
+
+(* RELOCATION P-STREAM ******************************************************)
+
+(* Properties with stream_tls ************************************************)
+
+lemma tls_next: ∀f. ∀p:pnat. ⫰*[p]f = ⫰*[p]↑f.
+#f #p >(npsucc_pred p) <stream_tls_swap <stream_tls_swap //
+qed.
(* Basic constructions ******************************************************)
-lemma exteq_refl (A) (B): reflexive … (exteq A B).
+lemma exteq_refl (A) (B):
+ reflexive … (exteq A B).
// qed.
-lemma exteq_repl (A) (B): replace_2 … (exteq A B) (exteq A B) (exteq A B).
+lemma exteq_repl (A) (B):
+ replace_2 … (exteq A B) (exteq A B) (exteq A B).
// qed-.
-lemma exteq_sym (A) (B): symmetric … (exteq A B).
+lemma exteq_sym (A) (B):
+ symmetric … (exteq A B).
/2 width=1 by exteq_repl/ qed-.
-lemma exteq_trans (A) (B): Transitive … (exteq A B).
+lemma exteq_trans (A) (B):
+ Transitive … (exteq A B).
/2 width=1 by exteq_repl/ qed-.
-lemma exteq_canc_sn (A) (B): left_cancellable … (exteq A B).
+lemma exteq_canc_sn (A) (B):
+ left_cancellable … (exteq A B).
/2 width=1 by exteq_repl/ qed-.
-lemma exteq_canc_dx (A) (B): right_cancellable … (exteq A B).
+lemma exteq_canc_dx (A) (B):
+ right_cancellable … (exteq A B).
/2 width=1 by exteq_repl/ qed-.
(* Constructions with compose ***********************************************)
(* FUNCTIONS ****************************************************************)
-definition left_identity (A) (f): predicate A ≝ λi. ∀a:A. a = f i a.
+definition left_identity (A) (f):
+ predicate A ≝
+ λi. ∀a:A. a = f i a.
-definition right_identity (A) (f): predicate A ≝ λi. ∀a:A. a = f a i.
+definition right_identity (A) (f):
+ predicate A ≝
+ λi. ∀a:A. a = f a i.
definition compatible_2 (A) (B):
- relation3 … (relation A) (relation B) ≝
- λf,Sa,Sb.
- ∀a1,a2. Sa a1 a2 → Sb (f a1) (f a2).
+ relation3 … (relation A) (relation B) ≝
+ λf,Sa,Sb.
+ ∀a1,a2. Sa a1 a2 → Sb (f a1) (f a2).
definition compatible_3 (A) (B) (C):
- relation4 … (relation A) (relation B) (relation C) ≝
- λf,Sa,Sb,Sc.
- ∀a1,a2. Sa a1 a2 → ∀b1,b2. Sb b1 b2 → Sc (f a1 b1) (f a2 b2).
+ relation4 … (relation A) (relation B) (relation C) ≝
+ λf,Sa,Sb,Sc.
+ ∀a1,a2. Sa a1 a2 → ∀b1,b2. Sb b1 b2 → Sc (f a1 b1) (f a2 b2).
-definition annulment_2 (A) (f): predicate A ≝
- λi:A. ∀a1,a2. i = f a1 a2 → ∧∧ i = a1 & i = a2.
+definition annulment_2 (A) (f):
+ predicate A ≝
+ λi:A.
+ ∀a1,a2. i = f a1 a2 → ∧∧ i = a1 & i = a2.
"cons (lists)"
'OPlusRight A hd tl = (list_cons A hd tl).
-rec definition list_all A (R:predicate A) (l:list A) on l ≝
-match l with
+rec definition list_all A (R:predicate A) (l:list A) on l ≝ match l with
[ list_nil ⇒ ⊤
| list_cons hd tl ⇒ ∧∧ R hd & list_all A R tl
].
(* Basic constructions ******************************************************)
-lemma list_eq_refl (A): reflexive … (list_eq A).
+lemma list_eq_refl (A):
+ reflexive … (list_eq A).
#A #l elim l -l /2 width=1 by conj/
qed.
(* Main constructions *******************************************************)
-theorem eq_list_eq (A,l1,l2): l1 = l2 → l1 ≗{A} l2.
+theorem eq_list_eq (A) (l1) (l2):
+ l1 = l2 → l1 ≗{A} l2.
// qed.
(* Main inversions **********************************************************)
-theorem list_eq_inv_eq (A,l1,l2): l1 ≗{A} l2 → l1 = l2.
+theorem list_eq_inv_eq (A) (l1) (l2):
+ l1 ≗{A} l2 → l1 = l2.
#A #l1 elim l1 -l1 [| #a1 #l1 #IH ] *
[ //
| #a2 #l2 #H elim H
(* LENGTH FOR LISTS *********************************************************)
-rec definition list_length A (l:list A) on l ≝
-match l with
+rec definition list_length A (l:list A) on l ≝ match l with
[ list_nil ⇒ 𝟎
| list_cons _ l ⇒ ↑(list_length A l)
].
(* Constructions with land **************************************************)
-lemma commutative_and: ∀A,B. A ∧ B → B ∧ A.
+lemma commutative_and (A) (B):
+ A ∧ B → B ∧ A.
#A #B * /2 width=1 by conj/
qed-.
(* Basic constructions ******************************************************)
-lemma ltc_sn (A) (f) (B) (R): ∀a1,b1,b. R a1 b1 b →
- ∀a2,b2. ltc A f B R a2 b b2 → ltc … f … R (f a1 a2) b1 b2.
+lemma ltc_sn (A) (f) (B) (R):
+ ∀a1,b1,b. R a1 b1 b →
+ ∀a2,b2. ltc A f B R a2 b b2 → ltc … f … R (f a1 a2) b1 b2.
/3 width=3 by ltc_rc, ltc_trans/ qed.
-lemma ltc_dx (A) (f) (B) (R): ∀a1,b1,b. ltc A f B R a1 b1 b →
- ∀a2,b2. R a2 b b2 → ltc … f … R (f a1 a2) b1 b2.
+lemma ltc_dx (A) (f) (B) (R):
+ ∀a1,b1,b. ltc A f B R a1 b1 b →
+ ∀a2,b2. R a2 b b2 → ltc … f … R (f a1 a2) b1 b2.
/3 width=3 by ltc_rc, ltc_trans/ qed.
(* Basic eliminations *******************************************************)
-lemma ltc_ind_sn (A) (f) (B) (R) (Q:relation2 A B) (b2): associative … f →
- (∀a,b1. R a b1 b2 → Q a b1) →
- (∀a1,a2,b1,b. R a1 b1 b → ltc … f … R a2 b b2 → Q a2 b → Q (f a1 a2) b1) →
- ∀a,b1. ltc … f … R a b1 b2 → Q a b1.
+lemma ltc_ind_sn (A) (f) (B) (R) (Q:relation2 A B) (b2):
+ associative … f →
+ (∀a,b1. R a b1 b2 → Q a b1) →
+ (∀a1,a2,b1,b. R a1 b1 b → ltc … f … R a2 b b2 → Q a2 b → Q (f a1 a2) b1) →
+ ∀a,b1. ltc … f … R a b1 b2 → Q a b1.
#A #f #B #R #Q #b2 #Hf #IH1 #IH2 #a #b1 @(insert_eq_1 … b2)
#b0 #H elim H -a -b1 -b0 /2 width=2 by/
#a1 #a2 #b1 #b #b0 #H #Hb2 #_
elim H -a1 -b1 -b /4 width=4 by ltc_trans/
qed-.
-lemma ltc_ind_dx (A) (f) (B) (R) (Q:A→predicate B) (b1): associative … f →
- (∀a,b2. R a b1 b2 → Q a b2) →
- (∀a1,a2,b,b2. ltc … f … R a1 b1 b → Q a1 b → R a2 b b2 → Q (f a1 a2) b2) →
- ∀a,b2. ltc … f … R a b1 b2 → Q a b2.
+lemma ltc_ind_dx (A) (f) (B) (R) (Q:A→predicate B) (b1):
+ associative … f →
+ (∀a,b2. R a b1 b2 → Q a b2) →
+ (∀a1,a2,b,b2. ltc … f … R a1 b1 b → Q a1 b → R a2 b b2 → Q (f a1 a2) b2) →
+ ∀a,b2. ltc … f … R a b1 b2 → Q a b2.
#A #f #B #R #Q #b1 #Hf #IH1 #IH2 #a #b2 @(insert_eq_1 … b1)
#b0 #H elim H -a -b0 -b2 /2 width=2 by/
#a1 #a2 #b0 #b #b2 #Hb0 #H #IHb0 #_
(* Advanced eliminations (with reflexivity) *********************************)
lemma ltc_ind_sn_refl (A) (i) (f) (B) (R) (Q:relation2 A B) (b2):
- associative … f → right_identity … f i → reflexive B (R i) →
- Q i b2 →
- (∀a1,a2,b1,b. R a1 b1 b → ltc … f … R a2 b b2 → Q a2 b → Q (f a1 a2) b1) →
- ∀a,b1. ltc … f … R a b1 b2 → Q a b1.
+ associative … f → right_identity … f i → reflexive B (R i) →
+ Q i b2 →
+ (∀a1,a2,b1,b. R a1 b1 b → ltc … f … R a2 b b2 → Q a2 b → Q (f a1 a2) b1) →
+ ∀a,b1. ltc … f … R a b1 b2 → Q a b1.
#A #i #f #B #R #Q #b2 #H1f #H2f #HR #IH1 #IH2 #a #b1 #H
@(ltc_ind_sn … R … H1f … IH2 … H) -a -b1 -H1f #a #b1 #Hb12
>(H2f a) -H2f /3 width=4 by ltc_rc/
qed-.
lemma ltc_ind_dx_refl (A) (i) (f) (B) (R) (Q:A→predicate B) (b1):
- associative … f → left_identity … f i → reflexive B (R i) →
- Q i b1 →
- (∀a1,a2,b,b2. ltc … f … R a1 b1 b → Q a1 b → R a2 b b2 → Q (f a1 a2) b2) →
- ∀a,b2. ltc … f … R a b1 b2 → Q a b2.
+ associative … f → left_identity … f i → reflexive B (R i) →
+ Q i b1 →
+ (∀a1,a2,b,b2. ltc … f … R a1 b1 b → Q a1 b → R a2 b b2 → Q (f a1 a2) b2) →
+ ∀a,b2. ltc … f … R a b1 b2 → Q a b2.
#A #i #f #B #R #Q #b1 #H1f #H2f #HR #IH1 #IH2 #a #b2 #H
@(ltc_ind_dx … R … H1f … IH2 … H) -a -b2 -H1f #a #b2 #Hb12
>(H2f a) -H2f /3 width=4 by ltc_rc/
(* Constructions with lsub **************************************************)
-lemma ltc_lsub_trans: ∀A,f. associative … f →
- ∀B,C,R,S. (∀n. lsub_trans B C (λL. R L n) S) →
- ∀n. lsub_trans B C (λL. ltc A f … (R L) n) S.
-#A #f #Hf #B #C #R #S #HRS #n #L2 #T1 #T2 #H
+lemma ltc_lsub_trans (A) (f) (B) (C) (R) (S):
+ associative … f →
+ (∀n. lsub_trans B C (λL. R L n) S) →
+ ∀n. lsub_trans B C (λL. ltc A f … (R L) n) S.
+#A #f #B #C #R #S #Hf #HRS #n #L2 #T1 #T2 #H
@(ltc_ind_dx … Hf ???? H) -n -T2
/3 width=5 by ltc_dx, ltc_rc/
qed-.
(* Constructions with ctc ***************************************************)
lemma ltc_CTC (C) (A) (i) (f) (B) (R:relation4 C A B B):
- left_identity … f i →
- ∀c. CTC … (λc. R c i) c ⊆ ltc … f … (R c) i.
+ left_identity … f i →
+ ∀c. CTC … (λc. R c i) c ⊆ ltc … f … (R c) i.
#C #A #i #f #B #R #Hf #c #b1 #b2 #H elim H -b2 /2 width=1 by ltc_rc/
#b #b2 #_ #Hb2 #IH >(Hf i) -Hf /2 width=3 by ltc_dx/
qed.
(* Inversions with ctc ******************************************************)
lemma ltc_inv_CTC (C) (A) (i) (f) (B) (R:relation4 C A B B):
- associative … f → annulment_2 … f i →
- ∀c. ltc … f … (R c) i ⊆ CTC … (λc. R c i) c.
+ associative … f → annulment_2 … f i →
+ ∀c. ltc … f … (R c) i ⊆ CTC … (λc. R c i) c.
#C #A #i #f #B #R #H1f #H2f #c #b1 #b2
@(insert_eq_1 … i) #a #H
@(ltc_ind_dx A f B … H) -a -b2 /2 width=1 by inj/ -H1f
(* Main constructions with eq ***********************************************)
-theorem canc_sn_eq (A): left_cancellable A (eq …).
+theorem canc_sn_eq (A):
+ left_cancellable A (eq …).
// qed-.
-theorem canc_dx_eq (A): right_cancellable A (eq …).
+theorem canc_dx_eq (A):
+ right_cancellable A (eq …).
// qed-.
(* TRANSITIVE CLOSURE FOR RELATIONS *****************************************)
-definition CTC: ∀A:Type[0]. ∀B. (A→relation B) → (A→relation B) ≝
- λA,B,R,a. TC … (R a).
-
-definition s_r_transitive: ∀A,B. relation2 (A→relation B) (B→relation A) ≝ λA,B,R1,R2.
- ∀L2,T1,T2. R1 L2 T1 T2 → ∀L1. R2 T1 L1 L2 → CTC … R1 L1 T1 T2.
-
-definition s_rs_transitive: ∀A,B. relation2 (A→relation B) (B→relation A) ≝ λA,B,R1,R2.
- ∀L2,T1,T2. CTC … R1 L2 T1 T2 → ∀L1. R2 T1 L1 L2 → CTC … R1 L1 T1 T2.
-
-lemma TC_strip1: ∀A,R1,R2. confluent2 A R1 R2 →
- ∀a0,a1. TC … R1 a0 a1 → ∀a2. R2 a0 a2 →
- ∃∃a. R2 a1 a & TC … R1 a2 a.
+definition CTC (A:Type[0]) (B):
+ (A→relation B) → (A→relation B) ≝
+ λR,a. TC … (R a).
+
+definition s_r_transitive (A) (B):
+ relation2 (A→relation B) (B→relation A) ≝
+ λR1,R2.
+ ∀L2,T1,T2. R1 L2 T1 T2 → ∀L1. R2 T1 L1 L2 → CTC … R1 L1 T1 T2.
+
+definition s_rs_transitive (A) (B):
+ relation2 (A→relation B) (B→relation A) ≝
+ λR1,R2.
+ ∀L2,T1,T2. CTC … R1 L2 T1 T2 → ∀L1. R2 T1 L1 L2 → CTC … R1 L1 T1 T2.
+
+lemma TC_strip (A) (R1) (R2):
+ confluent2 A R1 R2 →
+ ∀a0,a1. TC … R1 a0 a1 → ∀a2. R2 a0 a2 →
+ ∃∃a. R2 a1 a & TC … R1 a2 a.
#A #R1 #R2 #HR12 #a0 #a1 #H elim H -a1
[ #a1 #Ha01 #a2 #Ha02
elim (HR12 … Ha01 … Ha02) -HR12 -a0 /3 width=3 by inj, ex2_intro/
]
qed.
-lemma TC_strip2: ∀A,R1,R2. confluent2 A R1 R2 →
- ∀a0,a2. TC … R2 a0 a2 → ∀a1. R1 a0 a1 →
- ∃∃a. TC … R2 a1 a & R1 a2 a.
+lemma TC_strip2 (A) (R1) (R2):
+ confluent2 A R1 R2 →
+ ∀a0,a2. TC … R2 a0 a2 → ∀a1. R1 a0 a1 →
+ ∃∃a. TC … R2 a1 a & R1 a2 a.
#A #R1 #R2 #HR12 #a0 #a2 #H elim H -a2
[ #a2 #Ha02 #a1 #Ha01
elim (HR12 … Ha01 … Ha02) -HR12 -a0 /3 width=3 by inj, ex2_intro/
]
qed.
-lemma TC_confluent2: ∀A,R1,R2.
- confluent2 A R1 R2 → confluent2 A (TC … R1) (TC … R2).
+lemma TC_confluent2 (A) (R1) (R2):
+ confluent2 A R1 R2 → confluent2 A (TC … R1) (TC … R2).
#A #R1 #R2 #HR12 #a0 #a1 #H elim H -a1
[ #a1 #Ha01 #a2 #Ha02
elim (TC_strip2 … HR12 … Ha02 … Ha01) -HR12 -a0 /3 width=3 by inj, ex2_intro/
]
qed.
-lemma TC_strap1: ∀A,R1,R2. transitive2 A R1 R2 →
- ∀a1,a0. TC … R1 a1 a0 → ∀a2. R2 a0 a2 →
- ∃∃a. R2 a1 a & TC … R1 a a2.
+lemma TC_strap1 (A) (R1) (R2):
+ transitive2 A R1 R2 →
+ ∀a1,a0. TC … R1 a1 a0 → ∀a2. R2 a0 a2 →
+ ∃∃a. R2 a1 a & TC … R1 a a2.
#A #R1 #R2 #HR12 #a1 #a0 #H elim H -a0
[ #a0 #Ha10 #a2 #Ha02
elim (HR12 … Ha10 … Ha02) -HR12 -a0 /3 width=3 by inj, ex2_intro/
]
qed.
-lemma TC_strap2: ∀A,R1,R2. transitive2 A R1 R2 →
- ∀a0,a2. TC … R2 a0 a2 → ∀a1. R1 a1 a0 →
- ∃∃a. TC … R2 a1 a & R1 a a2.
+lemma TC_strap2 (A) (R1) (R2):
+ transitive2 A R1 R2 →
+ ∀a0,a2. TC … R2 a0 a2 → ∀a1. R1 a1 a0 →
+ ∃∃a. TC … R2 a1 a & R1 a a2.
#A #R1 #R2 #HR12 #a0 #a2 #H elim H -a2
[ #a2 #Ha02 #a1 #Ha10
elim (HR12 … Ha10 … Ha02) -HR12 -a0 /3 width=3 by inj, ex2_intro/
]
qed.
-lemma TC_transitive2: ∀A,R1,R2.
- transitive2 A R1 R2 → transitive2 A (TC … R1) (TC … R2).
+lemma TC_transitive2 (A) (R1) (R2):
+ transitive2 A R1 R2 → transitive2 A (TC … R1) (TC … R2).
#A #R1 #R2 #HR12 #a1 #a0 #H elim H -a0
[ #a0 #Ha10 #a2 #Ha02
elim (TC_strap2 … HR12 … Ha02 … Ha10) -HR12 -a0 /3 width=3 by inj, ex2_intro/
]
qed.
-lemma CTC_lsub_trans: ∀A,B,R,S. lsub_trans A B R S → lsub_trans A B (CTC … R) S.
+lemma CTC_lsub_trans (A) (B) (R) (S):
+ lsub_trans A B R S → lsub_trans A B (CTC … R) S.
#A #B #R #S #HRS #L2 #T1 #T2 #H elim H -T2 /3 width=3 by inj/
#T #T2 #_ #HT2 #IHT1 #L1 #HL12
lapply (HRS … HT2 … HL12) -HRS -HT2 /3 width=3 by step/
qed-.
-lemma s_r_conf1_CTC1: ∀A,B,S,R. s_r_confluent1 A B S R → s_r_confluent1 A B (CTC … S) R.
+lemma s_r_conf1_CTC1 (A) (B) (S) (R):
+ s_r_confluent1 A B S R → s_r_confluent1 A B (CTC … S) R.
#A #B #S #R #HSR #L1 #T1 #T2 #H @(TC_ind_dx … T1 H) -T1 /3 width=3 by/
qed-.
-lemma s_r_trans_CTC1: ∀A,B,S,R. s_r_confluent1 A B S R →
- s_r_transitive A B S R → s_rs_transitive A B S R.
+lemma s_r_trans_CTC1 (A) (B) (S) (R):
+ s_r_confluent1 A B S R →
+ s_r_transitive A B S R → s_rs_transitive A B S R.
#A #B #S #R #H1SR #H2SR #L2 #T1 #T2 #H @(TC_ind_dx … T1 H) -T1 /2 width=3 by/
#T1 #T #HT1 #_ #IHT2 #L1 #HL12 lapply (H2SR … HT1 … HL12) -H2SR -HT1
/4 width=5 by s_r_conf1_CTC1, trans_TC/
qed-.
-lemma s_r_trans_CTC2: ∀A,B,S,R. s_rs_transitive A B S R → s_r_transitive A B S (CTC … R).
+lemma s_r_trans_CTC2 (A) (B) (S) (R):
+ s_rs_transitive A B S R → s_r_transitive A B S (CTC … R).
#A #B #S #R #HSR #L2 #T1 #T2 #HT12 #L1 #H @(TC_ind_dx … L1 H) -L1 /3 width=3 by inj/
qed-.
-lemma s_r_to_s_rs_trans: ∀A,B,S,R. s_r_transitive A B (CTC … S) R →
- s_rs_transitive A B S R.
+lemma s_r_to_s_rs_trans (A) (B) (S) (R):
+ s_r_transitive A B (CTC … S) R → s_rs_transitive A B S R.
#A #B #S #R #HSR #L2 #T1 #T2 #HL2 #L1 #HT1
elim (TC_idem … (S L1) … T1 T2)
#_ #H @H @HSR //
qed-.
-lemma s_rs_to_s_r_trans: ∀A,B,S,R. s_rs_transitive A B S R →
- s_r_transitive A B (CTC … S) R.
+lemma s_rs_to_s_r_trans (A) (B) (S) (R):
+ s_rs_transitive A B S R → s_r_transitive A B (CTC … S) R.
#A #B #S #R #HSR #L2 #T1 #T2 #HL2 #L1 #HT1
elim (TC_idem … (S L1) … T1 T2)
#H #_ @H @HSR //
qed-.
-lemma s_rs_trans_TC1: ∀A,B,S,R. s_rs_transitive A B S R →
- s_rs_transitive A B (CTC … S) R.
+lemma s_rs_trans_TC1 (A) (B) (S) (R):
+ s_rs_transitive A B S R → s_rs_transitive A B (CTC … S) R.
#A #B #S #R #HSR #L2 #T1 #T2 #HL2 #L1 #HT1
elim (TC_idem … (S L1) … T1 T2)
elim (TC_idem … (S L2) … T1 T2)
(* NOTE: Normal form and strong normalization *******************************)
-lemma SN_to_NF: ∀A,R,S. NF_dec A R S →
- ∀a1. SN A R S a1 →
- ∃∃a2. star … R a1 a2 & NF A R S a2.
+lemma SN_to_NF (A) (R) (S):
+ NF_dec A R S →
+ ∀a1. SN A R S a1 →
+ ∃∃a2. star … R a1 a2 & NF A R S a2.
#A #R #S #HRS #a1 #H elim H -a1
#a1 #_ #IHa1 elim (HRS a1) -HRS /2 width=3 by srefl, ex2_intro/
* #a0 #Ha10 #Ha01 elim (IHa1 … Ha10 Ha01) -IHa1 -Ha01 /3 width=3 by star_compl, ex2_intro/
(* NOTE: Relations with unboxed pairs ***************************************)
-lemma bi_TC_strip: ∀A,B,R. bi_confluent A B R →
- ∀a0,a1,b0,b1. R a0 b0 a1 b1 → ∀a2,b2. bi_TC … R a0 b0 a2 b2 →
- ∃∃a,b. bi_TC … R a1 b1 a b & R a2 b2 a b.
+lemma bi_TC_strip (A) (B) (R):
+ bi_confluent A B R →
+ ∀a0,a1,b0,b1. R a0 b0 a1 b1 → ∀a2,b2. bi_TC … R a0 b0 a2 b2 →
+ ∃∃a,b. bi_TC … R a1 b1 a b & R a2 b2 a b.
#A #B #R #HR #a0 #a1 #b0 #b1 #H01 #a2 #b2 #H elim H -a2 -b2
[ #a2 #b2 #H02
elim (HR … H01 … H02) -HR -a0 -b0 /3 width=4 by ex2_2_intro, bi_inj/
]
qed.
-lemma bi_TC_confluent: ∀A,B,R. bi_confluent A B R →
- bi_confluent A B (bi_TC … R).
+lemma bi_TC_confluent (A) (B) (R):
+ bi_confluent A B R → bi_confluent A B (bi_TC … R).
#A #B #R #HR #a0 #a1 #b0 #b1 #H elim H -a1 -b1
[ #a1 #b1 #H01 #a2 #b2 #H02
elim (bi_TC_strip … HR … H01 … H02) -a0 -b0 /3 width=4 by ex2_2_intro, bi_inj/
]
qed.
-lemma bi_TC_decomp_r: ∀A,B. ∀R:bi_relation A B.
- ∀a1,a2,b1,b2. bi_TC … R a1 b1 a2 b2 →
- R a1 b1 a2 b2 ∨
- ∃∃a,b. bi_TC … R a1 b1 a b & R a b a2 b2.
+lemma bi_TC_decomp_r (A) (B) (R:bi_relation A B):
+ ∀a1,a2,b1,b2. bi_TC … R a1 b1 a2 b2 →
+ ∨∨ R a1 b1 a2 b2
+ | ∃∃a,b. bi_TC … R a1 b1 a b & R a b a2 b2.
#A #B #R #a1 #a2 #b1 #b2 * -a2 -b2 /2 width=1/ /3 width=4 by ex2_2_intro, or_intror/
qed-.
-lemma bi_TC_decomp_l: ∀A,B. ∀R:bi_relation A B.
- ∀a1,a2,b1,b2. bi_TC … R a1 b1 a2 b2 →
- R a1 b1 a2 b2 ∨
- ∃∃a,b. R a1 b1 a b & bi_TC … R a b a2 b2.
+lemma bi_TC_decomp_l (A) (B) (R:bi_relation A B):
+ ∀a1,a2,b1,b2. bi_TC … R a1 b1 a2 b2 →
+ ∨∨ R a1 b1 a2 b2
+ | ∃∃a,b. R a1 b1 a b & bi_TC … R a b a2 b2.
#A #B #R #a1 #a2 #b1 #b2 #H @(bi_TC_ind_dx … a1 b1 H) -a1 -b1
[ /2 width=1 by or_introl/
| #a1 #a #b1 #b #Hab1 #Hab2 #_ /3 width=4 by ex2_2_intro, or_intror/ (* * auto fails without #_ *)
(* NOTE: Relations with unboxed triples *************************************)
-definition tri_star: ∀A,B,C,R. tri_relation A B C ≝
- λA,B,C,R. tri_RC A B C (tri_TC … R).
+definition tri_star (A) (B) (C) (R):
+ tri_relation A B C ≝
+ tri_RC A B C (tri_TC … R).
-lemma tri_star_tri_reflexive: ∀A,B,C,R. tri_reflexive A B C (tri_star … R).
+lemma tri_star_tri_reflexive (A) (B) (C) (R):
+ tri_reflexive A B C (tri_star … R).
/2 width=1 by/ qed.
-lemma tri_TC_to_tri_star: ∀A,B,C,R,a1,b1,c1,a2,b2,c2.
- tri_TC A B C R a1 b1 c1 a2 b2 c2 →
- tri_star A B C R a1 b1 c1 a2 b2 c2.
+lemma tri_TC_to_tri_star (A) (B) (C) (R):
+ ∀a1,b1,c1,a2,b2,c2.
+ tri_TC A B C R a1 b1 c1 a2 b2 c2 → tri_star A B C R a1 b1 c1 a2 b2 c2.
/2 width=1 by or_introl/ qed.
-lemma tri_R_to_tri_star: ∀A,B,C,R,a1,b1,c1,a2,b2,c2.
- R a1 b1 c1 a2 b2 c2 → tri_star A B C R a1 b1 c1 a2 b2 c2.
+lemma tri_R_to_tri_star (A) (B) (C) (R):
+ ∀a1,b1,c1,a2,b2,c2.
+ R a1 b1 c1 a2 b2 c2 → tri_star A B C R a1 b1 c1 a2 b2 c2.
/3 width=1 by tri_TC_to_tri_star, tri_inj/ qed.
-lemma tri_star_strap1: ∀A,B,C,R,a1,a,a2,b1,b,b2,c1,c,c2.
- tri_star A B C R a1 b1 c1 a b c →
- R a b c a2 b2 c2 → tri_star A B C R a1 b1 c1 a2 b2 c2.
+lemma tri_star_strap1 (A) (B) (C) (R):
+ ∀a1,a,a2,b1,b,b2,c1,c,c2.
+ tri_star A B C R a1 b1 c1 a b c →
+ R a b c a2 b2 c2 → tri_star A B C R a1 b1 c1 a2 b2 c2.
#A #B #C #R #a1 #a #a2 #b1 #b #b2 #c1 #c #c2 *
[ /3 width=5 by tri_TC_to_tri_star, tri_step/
| * #H1 #H2 #H3 destruct /2 width=1 by tri_R_to_tri_star/
]
qed.
-lemma tri_star_strap2: ∀A,B,C,R,a1,a,a2,b1,b,b2,c1,c,c2. R a1 b1 c1 a b c →
- tri_star A B C R a b c a2 b2 c2 →
- tri_star A B C R a1 b1 c1 a2 b2 c2.
+lemma tri_star_strap2 (A) (B) (C) (R):
+ ∀a1,a,a2,b1,b,b2,c1,c,c2.
+ R a1 b1 c1 a b c → tri_star A B C R a b c a2 b2 c2 →
+ tri_star A B C R a1 b1 c1 a2 b2 c2.
#A #B #C #R #a1 #a #a2 #b1 #b #b2 #c1 #c #c2 #H *
[ /3 width=5 by tri_TC_to_tri_star, tri_TC_strap/
| * #H1 #H2 #H3 destruct /2 width=1 by tri_R_to_tri_star/
]
qed.
-lemma tri_star_to_tri_TC_to_tri_TC: ∀A,B,C,R,a1,a,a2,b1,b,b2,c1,c,c2.
- tri_star A B C R a1 b1 c1 a b c →
- tri_TC A B C R a b c a2 b2 c2 →
- tri_TC A B C R a1 b1 c1 a2 b2 c2.
+lemma tri_star_to_tri_TC_to_tri_TC (A) (B) (C) (R):
+ ∀a1,a,a2,b1,b,b2,c1,c,c2.
+ tri_star A B C R a1 b1 c1 a b c →
+ tri_TC A B C R a b c a2 b2 c2 → tri_TC A B C R a1 b1 c1 a2 b2 c2.
#A #B #C #R #a1 #a #a2 #b1 #b #b2 #c1 #c #c2 *
[ /2 width=5 by tri_TC_transitive/
| * #H1 #H2 #H3 destruct /2 width=1 by/
]
qed.
-lemma tri_TC_to_tri_star_to_tri_TC: ∀A,B,C,R,a1,a,a2,b1,b,b2,c1,c,c2.
- tri_TC A B C R a1 b1 c1 a b c →
- tri_star A B C R a b c a2 b2 c2 →
- tri_TC A B C R a1 b1 c1 a2 b2 c2.
+lemma tri_TC_to_tri_star_to_tri_TC (A) (B) (C) (R):
+ ∀a1,a,a2,b1,b,b2,c1,c,c2.
+ tri_TC A B C R a1 b1 c1 a b c →
+ tri_star A B C R a b c a2 b2 c2 → tri_TC A B C R a1 b1 c1 a2 b2 c2.
#A #B #C #R #a1 #a #a2 #b1 #b #b2 #c1 #c #c2 #H *
[ /2 width=5 by tri_TC_transitive/
| * #H1 #H2 #H3 destruct /2 width=1 by/
]
qed.
-lemma tri_tansitive_tri_star: ∀A,B,C,R. tri_transitive A B C (tri_star … R).
+lemma tri_tansitive_tri_star (A) (B) (C) (R):
+ tri_transitive A B C (tri_star … R).
#A #B #C #R #a1 #a #b1 #b #c1 #c #H #a2 #b2 #c2 *
[ /3 width=5 by tri_star_to_tri_TC_to_tri_TC, tri_TC_to_tri_star/
| * #H1 #H2 #H3 destruct /2 width=1 by/
]
qed.
-lemma tri_star_ind: ∀A,B,C,R,a1,b1,c1. ∀P:relation3 A B C. P a1 b1 c1 →
- (∀a,a2,b,b2,c,c2. tri_star … R a1 b1 c1 a b c → R a b c a2 b2 c2 → P a b c → P a2 b2 c2) →
- ∀a2,b2,c2. tri_star … R a1 b1 c1 a2 b2 c2 → P a2 b2 c2.
-#A #B #C #R #a1 #b1 #c1 #P #H #IH #a2 #b2 #c2 *
+lemma tri_star_ind (A) (B) (C) (R):
+ ∀a1,b1,c1. ∀Q:relation3 A B C. Q a1 b1 c1 →
+ (∀a,a2,b,b2,c,c2. tri_star … R a1 b1 c1 a b c → R a b c a2 b2 c2 → Q a b c → Q a2 b2 c2) →
+ ∀a2,b2,c2. tri_star … R a1 b1 c1 a2 b2 c2 → Q a2 b2 c2.
+#A #B #C #R #a1 #b1 #c1 #Q #H #IH #a2 #b2 #c2 *
[ #H12 elim H12 -a2 -b2 -c2 /3 width=6 by tri_TC_to_tri_star/
| * #H1 #H2 #H3 destruct //
]
qed-.
-lemma tri_star_ind_dx: ∀A,B,C,R,a2,b2,c2. ∀P:relation3 A B C. P a2 b2 c2 →
- (∀a1,a,b1,b,c1,c. R a1 b1 c1 a b c → tri_star … R a b c a2 b2 c2 → P a b c → P a1 b1 c1) →
- ∀a1,b1,c1. tri_star … R a1 b1 c1 a2 b2 c2 → P a1 b1 c1.
-#A #B #C #R #a2 #b2 #c2 #P #H #IH #a1 #b1 #c1 *
+lemma tri_star_ind_dx (A) (B) (C) (R):
+ ∀a2,b2,c2. ∀Q:relation3 A B C. Q a2 b2 c2 →
+ (∀a1,a,b1,b,c1,c. R a1 b1 c1 a b c → tri_star … R a b c a2 b2 c2 → Q a b c → Q a1 b1 c1) →
+ ∀a1,b1,c1. tri_star … R a1 b1 c1 a2 b2 c2 → Q a1 b1 c1.
+#A #B #C #R #a2 #b2 #c2 #Q #H #IH #a1 #b1 #c1 *
[ #H12 @(tri_TC_ind_dx … a1 b1 c1 H12) -a1 -b1 -c1 /3 width=6 by tri_TC_to_tri_star/
| * #H1 #H2 #H3 destruct //
]
(* Basic constructions ******************************************************)
-lemma stream_rew (A) (t:stream A): match t with [ stream_cons a u ⇒ a ⨮ u ] = t.
+(*** stream_rew *)
+lemma stream_unfold (A) (t:stream A):
+ match t with [ stream_cons a u ⇒ a ⨮ u ] = t.
#A * //
qed.
(* EXTENSIONAL EQUIVALENCE FOR STREAMS **************************************)
coinductive stream_eq (A): relation (stream A) ≝
-| stream_eq_cons: ∀t1,t2,b1,b2. b1 = b2 → stream_eq A t1 t2 → stream_eq A (b1⨮t1) (b2⨮t2)
+| stream_eq_cons (a1) (a2) (t1) (t2):
+ a1 = a2 → stream_eq A t1 t2 → stream_eq A (a1⨮t1) (a2⨮t2)
.
interpretation
definition stream_eq_repl_fwd (A) (R:predicate …) ≝
∀t1. R t1 → ∀t2. t2 ≗{A} t1 → R t2.
-(* Basic inversions *********************************************************)
-
-lemma stream_eq_inv_cons: ∀A,t1,t2. t1 ≗{A} t2 →
- ∀u1,u2,a1,a2. a1⨮u1 = t1 → a2⨮u2 = t2 →
- u1 ≗ u2 ∧ a1 = a2.
-#A #t1 #t2 * -t1 -t2
-#t1 #t2 #b1 #b2 #Hb #Ht #u1 #u2 #a1 #a2 #H1 #H2 destruct /2 width=1 by conj/
-qed-.
-
(* Basic constructions ******************************************************)
-corec lemma stream_eq_refl: ∀A. reflexive … (stream_eq A).
-#A * #b #t @stream_eq_cons //
+corec lemma stream_eq_refl (A:?):
+ reflexive … (stream_eq A).
+* #a #t @stream_eq_cons //
qed.
-corec lemma stream_eq_sym: ∀A. symmetric … (stream_eq A).
-#A #t1 #t2 * -t1 -t2
-#t1 #t2 #b1 #b2 #Hb #Ht @stream_eq_cons /2 width=1 by/
+corec lemma stream_eq_sym (A):
+ symmetric … (stream_eq A).
+#t1 #t2 * -t1 -t2
+#a1 #a2 #t1 #t2 #Ha #Ht
+@stream_eq_cons /2 width=1 by/
qed-.
-lemma stream_eq_repl_sym: ∀A,R. stream_eq_repl_back A R → stream_eq_repl_fwd A R.
+lemma stream_eq_repl_sym (A) (R):
+ stream_eq_repl_back A R → stream_eq_repl_fwd A R.
/3 width=3 by stream_eq_sym/ qed-.
-(* Main constructions *******************************************************)
+(* Basic inversions *********************************************************)
-corec theorem stream_eq_trans: ∀A. Transitive … (stream_eq A).
-#A #t1 #t * -t1 -t
-#t1 #t #b1 #b * #Ht1 * #b2 #t2 #H cases (stream_eq_inv_cons A … H) -H -b
-/3 width=7 by stream_eq_cons/
+lemma stream_eq_inv_cons_bi (A):
+ ∀t1,t2. t1 ≗{A} t2 →
+ ∀u1,u2,b1,b2. b1⨮u1 = t1 → b2⨮u2 = t2 →
+ ∧∧ b1 = b2 & u1 ≗ u2.
+#A #t1 #t2 * -t1 -t2
+#a1 #a2 #t1 #t2 #Ha #Ht #u1 #u2 #b1 #b2 #H1 #H2 destruct /2 width=1 by conj/
qed-.
-
-theorem stream_eq_canc_sn: ∀A,t,t1,t2. t ≗ t1 → t ≗ t2 → t1 ≗{A} t2.
-/3 width=3 by stream_eq_trans, stream_eq_sym/ qed-.
-
-theorem stream_eq_canc_dx: ∀A,t,t1,t2. t1 ≗ t → t2 ≗ t → t1 ≗{A} t2.
-/3 width=3 by stream_eq_trans, stream_eq_sym/ 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 "ground/lib/stream_eq.ma".
+
+(* EXTENSIONAL EQUIVALENCE FOR STREAMS **************************************)
+
+(* Main constructions *******************************************************)
+
+corec theorem stream_eq_trans (A):
+ Transitive … (stream_eq A).
+#t1 #t * -t1 -t
+#a1 #a #t1 #t * #Ht1 * #a2 #t2 #H
+cases (stream_eq_inv_cons_bi A … H) -H -a
+/3 width=7 by stream_eq_cons/
+qed-.
+
+theorem stream_eq_canc_sn (A):
+ ∀t,t1,t2. t ≗ t1 → t ≗ t2 → t1 ≗{A} t2.
+/3 width=3 by stream_eq_trans, stream_eq_sym/ qed-.
+
+theorem stream_eq_canc_dx (A):
+ ∀t,t1,t2. t1 ≗ t → t2 ≗ t → t1 ≗{A} t2.
+/3 width=3 by stream_eq_trans, stream_eq_sym/ qed-.
(**************************************************************************)
include "ground/notation/functions/downspoon_2.ma".
-include "ground/lib/stream_eq.ma".
+include "ground/lib/stream.ma".
(* HEAD AND TAIL FOR STREAMS ************************************************)
-definition stream_hd (A:Type[0]): stream A → A ≝
- λt. match t with [ stream_cons a _ ⇒ a ].
+definition stream_hd (A:Type[0]): stream A → A.
+#A * #a #_ @a
+defined.
-definition stream_tl (A:Type[0]): stream A → stream A ≝
- λt. match t with [ stream_cons _ t ⇒ t ].
+definition stream_tl (A:Type[0]): stream A → stream A.
+#A * #_ #t @t
+defined.
interpretation
"tail (streams)"
t = ⫰{A}(a⨮t).
// qed.
-lemma eq_stream_split_hd_tl (A) (t):
- stream_hd … t ⨮ ⫰t ≗{A} t.
+lemma stream_split_tl (A) (t):
+ stream_hd A t ⨮ ⫰t = t.
#A * //
qed.
lemma stream_tls_swap (A) (n) (t):
(⫰*[n]⫰t) = ⫰*{A}[↑n]t.
// qed.
-
-lemma stream_tls_eq_repl (A) (n):
- stream_eq_repl A (λt1,t2. ⫰*[n] t1 ≗ ⫰*[n] t2).
-#A #n @(nat_ind_succ … n) -n //
-#n #IH * #n1 #t1 * #n2 #t2 #H elim (stream_eq_inv_cons … H) /2 width=7 by/
-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 "ground/lib/stream_eq.ma".
+include "ground/lib/stream_tls.ma".
+
+(* ITERATED TAIL FOR STREAMS ************************************************)
+
+(* Properties with stream_eq *)
+
+lemma stream_tls_eq_repl (A) (n):
+ stream_eq_repl A (λt1,t2. ⫰*[n] t1 ≗ ⫰*[n] t2).
+#A #n @(nat_ind_succ … n) -n //
+#n #IH * #n1 #t1 * #n2 #t2 #H
+elim (stream_eq_inv_cons_bi … H) /2 width=7 by/
+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 *)
-(* *)
-(**************************************************************************)
-
-(* GROUND NOTATION **********************************************************)
-
-notation "hvbox( 𝐁❨ term 46 l, break term 46 h ❩ )"
- non associative with precedence 90
- for @{ 'Basic $l $h }.
(* GROUND NOTATION **********************************************************)
notation < "hvbox( Ⓔ )"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'CircledE $S }.
notation > "hvbox( Ⓔ )"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'CircledE ? }.
notation > "hvbox( Ⓔ{ term 46 C } )"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'CircledE $S }.
(* GROUND NOTATION **********************************************************)
notation "◊"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'Diamond }.
(* GROUND NOTATION **********************************************************)
-notation "hvbox( ↓ term 70 T )"
- non associative with precedence 70
+notation "hvbox( ↓ term 75 T )"
+ non associative with precedence 75
for @{ 'DownArrow $T }.
(* GROUND NOTATION **********************************************************)
-notation < "hvbox( ⫰ term 46 a )"
- non associative with precedence 46
+notation < "hvbox( ⫰ term 75 a )"
+ non associative with precedence 75
for @{ 'DownSpoon $S $a }.
-notation > "hvbox( ⫰ term 46 a )"
- non associative with precedence 46
+notation > "hvbox( ⫰ term 75 a )"
+ non associative with precedence 75
for @{ 'DownSpoon ? $a }.
-notation > "hvbox( ⫰{ term 46 S } break term 46 a )"
- non associative with precedence 46
+notation > "hvbox( ⫰{ term 46 S } break term 75 a )"
+ non associative with precedence 75
for @{ 'DownSpoon $S $a }.
(* GROUND NOTATION **********************************************************)
-notation < "hvbox( ⫰*[ break term 46 n ] break term 46 a )"
- non associative with precedence 46
+notation < "hvbox( ⫰*[ break term 46 n ] break term 75 a )"
+ non associative with precedence 75
for @{ 'DownSpoonStar $S $n $a }.
-notation > "hvbox( ⫰*[ break term 46 n ] break term 46 a )"
- non associative with precedence 46
+notation > "hvbox( ⫰*[ break term 46 n ] break term 75 a )"
+ non associative with precedence 75
for @{ 'DownSpoonStar ? $n $a }.
-notation > "hvbox( ⫰*{ term 46 S }[ break term 46 n ] break term 46 a )"
- non associative with precedence 46
+notation > "hvbox( ⫰*{ term 46 S }[ break term 46 n ] break term 75 a )"
+ non associative with precedence 75
for @{ 'DownSpoonStar $S $n $a }.
(* GROUND NOTATION **********************************************************)
-notation "hvbox( ⫱ term 46 T )"
- non associative with precedence 46
+notation "hvbox( ⫱ term 75 T )"
+ non associative with precedence 75
for @{ 'DropPred $T }.
(* GROUND NOTATION **********************************************************)
-notation "hvbox( ⫱ *[ term 46 n ] break term 46 T )"
- non associative with precedence 46
+notation "hvbox( ⫱ *[ term 46 n ] break term 75 T )"
+ non associative with precedence 75
for @{ 'DropPreds $n $T }.
--- /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 *)
+(* *)
+(**************************************************************************)
+
+(* GROUND NOTATION **********************************************************)
+
+notation "hvbox( 𝐛❨ term 46 d, break term 46 h ❩ )"
+ non associative with precedence 75
+ for @{ 'ElementB $d $h }.
--- /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 *)
+(* *)
+(**************************************************************************)
+
+(* GROUND NOTATION **********************************************************)
+
+notation "hvbox( 𝐢 )"
+ non associative with precedence 75
+ for @{ 'ElementI }.
--- /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 *)
+(* *)
+(**************************************************************************)
+
+(* GROUND NOTATION **********************************************************)
+
+notation "hvbox( 𝐮 ❨ break term 46 a ❩ )"
+ non associative with precedence 75
+ for @{ 'ElementU $a }.
(* GROUND NOTATION **********************************************************)
notation < "hvbox( f ^ break x )"
- left associative with precedence 75
+ left associative with precedence 65
for @{ 'Exp $X $f $x }.
notation > "hvbox( f ^ break x )"
- left associative with precedence 75
+ left associative with precedence 65
for @{ 'Exp ? $f $x }.
-notation > "hvbox( f ^{ break term 46 X } break term 75 x )"
- non associative with precedence 75
+notation > "hvbox( f ^{ break term 46 X } break term 65 x )"
+ non associative with precedence 65
for @{ 'Exp $X $f $x }.
+++ /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 *)
-(* *)
-(**************************************************************************)
-
-(* GROUND NOTATION **********************************************************)
-
-notation "hvbox( 𝐈𝐝 )"
- non associative with precedence 90
- for @{ 'Identity }.
(* GROUND NOTATION **********************************************************)
notation "∞"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'Infinity }.
-
(* GROUND NOTATION **********************************************************)
notation "Ⓕ"
- non associative with precedence 55
+ non associative with precedence 75
for @{'no}.
(* GROUND NOTATION **********************************************************)
notation "𝟏"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'One }.
(* GROUND NOTATION **********************************************************)
notation "𝟙𝟘"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'OneZero }.
(* GROUND NOTATION **********************************************************)
notation "hvbox( ❨ term 46 hd1, break term 46 hd2 ❩; break term 46 tl )"
- non associative with precedence 47
+ non associative with precedence 75
for @{ 'Semicolon $hd1 $hd2 $tl }.
(* GROUND NOTATION **********************************************************)
notation "hvbox ( 〈 term 46 x1, break term 46 x2 , break term 46 x3, break term 46 x4 〉 )"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'Tuple $x1 $x2 $x3 $x4 }.
(* GROUND NOTATION **********************************************************)
notation "𝟐"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'Two }.
+++ /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 *)
-(* *)
-(**************************************************************************)
-
-(* GROUND NOTATION **********************************************************)
-
-notation "hvbox( 𝐔 ❨ break term 46 a ❩ )"
- non associative with precedence 90
- for @{ 'Uniform $a }.
(* GROUND NOTATION **********************************************************)
-notation "hvbox( ↑ term 70 T )"
- non associative with precedence 70
+notation "hvbox( ↑ term 75 T )"
+ non associative with precedence 75
for @{ 'UpArrow $T }.
(* GROUND NOTATION **********************************************************)
-notation "hvbox( ↑*[ term 46 n ] break term 70 T )"
- non associative with precedence 70
+notation "hvbox( ↑*[ term 46 n ] break term 75 T )"
+ non associative with precedence 75
for @{ 'UpArrowStar $n $T }.
(* GROUND NOTATION **********************************************************)
-notation "hvbox( ↕* term 46 T )"
- non associative with precedence 46
+notation "hvbox( ↕* term 75 T )"
+ non associative with precedence 75
for @{ 'UpDownArrowStar $T }.
(* GROUND NOTATION **********************************************************)
-notation "hvbox( ⫯ term 46 T )"
- non associative with precedence 46
+notation "hvbox( ⫯ term 75 T )"
+ non associative with precedence 75
for @{ 'UpSpoon $T }.
(* GROUND NOTATION **********************************************************)
-notation "hvbox( ⫯*[ term 46 n ] break term 46 T )"
- non associative with precedence 46
+notation "hvbox( ⫯*[ term 46 n ] break term 75 T )"
+ non associative with precedence 75
for @{ 'UpSpoonStar $n $T }.
(* GROUND NOTATION **********************************************************)
notation "Ⓣ"
- non associative with precedence 55
+ non associative with precedence 75
for @{'yes}.
(* GROUND NOTATION **********************************************************)
notation "𝟎"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'Zero }.
(* GROUND NOTATION **********************************************************)
notation "𝟘𝟙"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'ZeroOne }.
(* GROUND NOTATION **********************************************************)
notation "𝟘𝟘"
- non associative with precedence 55
+ non associative with precedence 75
for @{ 'ZeroZero }.
+++ /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 *)
-(* *)
-(**************************************************************************)
-
-(* GROUND NOTATION **********************************************************)
-
-notation "hvbox( 𝛀❪ term 46 f ❫ )"
- non associative with precedence 45
- for @{ 'IsDivergent $f }.
+++ /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 *)
-(* *)
-(**************************************************************************)
-
-(* GROUND NOTATION **********************************************************)
-
-notation "hvbox( 𝐅❪ term 46 f ❫ )"
- non associative with precedence 45
- for @{ 'IsFinite $f }.
+++ /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 *)
-(* *)
-(**************************************************************************)
-
-(* GROUND NOTATION **********************************************************)
-
-notation "hvbox( 𝐈❪ term 46 f ❫ )"
- non associative with precedence 45
- for @{ 'IsIdentity $f }.
+++ /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 *)
-(* *)
-(**************************************************************************)
-
-(* GROUND NOTATION **********************************************************)
-
-notation "hvbox( 𝐌❪ term 46 n, break term 46 c ❫ )"
- non associative with precedence 45
- for @{ 'IsM $n $c }.
+++ /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 *)
-(* *)
-(**************************************************************************)
-
-(* GROUND NOTATION **********************************************************)
-
-notation "hvbox( 𝐓❪ term 46 f ❫ )"
- non associative with precedence 45
- for @{ 'IsT $f }.
+++ /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 *)
-(* *)
-(**************************************************************************)
-
-(* GROUND NOTATION **********************************************************)
-
-notation "hvbox( 𝐓❪ term 46 n, break term 46 c ❫ )"
- non associative with precedence 45
- for @{ 'IsT $n $c }.
+++ /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 *)
-(* *)
-(**************************************************************************)
-
-(* GROUND NOTATION **********************************************************)
-
-notation "hvbox( 𝐔❪ term 46 f ❫ )"
- non associative with precedence 45
- for @{ 'IsUniform $f }.
--- /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 *)
+(* *)
+(**************************************************************************)
+
+(* GROUND NOTATION **********************************************************)
+
+notation "hvbox( 𝐅❪ term 46 f ❫ )"
+ non associative with precedence 45
+ for @{ 'PredicateF $f }.
--- /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 *)
+(* *)
+(**************************************************************************)
+
+(* GROUND NOTATION **********************************************************)
+
+notation "hvbox( 𝐈❪ term 46 f ❫ )"
+ non associative with precedence 45
+ for @{ 'PredicateI $f }.
--- /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 *)
+(* *)
+(**************************************************************************)
+
+(* GROUND NOTATION **********************************************************)
+
+notation "hvbox( 𝐌❪ term 46 n, break term 46 c ❫ )"
+ non associative with precedence 45
+ for @{ 'PredicateM $n $c }.
--- /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 *)
+(* *)
+(**************************************************************************)
+
+(* GROUND NOTATION **********************************************************)
+
+notation "hvbox( 𝛀❪ term 46 f ❫ )"
+ non associative with precedence 45
+ for @{ 'PredicateOmega $f }.
--- /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 *)
+(* *)
+(**************************************************************************)
+
+(* GROUND NOTATION **********************************************************)
+
+notation "hvbox( 𝐓❪ term 46 f ❫ )"
+ non associative with precedence 45
+ for @{ 'PredicateT $f }.
--- /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 *)
+(* *)
+(**************************************************************************)
+
+(* GROUND NOTATION **********************************************************)
+
+notation "hvbox( 𝐓❪ term 46 n, break term 46 c ❫ )"
+ non associative with precedence 45
+ for @{ 'PredicateT $n $c }.
--- /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 *)
+(* *)
+(**************************************************************************)
+
+(* GROUND NOTATION **********************************************************)
+
+notation "hvbox( 𝐔❪ term 46 f ❫ )"
+ non associative with precedence 45
+ for @{ 'PredicateU $f }.
+++ /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 *)
-(* *)
-(**************************************************************************)
-
-(* GROUND NOTATION **********************************************************)
-
-notation "hvbox( 𝐂❪ term 46 f ❫ ≘ break term 46 n )"
- non associative with precedence 45
- for @{ 'RCoLength $f $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 *)
+(* *)
+(**************************************************************************)
+
+(* GROUND NOTATION **********************************************************)
+
+notation "hvbox( 𝐂❪ term 46 f ❫ ≘ break term 46 n )"
+ non associative with precedence 45
+ for @{ 'RFunC $f $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 "ground/notation/functions/append_2.ma".
+include "ground/relocation/fr2_map.ma".
+
+(* APPEND FOR FINITE RELOCATION MAPS WITH PAIRS *******************************************)
+
+(* Note: this is compose *)
+(*** fr2_append *)
+rec definition fr2_append f1 f2 on f1 ≝ match f1 with
+[ fr2_nil ⇒ f2
+| fr2_cons d h f1 ⇒ ❨d, h❩; fr2_append f1 f2
+].
+
+interpretation
+ "append (finite relocation maps with pairs)"
+ 'Append f1 f2 = (fr2_append f1 f2).
+
+(* Basic properties *********************************************************)
+
+(*** mr2_append_nil *)
+lemma fr2_append_nil (f2):
+ f2 = ◊ @@ f2.
+// qed.
+
+(*** mr2_append_cons *)
+lemma fr2_append_cons (d) (h) (f1) (f2):
+ ❨d, h❩; (f1 @@ f2) = (❨d, h❩; f1) @@ f2.
+// 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 "ground/notation/functions/diamond_0.ma".
+include "ground/notation/functions/semicolon_3.ma".
+include "ground/arith/nat.ma".
+
+(* FINITE RELOCATION MAPS WITH PAIRS ****************************************)
+
+(*** mr2 *)
+inductive fr2_map: Type[0] :=
+(*** nil2 *)
+ | fr2_nil : fr2_map
+(*** cons2 *)
+ | fr2_cons: nat → nat → fr2_map → fr2_map.
+
+interpretation
+ "nil (finite relocation maps with pairs)"
+ 'Diamond = (fr2_nil).
+
+interpretation
+ "cons (finite relocation maps with pairs)"
+ 'Semicolon d h f = (fr2_cons d h f).
--- /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 "ground/xoa/ex_3_1.ma".
+include "ground/notation/relations/rminus_3.ma".
+include "ground/arith/nat_plus.ma".
+include "ground/arith/nat_minus.ma".
+include "ground/arith/nat_lt.ma".
+include "ground/relocation/fr2_map.ma".
+
+(* RELATIONAL SUBTRACTION FOR FINITE RELOCATION MAPS WITH PAIRS *******************************************)
+
+(*** minuss *)
+inductive fr2_minus: nat → relation fr2_map ≝
+(*** minuss_nil *)
+| fr2_minus_nil (i):
+ fr2_minus i (◊) (◊)
+(*** minuss_lt *)
+| fr2_minus_lt (f1) (f2) (d) (h) (i):
+ i < d → fr2_minus i f1 f2 → fr2_minus i (❨d,h❩;f1) (❨d-i,h❩;f2)
+(*** minuss_ge *)
+| fr2_minus_ge (f1) (f2) (d) (h) (i):
+ d ≤ i → fr2_minus (h+i) f1 f2 → fr2_minus i (❨d,h❩;f1) f2
+.
+
+interpretation
+ "minus (finite relocation maps with pairs)"
+ 'RMinus f1 i f2 = (fr2_minus i f1 f2).
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** minuss_inv_nil1 *)
+lemma fr2_minus_inv_nil_sn (f2) (i):
+ ◊ ▭ i ≘ f2 → f2 = ◊.
+#f2 #i @(insert_eq_1 … (◊))
+#f1 * -f1 -f2 -i
+[ //
+| #f1 #f2 #d #h #i #_ #_ #H destruct
+| #f1 #f2 #d #h #i #_ #_ #H destruct
+]
+qed-.
+
+(*** minuss_inv_cons1 *)
+lemma fr2_minus_inv_cons_sn (f1) (f2) (d) (h) (i):
+ ❨d, h❩;f1 ▭ i ≘ f2 →
+ ∨∨ ∧∧ d ≤ i & f1 ▭ h+i ≘ f2
+ | ∃∃f. i < d & f1 ▭ i ≘ f & f2 = ❨d-i,h❩;f.
+#g1 #f2 #d #h #i @(insert_eq_1 … (❨d,h❩;g1))
+#f1 * -f1 -f2 -i
+[ #i #H destruct
+| #f1 #f #d1 #h1 #i1 #Hid1 #Hf #H destruct /3 width=3 by ex3_intro, or_intror/
+| #f1 #f #d1 #h1 #i1 #Hdi1 #Hf #H destruct /3 width=1 by or_introl, conj/
+]
+qed-.
+
+(*** minuss_inv_cons1_ge *)
+lemma fr2_minus_inv_cons_sn_ge (f1) (f2) (d) (h) (i):
+ ❨d, h❩;f1 ▭ i ≘ f2 → d ≤ i → f1 ▭ h+i ≘ f2.
+#f1 #f2 #d #h #i #H
+elim (fr2_minus_inv_cons_sn … H) -H * // #f #Hid #_ #_ #Hdi
+elim (nlt_ge_false … Hid Hdi)
+qed-.
+
+(*** minuss_inv_cons1_lt *)
+lemma fr2_minus_inv_cons_sn_lt (f1) (f2) (d) (h) (i):
+ ❨d, h❩;f1 ▭ i ≘ f2 → i < d →
+ ∃∃f. f1 ▭ i ≘ f & f2 = ❨d-i,h❩;f.
+#f1 #f2 #d #h #i #H elim (fr2_minus_inv_cons_sn … H) -H *
+[ #Hdi #_ #Hid elim (nlt_ge_false … Hid Hdi)
+| /2 width=3 by ex2_intro/
+]
+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 "ground/notation/relations/rat_3.ma".
+include "ground/arith/nat_plus.ma".
+include "ground/arith/nat_lt.ma".
+include "ground/relocation/fr2_map.ma".
+
+(* NON-NEGATIVE APPLICATION FOR FINITE RELOCATION MAPS WITH PAIRS *******************************************)
+
+(*** at *)
+inductive fr2_nat: fr2_map → relation nat ≝
+(*** at_nil *)
+| fr2_nat_nil (l):
+ fr2_nat (◊) l l
+(*** at_lt *)
+| fr2_nat_lt (f) (d) (h) (l1) (l2):
+ l1 < d → fr2_nat f l1 l2 → fr2_nat (❨d,h❩;f) l1 l2
+(*** at_ge *)
+| fr2_nat_ge (f) (d) (h) (l1) (l2):
+ d ≤ l1 → fr2_nat f (l1 + h) l2 → fr2_nat (❨d,h❩;f) l1 l2
+.
+
+interpretation
+ "non-negative relational application (finite relocation maps with pairs)"
+ 'RAt l1 f l2 = (fr2_nat f l1 l2).
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** at_inv_nil *)
+lemma fr2_nat_inv_nil (l1) (l2):
+ @❪l1, ◊❫ ≘ l2 → l1 = l2.
+#l1 #l2 @(insert_eq_1 … (◊))
+#f * -f -l1 -l2
+[ //
+| #f #d #h #l1 #l2 #_ #_ #H destruct
+| #f #d #h #l1 #l2 #_ #_ #H destruct
+]
+qed-.
+
+(*** at_inv_cons *)
+lemma fr2_nat_inv_cons (f) (d) (h) (l1) (l2):
+ @❪l1, ❨d,h❩;f❫ ≘ l2 →
+ ∨∨ ∧∧ l1 < d & @❪l1, f❫ ≘ l2
+ | ∧∧ d ≤ l1 & @❪l1+h, f❫ ≘ l2.
+#g #d #h #l1 #l2 @(insert_eq_1 … (❨d, h❩;g))
+#f * -f -l1 -l2
+[ #l #H destruct
+| #f1 #d1 #h1 #l1 #l2 #Hld1 #Hl12 #H destruct /3 width=1 by or_introl, conj/
+| #f1 #d1 #h1 #l1 #l2 #Hdl1 #Hl12 #H destruct /3 width=1 by or_intror, conj/
+]
+qed-.
+
+(*** at_inv_cons *)
+lemma fr2_nat_inv_cons_lt (f) (d) (h) (l1) (l2):
+ @❪l1, ❨d,h❩;f❫ ≘ l2 → l1 < d → @❪l1, f❫ ≘ l2.
+#f #d #h #l1 #h2 #H
+elim (fr2_nat_inv_cons … H) -H * // #Hdl1 #_ #Hl1d
+elim (nlt_ge_false … Hl1d Hdl1)
+qed-.
+
+(*** at_inv_cons *)
+lemma fr2_nat_inv_cons_ge (f) (d) (h) (l1) (l2):
+ @❪l1, ❨d,h❩;f❫ ≘ l2 → d ≤ l1 → @❪l1+h, f❫ ≘ l2.
+#f #d #h #l1 #h2 #H
+elim (fr2_nat_inv_cons … H) -H * // #Hl1d #_ #Hdl1
+elim (nlt_ge_false … Hl1d Hdl1)
+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 "ground/relocation/fr2_nat.ma".
+
+(* NON-NEGATIVE APPLICATION FOR FINITE RELOCATION MAPS WITH PAIRS *******************************************)
+
+(* Main properties **********************************************************)
+
+(*** at_mono *)
+theorem fr2_nat_mono (f) (l):
+ ∀l1. @❪l, f❫ ≘ l1 → ∀l2. @❪l, f❫ ≘ l2 → l1 = l2.
+#f #l #l1 #H elim H -f -l -l1
+[ #l #x #H <(fr2_nat_inv_nil … H) -x //
+| #f #d #h #l #l1 #Hld #_ #IH #x #H
+ lapply (fr2_nat_inv_cons_lt … H Hld) -H -Hld /2 width=1 by/
+| #f #d #h #l #l1 #Hdl #_ #IH #x #H
+ lapply (fr2_nat_inv_cons_ge … H Hdl) -H -Hdl /2 width=1 by/
+]
+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 "ground/arith/nat_minus_plus.ma".
+include "ground/relocation/fr2_map.ma".
+
+(* ADDITION FOR FINITE RELOCATION MAPS WITH PAIRS ******************************)
+
+(* Note: this is pushs *)
+(*** pluss *)
+rec definition fr2_plus (f:fr2_map) (n:nat) on f ≝ match f with
+[ fr2_nil ⇒ ◊
+| fr2_cons d h f ⇒ ❨d+n,h❩;fr2_plus f n
+].
+
+interpretation
+ "plus (finite relocation maps with pairs)"
+ 'plus f n = (fr2_plus f n).
+
+(* Basic properties *********************************************************)
+
+(*** pluss_SO2 *)
+lemma fr2_plus_cons_unit (d) (h) (f):
+ ((❨d,h❩;f)+𝟏) = ❨↑d,h❩;f+𝟏.
+normalize // qed.
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** pluss_inv_nil2 *)
+lemma fr2_plus_inv_nil_dx (n) (f):
+ f+n = ◊ → f = ◊.
+#n * // normalize
+#d #h #f #H destruct
+qed.
+
+(*** pluss_inv_cons2 *)
+lemma fr2_plus_inv_cons_dx (n) (d) (h) (f2) (f):
+ f + n = ❨d,h❩;f2 →
+ ∃∃f1. f1+n = f2 & f = ❨d-n,h❩;f1.
+#n #d #h #f2 *
+[ normalize #H destruct
+| #d1 #h1 #f1 whd in ⊢ (??%?→?); #H destruct
+ <nminus_plus_sn_refl_sn /2 width=3 by ex2_intro/
+]
+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 "ground/notation/relations/rafter_3.ma".
+include "ground/xoa/ex_3_2.ma".
+include "ground/relocation/gr_tl.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** after *)
+coinductive gr_after: relation3 gr_map gr_map gr_map ≝
+(*** after_refl *)
+| gr_after_refl (f1) (f2) (f) (g1) (g2) (g):
+ gr_after f1 f2 f → ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → gr_after g1 g2 g
+(*** after_push *)
+| gr_after_push (f1) (f2) (f) (g1) (g2) (g):
+ gr_after f1 f2 f → ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → gr_after g1 g2 g
+(*** after_next *)
+| gr_after_next (f1) (f2) (f) (g1) (g):
+ gr_after f1 f2 f → ↑f1 = g1 → ↑f = g → gr_after g1 f2 g
+.
+
+interpretation
+ "relational composition (generic relocation maps)"
+ 'RAfter f1 f2 f = (gr_after f1 f2 f).
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** after_inv_ppx *)
+lemma gr_after_inv_push_bi:
+ ∀g1,g2,g. g1 ⊚ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 →
+ ∃∃f. f1 ⊚ f2 ≘ f & ⫯f = g.
+#g1 #g2 #g * -g1 -g2 -g #f1 #f2 #f #g1
+[ #g2 #g #Hf #H1 #H2 #H #x1 #x2 #Hx1 #Hx2 destruct
+ >(eq_inv_gr_push_bi … Hx1) >(eq_inv_gr_push_bi … Hx2) -x2 -x1
+ /2 width=3 by ex2_intro/
+| #g2 #g #_ #_ #H2 #_ #x1 #x2 #_ #Hx2 destruct
+ elim (eq_inv_gr_push_next … Hx2)
+| #g #_ #H1 #_ #x1 #x2 #Hx1 #_ destruct
+ elim (eq_inv_gr_push_next … Hx1)
+]
+qed-.
+
+(*** after_inv_pnx *)
+lemma gr_after_inv_push_next:
+ ∀g1,g2,g. g1 ⊚ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 →
+ ∃∃f. f1 ⊚ f2 ≘ f & ↑f = g.
+#g1 #g2 #g * -g1 -g2 -g #f1 #f2 #f #g1
+[ #g2 #g #_ #_ #H2 #_ #x1 #x2 #_ #Hx2 destruct
+ elim (eq_inv_gr_next_push … Hx2)
+| #g2 #g #Hf #H1 #H2 #H3 #x1 #x2 #Hx1 #Hx2 destruct
+ >(eq_inv_gr_push_bi … Hx1) >(eq_inv_gr_next_bi … Hx2) -x2 -x1
+ /2 width=3 by ex2_intro/
+| #g #_ #H1 #_ #x1 #x2 #Hx1 #_ destruct
+ elim (eq_inv_gr_push_next … Hx1)
+]
+qed-.
+
+(*** after_inv_nxx *)
+lemma gr_after_inv_next_sn:
+ ∀g1,f2,g. g1 ⊚ f2 ≘ g → ∀f1. ↑f1 = g1 →
+ ∃∃f. f1 ⊚ f2 ≘ f & ↑f = g.
+#g1 #f2 #g * -g1 -f2 -g #f1 #f2 #f #g1
+[ #g2 #g #_ #H1 #_ #_ #x1 #Hx1 destruct
+ elim (eq_inv_gr_next_push … Hx1)
+| #g2 #g #_ #H1 #_ #_ #x1 #Hx1 destruct
+ elim (eq_inv_gr_next_push … Hx1)
+| #g #Hf #H1 #H #x1 #Hx1 destruct
+ >(eq_inv_gr_next_bi … Hx1) -x1
+ /2 width=3 by ex2_intro/
+]
+qed-.
+
+(* Advanced inversion lemmas ************************************************)
+
+(*** after_inv_ppp *)
+lemma gr_after_inv_push_bi_push:
+ ∀g1,g2,g. g1 ⊚ g2 ≘ g →
+ ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → f1 ⊚ f2 ≘ f.
+#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H elim (gr_after_inv_push_bi … Hg … H1 H2) -g1 -g2
+#x #Hf #Hx destruct <(eq_inv_gr_push_bi … Hx) -f //
+qed-.
+
+(*** after_inv_ppn *)
+lemma gr_after_inv_push_bi_next:
+ ∀g1,g2,g. g1 ⊚ g2 ≘ g →
+ ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ↑f = g → ⊥.
+#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H elim (gr_after_inv_push_bi … Hg … H1 H2) -g1 -g2
+#x #Hf #Hx destruct elim (eq_inv_gr_push_next … Hx)
+qed-.
+
+(*** after_inv_pnn *)
+lemma gr_after_inv_push_next_next:
+ ∀g1,g2,g. g1 ⊚ g2 ≘ g →
+ ∀f1,f2,f. ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → f1 ⊚ f2 ≘ f.
+#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H elim (gr_after_inv_push_next … Hg … H1 H2) -g1 -g2
+#x #Hf #Hx destruct <(eq_inv_gr_next_bi … Hx) -f //
+qed-.
+
+(*** after_inv_pnp *)
+lemma gr_after_inv_push_next_push:
+ ∀g1,g2,g. g1 ⊚ g2 ≘ g →
+ ∀f1,f2,f. ⫯f1 = g1 → ↑f2 = g2 → ⫯f = g → ⊥.
+#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H elim (gr_after_inv_push_next … Hg … H1 H2) -g1 -g2
+#x #Hf #Hx destruct elim (eq_inv_gr_next_push … Hx)
+qed-.
+
+(*** after_inv_nxn *)
+lemma gr_after_inv_next_sn_next:
+ ∀g1,f2,g. g1 ⊚ f2 ≘ g →
+ ∀f1,f. ↑f1 = g1 → ↑f = g → f1 ⊚ f2 ≘ f.
+#g1 #f2 #g #Hg #f1 #f #H1 #H elim (gr_after_inv_next_sn … Hg … H1) -g1
+#x #Hf #Hx destruct <(eq_inv_gr_next_bi … Hx) -f //
+qed-.
+
+(*** after_inv_nxp *)
+lemma gr_after_inv_next_sn_push:
+ ∀g1,f2,g. g1 ⊚ f2 ≘ g →
+ ∀f1,f. ↑f1 = g1 → ⫯f = g → ⊥.
+#g1 #f2 #g #Hg #f1 #f #H1 #H elim (gr_after_inv_next_sn … Hg … H1) -g1
+#x #Hf #Hx destruct elim (eq_inv_gr_next_push … Hx)
+qed-.
+
+(*** after_inv_pxp *)
+lemma gr_after_inv_push_sn_push:
+ ∀g1,g2,g. g1 ⊚ g2 ≘ g →
+ ∀f1,f. ⫯f1 = g1 → ⫯f = g →
+ ∃∃f2. f1 ⊚ f2 ≘ f & ⫯f2 = g2.
+#g1 #g2 elim (gr_map_split_tl g2)
+#Hg2 #g #Hg #f1 #f #H1 #H
+[ lapply (gr_after_inv_push_bi_push … Hg … H1 … H) -g1 -g
+ /2 width=3 by ex2_intro/
+| elim (gr_after_inv_push_next_push … Hg … H1 … H) -g1 -g -f1 -f //
+]
+qed-.
+
+(*** after_inv_pxn *)
+lemma gr_after_inv_push_sn_next:
+ ∀g1,g2,g. g1 ⊚ g2 ≘ g →
+ ∀f1,f. ⫯f1 = g1 → ↑f = g →
+ ∃∃f2. f1 ⊚ f2 ≘ f & ↑f2 = g2.
+#g1 #g2 elim (gr_map_split_tl g2)
+#Hg2 #g #Hg #f1 #f #H1 #H
+[ elim (gr_after_inv_push_bi_next … Hg … H1 … H) -g1 -g -f1 -f //
+| lapply (gr_after_inv_push_next_next … Hg … H1 … H) -g1 -g
+ /2 width=3 by ex2_intro/
+]
+qed-.
+
+(*** after_inv_xxp *)
+lemma gr_after_inv_push:
+ ∀g1,g2,g. g1 ⊚ g2 ≘ g → ∀f. ⫯f = g →
+ ∃∃f1,f2. f1 ⊚ f2 ≘ f & ⫯f1 = g1 & ⫯f2 = g2.
+#g1 elim (gr_map_split_tl g1)
+#Hg1 #g2 #g #Hg #f #H
+[ elim (gr_after_inv_push_sn_push … Hg … H) -g /2 width=5 by ex3_2_intro/
+| elim (gr_after_inv_next_sn_push … Hg … H) -g2 -g -f //
+]
+qed-.
+
+(*** after_inv_xxn *)
+lemma gr_after_inv_next:
+ ∀g1,g2,g. g1 ⊚ g2 ≘ g → ∀f. ↑f = g →
+ ∨∨ ∃∃f1,f2. f1 ⊚ f2 ≘ f & ⫯f1 = g1 & ↑f2 = g2
+ | ∃∃f1. f1 ⊚ g2 ≘ f & ↑f1 = g1.
+#g1 elim (gr_map_split_tl g1)
+#Hg1 #g2 #g #Hg #f #H
+[ elim (gr_after_inv_push_sn_next … Hg … H) -g
+ /3 width=5 by or_introl, ex3_2_intro/
+| /4 width=5 by gr_after_inv_next_sn_next, or_intror, ex2_intro/
+]
+qed-.
+
+(*** after_inv_pxx *)
+lemma gr_after_inv_push_sn:
+ ∀g1,g2,g. g1 ⊚ g2 ≘ g → ∀f1. ⫯f1 = g1 →
+ ∨∨ ∃∃f2,f. f1 ⊚ f2 ≘ f & ⫯f2 = g2 & ⫯f = g
+ | ∃∃f2,f. f1 ⊚ f2 ≘ f & ↑f2 = g2 & ↑f = g.
+#g1 #g2 elim (gr_map_split_tl g2)
+#Hg2 #g #Hg #f1 #H
+[ elim (gr_after_inv_push_bi … Hg … H) -g1
+ /3 width=5 by or_introl, ex3_2_intro/
+| elim (gr_after_inv_push_next … Hg … H) -g1
+ /3 width=5 by or_intror, ex3_2_intro/
+]
+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 "ground/relocation/gr_after_eq.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Main properties **********************************************************)
+
+(*** after_trans1 *)
+corec theorem gr_after_trans_sn:
+ ∀f0,f3,f4. f0 ⊚ f3 ≘ f4 →
+ ∀f1,f2. f1 ⊚ f2 ≘ f0 →
+ ∀f. f2 ⊚ f3 ≘ f → f1 ⊚ f ≘ f4.
+#f0 #f3 #f4 * -f0 -f3 -f4 #f0 #f3 #f4 #g0 [1,2: #g3 ] #g4
+[ #Hf4 #H0 #H3 #H4 #g1 #g2 #Hg0 #g #Hg
+ cases (gr_after_inv_push … Hg0 … H0) -g0
+ #f1 #f2 #Hf0 #H1 #H2
+ cases (gr_after_inv_push_bi … Hg … H2 H3) -g2 -g3
+ #f #Hf #H /3 width=7 by gr_after_refl/
+| #Hf4 #H0 #H3 #H4 #g1 #g2 #Hg0 #g #Hg
+ cases (gr_after_inv_push … Hg0 … H0) -g0
+ #f1 #f2 #Hf0 #H1 #H2
+ cases (gr_after_inv_push_next … Hg … H2 H3) -g2 -g3
+ #f #Hf #H /3 width=7 by gr_after_push/
+| #Hf4 #H0 #H4 #g1 #g2 #Hg0 #g #Hg
+ cases (gr_after_inv_next … Hg0 … H0) -g0 *
+ [ #f1 #f2 #Hf0 #H1 #H2
+ cases (gr_after_inv_next_sn … Hg … H2) -g2
+ #f #Hf #H /3 width=7 by gr_after_push/
+ | #f1 #Hf0 #H1 /3 width=6 by gr_after_next/
+ ]
+]
+qed-.
+
+(*** after_trans2 *)
+corec theorem gr_after_trans_dx:
+ ∀f1,f0,f4. f1 ⊚ f0 ≘ f4 →
+ ∀f2, f3. f2 ⊚ f3 ≘ f0 →
+ ∀f. f1 ⊚ f2 ≘ f → f ⊚ f3 ≘ f4.
+#f1 #f0 #f4 * -f1 -f0 -f4 #f1 #f0 #f4 #g1 [1,2: #g0 ] #g4
+[ #Hf4 #H1 #H0 #H4 #g2 #g3 #Hg0 #g #Hg
+ cases (gr_after_inv_push … Hg0 … H0) -g0
+ #f2 #f3 #Hf0 #H2 #H3
+ cases (gr_after_inv_push_bi … Hg … H1 H2) -g1 -g2
+ #f #Hf #H /3 width=7 by gr_after_refl/
+| #Hf4 #H1 #H0 #H4 #g2 #g3 #Hg0 #g #Hg
+ cases (gr_after_inv_next … Hg0 … H0) -g0 *
+ [ #f2 #f3 #Hf0 #H2 #H3
+ cases (gr_after_inv_push_bi … Hg … H1 H2) -g1 -g2
+ #f #Hf #H /3 width=7 by gr_after_push/
+ | #f2 #Hf0 #H2
+ cases (gr_after_inv_push_next … Hg … H1 H2) -g1 -g2
+ #f #Hf #H /3 width=6 by gr_after_next/
+ ]
+| #Hf4 #H1 #H4 #f2 #f3 #Hf0 #g #Hg
+ cases (gr_after_inv_next_sn … Hg … H1) -g1
+ #f #Hg #H /3 width=6 by gr_after_next/
+]
+qed-.
+
+(* Main inversion lemmas ****************************************************)
+
+(*** after_mono *)
+corec theorem gr_after_mono:
+ ∀f1,f2,x,y. f1 ⊚ f2 ≘ x → f1 ⊚ f2 ≘ y → x ≡ y.
+#f1 #f2 #x #y * -f1 -f2 -x
+#f1 #f2 #x #g1 [1,2: #g2 ] #g #Hx #H1 [1,2: #H2 ] #H0x #Hy
+[ cases (gr_after_inv_push_bi … Hy … H1 H2) -g1 -g2 /3 width=8 by gr_eq_push/
+| cases (gr_after_inv_push_next … Hy … H1 H2) -g1 -g2 /3 width=8 by gr_eq_next/
+| cases (gr_after_inv_next_sn … Hy … H1) -g1 /3 width=8 by gr_eq_next/
+]
+qed-.
+
+(*** after_mono_eq *)
+lemma gr_after_mono_eq:
+ ∀f1,f2,f. f1 ⊚ f2 ≘ f → ∀g1,g2,g. g1 ⊚ g2 ≘ g →
+ f1 ≡ g1 → f2 ≡ g2 → f ≡ g.
+/4 width=4 by gr_after_mono, gr_after_eq_repl_back_dx, gr_after_eq_repl_back_sn/ 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 "ground/arith/nat_pred_succ.ma".
+include "ground/relocation/gr_pat_tls.ma".
+include "ground/relocation/gr_ist_tls.ma".
+include "ground/relocation/gr_after_pat_tls.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** H_after_inj *)
+definition H_gr_after_inj: predicate gr_map ≝
+ λf1. 𝐓❪f1❫ →
+ ∀f,f21,f22. f1 ⊚ f21 ≘ f → f1 ⊚ f22 ≘ f → f21 ≡ f22.
+
+(* Main forward lemmas on istot **************************************************)
+
+(*** after_inj_O_aux *)
+corec fact gr_after_inj_unit_aux:
+ ∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_gr_after_inj f1.
+#f1 #H1f1 #H2f1 #f #f21 #f22 #H1f #H2f
+cases (gr_pat_inv_unit_bi … H1f1) -H1f1 [|*: // ] #g1 #H1
+lapply (gr_ist_inv_push … H2f1 … H1) -H2f1 #H2g1
+cases (H2g1 (𝟏)) #p #Hp
+cases (gr_after_inv_push_sn … H1f … H1) -H1f * #g21 #g #H1g #H21 #H
+[ cases (gr_after_inv_push_sn_push … H2f … H1 H) -f1 -f #g22 #H2g #H22
+ @(gr_eq_push … H21 H22) -f21 -f22
+| cases (gr_after_inv_push_sn_next … H2f … H1 H) -f1 -f #g22 #H2g #H22
+ @(gr_eq_next … H21 H22) -f21 -f22
+]
+@(gr_after_inj_unit_aux (⫱*[↓p]g1) … (⫱*[↓p]g)) -gr_after_inj_unit_aux
+/2 width=1 by gr_after_tls_sn_tls, gr_ist_tls, gr_pat_unit_succ_tls/
+qed-.
+
+(*** after_inj_aux *)
+fact gr_after_inj_aux:
+ (∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_gr_after_inj f1) →
+ ∀i2,f1. @❪𝟏, f1❫ ≘ i2 → H_gr_after_inj f1.
+#H0 #i2 elim i2 -i2 /2 width=1 by/ -H0
+#i2 #IH #f1 #H1f1 #H2f1 #f #f21 #f22 #H1f #H2f
+elim (gr_pat_inv_unit_succ … H1f1) -H1f1 [|*: // ] #g1 #H1g1 #H1
+elim (gr_after_inv_next_sn … H1f … H1) -H1f #g #H1g #H
+lapply (gr_after_inv_next_sn_next … H2f … H1 H) -f #H2g
+/3 width=6 by gr_ist_inv_next/
+qed-.
+
+(*** after_inj *)
+theorem gr_after_inj:
+ ∀f1. H_gr_after_inj f1.
+#f1 #H cases (H (𝟏))
+/3 width=7 by gr_after_inj_aux, gr_after_inj_unit_aux/
+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 "ground/arith/nat_le_pred.ma".
+include "ground/relocation/gr_basic.ma".
+include "ground/relocation/gr_after_uni.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_basic **********************************************)
+
+(*** after_basic_rc *)
+lemma after_basic_rc (d2) (d1):
+ d1 ≤ d2 → ∀h2,h1.d2 ≤ h1+d1 → 𝐛❨d2,h2❩ ⊚ 𝐛❨d1,h1❩ ≘ 𝐛❨d1,h1+h2❩.
+#d2 #d1 @(nat_ind_2_succ … d2 d1) -d2 -d1
+[ #d1 #H #h2 #h1 #_
+ <(nle_inv_zero_dx … H) -d1 //
+| #d2 #IH #_ #h2 #h1 <nplus_zero_dx #H
+ elim (nle_inv_succ_sn … H) -H #Hd2 #Hh1
+ >Hh1 -Hh1 <nplus_succ_sn
+ /3 width=7 by gr_after_push/
+| #d2 #d1 #IH #H1 #h2 #h1 <nplus_succ_dx #H2
+ lapply (nle_inv_succ_bi … H1) -H1 #H1
+ lapply (nle_inv_succ_bi … H2) -H2 #H2
+ /3 width=7 by gr_after_refl/
+]
+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 "ground/relocation/gr_tl_eq.ma".
+include "ground/relocation/gr_after.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *)
+
+(*** after_eq_repl_back2 *)
+corec lemma gr_after_eq_repl_back_sn:
+ ∀f1,f. gr_eq_repl_back (λf2. f2 ⊚ f1 ≘ f).
+#f1 #f #f2 * -f2 -f1 -f
+#f21 #f1 #f #g21 [1,2: #g1 ] #g #Hf #H21 [1,2: #H1 ] #H #g22 #H0
+[ cases (gr_eq_inv_push_sn … H0 … H21) -g21 /3 width=7 by gr_after_refl/
+| cases (gr_eq_inv_push_sn … H0 … H21) -g21 /3 width=7 by gr_after_push/
+| cases (gr_eq_inv_next_sn … H0 … H21) -g21 /3 width=5 by gr_after_next/
+]
+qed-.
+
+(*** after_eq_repl_fwd2 *)
+lemma gr_after_eq_repl_fwd_sn:
+ ∀f1,f. gr_eq_repl_fwd (λf2. f2 ⊚ f1 ≘ f).
+#f1 #f @gr_eq_repl_sym /2 width=3 by gr_after_eq_repl_back_sn/
+qed-.
+
+(*** after_eq_repl_back1 *)
+corec lemma gr_after_eq_repl_back_dx:
+ ∀f2,f. gr_eq_repl_back (λf1. f2 ⊚ f1 ≘ f).
+#f2 #f #f1 * -f2 -f1 -f
+#f2 #f11 #f #g2 [1,2: #g11 ] #g #Hf #H2 [1,2: #H11 ] #H #g2 #H0
+[ cases (gr_eq_inv_push_sn … H0 … H11) -g11 /3 width=7 by gr_after_refl/
+| cases (gr_eq_inv_next_sn … H0 … H11) -g11 /3 width=7 by gr_after_push/
+| @(gr_after_next … H2 H) /2 width=5 by/
+]
+qed-.
+
+(*** after_eq_repl_fwd1 *)
+lemma gr_after_eq_repl_fwd_dx:
+ ∀f2,f. gr_eq_repl_fwd (λf1. f2 ⊚ f1 ≘ f).
+#f2 #f @gr_eq_repl_sym /2 width=3 by gr_after_eq_repl_back_dx/
+qed-.
+
+(*** after_eq_repl_back0 *)
+corec lemma gr_after_eq_repl_back:
+ ∀f1,f2. gr_eq_repl_back (λf. f2 ⊚ f1 ≘ f).
+#f2 #f1 #f * -f2 -f1 -f
+#f2 #f1 #f01 #g2 [1,2: #g1 ] #g01 #Hf01 #H2 [1,2: #H1 ] #H01 #g02 #H0
+[ cases (gr_eq_inv_push_sn … H0 … H01) -g01 /3 width=7 by gr_after_refl/
+| cases (gr_eq_inv_next_sn … H0 … H01) -g01 /3 width=7 by gr_after_push/
+| cases (gr_eq_inv_next_sn … H0 … H01) -g01 /3 width=5 by gr_after_next/
+]
+qed-.
+
+(*** after_eq_repl_fwd0 *)
+lemma gr_after_eq_repl_fwd:
+ ∀f2,f1. gr_eq_repl_fwd (λf. f2 ⊚ f1 ≘ f).
+#f2 #f1 @gr_eq_repl_sym /2 width=3 by gr_after_eq_repl_back/
+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 "ground/relocation/gr_isi.ma".
+include "ground/relocation/gr_after_after.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties on isid *******************************************************)
+
+(*** after_isid_sn *)
+corec lemma gr_after_isi_sn:
+ ∀f1. 𝐈❪f1❫ → ∀f2. f1 ⊚ f2 ≘ f2.
+#f1 * -f1
+#f1 #g1 #Hf1 #H1 #f2 cases (gr_map_split_tl f2) #H2
+/3 width=7 by gr_after_push, gr_after_refl/
+qed.
+
+(*** after_isid_dx *)
+corec lemma gr_after_isi_dx:
+ ∀f2. 𝐈❪f2❫ → ∀f1. f1 ⊚ f2 ≘ f1.
+#f2 * -f2
+#f2 #g2 #Hf2 #H2 #f1 cases (gr_map_split_tl f1) #H1
+[ /3 width=7 by gr_after_refl/
+| @(gr_after_next … H1 H1) /3 width=3 by gr_isi_push/
+]
+qed.
+
+(* Destructions on isid *************************************************)
+
+(*** after_isid_inv_sn *)
+lemma gr_after_isi_inv_sn:
+ ∀f1,f2,f. f1 ⊚ f2 ≘ f → 𝐈❪f1❫ → f2 ≡ f.
+/3 width=6 by gr_after_isi_sn, gr_after_mono/ qed-.
+
+(*** after_isid_inv_dx *)
+lemma gr_after_isi_inv_dx:
+ ∀f1,f2,f. f1 ⊚ f2 ≘ f → 𝐈❪f2❫ → f1 ≡ f.
+/3 width=6 by gr_after_isi_dx, gr_after_mono/ qed-.
+
+(*** after_fwd_isid1 *)
+corec lemma gr_after_des_isi_sn:
+ ∀f1,f2,f. f1 ⊚ f2 ≘ f → 𝐈❪f❫ → 𝐈❪f1❫.
+#f1 #f2 #f * -f1 -f2 -f
+#f1 #f2 #f #g1 [1,2: #g2 ] #g #Hf #H1 [1,2: #H2 ] #H0 #H
+[ /4 width=6 by gr_isi_inv_push, gr_isi_push/ ]
+cases (gr_isi_inv_next … H … H0)
+qed-.
+
+(*** after_fwd_isid2 *)
+corec lemma gr_after_des_isi_dx:
+ ∀f1,f2,f. f1 ⊚ f2 ≘ f → 𝐈❪f❫ → 𝐈❪f2❫.
+#f1 #f2 #f * -f1 -f2 -f
+#f1 #f2 #f #g1 [1,2: #g2 ] #g #Hf #H1 [1,2: #H2 ] #H0 #H
+[ /4 width=6 by gr_isi_inv_push, gr_isi_push/ ]
+cases (gr_isi_inv_next … H … H0)
+qed-.
+
+(*** after_inv_isid3 *)
+lemma gr_after_inv_isi:
+ ∀f1,f2,f. f1 ⊚ f2 ≘ f → 𝐈❪f❫ → 𝐈❪f1❫ ∧ 𝐈❪f2❫.
+/3 width=4 by gr_after_des_isi_dx, gr_after_des_isi_sn, conj/ 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 "ground/relocation/gr_pat_lt.ma".
+include "ground/relocation/gr_ist.ma".
+include "ground/relocation/gr_after_pat.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Forward lemmas on istot **************************************************)
+
+(*** after_istot_fwd *)
+lemma gr_after_ist_des:
+ ∀f2,f1,f. f2 ⊚ f1 ≘ f → 𝐓❪f2❫ → 𝐓❪f1❫ → 𝐓❪f❫.
+#f2 #f1 #f #Hf #Hf2 #Hf1 #i1 elim (Hf1 i1) -Hf1
+#i2 #Hf1 elim (Hf2 i2) -Hf2
+/3 width=7 by gr_after_des_pat, ex_intro/
+qed-.
+
+(*** after_fwd_istot_dx *)
+lemma gr_after_des_ist_dx:
+ ∀f2,f1,f. f2 ⊚ f1 ≘ f → 𝐓❪f❫ → 𝐓❪f1❫.
+#f2 #f1 #f #H #Hf #i1 elim (Hf i1) -Hf
+#i2 #Hf elim (gr_after_pat_des … Hf … H) -f /2 width=2 by ex_intro/
+qed-.
+
+(*** after_fwd_istot_sn *)
+lemma gr_after_des_ist_sn:
+ ∀f2,f1,f. f2 ⊚ f1 ≘ f → 𝐓❪f❫ → 𝐓❪f2❫.
+#f2 #f1 #f #H #Hf #i1 elim (Hf i1) -Hf
+#i #Hf elim (gr_after_pat_des … Hf … H) -f
+#i2 #Hf1 #Hf2 lapply (gr_pat_increasing … Hf1) -f1
+#Hi12 elim (gr_pat_le_ex … Hf2 … Hi12) -i2 /2 width=2 by ex_intro/
+qed-.
+
+(*** after_at1_fwd *)
+lemma gr_after_pat_sn_des:
+ ∀f1,i1,i2. @❪i1, f1❫ ≘ i2 → ∀f2. 𝐓❪f2❫ → ∀f. f2 ⊚ f1 ≘ f →
+ ∃∃i. @❪i2, f2❫ ≘ i & @❪i1, f❫ ≘ i.
+#f1 #i1 #i2 #Hf1 #f2 #Hf2 #f #Hf elim (Hf2 i2) -Hf2
+/3 width=8 by gr_after_des_pat, ex2_intro/
+qed-.
+
+(* Inversions with gr_ist *)
+
+(*** after_inv_istot *)
+lemma gr_after_inv_ist:
+ ∀f2,f1,f. f2 ⊚ f1 ≘ f → 𝐓❪f❫ → ∧∧ 𝐓❪f2❫ & 𝐓❪f1❫.
+/3 width=4 by gr_after_des_ist_sn, gr_after_des_ist_dx, conj/ 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 "ground/relocation/gr_ist_isi.ma".
+include "ground/relocation/gr_after_ist.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Forward lemmas on istot and isid **************************************************)
+
+(*** after_fwd_isid_sn *)
+lemma gr_after_des_isi_sn:
+ ∀f2,f1,f. 𝐓❪f❫ → f2 ⊚ f1 ≘ f → f1 ≡ f → 𝐈❪f2❫.
+#f2 #f1 #f #H #Hf elim (gr_after_inv_ist … Hf H) -H
+#Hf2 #Hf1 #H @gr_isi_pat_total // -Hf2
+#i2 #i #Hf2 elim (Hf1 i2) -Hf1
+#i0 #Hf1 lapply (gr_pat_increasing … Hf1)
+#Hi20 lapply (gr_after_des_pat_sn … i0 … Hf1 … Hf) -Hf
+/3 width=7 by gr_pat_eq_repl_back, gr_pat_mono, gr_pat_id_le/
+qed-.
+
+(*** after_fwd_isid_dx *)
+lemma gr_after_des_isi_dx:
+ ∀f2,f1,f. 𝐓❪f❫ → f2 ⊚ f1 ≘ f → f2 ≡ f → 𝐈❪f1❫.
+#f2 #f1 #f #H #Hf elim (gr_after_inv_ist … Hf H) -H
+#Hf2 #Hf1 #H2 @gr_isi_pat_total // -Hf1
+#i1 #i2 #Hi12 elim (gr_after_pat_sn_des … Hi12 … Hf) -f1
+/3 width=8 by gr_pat_inj, gr_pat_eq_repl_back/
+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 "ground/relocation/gr_isu_uni.ma".
+include "ground/relocation/gr_after_uni.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties on isuni ******************************************************)
+
+(*** after_isid_isuni *)
+lemma gr_after_isu_isi_next:
+ ∀f1,f2. 𝐈❪f2❫ → 𝐔❪f1❫ → f1 ⊚ ↑f2 ≘ ↑f1.
+#f1 #f2 #Hf2 #H
+elim (gr_isu_inv_uni … H) -H #h #H
+/5 width=7 by gr_after_uni_isi_next, gr_after_eq_repl_back, gr_after_eq_repl_back_sn, gr_eq_next/
+qed.
+
+(*** after_uni_next2 *)
+lemma gr_after_isu_next_sn:
+ ∀f2. 𝐔❪f2❫ → ∀f1,f. ↑f2 ⊚ f1 ≘ f → f2 ⊚ ↑f1 ≘ f.
+#f2 #H #f1 #f #Hf
+elim (gr_isu_inv_uni … H) -H #h #H
+/5 width=7 by gr_after_uni_next_sn, gr_after_eq_repl_fwd_sn, gr_after_eq_repl_back_sn, gr_eq_next/
+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 "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_nat.ma".
+include "ground/relocation/gr_isi_uni.ma".
+include "ground/relocation/gr_after_isi.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_nat and uni *)
+
+(*** after_uni_dx *)
+lemma gr_after_uni_dx (l2) (l1):
+ ∀f2. @↑❪l1, f2❫ ≘ l2 →
+ ∀f. f2 ⊚ 𝐮❨l1❩ ≘ f → 𝐮❨l2❩ ⊚ ⫱*[l2] f2 ≘ f.
+#l2 @(nat_ind_succ … l2) -l2
+[ #l1 #f2 #Hf2 #f #Hf
+ elim (gr_nat_inv_zero_dx … Hf2) -Hf2 // #g2 #H1 #H2 destruct
+ lapply (gr_after_isi_inv_dx … Hf ?) -Hf
+ /3 width=3 by gr_after_isi_sn, gr_after_eq_repl_back/
+| #l2 #IH #l1 #f2 #Hf2 #f #Hf
+ elim (gr_nat_inv_succ_dx … Hf2) -Hf2 [1,3: * |*: // ]
+ [ #g2 #k1 #Hg2 #H1 #H2 destruct
+ elim (gr_after_inv_push_next … Hf) -Hf [ |*: // ] #g #Hg #H destruct
+ <gr_tls_swap /3 width=5 by gr_after_next/
+ | #g2 #Hg2 #H2 destruct
+ elim (gr_after_inv_next_sn … Hf) -Hf [ |*: // ] #g #Hg #H destruct
+ <gr_tls_swap /3 width=5 by gr_after_next/
+ ]
+]
+qed.
+
+(*** after_uni_sn *)
+lemma gr_after_uni_sn (l2) (l1):
+ ∀f2. @↑❪l1, f2❫ ≘ l2 →
+ ∀f. 𝐮❨l2❩ ⊚ ⫱*[l2] f2 ≘ f → f2 ⊚ 𝐮❨l1❩ ≘ f.
+#l2 @(nat_ind_succ … l2) -l2
+[ #l1 #f2 #Hf2 #f #Hf
+ elim (gr_nat_inv_zero_dx … Hf2) -Hf2 // #g2 #H1 #H2 destruct
+ lapply (gr_after_isi_inv_sn … Hf ?) -Hf
+ /3 width=3 by gr_after_isi_dx, gr_after_eq_repl_back/
+| #l2 #IH #l1 #f2 #Hf2 #f #Hf
+ elim (gr_after_inv_next_sn … Hf) -Hf [2,3: // ] #g #Hg #H destruct
+ elim (gr_nat_inv_succ_dx … Hf2) -Hf2 [1,3: * |*: // ]
+ [ #g2 #k1 #Hg2 #H1 #H2 destruct /3 width=7 by gr_after_push/
+ | #g2 #Hg2 #H2 destruct /3 width=5 by gr_after_next/
+ ]
+]
+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 "ground/relocation/gr_pat_pat.ma".
+include "ground/relocation/gr_after.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Forward lemmas on pat *****************************************************)
+
+(*** after_at_fwd *)
+lemma gr_after_pat_des (i) (i1):
+ ∀f. @❪i1, f❫ ≘ i → ∀f2,f1. f2 ⊚ f1 ≘ f →
+ ∃∃i2. @❪i1, f1❫ ≘ i2 & @❪i2, f2❫ ≘ i.
+#i elim i -i [2: #i #IH ] #i1 #f #Hf #f2 #f1 #Hf21
+[ elim (gr_pat_inv_succ_dx … Hf) -Hf [1,3:* |*: // ]
+ [1: #g #j1 #Hg #H0 #H |2,4: #g #Hg #H ]
+| elim (gr_pat_inv_unit_dx … Hf) -Hf //
+ #g #H1 #H
+]
+[2: elim (gr_after_inv_next … Hf21 … H) -f *
+ [ #g2 #g1 #Hg21 #H2 #H1 | #g2 #Hg21 #H2 ]
+|*: elim (gr_after_inv_push … Hf21 … H) -f
+ #g2 #g1 #Hg21 #H2 #H1
+]
+[4: -Hg21 |*: elim (IH … Hg … Hg21) -g -IH ]
+/3 width=9 by gr_pat_refl, gr_pat_push, gr_pat_next, ex2_intro/
+qed-.
+
+(*** after_fwd_at *)
+lemma gr_after_des_pat (i) (i2) (i1):
+ ∀f1,f2. @❪i1, f1❫ ≘ i2 → @❪i2, f2❫ ≘ i →
+ ∀f. f2 ⊚ f1 ≘ f → @❪i1, f❫ ≘ i.
+#i elim i -i [2: #i #IH ] #i2 #i1 #f1 #f2 #Hf1 #Hf2 #f #Hf
+[ elim (gr_pat_inv_succ_dx … Hf2) -Hf2 [1,3: * |*: // ]
+ #g2 [ #j2 ] #Hg2 [ #H22 ] #H20
+ [ elim (gr_pat_inv_succ_dx … Hf1 … H22) -i2 *
+ #g1 [ #j1 ] #Hg1 [ #H11 ] #H10
+ [ elim (gr_after_inv_push_bi … Hf … H20 H10) -f1 -f2 /3 width=7 by gr_pat_push/
+ | elim (gr_after_inv_push_next … Hf … H20 H10) -f1 -f2 /3 width=6 by gr_pat_next/
+ ]
+ | elim (gr_after_inv_next_sn … Hf … H20) -f2 /3 width=7 by gr_pat_next/
+ ]
+| elim (gr_pat_inv_unit_dx … Hf2) -Hf2 // #g2 #H22 #H20
+ elim (gr_pat_inv_unit_dx … Hf1 … H22) -i2 #g1 #H11 #H10
+ elim (gr_after_inv_push_bi … Hf … H20 H10) -f1 -f2 /2 width=2 by gr_pat_refl/
+]
+qed-.
+
+(*** after_fwd_at2 *)
+lemma gr_after_des_pat_sn (i1) (i):
+ ∀f. @❪i1, f❫ ≘ i → ∀f1,i2. @❪i1, f1❫ ≘ i2 →
+ ∀f2. f2 ⊚ f1 ≘ f → @❪i2, f2❫ ≘ i.
+#i1 #i #f #Hf #f1 #i2 #Hf1 #f2 #H elim (gr_after_pat_des … Hf … H) -f
+#j1 #H #Hf2 <(gr_pat_mono … Hf1 … H) -i1 -i2 //
+qed-.
+
+(*** after_fwd_at1 *)
+lemma gr_after_des_pat_dx (i) (i2) (i1):
+ ∀f,f2. @❪i1, f❫ ≘ i → @❪i2, f2❫ ≘ i →
+ ∀f1. f2 ⊚ f1 ≘ f → @❪i1, f1❫ ≘ i2.
+#i elim i -i [2: #i #IH ] #i2 #i1 #f #f2 #Hf #Hf2 #f1 #Hf1
+[ elim (gr_pat_inv_succ_dx … Hf) -Hf [1,3: * |*: // ]
+ #g [ #j1 ] #Hg [ #H01 ] #H00
+ elim (gr_pat_inv_succ_dx … Hf2) -Hf2 [1,3,5,7: * |*: // ]
+ #g2 [1,3: #j2 ] #Hg2 [1,2: #H22 ] #H20
+ [ elim (gr_after_inv_push_sn_push … Hf1 … H20 H00) -f2 -f /3 width=7 by gr_pat_push/
+ | elim (gr_after_inv_push_sn_next … Hf1 … H20 H00) -f2 -f /3 width=5 by gr_pat_next/
+ | elim (gr_after_inv_next_sn_push … Hf1 … H20 H00)
+ | /4 width=9 by gr_after_inv_next_sn_next, gr_pat_next/
+ ]
+| elim (gr_pat_inv_unit_dx … Hf) -Hf // #g #H01 #H00
+ elim (gr_pat_inv_unit_dx … Hf2) -Hf2 // #g2 #H21 #H20
+ elim (gr_after_inv_push_sn_push … Hf1 … H20 H00) -f2 -f /3 width=2 by gr_pat_refl/
+]
+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 "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_pat.ma".
+include "ground/relocation/gr_after.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties on pat and tls ********************************************************)
+
+(* Note: this requires ↑ on first n *)
+(*** after_tls *)
+lemma gr_after_tls_sn_tls (n):
+ ∀f1,f2,f. @❪𝟏, f1❫ ≘ ↑n →
+ f1 ⊚ f2 ≘ f → ⫱*[n]f1 ⊚ f2 ≘ ⫱*[n]f.
+#n @(nat_ind_succ … n) -n //
+#n #IH #f1 #f2 #f #Hf1 #Hf
+cases (gr_pat_inv_unit_succ … Hf1) -Hf1 [ |*: // ] #g1 #Hg1 #H1
+cases (gr_after_inv_next_sn … Hf … H1) -Hf #g #Hg #H0 destruct
+<gr_tls_swap <gr_tls_swap /2 width=1 by/
+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 "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_pat.ma".
+(**) (* it should not depend on gr_isi *)
+include "ground/relocation/gr_isi_uni.ma".
+include "ground/relocation/gr_after_isi.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with pat and uni *******************************************************)
+
+(*** after_uni_succ_dx *)
+lemma gr_after_uni_dx (i2) (i1):
+ ∀f2. @❪i1, f2❫ ≘ i2 →
+ ∀f. f2 ⊚ 𝐮❨i1❩ ≘ f → 𝐮❨i2❩ ⊚ ⫱*[i2] f2 ≘ f.
+#i2 elim i2 -i2
+[ #i1 #f2 #Hf2 #f #Hf
+ elim (gr_pat_inv_unit_dx … Hf2) -Hf2 // #g2 #H1 #H2 destruct
+ elim (gr_after_inv_push_next … Hf) -Hf [ |*: // ] #g #Hg #H
+ lapply (gr_after_isi_inv_dx … Hg ?) -Hg
+ /4 width=5 by gr_after_isi_sn, gr_after_eq_repl_back, gr_after_next/
+| #i2 #IH #i1 #f2 #Hf2 #f #Hf >nsucc_inj
+ elim (gr_pat_inv_succ_dx … Hf2) -Hf2 [1,3: * |*: // ]
+ [ #g2 #j1 #Hg2 #H1 #H2 destruct >nsucc_inj in Hf; #Hf
+ elim (gr_after_inv_push_next … Hf) -Hf [ |*: // ] #g #Hg #H destruct
+ <gr_tls_swap /3 width=5 by gr_after_next/
+ | #g2 #Hg2 #H2 destruct
+ elim (gr_after_inv_next_sn … Hf) -Hf [2,3: // ] #g #Hg #H destruct
+ <gr_tls_swap /3 width=5 by gr_after_next/
+ ]
+]
+qed.
+
+(*** after_uni_succ_sn *)
+lemma gr_after_uni_sn (i2) (i1):
+ ∀f2. @❪i1, f2❫ ≘ i2 →
+ ∀f. 𝐮❨i2❩ ⊚ ⫱*[i2] f2 ≘ f → f2 ⊚ 𝐮❨i1❩ ≘ f.
+#i2 elim i2 -i2
+[ #i1 #f2 #Hf2 #f #Hf
+ elim (gr_pat_inv_unit_dx … Hf2) -Hf2 // #g2 #H1 #H2 destruct
+ elim (gr_after_inv_next_sn … Hf) -Hf [ |*: // ] #g #Hg #H destruct
+ lapply (gr_after_isi_inv_sn … Hg ?) -Hg
+ /4 width=7 by gr_after_isi_dx, gr_after_eq_repl_back, gr_after_push/
+| #i2 #IH #i1 #f2 #Hf2 #f >nsucc_inj #Hf
+ elim (gr_after_inv_next_sn … Hf) -Hf [2,3: // ] #g #Hg #H destruct
+ elim (gr_pat_inv_succ_dx … Hf2) -Hf2 [1,3: * |*: // ]
+ [ #g2 #j1 #Hg2 #H1 #H2 destruct <gr_tls_swap in Hg; /3 width=7 by gr_after_push/
+ | #g2 #Hg2 #H2 destruct <gr_tls_swap in Hg; /3 width=5 by gr_after_next/
+ ]
+]
+qed-.
+
+(* Advanced properties with uni *)
+
+(*** after_uni_one_dx *)
+lemma gr_after_uni_one_dx:
+ ∀f2,f. ⫯f2 ⊚ 𝐮❨𝟏❩ ≘ f → 𝐮❨𝟏❩ ⊚ f2 ≘ f.
+#f2 #f #H
+@(gr_after_uni_dx … (⫯f2))
+/2 width=3 by gr_pat_refl/
+qed.
+
+(*** after_uni_one_sn *)
+lemma gr_after_uni_one_sn:
+ ∀f1,f. 𝐮❨𝟏❩ ⊚ f1 ≘ f → ⫯f1 ⊚ 𝐮❨𝟏❩ ≘ f.
+/3 width=3 by gr_after_uni_sn, gr_pat_refl/ 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 "ground/arith/nat_plus.ma".
+(**) (* it should not depend on gr_isi *)
+include "ground/relocation/gr_isi_uni.ma".
+include "ground/relocation/gr_after_isi.ma".
+
+(* RELATIONAL COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties on uni ********************************************************)
+
+(*** after_uni *)
+lemma gr_after_uni (h1) (h2): 𝐮❨h1❩ ⊚ 𝐮❨h2❩ ≘ 𝐮❨h2+h1❩.
+#h1 @(nat_ind_succ … h1) -h1
+/3 width=5 by gr_after_isi_sn, gr_after_next, eq_f/
+qed.
+
+(*** after_uni_sn_pushs *)
+lemma gr_after_uni_sn_pushs (h):
+ ∀f. 𝐮❨h❩ ⊚ f ≘ ↑*[h]f.
+#h @(nat_ind_succ … h) -h
+/2 width=5 by gr_after_isi_sn, gr_after_next/
+qed.
+
+lemma gr_after_uni_isi_next (h1):
+ ∀f2. 𝐈❪f2❫ → 𝐮❨h1❩ ⊚ ↑f2 ≘ ↑𝐮❨h1❩.
+#h1 @(nat_ind_succ … h1) -h1
+/5 width=7 by gr_after_isi_dx, gr_after_eq_repl_back_sn, gr_after_next, gr_after_push, gr_isi_inv_eq_push/
+qed.
+
+lemma gr_after_uni_next_sn (h2):
+ ∀f1,f. ↑𝐮❨h2❩ ⊚ f1 ≘ f → 𝐮❨h2❩ ⊚ ↑f1 ≘ f.
+#h2 @(nat_ind_succ … h2) -h2
+[ #f1 #f #Hf
+ elim (gr_after_inv_next_sn … Hf) -Hf [2,3: // ] #g #Hg #H0 destruct
+ /4 width=7 by gr_after_isi_inv_sn, gr_after_isi_sn, gr_after_eq_repl_back, gr_eq_next/
+| #h2 #IH #f1 #f #Hf
+ elim (gr_after_inv_next_sn … Hf) -Hf [2,3: // ] #g #Hg #H0 destruct
+ /3 width=5 by gr_after_next/
+]
+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 "ground/notation/functions/element_b_2.ma".
+include "ground/relocation/gr_pushs.ma".
+include "ground/relocation/gr_uni.ma".
+
+(* BASIC ELEMENTS FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+definition basic (d) (h): gr_map ≝ ⫯*[d] 𝐮❨h❩.
+
+interpretation
+ "basic elements (generic relocation maps)"
+ 'ElementB d h = (basic d h).
+
+(* Basic properties *********************************************************)
+
+(*** at_basic_succ_sn *)
+lemma gr_basic_succ_sn (d) (h): ⫯𝐛❨d,h❩ = 𝐛❨↑d,h❩.
+#d #h >gr_pushs_succ //
+qed.
+
+(*** at_basic_zero_succ *)
+lemma gr_basic_zero_succ (h): ↑𝐛❨𝟎,h❩ = 𝐛❨𝟎,↑h❩.
+#h >gr_nexts_succ //
+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 "ground/notation/relations/rcoafter_3.ma".
+include "ground/xoa/ex_3_2.ma".
+include "ground/relocation/gr_tl.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** coafter *)
+coinductive gr_coafter: relation3 gr_map gr_map gr_map ≝
+(*** coafter_refl *)
+| gr_coafter_refl (f1) (f2) (f) (g1) (g2) (g):
+ gr_coafter f1 f2 f → ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → gr_coafter g1 g2 g
+(*** coafter_push *)
+| gr_coafter_push (f1) (f2) (f) (g1) (g2) (g):
+ gr_coafter f1 f2 f → ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → gr_coafter g1 g2 g
+(*** coafter_next *)
+| gr_coafter_next (f1) (f2) (f) (g1) (g):
+ gr_coafter f1 f2 f → ↑f1 = g1 → ⫯f = g → gr_coafter g1 f2 g
+.
+
+interpretation
+ "relational co-composition (generic relocation maps)"
+ 'RCoAfter f1 f2 f = (gr_coafter f1 f2 f).
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** coafter_inv_ppx *)
+lemma gr_coafter_inv_push_bi:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 →
+ ∃∃f. f1 ~⊚ f2 ≘ f & ⫯f = g.
+#g1 #g2 #g * -g1 -g2 -g #f1 #f2 #f #g1
+[ #g2 #g #Hf #H1 #H2 #H #x1 #x2 #Hx1 #Hx2 destruct
+ >(eq_inv_gr_push_bi … Hx1) >(eq_inv_gr_push_bi … Hx2) -x2 -x1
+ /2 width=3 by ex2_intro/
+| #g2 #g #_ #_ #H2 #_ #x1 #x2 #_ #Hx2 destruct
+ elim (eq_inv_gr_push_next … Hx2)
+| #g #_ #H1 #_ #x1 #x2 #Hx1 #_ destruct
+ elim (eq_inv_gr_push_next … Hx1)
+]
+qed-.
+
+(*** coafter_inv_pnx *)
+lemma gr_coafter_inv_push_next:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 →
+ ∃∃f. f1 ~⊚ f2 ≘ f & ↑f = g.
+#g1 #g2 #g * -g1 -g2 -g #f1 #f2 #f #g1
+[ #g2 #g #_ #_ #H2 #_ #x1 #x2 #_ #Hx2 destruct
+ elim (eq_inv_gr_next_push … Hx2)
+| #g2 #g #Hf #H1 #H2 #H3 #x1 #x2 #Hx1 #Hx2 destruct
+ >(eq_inv_gr_push_bi … Hx1) >(eq_inv_gr_next_bi … Hx2) -x2 -x1
+ /2 width=3 by ex2_intro/
+| #g #_ #H1 #_ #x1 #x2 #Hx1 #_ destruct
+ elim (eq_inv_gr_push_next … Hx1)
+]
+qed-.
+
+(*** coafter_inv_nxx *)
+lemma gr_coafter_inv_next_sn:
+ ∀g1,f2,g. g1 ~⊚ f2 ≘ g → ∀f1. ↑f1 = g1 →
+ ∃∃f. f1 ~⊚ f2 ≘ f & ⫯f = g.
+#g1 #f2 #g * -g1 -f2 -g #f1 #f2 #f #g1
+[ #g2 #g #_ #H1 #_ #_ #x1 #Hx1 destruct
+ elim (eq_inv_gr_next_push … Hx1)
+| #g2 #g #_ #H1 #_ #_ #x1 #Hx1 destruct
+ elim (eq_inv_gr_next_push … Hx1)
+| #g #Hf #H1 #H #x1 #Hx1 destruct
+ >(eq_inv_gr_next_bi … Hx1) -x1
+ /2 width=3 by ex2_intro/
+]
+qed-.
+
+(* Advanced inversion lemmas ************************************************)
+
+(*** coafter_inv_ppp *)
+lemma gr_coafter_inv_push_bi_push:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
+ ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → f1 ~⊚ f2 ≘ f.
+#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H
+elim (gr_coafter_inv_push_bi … Hg … H1 H2) -g1 -g2 #x #Hf #Hx destruct
+<(eq_inv_gr_push_bi … Hx) -f //
+qed-.
+
+(*** coafter_inv_ppn *)
+lemma gr_coafter_inv_push_bi_next:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
+ ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ↑f = g → ⊥.
+#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H
+elim (gr_coafter_inv_push_bi … Hg … H1 H2) -g1 -g2 #x #Hf #Hx destruct
+elim (eq_inv_gr_push_next … Hx)
+qed-.
+
+(*** coafter_inv_pnn *)
+lemma gr_coafter_inv_push_next_next:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
+ ∀f1,f2,f. ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → f1 ~⊚ f2 ≘ f.
+#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H
+elim (gr_coafter_inv_push_next … Hg … H1 H2) -g1 -g2 #x #Hf #Hx destruct
+<(eq_inv_gr_next_bi … Hx) -f //
+qed-.
+
+(*** coafter_inv_pnp *)
+lemma gr_coafter_inv_push_next_push:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
+ ∀f1,f2,f. ⫯f1 = g1 → ↑f2 = g2 → ⫯f = g → ⊥.
+#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H
+elim (gr_coafter_inv_push_next … Hg … H1 H2) -g1 -g2 #x #Hf #Hx destruct
+elim (eq_inv_gr_next_push … Hx)
+qed-.
+
+(*** coafter_inv_nxp *)
+lemma gr_coafter_inv_next_sn_push:
+ ∀g1,f2,g. g1 ~⊚ f2 ≘ g →
+ ∀f1,f. ↑f1 = g1 → ⫯f = g → f1 ~⊚ f2 ≘ f.
+#g1 #f2 #g #Hg #f1 #f #H1 #H
+elim (gr_coafter_inv_next_sn … Hg … H1) -g1 #x #Hf #Hx destruct
+<(eq_inv_gr_push_bi … Hx) -f //
+qed-.
+
+(*** coafter_inv_nxn *)
+lemma gr_coafter_inv_next_sn_next:
+ ∀g1,f2,g. g1 ~⊚ f2 ≘ g →
+ ∀f1,f. ↑f1 = g1 → ↑f = g → ⊥.
+#g1 #f2 #g #Hg #f1 #f #H1 #H
+elim (gr_coafter_inv_next_sn … Hg … H1) -g1 #x #Hf #Hx destruct
+elim (eq_inv_gr_push_next … Hx)
+qed-.
+
+(*** coafter_inv_pxp *)
+lemma gr_coafter_inv_push_sn_push:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
+ ∀f1,f. ⫯f1 = g1 → ⫯f = g →
+ ∃∃f2. f1 ~⊚ f2 ≘ f & ⫯f2 = g2.
+#g1 #g2 #g #Hg #f1 #f #H1 #H
+elim (gr_map_split_tl g2) #H2
+[ lapply (gr_coafter_inv_push_bi_push … Hg … H1 H2 H) -g1 -g
+ /2 width=3 by ex2_intro/
+| elim (gr_coafter_inv_push_next_push … Hg … H1 H2 H)
+]
+qed-.
+
+(*** coafter_inv_pxn *)
+lemma gr_coafter_inv_push_sn_next:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
+ ∀f1,f. ⫯f1 = g1 → ↑f = g →
+ ∃∃f2. f1 ~⊚ f2 ≘ f & ↑f2 = g2.
+#g1 #g2 #g #Hg #f1 #f #H1 #H
+elim (gr_map_split_tl g2) #H2
+[ elim (gr_coafter_inv_push_bi_next … Hg … H1 H2 H)
+| lapply (gr_coafter_inv_push_next_next … Hg … H1 … H) -g1 -g
+ /2 width=3 by ex2_intro/
+]
+qed-.
+
+(*** coafter_inv_xxn *)
+lemma gr_coafter_inv_next:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g → ∀f. ↑f = g →
+ ∃∃f1,f2. f1 ~⊚ f2 ≘ f & ⫯f1 = g1 & ↑f2 = g2.
+#g1 #g2 #g #Hg #f #H
+elim (gr_map_split_tl g1) #H1
+[ elim (gr_coafter_inv_push_sn_next … Hg … H1 H) -g
+ /2 width=5 by ex3_2_intro/
+| elim (gr_coafter_inv_next_sn_next … Hg … H1 H)
+]
+qed-.
+
+(*** coafter_inv_xnn *)
+lemma gr_coafter_inv_next_dx_next:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
+ ∀f2,f. ↑f2 = g2 → ↑f = g →
+ ∃∃f1. f1 ~⊚ f2 ≘ f & ⫯f1 = g1.
+#g1 #g2 #g #Hg #f2 #f #H2 destruct #H
+elim (gr_coafter_inv_next … Hg … H) -g #z1 #z2 #Hf #H1 #H2 destruct
+/2 width=3 by ex2_intro/
+qed-.
+
+(*** coafter_inv_xxp *)
+lemma gr_coafter_inv_push:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g → ∀f. ⫯f = g →
+ ∨∨ ∃∃f1,f2. f1 ~⊚ f2 ≘ f & ⫯f1 = g1 & ⫯f2 = g2
+ | ∃∃f1. f1 ~⊚ g2 ≘ f & ↑f1 = g1.
+#g1 #g2 #g #Hg #f #H
+elim (gr_map_split_tl g1) #H1
+[ elim (gr_coafter_inv_push_sn_push … Hg … H1 H) -g
+ /3 width=5 by or_introl, ex3_2_intro/
+| /4 width=5 by gr_coafter_inv_next_sn_push, or_intror, ex2_intro/
+]
+qed-.
+
+(*** coafter_inv_pxx *)
+lemma gr_coafter_inv_push_sn:
+ ∀g1,g2,g. g1 ~⊚ g2 ≘ g → ∀f1. ⫯f1 = g1 →
+ ∨∨ ∃∃f2,f. f1 ~⊚ f2 ≘ f & ⫯f2 = g2 & ⫯f = g
+ | ∃∃f2,f. f1 ~⊚ f2 ≘ f & ↑f2 = g2 & ↑f = g.
+#g1 #g2 #g #Hg #f1 #H1
+elim (gr_map_split_tl g2) #H2
+[ elim (gr_coafter_inv_push_bi … Hg … H1 H2) -g1
+ /3 width=5 by or_introl, ex3_2_intro/
+| elim (gr_coafter_inv_push_next … Hg … H1 H2) -g1
+ /3 width=5 by or_intror, ex3_2_intro/
+]
+qed-.
+
+(* Inversion lemmas with tail ***********************************************)
+
+(*** coafter_inv_tl1 *)
+lemma gr_coafter_inv_tl_dx:
+ ∀g2,g1,g. g2 ~⊚ ⫱g1 ≘ g →
+ ∃∃f. ⫯g2 ~⊚ g1 ≘ f & ⫱f = g.
+#g2 #g1 #g
+elim (gr_map_split_tl g1) #H1 #H2
+[ /3 width=7 by gr_coafter_refl, ex2_intro/
+| @(ex2_intro … (↑g)) /2 width=7 by gr_coafter_push/ (**) (* full auto fails *)
+]
+qed-.
+
+(*** coafter_inv_tl0 *)
+lemma gr_coafter_inv_tl:
+ ∀g2,g1,g. g2 ~⊚ g1 ≘ ⫱g →
+ ∃∃f1. ⫯g2 ~⊚ f1 ≘ g & ⫱f1 = g1.
+#g2 #g1 #g
+elim (gr_map_split_tl g) #H1 #H2
+[ /3 width=7 by gr_coafter_refl, ex2_intro/
+| @(ex2_intro … (↑g1)) /2 width=7 by gr_coafter_push/ (**) (* full auto fails *)
+]
+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 "ground/relocation/gr_coafter_eq.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Main inversion lemmas ****************************************************)
+
+(*** coafter_mono *)
+corec theorem gr_coafter_mono:
+ ∀f1,f2,x,y. f1 ~⊚ f2 ≘ x → f1 ~⊚ f2 ≘ y → x ≡ y.
+#f1 #f2 #x #y * -f1 -f2 -x
+#f1 #f2 #x #g1 [1,2: #g2 ] #g #Hx #H1 [1,2: #H2 ] #H0x #Hy
+[ cases (gr_coafter_inv_push_bi … Hy … H1 H2) -g1 -g2 /3 width=8 by gr_eq_push/
+| cases (gr_coafter_inv_push_next … Hy … H1 H2) -g1 -g2 /3 width=8 by gr_eq_next/
+| cases (gr_coafter_inv_next_sn … Hy … H1) -g1 /3 width=8 by gr_eq_push/
+]
+qed-.
+
+(*** coafter_mono_eq *)
+lemma gr_coafter_mono_eq:
+ ∀f1,f2,f. f1 ~⊚ f2 ≘ f → ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
+ f1 ≡ g1 → f2 ≡ g2 → f ≡ g.
+/4 width=4 by gr_coafter_mono, gr_coafter_eq_repl_back_dx, gr_coafter_eq_repl_back_sn/ 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 "ground/relocation/gr_pat_tls.ma".
+include "ground/relocation/gr_ist_tls.ma".
+include "ground/relocation/gr_coafter_nat_tls.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** H_coafter_inj *)
+definition H_gr_coafter_inj: predicate gr_map ≝
+ λf1. 𝐓❪f1❫ →
+ ∀f,f21,f22. f1 ~⊚ f21 ≘ f → f1 ~⊚ f22 ≘ f → f21 ≡ f22.
+
+(* Main Forward lemmas with istot ************************************************)
+
+(*** coafter_inj_O_aux *)
+corec fact gr_coafter_inj_unit_aux:
+ ∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_gr_coafter_inj f1.
+#f1 #H1f1 #H2f1 #f #f21 #f22 #H1f #H2f
+cases (gr_pat_inv_unit_bi … H1f1) -H1f1 [ |*: // ] #g1 #H1
+lapply (gr_ist_inv_push … H2f1 … H1) -H2f1 #H2g1
+cases (H2g1 (𝟏)) #n #Hn
+cases (gr_coafter_inv_push_sn … H1f … H1) -H1f * #g21 #g #H1g #H21 #H
+[ cases (gr_coafter_inv_push_sn_push … H2f … H1 H) -f1 -f #g22 #H2g #H22
+ @(gr_eq_push … H21 H22) -f21 -f22
+| cases (gr_coafter_inv_push_sn_next … H2f … H1 H) -f1 -f #g22 #H2g #H22
+ @(gr_eq_next … H21 H22) -f21 -f22
+]
+@(gr_coafter_inj_unit_aux (⫱*[↓n]g1) … (⫱*[↓n]g)) -gr_coafter_inj_unit_aux
+/2 width=1 by gr_coafter_tls_bi_tls, gr_ist_tls, gr_pat_unit_succ_tls/
+qed-.
+
+(*** coafter_inj_aux *)
+fact gr_coafter_inj_aux:
+ (∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_gr_coafter_inj f1) →
+ ∀i2,f1. @❪𝟏, f1❫ ≘ i2 → H_gr_coafter_inj f1.
+#H0 #i2 elim i2 -i2 /2 width=1 by/ -H0
+#i2 #IH #f1 #H1f1 #H2f1 #f #f21 #f22 #H1f #H2f
+elim (gr_pat_inv_unit_succ … H1f1) -H1f1 [ |*: // ] #g1 #H1g1 #H1
+elim (gr_coafter_inv_next_sn … H1f … H1) -H1f #g #H1g #H
+lapply (gr_coafter_inv_next_sn_push … H2f … H1 H) -f #H2g
+/3 width=6 by gr_ist_inv_next/
+qed-.
+
+(*** coafter_inj *)
+theorem gr_coafter_inj:
+ ∀f1. H_gr_coafter_inj f1.
+#f1 #H cases (H (𝟏)) /3 width=7 by gr_coafter_inj_aux, gr_coafter_inj_unit_aux/
+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 "ground/relocation/gr_tl_eq.ma".
+include "ground/relocation/gr_coafter.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *)
+
+(*** coafter_eq_repl_back2 *)
+corec lemma gr_coafter_eq_repl_back_sn:
+ ∀f1,f. gr_eq_repl_back (λf2. f2 ~⊚ f1 ≘ f).
+#f1 #f #f2 * -f2 -f1 -f
+#f21 #f1 #f #g21 [1,2: #g1 ] #g #Hf #H21 [1,2: #H1 ] #H #g22 #H0
+[ cases (gr_eq_inv_push_sn … H0 … H21) -g21 /3 width=7 by gr_coafter_refl/
+| cases (gr_eq_inv_push_sn … H0 … H21) -g21 /3 width=7 by gr_coafter_push/
+| cases (gr_eq_inv_next_sn … H0 … H21) -g21 /3 width=5 by gr_coafter_next/
+]
+qed-.
+
+(*** coafter_eq_repl_fwd2 *)
+lemma gr_coafter_eq_repl_fwd_sn:
+ ∀f1,f. gr_eq_repl_fwd (λf2. f2 ~⊚ f1 ≘ f).
+#f1 #f @gr_eq_repl_sym /2 width=3 by gr_coafter_eq_repl_back_sn/
+qed-.
+
+(*** coafter_eq_repl_back1 *)
+corec lemma gr_coafter_eq_repl_back_dx:
+ ∀f2,f. gr_eq_repl_back (λf1. f2 ~⊚ f1 ≘ f).
+#f2 #f #f1 * -f2 -f1 -f
+#f2 #f11 #f #g2 [1,2: #g11 ] #g #Hf #H2 [1,2: #H11 ] #H #g2 #H0
+[ cases (gr_eq_inv_push_sn … H0 … H11) -g11 /3 width=7 by gr_coafter_refl/
+| cases (gr_eq_inv_next_sn … H0 … H11) -g11 /3 width=7 by gr_coafter_push/
+| @(gr_coafter_next … H2 H) /2 width=5 by/
+]
+qed-.
+
+(*** coafter_eq_repl_fwd1 *)
+lemma gr_coafter_eq_repl_fwd_dx:
+ ∀f2,f. gr_eq_repl_fwd (λf1. f2 ~⊚ f1 ≘ f).
+#f2 #f @gr_eq_repl_sym /2 width=3 by gr_coafter_eq_repl_back_dx/
+qed-.
+
+(*** coafter_eq_repl_back0 *)
+corec lemma gr_coafter_eq_repl_back:
+ ∀f1,f2. gr_eq_repl_back (λf. f2 ~⊚ f1 ≘ f).
+#f2 #f1 #f * -f2 -f1 -f
+#f2 #f1 #f01 #g2 [1,2: #g1 ] #g01 #Hf01 #H2 [1,2: #H1 ] #H01 #g02 #H0
+[ cases (gr_eq_inv_push_sn … H0 … H01) -g01 /3 width=7 by gr_coafter_refl/
+| cases (gr_eq_inv_next_sn … H0 … H01) -g01 /3 width=7 by gr_coafter_push/
+| cases (gr_eq_inv_push_sn … H0 … H01) -g01 /3 width=5 by gr_coafter_next/
+]
+qed-.
+
+(*** coafter_eq_repl_fwd0 *)
+lemma gr_coafter_eq_repl_fwd:
+ ∀f2,f1. gr_eq_repl_fwd (λf. f2 ~⊚ f1 ≘ f).
+#f2 #f1 @gr_eq_repl_sym /2 width=3 by gr_coafter_eq_repl_back/
+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 "ground/relocation/gr_isi_id.ma".
+include "ground/relocation/gr_coafter_coafter.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with test for identity ****************************************)
+
+(*** coafter_isid_sn *)
+corec lemma gr_coafter_isi_sn:
+ ∀f1. 𝐈❪f1❫ → ∀f2. f1 ~⊚ f2 ≘ f2.
+#f1 * -f1 #f1 #g1 #Hf1 #H1 #f2
+cases (gr_map_split_tl f2) #H2
+/3 width=7 by gr_coafter_push, gr_coafter_refl/
+qed.
+
+(*** coafter_isid_dx *)
+corec lemma gr_coafter_isi_dx:
+ ∀f2,f. 𝐈❪f2❫ → 𝐈❪f❫ → ∀f1. f1 ~⊚ f2 ≘ f.
+#f2 #f * -f2 #f2 #g2 #Hf2 #H2 * -f #f #g #Hf #H #f1
+cases (gr_map_split_tl f1) #H1
+[ /3 width=7 by gr_coafter_refl/
+| @(gr_coafter_next … H1 … H) /3 width=3 by gr_isi_push/
+]
+qed.
+
+(* Inversion lemmas with test for identity **********************************)
+
+(*** coafter_isid_inv_sn *)
+lemma gr_coafter_isi_inv_sn:
+ ∀f1,f2,f. f1 ~⊚ f2 ≘ f → 𝐈❪f1❫ → f2 ≡ f.
+/3 width=6 by gr_coafter_isi_sn, gr_coafter_mono/ qed-.
+
+(*** coafter_isid_inv_dx *)
+lemma gr_coafter_isi_inv_dx:
+ ∀f1,f2,f. f1 ~⊚ f2 ≘ f → 𝐈❪f2❫ → 𝐈❪f❫.
+/4 width=4 by gr_eq_id_isi, gr_coafter_isi_dx, gr_coafter_mono/ 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 "ground/relocation/gr_pat_tls.ma".
+include "ground/relocation/gr_isf_tls.ma".
+include "ground/relocation/gr_ist_tls.ma".
+include "ground/relocation/gr_coafter_nat_tls.ma".
+include "ground/relocation/gr_coafter_isi.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** H_coafter_isfin2_fwd *)
+definition H_gr_coafter_des_ist_isf: predicate gr_map ≝
+ λf1. ∀f2. 𝐅❪f2❫ → 𝐓❪f1❫ → ∀f. f1 ~⊚ f2 ≘ f → 𝐅❪f❫.
+
+(* Forward lemmas with ist and isf *)
+
+(*** coafter_isfin2_fwd_O_aux *)
+fact gr_coafter_des_ist_isf_unit_aux:
+ ∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_gr_coafter_des_ist_isf f1.
+#f1 #Hf1 #f2 #H
+generalize in match Hf1; generalize in match f1; -f1
+@(gr_isf_ind … H) -f2
+[ /3 width=4 by gr_coafter_isi_inv_dx, gr_isf_isi/ ]
+#f2 #_ #IH #f1 #H #Hf1 #f #Hf
+elim (gr_pat_inv_unit_bi … H) -H [ |*: // ] #g1 #H1
+lapply (gr_ist_inv_push … Hf1 … H1) -Hf1 #Hg1
+elim (Hg1 (𝟏)) #n #Hn
+[ elim (gr_coafter_inv_push_bi … Hf) | elim (gr_coafter_inv_push_next … Hf)
+] -Hf [1,6: |*: // ] #g #Hg #H0 destruct
+/5 width=6 by gr_isf_next, gr_isf_push, gr_isf_inv_tls, gr_ist_tls, gr_pat_unit_succ_tls, gr_coafter_tls_sn_tls/
+qed-.
+
+(*** coafter_isfin2_fwd_aux *)
+fact gr_coafter_des_ist_isf_aux:
+ (∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_gr_coafter_des_ist_isf f1) →
+ ∀i2,f1. @❪𝟏, f1❫ ≘ i2 → H_gr_coafter_des_ist_isf f1.
+#H0 #i2 elim i2 -i2 /2 width=1 by/ -H0
+#i2 #IH #f1 #H1f1 #f2 #Hf2 #H2f1 #f #Hf
+elim (gr_pat_inv_unit_succ … H1f1) -H1f1 [ |*: // ] #g1 #Hg1 #H1
+elim (gr_coafter_inv_next_sn … Hf … H1) -Hf #g #Hg #H0
+lapply (IH … Hg1 … Hg) -i2 -Hg
+/2 width=4 by gr_ist_inv_next, gr_isf_push/ (**) (* full auto fails *)
+qed-.
+
+(*** coafter_isfin2_fwd *)
+lemma gr_coafter_des_ist_isf: ∀f1. H_gr_coafter_des_ist_isf f1.
+#f1 #f2 #Hf2 #Hf1 cases (Hf1 (𝟏))
+/3 width=7 by gr_coafter_des_ist_isf_aux, gr_coafter_des_ist_isf_unit_aux/
+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 "ground/relocation/gr_pat_tls.ma".
+include "ground/relocation/gr_isi_tls.ma".
+include "ground/relocation/gr_ist_tls.ma".
+include "ground/relocation/gr_coafter_nat_tls.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** H_coafter_fwd_isid2 *)
+definition H_gr_coafter_des_ist_sn_isi: predicate gr_map ≝
+ λf1. ∀f2,f. f1 ~⊚ f2 ≘ f → 𝐓❪f1❫ → 𝐈❪f❫ → 𝐈❪f2❫.
+
+(* Forward lemmas with ist and isi *)
+
+(*** coafter_fwd_isid2_O_aux *)
+corec fact gr_coafter_des_ist_sn_isi_unit_aux:
+ ∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_gr_coafter_des_ist_sn_isi f1.
+#f1 #H1f1 #f2 #f #H #H2f1 #Hf
+cases (gr_pat_inv_unit_bi … H1f1) -H1f1 [ |*: // ] #g1 #H1
+lapply (gr_ist_inv_push … H2f1 … H1) -H2f1 #H2g1
+cases (H2g1 (𝟏)) #n #Hn
+cases (gr_coafter_inv_push_sn … H … H1) -H * #g2 #g #H #H2 #H0
+[ lapply (gr_isi_inv_push … Hf … H0) -Hf #Hg
+ @(gr_isi_push … H2) -H2
+ /3 width=7 by gr_coafter_tls_sn_tls, gr_pat_unit_succ_tls, gr_ist_tls, gr_isi_tls/
+| cases (gr_isi_inv_next … Hf … H0)
+]
+qed-.
+
+(*** coafter_fwd_isid2_aux *)
+fact gr_coafter_des_ist_sn_isi_aux:
+ (∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_gr_coafter_des_ist_sn_isi f1) →
+ ∀i2,f1. @❪𝟏, f1❫ ≘ i2 → H_gr_coafter_des_ist_sn_isi f1.
+#H0 #i2 elim i2 -i2 /2 width=1 by/ -H0
+#i2 #IH #f1 #H1f1 #f2 #f #H #H2f1 #Hf
+elim (gr_pat_inv_unit_succ … H1f1) -H1f1 [ |*: // ] #g1 #Hg1 #H1
+elim (gr_coafter_inv_next_sn … H … H1) -H #g #Hg #H0
+@(IH … Hg1 … Hg) /2 width=3 by gr_ist_inv_next, gr_isi_inv_push/ (**) (* full auto fails *)
+qed-.
+
+(*** coafter_fwd_isid2 *)
+lemma gr_coafter_des_ist_sn_isi:
+ ∀f1. H_gr_coafter_des_ist_sn_isi f1.
+#f1 #f2 #f #Hf #H cases (H (𝟏))
+/3 width=7 by gr_coafter_des_ist_sn_isi_aux, gr_coafter_des_ist_sn_isi_unit_aux/
+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 "ground/relocation/gr_isi_pushs.ma".
+include "ground/relocation/gr_isu_uni.ma".
+include "ground/relocation/gr_coafter_uni_pushs.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with test for uniform relocations and isi *****************************)
+
+(*** coafter_isuni_isid *)
+lemma gr_coafter_isu_isi:
+ ∀f2. 𝐈❪f2❫ → ∀f1. 𝐔❪f1❫ → f1 ~⊚ f2 ≘ f2.
+#f #Hf #g #H
+elim (gr_isu_inv_uni … H) -H #n #H
+/5 width=4 by gr_isi_pushs, gr_isi_inv_eq_repl, gr_coafter_eq_repl_back, gr_coafter_eq_repl_back_sn/
+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 "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_nat.ma".
+include "ground/relocation/gr_coafter.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with nat and iterated tail ********************************************)
+
+(*** coafter_tls *)
+lemma gr_coafter_tls_bi_tls (n2) (n1):
+ ∀f1,f2,f. @↑❪n1, f1❫ ≘ n2 →
+ f1 ~⊚ f2 ≘ f → ⫱*[n2]f1 ~⊚ ⫱*[n1]f2 ≘ ⫱*[n2]f.
+#n2 @(nat_ind_succ … n2) -n2 [ #n1 | #n2 #IH * [| #n1 ] ] #f1 #f2 #f #Hf1 #Hf
+[ elim (gr_nat_inv_zero_dx … Hf1) -Hf1 [ |*: // ] #g1 #Hg1 #H1 destruct //
+| elim (gr_nat_inv_zero_succ … Hf1) -Hf1 [ |*: // ] #g1 #Hg1 #H1
+ elim (gr_coafter_inv_next_sn … Hf … H1) -Hf #g #Hg #H0 destruct
+ lapply (IH … Hg1 Hg) -IH -Hg1 -Hg //
+| elim (gr_nat_inv_succ_dx … Hf1) -Hf1 [1,3: * |*: // ] #g1 [ #n1 ] #Hg1 [ #H ] #H1
+ [ elim (gr_coafter_inv_push_sn … Hf … H1) -Hf * #g2 #g #Hg #H2 #H0 destruct
+ lapply (IH … Hg1 Hg) -IH -Hg1 -Hg #H //
+ | elim (gr_coafter_inv_next_sn … Hf … H1) -Hf #g #Hg #H0 destruct
+ lapply (IH … Hg1 Hg) -IH -Hg1 -Hg #H //
+ ]
+]
+qed.
+
+(*** coafter_tls_O *)
+lemma gr_coafter_tls_sn_tls:
+ ∀n,f1,f2,f. @↑❪𝟎, f1❫ ≘ n →
+ f1 ~⊚ f2 ≘ f → ⫱*[n]f1 ~⊚ f2 ≘ ⫱*[n]f.
+/2 width=1 by gr_coafter_tls_bi_tls/ 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 "ground/relocation/gr_pushs.ma".
+include "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_nat.ma".
+include "ground/relocation/gr_coafter.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Forward lemmas with nat and iterated tail and pushs ************************************************)
+
+(*** coafter_fwd_pushs *)
+lemma gr_coafter_des_pushs_dx (n) (m):
+ ∀g2,f1,g. g2 ~⊚ ⫯*[m]f1 ≘ g → @↑❪m, g2❫ ≘ n →
+ ∃∃f. ⫱*[n]g2 ~⊚ f1 ≘ f & ⫯*[n] f = g.
+#n @(nat_ind_succ … n) -n
+[ #m #g2 #f1 #g #Hg #H
+ elim (gr_nat_inv_zero_dx … H) -H [|*: // ] #f2 #H1 #H2 destruct
+ /2 width=3 by ex2_intro/
+| #n #IH * [| #m ] #g2 #f1 #g #Hg #H
+ [ elim (gr_nat_inv_zero_succ … H) -H [|*: // ] #f2 #Hmn #H destruct
+ elim (gr_coafter_inv_next_sn … Hg) -Hg [|*: // ] #f #Hf #H destruct
+ elim (IH … Hf Hmn) -IH -Hf -Hmn /2 width=3 by ex2_intro/
+ | elim (gr_nat_inv_succ_bi … H) -H [1,4: * |*: // ] #f2 #Hmn #H destruct
+ [ elim (gr_coafter_inv_push_bi … Hg) -Hg [|*: // ] #f #Hf #H destruct
+ elim (IH … Hf Hmn) -IH -Hf -Hmn /2 width=3 by ex2_intro/
+ | elim (gr_coafter_inv_next_sn … Hg) -Hg [|*: // ] #f #Hf #H destruct
+ elim (IH … Hf Hmn) -IH -Hf -Hmn /2 width=3 by ex2_intro/
+ ]
+ ]
+]
+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 "ground/relocation/gr_pat_tls.ma".
+include "ground/relocation/gr_coafter_nat_tls.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with pat and iterated tail ********************************************)
+
+(* Note: this does not require ↑ first and second j *)
+(*** coafter_tls_succ *)
+lemma gr_coafter_tls_tl_tls:
+ ∀g2,g1,g. g2 ~⊚ g1 ≘ g →
+ ∀j. @❪𝟏, g2❫ ≘ j → ⫱*[j]g2 ~⊚ ⫱g1 ≘ ⫱*[j]g.
+#g2 #g1 #g #Hg #j #Hg2
+lapply (gr_nat_pred_bi … Hg2) -Hg2 #Hg2
+lapply (gr_coafter_tls_bi_tls … Hg2 … Hg) -Hg #Hg
+lapply (gr_pat_unit_succ_tls … Hg2) -Hg2 #H
+elim (gr_pat_inv_unit_bi … H) -H [ |*: // ] #f2 #H2
+elim (gr_coafter_inv_push_sn … Hg … H2) -Hg * #f1 #f #Hf #H1 #H0
+>(npsucc_pred j) <gr_tls_succ <gr_tls_succ //
+qed.
+
+(* Note: parked for now
+lemma coafter_fwd_xpx_pushs:
+ ∀g2,f1,g,i,j. @❪i, g2❫ ≘ j → g2 ~⊚ ⫯*[i]⫯f1 ≘ g →
+ ∃∃f. ⫱*[↑j]g2 ~⊚ f1 ≘ f & ⫯*[j]⫯f = g.
+#g2 #g1 #g #i #j #Hg2 <pushs_xn #Hg(coafter_fwd_pushs … Hg Hg2) #f #H0 destruct
+lapply (coafter_tls … Hg2 Hg) -Hg <tls_pushs <tls_pushs #Hf
+lapply (at_inv_tls … Hg2) -Hg2 #H
+lapply (coafter_eq_repl_fwd2 … Hf … H) -H -Hf #Hf
+elim (coafter_inv_ppx … Hf) [|*: // ] -Hf #g #Hg #H destruct
+/2 width=3 by ex2_intro/
+qed-.
+
+lemma coafter_fwd_xnx_pushs:
+ ∀g2,f1,g,i,j. @❪i, g2❫ ≘ j → g2 ~⊚ ⫯*[i]↑f1 ≘ g →
+ ∃∃f. ⫱*[↑j]g2 ~⊚ f1 ≘ f & ⫯*[j] ↑f = g.
+#g2 #g1 #g #i #j #Hg2 #Hg
+elim (coafter_fwd_pushs … Hg Hg2) #f #H0 destruct
+lapply (coafter_tls … Hg2 Hg) -Hg <tls_pushs <tls_pushs #Hf
+lapply (at_inv_tls … Hg2) -Hg2 #H
+lapply (coafter_eq_repl_fwd2 … Hf … H) -H -Hf #Hf
+elim (coafter_inv_pnx … Hf) [|*: // ] -Hf #g #Hg #H destruct
+/2 width=3 by ex2_intro/
+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 "ground/relocation/gr_pushs.ma".
+include "ground/relocation/gr_uni.ma".
+(**) (* it should not depend on gr_isi *)
+include "ground/relocation/gr_coafter_isi.ma".
+
+(* RELATIONAL CO-COMPOSITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with uniform relocations and pushs **************************************)
+
+(*** coafter_uni_sn *)
+lemma gr_coafter_uni_sn_pushs (n):
+ ∀f. 𝐮❨n❩ ~⊚ f ≘ ⫯*[n] f.
+#n @(nat_ind_succ … n) -n
+/2 width=5 by gr_coafter_isi_sn, gr_coafter_next/
+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 "ground/xoa/ex_3_2.ma".
+include "ground/notation/relations/ideq_2.ma".
+include "ground/lib/stream_eq.ma".
+include "ground/relocation/gr_map.ma".
+
+(* EXTENSIONAL EQUIVALENCE FOR GENERIC RELOCATION MAPS **********************)
+
+(*** eq *)
+coinductive gr_eq: relation gr_map ≝
+(*** eq_push *)
+| gr_eq_push (f1) (f2) (g1) (g2):
+ gr_eq f1 f2 → ⫯f1 = g1 → ⫯f2 = g2 → gr_eq g1 g2
+(*** eq_next *)
+| gr_eq_next (f1) (f2) (g1) (g2):
+ gr_eq f1 f2 → ↑f1 = g1 → ↑f2 = g2 → gr_eq g1 g2
+.
+
+interpretation
+ "extensional equivalence (generic relocation maps)"
+ 'IdEq f1 f2 = (gr_eq f1 f2).
+
+(*** eq_repl *)
+definition gr_eq_repl (R:relation …) ≝
+ ∀f1,f2. f1 ≡ f2 → R f1 f2.
+
+(*** eq_repl_back *)
+definition gr_eq_repl_back (R:predicate …) ≝
+ ∀f1. R f1 → ∀f2. f1 ≡ f2 → R f2.
+
+(*** eq_repl_fwd *)
+definition gr_eq_repl_fwd (R:predicate …) ≝
+ ∀f1. R f1 → ∀f2. f2 ≡ f1 → R f2.
+
+(* Basic properties *********************************************************)
+
+(*** eq_sym *)
+corec lemma gr_eq_sym: symmetric … gr_eq.
+#f1 #f2 * -f1 -f2
+#f1 #f2 #g1 #g2 #Hf #H1 #H2
+[ @(gr_eq_push … H2 H1) | @(gr_eq_next … H2 H1) ] -g2 -g1 /2 width=1 by/
+qed-.
+
+(*** eq_repl_sym *)
+lemma gr_eq_repl_sym (R):
+ gr_eq_repl_back R → gr_eq_repl_fwd R.
+/3 width=3 by gr_eq_sym/ qed-.
+
+(* Alternative definition with stream_eq (specific) ***************************************************)
+
+alias symbol "subseteq" (instance 1) = "relation inclusion".
+
+corec lemma stream_eq_gr_eq: stream_eq … ⊆ gr_eq.
+* #b1 #f1 * #b2 #f2 #H
+cases (stream_eq_inv_cons_bi … H) -H [|*: // ] * -b2 #Hf
+cases b1 /3 width=5 by gr_eq_next, gr_eq_push/
+qed.
+
+corec lemma gr_eq_inv_stream_eq: gr_eq ⊆ stream_eq ….
+#g1 #g2 * -g1 -g2 #f1 #f2 #g1 #g2 #Hf * * -g1 -g2
+/3 width=1 by stream_eq_cons/
+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 "ground/notation/relations/rfun_c_2.ma".
+include "ground/arith/nat_succ.ma".
+include "ground/relocation/gr_isi.ma".
+
+(* FINITE COLENGTH ASSIGNMENT FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** fcla *)
+inductive gr_fcla: relation2 gr_map nat ≝
+(*** fcla_isid *)
+| gr_fcla_isi (f): 𝐈❪f❫ → gr_fcla f (𝟎)
+(*** fcla_push *)
+| gr_fcla_push (f) (n): gr_fcla f n → gr_fcla (⫯f) n
+(*** fcla_next *)
+| gr_fcla_next (f) (n): gr_fcla f n → gr_fcla (↑f) (↑n)
+.
+
+interpretation
+ "finite colength assignment (generic relocation maps)"
+ 'RFunC f n = (gr_fcla f n).
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** fcla_inv_px *)
+lemma gr_fcla_inv_push (g) (m): 𝐂❪g❫ ≘ m → ∀f. ⫯f = g → 𝐂❪f❫ ≘ m.
+#g #m * -g -m
+[ /3 width=3 by gr_fcla_isi, gr_isi_inv_push/
+| #g #m #Hg #f #H >(eq_inv_gr_push_bi … H) -f //
+| #g #m #_ #f #H elim (eq_inv_gr_push_next … H)
+]
+qed-.
+
+(*** fcla_inv_nx *)
+lemma gr_fcla_inv_next (g) (m): 𝐂❪g❫ ≘ m → ∀f. ↑f = g → ∃∃n. 𝐂❪f❫ ≘ n & ↑n = m.
+#g #m * -g -m
+[ #g #Hg #f #H destruct
+ elim (gr_isi_inv_next … Hg) -Hg //
+| #g #m #_ #f #H elim (eq_inv_gr_next_push … H)
+| #g #m #Hg #f #H >(eq_inv_gr_next_bi … H) -f
+ /2 width=3 by ex2_intro/
+]
+qed-.
+
+(* Advanced inversion lemmas ************************************************)
+
+(*** cla_inv_nn *)
+lemma gr_cla_inv_next_succ (g) (m): 𝐂❪g❫ ≘ m → ∀f,n. ↑f = g → ↑n = m → 𝐂❪f❫ ≘ n.
+#g #m #H #f #n #H1 #H2 elim (gr_fcla_inv_next … H … H1) -g
+#x #Hf #H destruct <(eq_inv_nsucc_bi … H) -n //
+qed-.
+
+(*** cla_inv_np *)
+lemma gr_cla_inv_next_zero (g) (m): 𝐂❪g❫ ≘ m → ∀f. ↑f = g → 𝟎 = m → ⊥.
+#g #m #H #f #H1 elim (gr_fcla_inv_next … H … H1) -g
+#x #_ #H1 #H2 destruct /2 width=2 by eq_inv_zero_nsucc/
+qed-.
+
+(*** fcla_inv_xp *)
+lemma gr_fcla_inv_zero (g) (m): 𝐂❪g❫ ≘ m → 𝟎 = m → 𝐈❪g❫.
+#g #m #H elim H -g -m /3 width=3 by gr_isi_push/
+#g #m #_ #_ #H destruct elim (eq_inv_zero_nsucc … H)
+qed-.
+
+(*** fcla_inv_isid *)
+lemma gr_fcla_inv_isi (g) (m): 𝐂❪g❫ ≘ m → 𝐈❪g❫ → 𝟎 = m.
+#f #n #H elim H -f -n /3 width=3 by gr_isi_inv_push/
+#f #n #_ #_ #H elim (gr_isi_inv_next … H) -H //
+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 "ground/relocation/gr_isi_eq.ma".
+include "ground/relocation/gr_fcla.ma".
+
+(* FINITE COLENGTH ASSIGNMENT FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *********************************************************)
+
+(*** fcla_eq_repl_back *)
+lemma gr_fcla_eq_repl_back (n):
+ gr_eq_repl_back … (λf. 𝐂❪f❫ ≘ n).
+#n #f1 #H elim H -f1 -n /3 width=3 by gr_fcla_isi, gr_isi_eq_repl_back/
+#f1 #n #_ #IH #g2 #H [ elim (gr_eq_inv_push_sn … H) | elim (gr_eq_inv_next_sn … H) ] -H
+/3 width=3 by gr_fcla_push, gr_fcla_next/
+qed-.
+
+(*** fcla_eq_repl_fwd *)
+lemma fcla_eq_repl_fwd (n):
+ gr_eq_repl_fwd … (λf. 𝐂❪f❫ ≘ n).
+#n @gr_eq_repl_sym /2 width=3 by gr_fcla_eq_repl_back/
+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 "ground/relocation/gr_fcla.ma".
+
+(* FINITE COLENGTH ASSIGNMENT FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Main forward lemmas ******************************************************)
+
+(*** fcla_mono *)
+theorem gr_fcla_mono (f):
+ ∀n1. 𝐂❪f❫ ≘ n1 → ∀n2. 𝐂❪f❫ ≘ n2 → n1 = n2.
+#f #n #H elim H -f -n
+[ /2 width=3 by gr_fcla_inv_isi/
+| /3 width=3 by gr_fcla_inv_push/
+| #f #n1 #_ #IH #n2 #H elim (gr_fcla_inv_next … H) -H [2,3 : // ]
+ #g #Hf #H destruct >IH //
+]
+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 "ground/relocation/gr_isi_uni.ma".
+include "ground/relocation/gr_fcla.ma".
+
+(* FINITE COLENGTH ASSIGNMENT FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_uni ***************************)
+
+(*** fcla_uni *)
+lemma gr_fcla_uni (n): 𝐂❪𝐮❨n❩❫ ≘ n.
+#n @(nat_ind_succ … n) -n
+/2 width=1 by gr_fcla_isi, gr_fcla_next/
+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 "ground/notation/functions/element_i_0.ma".
+include "ground/relocation/gr_map.ma".
+
+(* IDENTITY ELEMENT FOR GENERIC RELOCATION MAPS ******************************************************)
+
+(*** id *)
+corec definition gr_id: gr_map ≝ ⫯gr_id.
+
+interpretation
+ "identity element (generic relocation streams)"
+ 'ElementI = (gr_id).
+
+(* Basic properties (specific) *********************************************************)
+
+(*** id_rew *)
+lemma gr_id_unfold: ⫯𝐢 = 𝐢.
+<(stream_unfold … (𝐢)) in ⊢ (???%); //
+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 "ground/relocation/gr_tl_eq.ma".
+include "ground/relocation/gr_id.ma".
+
+(* IDENTITY ELEMENT FOR GENERIC RELOCATION MAPS ******************************************************)
+
+(* Properties with gr_eq *)
+
+corec lemma gr_id_eq (f): ⫯f ≡ f → 𝐢 ≡ f.
+cases gr_id_unfold #Hf
+cases (gr_eq_inv_push_sn … Hf) [|*: // ] #_ #H
+cases H in Hf; -H #Hf
+@gr_eq_push [3:|*: // ]
+/3 width=5 by gr_eq_inv_push_bi/
+qed.
+
+(* Inversions with gr_eq *)
+
+(* Note: this has the same proof of the previous *)
+corec lemma gr_id_inv_eq (f): 𝐢 ≡ f → ⫯f ≡ f.
+cases gr_id_unfold #Hf
+cases (gr_eq_inv_push_sn … Hf) [|*: // ] #_ #H
+cases H in Hf; -H #Hf
+@gr_eq_push [3:|*: // ]
+/3 width=5 by gr_eq_inv_push_bi/
+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 "ground/notation/relations/predicate_omega_1.ma".
+include "ground/relocation/gr_map.ma".
+
+(* DIVERGENCE CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** isdiv *)
+coinductive gr_isd: predicate gr_map ≝
+(*** isdiv_next *)
+| gr_isd_next (f) (g):
+ gr_isd f → ↑f = g → gr_isd g
+.
+
+interpretation
+ "divergence condition (generic relocation maps)"
+ 'PredicateOmega f = (gr_isd f).
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** isdiv_inv_gen *)
+lemma gr_isd_inv_gen (g): 𝛀❪g❫ → ∃∃f. 𝛀❪f❫ & ↑f = g.
+#g * -g
+#f #g #Hf * /2 width=3 by ex2_intro/
+qed-.
+
+(* Advanced inversion lemmas ************************************************)
+
+(*** isdiv_inv_next *)
+lemma gr_isd_inv_next (g): 𝛀❪g❫ → ∀f. ↑f = g → 𝛀❪f❫.
+#g #H elim (gr_isd_inv_gen … H) -H
+#f #Hf * -g #g #H >(eq_inv_gr_next_bi … H) -H //
+qed-.
+
+(*** isdiv_inv_push *)
+lemma gr_isd_inv_push (g): 𝛀❪g❫ → ∀f. ⫯f = g → ⊥.
+#g #H elim (gr_isd_inv_gen … H) -H
+#f #Hf * -g #g #H elim (eq_inv_gr_push_next … H)
+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 "ground/relocation/gr_tl_eq_eq.ma".
+include "ground/relocation/gr_isd.ma".
+
+(* DIVERGENCE CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *********************************************************)
+
+(*** isdiv_eq_repl_back *)
+corec lemma gr_isd_eq_repl_back:
+ gr_eq_repl_back … gr_isd.
+#f1 #H cases (gr_isd_inv_gen … H) -H
+#g1 #Hg1 #H1 #f2 #Hf cases (gr_eq_inv_next_sn … Hf … H1) -f1
+/3 width=3 by gr_isd_next/
+qed-.
+
+(*** isdiv_eq_repl_fwd *)
+lemma gr_isd_eq_repl_fwd:
+ gr_eq_repl_fwd … gr_isd.
+/3 width=3 by gr_isd_eq_repl_back, gr_eq_repl_sym/ qed-.
+
+(* Main inversion lemmas with gr_eq ***************)
+
+(*** isdiv_inv_eq_repl *)
+corec theorem gr_isd_inv_eq_repl (g1) (g2): 𝛀❪g1❫ → 𝛀❪g2❫ → g1 ≡ g2.
+#H1 #H2
+cases (gr_isd_inv_gen … H1) -H1
+cases (gr_isd_inv_gen … H2) -H2
+/3 width=5 by gr_eq_next/
+qed-.
+
+(* Alternative definition with gr_eq ***************************************************)
+
+(*** eq_next_isdiv *)
+corec lemma gr_eq_next_isd (f): ↑f ≡ f → 𝛀❪f❫.
+#H cases (gr_eq_inv_next_sn … H) -H
+/4 width=3 by gr_isd_next, gr_eq_trans/
+qed.
+
+(*** eq_next_inv_isdiv *)
+corec lemma gr_eq_next_inv_isd (g): 𝛀❪g❫ → ↑g ≡ g.
+* -g #f #g #Hf *
+/3 width=5 by gr_eq_next/
+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 "ground/relocation/gr_nexts.ma".
+include "ground/relocation/gr_isd.ma".
+
+(* DIVERGENCE CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with iterated next ********************************************)
+
+(*** isdiv_nexts *)
+lemma gr_isd_nexts (n) (f): 𝛀❪f❫ → 𝛀❪↑*[n]f❫.
+#n @(nat_ind_succ … n) -n /3 width=3 by gr_isd_next/
+qed.
+
+(* Inversion lemmas with iterated next **************************************)
+
+(*** isdiv_inv_nexts *)
+lemma gr_isd_inv_nexts (n) (g): 𝛀❪↑*[n]g❫ → 𝛀❪g❫.
+#n @(nat_ind_succ … n) -n /3 width=3 by gr_isd_inv_next/
+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 "ground/relocation/gr_tl.ma".
+include "ground/relocation/gr_isd.ma".
+
+(* DIVERGENCE CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with tail *****************************************************)
+
+(*** isdiv_tl *)
+lemma gr_isd_tl (f): 𝛀❪f❫ → 𝛀❪⫱f❫.
+#f cases (gr_map_split_tl f) * #H
+[ elim (gr_isd_inv_push … H) -H //
+| /2 width=3 by gr_isd_inv_next/
+]
+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 "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_isd_tl.ma".
+
+(* DIVERGENCE CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with iterated tail ********************************************)
+
+(*** isdiv_tls *)
+lemma gr_isd_tls (n) (g): 𝛀❪g❫ → 𝛀❪⫱*[n]g❫.
+#n @(nat_ind_succ … n) -n /3 width=1 by gr_isd_tl/
+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 "ground/notation/relations/predicate_f_1.ma".
+include "ground/relocation/gr_fcla.ma".
+
+(* FINITE COLENGTH CONDITION FOR GENERIC RELOCATION MAPS *)
+
+(*** isfin *)
+definition gr_isf: predicate gr_map ≝
+ λf. ∃n. 𝐂❪f❫ ≘ n.
+
+interpretation
+ "finite colength condition (generic relocation maps)"
+ 'PredicateF f = (gr_isf f).
+
+(* Basic eliminators ********************************************************)
+
+(*** isfin_ind *)
+lemma gr_isf_ind (Q:predicate …):
+ (∀f. 𝐈❪f❫ → Q f) →
+ (∀f. 𝐅❪f❫ → Q f → Q (⫯f)) →
+ (∀f. 𝐅❪f❫ → Q f → Q (↑f)) →
+ ∀f. 𝐅❪f❫ → Q f.
+#Q #IH1 #IH2 #IH3 #f #H elim H -H
+#n #H elim H -f -n /3 width=2 by ex_intro/
+qed-.
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** isfin_inv_push *)
+lemma gr_isf_inv_push (g): 𝐅❪g❫ → ∀f. ⫯f = g → 𝐅❪f❫.
+#g * /3 width=4 by gr_fcla_inv_push, ex_intro/
+qed-.
+
+(*** isfin_inv_next *)
+lemma gr_isf_inv_next (g): 𝐅❪g❫ → ∀f. ↑f = g → 𝐅❪f❫.
+#g * #n #H #f #H0 elim (gr_fcla_inv_next … H … H0) -g
+/2 width=2 by ex_intro/
+qed-.
+
+(* Basic properties *********************************************************)
+
+(*** isfin_isid *)
+lemma gr_isf_isi (f): 𝐈❪f❫ → 𝐅❪f❫.
+/3 width=2 by gr_fcla_isi, ex_intro/ qed.
+
+(*** isfin_push *)
+lemma gr_isf_push (f): 𝐅❪f❫ → 𝐅❪⫯f❫.
+#f * /3 width=2 by gr_fcla_push, ex_intro/
+qed.
+
+(*** isfin_next *)
+lemma gr_isf_next (f): 𝐅❪f❫ → 𝐅❪↑f❫.
+#f * /3 width=2 by gr_fcla_next, ex_intro/
+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 "ground/relocation/gr_fcla_eq.ma".
+include "ground/relocation/gr_isf.ma".
+
+(* FINITE COLENGTH CONDITION FOR GENERIC RELOCATION MAPS *)
+
+(* Properties with gr_eq *)
+
+(*** isfin_eq_repl_back *)
+lemma gr_isf_eq_repl_back:
+ gr_eq_repl_back … gr_isf.
+#f1 * /3 width=4 by gr_fcla_eq_repl_back, ex_intro/
+qed-.
+
+(*** isfin_eq_repl_fwd *)
+lemma gr_isf_eq_repl_fwd: gr_eq_repl_fwd … gr_isf.
+/3 width=3 by gr_isf_eq_repl_back, gr_eq_repl_sym/ 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 "ground/relocation/gr_isu.ma".
+include "ground/relocation/gr_isf.ma".
+
+(* FINITE COLENGTH CONDITION FOR GENERIC RELOCATION MAPS *)
+
+(* Properties with gr_isu *)
+
+(*** isuni_fwd_isfin *)
+lemma gr_isf_isu (f): 𝐔❪f❫ → 𝐅❪f❫.
+#f #H elim H -f
+/3 width=1 by gr_isf_next, gr_isf_isi/
+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 "ground/relocation/gr_pushs.ma".
+include "ground/relocation/gr_isf.ma".
+
+(* FINITE COLENGTH CONDITION FOR GENERIC RELOCATION MAPS *)
+
+(* Properties with iterated push ********************************************)
+
+(*** isfin_pushs *)
+lemma gr_isf_pushs (n) (f): 𝐅❪f❫ → 𝐅❪⫯*[n]f❫.
+#n @(nat_ind_succ … n) -n /3 width=3 by gr_isf_push/
+qed.
+
+(* Inversion lemmas with iterated push **************************************)
+
+(*** isfin_inv_pushs *)
+lemma gr_isf_inv_pushs (n) (g): 𝐅❪⫯*[n]g❫ → 𝐅❪g❫.
+#n @(nat_ind_succ … n) -n /3 width=3 by gr_isf_inv_push/
+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 "ground/relocation/gr_tl.ma".
+include "ground/relocation/gr_isf.ma".
+
+(* FINITE COLENGTH CONDITION FOR GENERIC RELOCATION MAPS *)
+
+(* Properties with tail *****************************************************)
+
+(*** isfin_tl *)
+lemma gr_isf_tl (f): 𝐅❪f❫ → 𝐅❪⫱f❫.
+#f elim (gr_map_split_tl f) * #Hf
+/3 width=3 by gr_isf_inv_push, gr_isf_inv_next/
+qed.
+
+(* Inversion lemmas with tail ***********************************************)
+
+(*** isfin_inv_tl *)
+lemma gr_isf_inv_tl (g): 𝐅❪⫱g❫ → 𝐅❪g❫.
+#f elim (gr_map_split_tl f) * #Hf
+/2 width=1 by gr_isf_next, gr_isf_push/
+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 "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_isf_tl.ma".
+
+(* FINITE COLENGTH CONDITION FOR GENERIC RELOCATION MAPS *)
+
+(* Properties with iterated tail **************************************)
+
+lemma gr_isf_tls (n) (f): 𝐅❪f❫ → 𝐅❪⫱*[n]f❫.
+#n @(nat_ind_succ … n) -n /3 width=1 by gr_isf_tl/
+qed.
+
+(* Inversion lemmas with iterated tail **************************************)
+
+(*** isfin_inv_tls *)
+lemma gr_isf_inv_tls (n) (g): 𝐅❪⫱*[n]g❫ → 𝐅❪g❫.
+#n @(nat_ind_succ … n) -n /3 width=1 by gr_isf_inv_tl/
+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 "ground/relocation/gr_fcla_uni.ma".
+include "ground/relocation/gr_isf.ma".
+
+(* FINITE COLENGTH CONDITION FOR GENERIC RELOCATION MAPS *)
+
+(* Properties with gr_uni ***************************)
+
+(*** isfin_uni *)
+lemma gr_isf_uni (n): 𝐅❪𝐮❨n❩❫.
+/3 width=2 by ex_intro/ 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 "ground/notation/relations/predicate_i_1.ma".
+include "ground/relocation/gr_map.ma".
+
+(* IDENTITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** isid *)
+coinductive gr_isi: predicate gr_map ≝
+(*** isid_push *)
+| gr_isi_push (f) (g):
+ gr_isi f → ⫯f = g → gr_isi g
+.
+
+interpretation
+ "identity condition (generic relocation maps)"
+ 'PredicateI f = (gr_isi f).
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** isid_inv_gen *)
+lemma gr_isi_inv_gen (g): 𝐈❪g❫ → ∃∃f. 𝐈❪f❫ & ⫯f = g.
+#g * -g
+#f #g #Hf /2 width=3 by ex2_intro/
+qed-.
+
+(* Advanced inversion lemmas ************************************************)
+
+(*** isid_inv_push *)
+lemma gr_isi_inv_push (g): 𝐈❪g❫ → ∀f. ⫯f = g → 𝐈❪f❫.
+#g #H
+elim (gr_isi_inv_gen … H) -H #f #Hf
+* -g #g #H
+>(eq_inv_gr_push_bi … H) -H //
+qed-.
+
+(*** isid_inv_next *)
+lemma gr_isi_inv_next (g): 𝐈❪g❫ → ∀f. ↑f = g → ⊥.
+#g #H
+elim (gr_isi_inv_gen … H) -H #f #Hf
+* -g #g #H elim (eq_inv_gr_next_push … H)
+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 "ground/relocation/gr_tl_eq_eq.ma".
+include "ground/relocation/gr_isi.ma".
+
+(* IDENTITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *********************************************************)
+
+(*** isid_eq_repl_back *)
+corec lemma gr_isi_eq_repl_back:
+ gr_eq_repl_back … gr_isi.
+#f1 #H
+cases (gr_isi_inv_gen … H) -H #g1 #Hg1 #H1 #f2 #Hf
+cases (gr_eq_inv_push_sn … Hf … H1) -f1
+/3 width=3 by gr_isi_push/
+qed-.
+
+(*** isid_eq_repl_fwd *)
+lemma gr_isi_eq_repl_fwd:
+ gr_eq_repl_fwd … gr_isi.
+/3 width=3 by gr_isi_eq_repl_back, gr_eq_repl_sym/ qed-.
+
+(* Main inversion lemmas with gr_eq ****************************************************)
+
+(*** isid_inv_eq_repl *)
+corec theorem gr_isi_inv_eq_repl (g1) (g2): 𝐈❪g1❫ → 𝐈❪g2❫ → g1 ≡ g2.
+#H1 #H2
+cases (gr_isi_inv_gen … H1) -H1
+cases (gr_isi_inv_gen … H2) -H2
+/3 width=5 by gr_eq_push/
+qed-.
+
+(* Alternative definition with gr_eq ***************************************************)
+
+(*** eq_push_isid *)
+corec lemma gr_eq_push_isi (f): ⫯f ≡ f → 𝐈❪f❫.
+#H cases (gr_eq_inv_push_sn … H) -H
+/4 width=3 by gr_isi_push, gr_eq_trans/
+qed.
+
+(*** eq_push_inv_isid *)
+corec lemma gr_isi_inv_eq_push (g): 𝐈❪g❫ → ⫯g ≡ g.
+* -g #f #g #Hf *
+/3 width=5 by gr_eq_push/
+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 "ground/relocation/gr_id.ma".
+include "ground/relocation/gr_isi_eq.ma".
+
+(* IDENTITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_id *********************************************************)
+
+(*** id_isid *)
+lemma gr_isi_id: 𝐈❪𝐢❫.
+/2 width=1 by gr_eq_push_isi/ qed.
+
+(* Alternative definition with gr_id and gr_eq *******************************************)
+
+(*** eq_id_isid *)
+lemma gr_eq_id_isi (f): 𝐢 ≡ f → 𝐈❪f❫.
+/2 width=3 by gr_isi_eq_repl_back/ qed.
+
+(*** eq_id_inv_isid *)
+lemma gr_isi_inv_eq_id (f): 𝐈❪f❫ → 𝐢 ≡ f.
+/2 width=1 by gr_isi_inv_eq_repl/ 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 "ground/relocation/gr_isi_id.ma".
+include "ground/relocation/gr_pat_pat_id.ma".
+
+(* IDENTITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Advanced properties on isid **********************************************)
+
+(*** isid_at *)
+lemma gr_isi_pat (f): (∀i. @❪i,f❫ ≘ i) → 𝐈❪f❫.
+/3 width=1 by gr_eq_id_isi, gr_pat_inv_id/
+qed.
+
+(* Inversion lemmas on pat ****************************************)
+
+(*** isid_inv_at *)
+lemma gr_isi_inv_pat (f) (i): 𝐈❪f❫ → @❪i,f❫ ≘ i.
+/3 width=3 by gr_isi_inv_eq_id, gr_pat_id, gr_pat_eq_repl_back/
+qed-.
+
+(* Destructions with pat *)
+
+(*** isid_inv_at_mono *)
+lemma gr_isi_pat_des (f) (i1) (i2): 𝐈❪f❫ → @❪i1,f❫ ≘ i2 → i1 = i2.
+/4 width=3 by gr_isi_inv_eq_id, gr_pat_id_des, gr_pat_eq_repl_fwd/
+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 "ground/relocation/gr_pushs.ma".
+include "ground/relocation/gr_isi.ma".
+
+(* IDENTITY CONDITION FOR GENERIC RELOCATION MAPS ******************************************************)
+
+(* Properties with gr_pushs *)
+
+(*** isid_pushs *)
+lemma gr_isi_pushs (n) (f): 𝐈❪f❫ → 𝐈❪⫯*[n]f❫.
+#n @(nat_ind_succ … n) -n /3 width=3 by gr_isi_push/
+qed.
+
+(* Inversion lemmas with iterated push **************************************)
+
+(*** isid_inv_pushs *)
+lemma gr_isi_inv_pushs (n) (g): 𝐈❪⫯*[n]g❫ → 𝐈❪g❫.
+#n @(nat_ind_succ … n) -n /3 width=3 by gr_isi_inv_push/
+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 "ground/relocation/gr_tl.ma".
+include "ground/relocation/gr_isi.ma".
+
+(* IDENTITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with tail *****************************************************)
+
+(*** isid_tl *)
+lemma gr_isi_tl (f): 𝐈❪f❫ → 𝐈❪⫱f❫.
+#f cases (gr_map_split_tl f) * #H
+[ /2 width=3 by gr_isi_inv_push/
+| elim (gr_isi_inv_next … H) -H //
+]
+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 "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_isi_tl.ma".
+
+(* IDENTITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with iterated tail ********************************************)
+
+(*** isid_tls *)
+lemma gr_isi_tls (n) (f): 𝐈❪f❫ → 𝐈❪⫱*[n]f❫.
+#n @(nat_ind_succ … n) -n /3 width=1 by gr_isi_tl/
+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 "ground/relocation/gr_uni.ma".
+include "ground/relocation/gr_isi_id.ma".
+
+(* IDENTITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with test for identity ****************************************)
+
+(*** uni_inv_isid uni_isi *)
+lemma gr_uni_isi (f): 𝐮❨𝟎❩ ≡ f → 𝐈❪f❫.
+/2 width=1 by gr_eq_id_isi/ qed.
+
+(* Inversion lemmas with test for identity **********************************)
+
+(*** uni_isid isi_inv_uni *)
+lemma gr_isi_inv_uni (f): 𝐈❪f❫ → 𝐮❨𝟎❩ ≡ f.
+/2 width=1 by gr_isi_inv_eq_id/ 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 "ground/notation/relations/predicate_t_1.ma".
+include "ground/relocation/gr_pat.ma".
+
+(* TOTALITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** istot *)
+definition gr_ist: predicate gr_map ≝
+ λf. ∀i. ∃j. @❪i,f❫ ≘ j.
+
+interpretation
+ "totality condition (generic relocation maps)"
+ 'PredicateT f = (gr_ist f).
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** istot_inv_push *)
+lemma gr_ist_inv_push (g): 𝐓❪g❫ → ∀f. ⫯f = g → 𝐓❪f❫.
+#g #Hg #f #H #i elim (Hg (↑i)) -Hg
+#j #Hg elim (gr_pat_inv_succ_push … Hg … H) -Hg -H /2 width=3 by ex_intro/
+qed-.
+
+(*** istot_inv_next *)
+lemma gr_ist_inv_next (g): 𝐓❪g❫ → ∀f. ↑f = g → 𝐓❪f❫.
+#g #Hg #f #H #i elim (Hg i) -Hg
+#j #Hg elim (gr_pat_inv_next … Hg … H) -Hg -H /2 width=2 by ex_intro/
+qed-.
+
+(* Properties on tl *********************************************************)
+
+(*** istot_tl *)
+lemma gr_ist_tl (f): 𝐓❪f❫ → 𝐓❪⫱f❫.
+#f cases (gr_map_split_tl f) *
+/2 width=3 by gr_ist_inv_next, gr_ist_inv_push/
+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 "ground/relocation/gr_isi_pat.ma".
+include "ground/relocation/gr_ist.ma".
+
+(* TOTALITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Advanced properties on isid **********************************************)
+
+(*** isid_at_total *)
+lemma gr_isi_pat_total: ∀f. 𝐓❪f❫ → (∀i1,i2. @❪i1,f❫ ≘ i2 → i1 = i2) → 𝐈❪f❫.
+#f #H1f #H2f @gr_isi_pat
+#i lapply (H1f i) -H1f *
+#j #Hf >(H2f … Hf) in ⊢ (???%); -H2f //
+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 "ground/relocation/gr_eq.ma".
+include "ground/relocation/gr_pat_lt.ma".
+include "ground/relocation/gr_pat_pat.ma".
+include "ground/relocation/gr_ist.ma".
+
+(* TOTALITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Advanced properties on at ************************************************)
+
+(*** at_dec *)
+lemma gr_pat_dec (f) (i1) (i2): 𝐓❪f❫ → Decidable (@❪i1,f❫ ≘ i2).
+#f #i1 #i2 #Hf lapply (Hf i1) -Hf *
+#j2 #Hf elim (eq_pnat_dec i2 j2)
+[ #H destruct /2 width=1 by or_introl/
+| /4 width=6 by gr_pat_mono, or_intror/
+]
+qed-.
+
+(*** is_at_dec *)
+lemma is_gr_pat_dec (f) (i2): 𝐓❪f❫ → Decidable (∃i1. @❪i1,f❫ ≘ i2).
+#f #i2 #Hf
+lapply (dec_plt (λi1.@❪i1,f❫ ≘ i2) … (↑i2)) [| * ]
+[ /2 width=1 by gr_pat_dec/
+| * /3 width=2 by ex_intro, or_introl/
+| #H @or_intror * #i1 #Hi12
+ /5 width=3 by gr_pat_increasing, plt_succ_dx, ex2_intro/
+]
+qed-.
+
+(* Main forward lemmas on at ************************************************)
+
+(*** at_ext *)
+corec theorem gr_eq_ext_pat (f1) (f2): 𝐓❪f1❫ → 𝐓❪f2❫ →
+ (∀i,i1,i2. @❪i,f1❫ ≘ i1 → @❪i,f2❫ ≘ i2 → i1 = i2) →
+ f1 ≡ f2.
+cases (gr_map_split_tl f1) #H1
+cases (gr_map_split_tl f2) #H2
+#Hf1 #Hf2 #Hi
+[ @(gr_eq_push … H1 H2) @gr_eq_ext_pat -gr_eq_ext_pat
+ [3:|*: /2 width=3 by gr_ist_inv_push/ ] -Hf1 -Hf2 #i #i1 #i2 #Hg1 #Hg2
+ lapply (Hi (↑i) (↑i1) (↑i2) ??) /2 width=7 by gr_pat_push/
+| cases (Hf2 (𝟏)) -Hf1 -Hf2 -gr_eq_ext_pat
+ #j2 #Hf2 cases (gr_pat_increasing_strict … Hf2 … H2) -H2
+ lapply (Hi (𝟏) (𝟏) j2 … Hf2) /2 width=2 by gr_pat_refl/ -Hi -Hf2 -H1
+ #H2 #H cases (plt_ge_false … H) -H //
+| cases (Hf1 (𝟏)) -Hf1 -Hf2 -gr_eq_ext_pat
+ #j1 #Hf1 cases (gr_pat_increasing_strict … Hf1 … H1) -H1
+ lapply (Hi (𝟏) j1 (𝟏) Hf1 ?) /2 width=2 by gr_pat_refl/ -Hi -Hf1 -H2
+ #H1 #H cases (plt_ge_false … H) -H //
+| @(gr_eq_next … H1 H2) @gr_eq_ext_pat -gr_eq_ext_pat
+ [3:|*: /2 width=3 by gr_ist_inv_next/ ] -Hf1 -Hf2 #i #i1 #i2 #Hg1 #Hg2
+ lapply (Hi i (↑i1) (↑i2) ??) /2 width=5 by gr_pat_next/
+]
+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 "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_ist.ma".
+
+(* TOTALITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties on tls ********************************************************)
+
+(*** istot_tls *)
+lemma gr_ist_tls (n) (f): 𝐓❪f❫ → 𝐓❪⫱*[n]f❫.
+#n @(nat_ind_succ … n) -n //
+#n #IH #f #Hf <gr_tls_succ
+/3 width=1 by gr_ist_tl/
+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 "ground/notation/relations/predicate_u_1.ma".
+include "ground/relocation/gr_isi.ma".
+
+(* UNIFORMITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** isuni *)
+inductive gr_isu: predicate gr_map ≝
+(*** isuni_isid *)
+| gr_isu_isi (f): 𝐈❪f❫ → gr_isu f
+(*** isuni_next *)
+| gr_isu_next (f): gr_isu f → ∀g. ↑f = g → gr_isu g
+.
+
+interpretation
+ "uniformity condition (generic relocation maps)"
+ 'PredicateU f = (gr_isu f).
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** isuni_inv_push *)
+lemma gr_isu_inv_push (g): 𝐔❪g❫ → ∀f. ⫯f = g → 𝐈❪f❫.
+#g * -g
+[ /2 width=3 by gr_isi_inv_push/
+| #f #_ #g #H #x #Hx destruct
+ elim (eq_inv_gr_push_next … Hx)
+]
+qed-.
+
+(*** isuni_inv_next *)
+lemma gr_isu_inv_next (g): 𝐔❪g❫ → ∀f. ↑f = g → 𝐔❪f❫.
+#g * -g #f #Hf
+[ #x #Hx elim (gr_isi_inv_next … Hf … Hx)
+| #g #H #x #Hx destruct
+ >(eq_inv_gr_next_bi … Hx) -x //
+]
+qed-.
+
+(* Basic forward lemmas *****************************************************)
+
+(*** isuni_fwd_push *)
+lemma gr_isu_fwd_push (g): 𝐔❪g❫ → ∀f. ⫯f = g → 𝐔❪f❫.
+/3 width=3 by gr_isu_inv_push, gr_isu_isi/ 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 "ground/relocation/gr_tl.ma".
+include "ground/relocation/gr_isu.ma".
+
+(* UNIFORMITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with tail *****************************************************)
+
+lemma gr_isu_tl (f): 𝐔❪f❫ → 𝐔❪⫱f❫.
+#f cases (gr_map_split_tl f) * #H
+[ /3 width=3 by gr_isu_inv_push, gr_isu_isi/
+| /2 width=3 by gr_isu_inv_next/
+]
+qed.
+
+(* Advanced inversion lemmas ***************************************************)
+
+(*** isuni_split *)
+lemma gr_isu_split (g): 𝐔❪g❫ → ∨∨ (∃∃f. 𝐈❪f❫ & ⫯f = g) | (∃∃f.𝐔❪f❫ & ↑f = g).
+#g elim (gr_map_split_tl g) * #H
+/4 width=3 by gr_isu_inv_next, gr_isu_inv_push, or_introl, or_intror, ex2_intro/
+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 "ground/relocation/gr_isi_uni.ma".
+include "ground/relocation/gr_isu.ma".
+
+(* UNIFORMITY CONDITION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_uni **************************************)
+
+(*** isuni_uni *)
+lemma gr_isu_uni (n): 𝐔❪𝐮❨n❩❫.
+#n @(nat_ind_succ … n) -n
+/3 width=3 by gr_isu_isi, gr_isu_next/
+qed.
+
+(*** uni_inv_isuni *)
+lemma gr_isu_eq_repl_back:
+ gr_eq_repl_back … gr_isu.
+#f1 #H elim H -f1
+[ /3 width=3 by gr_isu_isi, gr_isi_eq_repl_back/
+| #f1 #_ #g1 * #IH #f2 #H -g1
+ elim (gr_eq_inv_next_sn … H) -H
+ /3 width=3 by gr_isu_next/
+]
+qed-.
+
+lemma gr_isu_eq_repl_fwd:
+ gr_eq_repl_fwd … gr_isu.
+/3 width=3 by gr_isu_eq_repl_back, gr_eq_repl_sym/ qed-.
+
+(* Inversion lemmas with gr_uni ********************************)
+
+(*** uni_isuni *)
+lemma gr_isu_inv_uni (f): 𝐔❪f❫ → ∃n. 𝐮❨n❩ ≡ f.
+#f #H elim H -f
+[ /3 width=2 by gr_isi_inv_uni, ex_intro/
+| #f #_ #g #H * /3 width=6 by gr_eq_next, ex_intro/
+]
+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 "ground/notation/functions/upspoon_1.ma".
+include "ground/notation/functions/uparrow_1.ma".
+include "ground/lib/stream.ma".
+include "ground/lib/bool.ma".
+
+(* GENERIC RELOCATION MAPS **************************************************)
+
+(*** rtmap *)
+definition gr_map: Type[0] ≝ stream bool.
+
+(*** push *)
+definition gr_push (f): gr_map ≝ Ⓕ⨮f.
+
+interpretation
+ "push (generic relocation maps)"
+ 'UpSpoon f = (gr_push f).
+
+(*** next *)
+definition gr_next (f): gr_map ≝ Ⓣ⨮f.
+
+interpretation
+ "next (generic relocation maps)"
+ 'UpArrow f = (gr_next f).
+
+(* Basic properties (specific) **********************************************)
+
+(*** push_rew *)
+lemma gr_push_unfold (f): Ⓕ⨮f = ⫯f.
+// qed.
+
+(*** next_rew *)
+lemma gr_next_unfold (f): Ⓣ⨮f = ↑f.
+// qed.
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** injective_push *)
+lemma eq_inv_gr_push_bi: injective ? ? gr_push.
+#f1 #f2 <gr_push_unfold <gr_push_unfold #H destruct //
+qed-.
+
+(*** discr_push_next *)
+lemma eq_inv_gr_push_next (f1) (f2): ⫯f1 = ↑f2 → ⊥.
+#f1 #f2 <gr_push_unfold <gr_next_unfold #H destruct
+qed-.
+
+(*** discr_next_push *)
+lemma eq_inv_gr_next_push (f1) (f2): ↑f1 = ⫯f2 → ⊥.
+#f1 #f2 <gr_next_unfold <gr_push_unfold #H destruct
+qed-.
+
+(*** injective_next *)
+lemma eq_inv_gr_next_bi: injective ? ? gr_next.
+#f1 #f2 <gr_next_unfold <gr_next_unfold #H destruct //
+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 "ground/notation/relations/ratsucc_3.ma".
+include "ground/arith/nat_pred_succ.ma".
+include "ground/relocation/gr_pat.ma".
+
+(* NON-NEGATIVE APPLICATION FOR GENERIC RELOCATION MAPS *****************************)
+
+definition gr_nat: relation3 gr_map nat nat ≝
+ λf,l1,l2. @❪↑l1,f❫ ≘ ↑l2.
+
+interpretation
+ "relational non-negative application (generic relocation maps)"
+ 'RAtSucc l1 f l2 = (gr_nat f l1 l2).
+
+(* Basic properties *********************************************************)
+
+lemma gr_nat_refl (f) (g) (k1) (k2):
+ (⫯f) = g → 𝟎 = k1 → 𝟎 = k2 → @↑❪k1,g❫ ≘ k2.
+#f #g #k1 #k2 #H1 #H2 #H3 destruct
+/2 width=2 by gr_pat_refl/
+qed.
+
+lemma gr_nat_push (f) (l1) (l2) (g) (k1) (k2):
+ @↑❪l1,f❫ ≘ l2 → ⫯f = g → ↑l1 = k1 → ↑l2 = k2 → @↑❪k1,g❫ ≘ k2.
+#f #l1 #l2 #g #k1 #k2 #Hf #H1 #H2 #H3 destruct
+/2 width=7 by gr_pat_push/
+qed.
+
+lemma gr_nat_next (f) (l1) (l2) (g) (k2):
+ @↑❪l1,f❫ ≘ l2 → ↑f = g → ↑l2 = k2 → @↑❪l1,g❫ ≘ k2.
+#f #l1 #l2 #g #k2 #Hf #H1 #H2 destruct
+/2 width=5 by gr_pat_next/
+qed.
+
+lemma gr_nat_pred_bi (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → @↑❪↓i1,f❫ ≘ ↓i2.
+#f #i1 #i2
+>(npsucc_pred i1) in ⊢ (%→?); >(npsucc_pred i2) in ⊢ (%→?);
+//
+qed.
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** gr_nat_inv_ppx *)
+lemma gr_nat_inv_zero_push (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀g. 𝟎 = l1 → ⫯g = f → 𝟎 = l2.
+#f #l1 #l2 #H #g #H1 #H2 destruct
+lapply (gr_pat_inv_unit_push … H ???) -H
+/2 width=2 by eq_inv_npsucc_bi/
+qed-.
+
+(*** gr_nat_inv_npx *)
+lemma gr_nat_inv_succ_push (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀g,k1. ↑k1 = l1 → ⫯g = f →
+ ∃∃k2. @↑❪k1,g❫ ≘ k2 & ↑k2 = l2.
+#f #l1 #l2 #H #g #k1 #H1 #H2 destruct
+elim (gr_pat_inv_succ_push … H) -H [|*: // ] #k2 #Hg
+>(npsucc_pred (↑l2)) #H
+@(ex2_intro … (↓k2)) //
+qed-.
+
+(*** gr_nat_inv_xnx *)
+lemma gr_nat_inv_next (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀g. ↑g = f →
+ ∃∃k2. @↑❪l1,g❫ ≘ k2 & ↑k2 = l2.
+#f #l1 #l2 #H #g #H1 destruct
+elim (gr_pat_inv_next … H) -H [|*: // ] #k2
+>(npsucc_pred (k2)) in ⊢ (%→?→?); #Hg #H
+@(ex2_intro … (↓k2)) //
+qed-.
+
+(* Advanced inversion lemmas ************************************************)
+
+(*** gr_nat_inv_ppn *)
+lemma gr_nat_inv_zero_push_succ (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀g,k2. 𝟎 = l1 → ⫯g = f → ↑k2 = l2 → ⊥.
+#f #l1 #l2 #Hf #g #k2 #H1 #H <(gr_nat_inv_zero_push … Hf … H1 H) -f -g -l1 -l2
+/2 width=3 by eq_inv_nsucc_zero/
+qed-.
+
+(*** gr_nat_inv_npp *)
+lemma gr_nat_inv_succ_push_zero (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀g,k1. ↑k1 = l1 → ⫯g = f → 𝟎 = l2 → ⊥.
+#f #l1 #l2 #Hf #g #k1 #H1 #H elim (gr_nat_inv_succ_push … Hf … H1 H) -f -l1
+#x2 #Hg * -l2 /2 width=3 by eq_inv_zero_nsucc/
+qed-.
+
+(*** gr_nat_inv_npn *)
+lemma gr_nat_inv_succ_push_succ (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀g,k1,k2. ↑k1 = l1 → ⫯g = f → ↑k2 = l2 → @↑❪k1,g❫ ≘ k2.
+#f #l1 #l2 #Hf #g #k1 #k2 #H1 #H elim (gr_nat_inv_succ_push … Hf … H1 H) -f -l1
+#x2 #Hg * -l2 #H >(eq_inv_nsucc_bi … H) -k2 //
+qed-.
+
+(*** gr_nat_inv_xnp *)
+lemma gr_nat_inv_next_zero (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀g. ↑g = f → 𝟎 = l2 → ⊥.
+#f #l1 #l2 #Hf #g #H elim (gr_nat_inv_next … Hf … H) -f
+#x2 #Hg * -l2 /2 width=3 by eq_inv_zero_nsucc/
+qed-.
+
+(*** gr_nat_inv_xnn *)
+lemma gr_nat_inv_next_succ (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀g,k2. ↑g = f → ↑k2 = l2 → @↑❪l1,g❫ ≘ k2.
+#f #l1 #l2 #Hf #g #k2 #H elim (gr_nat_inv_next … Hf … H) -f
+#x2 #Hg * -l2 #H >(eq_inv_nsucc_bi … H) -k2 //
+qed-.
+
+(*** gr_nat_inv_pxp *)
+lemma gr_nat_inv_zero_bi (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → 𝟎 = l1 → 𝟎 = l2 → ∃g. ⫯g = f.
+#f elim (gr_map_split_tl … f) /2 width=2 by ex_intro/
+#H #l1 #l2 #Hf #H1 #H2 cases (gr_nat_inv_next_zero … Hf … H H2)
+qed-.
+
+(*** gr_nat_inv_pxn *)
+lemma gr_nat_inv_zero_succ (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀k2. 𝟎 = l1 → ↑k2 = l2 →
+ ∃∃g. @↑❪l1,g❫ ≘ k2 & ↑g = f.
+#f elim (gr_map_split_tl … f)
+#H #l1 #l2 #Hf #k2 #H1 #H2
+[ elim (gr_nat_inv_zero_push_succ … Hf … H1 H H2)
+| /3 width=5 by gr_nat_inv_next_succ, ex2_intro/
+]
+qed-.
+
+(*** gr_nat_inv_nxp *)
+lemma gr_nat_inv_succ_zero (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀k1. ↑k1 = l1 → 𝟎 = l2 → ⊥.
+#f elim (gr_map_split_tl f)
+#H #l1 #l2 #Hf #k1 #H1 #H2
+[ elim (gr_nat_inv_succ_push_zero … Hf … H1 H H2)
+| elim (gr_nat_inv_next_zero … Hf … H H2)
+]
+qed-.
+
+(*** gr_nat_inv_nxn *)
+lemma gr_nat_inv_succ_bi (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀k1,k2. ↑k1 = l1 → ↑k2 = l2 →
+ ∨∨ ∃∃g. @↑❪k1,g❫ ≘ k2 & ⫯g = f
+ | ∃∃g. @↑❪l1,g❫ ≘ k2 & ↑g = f.
+#f elim (gr_map_split_tl f) *
+/4 width=7 by gr_nat_inv_next_succ, gr_nat_inv_succ_push_succ, ex2_intro, or_intror, or_introl/
+qed-.
+
+(* Note: the following inversion lemmas must be checked *)
+(*** gr_nat_inv_xpx *)
+lemma gr_nat_inv_push (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀g. ⫯g = f →
+ ∨∨ ∧∧ 𝟎 = l1 & 𝟎 = l2
+ | ∃∃k1,k2. @↑❪k1,g❫ ≘ k2 & ↑k1 = l1 & ↑k2 = l2.
+#f * [2: #l1 ] #l2 #Hf #g #H
+[ elim (gr_nat_inv_succ_push … Hf … H) -f /3 width=5 by or_intror, ex3_2_intro/
+| >(gr_nat_inv_zero_push … Hf … H) -f /3 width=1 by conj, or_introl/
+]
+qed-.
+
+(*** gr_nat_inv_xpp *)
+lemma gr_nat_inv_push_zero (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀g. ⫯g = f → 𝟎 = l2 → 𝟎 = l1.
+#f #l1 #l2 #Hf #g #H elim (gr_nat_inv_push … Hf … H) -f * //
+#k1 #k2 #_ #_ * -l2 #H elim (eq_inv_zero_nsucc … H)
+qed-.
+
+(*** gr_nat_inv_xpn *)
+lemma gr_nat_inv_push_succ (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → ∀g,k2. ⫯g = f → ↑k2 = l2 →
+ ∃∃k1. @↑❪k1,g❫ ≘ k2 & ↑k1 = l1.
+#f #l1 #l2 #Hf #g #k2 #H elim (gr_nat_inv_push … Hf … H) -f *
+[ #_ * -l2 #H elim (eq_inv_nsucc_zero … H)
+| #x1 #x2 #Hg #H1 * -l2 #H
+ lapply (eq_inv_nsucc_bi … H) -H #H destruct
+ /2 width=3 by ex2_intro/
+]
+qed-.
+
+(*** gr_nat_inv_xxp *)
+lemma gr_nat_inv_zero_dx (f) (l1) (l2):
+ @↑❪l1,f❫ ≘ l2 → 𝟎 = l2 → ∃∃g. 𝟎 = l1 & ⫯g = f.
+#f elim (gr_map_split_tl f)
+#H #l1 #l2 #Hf #H2
+[ /3 width=6 by gr_nat_inv_push_zero, ex2_intro/
+| elim (gr_nat_inv_next_zero … Hf … H H2)
+]
+qed-.
+
+(*** gr_nat_inv_xxn *)
+lemma gr_nat_inv_succ_dx (f) (l1) (l2): @↑❪l1,f❫ ≘ l2 → ∀k2. ↑k2 = l2 →
+ ∨∨ ∃∃g,k1. @↑❪k1,g❫ ≘ k2 & ↑k1 = l1 & ⫯g = f
+ | ∃∃g. @↑❪l1,g❫ ≘ k2 & ↑g = f.
+#f elim (gr_map_split_tl f)
+#H #l1 #l2 #Hf #k2 #H2
+[ elim (gr_nat_inv_push_succ … Hf … H H2) -l2 /3 width=5 by or_introl, ex3_2_intro/
+| lapply (gr_nat_inv_next_succ … Hf … H H2) -l2 /3 width=3 by or_intror, ex2_intro/
+]
+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 "ground/relocation/gr_basic.ma".
+include "ground/relocation/gr_nat_uni.ma".
+
+(* NON-NEGATIVE APPLICATION FOR GENERIC RELOCATION MAPS *****************************)
+
+(* Properties with gr_basic **********************************************)
+
+lemma gr_nat_basic_lt (m) (n) (l):
+ l < m → @↑❪l, 𝐛❨m,n❩❫ ≘ l.
+#m @(nat_ind_succ … m) -m
+[ #n #i #H elim (nlt_inv_zero_dx … H)
+| #m #IH #n #l @(nat_ind_succ … l) -l
+ [ #_ /2 width=2 by refl, gr_pat_refl/
+ | #l #_ #H
+ lapply (nlt_inv_succ_bi … H) -H #Hlm
+ /3 width=7 by refl, gr_pat_push/
+ ]
+]
+qed.
+
+lemma gr_nat_basic_ge (m) (n) (l):
+ m ≤ l → @↑❪l, 𝐛❨m,n❩❫ ≘ l+n.
+#m @(nat_ind_succ … m) -m //
+#m #IH #n #l #H
+elim (nle_inv_succ_sn … H) -H #Hml #H >H -H
+/3 width=7 by gr_nat_push/
+qed.
+
+(* Inversion lemmas with gr_basic ****************************************)
+
+lemma gr_nat_basic_inv_lt (m) (n) (l) (k):
+ l < m → @↑❪l, 𝐛❨m,n❩❫ ≘ k → l = k.
+/3 width=4 by gr_nat_basic_lt, gr_nat_mono/ qed-.
+
+lemma gr_nat_basic_inv_ge (m) (n) (l) (k):
+ m ≤ l → @↑❪l, 𝐛❨m,n❩❫ ≘ k → l+n = k.
+/3 width=4 by gr_nat_basic_ge, gr_nat_mono/ 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 "ground/arith/nat_lt_pred.ma".
+include "ground/relocation/gr_nat.ma".
+
+(* NON-NEGATIVE APPLICATION FOR GENERIC RELOCATION MAPS *****************************)
+
+(* Main destructions ********************************************************)
+
+theorem gr_nat_monotonic (k2) (l2) (f):
+ @↑❪l2,f❫ ≘ k2 → ∀k1,l1. @↑❪l1,f❫ ≘ k1 → l1 < l2 → k1 < k2.
+#k2 @(nat_ind_succ … k2) -k2
+[ #l2 #f #H2f elim (gr_nat_inv_zero_dx … H2f) -H2f //
+ #g #H21 #_ #k1 #l1 #_ #Hi destruct
+ elim (nlt_inv_zero_dx … Hi)
+| #k2 #IH #l2 #f #H2f #k1 @(nat_ind_succ … k1) -k1 //
+ #k1 #_ #l1 #H1f #Hl elim (nlt_inv_gen … Hl)
+ #_ #Hl2 elim (gr_nat_inv_succ_bi … H2f (↓l2)) -H2f [1,3: * |*: // ]
+ #g #H2g #H
+ [ elim (gr_nat_inv_push_succ … H1f … H) -f
+ /4 width=8 by nlt_inv_succ_bi, nlt_succ_bi/
+ | /4 width=8 by gr_nat_inv_next_succ, nlt_succ_bi/
+ ]
+]
+qed-.
+
+theorem gr_nat_inv_monotonic (k1) (l1) (f):
+ @↑❪l1,f❫ ≘ k1 → ∀k2,l2. @↑❪l2,f❫ ≘ k2 → k1 < k2 → l1 < l2.
+#k1 @(nat_ind_succ … k1) -k1
+[ #l1 #f #H1f elim (gr_nat_inv_zero_dx … H1f) -H1f //
+ #g * -l1 #H #k2 #l2 #H2f #Hk
+ lapply (nlt_des_gen … Hk) -Hk #H22
+ elim (gr_nat_inv_push_succ … H2f … (↓k2) H) -f //
+| #k1 #IH #l1 @(nat_ind_succ … l1) -l1
+ [ #f #H1f elim (gr_nat_inv_zero_succ … H1f) -H1f [ |*: // ]
+ #g #H1g #H #k2 #l2 #H2f #Hj elim (nlt_inv_succ_sn … Hj) -Hj
+ /3 width=7 by gr_nat_inv_next_succ/
+ | #l1 #_ #f #H1f #k2 #l2 #H2f #Hj elim (nlt_inv_succ_sn … Hj) -Hj
+ #Hj #H22 elim (gr_nat_inv_succ_bi … H1f) -H1f [1,4: * |*: // ]
+ #g #Hg #H
+ [ elim (gr_nat_inv_push_succ … H2f … (↓k2) H) -f
+ /3 width=7 by nlt_succ_bi/
+ | /3 width=7 by gr_nat_inv_next_succ/
+ ]
+ ]
+]
+qed-.
+
+theorem gr_nat_mono (f) (l) (l1) (l2):
+ @↑❪l,f❫ ≘ l1 → @↑❪l,f❫ ≘ l2 → l2 = l1.
+#f #l #l1 #l2 #H1 #H2 elim (nat_split_lt_eq_gt l2 l1) //
+#Hi elim (nlt_ge_false l l)
+/2 width=6 by gr_nat_inv_monotonic/
+qed-.
+
+theorem gr_nat_inj (f) (l1) (l2) (l):
+ @↑❪l1,f❫ ≘ l → @↑❪l2,f❫ ≘ l → l1 = l2.
+#f #l1 #l2 #l #H1 #H2 elim (nat_split_lt_eq_gt l2 l1) //
+#Hi elim (nlt_ge_false l l)
+/2 width=6 by gr_nat_monotonic/
+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 "ground/arith/nat_plus_rplus.ma".
+include "ground/relocation/gr_pat_uni.ma".
+include "ground/relocation/gr_nat_nat.ma".
+
+(* NON-NEGATIVE APPLICATION FOR GENERIC RELOCATION MAPS *****************************)
+
+(* Properties with uniform relocations **************************************)
+
+lemma gr_nat_uni (n) (l):
+ @↑❪l,𝐮❨n❩❫ ≘ l+n.
+/2 width=1 by gr_nat_pred_bi/
+qed.
+
+(* Inversion lemmas with uniform relocations ********************************)
+
+lemma gr_nat_inv_uni (n) (l) (k):
+ @↑❪l,𝐮❨n❩❫ ≘ k → k = l+n.
+/2 width=4 by gr_nat_mono/ 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 "ground/notation/functions/uparrowstar_2.ma".
+include "ground/arith/nat_succ_iter.ma".
+include "ground/relocation/gr_map.ma".
+
+(* ITERATED NEXT FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** nexts *)
+definition gr_nexts (f:gr_map) (n:nat) ≝
+ (gr_next^n) f.
+
+interpretation
+ "iterated next (generic relocation maps)"
+ 'UpArrowStar n f = (gr_nexts f n).
+
+(* Basic properties *********************************************************)
+
+(*** nexts_O *)
+lemma gr_nexts_zero:
+ ∀f. f = ↑*[𝟎] f.
+// qed.
+
+(*** nexts_swap *)
+lemma gr_nexts_next (n):
+ ∀f. ↑↑*[n] f = ↑*[n] ↑f.
+#f #n @(niter_appl … gr_next)
+qed.
+
+(*** nexts_S *)
+lemma gr_nexts_succ (n):
+ ∀f. ↑↑*[n] f = ↑*[↑n] f.
+#f #n @(niter_succ … gr_next)
+qed.
+
+(*** nexts_xn *)
+lemma gr_nexts_swap (n):
+ ∀f. ↑*[n] ↑f = ↑*[↑n] f.
+// 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 "ground/relocation/gr_eq.ma".
+include "ground/relocation/gr_nexts.ma".
+
+(* ITERATED NEXT FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq ******************************************************)
+
+(*** nexts_eq_repl *)
+lemma gr_nexts_eq_repl (n):
+ gr_eq_repl (λf1,f2. ↑*[n] f1 ≡ ↑*[n] f2).
+#n @(nat_ind_succ … n) -n
+/3 width=5 by gr_eq_next/
+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 "ground/notation/relations/rat_3.ma".
+include "ground/xoa/ex_3_2.ma".
+include "ground/arith/pnat.ma".
+include "ground/relocation/gr_tl.ma".
+
+(* POSITIVE APPLICATION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** at *)
+coinductive gr_pat: relation3 gr_map pnat pnat ≝
+(*** at_refl *)
+| gr_pat_refl (f) (g) (j1) (j2):
+ ⫯f = g → 𝟏 = j1 → 𝟏 = j2 → gr_pat g j1 j2
+(*** at_push *)
+| gr_pat_push (f) (i1) (i2):
+ gr_pat f i1 i2 → ∀g,j1,j2. ⫯f = g → ↑i1 = j1 → ↑i2 = j2 → gr_pat g j1 j2
+(*** at_next *)
+| gr_pat_next (f) (i1) (i2):
+ gr_pat f i1 i2 → ∀g,j2. ↑f = g → ↑i2 = j2 → gr_pat g i1 j2
+.
+
+interpretation
+ "relational positive application (generic relocation maps)"
+ 'RAt i1 f i2 = (gr_pat f i1 i2).
+
+(*** H_at_div *)
+definition H_gr_pat_div: relation4 gr_map gr_map gr_map gr_map ≝
+ λf2,g2,f1,g1.
+ ∀jf,jg,j. @❪jf,f2❫ ≘ j → @❪jg,g2❫ ≘ j →
+ ∃∃j0. @❪j0,f1❫ ≘ jf & @❪j0,g1❫ ≘ jg.
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** at_inv_ppx *)
+lemma gr_pat_inv_unit_push (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀g. 𝟏 = i1 → ⫯g = f → 𝟏 = i2.
+#f #i1 #i2 * -f -i1 -i2 //
+[ #f #i1 #i2 #_ #g #j1 #j2 #_ * #_ #x #H destruct
+| #f #i1 #i2 #_ #g #j2 * #_ #x #_ #H elim (eq_inv_gr_push_next … H)
+]
+qed-.
+
+(*** at_inv_npx *)
+lemma gr_pat_inv_succ_push (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀g,j1. ↑j1 = i1 → ⫯g = f →
+ ∃∃j2. @❪j1,g❫ ≘ j2 & ↑j2 = i2.
+#f #i1 #i2 * -f -i1 -i2
+[ #f #g #j1 #j2 #_ * #_ #x #x1 #H destruct
+| #f #i1 #i2 #Hi #g #j1 #j2 * * * #x #x1 #H #Hf >(eq_inv_gr_push_bi … Hf) -g destruct /2 width=3 by ex2_intro/
+| #f #i1 #i2 #_ #g #j2 * #_ #x #x1 #_ #H elim (eq_inv_gr_push_next … H)
+]
+qed-.
+
+(*** at_inv_xnx *)
+lemma gr_pat_inv_next (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀g. ↑g = f →
+ ∃∃j2. @❪i1,g❫ ≘ j2 & ↑j2 = i2.
+#f #i1 #i2 * -f -i1 -i2
+[ #f #g #j1 #j2 * #_ #_ #x #H elim (eq_inv_gr_next_push … H)
+| #f #i1 #i2 #_ #g #j1 #j2 * #_ #_ #x #H elim (eq_inv_gr_next_push … H)
+| #f #i1 #i2 #Hi #g #j2 * * #x #H >(eq_inv_gr_next_bi … H) -g /2 width=3 by ex2_intro/
+]
+qed-.
+
+(* Advanced inversion lemmas ************************************************)
+
+(*** at_inv_ppn *)
+lemma gr_pat_inv_unit_push_succ (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀g,j2. 𝟏 = i1 → ⫯g = f → ↑j2 = i2 → ⊥.
+#f #i1 #i2 #Hf #g #j2 #H1 #H <(gr_pat_inv_unit_push … Hf … H1 H) -f -g -i1 -i2
+#H destruct
+qed-.
+
+(*** at_inv_npp *)
+lemma gr_pat_inv_succ_push_unit (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀g,j1. ↑j1 = i1 → ⫯g = f → 𝟏 = i2 → ⊥.
+#f #i1 #i2 #Hf #g #j1 #H1 #H elim (gr_pat_inv_succ_push … Hf … H1 H) -f -i1
+#x2 #Hg * -i2 #H destruct
+qed-.
+
+(*** at_inv_npn *)
+lemma gr_pat_inv_succ_push_succ (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀g,j1,j2. ↑j1 = i1 → ⫯g = f → ↑j2 = i2 → @❪j1,g❫ ≘ j2.
+#f #i1 #i2 #Hf #g #j1 #j2 #H1 #H elim (gr_pat_inv_succ_push … Hf … H1 H) -f -i1
+#x2 #Hg * -i2 #H destruct //
+qed-.
+
+(*** at_inv_xnp *)
+lemma gr_pat_inv_next_unit (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀g. ↑g = f → 𝟏 = i2 → ⊥.
+#f #i1 #i2 #Hf #g #H elim (gr_pat_inv_next … Hf … H) -f
+#x2 #Hg * -i2 #H destruct
+qed-.
+
+(*** at_inv_xnn *)
+lemma gr_pat_inv_next_succ (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀g,j2. ↑g = f → ↑j2 = i2 → @❪i1,g❫ ≘ j2.
+#f #i1 #i2 #Hf #g #j2 #H elim (gr_pat_inv_next … Hf … H) -f
+#x2 #Hg * -i2 #H destruct //
+qed-.
+
+(*** at_inv_pxp *)
+lemma gr_pat_inv_unit_bi (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → 𝟏 = i1 → 𝟏 = i2 → ∃g. ⫯g = f.
+#f elim (gr_map_split_tl … f) /2 width=2 by ex_intro/
+#H #i1 #i2 #Hf #H1 #H2 cases (gr_pat_inv_next_unit … Hf … H H2)
+qed-.
+
+(*** at_inv_pxn *)
+lemma gr_pat_inv_unit_succ (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀j2. 𝟏 = i1 → ↑j2 = i2 →
+ ∃∃g. @❪i1,g❫ ≘ j2 & ↑g = f.
+#f elim (gr_map_split_tl … f)
+#H #i1 #i2 #Hf #j2 #H1 #H2
+[ elim (gr_pat_inv_unit_push_succ … Hf … H1 H H2)
+| /3 width=5 by gr_pat_inv_next_succ, ex2_intro/
+]
+qed-.
+
+(*** at_inv_nxp *)
+lemma gr_pat_inv_succ_unit (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀j1. ↑j1 = i1 → 𝟏 = i2 → ⊥.
+#f elim (gr_map_split_tl f)
+#H #i1 #i2 #Hf #j1 #H1 #H2
+[ elim (gr_pat_inv_succ_push_unit … Hf … H1 H H2)
+| elim (gr_pat_inv_next_unit … Hf … H H2)
+]
+qed-.
+
+(*** at_inv_nxn *)
+lemma gr_pat_inv_succ_bi (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀j1,j2. ↑j1 = i1 → ↑j2 = i2 →
+ ∨∨ ∃∃g. @❪j1,g❫ ≘ j2 & ⫯g = f
+ | ∃∃g. @❪i1,g❫ ≘ j2 & ↑g = f.
+#f elim (gr_map_split_tl f) *
+/4 width=7 by gr_pat_inv_next_succ, gr_pat_inv_succ_push_succ, ex2_intro, or_intror, or_introl/
+qed-.
+
+(* Note: the following inversion lemmas must be checked *)
+(*** at_inv_xpx *)
+lemma gr_pat_inv_push (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀g. ⫯g = f →
+ ∨∨ ∧∧ 𝟏 = i1 & 𝟏 = i2
+ | ∃∃j1,j2. @❪j1,g❫ ≘ j2 & ↑j1 = i1 & ↑j2 = i2.
+#f * [2: #i1 ] #i2 #Hf #g #H
+[ elim (gr_pat_inv_succ_push … Hf … H) -f /3 width=5 by or_intror, ex3_2_intro/
+| >(gr_pat_inv_unit_push … Hf … H) -f /3 width=1 by conj, or_introl/
+]
+qed-.
+
+(*** at_inv_xpp *)
+lemma gr_pat_inv_push_unit (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀g. ⫯g = f → 𝟏 = i2 → 𝟏 = i1.
+#f #i1 #i2 #Hf #g #H elim (gr_pat_inv_push … Hf … H) -f * //
+#j1 #j2 #_ #_ * -i2 #H destruct
+qed-.
+
+(*** at_inv_xpn *)
+lemma gr_pat_inv_push_succ (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀g,j2. ⫯g = f → ↑j2 = i2 →
+ ∃∃j1. @❪j1,g❫ ≘ j2 & ↑j1 = i1.
+#f #i1 #i2 #Hf #g #j2 #H elim (gr_pat_inv_push … Hf … H) -f *
+[ #_ * -i2 #H destruct
+| #x1 #x2 #Hg #H1 * -i2 #H destruct /2 width=3 by ex2_intro/
+]
+qed-.
+
+(*** at_inv_xxp *)
+lemma gr_pat_inv_unit_dx (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → 𝟏 = i2 →
+ ∃∃g. 𝟏 = i1 & ⫯g = f.
+#f elim (gr_map_split_tl f)
+#H #i1 #i2 #Hf #H2
+[ /3 width=6 by gr_pat_inv_push_unit, ex2_intro/
+| elim (gr_pat_inv_next_unit … Hf … H H2)
+]
+qed-.
+
+(*** at_inv_xxn *)
+lemma gr_pat_inv_succ_dx (f) (i1) (i2):
+ @❪i1,f❫ ≘ i2 → ∀j2. ↑j2 = i2 →
+ ∨∨ ∃∃g,j1. @❪j1,g❫ ≘ j2 & ↑j1 = i1 & ⫯g = f
+ | ∃∃g. @❪i1,g❫ ≘ j2 & ↑g = f.
+#f elim (gr_map_split_tl f)
+#H #i1 #i2 #Hf #j2 #H2
+[ elim (gr_pat_inv_push_succ … Hf … H H2) -i2 /3 width=5 by or_introl, ex3_2_intro/
+| lapply (gr_pat_inv_next_succ … Hf … H H2) -i2 /3 width=3 by or_intror, ex2_intro/
+]
+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 "ground/relocation/gr_nat_basic.ma".
+
+(* POSITIVE APPLICATION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_basic **********************************************)
+
+(*** at_basic_lt *)
+lemma gr_pat_basic_lt (m) (n) (i):
+ ninj i ≤ m → @❪i, 𝐛❨m,n❩❫ ≘ i.
+#m #n #i >(npsucc_pred i) #Hmi
+/2 width=1 by gr_nat_basic_lt/
+qed.
+
+(*** at_basic_ge *)
+lemma gr_pat_basic_ge (m) (n) (i):
+ m < ninj i → @❪i, 𝐛❨m,n❩❫ ≘ i+n.
+#m #n #i >(npsucc_pred i) #Hmi <nrplus_npsucc_sn
+/3 width=1 by gr_nat_basic_ge, nlt_inv_succ_dx/
+qed.
+
+(* Inversion lemmas with gr_basic ****************************************)
+
+(*** at_basic_inv_lt *)
+lemma gr_pat_basic_inv_lt (m) (n) (i) (j):
+ ninj i ≤ m → @❪i, 𝐛❨m,n❩❫ ≘ j → i = j.
+/3 width=4 by gr_pat_basic_lt, gr_pat_mono/ qed-.
+
+(*** at_basic_inv_ge *)
+lemma gr_pat_basic_inv_ge (m) (n) (i) (j):
+ m < ninj i → @❪i, 𝐛❨m,n❩❫ ≘ j → i+n = j.
+/3 width=4 by gr_pat_basic_ge, gr_pat_mono/ 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 "ground/relocation/gr_tl_eq.ma".
+include "ground/relocation/gr_pat_lt.ma".
+
+(* POSITIVE APPLICATION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *)
+
+(*** at_eq_repl_back *)
+corec lemma gr_pat_eq_repl_back (i1) (i2):
+ gr_eq_repl_back (λf. @❪i1,f❫ ≘ i2).
+#f1 * -f1 -i1 -i2
+[ #f1 #g1 #j1 #j2 #H #H1 #H2 #f2 #H12
+ cases (gr_eq_inv_push_sn … H12 … H) -g1 /2 width=2 by gr_pat_refl/
+| #f1 #i1 #i2 #Hf1 #g1 #j1 #j2 #H #H1 #H2 #f2 #H12
+ cases (gr_eq_inv_push_sn … H12 … H) -g1 /3 width=7 by gr_pat_push/
+| #f1 #i1 #i2 #Hf1 #g1 #j2 #H #H2 #f2 #H12
+ cases (gr_eq_inv_next_sn … H12 … H) -g1 /3 width=5 by gr_pat_next/
+]
+qed-.
+
+(*** at_eq_repl_fwd *)
+lemma gr_pat_eq_repl_fwd (i1) (i2):
+ gr_eq_repl_fwd (λf. @❪i1,f❫ ≘ i2).
+#i1 #i2 @gr_eq_repl_sym /2 width=3 by gr_pat_eq_repl_back/
+qed-.
+
+lemma gr_pat_eq (f): ⫯f ≡ f → ∀i. @❪i,f❫ ≘ i.
+#f #Hf #i elim i -i
+[ /3 width=3 by gr_pat_eq_repl_back, gr_pat_refl/
+| /3 width=7 by gr_pat_eq_repl_back, gr_pat_push/
+]
+qed.
+
+(* Inversions with gr_eq *)
+
+corec lemma gr_pat_inv_eq (f):
+ (∀i. @❪i,f❫ ≘ i) → ⫯f ≡ f.
+#Hf
+lapply (Hf (𝟏)) #H
+lapply (gr_pat_des_id … H) -H #H
+cases H in Hf; -H #Hf
+@gr_eq_push [3:|*: // ]
+/3 width=7 by gr_pat_inv_succ_push_succ/
+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 "ground/relocation/gr_id_eq.ma".
+include "ground/relocation/gr_pat_eq.ma".
+
+(* POSITIVE APPLICATION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties on id ************************************************)
+
+(*** id_at *)
+lemma gr_pat_id (i): @❪i,𝐢❫ ≘ i.
+/2 width=1 by gr_pat_eq, gr_eq_refl/ qed.
+
+(* Inversions with id *)
+
+(*** id_inv_at *)
+lemma gr_pat_inv_id (f):
+ (∀i. @❪i,f❫ ≘ i) → 𝐢 ≡ f.
+/3 width=1 by gr_pat_inv_eq, gr_id_eq/
+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 "ground/arith/pnat_pred.ma".
+include "ground/arith/pnat_lt.ma".
+include "ground/relocation/gr_pat.ma".
+
+(* POSITIVE APPLICATION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Forward lemmas with plt and ple *****************************************************)
+
+(*** at_increasing *)
+lemma gr_pat_increasing (i2) (i1) (f):
+ @❪i1,f❫ ≘ i2 → i1 ≤ i2.
+#i2 elim i2 -i2
+[ #i1 #f #Hf elim (gr_pat_inv_unit_dx … Hf) -Hf //
+| #i2 #IH * //
+ #i1 #f #Hf elim (gr_pat_inv_succ_bi … Hf) -Hf [1,4: * |*: // ]
+ /3 width=2 by ple_succ_bi, ple_succ_dx/
+]
+qed-.
+
+(*** at_increasing_strict *)
+lemma gr_pat_increasing_strict (g) (i1) (i2):
+ @❪i1,g❫ ≘ i2 → ∀f. ↑f = g →
+ ∧∧ i1 < i2 & @❪i1,f❫ ≘ ↓i2.
+#g #i1 #i2 #Hg #f #H elim (gr_pat_inv_next … Hg … H) -Hg -H
+/4 width=2 by conj, gr_pat_increasing, ple_succ_bi/
+qed-.
+
+(*** at_fwd_id_ex *)
+lemma gr_pat_des_id (f) (i): @❪i,f❫ ≘ i → ⫯⫱f = f.
+#f elim (gr_map_split_tl f) //
+#H #i #Hf elim (gr_pat_inv_next … Hf … H) -Hf -H
+#j2 #Hg #H destruct lapply (gr_pat_increasing … Hg) -Hg
+#H elim (plt_ge_false … H) -H //
+qed-.
+
+(* Properties with ple *********************************************************)
+
+(*** at_le_ex *)
+lemma gr_pat_le_ex (j2) (i2) (f):
+ @❪i2,f❫ ≘ j2 → ∀i1. i1 ≤ i2 →
+ ∃∃j1. @❪i1,f❫ ≘ j1 & j1 ≤ j2.
+#j2 elim j2 -j2 [2: #j2 #IH ] #i2 #f #Hf
+[ elim (gr_pat_inv_succ_dx … Hf) -Hf [1,3: * |*: // ]
+ #g [ #x2 ] #Hg [ #H2 ] #H0
+ [ * /3 width=3 by gr_pat_refl, ex2_intro/
+ #i1 #Hi12 destruct lapply (ple_inv_succ_bi … Hi12) -Hi12
+ #Hi12 elim (IH … Hg … Hi12) -x2 -IH
+ /3 width=7 by gr_pat_push, ex2_intro, ple_succ_bi/
+ | #i1 #Hi12 elim (IH … Hg … Hi12) -IH -i2
+ /3 width=5 by gr_pat_next, ex2_intro, ple_succ_bi/
+ ]
+| elim (gr_pat_inv_unit_dx … Hf) -Hf //
+ #g * -i2 #H2 #i1 #Hi12 <(ple_inv_unit_dx … Hi12)
+ /3 width=3 by gr_pat_refl, ex2_intro/
+]
+qed-.
+
+(*** at_id_le *)
+lemma gr_pat_id_le (i1) (i2):
+ i1 ≤ i2 → ∀f. @❪i2,f❫ ≘ i2 → @❪i1,f❫ ≘ i1.
+#i1 #i2 #H
+@(ple_ind_alt … H) -i1 -i2 [ #i2 | #i1 #i2 #_ #IH ] #f #Hf
+lapply (gr_pat_des_id … Hf) #H <H in Hf; -H
+/4 width=7 by gr_pat_inv_succ_push_succ, gr_pat_push, gr_pat_refl/
+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 "ground/arith/pnat_lt_pred.ma".
+include "ground/relocation/gr_pat.ma".
+
+(* POSITIVE APPLICATION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Main properties **********************************************************)
+
+(*** at_monotonic *)
+theorem gr_pat_monotonic:
+ ∀j2,i2,f. @❪i2,f❫ ≘ j2 → ∀j1,i1. @❪i1,f❫ ≘ j1 →
+ i1 < i2 → j1 < j2.
+#j2 elim j2 -j2
+[ #i2 #f #H2f elim (gr_pat_inv_unit_dx … H2f) -H2f //
+ #g #H21 #_ #j1 #i1 #_ #Hi elim (plt_ge_false … Hi) -Hi //
+| #j2 #IH #i2 #f #H2f * //
+ #j1 #i1 #H1f #Hi elim (plt_inv_gen … Hi)
+ #_ #Hi2 elim (gr_pat_inv_succ_bi … H2f (↓i2)) -H2f [1,3: * |*: // ]
+ #g #H2g #H
+ [ elim (gr_pat_inv_push_succ … H1f … H) -f
+ /4 width=8 by plt_inv_succ_bi, plt_succ_bi/
+ | /4 width=8 by gr_pat_inv_next_succ, plt_succ_bi/
+ ]
+]
+qed-.
+
+(*** at_inv_monotonic *)
+theorem gr_pat_inv_monotonic:
+ ∀j1,i1,f. @❪i1,f❫ ≘ j1 → ∀j2,i2. @❪i2,f❫ ≘ j2 →
+ j1 < j2 → i1 < i2.
+#j1 elim j1 -j1
+[ #i1 #f #H1f elim (gr_pat_inv_unit_dx … H1f) -H1f //
+ #g * -i1 #H #j2 #i2 #H2f #Hj lapply (plt_des_gen … Hj) -Hj
+ #H22 elim (gr_pat_inv_push_succ … H2f … (↓j2) H) -f //
+| #j1 #IH *
+ [ #f #H1f elim (gr_pat_inv_unit_succ … H1f) -H1f [ |*: // ]
+ #g #H1g #H #j2 #i2 #H2f #Hj elim (plt_inv_succ_sn … Hj) -Hj
+ /3 width=7 by gr_pat_inv_next_succ/
+ | #i1 #f #H1f #j2 #i2 #H2f #Hj elim (plt_inv_succ_sn … Hj) -Hj
+ #Hj #H22 elim (gr_pat_inv_succ_bi … H1f) -H1f [1,4: * |*: // ]
+ #g #Hg #H
+ [ elim (gr_pat_inv_push_succ … H2f … (↓j2) H) -f
+ /3 width=7 by plt_succ_bi/
+ | /3 width=7 by gr_pat_inv_next_succ/
+ ]
+ ]
+]
+qed-.
+
+(*** at_mono *)
+theorem gr_pat_mono (f) (i):
+ ∀i1. @❪i,f❫ ≘ i1 → ∀i2. @❪i,f❫ ≘ i2 → i2 = i1.
+#f #i #i1 #H1 #i2 #H2 elim (pnat_split_lt_eq_gt i2 i1) //
+#Hi elim (plt_ge_false i i)
+/2 width=6 by gr_pat_inv_monotonic/
+qed-.
+
+(*** at_inj *)
+theorem gr_pat_inj (f) (i):
+ ∀i1. @❪i1,f❫ ≘ i → ∀i2. @❪i2,f❫ ≘ i → i1 = i2.
+#f #i #i1 #H1 #i2 #H2 elim (pnat_split_lt_eq_gt i2 i1) //
+#Hi elim (plt_ge_false i i)
+/2 width=6 by gr_pat_monotonic/
+qed-.
+
+(*** at_div_comm *)
+theorem gr_pat_div_comm (f2) (g2) (f1) (g1):
+ H_gr_pat_div f2 g2 f1 g1 → H_gr_pat_div g2 f2 g1 f1.
+#f2 #g2 #f1 #g1 #IH #jg #jf #j #Hg #Hf
+elim (IH … Hf Hg) -IH -j /2 width=3 by ex2_intro/
+qed-.
+
+(*** at_div_pp *)
+theorem gr_pat_div_push_bi (f2) (g2) (f1) (g1):
+ H_gr_pat_div f2 g2 f1 g1 → H_gr_pat_div (⫯f2) (⫯g2) (⫯f1) (⫯g1).
+#f2 #g2 #f1 #g1 #IH #jf #jg #j #Hf #Hg
+elim (gr_pat_inv_push … Hf) -Hf [1,2: * |*: // ]
+[ #H1 #H2 destruct -IH
+ lapply (gr_pat_inv_push_unit … Hg ???) -Hg [4: |*: // ] #H destruct
+ /3 width=3 by gr_pat_refl, ex2_intro/
+| #xf #i #Hf2 #H1 #H2 destruct
+ lapply (gr_pat_inv_push_succ … Hg ????) -Hg [5: * |*: // ] #xg #Hg2 #H destruct
+ elim (IH … Hf2 Hg2) -IH -i /3 width=9 by gr_pat_push, ex2_intro/
+]
+qed-.
+
+(*** at_div_nn *)
+theorem gr_pat_div_next_bi (f2) (g2) (f1) (g1):
+ H_gr_pat_div f2 g2 f1 g1 → H_gr_pat_div (↑f2) (↑g2) (f1) (g1).
+#f2 #g2 #f1 #g1 #IH #jf #jg #j #Hf #Hg
+elim (gr_pat_inv_next … Hf) -Hf [ |*: // ] #i #Hf2 #H destruct
+lapply (gr_pat_inv_next_succ … Hg ????) -Hg [5: |*: // ] #Hg2
+elim (IH … Hf2 Hg2) -IH -i /2 width=3 by ex2_intro/
+qed-.
+
+(*** at_div_np *)
+theorem gr_pat_div_next_push (f2) (g2) (f1) (g1):
+ H_gr_pat_div f2 g2 f1 g1 → H_gr_pat_div (↑f2) (⫯g2) (f1) (↑g1).
+#f2 #g2 #f1 #g1 #IH #jf #jg #j #Hf #Hg
+elim (gr_pat_inv_next … Hf) -Hf [ |*: // ] #i #Hf2 #H destruct
+lapply (gr_pat_inv_push_succ … Hg ????) -Hg [5: * |*: // ] #xg #Hg2 #H destruct
+elim (IH … Hf2 Hg2) -IH -i /3 width=7 by gr_pat_next, ex2_intro/
+qed-.
+
+(*** at_div_pn *)
+theorem gr_pat_div_push_next (f2) (g2) (f1) (g1):
+ H_gr_pat_div f2 g2 f1 g1 → H_gr_pat_div (⫯f2) (↑g2) (↑f1) (g1).
+/4 width=6 by gr_pat_div_next_push, gr_pat_div_comm/ 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 "ground/relocation/gr_pat_id.ma".
+include "ground/relocation/gr_pat_pat.ma".
+
+(* POSITIVE APPLICATION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Advanced Forward lemmas on id ********************************************)
+
+(*** at_id_fwd *)
+lemma gr_pat_id_des (i1) (i2):
+ @❪i1,𝐢❫ ≘ i2 → i1 = i2.
+/2 width=4 by gr_pat_mono/ qed-.
+
+(* Main properties on id ****************************************************)
+
+(*** at_div_id_dx *)
+theorem gr_pat_div_id_dx (f):
+ H_gr_pat_div f 𝐢 𝐢 f.
+#f #jf #j0 #j #Hf #H0
+lapply (gr_pat_id_des … H0) -H0 #H destruct
+/2 width=3 by ex2_intro/
+qed-.
+
+(*** at_div_id_sn *)
+theorem gr_pat_div_id_sn (f):
+ H_gr_pat_div 𝐢 f f 𝐢.
+/3 width=6 by gr_pat_div_id_dx, gr_pat_div_comm/ 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 "ground/arith/pnat_plus.ma".
+include "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_pat_eq.ma".
+
+(* POSITIVE APPLICATION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties on tls ********************************************************)
+
+(* Note: this requires ↑ on first n *)
+(*** at_pxx_tls *)
+lemma gr_pat_unit_succ_tls (n) (f):
+ @❪𝟏,f❫ ≘ ↑n → @❪𝟏,⫱*[n]f❫ ≘ 𝟏.
+#n @(nat_ind_succ … n) -n //
+#n #IH #f #Hf
+elim (gr_pat_inv_unit_succ … Hf) -Hf [|*: // ] #g #Hg #H0 destruct
+<gr_tls_swap /2 width=1 by/
+qed.
+
+(* Note: this requires ↑ on third n2 *)
+(*** at_tls *)
+lemma gr_pat_tls (n2) (f): ⫯⫱*[↑n2]f ≡ ⫱*[n2]f → ∃i1. @❪i1,f❫ ≘ ↑n2.
+#n2 @(nat_ind_succ … n2) -n2
+[ /4 width=4 by gr_pat_eq_repl_back, gr_pat_refl, ex_intro/
+| #n2 #IH #f <gr_tls_swap <gr_tls_swap in ⊢ (??%→?); #H
+ elim (IH … H) -IH -H #i1 #Hf
+ elim (gr_map_split_tl f) #Hg destruct
+ /3 width=8 by gr_pat_push, gr_pat_next, ex_intro/
+]
+qed-.
+
+(* Inversion lemmas with tls ************************************************)
+
+(* Note: this does not require ↑ on second and third p *)
+(*** at_inv_nxx *)
+lemma gr_pat_inv_succ_sn (p) (g) (i1) (j2):
+ @❪↑i1,g❫ ≘ j2 → @❪𝟏,g❫ ≘ p →
+ ∃∃i2. @❪i1,⫱*[p]g❫ ≘ i2 & p+i2 = j2.
+#p elim p -p
+[ #g #i1 #j2 #Hg #H
+ elim (gr_pat_inv_unit_bi … H) -H [|*: // ] #f #H0
+ elim (gr_pat_inv_succ_push … Hg … H0) -Hg [|*: // ] #x2 #Hf #H2 destruct
+ /2 width=3 by ex2_intro/
+| #p #IH #g #i1 #j2 #Hg #H
+ elim (gr_pat_inv_unit_succ … H) -H [|*: // ] #f #Hf2 #H0
+ elim (gr_pat_inv_next … Hg … H0) -Hg #x2 #Hf1 #H2 destruct
+ elim (IH … Hf1 Hf2) -IH -Hf1 -Hf2 #i2 #Hf #H2 destruct
+ /2 width=3 by ex2_intro/
+]
+qed-.
+
+(* Note: this requires ↑ on first n2 *)
+(*** at_inv_tls *)
+lemma gr_pat_inv_succ_dx_tls (n2) (i1) (f):
+ @❪i1,f❫ ≘ ↑n2 → ⫯⫱*[↑n2]f ≡ ⫱*[n2]f.
+#n2 @(nat_ind_succ … n2) -n2
+[ #i1 #f #Hf elim (gr_pat_inv_unit_dx … Hf) -Hf // #g #H1 #H destruct
+ /2 width=1 by gr_eq_refl/
+| #n2 #IH #i1 #f #Hf
+ elim (gr_pat_inv_succ_dx … Hf) -Hf [1,3: * |*: // ]
+ [ #g #j1 #Hg #H1 #H2 | #g #Hg #Ho ] destruct
+ <gr_tls_swap /2 width=2 by/
+]
+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 "ground/arith/nat_rplus_succ.ma".
+include "ground/relocation/gr_uni.ma".
+include "ground/relocation/gr_pat_pat_id.ma".
+
+(* POSITIVE APPLICATION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with uniform relocations **************************************)
+
+(*** at_uni *)
+lemma gr_pat_uni (n) (i):
+ @❪i,𝐮❨n❩❫ ≘ i+n.
+#n @(nat_ind_succ … n) -n
+/2 width=5 by gr_pat_next/
+qed.
+
+(* Inversion lemmas with uniform relocations ********************************)
+
+(*** at_inv_uni *)
+lemma gr_pat_inv_uni (n) (i) (j):
+ @❪i,𝐮❨n❩❫ ≘ j → j = i+n.
+/2 width=4 by gr_pat_mono/ 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 "ground/notation/functions/upspoonstar_2.ma".
+include "ground/arith/nat_succ_iter.ma".
+include "ground/relocation/gr_map.ma".
+
+(* ITERATED PUSH FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** pushs *)
+definition gr_pushs (f:gr_map) (n:nat) ≝
+ (gr_push^n) f.
+
+interpretation
+ "iterated push (generic relocation maps)"
+ 'UpSpoonStar n f = (gr_pushs f n).
+
+(* Basic properties *********************************************************)
+
+(*** pushs_O *)
+lemma gr_pushs_zero:
+ ∀f. f = ⫯*[𝟎] f.
+// qed.
+
+(*** push_swap *)
+lemma gr_pushs_push (n):
+ ∀f. ⫯⫯*[n] f = ⫯*[n] ⫯f.
+#n #f @(niter_appl … gr_push)
+qed.
+
+(*** pushs_S *)
+lemma gr_pushs_succ (n):
+ ∀f. ⫯⫯*[n] f = ⫯*[↑n] f.
+#f #n @(niter_succ … gr_push)
+qed.
+
+(*** pushs_xn *)
+lemma gr_pushs_swap (n):
+ ∀f. ⫯*[n] ⫯f = ⫯*[↑n] f.
+// 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 "ground/relocation/gr_eq.ma".
+include "ground/relocation/gr_pushs.ma".
+
+(* ITERATED PUSH FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *)
+
+(*** pushs_eq_repl *)
+lemma gr_pushs_eq_repl (n):
+ gr_eq_repl (λf1,f2. ⫯*[n] f1 ≡ ⫯*[n] f2).
+#n @(nat_ind_succ … n) -n
+/3 width=5 by gr_eq_push/
+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 "ground/notation/relations/rintersection_3.ma".
+include "ground/relocation/gr_tl.ma".
+
+(* RELATIONAL INTERSECTION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** sand *)
+coinductive gr_sand: relation3 gr_map gr_map gr_map ≝
+(*** sand_pp *)
+| gr_sand_push_bi (f1) (f2) (f) (g1) (g2) (g):
+ gr_sand f1 f2 f → ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → gr_sand g1 g2 g
+(*** sand_np *)
+| gr_sand_next_push (f1) (f2) (f) (g1) (g2) (g):
+ gr_sand f1 f2 f → ↑f1 = g1 → ⫯f2 = g2 → ⫯f = g → gr_sand g1 g2 g
+(*** sand_pn *)
+| gr_sand_push_next (f1) (f2) (f) (g1) (g2) (g):
+ gr_sand f1 f2 f → ⫯f1 = g1 → ↑f2 = g2 → ⫯f = g → gr_sand g1 g2 g
+(*** sand_nn *)
+| gr_sand_next_bi (f1) (f2) (f) (g1) (g2) (g):
+ gr_sand f1 f2 f → ↑f1 = g1 → ↑f2 = g2 → ↑f = g → gr_sand g1 g2 g
+.
+
+interpretation
+ "relational intersection (generic relocation maps)"
+ 'RIntersection f1 f2 f = (gr_sand f1 f2 f).
+
+(* Basic properties *********************************************************)
+
+(*** sand_refl *)
+corec lemma gr_sand_idem:
+ ∀f. f ⋒ f ≘ f.
+#f cases (gr_map_split_tl f) #H
+[ @(gr_sand_push_bi … H H H)
+| @(gr_sand_next_bi … H H H)
+] -H //
+qed.
+
+(*** sand_sym *)
+corec lemma gr_sand_comm:
+ ∀f1,f2,f. f1 ⋒ f2 ≘ f → f2 ⋒ f1 ≘ f.
+#f1 #f2 #f * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf * * * -g1 -g2 -g
+[ @gr_sand_push_bi
+| @gr_sand_push_next
+| @gr_sand_next_push
+| @gr_sand_next_bi
+] /2 width=7 by/
+qed-.
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** sand_inv_ppx *)
+lemma gr_sand_inv_push_bi:
+ ∀g1,g2,g. g1 ⋒ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 →
+ ∃∃f. f1 ⋒ f2 ≘ f & ⫯f = g.
+#g1 #g2 #g * -g1 -g2 -g
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
+try (>(eq_inv_gr_push_bi … Hx1) -x1) try (>(eq_inv_gr_next_bi … Hx1) -x1)
+try elim (eq_inv_gr_push_next … Hx1) try elim (eq_inv_gr_next_push … Hx1)
+try (>(eq_inv_gr_push_bi … Hx2) -x2) try (>(eq_inv_gr_next_bi … Hx2) -x2)
+try elim (eq_inv_gr_push_next … Hx2) try elim (eq_inv_gr_next_push … Hx2)
+/2 width=3 by ex2_intro/
+qed-.
+
+(*** sand_inv_npx *)
+lemma gr_sand_inv_next_push:
+ ∀g1,g2,g. g1 ⋒ g2 ≘ g → ∀f1,f2. ↑f1 = g1 → ⫯f2 = g2 →
+ ∃∃f. f1 ⋒ f2 ≘ f & ⫯f = g.
+#g1 #g2 #g * -g1 -g2 -g
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
+try (>(eq_inv_gr_push_bi … Hx1) -x1) try (>(eq_inv_gr_next_bi … Hx1) -x1)
+try elim (eq_inv_gr_push_next … Hx1) try elim (eq_inv_gr_next_push … Hx1)
+try (>(eq_inv_gr_push_bi … Hx2) -x2) try (>(eq_inv_gr_next_bi … Hx2) -x2)
+try elim (eq_inv_gr_push_next … Hx2) try elim (eq_inv_gr_next_push … Hx2)
+/2 width=3 by ex2_intro/
+qed-.
+
+(*** sand_inv_pnx *)
+lemma gr_sand_inv_push_next:
+ ∀g1,g2,g. g1 ⋒ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 →
+ ∃∃f. f1 ⋒ f2 ≘ f & ⫯f = g.
+#g1 #g2 #g * -g1 -g2 -g
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
+try (>(eq_inv_gr_push_bi … Hx1) -x1) try (>(eq_inv_gr_next_bi … Hx1) -x1)
+try elim (eq_inv_gr_push_next … Hx1) try elim (eq_inv_gr_next_push … Hx1)
+try (>(eq_inv_gr_push_bi … Hx2) -x2) try (>(eq_inv_gr_next_bi … Hx2) -x2)
+try elim (eq_inv_gr_push_next … Hx2) try elim (eq_inv_gr_next_push … Hx2)
+/2 width=3 by ex2_intro/
+qed-.
+
+(*** sand_inv_nnx *)
+lemma gr_sand_inv_next_bi:
+ ∀g1,g2,g. g1 ⋒ g2 ≘ g → ∀f1,f2. ↑f1 = g1 → ↑f2 = g2 →
+ ∃∃f. f1 ⋒ f2 ≘ f & ↑f = g.
+#g1 #g2 #g * -g1 -g2 -g
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
+try (>(eq_inv_gr_push_bi … Hx1) -x1) try (>(eq_inv_gr_next_bi … Hx1) -x1)
+try elim (eq_inv_gr_push_next … Hx1) try elim (eq_inv_gr_next_push … Hx1)
+try (>(eq_inv_gr_push_bi … Hx2) -x2) try (>(eq_inv_gr_next_bi … Hx2) -x2)
+try elim (eq_inv_gr_push_next … Hx2) try elim (eq_inv_gr_next_push … Hx2)
+/2 width=3 by ex2_intro/
+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 "ground/relocation/gr_tl_eq.ma".
+include "ground/relocation/gr_sand.ma".
+
+(* RELATIONAL INTERSECTION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *)
+
+(*** sand_eq_repl_back1 *)
+corec lemma gr_sand_eq_repl_back_sn:
+ ∀f2,f. gr_eq_repl_back … (λf1. f1 ⋒ f2 ≘ f).
+#f2 #f #f1 * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x #Hx
+try cases (gr_eq_inv_push_sn … Hx … H1) try cases (gr_eq_inv_next_sn … Hx … H1) -g1
+/3 width=7 by gr_sand_push_bi, gr_sand_next_push, gr_sand_push_next, gr_sand_next_bi/
+qed-.
+
+(*** sand_eq_repl_fwd1 *)
+lemma gr_sand_eq_repl_fwd_sn:
+ ∀f2,f. gr_eq_repl_fwd … (λf1. f1 ⋒ f2 ≘ f).
+#f2 #f @gr_eq_repl_sym /2 width=3 by gr_sand_eq_repl_back_sn/
+qed-.
+
+(*** sand_eq_repl_back2 *)
+corec lemma gr_sand_eq_repl_back_dx:
+ ∀f1,f. gr_eq_repl_back … (λf2. f1 ⋒ f2 ≘ f).
+#f1 #f #f2 * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf #H #H2 #H0 #x #Hx
+try cases (gr_eq_inv_push_sn … Hx … H2) try cases (gr_eq_inv_next_sn … Hx … H2) -g2
+/3 width=7 by gr_sand_push_bi, gr_sand_next_push, gr_sand_push_next, gr_sand_next_bi/
+qed-.
+
+(*** sand_eq_repl_fwd2 *)
+lemma sand_eq_repl_fwd_dx:
+ ∀f1,f. gr_eq_repl_fwd … (λf2. f1 ⋒ f2 ≘ f).
+#f1 #f @gr_eq_repl_sym /2 width=3 by gr_sand_eq_repl_back_dx/
+qed-.
+
+(*** sand_eq_repl_back3 *)
+corec lemma gr_sand_eq_repl_back:
+ ∀f1,f2. gr_eq_repl_back … (λf. f1 ⋒ f2 ≘ f).
+#f1 #f2 #f * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf #H #H2 #H0 #x #Hx
+try cases (gr_eq_inv_push_sn … Hx … H0) try cases (gr_eq_inv_next_sn … Hx … H0) -g
+/3 width=7 by gr_sand_push_bi, gr_sand_next_push, gr_sand_push_next, gr_sand_next_bi/
+qed-.
+
+(*** sand_eq_repl_fwd3 *)
+lemma gr_sand_eq_repl_fwd:
+ ∀f1,f2. gr_eq_repl_fwd … (λf. f1 ⋒ f2 ≘ f).
+#f1 #f2 @gr_eq_repl_sym /2 width=3 by gr_sand_eq_repl_back/
+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 "ground/notation/relations/parallel_2.ma".
+include "ground/relocation/gr_tl.ma".
+
+(* DISJOINTNESS FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** sdj *)
+coinductive gr_sdj: relation gr_map ≝
+(*** sdj_pp *)
+| gr_sdj_push_bi (f1) (f2) (g1) (g2):
+ gr_sdj f1 f2 → ⫯f1 = g1 → ⫯f2 = g2 → gr_sdj g1 g2
+(*** sdj_np *)
+| gr_sdj_next_push (f1) (f2) (g1) (g2):
+ gr_sdj f1 f2 → ↑f1 = g1 → ⫯f2 = g2 → gr_sdj g1 g2
+(*** sdj_pn *)
+| gr_sdj_push_next (f1) (f2) (g1) (g2):
+ gr_sdj f1 f2 → ⫯f1 = g1 → ↑f2 = g2 → gr_sdj g1 g2
+.
+
+interpretation
+ "disjointness (generic relocation maps)"
+ 'Parallel f1 f2 = (gr_sdj f1 f2).
+
+(* Basic properties *********************************************************)
+
+(*** sdj_sym *)
+corec lemma gr_sdj_sym:
+ symmetric … gr_sdj.
+#f1 #f2 * -f1 -f2
+#f1 #f2 #g1 #g2 #Hf #H1 #H2
+[ @(gr_sdj_push_bi … H2 H1)
+| @(gr_sdj_push_next … H2 H1)
+| @(gr_sdj_next_push … H2 H1)
+] -g2 -g1
+/2 width=1 by/
+qed-.
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** sdj_inv_pp *)
+lemma gr_sdj_inv_push_bi:
+ ∀g1,g2. g1 ∥ g2 → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 → f1 ∥ f2.
+#g1 #g2 * -g1 -g2
+#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #x2 #Hx1 #Hx2 destruct
+[ lapply (eq_inv_gr_push_bi … Hx1) -Hx1
+ lapply (eq_inv_gr_push_bi … Hx2) -Hx2 //
+| elim (eq_inv_gr_push_next … Hx1)
+| elim (eq_inv_gr_push_next … Hx2)
+]
+qed-.
+
+(*** sdj_inv_np *)
+lemma gr_sdj_inv_next_push:
+ ∀g1,g2. g1 ∥ g2 → ∀f1,f2. ↑f1 = g1 → ⫯f2 = g2 → f1 ∥ f2.
+#g1 #g2 * -g1 -g2
+#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #x2 #Hx1 #Hx2 destruct
+[ elim (eq_inv_gr_next_push … Hx1)
+| lapply (eq_inv_gr_next_bi … Hx1) -Hx1
+ lapply (eq_inv_gr_push_bi … Hx2) -Hx2 //
+| elim (eq_inv_gr_push_next … Hx2)
+]
+qed-.
+
+(*** sdj_inv_pn *)
+lemma gr_sdj_inv_push_next:
+ ∀g1,g2. g1 ∥ g2 → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 → f1 ∥ f2.
+#g1 #g2 * -g1 -g2
+#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #x2 #Hx1 #Hx2 destruct
+[ elim (eq_inv_gr_next_push … Hx2)
+| elim (eq_inv_gr_push_next … Hx1)
+| lapply (eq_inv_gr_push_bi … Hx1) -Hx1
+ lapply (eq_inv_gr_next_bi … Hx2) -Hx2 //
+]
+qed-.
+
+(*** sdj_inv_nn *)
+lemma gr_sdj_inv_next_bi:
+ ∀g1,g2. g1 ∥ g2 → ∀f1,f2. ↑f1 = g1 → ↑f2 = g2 → ⊥.
+#g1 #g2 * -g1 -g2
+#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #x2 #Hx1 #Hx2 destruct
+[ elim (eq_inv_gr_next_push … Hx1)
+| elim (eq_inv_gr_next_push … Hx2)
+| elim (eq_inv_gr_next_push … Hx1)
+]
+qed-.
+
+(* Advanced inversion lemmas ************************************************)
+
+(*** sdj_inv_nx *)
+lemma gr_sdj_inv_next_sn:
+ ∀g1,g2. g1 ∥ g2 → ∀f1. ↑f1 = g1 →
+ ∃∃f2. f1 ∥ f2 & ⫯f2 = g2.
+#g1 #g2 elim (gr_map_split_tl g2) #H2 #H #f1 #H1
+[ lapply (gr_sdj_inv_next_push … H … H1 H2) -H /2 width=3 by ex2_intro/
+| elim (gr_sdj_inv_next_bi … H … H1 H2)
+]
+qed-.
+
+(*** sdj_inv_xn *)
+lemma gr_sdj_inv_next_dx:
+ ∀g1,g2. g1 ∥ g2 → ∀f2. ↑f2 = g2 →
+ ∃∃f1. f1 ∥ f2 & ⫯f1 = g1.
+#g1 #g2 elim (gr_map_split_tl g1) #H1 #H #f2 #H2
+[ lapply (gr_sdj_inv_push_next … H … H1 H2) -H /2 width=3 by ex2_intro/
+| elim (gr_sdj_inv_next_bi … H … H1 H2)
+]
+qed-.
+
+(*** sdj_inv_xp *)
+lemma gr_sdj_inv_push_dx:
+ ∀g1,g2. g1 ∥ g2 → ∀f2. ⫯f2 = g2 →
+ ∨∨ ∃∃f1. f1 ∥ f2 & ⫯f1 = g1
+ | ∃∃f1. f1 ∥ f2 & ↑f1 = g1.
+#g1 #g2 elim (gr_map_split_tl g1) #H1 #H #f2 #H2
+[ lapply (gr_sdj_inv_push_bi … H … H1 H2)
+| lapply (gr_sdj_inv_next_push … H … H1 H2)
+] -H -H2
+/3 width=3 by ex2_intro, or_introl, or_intror/
+qed-.
+
+(*** sdj_inv_px *)
+lemma gr_sdj_inv_push_sn:
+ ∀g1,g2. g1 ∥ g2 → ∀f1. ⫯f1 = g1 →
+ ∨∨ ∃∃f2. f1 ∥ f2 & ⫯f2 = g2
+ | ∃∃f2. f1 ∥ f2 & ↑f2 = g2.
+#g1 #g2 elim (gr_map_split_tl g2) #H2 #H #f1 #H1
+[ lapply (gr_sdj_inv_push_bi … H … H1 H2)
+| lapply (gr_sdj_inv_push_next … H … H1 H2)
+] -H -H1
+/3 width=3 by ex2_intro, or_introl, or_intror/
+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 "ground/relocation/gr_tl_eq.ma".
+include "ground/relocation/gr_sdj.ma".
+
+(* DISJOINTNESS FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *********************************************************)
+
+(*** sdj_eq_repl_back1 *)
+corec lemma gr_sdj_eq_repl_back_sn:
+ ∀f2. gr_eq_repl_back … (λf1. f1 ∥ f2).
+#f2 #f1 * -f2 -f1
+#f1 #f2 #g1 #g2 #Hf #H1 #H2 #g #H0
+[ cases (gr_eq_inv_push_sn … H0 … H1) -g1 /3 width=5 by gr_sdj_push_bi/
+| cases (gr_eq_inv_next_sn … H0 … H1) -g1 /3 width=5 by gr_sdj_next_push/
+| cases (gr_eq_inv_push_sn … H0 … H1) -g1 /3 width=5 by gr_sdj_push_next/
+]
+qed-.
+
+(*** sdj_eq_repl_fwd1 *)
+lemma gr_sdj_eq_repl_fwd_sn:
+ ∀f2. gr_eq_repl_fwd … (λf1. f1 ∥ f2).
+#f2 @gr_eq_repl_sym /2 width=3 by gr_sdj_eq_repl_back_sn/
+qed-.
+
+(*** sdj_eq_repl_back2 *)
+corec lemma gr_sdj_eq_repl_back_dx:
+ ∀f1. gr_eq_repl_back … (λf2. f1 ∥ f2).
+#f1 #f2 * -f1 -f2
+#f1 #f2 #g1 #g2 #Hf #H1 #H2 #g #H0
+[ cases (gr_eq_inv_push_sn … H0 … H2) -g2 /3 width=5 by gr_sdj_push_bi/
+| cases (gr_eq_inv_push_sn … H0 … H2) -g2 /3 width=5 by gr_sdj_next_push/
+| cases (gr_eq_inv_next_sn … H0 … H2) -g2 /3 width=5 by gr_sdj_push_next/
+]
+qed-.
+
+(*** sdj_eq_repl_fwd2 *)
+lemma gr_sdj_eq_repl_fwd_dx:
+ ∀f1. gr_eq_repl_fwd … (λf2. f1 ∥ f2).
+#f1 @gr_eq_repl_sym /2 width=3 by gr_sdj_eq_repl_back_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 "ground/relocation/gr_isi.ma".
+include "ground/relocation/gr_sdj.ma".
+
+(* DISJOINTNESS FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with isid *****************************************************)
+
+(*** sdj_isid_dx *)
+corec lemma gr_sdj_isi_dx:
+ ∀f2. 𝐈❪f2❫ → ∀f1. f1 ∥ f2.
+#f2 * -f2
+#f2 #g2 #Hf2 #H2 #f1 cases (gr_map_split_tl f1) *
+/3 width=5 by gr_sdj_next_push, gr_sdj_push_bi/
+qed.
+
+(*** sdj_isid_sn *)
+corec lemma gr_sdj_isi_sn:
+ ∀f1. 𝐈❪f1❫ → ∀f2. f1 ∥ f2.
+#f1 * -f1
+#f1 #g1 #Hf1 #H1 #f2 cases (gr_map_split_tl f2) *
+/3 width=5 by gr_sdj_push_next, gr_sdj_push_bi/
+qed.
+
+(* Inversion lemmas with isid ***********************************************)
+
+(*** sdj_inv_refl *)
+corec lemma gr_sdj_inv_refl:
+ ∀f. f ∥ f → 𝐈❪f❫.
+#f cases (gr_map_split_tl f) #Hf #H
+[ lapply (gr_sdj_inv_push_bi … H … Hf Hf) -H /3 width=3 by gr_isi_push/
+| elim (gr_sdj_inv_next_bi … H … Hf Hf)
+]
+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 "ground/relocation/gr_tl.ma".
+
+(* INCLUSION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** sle *)
+coinductive gr_sle: relation gr_map ≝
+(*** sle_push *)
+| gr_sle_push (f1) (f2) (g1) (g2):
+ gr_sle f1 f2 → ⫯f1 = g1 → ⫯f2 = g2 → gr_sle g1 g2
+(*** sle_next *)
+| gr_sle_next (f1) (f2) (g1) (g2):
+ gr_sle f1 f2 → ↑f1 = g1 → ↑f2 = g2 → gr_sle g1 g2
+(*** sle_weak *)
+| gr_sle_weak (f1) (f2) (g1) (g2):
+ gr_sle f1 f2 → ⫯f1 = g1 → ↑f2 = g2 → gr_sle g1 g2
+.
+
+interpretation
+ "inclusion (generic relocation maps)"
+ 'subseteq f1 f2 = (gr_sle f1 f2).
+
+(* Basic properties *********************************************************)
+
+(*** sle_refl *)
+corec lemma gr_sle_refl:
+ reflexive … gr_sle.
+#f cases (gr_map_split_tl f) #H
+[ @(gr_sle_push … H H) | @(gr_sle_next … H H) ] -H //
+qed.
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** sle_inv_xp *)
+lemma gr_sle_inv_push_dx:
+ ∀g1,g2. g1 ⊆ g2 → ∀f2. ⫯f2 = g2 →
+ ∃∃f1. f1 ⊆ f2 & ⫯f1 = g1.
+#g1 #g2 * -g1 -g2
+#f1 #f2 #g1 #g2 #H #H1 #H2 #x2 #Hx2 destruct
+[ lapply (eq_inv_gr_push_bi … Hx2) -Hx2 /2 width=3 by ex2_intro/ ]
+elim (eq_inv_gr_push_next … Hx2)
+qed-.
+
+(*** sle_inv_nx *)
+lemma gr_sle_inv_next_sn:
+ ∀g1,g2. g1 ⊆ g2 → ∀f1. ↑f1 = g1 →
+ ∃∃f2. f1 ⊆ f2 & ↑f2 = g2.
+#g1 #g2 * -g1 -g2
+#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #Hx1 destruct
+[2: lapply (eq_inv_gr_next_bi … Hx1) -Hx1 /2 width=3 by ex2_intro/ ]
+elim (eq_inv_gr_next_push … Hx1)
+qed-.
+
+(*** sle_inv_pn *)
+lemma gr_sle_inv_push_next:
+ ∀g1,g2. g1 ⊆ g2 → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 → f1 ⊆ f2.
+#g1 #g2 * -g1 -g2
+#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #x2 #Hx1 #Hx2 destruct
+[ elim (eq_inv_gr_next_push … Hx2)
+| elim (eq_inv_gr_push_next … Hx1)
+| lapply (eq_inv_gr_push_bi … Hx1) -Hx1
+ lapply (eq_inv_gr_next_bi … Hx2) -Hx2 //
+]
+qed-.
+
+(* Advanced inversion lemmas ************************************************)
+
+(*** sle_inv_pp *)
+lemma gr_sle_inv_push_bi:
+ ∀g1,g2. g1 ⊆ g2 → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 → f1 ⊆ f2.
+#g1 #g2 #H #f1 #f2 #H1 #H2
+elim (gr_sle_inv_push_dx … H … H2) -g2 #x1 #H #Hx1 destruct
+lapply (eq_inv_gr_push_bi … Hx1) -Hx1 //
+qed-.
+
+(*** sle_inv_nn *)
+lemma gr_sle_inv_next_bi:
+ ∀g1,g2. g1 ⊆ g2 → ∀f1,f2. ↑f1 = g1 → ↑f2 = g2 → f1 ⊆ f2.
+#g1 #g2 #H #f1 #f2 #H1 #H2
+elim (gr_sle_inv_next_sn … H … H1) -g1 #x2 #H #Hx2 destruct
+lapply (eq_inv_gr_next_bi … Hx2) -Hx2 //
+qed-.
+
+(*** sle_inv_px *)
+lemma gr_sle_inv_push_sn:
+ ∀g1,g2. g1 ⊆ g2 → ∀f1. ⫯f1 = g1 →
+ ∨∨ ∃∃f2. f1 ⊆ f2 & ⫯f2 = g2
+ | ∃∃f2. f1 ⊆ f2 & ↑f2 = g2.
+#g1 #g2
+elim (gr_map_split_tl g2) #H2 #H #f1 #H1
+[ lapply (gr_sle_inv_push_bi … H … H1 H2)
+| lapply (gr_sle_inv_push_next … H … H1 H2)
+] -H -H1
+/3 width=3 by ex2_intro, or_introl, or_intror/
+qed-.
+
+(*** sle_inv_xn *)
+lemma gr_sle_inv_next_dx:
+ ∀g1,g2. g1 ⊆ g2 → ∀f2. ↑f2 = g2 →
+ ∨∨ ∃∃f1. f1 ⊆ f2 & ⫯f1 = g1
+ | ∃∃f1. f1 ⊆ f2 & ↑f1 = g1.
+#g1 #g2
+elim (gr_map_split_tl g1) #H1 #H #f2 #H2
+[ lapply (gr_sle_inv_push_next … H … H1 H2)
+| lapply (gr_sle_inv_next_bi … H … H1 H2)
+] -H -H2
+/3 width=3 by ex2_intro, or_introl, or_intror/
+qed-.
+
+(* Properties with tail *****************************************************)
+
+(*** sle_px_tl *)
+lemma gr_sle_push_sn_tl:
+ ∀g1,g2. g1 ⊆ g2 → ∀f1. ⫯f1 = g1 → f1 ⊆ ⫱g2.
+#g1 #g2 #H #f1 #H1
+elim (gr_sle_inv_push_sn … H … H1) -H -H1 * //
+qed.
+
+(*** sle_xn_tl *)
+lemma gr_sle_next_dx_tl:
+ ∀g1,g2. g1 ⊆ g2 → ∀f2. ↑f2 = g2 → ⫱g1 ⊆ f2.
+#g1 #g2 #H #f2 #H2
+elim (gr_sle_inv_next_dx … H … H2) -H -H2 * //
+qed.
+
+(*** sle_tl *)
+lemma gr_sle_tl:
+ ∀f1,f2. f1 ⊆ f2 → ⫱f1 ⊆ ⫱f2.
+#f1 elim (gr_map_split_tl f1) #H1 #f2 #H
+[ lapply (gr_sle_push_sn_tl … H … H1) -H //
+| elim (gr_sle_inv_next_sn … H … H1) -H //
+]
+qed.
+
+(* Inversion lemmas with tail ***********************************************)
+
+(*** sle_inv_tl_sn *)
+lemma gr_sle_inv_tl_sn:
+ ∀f1,f2. ⫱f1 ⊆ f2 → f1 ⊆ ↑f2.
+#f1 elim (gr_map_split_tl f1) #H #f2 #Hf12
+/2 width=5 by gr_sle_next, gr_sle_weak/
+qed-.
+
+(*** sle_inv_tl_dx *)
+lemma gr_sle_inv_tl_dx:
+ ∀f1,f2. f1 ⊆ ⫱f2 → ⫯f1 ⊆ f2.
+#f1 #f2 elim (gr_map_split_tl f2) #H #Hf12
+/2 width=5 by gr_sle_push, gr_sle_weak/
+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 "ground/relocation/gr_sle.ma".
+(**) (* this should go first *)
+include "ground/relocation/gr_tl_eq.ma".
+
+(* INCLUSION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *********************************************************)
+
+(*** sle_eq_repl_back1 *)
+corec lemma gr_sle_eq_repl_back_sn:
+ ∀f2:gr_map. gr_eq_repl_back … (λf1:gr_map. f1 ⊆ f2).
+#f2 #f1 * -f2 -f1
+#f1 #f2 #g1 #g2 #Hf #H1 #H2 #g #H0
+[ cases (gr_eq_inv_push_sn … H0 … H1) -g1 /3 width=5 by gr_sle_push/
+| cases (gr_eq_inv_next_sn … H0 … H1) -g1 /3 width=5 by gr_sle_next/
+| cases (gr_eq_inv_push_sn … H0 … H1) -g1 /3 width=5 by gr_sle_weak/
+]
+qed-.
+
+(*** sle_eq_repl_fwd1 *)
+lemma gr_sle_eq_repl_fwd_sn:
+ ∀f2. gr_eq_repl_fwd … (λf1. f1 ⊆ f2).
+#f2 @gr_eq_repl_sym /2 width=3 by gr_sle_eq_repl_back_sn/
+qed-.
+
+(*** sle_eq_repl_back2 *)
+corec lemma gr_sle_eq_repl_back_dx:
+ ∀f1. gr_eq_repl_back … (λf2. f1 ⊆ f2).
+#f1 #f2 * -f1 -f2
+#f1 #f2 #g1 #g2 #Hf #H1 #H2 #g #H0
+[ cases (gr_eq_inv_push_sn … H0 … H2) -g2 /3 width=5 by gr_sle_push/
+| cases (gr_eq_inv_next_sn … H0 … H2) -g2 /3 width=5 by gr_sle_next/
+| cases (gr_eq_inv_next_sn … H0 … H2) -g2 /3 width=5 by gr_sle_weak/
+]
+qed-.
+
+(*** sle_eq_repl_fwd2 *)
+lemma gr_sle_eq_repl_fwd_dx:
+ ∀f1. gr_eq_repl_fwd … (λf2. f1 ⊆ f2).
+#f1 @gr_eq_repl_sym /2 width=3 by gr_sle_eq_repl_back_dx/
+qed-.
+
+(*** sle_refl_eq *)
+lemma gr_sle_refl_eq:
+ ∀f1,f2. f1 ≡ f2 → f1 ⊆ f2.
+/2 width=3 by gr_sle_eq_repl_back_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 "ground/relocation/gr_isd.ma".
+include "ground/relocation/gr_sle.ma".
+
+(* INCLUSION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with isdiv ****************************************************)
+
+(*** sle_isdiv_dx *)
+corec lemma gr_sle_isd_dx:
+ ∀f2. 𝛀❪f2❫ → ∀f1. f1 ⊆ f2.
+#f2 * -f2
+#f2 #g2 #Hf2 #H2 #f1 cases (gr_map_split_tl f1) *
+/3 width=5 by gr_sle_weak, gr_sle_next/
+qed.
+
+(* Inversion lemmas with isdiv **********************************************)
+
+(*** sle_inv_isdiv_sn *)
+corec lemma gr_sle_inv_isd_sn:
+ ∀f1,f2. f1 ⊆ f2 → 𝛀❪f1❫ → 𝛀❪f2❫.
+#f1 #f2 * -f1 -f2
+#f1 #f2 #g1 #g2 #Hf * * #H
+[1,3: elim (gr_isd_inv_push … H) // ]
+lapply (gr_isd_inv_next … H ??) -H
+/3 width=3 by gr_isd_next/
+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 "ground/relocation/gr_isi.ma".
+include "ground/relocation/gr_sle.ma".
+
+(* INCLUSION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with isid *****************************************************)
+
+(*** sle_isid_sn *)
+corec lemma gr_sle_isi_sn:
+ ∀f1. 𝐈❪f1❫ → ∀f2. f1 ⊆ f2.
+#f1 * -f1
+#f1 #g1 #Hf1 #H1 #f2 cases (gr_map_split_tl f2) *
+/3 width=5 by gr_sle_weak, gr_sle_push/
+qed.
+
+(* Inversion lemmas with isid ***********************************************)
+
+(*** sle_inv_isid_dx *)
+corec lemma gr_sle_inv_isi_dx:
+ ∀f1,f2. f1 ⊆ f2 → 𝐈❪f2❫ → 𝐈❪f1❫.
+#f1 #f2 * -f1 -f2
+#f1 #f2 #g1 #g2 #Hf * * #H
+[2,3: elim (gr_isi_inv_next … H) // ]
+lapply (gr_isi_inv_push … H ??) -H
+/3 width=3 by gr_isi_push/
+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 "ground/relocation/gr_pushs.ma".
+include "ground/relocation/gr_sle.ma".
+
+(* INCLUSION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with iterated push ********************************************)
+
+(*** sle_pushs *)
+lemma gr_sle_pushs:
+ ∀f1,f2. f1 ⊆ f2 → ∀n. ⫯*[n] f1 ⊆ ⫯*[n] f2.
+#f1 #f2 #Hf12 #n @(nat_ind_succ … n) -n
+/2 width=5 by gr_sle_push/
+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 "ground/relocation/gr_sle.ma".
+
+(* INCLUSION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Main properties **********************************************************)
+
+(*** sle_trans *)
+corec theorem gr_sle_trans:
+ Transitive … gr_sle.
+#f1 #f * -f1 -f
+#f1 #f #g1 #g #Hf #H1 #H #g2 #H0
+[ cases (gr_sle_inv_push_sn … H0 … H) *
+|*: cases (gr_sle_inv_next_sn … H0 … H)
+] -g
+/3 width=5 by gr_sle_push, gr_sle_next, gr_sle_weak/
+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 "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_sle.ma".
+
+(* INCLUSION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with iterated tail ********************************************)
+
+(*** sle_tls *)
+lemma gr_sle_tls:
+ ∀f1,f2. f1 ⊆ f2 → ∀n. ⫱*[n] f1 ⊆ ⫱*[n] f2.
+#f1 #f2 #Hf12 #n @(nat_ind_succ … n) -n
+/2 width=5 by gr_sle_tl/
+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 "ground/notation/relations/runion_3.ma".
+include "ground/xoa/or_3.ma".
+include "ground/xoa/ex_3_2.ma".
+include "ground/relocation/gr_tl.ma".
+
+(* RELATIONAL UNION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** sor *)
+coinductive gr_sor: relation3 gr_map gr_map gr_map ≝
+(*** sor_pp *)
+| gr_sor_push_bi (f1) (f2) (f) (g1) (g2) (g):
+ gr_sor f1 f2 f → ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → gr_sor g1 g2 g
+(*** sor_np *)
+| gr_sor_next_push (f1) (f2) (f) (g1) (g2) (g):
+ gr_sor f1 f2 f → ↑f1 = g1 → ⫯f2 = g2 → ↑f = g → gr_sor g1 g2 g
+(*** sor_pn *)
+| gr_sor_push_next (f1) (f2) (f) (g1) (g2) (g):
+ gr_sor f1 f2 f → ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → gr_sor g1 g2 g
+(*** sor_nn *)
+| gr_sor_next_bi (f1) (f2) (f) (g1) (g2) (g):
+ gr_sor f1 f2 f → ↑f1 = g1 → ↑f2 = g2 → ↑f = g → gr_sor g1 g2 g
+.
+
+interpretation
+ "relational union (generic relocation maps)"
+ 'RUnion f1 f2 f = (gr_sor f1 f2 f).
+
+(* Basic properties *********************************************************)
+
+(*** sor_idem *)
+corec lemma gr_sor_idem:
+ ∀f. f ⋓ f ≘ f.
+#f cases (gr_map_split_tl f) #H
+[ @(gr_sor_push_bi … H H H)
+| @(gr_sor_next_bi … H H H)
+] -H //
+qed.
+
+(*** sor_comm *)
+corec lemma gr_sor_comm:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → f2 ⋓ f1 ≘ f.
+#f1 #f2 #f * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf * * * -g1 -g2 -g
+[ @gr_sor_push_bi | @gr_sor_push_next | @gr_sor_next_push | @gr_sor_next_bi ] /2 width=7 by/
+qed-.
+
+(* Basic inversion lemmas ***************************************************)
+
+(*** sor_inv_ppx *)
+lemma gr_sor_inv_push_bi:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 →
+ ∃∃f. f1 ⋓ f2 ≘ f & ⫯f = g.
+#g1 #g2 #g * -g1 -g2 -g
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
+try (>(eq_inv_gr_push_bi … Hx1) -x1) try (>(eq_inv_gr_next_bi … Hx1) -x1)
+try elim (eq_inv_gr_push_next … Hx1) try elim (eq_inv_gr_next_push … Hx1)
+try (>(eq_inv_gr_push_bi … Hx2) -x2) try (>(eq_inv_gr_next_bi … Hx2) -x2)
+try elim (eq_inv_gr_push_next … Hx2) try elim (eq_inv_gr_next_push … Hx2)
+/2 width=3 by ex2_intro/
+qed-.
+
+(*** sor_inv_npx *)
+lemma gr_sor_inv_next_push:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f1,f2. ↑f1 = g1 → ⫯f2 = g2 →
+ ∃∃f. f1 ⋓ f2 ≘ f & ↑f = g.
+#g1 #g2 #g * -g1 -g2 -g
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
+try (>(eq_inv_gr_push_bi … Hx1) -x1) try (>(eq_inv_gr_next_bi … Hx1) -x1)
+try elim (eq_inv_gr_push_next … Hx1) try elim (eq_inv_gr_next_push … Hx1)
+try (>(eq_inv_gr_push_bi … Hx2) -x2) try (>(eq_inv_gr_next_bi … Hx2) -x2)
+try elim (eq_inv_gr_push_next … Hx2) try elim (eq_inv_gr_next_push … Hx2)
+/2 width=3 by ex2_intro/
+qed-.
+
+(*** sor_inv_pnx *)
+lemma gr_sor_inv_push_next:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 →
+ ∃∃f. f1 ⋓ f2 ≘ f & ↑f = g.
+#g1 #g2 #g * -g1 -g2 -g
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
+try (>(eq_inv_gr_push_bi … Hx1) -x1) try (>(eq_inv_gr_next_bi … Hx1) -x1)
+try elim (eq_inv_gr_push_next … Hx1) try elim (eq_inv_gr_next_push … Hx1)
+try (>(eq_inv_gr_push_bi … Hx2) -x2) try (>(eq_inv_gr_next_bi … Hx2) -x2)
+try elim (eq_inv_gr_push_next … Hx2) try elim (eq_inv_gr_next_push … Hx2)
+/2 width=3 by ex2_intro/
+qed-.
+
+(*** sor_inv_nnx *)
+lemma gr_sor_inv_next_bi:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f1,f2. ↑f1 = g1 → ↑f2 = g2 →
+ ∃∃f. f1 ⋓ f2 ≘ f & ↑f = g.
+#g1 #g2 #g * -g1 -g2 -g
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
+try (>(eq_inv_gr_push_bi … Hx1) -x1) try (>(eq_inv_gr_next_bi … Hx1) -x1)
+try elim (eq_inv_gr_push_next … Hx1) try elim (eq_inv_gr_next_push … Hx1)
+try (>(eq_inv_gr_push_bi … Hx2) -x2) try (>(eq_inv_gr_next_bi … Hx2) -x2)
+try elim (eq_inv_gr_push_next … Hx2) try elim (eq_inv_gr_next_push … Hx2)
+/2 width=3 by ex2_intro/
+qed-.
+
+(* Advanced inversion lemmas ************************************************)
+
+(*** sor_inv_ppn *)
+lemma gr_sor_inv_push_bi_next:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ↑f = g → ⊥.
+#g1 #g2 #g #H #f1 #f2 #f #H1 #H2 #H0
+elim (gr_sor_inv_push_bi … H … H1 H2) -g1 -g2 #x #_ #H destruct
+/2 width=3 by eq_inv_gr_push_next/
+qed-.
+
+(*** sor_inv_nxp *)
+lemma gr_sor_inv_next_sn_push:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f1,f. ↑f1 = g1 → ⫯f = g → ⊥.
+#g1 #g2 #g #H #f1 #f #H1 #H0
+elim (gr_map_split_tl g2) #H2
+[ elim (gr_sor_inv_next_push … H … H1 H2)
+| elim (gr_sor_inv_next_bi … H … H1 H2)
+] -g1 #x #H
+/2 width=3 by eq_inv_gr_next_push/
+qed-.
+
+(*** sor_inv_xnp *)
+lemma gr_sor_inv_next_dx_push:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f2,f. ↑f2 = g2 → ⫯f = g → ⊥.
+#g1 #g2 #g #H #f2 #f #H2 #H0
+elim (gr_map_split_tl g1) #H1
+[ elim (gr_sor_inv_push_next … H … H1 H2)
+| elim (gr_sor_inv_next_bi … H … H1 H2)
+] -g2 #x #H
+/2 width=3 by eq_inv_gr_next_push/
+qed-.
+
+(*** sor_inv_ppp *)
+lemma gr_sor_inv_push_bi_push:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → f1 ⋓ f2 ≘ f.
+#g1 #g2 #g #H #f1 #f2 #f #H1 #H2 #H0
+elim (gr_sor_inv_push_bi … H … H1 H2) -g1 -g2 #x #Hx #H destruct
+<(eq_inv_gr_push_bi … H) -f //
+qed-.
+
+(*** sor_inv_npn *)
+lemma gr_sor_inv_next_push_next:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f1,f2,f. ↑f1 = g1 → ⫯f2 = g2 → ↑f = g → f1 ⋓ f2 ≘ f.
+#g1 #g2 #g #H #f1 #f2 #f #H1 #H2 #H0
+elim (gr_sor_inv_next_push … H … H1 H2) -g1 -g2 #x #Hx #H destruct
+<(eq_inv_gr_next_bi … H) -f //
+qed-.
+
+(*** sor_inv_pnn *)
+lemma gr_sor_inv_push_next_next:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f1,f2,f. ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → f1 ⋓ f2 ≘ f.
+#g1 #g2 #g #H #f1 #f2 #f #H1 #H2 #H0
+elim (gr_sor_inv_push_next … H … H1 H2) -g1 -g2 #x #Hx #H destruct
+<(eq_inv_gr_next_bi … H) -f //
+qed-.
+
+(*** sor_inv_nnn *)
+lemma gr_sor_inv_next_bi_next:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f1,f2,f. ↑f1 = g1 → ↑f2 = g2 → ↑f = g → f1 ⋓ f2 ≘ f.
+#g1 #g2 #g #H #f1 #f2 #f #H1 #H2 #H0
+elim (gr_sor_inv_next_bi … H … H1 H2) -g1 -g2 #x #Hx #H destruct
+<(eq_inv_gr_next_bi … H) -f //
+qed-.
+
+(*** sor_inv_pxp *)
+lemma gr_sor_inv_push_sn_push:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f1,f. ⫯f1 = g1 → ⫯f = g →
+ ∃∃f2. f1 ⋓ f2 ≘ f & ⫯f2 = g2.
+#g1 #g2 #g #H #f1 #f #H1 #H0
+elim (gr_map_split_tl g2) #H2
+[ /3 width=7 by gr_sor_inv_push_bi_push, ex2_intro/
+| elim (gr_sor_inv_next_dx_push … H … H2 H0)
+]
+qed-.
+
+(*** sor_inv_xpp *)
+lemma gr_sor_inv_push_dx_push:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f2,f. ⫯f2 = g2 → ⫯f = g →
+ ∃∃f1. f1 ⋓ f2 ≘ f & ⫯f1 = g1.
+#g1 #g2 #g #H #f2 #f #H2 #H0
+elim (gr_map_split_tl g1) #H1
+[ /3 width=7 by gr_sor_inv_push_bi_push, ex2_intro/
+| elim (gr_sor_inv_next_sn_push … H … H1 H0)
+]
+qed-.
+
+(*** sor_inv_pxn *)
+lemma gr_sor_inv_push_sn_next:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f1,f. ⫯f1 = g1 → ↑f = g →
+ ∃∃f2. f1 ⋓ f2 ≘ f & ↑f2 = g2.
+#g1 #g2 #g #H #f1 #f #H1 #H0
+elim (gr_map_split_tl g2) #H2
+[ elim (gr_sor_inv_push_bi_next … H … H1 H2 H0)
+| /3 width=7 by gr_sor_inv_push_next_next, ex2_intro/
+]
+qed-.
+
+(*** sor_inv_xpn *)
+lemma gr_sor_inv_push_dx_next:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f2,f. ⫯f2 = g2 → ↑f = g →
+ ∃∃f1. f1 ⋓ f2 ≘ f & ↑f1 = g1.
+#g1 #g2 #g #H #f2 #f #H2 #H0
+elim (gr_map_split_tl g1) #H1
+[ elim (gr_sor_inv_push_bi_next … H … H1 H2 H0)
+| /3 width=7 by gr_sor_inv_next_push_next, ex2_intro/
+]
+qed-.
+
+(*** sor_inv_xxp *)
+lemma gr_sor_inv_push:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f. ⫯f = g →
+ ∃∃f1,f2. f1 ⋓ f2 ≘ f & ⫯f1 = g1 & ⫯f2 = g2.
+#g1 #g2 #g #H #f #H0
+elim (gr_map_split_tl g1) #H1
+[ elim (gr_sor_inv_push_sn_push … H … H1 H0) -g /2 width=5 by ex3_2_intro/
+| elim (gr_sor_inv_next_sn_push … H … H1 H0)
+]
+qed-.
+
+(*** sor_inv_nxn *)
+lemma gr_sor_inv_next_sn_next:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f1,f. ↑f1 = g1 → ↑f = g →
+ ∨∨ ∃∃f2. f1 ⋓ f2 ≘ f & ⫯f2 = g2
+ | ∃∃f2. f1 ⋓ f2 ≘ f & ↑f2 = g2.
+#g1 #g2 elim (gr_map_split_tl g2)
+/4 width=7 by gr_sor_inv_next_push_next, gr_sor_inv_next_bi_next, ex2_intro, or_intror, or_introl/
+qed-.
+
+(*** sor_inv_xnn *)
+lemma gr_sor_inv_next_dx_next:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f2,f. ↑f2 = g2 → ↑f = g →
+ ∨∨ ∃∃f1. f1 ⋓ f2 ≘ f & ⫯f1 = g1
+ | ∃∃f1. f1 ⋓ f2 ≘ f & ↑f1 = g1.
+#g1 elim (gr_map_split_tl g1)
+/4 width=7 by gr_sor_inv_push_next_next, gr_sor_inv_next_bi_next, ex2_intro, or_intror, or_introl/
+qed-.
+
+(*** sor_inv_xxn *)
+lemma gr_sor_inv_next:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f. ↑f = g →
+ ∨∨ ∃∃f1,f2. f1 ⋓ f2 ≘ f & ↑f1 = g1 & ⫯f2 = g2
+ | ∃∃f1,f2. f1 ⋓ f2 ≘ f & ⫯f1 = g1 & ↑f2 = g2
+ | ∃∃f1,f2. f1 ⋓ f2 ≘ f & ↑f1 = g1 & ↑f2 = g2.
+#g1 #g2 #g #H #f #H0
+elim (gr_map_split_tl g1) #H1
+[ elim (gr_sor_inv_push_sn_next … H … H1 H0) -g
+ /3 width=5 by or3_intro1, ex3_2_intro/
+| elim (gr_sor_inv_next_sn_next … H … H1 H0) -g *
+ /3 width=5 by or3_intro0, or3_intro2, ex3_2_intro/
+]
+qed-.
+
+(* Properties with tail *****************************************************)
+
+(*** sor_tl *)
+lemma gr_sor_tl:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → ⫱f1 ⋓ ⫱f2 ≘ ⫱f.
+#f1 cases (gr_map_split_tl f1) #H1
+#f2 cases (gr_map_split_tl f2) #H2
+#f #Hf
+[ cases (gr_sor_inv_push_bi … Hf … H1 H2)
+| cases (gr_sor_inv_push_next … Hf … H1 H2)
+| cases (gr_sor_inv_next_push … Hf … H1 H2)
+| cases (gr_sor_inv_next_bi … Hf … H1 H2)
+] -Hf #g #Hg #H destruct //
+qed.
+
+(*** sor_xxn_tl *)
+lemma gr_sor_next_tl:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f. ↑f = g →
+ (∃∃f1,f2. f1 ⋓ f2 ≘ f & ↑f1 = g1 & ⫱g2 = f2) ∨
+ (∃∃f1,f2. f1 ⋓ f2 ≘ f & ⫱g1 = f1 & ↑f2 = g2).
+#g1 #g2 #g #H #f #H0 elim (gr_sor_inv_next … H … H0) -H -H0 *
+/3 width=5 by ex3_2_intro, or_introl, or_intror/
+qed-.
+
+(*** sor_xnx_tl *)
+lemma gr_sor_next_dx_tl:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f2. ↑f2 = g2 →
+ ∃∃f1,f. f1 ⋓ f2 ≘ f & ⫱g1 = f1 & ↑f = g.
+#g1 elim (gr_map_split_tl g1) #H1 #g2 #g #H #f2 #H2
+[ elim (gr_sor_inv_push_next … H … H1 H2)
+| elim (gr_sor_inv_next_bi … H … H1 H2)
+] -g2
+/3 width=5 by ex3_2_intro/
+qed-.
+
+(*** sor_nxx_tl *)
+lemma gr_sor_next_sn_tl:
+ ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f1. ↑f1 = g1 →
+ ∃∃f2,f. f1 ⋓ f2 ≘ f & ⫱g2 = f2 & ↑f = g.
+#g1 #g2 elim (gr_map_split_tl g2) #H2 #g #H #f1 #H1
+[ elim (gr_sor_inv_next_push … H … H1 H2)
+| elim (gr_sor_inv_next_bi … H … H1 H2)
+] -g1
+/3 width=5 by ex3_2_intro/
+qed-.
+
+(* Inversion lemmas with tail ***********************************************)
+
+(*** sor_inv_tl_sn *)
+lemma gr_sor_inv_tl_sn:
+ ∀f1,f2,f. ⫱f1 ⋓ f2 ≘ f → f1 ⋓ ↑f2 ≘ ↑f.
+#f1 #f2 #f elim (gr_map_split_tl f1)
+/2 width=7 by gr_sor_push_next, gr_sor_next_bi/
+qed-.
+
+(*** sor_inv_tl_dx *)
+lemma gr_sor_inv_tl_dx:
+ ∀f1,f2,f. f1 ⋓ ⫱f2 ≘ f → ↑f1 ⋓ f2 ≘ ↑f.
+#f1 #f2 #f elim (gr_map_split_tl f2)
+/2 width=7 by gr_sor_next_push, gr_sor_next_bi/
+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 "ground/relocation/gr_isf.ma".
+include "ground/relocation/gr_coafter_isi.ma".
+include "ground/relocation/gr_coafter_ist_isi.ma".
+include "ground/relocation/gr_sor_isi.ma".
+
+(* RELATIONAL UNION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with coafter and ist and isf ****************************************************)
+
+(*** coafter_sor *)
+lemma gr_sor_coafter_dx_tans:
+ ∀f. 𝐅❪f❫ → ∀f2. 𝐓❪f2❫ → ∀f1. f2 ~⊚ f1 ≘ f → ∀f1a,f1b. f1a ⋓ f1b ≘ f1 →
+ ∃∃fa,fb. f2 ~⊚ f1a ≘ fa & f2 ~⊚ f1b ≘ fb & fa ⋓ fb ≘ f.
+@gr_isf_ind
+[ #f #Hf #f2 #Hf2 #f1 #Hf #f1a #f1b #Hf1
+ lapply (gr_coafter_des_ist_sn_isi … Hf ??) -Hf // #H2f1
+ elim (gr_sor_inv_isi … Hf1) -Hf1 //
+ /3 width=5 by gr_coafter_isi_dx, gr_sor_idem, ex3_2_intro/
+| #f #_ #IH #f2 #Hf2 #f1 #H1 #f1a #f1b #H2
+ elim (gr_coafter_inv_push … H1) -H1 [1,3: * |*: // ]
+ [ #g2 #g1 #Hf #Hgf2 #Hgf1
+ elim (gr_sor_inv_push … H2) -H2 [ |*: // ] #ga #gb #Hg1
+ lapply (gr_ist_inv_push … Hf2 … Hgf2) -Hf2 #Hg2
+ elim (IH … Hf … Hg1) // -f1 -g1 -IH -Hg2
+ /3 width=11 by gr_coafter_refl, gr_sor_push_bi, ex3_2_intro/
+ | #g2 #Hf #Hgf2
+ lapply (gr_ist_inv_next … Hf2 … Hgf2) -Hf2 #Hg2
+ elim (IH … Hf … H2) // -f1 -IH -Hg2
+ /3 width=11 by gr_coafter_next, gr_sor_push_bi, ex3_2_intro/
+ ]
+| #f #_ #IH #f2 #Hf2 #f1 #H1 #f1a #f1b #H2
+ elim (gr_coafter_inv_next … H1) -H1 [ |*: // ] #g2 #g1 #Hf #Hgf2 #Hgf1
+ lapply (gr_ist_inv_push … Hf2 … Hgf2) -Hf2 #Hg2
+ elim (gr_sor_inv_next … H2) -H2 [1,3,4: * |*: // ] #ga #gb #Hg1
+ elim (IH … Hf … Hg1) // -f1 -g1 -IH -Hg2
+ /3 width=11 by gr_coafter_refl, gr_coafter_push, gr_sor_next_push, gr_sor_push_next, gr_sor_next_bi, ex3_2_intro/
+]
+qed-.
+
+(*** coafter_inv_sor *)
+lemma gr_sor_coafter_div:
+ ∀f. 𝐅❪f❫ → ∀f2. 𝐓❪f2❫ → ∀f1. f2 ~⊚ f1 ≘ f → ∀fa,fb. fa ⋓ fb ≘ f →
+ ∃∃f1a,f1b. f2 ~⊚ f1a ≘ fa & f2 ~⊚ f1b ≘ fb & f1a ⋓ f1b ≘ f1.
+@gr_isf_ind
+[ #f #Hf #f2 #Hf2 #f1 #H1f #fa #fb #H2f
+ elim (gr_sor_inv_isi … H2f) -H2f //
+ lapply (gr_coafter_des_ist_sn_isi … H1f ??) -H1f //
+ /3 width=5 by ex3_2_intro, gr_coafter_isi_dx, gr_sor_isi_bi_isi/
+| #f #_ #IH #f2 #Hf2 #f1 #H1 #fa #fb #H2
+ elim (gr_sor_inv_push … H2) -H2 [ |*: // ] #ga #gb #H2f
+ elim (gr_coafter_inv_push … H1) -H1 [1,3: * |*: // ] #g2 [ #g1 ] #H1f #Hgf2
+ [ lapply (gr_ist_inv_push … Hf2 … Hgf2) | lapply (gr_ist_inv_next … Hf2 … Hgf2) ] -Hf2 #Hg2
+ elim (IH … Hg2 … H1f … H2f) -f -Hg2
+ /3 width=11 by gr_sor_push_bi, ex3_2_intro, gr_coafter_refl, gr_coafter_next/
+| #f #_ #IH #f2 #Hf2 #f1 #H1 #fa #fb #H2
+ elim (gr_coafter_inv_next … H1) -H1 [ |*: // ] #g2 #g1 #H1f #Hgf2
+ lapply (gr_ist_inv_push … Hf2 … Hgf2) -Hf2 #Hg2
+ elim (gr_sor_inv_next … H2) -H2 [1,3,4: * |*: // ] #ga #gb #H2f
+ elim (IH … Hg2 … H1f … H2f) -f -Hg2
+ /3 width=11 by gr_sor_next_push, gr_sor_push_next, gr_sor_next_bi, ex3_2_intro, gr_coafter_refl, gr_coafter_push/
+]
+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 "ground/relocation/gr_tl_eq.ma".
+include "ground/relocation/gr_sor.ma".
+
+(* RELATIONAL UNION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *********************************************************)
+
+(*** sor_eq_repl_back1 *)
+corec lemma gr_sor_eq_repl_back_sn:
+ ∀f2,f. gr_eq_repl_back … (λf1. f1 ⋓ f2 ≘ f).
+#f2 #f #f1 * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x #Hx
+try cases (gr_eq_inv_push_sn … Hx … H1) try cases (gr_eq_inv_next_sn … Hx … H1) -g1
+/3 width=7 by gr_sor_push_bi, gr_sor_next_push, gr_sor_push_next, gr_sor_next_bi/
+qed-.
+
+(*** sor_eq_repl_fwd1 *)
+lemma gr_sor_eq_repl_fwd_sn:
+ ∀f2,f. gr_eq_repl_fwd … (λf1. f1 ⋓ f2 ≘ f).
+#f2 #f @gr_eq_repl_sym /2 width=3 by gr_sor_eq_repl_back_sn/
+qed-.
+
+(*** sor_eq_repl_back2 *)
+corec lemma gr_sor_eq_repl_back_dx:
+ ∀f1,f. gr_eq_repl_back … (λf2. f1 ⋓ f2 ≘ f).
+#f1 #f #f2 * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf #H #H2 #H0 #x #Hx
+try cases (gr_eq_inv_push_sn … Hx … H2) try cases (gr_eq_inv_next_sn … Hx … H2) -g2
+/3 width=7 by gr_sor_push_bi, gr_sor_next_push, gr_sor_push_next, gr_sor_next_bi/
+qed-.
+
+(*** sor_eq_repl_fwd2 *)
+lemma gr_sor_eq_repl_fwd_dx:
+ ∀f1,f. gr_eq_repl_fwd … (λf2. f1 ⋓ f2 ≘ f).
+#f1 #f @gr_eq_repl_sym /2 width=3 by gr_sor_eq_repl_back_dx/
+qed-.
+
+(*** sor_eq_repl_back3 *)
+corec lemma gr_sor_eq_repl_back:
+ ∀f1,f2. gr_eq_repl_back … (λf. f1 ⋓ f2 ≘ f).
+#f1 #f2 #f * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf #H #H2 #H0 #x #Hx
+try cases (gr_eq_inv_push_sn … Hx … H0) try cases (gr_eq_inv_next_sn … Hx … H0) -g
+/3 width=7 by gr_sor_push_bi, gr_sor_next_push, gr_sor_push_next, gr_sor_next_bi/
+qed-.
+
+(*** sor_eq_repl_fwd3 *)
+lemma gr_sor_eq_repl_fwd:
+ ∀f1,f2. gr_eq_repl_fwd … (λf. f1 ⋓ f2 ≘ f).
+#f1 #f2 @gr_eq_repl_sym /2 width=3 by gr_sor_eq_repl_back/
+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 "ground/xoa/ex_3_1.ma".
+include "ground/xoa/ex_4_2.ma".
+include "ground/arith/nat_plus.ma".
+include "ground/arith/nat_le_max.ma".
+include "ground/relocation/gr_fcla_eq.ma".
+include "ground/relocation/gr_sor_isi.ma".
+
+(* RELATIONAL UNION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with finite colength assignment *******************************)
+
+(*** sor_fcla_ex *)
+lemma gr_sor_fcla_bi:
+ ∀f1,n1. 𝐂❪f1❫ ≘ n1 → ∀f2,n2. 𝐂❪f2❫ ≘ n2 →
+ ∃∃f,n. f1 ⋓ f2 ≘ f & 𝐂❪f❫ ≘ n & (n1 ∨ n2) ≤ n & n ≤ n1 + n2.
+#f1 #n1 #Hf1 elim Hf1 -f1 -n1 /3 width=6 by gr_sor_isi_sn, ex4_2_intro/
+#f1 #n1 #Hf1 #IH #f2 #n2 * -f2 -n2 /3 width=6 by gr_fcla_push, gr_fcla_next, ex4_2_intro, gr_sor_isi_dx/
+#f2 #n2 #Hf2 elim (IH … Hf2) -IH -Hf2 -Hf1 [2,4: #f #n <nplus_succ_dx ] (**) (* full auto fails *)
+[ /3 width=7 by gr_fcla_next, gr_sor_push_next, nle_max_sn_succ_dx, nle_succ_bi, ex4_2_intro/
+| /4 width=7 by gr_fcla_next, gr_sor_next_bi, nle_succ_dx, nle_succ_bi, ex4_2_intro/
+| /3 width=7 by gr_fcla_push, gr_sor_push_bi, ex4_2_intro/
+| /3 width=7 by gr_fcla_next, gr_sor_next_push, nle_max_sn_succ_sn, nle_succ_bi, ex4_2_intro/
+]
+qed-.
+
+(* Forward lemmas with finite colength **************************************)
+
+(*** sor_fcla *)
+lemma gr_sor_inv_fcla_bi:
+ ∀f1,n1. 𝐂❪f1❫ ≘ n1 → ∀f2,n2. 𝐂❪f2❫ ≘ n2 → ∀f. f1 ⋓ f2 ≘ f →
+ ∃∃n. 𝐂❪f❫ ≘ n & (n1 ∨ n2) ≤ n & n ≤ n1 + n2.
+#f1 #n1 #Hf1 #f2 #n2 #Hf2 #f #Hf elim (gr_sor_fcla_bi … Hf1 … Hf2) -Hf1 -Hf2
+/4 width=6 by gr_sor_mono, gr_fcla_eq_repl_back, ex3_intro/
+qed-.
+
+(* Forward lemmas with finite colength **************************************)
+
+(*** sor_fwd_fcla_sn_ex *)
+lemma gr_sor_des_fcla_sn:
+ ∀f,n. 𝐂❪f❫ ≘ n → ∀f1,f2. f1 ⋓ f2 ≘ f →
+ ∃∃n1. 𝐂❪f1❫ ≘ n1 & n1 ≤ n.
+#f #n #H elim H -f -n
+[ /4 width=4 by gr_sor_des_isi_sn, gr_fcla_isi, ex2_intro/
+| #f #n #_ #IH #f1 #f2 #H
+ elim (gr_sor_inv_push … H) -H [ |*: // ] #g1 #g2 #Hf #H1 #H2 destruct
+ elim (IH … Hf) -f /3 width=3 by gr_fcla_push, ex2_intro/
+| #f #n #_ #IH #f1 #f2 #H
+ elim (gr_sor_inv_next … H) -H [1,3,4: * |*: // ] #g1 #g2 #Hf #H1 #H2 destruct
+ elim (IH … Hf) -f /3 width=3 by gr_fcla_push, gr_fcla_next, nle_succ_bi, nle_succ_dx, ex2_intro/
+]
+qed-.
+
+(*** sor_fwd_fcla_dx_ex *)
+lemma gr_sor_des_fcla_dx:
+ ∀f,n. 𝐂❪f❫ ≘ n → ∀f1,f2. f1 ⋓ f2 ≘ f →
+ ∃∃n2. 𝐂❪f2❫ ≘ n2 & n2 ≤ n.
+/3 width=4 by gr_sor_des_fcla_sn, gr_sor_comm/ 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 "ground/relocation/gr_isf_eq.ma".
+include "ground/relocation/gr_sor_fcla.ma".
+
+(* RELATIONAL UNION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with test for finite colength *********************************)
+
+(*** sor_isfin_ex *)
+lemma gr_sor_isf_bi:
+ ∀f1,f2. 𝐅❪f1❫ → 𝐅❪f2❫ → ∃∃f. f1 ⋓ f2 ≘ f & 𝐅❪f❫.
+#f1 #f2 * #n1 #H1 * #n2 #H2 elim (gr_sor_fcla_bi … H1 … H2) -H1 -H2
+/3 width=4 by ex2_intro, ex_intro/
+qed-.
+
+(* Forward lemmas with test for finite colength *****************************)
+
+(*** sor_fwd_isfin_sn *)
+lemma gr_sor_des_isf_sn:
+ ∀f. 𝐅❪f❫ → ∀f1,f2. f1 ⋓ f2 ≘ f → 𝐅❪f1❫.
+#f * #n #Hf #f1 #f2 #H
+elim (gr_sor_des_fcla_sn … Hf … H) -f -f2 /2 width=2 by ex_intro/
+qed-.
+
+(*** sor_fwd_isfin_dx *)
+lemma gr_sor_des_isf_dx:
+ ∀f. 𝐅❪f❫ → ∀f1,f2. f1 ⋓ f2 ≘ f → 𝐅❪f2❫.
+#f * #n #Hf #f1 #f2 #H
+elim (gr_sor_des_fcla_dx … Hf … H) -f -f1 /2 width=2 by ex_intro/
+qed-.
+
+(* Inversion lemmas with test for finite colength ***************************)
+
+(*** sor_isfin *)
+lemma gr_sor_inv_isf_bi:
+ ∀f1,f2. 𝐅❪f1❫ → 𝐅❪f2❫ → ∀f. f1 ⋓ f2 ≘ f → 𝐅❪f❫.
+#f1 #f2 #Hf1 #Hf2 #f #Hf elim (gr_sor_isf_bi … Hf1 … Hf2) -Hf1 -Hf2
+/3 width=6 by gr_sor_mono, gr_isf_eq_repl_back/
+qed-.
+
+(*** sor_inv_isfin3 *)
+lemma gr_sor_inv_isf:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐅❪f❫ →
+ ∧∧ 𝐅❪f1❫ & 𝐅❪f2❫.
+/3 width=4 by gr_sor_des_isf_dx, gr_sor_des_isf_sn, conj/ 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 "ground/relocation/gr_isi_eq.ma".
+include "ground/relocation/gr_sor_eq.ma".
+include "ground/relocation/gr_sor_sor.ma".
+
+(* RELATIONAL UNION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with test for identity *****************************************)
+
+(*** sor_isid_sn *)
+corec lemma gr_sor_isi_sn:
+ ∀f1. 𝐈❪f1❫ → ∀f2. f1 ⋓ f2 ≘ f2.
+#f1 * -f1
+#f1 #g1 #Hf1 #H1 #f2 cases (gr_map_split_tl f2)
+/3 width=7 by gr_sor_push_bi, gr_sor_push_next/
+qed.
+
+(*** sor_isid_dx *)
+corec lemma gr_sor_isi_dx:
+ ∀f2. 𝐈❪f2❫ → ∀f1. f1 ⋓ f2 ≘ f1.
+#f2 * -f2
+#f2 #g2 #Hf2 #H2 #f1 cases (gr_map_split_tl f1)
+/3 width=7 by gr_sor_push_bi, gr_sor_next_push/
+qed.
+
+(*** sor_isid *)
+lemma gr_sor_isi_bi_isi:
+ ∀f1,f2,f. 𝐈❪f1❫ → 𝐈❪f2❫ → 𝐈❪f❫ → f1 ⋓ f2 ≘ f.
+/4 width=3 by gr_sor_eq_repl_back_dx, gr_sor_eq_repl_back_sn, gr_isi_inv_eq_repl/ qed.
+
+
+(* Forward lemmas with test for identity **********************************)
+
+(*** sor_fwd_isid1 *)
+corec lemma gr_sor_des_isi_sn:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐈❪f❫ → 𝐈❪f1❫.
+#f1 #f2 #f * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H #Hg
+[ /4 width=6 by gr_isi_inv_push, gr_isi_push/ ]
+cases (gr_isi_inv_next … Hg … H)
+qed-.
+
+(*** sor_fwd_isid2 *)
+corec lemma gr_sor_des_isi_dx:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐈❪f❫ → 𝐈❪f2❫.
+#f1 #f2 #f * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H #Hg
+[ /4 width=6 by gr_isi_inv_push, gr_isi_push/ ]
+cases (gr_isi_inv_next … Hg … H)
+qed-.
+
+(* Inversion lemmas with test for identity **********************************)
+
+(*** sor_isid_inv_sn *)
+lemma gr_sor_inv_isi_sn:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐈❪f1❫ → f2 ≡ f.
+/3 width=4 by gr_sor_isi_sn, gr_sor_mono/
+qed-.
+
+(*** sor_isid_inv_dx *)
+lemma gr_sor_inv_isi_dx:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐈❪f2❫ → f1 ≡ f.
+/3 width=4 by gr_sor_isi_dx, gr_sor_mono/
+qed-.
+
+(*** sor_inv_isid3 *)
+lemma gr_sor_inv_isi:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐈❪f❫ →
+ ∧∧ 𝐈❪f1❫ & 𝐈❪f2❫.
+/3 width=4 by gr_sor_des_isi_dx, gr_sor_des_isi_sn, conj/ 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 "ground/relocation/gr_sle_sle.ma".
+include "ground/relocation/gr_sor.ma".
+
+(* RELATIONAL UNION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Inversion lemmas with inclusion ******************************************)
+
+(*** sor_inv_sle_sn *)
+corec lemma gr_sor_inv_sle_sn:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → f1 ⊆ f.
+#f1 #f2 #f * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0
+/3 width=5 by gr_sle_push, gr_sle_next, gr_sle_weak/
+qed-.
+
+(*** sor_inv_sle_dx *)
+corec lemma gr_sor_inv_sle_dx:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → f2 ⊆ f.
+#f1 #f2 #f * -f1 -f2 -f
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0
+/3 width=5 by gr_sle_push, gr_sle_next, gr_sle_weak/
+qed-.
+
+(*** sor_inv_sle_sn_trans *)
+lemma gr_sor_inv_sle_sn_trans:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → ∀g. g ⊆ f1 → g ⊆ f.
+/3 width=4 by gr_sor_inv_sle_sn, gr_sle_trans/ qed-.
+
+(*** sor_inv_sle_dx_trans *)
+lemma gr_sor_inv_sle_dx_trans:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → ∀g. g ⊆ f2 → g ⊆ f.
+/3 width=4 by gr_sor_inv_sle_dx, gr_sle_trans/ qed-.
+
+(*** sor_inv_sle *)
+axiom gr_sor_inv_sle_bi:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → ∀g. f1 ⊆ g → f2 ⊆ g → f ⊆ g.
+
+(* Properties with inclusion ************************************************)
+
+(*** sor_sle_dx *)
+corec lemma gr_sor_sle_dx:
+ ∀f1,f2. f1 ⊆ f2 → f1 ⋓ f2 ≘ f2.
+#f1 #f2 * -f1 -f2
+/3 width=7 by gr_sor_push_bi, gr_sor_next_bi, gr_sor_push_next/
+qed.
+
+(*** sor_sle_sn *)
+corec lemma gr_sor_sle_sn:
+ ∀f1,f2. f1 ⊆ f2 → f2 ⋓ f1 ≘ f2.
+#f1 #f2 * -f1 -f2
+/3 width=7 by gr_sor_push_bi, gr_sor_next_bi, gr_sor_next_push/
+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 "ground/relocation/gr_eq.ma".
+include "ground/relocation/gr_sor.ma".
+
+(* RELATIONAL UNION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Main inversion lemmas ****************************************************)
+
+(*** sor_mono *)
+corec theorem gr_sor_mono:
+ ∀f1,f2,x,y. f1 ⋓ f2 ≘ x → f1 ⋓ f2 ≘ y → x ≡ y.
+#f1 #f2 #x #y * -f1 -f2 -x
+#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #H
+[ cases (gr_sor_inv_push_bi … H … H1 H2)
+| cases (gr_sor_inv_next_push … H … H1 H2)
+| cases (gr_sor_inv_push_next … H … H1 H2)
+| cases (gr_sor_inv_next_bi … H … H1 H2)
+] -g1 -g2
+/3 width=5 by gr_eq_push, gr_eq_next/
+qed-.
+
+(* Main properties **********************************************************)
+
+(*** sor_assoc_dx *)
+axiom gr_sor_assoc_dx:
+ ∀f0,f3,f4. f0 ⋓ f3 ≘ f4 →
+ ∀f1,f2. f1 ⋓ f2 ≘ f0 →
+ ∀f. f2 ⋓ f3 ≘ f → f1 ⋓ f ≘ f4.
+
+(*** sor_assoc_sn *)
+axiom gr_sor_assoc_sn:
+ ∀f1,f0,f4. f1 ⋓ f0 ≘ f4 →
+ ∀f2, f3. f2 ⋓ f3 ≘ f0 →
+ ∀f. f1 ⋓ f2 ≘ f → f ⋓ f3 ≘ f4.
+
+(*** sor_comm_23 *)
+lemma gr_sor_comm_23:
+ ∀f0,f1,f2,f3,f4,f.
+ f0⋓f4 ≘ f1 → f1⋓f2 ≘ f → f0⋓f2 ≘ f3 → f3⋓f4 ≘ f.
+/4 width=6 by gr_sor_comm, gr_sor_assoc_dx/ qed-.
+
+(*** sor_comm_23_idem *)
+corec theorem gr_sor_comm_23_idem:
+ ∀f0,f1,f2. f0 ⋓ f1 ≘ f2 →
+ ∀f. f1 ⋓ f2 ≘ f → f1 ⋓ f0 ≘ f.
+#f0 #f1 #f2 * -f0 -f1 -f2
+#f0 #f1 #f2 #g0 #g1 #g2 #Hf2 #H0 #H1 #H2 #g #Hg
+[ cases (gr_sor_inv_push_bi … Hg … H1 H2)
+| cases (gr_sor_inv_push_next … Hg … H1 H2)
+| cases (gr_sor_inv_next_bi … Hg … H1 H2)
+| cases (gr_sor_inv_next_bi … Hg … H1 H2)
+] -g2 #f #Hf #H
+/3 width=7 by gr_sor_next_bi, gr_sor_next_push, gr_sor_push_next, gr_sor_push_bi/
+qed-.
+
+(*** sor_coll_dx *)
+corec theorem gr_sor_coll_dx:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f → ∀g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀g0. g1 ⋓ g0 ≘ f1 → g2 ⋓ g0 ≘ f2 → g ⋓ g0 ≘ f.
+#f1 #f2 #f cases (gr_map_split_tl f) #H1 #Hf #g1 #g2 #g #Hg #g0 #Hf1 #Hf2
+[ cases (gr_sor_inv_push … Hf … H1) -Hf #x1 #x2 #Hf #Hx1 #Hx2
+ cases (gr_sor_inv_push … Hf1 … Hx1) -f1 #y1 #y0 #Hf1 #Hy1 #Hy0
+ cases (gr_sor_inv_push_dx_push … Hf2 … Hy0 … Hx2) -f2 #y2 #Hf2 #Hy2
+ cases (gr_sor_inv_push_bi … Hg … Hy1 Hy2) -g1 -g2 #y #Hg #Hy
+ @(gr_sor_push_bi … Hy Hy0 H1) -g -g0 /2 width=8 by/
+| cases (gr_map_split_tl g) #H2
+ [ cases (gr_sor_inv_push … Hg … H2) -Hg #y1 #y2 #Hg #Hy1 #Hy2
+ cases (gr_sor_next_tl … Hf … H1) * #x1 #x2 #_ #Hx1 #Hx2
+ [ cases (gr_sor_inv_push_sn_next … Hf1 … Hy1 Hx1) -g1 #y0 #Hf1 #Hy0
+ cases (gr_sor_inv_push_next … Hf2 … Hy2 Hy0) -g2 -x2 #x2 #Hf2 #Hx2
+ | cases (gr_sor_inv_push_sn_next … Hf2 … Hy2 Hx2) -g2 #y0 #Hf2 #Hy0
+ cases (gr_sor_inv_push_next … Hf1 … Hy1 Hy0) -g1 -x1 #x1 #Hf1 #Hx1
+ ]
+ lapply (gr_sor_inv_next_bi_next … Hf … Hx1 Hx2 H1) -f1 -f2 #Hf
+ @(gr_sor_push_next … H2 Hy0 H1) -g0 /2 width=8 by/
+ | lapply (gr_sor_tl … Hf) -Hf #Hf
+ lapply (gr_sor_tl … Hg) -Hg #Hg
+ lapply (gr_sor_tl … Hf1) -Hf1 #Hf1
+ lapply (gr_sor_tl … Hf2) -Hf2 #Hf2
+ cases (gr_map_split_tl g0) #H0
+ [ @(gr_sor_next_push … H2 H0 H1) /2 width=8 by/
+ | @(gr_sor_next_bi … H2 H0 H1) /2 width=8 by/
+ ]
+ ]
+]
+qed-.
+
+(*** sor_distr_dx *)
+corec theorem gr_sor_distr_dx:
+ ∀g0,g1,g2,g. g1 ⋓ g2 ≘ g →
+ ∀f1,f2,f. g1 ⋓ g0 ≘ f1 → g2 ⋓ g0 ≘ f2 → g ⋓ g0 ≘ f →
+ f1 ⋓ f2 ≘ f.
+#g0 cases (gr_map_split_tl g0) #H0 #g1 #g2 #g
+[ * -g1 -g2 -g #y1 #y2 #y #g1 #g2 #g #Hy #Hy1 #Hy2 #Hy #f1 #f2 #f #Hf1 #Hf2 #Hf
+ [ cases (gr_sor_inv_push_bi … Hf1 … Hy1 H0) -g1
+ cases (gr_sor_inv_push_bi … Hf2 … Hy2 H0) -g2
+ cases (gr_sor_inv_push_bi … Hf … Hy H0) -g
+ | cases (gr_sor_inv_next_push … Hf1 … Hy1 H0) -g1
+ cases (gr_sor_inv_push_bi … Hf2 … Hy2 H0) -g2
+ cases (gr_sor_inv_next_push … Hf … Hy H0) -g
+ | cases (gr_sor_inv_push_bi … Hf1 … Hy1 H0) -g1
+ cases (gr_sor_inv_next_push … Hf2 … Hy2 H0) -g2
+ cases (gr_sor_inv_next_push … Hf … Hy H0) -g
+ | cases (gr_sor_inv_next_push … Hf1 … Hy1 H0) -g1
+ cases (gr_sor_inv_next_push … Hf2 … Hy2 H0) -g2
+ cases (gr_sor_inv_next_push … Hf … Hy H0) -g
+ ] #y #Hy #H #y2 #Hy2 #H2 #y1 #Hy1 #H1
+ /3 width=8 by gr_sor_next_bi, gr_sor_next_push, gr_sor_push_next, gr_sor_push_bi/
+| #H #f1 #f2 #f #Hf1 #Hf2 #Hf
+ cases (gr_sor_next_dx_tl … Hf1 … H0) -Hf1
+ cases (gr_sor_next_dx_tl … Hf2 … H0) -Hf2
+ cases (gr_sor_next_dx_tl … Hf … H0) -Hf
+ #y #x #Hx #Hy #H #y2 #x2 #Hx2 #Hy2 #H2 #y1 #x1 #Hx1 #Hy1 #H1
+ /4 width=8 by gr_sor_tl, gr_sor_next_bi/
+]
+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 "ground/relocation/gr_sle.ma".
+include "ground/relocation/gr_sor.ma".
+
+(* RELATIONAL UNION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Main inversion lemmas with inclusion ****************************************************)
+
+(*** monotonic_sle_sor *)
+axiom gr_sor_monotonic_sle:
+ ∀f1,g1. f1 ⊆ g1 → ∀f2,g2. f2 ⊆ g2 →
+ ∀f. f1 ⋓ f2 ≘ f → ∀g. g1 ⋓ g2 ≘ g → f ⊆ g.
--- /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 "ground/relocation/gr_tls.ma".
+include "ground/relocation/gr_sor.ma".
+
+(* RELATIONAL UNION FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with iterated tail ********************************************)
+
+(*** sor_tls *)
+lemma gr_sor_tls:
+ ∀f1,f2,f. f1 ⋓ f2 ≘ f →
+ ∀n. ⫱*[n]f1 ⋓ ⫱*[n]f2 ≘ ⫱*[n]f.
+#f1 #f2 #f #Hf #n @(nat_ind_succ … n) -n
+/2 width=1 by gr_sor_tl/
+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 "ground/notation/functions/droppred_1.ma".
+include "ground/lib/stream_hdtl.ma".
+include "ground/relocation/gr_map.ma".
+
+(* TAIL FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** tl *)
+definition gr_tl (f): gr_map ≝ ⫰f.
+
+interpretation
+ "tail (generic relocation maps)"
+ 'DropPred f = (gr_tl f).
+
+(* Basic properties *********************************************************)
+
+(*** tl_push_rew *)
+lemma gr_tl_push (f): f = ⫱⫯f.
+// qed.
+
+(*** tl_next_rew *)
+lemma gr_tl_next (f): f = ⫱↑f.
+// qed.
+
+(* Basic eliminators ********************************************************)
+
+(*** pn_split gr_map_split *)
+lemma gr_map_split_tl (f): ∨∨ ⫯⫱f = f | ↑⫱f = f.
+* * /2 width=1 by or_introl, or_intror/
+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 "ground/relocation/gr_eq.ma".
+include "ground/relocation/gr_tl.ma".
+
+(* TAIL FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq *)
+
+(*** eq_refl *)
+corec lemma gr_eq_refl: reflexive … gr_eq.
+#f cases (gr_map_split_tl f) #Hf
+[ @(gr_eq_push … Hf Hf) | @(gr_eq_next … Hf Hf) ] -Hf //
+qed.
+
+(*** tl_eq_repl *)
+lemma gr_tl_eq_repl:
+ gr_eq_repl … (λf1,f2. ⫱f1 ≡ ⫱f2).
+#f1 #f2 * -f1 -f2 //
+qed.
+
+(* Inversion lemmas with gr_eq ***************************************************)
+
+(*** eq_inv_gen *)
+lemma gr_eq_inv_gen (g1) (g2):
+ g1 ≡ g2 →
+ ∨∨ ∧∧ ⫱g1 ≡ ⫱g2 & ⫯⫱g1 = g1 & ⫯⫱g2 = g2
+ | ∧∧ ⫱g1 ≡ ⫱g2 & ↑⫱g1 = g1 & ↑⫱g2 = g2.
+#g1 #g2 * -g1 -g2 #f1 #f2 #g1 #g2 #f * *
+/3 width=1 by and3_intro, or_introl, or_intror/
+qed-.
+
+(* Advanced Inversion lemmas with gr_eq *)
+
+(*** gr_eq_inv_px *)
+lemma gr_eq_inv_push_sn (g1) (g2):
+ g1 ≡ g2 → ∀f1. ⫯f1 = g1 →
+ ∧∧ f1 ≡ ⫱g2 & ⫯⫱g2 = g2.
+#g1 #g2 #H #f1 #Hf1
+elim (gr_eq_inv_gen … H) -H * #Hg #Hg1 #Hg2 destruct
+[ /2 width=1 by conj/
+| elim (eq_inv_gr_next_push … Hg1)
+]
+qed-.
+
+(*** gr_eq_inv_nx *)
+lemma gr_eq_inv_next_sn (g1) (g2):
+ g1 ≡ g2 → ∀f1. ↑f1 = g1 →
+ ∧∧ f1 ≡ ⫱g2 & ↑⫱g2 = g2.
+#g1 #g2 #H #f1 #Hf1
+elim (gr_eq_inv_gen … H) -H * #Hg #Hg1 #Hg2 destruct
+[ elim (eq_inv_gr_push_next … Hg1)
+| /2 width=1 by conj/
+]
+qed-.
+
+(*** gr_eq_inv_xp *)
+lemma gr_eq_inv_push_dx (g1) (g2):
+ g1 ≡ g2 → ∀f2. ⫯f2 = g2 →
+ ∧∧ ⫱g1 ≡ f2 & ⫯⫱g1 = g1.
+#g1 #g2 #H #f2 #Hf2
+elim (gr_eq_inv_gen … H) -H * #Hg #Hg1 #Hg2 destruct
+[ /2 width=1 by conj/
+| elim (eq_inv_gr_next_push … Hg2)
+]
+qed-.
+
+(*** gr_eq_inv_xn *)
+lemma gr_eq_inv_next_dx (g1) (g2):
+ g1 ≡ g2 → ∀f2. ↑f2 = g2 →
+ ∧∧ ⫱g1 ≡ f2 & ↑⫱g1 = g1.
+#g1 #g2 #H #f2 #Hf2
+elim (gr_eq_inv_gen … H) -H * #Hg #Hg1 #Hg2 destruct
+[ elim (eq_inv_gr_push_next … Hg2)
+| /2 width=1 by conj/
+]
+qed-.
+
+(*** gr_eq_inv_pp *)
+lemma gr_eq_inv_push_bi (g1) (g2):
+ g1 ≡ g2 → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 → f1 ≡ f2.
+#g1 #g2 #H #f1 #f2 #H1
+elim (gr_eq_inv_push_sn … H … H1) -g1 #Hx2 * #H
+lapply (eq_inv_gr_push_bi … H) -H //
+qed-.
+
+(*** gr_eq_inv_nn *)
+lemma gr_eq_inv_next_bi (g1) (g2):
+ g1 ≡ g2 → ∀f1,f2. ↑f1 = g1 → ↑f2 = g2 → f1 ≡ f2.
+#g1 #g2 #H #f1 #f2 #H1
+elim (gr_eq_inv_next_sn … H … H1) -g1 #Hx2 * #H
+lapply (eq_inv_gr_next_bi … H) -H //
+qed-.
+
+(*** gr_eq_inv_pn *)
+lemma gr_eq_inv_push_next (g1) (g2):
+ g1 ≡ g2 → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 → ⊥.
+#g1 #g2 #H #f1 #f2 #H1
+elim (gr_eq_inv_push_sn … H … H1) -g1 #Hx2 * #H
+elim (eq_inv_gr_next_push … H)
+qed-.
+
+(*** gr_eq_inv_np *)
+lemma gr_eq_inv_next_push (g1) (g2):
+ g1 ≡ g2 → ∀f1,f2. ↑f1 = g1 → ⫯f2 = g2 → ⊥.
+#g1 #g2 #H #f1 #f2 #H1
+elim (gr_eq_inv_next_sn … H … H1) -g1 #Hx2 * #H
+elim (eq_inv_gr_push_next … H)
+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 "ground/relocation/gr_tl_eq.ma".
+
+(* TAIL FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Main properties with gr_eq **********************************************************)
+
+(*** eq_trans *)
+corec theorem gr_eq_trans: Transitive … gr_eq.
+#f1 #f * -f1 -f
+#f1 #f #g1 #g #Hf1 #H1 #H #f2 #Hf2
+[ cases (gr_eq_inv_push_sn … Hf2 … H)
+| cases (gr_eq_inv_next_sn … Hf2 … H)
+] -g
+/3 width=5 by gr_eq_push, gr_eq_next/
+qed-.
+
+(*** eq_canc_sn *)
+theorem gr_eq_canc_sn (f2): gr_eq_repl_back (λf. f ≡ f2).
+/3 width=3 by gr_eq_trans, gr_eq_sym/ qed-.
+
+(*** eq_canc_dx *)
+theorem gr_eq_canc_dx (f1): gr_eq_repl_fwd (λf. f1 ≡ f).
+/3 width=5 by gr_eq_canc_sn, gr_eq_repl_sym/ 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 "ground/notation/functions/droppreds_2.ma".
+include "ground/lib/stream_tls.ma".
+include "ground/relocation/gr_tl.ma".
+
+(* ITERATED TAIL FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** tls *)
+definition gr_tls (n) (f:gr_map) ≝ ⫰*[n]f.
+
+interpretation
+ "iterated tail (generic relocation maps)"
+ 'DropPreds n f = (gr_tls n f).
+
+(* Basic properties (specific) *********************************************************)
+
+(*** tls_O *)
+lemma gr_tls_zero (f): f = ⫱*[𝟎] f.
+// qed.
+
+(*** tls_swap *)
+lemma gr_tls_tl (n) (f): ⫱⫱*[n] f = ⫱*[n] ⫱f.
+/2 width=1 by stream_tls_tl/ qed.
+
+(*** tls_S *)
+lemma gr_tls_succ (n) (f): ⫱⫱*[n] f = ⫱*[↑n] f.
+/2 width=1 by stream_tls_succ/ qed.
+
+(*** tls_xn *)
+lemma gr_tls_swap (n) (f): ⫱*[n] ⫱f = ⫱*[↑n] f.
+// 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 "ground/relocation/gr_tl_eq.ma".
+include "ground/relocation/gr_tls.ma".
+
+(* ITERATED TAIL FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with gr_eq ******************************************************)
+
+(*** tls_eq_repl *)
+lemma gr_tls_eq_repl (n):
+ gr_eq_repl (λf1,f2. ⫱*[n] f1 ≡ ⫱*[n] f2).
+#n @(nat_ind_succ … n) -n /3 width=1 by gr_tl_eq_repl/
+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 "ground/relocation/gr_nexts.ma".
+include "ground/relocation/gr_tls_eq.ma".
+
+(* ITERATED TAIL FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Inversion lemmas with gr_nexts and gr_eq *****************************************************)
+
+(*** eq_inv_nexts_sn *)
+lemma gr_eq_inv_nexts_sn (n):
+ ∀f1,g2. ↑*[n] f1 ≡ g2 →
+ ∧∧ f1 ≡ ⫱*[n]g2 & ↑*[n]⫱*[n]g2 = g2.
+#n @(nat_ind_succ … n) -n /2 width=1 by conj/
+#n #IH #f1 #g2 #H
+elim (gr_eq_inv_next_sn … H) -H [|*: // ] #Hf10 *
+elim (IH … Hf10) -IH -Hf10 #Hf12 #H2
+<gr_tls_succ /2 width=1 by conj/
+qed-.
+
+(*** eq_inv_nexts_dx *)
+lemma gr_eq_inv_nexts_dx (n):
+ ∀f2,g1. g1 ≡ ↑*[n] f2 →
+ ∧∧ ⫱*[n]g1 ≡ f2 & ↑*[n]⫱*[n]g1 = g1.
+#n @(nat_ind_succ … n) -n /2 width=1 by conj/
+#n #IH #f2 #g1 #H
+elim (gr_eq_inv_next_dx … H) -H [|*: // ] #Hf02 *
+elim (IH … Hf02) -IH -Hf02 #Hf12 #H2
+<gr_tls_succ /2 width=1 by conj/
+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 "ground/relocation/gr_pushs.ma".
+include "ground/relocation/gr_tls.ma".
+
+(* ITERATED TAIL FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Properties with pushs ****************************************************)
+
+(*** tls_pushs *)
+lemma gr_tls_pushs (n) (f): f = ⫱*[n] ⫯*[n] f.
+#n @(nat_ind_succ … n) -n //
+#n #IH #f <gr_tls_swap <gr_pushs_succ <gr_tl_push //
+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 "ground/relocation/gr_tls_eq.ma".
+include "ground/relocation/gr_pushs.ma".
+
+(* ITERATED TAIL FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Inversion lemmas with gr_pushs and gr_eq *****************************************************)
+
+(*** eq_inv_pushs_sn *)
+lemma gr_eq_inv_pushs_sn (n):
+ ∀f1,g2. ⫯*[n] f1 ≡ g2 →
+ ∧∧ f1 ≡ ⫱*[n]g2 & ⫯*[n]⫱*[n]g2 = g2.
+#n @(nat_ind_succ … n) -n /2 width=1 by conj/
+#n #IH #f1 #g2 #H
+elim (gr_eq_inv_push_sn … H) -H [|*: // ] #Hf10 *
+elim (IH … Hf10) -IH -Hf10 #Hf12 #H1
+/2 width=1 by conj/
+qed-.
+
+(*** eq_inv_pushs_dx *)
+lemma gr_eq_inv_pushs_dx (n):
+ ∀f2,g1. g1 ≡ ⫯*[n] f2 →
+ ∧∧ ⫱*[n]g1 ≡ f2 & ⫯*[n]⫱*[n]g1 = g1.
+#n @(nat_ind_succ … n) -n /2 width=1 by conj/
+#n #IH #f2 #g1 #H
+elim (gr_eq_inv_push_dx … H) -H [|*: // ] #Hf02 *
+elim (IH … Hf02) -IH -Hf02 #Hf12 #H2
+/2 width=1 by conj/
+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 "ground/notation/functions/element_u_1.ma".
+include "ground/relocation/gr_nexts.ma".
+include "ground/relocation/gr_id.ma".
+
+(* UNIFORM ELEMENTS FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(*** uni *)
+definition gr_uni (n) ≝ ↑*[n] 𝐢.
+
+interpretation
+ "uniform elements (generic relocation maps)"
+ 'ElementU n = (gr_uni n).
+
+(* Basic properties *********************************************************)
+
+(*** uni_zero *)
+lemma gr_uni_zero: 𝐢 = 𝐮❨𝟎❩.
+// qed.
+
+(*** uni_succ *)
+lemma gr_uni_succ (n): ↑𝐮❨n❩ = 𝐮❨↑n❩.
+/2 width=1 by gr_nexts_succ/ 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 "ground/arith/nat_pred_succ.ma".
+include "ground/relocation/gr_tl_eq.ma".
+include "ground/relocation/gr_uni.ma".
+
+(* UNIFORM ELEMENTS FOR GENERIC RELOCATION MAPS ***********************************************************)
+
+(* Inversion lemmas with gr_eq ***************************************************)
+
+(*** uni_inv_push_dx *)
+lemma gr_eq_inv_uni_push (n) (g): 𝐮❨n❩ ≡ ⫯g → ∧∧ 𝟎 = n & 𝐢 ≡ g.
+#n @(nat_ind_succ … n) -n
+[ /3 width=5 by gr_eq_inv_push_bi, conj/
+| #n #_ #f <gr_uni_succ #H elim (gr_eq_inv_next_push … H) -H //
+]
+qed-.
+
+(*** uni_inv_push_sn *)
+lemma gr_eq_inv_push_uni (n) (g): ⫯g ≡ 𝐮❨n❩ → ∧∧ 𝟎 = n & 𝐢 ≡ g.
+/3 width=1 by gr_eq_inv_uni_push, gr_eq_sym/ qed-.
+
+(*** uni_inv_next_dx *)
+lemma gr_eq_inv_uni_next (n) (g): 𝐮❨n❩ ≡ ↑g → ∧∧ 𝐮❨↓n❩ ≡ g & ↑↓n = n.
+#n @(nat_ind_succ … n) -n
+[ #g <gr_uni_zero <gr_id_unfold #H elim (gr_eq_inv_push_next … H) -H //
+| #n #_ #g <gr_uni_succ /3 width=5 by gr_eq_inv_next_bi, conj/
+]
+qed-.
+
+(*** uni_inv_next_sn *)
+lemma gr_eq_inv_next_uni (n) (g): ↑g ≡ 𝐮❨n❩ → ∧∧ 𝐮❨↓n❩ ≡ g & ↑↓n = n.
+/3 width=1 by gr_eq_inv_uni_next, gr_eq_sym/ qed-.
+
+(* Inversion lemmas with id and gr_eq *)
+
+(*** uni_inv_id_dx *)
+lemma gr_eq_inv_uni_id (n): 𝐮❨n❩ ≡ 𝐢 → 𝟎 = n.
+#n <gr_id_unfold #H elim (gr_eq_inv_uni_push … H) -H //
+qed-.
+
+(*** uni_inv_id_sn *)
+lemma gr_eq_inv_id_uni (n): 𝐢 ≡ 𝐮❨n❩ → 𝟎 = n.
+/3 width=1 by gr_eq_inv_uni_id, gr_eq_sym/ 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 "ground/notation/functions/diamond_0.ma".
-include "ground/notation/functions/semicolon_3.ma".
-include "ground/arith/nat.ma".
-
-(* MULTIPLE RELOCATION WITH PAIRS *******************************************)
-
-inductive mr2: Type[0] :=
- | nil2 : mr2
- | cons2: nat → nat → mr2 → mr2.
-
-interpretation "nil (multiple relocation with pairs)"
- 'Diamond = (nil2).
-
-interpretation "cons (multiple relocation with pairs)"
- 'Semicolon hd1 hd2 tl = (cons2 hd1 hd2 tl).
+++ /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 "ground/notation/functions/append_2.ma".
-include "ground/relocation/mr2.ma".
-
-(* MULTIPLE RELOCATION WITH PAIRS *******************************************)
-
-let rec mr2_append cs1 cs2 on cs1 ≝
- match cs1 with
- [ nil2 ⇒ cs2
- | cons2 l m cs1 ⇒ ❨l, m❩; mr2_append cs1 cs2
- ].
-
-interpretation "append (multiple relocation with pairs)"
- 'Append cs1 cs2 = (mr2_append cs1 cs2).
-
-(* Basic properties *********************************************************)
-
-lemma mr2_append_nil (cs2): cs2 = ◊ @@ cs2.
-// qed.
-
-lemma mr2_append_cons (l) (m) (cs1) (cs2):
- ❨l, m❩; (cs1 @@ cs2) = (❨l, m❩; cs1) @@ cs2.
-// 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 "ground/notation/relations/rat_3.ma".
-include "ground/arith/nat_plus.ma".
-include "ground/arith/nat_lt.ma".
-include "ground/relocation/mr2.ma".
-
-(* MULTIPLE RELOCATION WITH PAIRS *******************************************)
-
-inductive at: mr2 → relation nat ≝
-| at_nil: ∀i. at (◊) i i
-| at_lt : ∀cs,l,m,i1,i2. i1 < l →
- at cs i1 i2 → at (❨l, m❩;cs) i1 i2
-| at_ge : ∀cs,l,m,i1,i2. l ≤ i1 →
- at cs (i1 + m) i2 → at (❨l, m❩;cs) i1 i2
-.
-
-interpretation "application (multiple relocation with pairs)"
- 'RAt i1 cs i2 = (at cs i1 i2).
-
-(* Basic inversion lemmas ***************************************************)
-
-fact at_inv_nil_aux: ∀cs,i1,i2. @❪i1, cs❫ ≘ i2 → cs = ◊ → i1 = i2.
-#cs #i1 #i2 * -cs -i1 -i2
-[ //
-| #cs #l #m #i1 #i2 #_ #_ #H destruct
-| #cs #l #m #i1 #i2 #_ #_ #H destruct
-]
-qed-.
-
-lemma at_inv_nil: ∀i1,i2. @❪i1, ◊❫ ≘ i2 → i1 = i2.
-/2 width=3 by at_inv_nil_aux/ qed-.
-
-fact at_inv_cons_aux: ∀cs,i1,i2. @❪i1, cs❫ ≘ i2 →
- ∀l,m,cs0. cs = ❨l, m❩;cs0 →
- i1 < l ∧ @❪i1, cs0❫ ≘ i2 ∨
- l ≤ i1 ∧ @❪i1 + m, cs0❫ ≘ i2.
-#cs #i1 #i2 * -cs -i1 -i2
-[ #i #l #m #cs #H destruct
-| #cs1 #l1 #m1 #i1 #i2 #Hil1 #Hi12 #l2 #m2 #cs2 #H destruct /3 width=1 by or_introl, conj/
-| #cs1 #l1 #m1 #i1 #i2 #Hli1 #Hi12 #l2 #m2 #cs2 #H destruct /3 width=1 by or_intror, conj/
-]
-qed-.
-
-lemma at_inv_cons: ∀cs,l,m,i1,i2. @❪i1, ❨l, m❩;cs❫ ≘ i2 →
- i1 < l ∧ @❪i1, cs❫ ≘ i2 ∨
- l ≤ i1 ∧ @❪i1 + m, cs❫ ≘ i2.
-/2 width=3 by at_inv_cons_aux/ qed-.
-
-lemma at_inv_cons_lt: ∀cs,l,m,i1,i2. @❪i1, ❨l, m❩;cs❫ ≘ i2 →
- i1 < l → @❪i1, cs❫ ≘ i2.
-#cs #l #m #i1 #m2 #H
-elim (at_inv_cons … H) -H * // #Hli1 #_ #Hi1l
-elim (nlt_ge_false … Hi1l Hli1)
-qed-.
-
-lemma at_inv_cons_ge: ∀cs,l,m,i1,i2. @❪i1, ❨l, m❩;cs❫ ≘ i2 →
- l ≤ i1 → @❪i1 + m, cs❫ ≘ i2.
-#cs #l #m #i1 #m2 #H
-elim (at_inv_cons … H) -H * // #Hi1l #_ #Hli1
-elim (nlt_ge_false … Hi1l Hli1)
-qed-.
-
-(* Main properties **********************************************************)
-
-theorem at_mono: ∀cs,i,i1. @❪i, cs❫ ≘ i1 → ∀i2. @❪i, cs❫ ≘ i2 → i1 = i2.
-#cs #i #i1 #H elim H -cs -i -i1
-[ #i #x #H <(at_inv_nil … H) -x //
-| #cs #l #m #i #i1 #Hil #_ #IHi1 #x #H
- lapply (at_inv_cons_lt … H Hil) -H -Hil /2 width=1 by/
-| #cs #l #m #i #i1 #Hli #_ #IHi1 #x #H
- lapply (at_inv_cons_ge … H Hli) -H -Hli /2 width=1 by/
-]
-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 "ground/xoa/ex_3_1.ma".
-include "ground/notation/relations/rminus_3.ma".
-include "ground/arith/nat_plus.ma".
-include "ground/arith/nat_minus.ma".
-include "ground/arith/nat_lt.ma".
-include "ground/relocation/mr2.ma".
-
-(* MULTIPLE RELOCATION WITH PAIRS *******************************************)
-
-inductive minuss: nat → relation mr2 ≝
-| minuss_nil: ∀i. minuss i (◊) (◊)
-| minuss_lt : ∀cs1,cs2,l,m,i. i < l → minuss i cs1 cs2 →
- minuss i (❨l, m❩;cs1) (❨l - i, m❩;cs2)
-| minuss_ge : ∀cs1,cs2,l,m,i. l ≤ i → minuss (m + i) cs1 cs2 →
- minuss i (❨l, m❩;cs1) cs2
-.
-
-interpretation "minus (multiple relocation with pairs)"
- 'RMinus cs1 i cs2 = (minuss i cs1 cs2).
-
-(* Basic inversion lemmas ***************************************************)
-
-fact minuss_inv_nil1_aux: ∀cs1,cs2,i. cs1 ▭ i ≘ cs2 → cs1 = ◊ → cs2 = ◊.
-#cs1 #cs2 #i * -cs1 -cs2 -i
-[ //
-| #cs1 #cs2 #l #m #i #_ #_ #H destruct
-| #cs1 #cs2 #l #m #i #_ #_ #H destruct
-]
-qed-.
-
-lemma minuss_inv_nil1: ∀cs2,i. ◊ ▭ i ≘ cs2 → cs2 = ◊.
-/2 width=4 by minuss_inv_nil1_aux/ qed-.
-
-fact minuss_inv_cons1_aux: ∀cs1,cs2,i. cs1 ▭ i ≘ cs2 →
- ∀l,m,cs. cs1 = ❨l, m❩;cs →
- l ≤ i ∧ cs ▭ m + i ≘ cs2 ∨
- ∃∃cs0. i < l & cs ▭ i ≘ cs0 &
- cs2 = ❨l - i, m❩;cs0.
-#cs1 #cs2 #i * -cs1 -cs2 -i
-[ #i #l #m #cs #H destruct
-| #cs1 #cs #l1 #m1 #i1 #Hil1 #Hcs #l2 #m2 #cs2 #H destruct /3 width=3 by ex3_intro, or_intror/
-| #cs1 #cs #l1 #m1 #i1 #Hli1 #Hcs #l2 #m2 #cs2 #H destruct /3 width=1 by or_introl, conj/
-]
-qed-.
-
-lemma minuss_inv_cons1: ∀cs1,cs2,l,m,i. ❨l, m❩;cs1 ▭ i ≘ cs2 →
- l ≤ i ∧ cs1 ▭ m + i ≘ cs2 ∨
- ∃∃cs. i < l & cs1 ▭ i ≘ cs &
- cs2 = ❨l - i, m❩;cs.
-/2 width=3 by minuss_inv_cons1_aux/ qed-.
-
-lemma minuss_inv_cons1_ge: ∀cs1,cs2,l,m,i. ❨l, m❩;cs1 ▭ i ≘ cs2 →
- l ≤ i → cs1 ▭ m + i ≘ cs2.
-#cs1 #cs2 #l #m #i #H
-elim (minuss_inv_cons1 … H) -H * // #cs #Hil #_ #_ #Hli
-elim (nlt_ge_false … Hil Hli)
-qed-.
-
-lemma minuss_inv_cons1_lt: ∀cs1,cs2,l,m,i. ❨l, m❩;cs1 ▭ i ≘ cs2 →
- i < l →
- ∃∃cs. cs1 ▭ i ≘ cs & cs2 = ❨l - i, m❩;cs.
-#cs1 #cs2 #l #m #i #H elim (minuss_inv_cons1 … H) -H * /2 width=3 by ex2_intro/
-#Hli #_ #Hil elim (nlt_ge_false … Hil Hli)
-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 "ground/arith/nat_minus_plus.ma".
-include "ground/relocation/mr2.ma".
-
-(* MULTIPLE RELOCATION WITH PAIRS *******************************************)
-
-rec definition pluss (cs:mr2) (i:nat) on cs ≝ match cs with
-[ nil2 ⇒ ◊
-| cons2 l m cs ⇒ ❨l + i,m❩;pluss cs i
-].
-
-interpretation "plus (multiple relocation with pairs)"
- 'plus x y = (pluss x y).
-
-(* Basic properties *********************************************************)
-
-lemma pluss_SO2: ∀l,m,cs. ((❨l,m❩;cs) + 𝟏) = ❨↑l,m❩;cs + 𝟏.
-normalize // qed.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma pluss_inv_nil2: ∀i,cs. cs + i = ◊ → cs = ◊.
-#i * // normalize
-#l #m #cs #H destruct
-qed.
-
-lemma pluss_inv_cons2: ∀i,l,m,cs2,cs. cs + i = ❨l,m❩;cs2 →
- ∃∃cs1. cs1 + i = cs2 & cs = ❨l - i,m❩;cs1.
-#i #l #m #cs2 *
-[ normalize #H destruct
-| #l1 #m1 #cs1 whd in ⊢ (??%?→?); #H destruct
- <nminus_plus_sn_refl_sn /2 width=3 by ex2_intro/
-]
-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 "ground/notation/functions/upspoon_1.ma".
-include "ground/lib/stream.ma".
-include "ground/arith/pnat.ma".
-
-(* RELOCATION P-STREAM ******************************************************)
-
-definition rtmap: Type[0] ≝ stream pnat.
-
-definition push: rtmap → rtmap ≝ λf. 𝟏⨮f.
-
-interpretation "push (pstream)" 'UpSpoon f = (push f).
-
-definition next: rtmap → rtmap.
-* #p #f @(↑p⨮f)
-defined.
-
-interpretation "next (pstream)" 'UpArrow f = (next f).
-
-(* Basic properties *********************************************************)
-
-lemma push_rew: ∀f. 𝟏⨮f = ⫯f.
-// qed.
-
-lemma next_rew: ∀f,p. (↑p)⨮f = ↑(p⨮f).
-// qed.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma injective_push: injective ? ? push.
-#f1 #f2 <push_rew <push_rew #H destruct //
-qed-.
-
-lemma discr_push_next: ∀f1,f2. ⫯f1 = ↑f2 → ⊥.
-#f1 * #p2 #f2 <push_rew <next_rew #H destruct
-qed-.
-
-lemma discr_next_push: ∀f1,f2. ↑f1 = ⫯f2 → ⊥.
-* #p1 #f1 #f2 <next_rew <push_rew #H destruct
-qed-.
-
-lemma injective_next: injective ? ? next.
-* #p1 #f1 * #p2 #f2 <next_rew <next_rew #H destruct //
-qed-.
-
-lemma push_inv_seq_sn: ∀f,g,p. p⨮g = ⫯f → ∧∧ 𝟏 = p & g = f.
-#f #g #p <push_rew #H destruct /2 width=1 by conj/
-qed-.
-
-lemma push_inv_seq_dx: ∀f,g,p. ⫯f = p⨮g → ∧∧ 𝟏 = p & g = f.
-#f #g #p <push_rew #H destruct /2 width=1 by conj/
-qed-.
-
-lemma next_inv_seq_sn: ∀f,g,p. p⨮g = ↑f → ∃∃q. q⨮g = f & ↑q = p.
-* #q #f #g #p <next_rew #H destruct /2 width=3 by ex2_intro/
-qed-.
-
-lemma next_inv_seq_dx: ∀f,g,p. ↑f = p⨮g → ∃∃q. q⨮g = f & ↑q = p.
-* #q #f #g #p <next_rew #H destruct /2 width=3 by ex2_intro/
-qed-.
-
-lemma case_prop (Q:predicate rtmap):
- (∀f. Q (⫯f)) → (∀f. Q (↑f)) → ∀f. Q f.
-#Q #H1 #H2 * * //
-qed-.
-
-lemma case_type0 (Q:rtmap→Type[0]):
- (∀f. Q (⫯f)) → (∀f. Q (↑f)) → ∀f. Q f.
-#Q #H1 #H2 * * //
-qed-.
-
-lemma iota_push: ∀Q,a,b,f. a f = case_type0 Q a b (⫯f).
-// qed.
-
-lemma iota_next: ∀Q,a,b,f. b f = case_type0 Q a b (↑f).
-#Q #a #b * //
-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 "ground/relocation/pstream_tls.ma".
-include "ground/relocation/pstream_istot.ma".
-include "ground/relocation/rtmap_after.ma".
-
-(* RELOCATION N-STREAM ******************************************************)
-
-corec definition compose: rtmap → rtmap → rtmap.
-#f2 * #p1 #f1 @(stream_cons … (f2@❨p1❩)) @(compose ? f1) -compose -f1
-@(⫰*[p1]f2)
-defined.
-
-interpretation "functional composition (nstream)"
- 'compose f2 f1 = (compose f2 f1).
-
-(* Basic properies on compose ***********************************************)
-
-lemma compose_rew: ∀f2,f1,p1. f2@❨p1❩⨮(⫰*[p1]f2)∘f1 = f2∘(p1⨮f1).
-#f2 #f1 #p1 <(stream_rew … (f2∘(p1⨮f1))) normalize //
-qed.
-
-lemma compose_next: ∀f2,f1,f. f2∘f1 = f → (↑f2)∘f1 = ↑f.
-#f2 * #p1 #f1 #f <compose_rew <compose_rew
-* -f /2 width=1 by eq_f2/
-qed.
-
-(* Basic inversion lemmas on compose ****************************************)
-
-lemma compose_inv_rew: ∀f2,f1,f,p1,p. f2∘(p1⨮f1) = p⨮f →
- f2@❨p1❩ = p ∧ (⫰*[p1]f2)∘f1 = f.
-#f2 #f1 #f #p1 #p <compose_rew
-#H destruct /2 width=1 by conj/
-qed-.
-
-lemma compose_inv_O2: ∀f2,f1,f,p2,p. (p2⨮f2)∘(⫯f1) = p⨮f →
- p2 = p ∧ f2∘f1 = f.
-#f2 #f1 #f #p2 #p <compose_rew
-#H destruct /2 width=1 by conj/
-qed-.
-
-lemma compose_inv_S2: ∀f2,f1,f,p2,p1,p. (p2⨮f2)∘(↑p1⨮f1) = p⨮f →
- f2@❨p1❩+p2 = p ∧ f2∘(p1⨮f1) = f2@❨p1❩⨮f.
-#f2 #f1 #f #p2 #p1 #p <compose_rew
-#H destruct >nsucc_inj <stream_tls_swap
-/2 width=1 by conj/
-qed-.
-
-lemma compose_inv_S1: ∀f2,f1,f,p1,p. (↑f2)∘(p1⨮f1) = p⨮f →
- ↑(f2@❨p1❩) = p ∧ f2∘(p1⨮f1) = f2@❨p1❩⨮f.
-#f2 #f1 #f #p1 #p <compose_rew
-#H destruct /2 width=1 by conj/
-qed-.
-
-(* Specific properties on after *********************************************)
-
-lemma after_O2: ∀f2,f1,f. f2 ⊚ f1 ≘ f →
- ∀p. p⨮f2 ⊚ ⫯f1 ≘ p⨮f.
-#f2 #f1 #f #Hf #p elim p -p
-/2 width=7 by after_refl, after_next/
-qed.
-
-lemma after_S2: ∀f2,f1,f,p1,p. f2 ⊚ p1⨮f1 ≘ p⨮f →
- ∀p2. p2⨮f2 ⊚ ↑p1⨮f1 ≘ (p+p2)⨮f.
-#f2 #f1 #f #p1 #p #Hf #p2 elim p2 -p2
-/2 width=7 by after_next, after_push/
-qed.
-
-lemma after_apply: ∀p1,f2,f1,f.
- (⫰*[ninj p1] f2) ⊚ f1 ≘ f → f2 ⊚ p1⨮f1 ≘ f2@❨p1❩⨮f.
-#p1 elim p1 -p1
-[ * /2 width=1 by after_O2/
-| #p1 #IH * #p2 #f2 >nsucc_inj <stream_tls_swap
- /3 width=1 by after_S2/
-]
-qed-.
-
-corec lemma after_total_aux: ∀f2,f1,f. f2 ∘ f1 = f → f2 ⊚ f1 ≘ f.
-* #p2 #f2 * #p1 #f1 * #p #f cases p2 -p2
-[ cases p1 -p1
- [ #H cases (compose_inv_O2 … H) -H /3 width=7 by after_refl, eq_f2/
- | #p1 #H cases (compose_inv_S2 … H) -H * -p /3 width=7 by after_push/
- ]
-| #p2 >next_rew #H cases (compose_inv_S1 … H) -H * -p >next_rew
- /3 width=5 by after_next/
-]
-qed-.
-
-theorem after_total: ∀f1,f2. f2 ⊚ f1 ≘ f2 ∘ f1.
-/2 width=1 by after_total_aux/ qed.
-
-(* Specific inversion lemmas on after ***************************************)
-
-lemma after_inv_xpx: ∀f2,g2,f,p2,p. p2⨮f2 ⊚ g2 ≘ p⨮f → ∀f1. ⫯f1 = g2 →
- f2 ⊚ f1 ≘ f ∧ p2 = p.
-#f2 #g2 #f #p2 elim p2 -p2
-[ #p #Hf #f1 #H2 elim (after_inv_ppx … Hf … H2) -g2 [|*: // ]
- #g #Hf #H elim (push_inv_seq_dx … H) -H destruct /2 width=1 by conj/
-| #p2 #IH #p #Hf #f1 #H2 elim (after_inv_nxx … Hf) -Hf [|*: // ]
- #g1 #Hg #H1 elim (next_inv_seq_dx … H1) -H1
- #x #Hx #H destruct elim (IH … Hg) [|*: // ] -IH -Hg
- #H destruct /2 width=1 by conj/
-]
-qed-.
-
-lemma after_inv_xnx: ∀f2,g2,f,p2,p. p2⨮f2 ⊚ g2 ≘ p⨮f → ∀f1. ↑f1 = g2 →
- ∃∃q. f2 ⊚ f1 ≘ q⨮f & q+p2 = p.
-#f2 #g2 #f #p2 elim p2 -p2
-[ #p #Hf #f1 #H2 elim (after_inv_pnx … Hf … H2) -g2 [|*: // ]
- #g #Hf #H elim (next_inv_seq_dx … H) -H
- #x #Hx #Hg destruct /2 width=3 by ex2_intro/
-| #p2 #IH #p #Hf #f1 #H2 elim (after_inv_nxx … Hf) -Hf [|*: // ]
- #g #Hg #H elim (next_inv_seq_dx … H) -H
- #x #Hx #H destruct elim (IH … Hg) -IH -Hg [|*: // ]
- #m #Hf #Hm destruct /2 width=3 by ex2_intro/
-]
-qed-.
-
-lemma after_inv_const: ∀f2,f1,f,p1,p.
- p⨮f2 ⊚ p1⨮f1 ≘ p⨮f → f2 ⊚ f1 ≘ f ∧ 𝟏 = p1.
-#f2 #f1 #f #p1 #p elim p -p
-[ #H elim (after_inv_pxp … H) -H [|*: // ]
- #g2 #Hf #H elim (push_inv_seq_dx … H) -H /2 width=1 by conj/
-| #p #IH #H lapply (after_inv_nxn … H ????) -H /2 width=5 by/
-]
-qed-.
-
-lemma after_inv_total: ∀f2,f1,f. f2 ⊚ f1 ≘ f → f2 ∘ f1 ≡ f.
-/2 width=4 by after_mono/ qed-.
-
-(* Specific forward lemmas on after *****************************************)
-
-lemma after_fwd_hd: ∀f2,f1,f,p1,p. f2 ⊚ p1⨮f1 ≘ p⨮f → f2@❨p1❩ = p.
-#f2 #f1 #f #p1 #p #H lapply (after_fwd_at ? p1 (𝟏) … H) -H [4:|*: // ]
-/3 width=2 by at_inv_O1, sym_eq/
-qed-.
-
-lemma after_fwd_tls: ∀f,f1,p1,f2,p2,p. p2⨮f2 ⊚ p1⨮f1 ≘ p⨮f →
- (⫰*[↓p1]f2) ⊚ f1 ≘ f.
-#f #f1 #p1 elim p1 -p1
-[ #f2 #p2 #p #H elim (after_inv_xpx … H) -H //
-| #p1 #IH * #q2 #f2 #p2 #p #H elim (after_inv_xnx … H) -H [|*: // ]
- #x #Hx #H destruct /2 width=3 by/
-]
-qed-.
-
-lemma after_inv_apply: ∀f2,f1,f,p2,p1,p. p2⨮f2 ⊚ p1⨮f1 ≘ p⨮f →
- (p2⨮f2)@❨p1❩ = p ∧ (⫰*[↓p1]f2) ⊚ f1 ≘ f.
-/3 width=3 by after_fwd_tls, after_fwd_hd, conj/ qed-.
-
-(* Properties on apply ******************************************************)
-
-lemma compose_apply (f2) (f1) (i): f2@❨f1@❨i❩❩ = (f2∘f1)@❨i❩.
-/4 width=6 by after_fwd_at, at_inv_total, sym_eq/ 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 "ground/arith/nat_lt_plus.ma".
-include "ground/relocation/rtmap_basic_at.ma".
-include "ground/relocation/pstream_after.ma".
-
-(* RELOCATION N-STREAM ******************************************************)
-
-(* Specific properties on basic relocation **********************************)
-
-lemma apply_basic_lt: ∀m,n,i. ninj i ≤ m → 𝐁❨m,n❩@❨i❩ = i.
-/3 width=1 by at_inv_total, at_basic_lt/ qed-.
-
-lemma apply_basic_ge: ∀m,n,i. m < ninj i → 𝐁❨m,n❩@❨i❩ = i+n.
-/3 width=1 by at_inv_total, at_basic_ge/ qed-.
-
-(* Specific main properties on basic relocation *****************************)
-
-theorem basic_swap: ∀d1,d2. d2 ≤ d1 →
- ∀h1,h2. 𝐁❨d2,h2❩∘𝐁❨d1,h1❩ ≡ 𝐁❨d1+h2,h1❩∘𝐁❨d2,h2❩.
-#d1 #d2 #Hd21 #h1 #h2
-@nstream_inv_eq
-@nstream_eq_inv_ext #i
-<compose_apply <compose_apply
-elim (nat_split_lt_ge d2 i) #Hd2
-[ elim (nat_split_lt_ge d1 i) -Hd21 #Hd1
- [ >(apply_basic_ge … Hd1) >(apply_basic_ge … Hd2) >apply_basic_ge
- [ >apply_basic_ge // >nrplus_inj_sn /2 width=1 by nlt_plus_bi_sn/
- | >nrplus_inj_sn /2 width=2 by nlt_plus_dx_dx/
- ]
- | >(apply_basic_lt … Hd1) >(apply_basic_ge … Hd2)
- >apply_basic_lt // >nrplus_inj_sn /2 width=1 by nle_plus_bi_dx/
- ]
-| lapply (nle_trans … Hd2 … Hd21) -Hd21 #Hd1
- >(apply_basic_lt … Hd1) >(apply_basic_lt … Hd2)
- >apply_basic_lt /2 width=1 by nle_plus_dx_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 "ground/notation/functions/cocompose_2.ma".
-include "ground/relocation/rtmap_coafter.ma".
-
-(* RELOCATION N-STREAM ******************************************************)
-
-rec definition fun0 (p1:pnat) on p1: rtmap → pnat.
-* * [ | #p2 #f2 @(𝟏) ]
-#f2 cases p1 -p1 [ @(𝟏) ]
-#p1 @(↑(fun0 p1 f2))
-defined.
-
-rec definition fun2 (p1:pnat) on p1: rtmap → rtmap.
-* * [ | #p2 #f2 @(p2⨮f2) ]
-#f2 cases p1 -p1 [ @f2 ]
-#p1 @(fun2 p1 f2)
-defined.
-
-rec definition fun1 (p1:pnat) (f1:rtmap) on p1: rtmap → rtmap.
-* * [ | #p2 #f2 @(p1⨮f1) ]
-#f2 cases p1 -p1 [ @f1 ]
-#p1 @(fun1 p1 f1 f2)
-defined.
-
-corec definition cocompose: rtmap → rtmap → rtmap.
-#f2 * #p1 #f1
-@(stream_cons … (fun0 p1 f2)) @(cocompose (fun2 p1 f2) (fun1 p1 f1 f2))
-defined.
-
-interpretation "functional co-composition (nstream)"
- 'CoCompose f1 f2 = (cocompose f1 f2).
-
-(* Basic properties on funs *************************************************)
-
-(* Note: we need theese since matita blocks recursive δ when ι is blocked *)
-lemma fun0_xn: ∀f2,p1. 𝟏 = fun0 p1 (↑f2).
-* #p2 #f2 * //
-qed.
-
-lemma fun2_xn: ∀f2,p1. f2 = fun2 p1 (↑f2).
-* #p2 #f2 * //
-qed.
-
-lemma fun1_xxn: ∀f2,f1,p1. fun1 p1 f1 (↑f2) = p1⨮f1.
-* #p2 #f2 #f1 * //
-qed.
-
-(* Basic properies on cocompose *********************************************)
-
-lemma cocompose_rew: ∀f2,f1,p1. (fun0 p1 f2)⨮(fun2 p1 f2)~∘(fun1 p1 f1 f2) = f2 ~∘ (p1⨮f1).
-#f2 #f1 #p1 <(stream_rew … (f2~∘(p1⨮f1))) normalize //
-qed.
-
-(* Basic inversion lemmas on compose ****************************************)
-
-lemma cocompose_inv_ppx: ∀f2,f1,f,x. (⫯f2) ~∘ (⫯f1) = x⨮f →
- ∧∧ 𝟏 = x & f2 ~∘ f1 = f.
-#f2 #f1 #f #x
-<cocompose_rew #H destruct
-normalize /2 width=1 by conj/
-qed-.
-
-lemma cocompose_inv_pnx: ∀f2,f1,f,p1,x. (⫯f2) ~∘ (↑p1⨮f1) = x⨮f →
- ∃∃p. ↑p = x & f2 ~∘ (p1⨮f1) = p⨮f.
-#f2 #f1 #f #p1 #x
-<cocompose_rew #H destruct
-@(ex2_intro … (fun0 p1 f2)) // <cocompose_rew
-/3 width=1 by eq_f2/
-qed-.
-
-lemma cocompose_inv_nxx: ∀f2,f1,f,p1,x. (↑f2) ~∘ (p1⨮f1) = x⨮f →
- ∧∧ 𝟏 = x & f2 ~∘ (p1⨮f1) = f.
-#f2 #f1 #f #p1 #x
-<cocompose_rew #H destruct
-/2 width=1 by conj/
-qed-.
-
-(* Specific properties on coafter *******************************************)
-
-corec lemma coafter_total_aux: ∀f2,f1,f. f2 ~∘ f1 = f → f2 ~⊚ f1 ≘ f.
-* #p2 #f2 * #p1 #f1 * #p #f cases p2 -p2
-[ cases p1 -p1
- [ #H cases (cocompose_inv_ppx … H) -H /3 width=7 by coafter_refl, eq_f2/
- | #p1 #H cases (cocompose_inv_pnx … H) -H /3 width=7 by coafter_push/
- ]
-| #p2 >next_rew #H cases (cocompose_inv_nxx … H) -H /3 width=5 by coafter_next/
-]
-qed-.
-
-theorem coafter_total: ∀f2,f1. f2 ~⊚ f1 ≘ f2 ~∘ f1.
-/2 width=1 by coafter_total_aux/ qed.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.tcs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "ground/lib/stream_eq.ma".
-include "ground/relocation/rtmap_eq.ma".
-
-(* RELOCATION N-STREAM ******************************************************)
-
-(* Specific properties ******************************************************)
-
-fact eq_inv_seq_aux: ∀f1,f2,p1,p2. p1⨮f1 ≡ p2⨮f2 → p1 = p2 ∧ f1 ≡ f2.
-#f1 #f2 #p1 #p2 @(pnat_ind_2 … p1 p2) -p1 -p2
-[ #p2 #H elim (eq_inv_px … H) -H [2,3: // ]
- #g1 #H1 #H elim (push_inv_seq_dx … H) -H /2 width=1 by conj/
-| #p1 #_ #H elim (eq_inv_np … H) -H //
-| #p1 #p2 #IH #H lapply (eq_inv_nn … H ????) -H [5:|*: // ]
- #H elim (IH H) -IH -H /2 width=1 by conj/
-]
-qed-.
-
-lemma eq_inv_seq: ∀g1,g2. g1 ≡ g2 → ∀f1,f2,p1,p2. p1⨮f1 = g1 → p2⨮f2 = g2 →
- p1 = p2 ∧ f1 ≡ f2.
-/2 width=1 by eq_inv_seq_aux/ qed-.
-
-corec lemma nstream_eq: ∀f1,f2. f1 ≡ f2 → f1 ≗ f2.
-* #p1 #f1 * #p2 #f2 #Hf cases (eq_inv_gen … Hf) -Hf *
-#g1 #g2 #Hg #H1 #H2
-[ cases (push_inv_seq_dx … H1) -H1 * -p1 #H1
- cases (push_inv_seq_dx … H2) -H2 * -p2 #H2
- @stream_eq_cons /2 width=1 by/
-| cases (next_inv_seq_dx … H1) -H1 #m1 #H1 * -p1
- cases (next_inv_seq_dx … H2) -H2 #m2 #H2 * -p2
- cases (eq_inv_seq … Hg … H1 H2) -g1 -g2 #Hm #Hf
- @stream_eq_cons /2 width=1 by/
-]
-qed-.
-
-corec lemma nstream_inv_eq: ∀f1,f2. f1 ≗ f2 → f1 ≡ f2.
-* #p1 #f1 * #p2 #f2 #H cases (stream_eq_inv_cons ??? H) -H [|*: // ]
-#Hf * -p2 cases p1 -p1 /3 width=5 by eq_push/
-#n @eq_next /3 width=5 by stream_eq_cons/
-qed.
-
-lemma eq_seq_id: ∀f1,f2. f1 ≡ f2 → ∀n. n⨮f1 ≡ n⨮f2.
-/4 width=1 by nstream_inv_eq, nstream_eq, stream_eq_cons/ 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 "ground/notation/functions/identity_0.ma".
-include "ground/relocation/rtmap_eq.ma".
-
-(* RELOCATION N-STREAM ******************************************************)
-
-corec definition id: rtmap ≝ ⫯id.
-
-interpretation "identity (nstream)"
- 'Identity = (id).
-
-(* Basic properties *********************************************************)
-
-lemma id_rew: ⫯𝐈𝐝 = 𝐈𝐝.
-<(stream_rew … (𝐈𝐝)) in ⊢ (???%); normalize //
-qed.
-
-lemma id_eq_rew: ⫯𝐈𝐝 ≡ 𝐈𝐝.
-cases id_rew in ⊢ (??%); //
-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 "ground/relocation/rtmap_isid.ma".
-
-(* RELOCATION N-STREAM ******************************************************)
-
-(* Specific inversion lemmas ************************************************)
-
-lemma isid_inv_seq: ∀f,p. 𝐈❪p⨮f❫ → 𝐈❪f❫ ∧ 𝟏 = p.
-#f #p #H elim (isid_inv_gen … H) -H
-#g #Hg #H elim (push_inv_seq_dx … H) -H /2 width=1 by conj/
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.tcs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "ground/notation/functions/apply_2.ma".
-include "ground/arith/pnat_le_plus.ma".
-include "ground/relocation/pstream_eq.ma".
-include "ground/relocation/rtmap_istot.ma".
-
-(* RELOCATION N-STREAM ******************************************************)
-
-rec definition apply (i: pnat) on i: rtmap → pnat.
-* #p #f cases i -i
-[ @p
-| #i lapply (apply i f) -apply -i -f
- #i @(i+p)
-]
-defined.
-
-interpretation "functional application (nstream)"
- 'Apply f i = (apply i f).
-
-(* Specific properties on at ************************************************)
-
-lemma at_O1: ∀i2,f. @❪𝟏, i2⨮f❫ ≘ i2.
-#i2 elim i2 -i2 /2 width=5 by at_refl, at_next/
-qed.
-
-lemma at_S1: ∀p,f,i1,i2. @❪i1, f❫ ≘ i2 → @❪↑i1, p⨮f❫ ≘ i2+p.
-#p elim p -p /3 width=7 by at_push, at_next/
-qed.
-
-lemma at_total: ∀i1,f. @❪i1, f❫ ≘ f@❨i1❩.
-#i1 elim i1 -i1
-[ * // | #i #IH * /3 width=1 by at_S1/ ]
-qed.
-
-lemma at_istot: ∀f. 𝐓❪f❫.
-/2 width=2 by ex_intro/ qed.
-
-lemma at_plus2: ∀f,i1,i,p,q. @❪i1, p⨮f❫ ≘ i → @❪i1, (p+q)⨮f❫ ≘ i+q.
-#f #i1 #i #p #q #H elim q -q
-/2 width=5 by at_next/
-qed.
-
-(* Specific inversion lemmas on at ******************************************)
-
-lemma at_inv_O1: ∀f,p,i2. @❪𝟏, p⨮f❫ ≘ i2 → p = i2.
-#f #p elim p -p /2 width=6 by at_inv_ppx/
-#p #IH #i2 #H elim (at_inv_xnx … H) -H [|*: // ]
-#j2 #Hj * -i2 /3 width=1 by eq_f/
-qed-.
-
-lemma at_inv_S1: ∀f,p,j1,i2. @❪↑j1, p⨮f❫ ≘ i2 →
- ∃∃j2. @❪j1, f❫ ≘ j2 & j2+p = i2.
-#f #p elim p -p /2 width=5 by at_inv_npx/
-#p #IH #j1 #i2 #H elim (at_inv_xnx … H) -H [|*: // ]
-#j2 #Hj * -i2 elim (IH … Hj) -IH -Hj
-#i2 #Hi * -j2 /2 width=3 by ex2_intro/
-qed-.
-
-lemma at_inv_total: ∀f,i1,i2. @❪i1, f❫ ≘ i2 → f@❨i1❩ = i2.
-/2 width=6 by at_mono/ qed-.
-
-(* Spercific forward lemmas on at *******************************************)
-
-lemma at_increasing_plus: ∀f,p,i1,i2. @❪i1, p⨮f❫ ≘ i2 → i1 + p ≤ ↑i2.
-#f #p *
-[ #i2 #H <(at_inv_O1 … H) -i2 //
-| #i1 #i2 #H elim (at_inv_S1 … H) -H
- #j1 #Ht * -i2 <pplus_succ_sn
- /4 width=2 by at_increasing, ple_plus_bi_dx, ple_succ_bi/
-]
-qed-.
-
-lemma at_fwd_id: ∀f,p,i. @❪i, p⨮f❫ ≘ i → 𝟏 = p.
-#f #p #i #H elim (at_fwd_id_ex … H) -H
-#g #H elim (push_inv_seq_dx … H) -H //
-qed-.
-
-(* Basic properties *********************************************************)
-
-lemma apply_O1: ∀p,f. (p⨮f)@❨𝟏❩ = p.
-// qed.
-
-lemma apply_S1: ∀p,f,i. (p⨮f)@❨↑i❩ = f@❨i❩+p.
-// qed.
-
-lemma apply_eq_repl (i): eq_repl … (λf1,f2. f1@❨i❩ = f2@❨i❩).
-#i elim i -i [2: #i #IH ] * #p1 #f1 * #p2 #f2 #H
-elim (eq_inv_seq_aux … H) -H #Hp #Hf //
->apply_S1 >apply_S1 /3 width=1 by eq_f2/
-qed.
-
-lemma apply_S2: ∀f,i. (↑f)@❨i❩ = ↑(f@❨i❩).
-* #p #f * //
-qed.
-
-(* Main inversion lemmas ****************************************************)
-
-theorem apply_inj: ∀f,i1,i2,j. f@❨i1❩ = j → f@❨i2❩ = j → i1 = i2.
-/2 width=4 by at_inj/ qed-.
-
-corec theorem nstream_eq_inv_ext: ∀f1,f2. (∀i. f1@❨i❩ = f2@❨i❩) → f1 ≗ f2.
-* #p1 #f1 * #p2 #f2 #Hf @stream_eq_cons
-[ @(Hf (𝟏))
-| @nstream_eq_inv_ext -nstream_eq_inv_ext #i
- lapply (Hf (𝟏)) >apply_O1 >apply_O1 #H destruct
- lapply (Hf (↑i)) >apply_S1 >apply_S1 #H
- /3 width=2 by eq_inv_pplus_bi_dx, eq_inv_psucc_bi/
-]
-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 "ground/relocation/rtmap_sor.ma".
-
-(* RELOCATION N-STREAM ******************************************************)
-
-axiom union: rtmap → rtmap → rtmap.
-
-interpretation "union (nstream)"
- 'union f1 f2 = (union f1 f2).
-
-(* Specific properties on sor ***********************************************)
-
-axiom sor_total: ∀f1,f2. f1 ⋓ f2 ≘ f1 ∪ f2.
+++ /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 "ground/lib/stream_hdtl.ma".
-include "ground/relocation/pstream.ma".
-
-(* RELOCATION P-STREAM ******************************************************)
-
-(* Poperties with stream_tl *************************************************)
-
-lemma tl_push: ∀f. f = ⫰⫯f.
-// qed.
-
-lemma tl_next: ∀f. ⫰f = ⫰↑f.
-* // 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 "ground/lib/stream_tls.ma".
-include "ground/arith/nat_pred_succ.ma".
-include "ground/relocation/pstream_tl.ma".
-
-(* RELOCATION P-STREAM ******************************************************)
-
-(* Poperties with stream_tls ************************************************)
-
-lemma tls_next: ∀f. ∀p:pnat. ⫰*[p]f = ⫰*[p]↑f.
-#f #p >(npsucc_pred p) <stream_tls_swap <stream_tls_swap //
-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 "ground/relocation/pstream.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-lemma pn_split: ∀f. (∃g. ⫯g = f) ∨ (∃g. ↑g = f).
-@case_prop /3 width=2 by or_introl, or_intror, ex_intro/
-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 "ground/notation/relations/rafter_3.ma".
-include "ground/arith/nat_pred_succ.ma".
-include "ground/relocation/rtmap_istot.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-coinductive after: relation3 rtmap rtmap rtmap ≝
-| after_refl: ∀f1,f2,f,g1,g2,g.
- after f1 f2 f → ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → after g1 g2 g
-| after_push: ∀f1,f2,f,g1,g2,g.
- after f1 f2 f → ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → after g1 g2 g
-| after_next: ∀f1,f2,f,g1,g.
- after f1 f2 f → ↑f1 = g1 → ↑f = g → after g1 f2 g
-.
-
-interpretation "relational composition (rtmap)"
- 'RAfter f1 f2 f = (after f1 f2 f).
-
-definition H_after_inj: predicate rtmap ≝
- λf1. 𝐓❪f1❫ →
- ∀f,f21,f22. f1 ⊚ f21 ≘ f → f1 ⊚ f22 ≘ f → f21 ≡ f22.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma after_inv_ppx: ∀g1,g2,g. g1 ⊚ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 →
- ∃∃f. f1 ⊚ f2 ≘ f & ⫯f = g.
-#g1 #g2 #g * -g1 -g2 -g #f1 #f2 #f #g1
-[ #g2 #g #Hf #H1 #H2 #H #x1 #x2 #Hx1 #Hx2 destruct
- >(injective_push … Hx1) >(injective_push … Hx2) -x2 -x1
- /2 width=3 by ex2_intro/
-| #g2 #g #_ #_ #H2 #_ #x1 #x2 #_ #Hx2 destruct
- elim (discr_push_next … Hx2)
-| #g #_ #H1 #_ #x1 #x2 #Hx1 #_ destruct
- elim (discr_push_next … Hx1)
-]
-qed-.
-
-lemma after_inv_pnx: ∀g1,g2,g. g1 ⊚ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 →
- ∃∃f. f1 ⊚ f2 ≘ f & ↑f = g.
-#g1 #g2 #g * -g1 -g2 -g #f1 #f2 #f #g1
-[ #g2 #g #_ #_ #H2 #_ #x1 #x2 #_ #Hx2 destruct
- elim (discr_next_push … Hx2)
-| #g2 #g #Hf #H1 #H2 #H3 #x1 #x2 #Hx1 #Hx2 destruct
- >(injective_push … Hx1) >(injective_next … Hx2) -x2 -x1
- /2 width=3 by ex2_intro/
-| #g #_ #H1 #_ #x1 #x2 #Hx1 #_ destruct
- elim (discr_push_next … Hx1)
-]
-qed-.
-
-lemma after_inv_nxx: ∀g1,f2,g. g1 ⊚ f2 ≘ g → ∀f1. ↑f1 = g1 →
- ∃∃f. f1 ⊚ f2 ≘ f & ↑f = g.
-#g1 #f2 #g * -g1 -f2 -g #f1 #f2 #f #g1
-[ #g2 #g #_ #H1 #_ #_ #x1 #Hx1 destruct
- elim (discr_next_push … Hx1)
-| #g2 #g #_ #H1 #_ #_ #x1 #Hx1 destruct
- elim (discr_next_push … Hx1)
-| #g #Hf #H1 #H #x1 #Hx1 destruct
- >(injective_next … Hx1) -x1
- /2 width=3 by ex2_intro/
-]
-qed-.
-
-(* Advanced inversion lemmas ************************************************)
-
-lemma after_inv_ppp: ∀g1,g2,g. g1 ⊚ g2 ≘ g →
- ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → f1 ⊚ f2 ≘ f.
-#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H elim (after_inv_ppx … Hg … H1 H2) -g1 -g2
-#x #Hf #Hx destruct <(injective_push … Hx) -f //
-qed-.
-
-lemma after_inv_ppn: ∀g1,g2,g. g1 ⊚ g2 ≘ g →
- ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ↑f = g → ⊥.
-#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H elim (after_inv_ppx … Hg … H1 H2) -g1 -g2
-#x #Hf #Hx destruct elim (discr_push_next … Hx)
-qed-.
-
-lemma after_inv_pnn: ∀g1,g2,g. g1 ⊚ g2 ≘ g →
- ∀f1,f2,f. ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → f1 ⊚ f2 ≘ f.
-#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H elim (after_inv_pnx … Hg … H1 H2) -g1 -g2
-#x #Hf #Hx destruct <(injective_next … Hx) -f //
-qed-.
-
-lemma after_inv_pnp: ∀g1,g2,g. g1 ⊚ g2 ≘ g →
- ∀f1,f2,f. ⫯f1 = g1 → ↑f2 = g2 → ⫯f = g → ⊥.
-#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H elim (after_inv_pnx … Hg … H1 H2) -g1 -g2
-#x #Hf #Hx destruct elim (discr_next_push … Hx)
-qed-.
-
-lemma after_inv_nxn: ∀g1,f2,g. g1 ⊚ f2 ≘ g →
- ∀f1,f. ↑f1 = g1 → ↑f = g → f1 ⊚ f2 ≘ f.
-#g1 #f2 #g #Hg #f1 #f #H1 #H elim (after_inv_nxx … Hg … H1) -g1
-#x #Hf #Hx destruct <(injective_next … Hx) -f //
-qed-.
-
-lemma after_inv_nxp: ∀g1,f2,g. g1 ⊚ f2 ≘ g →
- ∀f1,f. ↑f1 = g1 → ⫯f = g → ⊥.
-#g1 #f2 #g #Hg #f1 #f #H1 #H elim (after_inv_nxx … Hg … H1) -g1
-#x #Hf #Hx destruct elim (discr_next_push … Hx)
-qed-.
-
-lemma after_inv_pxp: ∀g1,g2,g. g1 ⊚ g2 ≘ g →
- ∀f1,f. ⫯f1 = g1 → ⫯f = g →
- ∃∃f2. f1 ⊚ f2 ≘ f & ⫯f2 = g2.
-#g1 * * [2: #m2] #g2 #g #Hg #f1 #f #H1 #H
-[ elim (after_inv_pnp … Hg … H1 … H) -g1 -g -f1 -f //
-| lapply (after_inv_ppp … Hg … H1 … H) -g1 -g /2 width=3 by ex2_intro/
-]
-qed-.
-
-lemma after_inv_pxn: ∀g1,g2,g. g1 ⊚ g2 ≘ g →
- ∀f1,f. ⫯f1 = g1 → ↑f = g →
- ∃∃f2. f1 ⊚ f2 ≘ f & ↑f2 = g2.
-#g1 * * [2: #m2] #g2 #g #Hg #f1 #f #H1 #H
-[ lapply (after_inv_pnn … Hg … H1 … H) -g1 -g /2 width=3 by ex2_intro/
-| elim (after_inv_ppn … Hg … H1 … H) -g1 -g -f1 -f //
-]
-qed-.
-
-lemma after_inv_xxp: ∀g1,g2,g. g1 ⊚ g2 ≘ g → ∀f. ⫯f = g →
- ∃∃f1,f2. f1 ⊚ f2 ≘ f & ⫯f1 = g1 & ⫯f2 = g2.
-* * [2: #m1 ] #g1 #g2 #g #Hg #f #H
-[ elim (after_inv_nxp … Hg … H) -g2 -g -f //
-| elim (after_inv_pxp … Hg … H) -g /2 width=5 by ex3_2_intro/
-]
-qed-.
-
-lemma after_inv_xxn: ∀g1,g2,g. g1 ⊚ g2 ≘ g → ∀f. ↑f = g →
- (∃∃f1,f2. f1 ⊚ f2 ≘ f & ⫯f1 = g1 & ↑f2 = g2) ∨
- ∃∃f1. f1 ⊚ g2 ≘ f & ↑f1 = g1.
-* * [2: #m1 ] #g1 #g2 #g #Hg #f #H
-[ /4 width=5 by after_inv_nxn, or_intror, ex2_intro/
-| elim (after_inv_pxn … Hg … H) -g
- /3 width=5 by or_introl, ex3_2_intro/
-]
-qed-.
-
-lemma after_inv_pxx: ∀g1,g2,g. g1 ⊚ g2 ≘ g → ∀f1. ⫯f1 = g1 →
- (∃∃f2,f. f1 ⊚ f2 ≘ f & ⫯f2 = g2 & ⫯f = g) ∨
- (∃∃f2,f. f1 ⊚ f2 ≘ f & ↑f2 = g2 & ↑f = g).
-#g1 * * [2: #m2 ] #g2 #g #Hg #f1 #H
-[ elim (after_inv_pnx … Hg … H) -g1
- /3 width=5 by or_intror, ex3_2_intro/
-| elim (after_inv_ppx … Hg … H) -g1
- /3 width=5 by or_introl, ex3_2_intro/
-]
-qed-.
-
-(* Basic properties *********************************************************)
-
-corec lemma after_eq_repl_back2: ∀f1,f. eq_repl_back (λf2. f2 ⊚ f1 ≘ f).
-#f1 #f #f2 * -f2 -f1 -f
-#f21 #f1 #f #g21 [1,2: #g1 ] #g #Hf #H21 [1,2: #H1 ] #H #g22 #H0
-[ cases (eq_inv_px … H0 … H21) -g21 /3 width=7 by after_refl/
-| cases (eq_inv_px … H0 … H21) -g21 /3 width=7 by after_push/
-| cases (eq_inv_nx … H0 … H21) -g21 /3 width=5 by after_next/
-]
-qed-.
-
-lemma after_eq_repl_fwd2: ∀f1,f. eq_repl_fwd (λf2. f2 ⊚ f1 ≘ f).
-#f1 #f @eq_repl_sym /2 width=3 by after_eq_repl_back2/
-qed-.
-
-corec lemma after_eq_repl_back1: ∀f2,f. eq_repl_back (λf1. f2 ⊚ f1 ≘ f).
-#f2 #f #f1 * -f2 -f1 -f
-#f2 #f11 #f #g2 [1,2: #g11 ] #g #Hf #H2 [1,2: #H11 ] #H #g2 #H0
-[ cases (eq_inv_px … H0 … H11) -g11 /3 width=7 by after_refl/
-| cases (eq_inv_nx … H0 … H11) -g11 /3 width=7 by after_push/
-| @(after_next … H2 H) /2 width=5 by/
-]
-qed-.
-
-lemma after_eq_repl_fwd1: ∀f2,f. eq_repl_fwd (λf1. f2 ⊚ f1 ≘ f).
-#f2 #f @eq_repl_sym /2 width=3 by after_eq_repl_back1/
-qed-.
-
-corec lemma after_eq_repl_back0: ∀f1,f2. eq_repl_back (λf. f2 ⊚ f1 ≘ f).
-#f2 #f1 #f * -f2 -f1 -f
-#f2 #f1 #f01 #g2 [1,2: #g1 ] #g01 #Hf01 #H2 [1,2: #H1 ] #H01 #g02 #H0
-[ cases (eq_inv_px … H0 … H01) -g01 /3 width=7 by after_refl/
-| cases (eq_inv_nx … H0 … H01) -g01 /3 width=7 by after_push/
-| cases (eq_inv_nx … H0 … H01) -g01 /3 width=5 by after_next/
-]
-qed-.
-
-lemma after_eq_repl_fwd0: ∀f2,f1. eq_repl_fwd (λf. f2 ⊚ f1 ≘ f).
-#f2 #f1 @eq_repl_sym /2 width=3 by after_eq_repl_back0/
-qed-.
-
-(* Main properties **********************************************************)
-
-corec theorem after_trans1: ∀f0,f3,f4. f0 ⊚ f3 ≘ f4 →
- ∀f1,f2. f1 ⊚ f2 ≘ f0 →
- ∀f. f2 ⊚ f3 ≘ f → f1 ⊚ f ≘ f4.
-#f0 #f3 #f4 * -f0 -f3 -f4 #f0 #f3 #f4 #g0 [1,2: #g3 ] #g4
-[ #Hf4 #H0 #H3 #H4 #g1 #g2 #Hg0 #g #Hg
- cases (after_inv_xxp … Hg0 … H0) -g0
- #f1 #f2 #Hf0 #H1 #H2
- cases (after_inv_ppx … Hg … H2 H3) -g2 -g3
- #f #Hf #H /3 width=7 by after_refl/
-| #Hf4 #H0 #H3 #H4 #g1 #g2 #Hg0 #g #Hg
- cases (after_inv_xxp … Hg0 … H0) -g0
- #f1 #f2 #Hf0 #H1 #H2
- cases (after_inv_pnx … Hg … H2 H3) -g2 -g3
- #f #Hf #H /3 width=7 by after_push/
-| #Hf4 #H0 #H4 #g1 #g2 #Hg0 #g #Hg
- cases (after_inv_xxn … Hg0 … H0) -g0 *
- [ #f1 #f2 #Hf0 #H1 #H2
- cases (after_inv_nxx … Hg … H2) -g2
- #f #Hf #H /3 width=7 by after_push/
- | #f1 #Hf0 #H1 /3 width=6 by after_next/
- ]
-]
-qed-.
-
-corec theorem after_trans2: ∀f1,f0,f4. f1 ⊚ f0 ≘ f4 →
- ∀f2, f3. f2 ⊚ f3 ≘ f0 →
- ∀f. f1 ⊚ f2 ≘ f → f ⊚ f3 ≘ f4.
-#f1 #f0 #f4 * -f1 -f0 -f4 #f1 #f0 #f4 #g1 [1,2: #g0 ] #g4
-[ #Hf4 #H1 #H0 #H4 #g2 #g3 #Hg0 #g #Hg
- cases (after_inv_xxp … Hg0 … H0) -g0
- #f2 #f3 #Hf0 #H2 #H3
- cases (after_inv_ppx … Hg … H1 H2) -g1 -g2
- #f #Hf #H /3 width=7 by after_refl/
-| #Hf4 #H1 #H0 #H4 #g2 #g3 #Hg0 #g #Hg
- cases (after_inv_xxn … Hg0 … H0) -g0 *
- [ #f2 #f3 #Hf0 #H2 #H3
- cases (after_inv_ppx … Hg … H1 H2) -g1 -g2
- #f #Hf #H /3 width=7 by after_push/
- | #f2 #Hf0 #H2
- cases (after_inv_pnx … Hg … H1 H2) -g1 -g2
- #f #Hf #H /3 width=6 by after_next/
- ]
-| #Hf4 #H1 #H4 #f2 #f3 #Hf0 #g #Hg
- cases (after_inv_nxx … Hg … H1) -g1
- #f #Hg #H /3 width=6 by after_next/
-]
-qed-.
-
-(* Main inversion lemmas ****************************************************)
-
-corec theorem after_mono: ∀f1,f2,x,y. f1 ⊚ f2 ≘ x → f1 ⊚ f2 ≘ y → x ≡ y.
-#f1 #f2 #x #y * -f1 -f2 -x
-#f1 #f2 #x #g1 [1,2: #g2 ] #g #Hx #H1 [1,2: #H2 ] #H0x #Hy
-[ cases (after_inv_ppx … Hy … H1 H2) -g1 -g2 /3 width=8 by eq_push/
-| cases (after_inv_pnx … Hy … H1 H2) -g1 -g2 /3 width=8 by eq_next/
-| cases (after_inv_nxx … Hy … H1) -g1 /3 width=8 by eq_next/
-]
-qed-.
-
-lemma after_mono_eq: ∀f1,f2,f. f1 ⊚ f2 ≘ f → ∀g1,g2,g. g1 ⊚ g2 ≘ g →
- f1 ≡ g1 → f2 ≡ g2 → f ≡ g.
-/4 width=4 by after_mono, after_eq_repl_back1, after_eq_repl_back2/ qed-.
-
-(* Properties on tls ********************************************************)
-
-(* Note: this requires ↑ on first n *)
-lemma after_tls: ∀n,f1,f2,f. @❪𝟏, f1❫ ≘ ↑n →
- f1 ⊚ f2 ≘ f → ⫱*[n]f1 ⊚ f2 ≘ ⫱*[n]f.
-#n @(nat_ind_succ … n) -n //
-#n #IH #f1 #f2 #f #Hf1 #Hf
-cases (at_inv_pxn … Hf1) -Hf1 [ |*: // ] #g1 #Hg1 #H1
-cases (after_inv_nxx … Hf … H1) -Hf #g #Hg #H0 destruct
-<tls_xn <tls_xn /2 width=1 by/
-qed.
-
-(* Properties on isid *******************************************************)
-
-corec lemma after_isid_sn: ∀f1. 𝐈❪f1❫ → ∀f2. f1 ⊚ f2 ≘ f2.
-#f1 * -f1 #f1 #g1 #Hf1 #H1 #f2 cases (pn_split f2) * #g2 #H2
-/3 width=7 by after_push, after_refl/
-qed.
-
-corec lemma after_isid_dx: ∀f2. 𝐈❪f2❫ → ∀f1. f1 ⊚ f2 ≘ f1.
-#f2 * -f2 #f2 #g2 #Hf2 #H2 #f1 cases (pn_split f1) * #g1 #H1
-[ /3 width=7 by after_refl/
-| @(after_next … H1 H1) /3 width=3 by isid_push/
-]
-qed.
-
-(* Inversion lemmas on isid *************************************************)
-
-lemma after_isid_inv_sn: ∀f1,f2,f. f1 ⊚ f2 ≘ f → 𝐈❪f1❫ → f2 ≡ f.
-/3 width=6 by after_isid_sn, after_mono/ qed-.
-
-lemma after_isid_inv_dx: ∀f1,f2,f. f1 ⊚ f2 ≘ f → 𝐈❪f2❫ → f1 ≡ f.
-/3 width=6 by after_isid_dx, after_mono/ qed-.
-
-corec lemma after_fwd_isid1: ∀f1,f2,f. f1 ⊚ f2 ≘ f → 𝐈❪f❫ → 𝐈❪f1❫.
-#f1 #f2 #f * -f1 -f2 -f
-#f1 #f2 #f #g1 [1,2: #g2 ] #g #Hf #H1 [1,2: #H2 ] #H0 #H
-[ /4 width=6 by isid_inv_push, isid_push/ ]
-cases (isid_inv_next … H … H0)
-qed-.
-
-corec lemma after_fwd_isid2: ∀f1,f2,f. f1 ⊚ f2 ≘ f → 𝐈❪f❫ → 𝐈❪f2❫.
-#f1 #f2 #f * -f1 -f2 -f
-#f1 #f2 #f #g1 [1,2: #g2 ] #g #Hf #H1 [1,2: #H2 ] #H0 #H
-[ /4 width=6 by isid_inv_push, isid_push/ ]
-cases (isid_inv_next … H … H0)
-qed-.
-
-lemma after_inv_isid3: ∀f1,f2,f. f1 ⊚ f2 ≘ f → 𝐈❪f❫ → 𝐈❪f1❫ ∧ 𝐈❪f2❫.
-/3 width=4 by after_fwd_isid2, after_fwd_isid1, conj/ qed-.
-
-(* Forward lemmas on at *****************************************************)
-
-lemma after_at_fwd: ∀i,i1,f. @❪i1, f❫ ≘ i → ∀f2,f1. f2 ⊚ f1 ≘ f →
- ∃∃i2. @❪i1, f1❫ ≘ i2 & @❪i2, f2❫ ≘ i.
-#i elim i -i [2: #i #IH ] #i1 #f #Hf #f2 #f1 #Hf21
-[ elim (at_inv_xxn … Hf) -Hf [1,3:* |*: // ]
- [1: #g #j1 #Hg #H0 #H |2,4: #g #Hg #H ]
-| elim (at_inv_xxp … Hf) -Hf //
- #g #H1 #H
-]
-[2: elim (after_inv_xxn … Hf21 … H) -f *
- [ #g2 #g1 #Hg21 #H2 #H1 | #g2 #Hg21 #H2 ]
-|*: elim (after_inv_xxp … Hf21 … H) -f
- #g2 #g1 #Hg21 #H2 #H1
-]
-[4: -Hg21 |*: elim (IH … Hg … Hg21) -g -IH ]
-/3 width=9 by at_refl, at_push, at_next, ex2_intro/
-qed-.
-
-lemma after_fwd_at: ∀i,i2,i1,f1,f2. @❪i1, f1❫ ≘ i2 → @❪i2, f2❫ ≘ i →
- ∀f. f2 ⊚ f1 ≘ f → @❪i1, f❫ ≘ i.
-#i elim i -i [2: #i #IH ] #i2 #i1 #f1 #f2 #Hf1 #Hf2 #f #Hf
-[ elim (at_inv_xxn … Hf2) -Hf2 [1,3: * |*: // ]
- #g2 [ #j2 ] #Hg2 [ #H22 ] #H20
- [ elim (at_inv_xxn … Hf1 … H22) -i2 *
- #g1 [ #j1 ] #Hg1 [ #H11 ] #H10
- [ elim (after_inv_ppx … Hf … H20 H10) -f1 -f2 /3 width=7 by at_push/
- | elim (after_inv_pnx … Hf … H20 H10) -f1 -f2 /3 width=6 by at_next/
- ]
- | elim (after_inv_nxx … Hf … H20) -f2 /3 width=7 by at_next/
- ]
-| elim (at_inv_xxp … Hf2) -Hf2 // #g2 #H22 #H20
- elim (at_inv_xxp … Hf1 … H22) -i2 #g1 #H11 #H10
- elim (after_inv_ppx … Hf … H20 H10) -f1 -f2 /2 width=2 by at_refl/
-]
-qed-.
-
-lemma after_fwd_at2: ∀f,i1,i. @❪i1, f❫ ≘ i → ∀f1,i2. @❪i1, f1❫ ≘ i2 →
- ∀f2. f2 ⊚ f1 ≘ f → @❪i2, f2❫ ≘ i.
-#f #i1 #i #Hf #f1 #i2 #Hf1 #f2 #H elim (after_at_fwd … Hf … H) -f
-#j1 #H #Hf2 <(at_mono … Hf1 … H) -i1 -i2 //
-qed-.
-
-lemma after_fwd_at1: ∀i,i2,i1,f,f2. @❪i1, f❫ ≘ i → @❪i2, f2❫ ≘ i →
- ∀f1. f2 ⊚ f1 ≘ f → @❪i1, f1❫ ≘ i2.
-#i elim i -i [2: #i #IH ] #i2 #i1 #f #f2 #Hf #Hf2 #f1 #Hf1
-[ elim (at_inv_xxn … Hf) -Hf [1,3: * |*: // ]
- #g [ #j1 ] #Hg [ #H01 ] #H00
- elim (at_inv_xxn … Hf2) -Hf2 [1,3,5,7: * |*: // ]
- #g2 [1,3: #j2 ] #Hg2 [1,2: #H22 ] #H20
- [ elim (after_inv_pxp … Hf1 … H20 H00) -f2 -f /3 width=7 by at_push/
- | elim (after_inv_pxn … Hf1 … H20 H00) -f2 -f /3 width=5 by at_next/
- | elim (after_inv_nxp … Hf1 … H20 H00)
- | /4 width=9 by after_inv_nxn, at_next/
- ]
-| elim (at_inv_xxp … Hf) -Hf // #g #H01 #H00
- elim (at_inv_xxp … Hf2) -Hf2 // #g2 #H21 #H20
- elim (after_inv_pxp … Hf1 … H20 H00) -f2 -f /3 width=2 by at_refl/
-]
-qed-.
-
-(* Forward lemmas on istot **************************************************)
-
-lemma after_istot_fwd: ∀f2,f1,f. f2 ⊚ f1 ≘ f → 𝐓❪f2❫ → 𝐓❪f1❫ → 𝐓❪f❫.
-#f2 #f1 #f #Hf #Hf2 #Hf1 #i1 elim (Hf1 i1) -Hf1
-#i2 #Hf1 elim (Hf2 i2) -Hf2
-/3 width=7 by after_fwd_at, ex_intro/
-qed-.
-
-lemma after_fwd_istot_dx: ∀f2,f1,f. f2 ⊚ f1 ≘ f → 𝐓❪f❫ → 𝐓❪f1❫.
-#f2 #f1 #f #H #Hf #i1 elim (Hf i1) -Hf
-#i2 #Hf elim (after_at_fwd … Hf … H) -f /2 width=2 by ex_intro/
-qed-.
-
-lemma after_fwd_istot_sn: ∀f2,f1,f. f2 ⊚ f1 ≘ f → 𝐓❪f❫ → 𝐓❪f2❫.
-#f2 #f1 #f #H #Hf #i1 elim (Hf i1) -Hf
-#i #Hf elim (after_at_fwd … Hf … H) -f
-#i2 #Hf1 #Hf2 lapply (at_increasing … Hf1) -f1
-#Hi12 elim (at_le_ex … Hf2 … Hi12) -i2 /2 width=2 by ex_intro/
-qed-.
-
-lemma after_inv_istot: ∀f2,f1,f. f2 ⊚ f1 ≘ f → 𝐓❪f❫ → 𝐓❪f2❫ ∧ 𝐓❪f1❫.
-/3 width=4 by after_fwd_istot_sn, after_fwd_istot_dx, conj/ qed-.
-
-lemma after_at1_fwd: ∀f1,i1,i2. @❪i1, f1❫ ≘ i2 → ∀f2. 𝐓❪f2❫ → ∀f. f2 ⊚ f1 ≘ f →
- ∃∃i. @❪i2, f2❫ ≘ i & @❪i1, f❫ ≘ i.
-#f1 #i1 #i2 #Hf1 #f2 #Hf2 #f #Hf elim (Hf2 i2) -Hf2
-/3 width=8 by after_fwd_at, ex2_intro/
-qed-.
-
-lemma after_fwd_isid_sn: ∀f2,f1,f. 𝐓❪f❫ → f2 ⊚ f1 ≘ f → f1 ≡ f → 𝐈❪f2❫.
-#f2 #f1 #f #H #Hf elim (after_inv_istot … Hf H) -H
-#Hf2 #Hf1 #H @isid_at_total // -Hf2
-#i2 #i #Hf2 elim (Hf1 i2) -Hf1
-#i0 #Hf1 lapply (at_increasing … Hf1)
-#Hi20 lapply (after_fwd_at2 … i0 … Hf1 … Hf) -Hf
-/3 width=7 by at_eq_repl_back, at_mono, at_id_le/
-qed-.
-
-lemma after_fwd_isid_dx: ∀f2,f1,f. 𝐓❪f❫ → f2 ⊚ f1 ≘ f → f2 ≡ f → 𝐈❪f1❫.
-#f2 #f1 #f #H #Hf elim (after_inv_istot … Hf H) -H
-#Hf2 #Hf1 #H2 @isid_at_total // -Hf1
-#i1 #i2 #Hi12 elim (after_at1_fwd … Hi12 … Hf) -f1
-/3 width=8 by at_inj, at_eq_repl_back/
-qed-.
-
-corec fact after_inj_O_aux: ∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_after_inj f1.
-#f1 #H1f1 #H2f1 #f #f21 #f22 #H1f #H2f
-cases (at_inv_pxp … H1f1) -H1f1 [ |*: // ] #g1 #H1
-lapply (istot_inv_push … H2f1 … H1) -H2f1 #H2g1
-cases (H2g1 (𝟏)) #p #Hp
-cases (after_inv_pxx … H1f … H1) -H1f * #g21 #g #H1g #H21 #H
-[ cases (after_inv_pxp … H2f … H1 H) -f1 -f #g22 #H2g #H22
- @(eq_push … H21 H22) -f21 -f22
-| cases (after_inv_pxn … H2f … H1 H) -f1 -f #g22 #H2g #H22
- @(eq_next … H21 H22) -f21 -f22
-]
-@(after_inj_O_aux (⫱*[↓p]g1) … (⫱*[↓p]g)) -after_inj_O_aux
-/2 width=1 by after_tls, istot_tls, at_pxx_tls/
-qed-.
-
-fact after_inj_aux: (∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_after_inj f1) →
- ∀i2,f1. @❪𝟏, f1❫ ≘ i2 → H_after_inj f1.
-#H0 #i2 elim i2 -i2 /2 width=1 by/ -H0
-#i2 #IH #f1 #H1f1 #H2f1 #f #f21 #f22 #H1f #H2f
-elim (at_inv_pxn … H1f1) -H1f1 [ |*: // ] #g1 #H1g1 #H1
-elim (after_inv_nxx … H1f … H1) -H1f #g #H1g #H
-lapply (after_inv_nxn … H2f … H1 H) -f #H2g
-/3 width=6 by istot_inv_next/
-qed-.
-
-theorem after_inj: ∀f1. H_after_inj f1.
-#f1 #H cases (H (𝟏)) /3 width=7 by after_inj_aux, after_inj_O_aux/
-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 "ground/relocation/rtmap_uni.ma".
-include "ground/relocation/rtmap_nat.ma".
-include "ground/relocation/rtmap_after.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-lemma after_uni_dx: ∀l2,l1,f2. @↑❪l1, f2❫ ≘ l2 →
- ∀f. f2 ⊚ 𝐔❨l1❩ ≘ f → 𝐔❨l2❩ ⊚ ⫱*[l2] f2 ≘ f.
-#l2 @(nat_ind_succ … l2) -l2
-[ #l1 #f2 #Hf2 #f #Hf
- elim (rm_nat_inv_xxp … Hf2) -Hf2 // #g2 #H1 #H2 destruct
- lapply (after_isid_inv_dx … Hf ?) -Hf
- /3 width=3 by after_isid_sn, after_eq_repl_back0/
-| #l2 #IH #l1 #f2 #Hf2 #f #Hf
- elim (rm_nat_inv_xxn … Hf2) -Hf2 [1,3: * |*: // ]
- [ #g2 #k1 #Hg2 #H1 #H2 destruct
- elim (after_inv_pnx … Hf) -Hf [ |*: // ] #g #Hg #H destruct
- <tls_xn /3 width=5 by after_next/
- | #g2 #Hg2 #H2 destruct
- elim (after_inv_nxx … Hf) -Hf [ |*: // ] #g #Hg #H destruct
- <tls_xn /3 width=5 by after_next/
- ]
-]
-qed.
-
-lemma after_uni_sn: ∀l2,l1,f2. @↑❪l1, f2❫ ≘ l2 →
- ∀f. 𝐔❨l2❩ ⊚ ⫱*[l2] f2 ≘ f → f2 ⊚ 𝐔❨l1❩ ≘ f.
-#l2 @(nat_ind_succ … l2) -l2
-[ #l1 #f2 #Hf2 #f #Hf
- elim (rm_nat_inv_xxp … Hf2) -Hf2 // #g2 #H1 #H2 destruct
- lapply (after_isid_inv_sn … Hf ?) -Hf
- /3 width=3 by after_isid_dx, after_eq_repl_back0/
-| #l2 #IH #l1 #f2 #Hf2 #f #Hf
- elim (after_inv_nxx … Hf) -Hf [2,3: // ] #g #Hg #H destruct
- elim (rm_nat_inv_xxn … Hf2) -Hf2 [1,3: * |*: // ]
- [ #g2 #k1 #Hg2 #H1 #H2 destruct /3 width=7 by after_push/
- | #g2 #Hg2 #H2 destruct /3 width=5 by after_next/
- ]
-]
-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 "ground/arith/nat_plus.ma".
-include "ground/relocation/rtmap_uni.ma".
-include "ground/relocation/rtmap_after.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-(* Properties on isuni ******************************************************)
-
-lemma after_isid_isuni: ∀f1,f2. 𝐈❪f2❫ → 𝐔❪f1❫ → f1 ⊚ ↑f2 ≘ ↑f1.
-#f1 #f2 #Hf2 #H elim H -H
-/5 width=7 by after_isid_dx, after_eq_repl_back2, after_next, after_push, eq_push_inv_isid/
-qed.
-
-lemma after_uni_next2: ∀f2. 𝐔❪f2❫ → ∀f1,f. ↑f2 ⊚ f1 ≘ f → f2 ⊚ ↑f1 ≘ f.
-#f2 #H elim H -f2
-[ #f2 #Hf2 #f1 #f #Hf
- elim (after_inv_nxx … Hf) -Hf [2,3: // ] #g #Hg #H0 destruct
- /4 width=7 by after_isid_inv_sn, after_isid_sn, after_eq_repl_back0, eq_next/
-| #f2 #_ #g2 #H2 #IH #f1 #f #Hf
- elim (after_inv_nxx … Hf) -Hf [2,3: // ] #g #Hg #H0 destruct
- /3 width=5 by after_next/
-]
-qed.
-
-(* Properties on uni ********************************************************)
-
-lemma after_uni: ∀n1,n2. 𝐔❨n1❩ ⊚ 𝐔❨n2❩ ≘ 𝐔❨n2+n1❩.
-#n1 @(nat_ind_succ … n1) -n1
-/3 width=5 by after_isid_sn, after_next, eq_f/
-qed.
-
-lemma after_uni_sn_pushs (m) (f): 𝐔❨m❩ ⊚ f ≘ ↑*[m]f.
-#m @(nat_ind_succ … m) -m
-/2 width=5 by after_isid_sn, after_next/
-qed.
-
-(* Properties with at *******************************************************)
-
-lemma after_uni_succ_dx: ∀i2,i1,f2. @❪i1, f2❫ ≘ i2 →
- ∀f. f2 ⊚ 𝐔❨i1❩ ≘ f → 𝐔❨i2❩ ⊚ ⫱*[i2] f2 ≘ f.
-#i2 elim i2 -i2
-[ #i1 #f2 #Hf2 #f #Hf
- elim (at_inv_xxp … Hf2) -Hf2 // #g2 #H1 #H2 destruct
- elim (after_inv_pnx … Hf) -Hf [ |*: // ] #g #Hg #H
- lapply (after_isid_inv_dx … Hg ?) -Hg
- /4 width=5 by after_isid_sn, after_eq_repl_back0, after_next/
-| #i2 #IH #i1 #f2 #Hf2 #f #Hf >nsucc_inj
- elim (at_inv_xxn … Hf2) -Hf2 [1,3: * |*: // ]
- [ #g2 #j1 #Hg2 #H1 #H2 destruct >nsucc_inj in Hf; #Hf
- elim (after_inv_pnx … Hf) -Hf [ |*: // ] #g #Hg #H destruct
- <tls_xn /3 width=5 by after_next/
- | #g2 #Hg2 #H2 destruct
- elim (after_inv_nxx … Hf) -Hf [2,3: // ] #g #Hg #H destruct
- <tls_xn /3 width=5 by after_next/
- ]
-]
-qed.
-
-lemma after_uni_succ_sn: ∀i2,i1,f2. @❪i1, f2❫ ≘ i2 →
- ∀f. 𝐔❨i2❩ ⊚ ⫱*[i2] f2 ≘ f → f2 ⊚ 𝐔❨i1❩ ≘ f.
-#i2 elim i2 -i2
-[ #i1 #f2 #Hf2 #f #Hf
- elim (at_inv_xxp … Hf2) -Hf2 // #g2 #H1 #H2 destruct
- elim (after_inv_nxx … Hf) -Hf [ |*: // ] #g #Hg #H destruct
- lapply (after_isid_inv_sn … Hg ?) -Hg
- /4 width=7 by after_isid_dx, after_eq_repl_back0, after_push/
-| #i2 #IH #i1 #f2 #Hf2 #f >nsucc_inj #Hf
- elim (after_inv_nxx … Hf) -Hf [2,3: // ] #g #Hg #H destruct
- elim (at_inv_xxn … Hf2) -Hf2 [1,3: * |*: // ]
- [ #g2 #j1 #Hg2 #H1 #H2 destruct <tls_xn in Hg; /3 width=7 by after_push/
- | #g2 #Hg2 #H2 destruct <tls_xn in Hg; /3 width=5 by after_next/
- ]
-]
-qed-.
-
-lemma after_uni_one_dx: ∀f2,f. ⫯f2 ⊚ 𝐔❨𝟏❩ ≘ f → 𝐔❨𝟏❩ ⊚ f2 ≘ f.
-#f2 #f #H @(after_uni_succ_dx … (⫯f2)) /2 width=3 by at_refl/
-qed.
-
-lemma after_uni_one_sn: ∀f1,f. 𝐔❨𝟏❩ ⊚ f1 ≘ f → ⫯f1 ⊚ 𝐔❨𝟏❩ ≘ f.
-/3 width=3 by after_uni_succ_sn, at_refl/ qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.tcs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "ground/notation/relations/rat_3.ma".
-include "ground/arith/pnat_plus.ma".
-include "ground/arith/pnat_lt_pred.ma".
-include "ground/relocation/rtmap_id.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-coinductive at: relation3 rtmap pnat pnat ≝
-| at_refl: ∀f,g,j1,j2. ⫯f = g → 𝟏 = j1 → 𝟏 = j2 → at g j1 j2
-| at_push: ∀f,i1,i2. at f i1 i2 → ∀g,j1,j2. ⫯f = g → ↑i1 = j1 → ↑i2 = j2 → at g j1 j2
-| at_next: ∀f,i1,i2. at f i1 i2 → ∀g,j2. ↑f = g → ↑i2 = j2 → at g i1 j2
-.
-
-interpretation "relational application (rtmap)"
- 'RAt i1 f i2 = (at f i1 i2).
-
-definition H_at_div: relation4 rtmap rtmap rtmap rtmap ≝ λf2,g2,f1,g1.
- ∀jf,jg,j. @❪jf,f2❫ ≘ j → @❪jg,g2❫ ≘ j →
- ∃∃j0. @❪j0,f1❫ ≘ jf & @❪j0,g1❫ ≘ jg.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma at_inv_ppx: ∀f,i1,i2. @❪i1,f❫ ≘ i2 → ∀g. 𝟏 = i1 → ⫯g = f → 𝟏 = i2.
-#f #i1 #i2 * -f -i1 -i2 //
-[ #f #i1 #i2 #_ #g #j1 #j2 #_ * #_ #x #H destruct
-| #f #i1 #i2 #_ #g #j2 * #_ #x #_ #H elim (discr_push_next … H)
-]
-qed-.
-
-lemma at_inv_npx: ∀f,i1,i2. @❪i1,f❫ ≘ i2 → ∀g,j1. ↑j1 = i1 → ⫯g = f →
- ∃∃j2. @❪j1,g❫ ≘ j2 & ↑j2 = i2.
-#f #i1 #i2 * -f -i1 -i2
-[ #f #g #j1 #j2 #_ * #_ #x #x1 #H destruct
-| #f #i1 #i2 #Hi #g #j1 #j2 * * * #x #x1 #H #Hf >(injective_push … Hf) -g destruct /2 width=3 by ex2_intro/
-| #f #i1 #i2 #_ #g #j2 * #_ #x #x1 #_ #H elim (discr_push_next … H)
-]
-qed-.
-
-lemma at_inv_xnx: ∀f,i1,i2. @❪i1,f❫ ≘ i2 → ∀g. ↑g = f →
- ∃∃j2. @❪i1,g❫ ≘ j2 & ↑j2 = i2.
-#f #i1 #i2 * -f -i1 -i2
-[ #f #g #j1 #j2 * #_ #_ #x #H elim (discr_next_push … H)
-| #f #i1 #i2 #_ #g #j1 #j2 * #_ #_ #x #H elim (discr_next_push … H)
-| #f #i1 #i2 #Hi #g #j2 * * #x #H >(injective_next … H) -g /2 width=3 by ex2_intro/
-]
-qed-.
-
-(* Advanced inversion lemmas ************************************************)
-
-alias symbol "UpArrow" (instance 3) = "successor (positive integers)".
-lemma at_inv_ppn: ∀f,i1,i2. @❪i1,f❫ ≘ i2 →
- ∀g,j2. 𝟏 = i1 → ⫯g = f → ↑j2 = i2 → ⊥.
-#f #i1 #i2 #Hf #g #j2 #H1 #H <(at_inv_ppx … Hf … H1 H) -f -g -i1 -i2
-#H destruct
-qed-.
-
-alias symbol "UpArrow" (instance 7) = "successor (positive integers)".
-lemma at_inv_npp: ∀f,i1,i2. @❪i1,f❫ ≘ i2 →
- ∀g,j1. ↑j1 = i1 → ⫯g = f → 𝟏 = i2 → ⊥.
-#f #i1 #i2 #Hf #g #j1 #H1 #H elim (at_inv_npx … Hf … H1 H) -f -i1
-#x2 #Hg * -i2 #H destruct
-qed-.
-
-lemma at_inv_npn: ∀f,i1,i2. @❪i1,f❫ ≘ i2 →
- ∀g,j1,j2. ↑j1 = i1 → ⫯g = f → ↑j2 = i2 → @❪j1,g❫ ≘ j2.
-#f #i1 #i2 #Hf #g #j1 #j2 #H1 #H elim (at_inv_npx … Hf … H1 H) -f -i1
-#x2 #Hg * -i2 #H destruct //
-qed-.
-
-lemma at_inv_xnp: ∀f,i1,i2. @❪i1,f❫ ≘ i2 →
- ∀g. ↑g = f → 𝟏 = i2 → ⊥.
-#f #i1 #i2 #Hf #g #H elim (at_inv_xnx … Hf … H) -f
-#x2 #Hg * -i2 #H destruct
-qed-.
-
-lemma at_inv_xnn: ∀f,i1,i2. @❪i1,f❫ ≘ i2 →
- ∀g,j2. ↑g = f → ↑j2 = i2 → @❪i1,g❫ ≘ j2.
-#f #i1 #i2 #Hf #g #j2 #H elim (at_inv_xnx … Hf … H) -f
-#x2 #Hg * -i2 #H destruct //
-qed-.
-
-lemma at_inv_pxp: ∀f,i1,i2. @❪i1,f❫ ≘ i2 → 𝟏 = i1 → 𝟏 = i2 → ∃g. ⫯g = f.
-#f elim (pn_split … f) * /2 width=2 by ex_intro/
-#g #H #i1 #i2 #Hf #H1 #H2 cases (at_inv_xnp … Hf … H H2)
-qed-.
-
-lemma at_inv_pxn: ∀f,i1,i2. @❪i1,f❫ ≘ i2 → ∀j2. 𝟏 = i1 → ↑j2 = i2 →
- ∃∃g. @❪i1,g❫ ≘ j2 & ↑g = f.
-#f elim (pn_split … f) *
-#g #H #i1 #i2 #Hf #j2 #H1 #H2
-[ elim (at_inv_ppn … Hf … H1 H H2)
-| /3 width=5 by at_inv_xnn, ex2_intro/
-]
-qed-.
-
-alias symbol "UpArrow" (instance 5) = "successor (positive integers)".
-lemma at_inv_nxp: ∀f,i1,i2. @❪i1,f❫ ≘ i2 →
- ∀j1. ↑j1 = i1 → 𝟏 = i2 → ⊥.
-#f elim (pn_split f) *
-#g #H #i1 #i2 #Hf #j1 #H1 #H2
-[ elim (at_inv_npp … Hf … H1 H H2)
-| elim (at_inv_xnp … Hf … H H2)
-]
-qed-.
-
-lemma at_inv_nxn: ∀f,i1,i2. @❪i1,f❫ ≘ i2 → ∀j1,j2. ↑j1 = i1 → ↑j2 = i2 →
- (∃∃g. @❪j1,g❫ ≘ j2 & ⫯g = f) ∨
- ∃∃g. @❪i1,g❫ ≘ j2 & ↑g = f.
-#f elim (pn_split f) *
-/4 width=7 by at_inv_xnn, at_inv_npn, ex2_intro, or_intror, or_introl/
-qed-.
-
-(* Note: the following inversion lemmas must be checked *)
-lemma at_inv_xpx: ∀f,i1,i2. @❪i1,f❫ ≘ i2 → ∀g. ⫯g = f →
- ∨∨ ∧∧ 𝟏 = i1 & 𝟏 = i2
- | ∃∃j1,j2. @❪j1,g❫ ≘ j2 & ↑j1 = i1 & ↑j2 = i2.
-#f * [2: #i1 ] #i2 #Hf #g #H
-[ elim (at_inv_npx … Hf … H) -f /3 width=5 by or_intror, ex3_2_intro/
-| >(at_inv_ppx … Hf … H) -f /3 width=1 by conj, or_introl/
-]
-qed-.
-
-lemma at_inv_xpp: ∀f,i1,i2. @❪i1,f❫ ≘ i2 → ∀g. ⫯g = f → 𝟏 = i2 → 𝟏 = i1.
-#f #i1 #i2 #Hf #g #H elim (at_inv_xpx … Hf … H) -f * //
-#j1 #j2 #_ #_ * -i2 #H destruct
-qed-.
-
-lemma at_inv_xpn: ∀f,i1,i2. @❪i1,f❫ ≘ i2 → ∀g,j2. ⫯g = f → ↑j2 = i2 →
- ∃∃j1. @❪j1,g❫ ≘ j2 & ↑j1 = i1.
-#f #i1 #i2 #Hf #g #j2 #H elim (at_inv_xpx … Hf … H) -f *
-[ #_ * -i2 #H destruct
-| #x1 #x2 #Hg #H1 * -i2 #H destruct /2 width=3 by ex2_intro/
-]
-qed-.
-
-lemma at_inv_xxp: ∀f,i1,i2. @❪i1,f❫ ≘ i2 → 𝟏 = i2 →
- ∃∃g. 𝟏 = i1 & ⫯g = f.
-#f elim (pn_split f) *
-#g #H #i1 #i2 #Hf #H2
-[ /3 width=6 by at_inv_xpp, ex2_intro/
-| elim (at_inv_xnp … Hf … H H2)
-]
-qed-.
-
-lemma at_inv_xxn: ∀f,i1,i2. @❪i1,f❫ ≘ i2 → ∀j2. ↑j2 = i2 →
- (∃∃g,j1. @❪j1,g❫ ≘ j2 & ↑j1 = i1 & ⫯g = f) ∨
- ∃∃g. @❪i1,g❫ ≘ j2 & ↑g = f.
-#f elim (pn_split f) *
-#g #H #i1 #i2 #Hf #j2 #H2
-[ elim (at_inv_xpn … Hf … H H2) -i2 /3 width=5 by or_introl, ex3_2_intro/
-| lapply (at_inv_xnn … Hf … H H2) -i2 /3 width=3 by or_intror, ex2_intro/
-]
-qed-.
-
-(* Basic forward lemmas *****************************************************)
-
-lemma at_increasing: ∀i2,i1,f. @❪i1,f❫ ≘ i2 → i1 ≤ i2.
-#i2 elim i2 -i2
-[ #i1 #f #Hf elim (at_inv_xxp … Hf) -Hf //
-| #i2 #IH * //
- #i1 #f #Hf elim (at_inv_nxn … Hf) -Hf [1,4: * |*: // ]
- /3 width=2 by ple_succ_bi, ple_succ_dx/
-]
-qed-.
-
-lemma at_increasing_strict: ∀g,i1,i2. @❪i1,g❫ ≘ i2 → ∀f. ↑f = g →
- i1 < i2 ∧ @❪i1,f❫ ≘ ↓i2.
-#g #i1 #i2 #Hg #f #H elim (at_inv_xnx … Hg … H) -Hg -H
-/4 width=2 by conj, at_increasing, ple_succ_bi/
-qed-.
-
-lemma at_fwd_id_ex: ∀f,i. @❪i,f❫ ≘ i → ∃g. ⫯g = f.
-#f elim (pn_split f) * /2 width=2 by ex_intro/
-#g #H #i #Hf elim (at_inv_xnx … Hf … H) -Hf -H
-#j2 #Hg #H destruct lapply (at_increasing … Hg) -Hg
-#H elim (plt_ge_false … H) -H //
-qed-.
-
-(* Basic properties *********************************************************)
-
-corec lemma at_eq_repl_back: ∀i1,i2. eq_repl_back (λf. @❪i1,f❫ ≘ i2).
-#i1 #i2 #f1 #H1 cases H1 -f1 -i1 -i2
-[ #f1 #g1 #j1 #j2 #H #H1 #H2 #f2 #H12 cases (eq_inv_px … H12 … H) -g1 /2 width=2 by at_refl/
-| #f1 #i1 #i2 #Hf1 #g1 #j1 #j2 #H #H1 #H2 #f2 #H12 cases (eq_inv_px … H12 … H) -g1 /3 width=7 by at_push/
-| #f1 #i1 #i2 #Hf1 #g1 #j2 #H #H2 #f2 #H12 cases (eq_inv_nx … H12 … H) -g1 /3 width=5 by at_next/
-]
-qed-.
-
-lemma at_eq_repl_fwd: ∀i1,i2. eq_repl_fwd (λf. @❪i1,f❫ ≘ i2).
-#i1 #i2 @eq_repl_sym /2 width=3 by at_eq_repl_back/
-qed-.
-
-lemma at_le_ex: ∀j2,i2,f. @❪i2,f❫ ≘ j2 → ∀i1. i1 ≤ i2 →
- ∃∃j1. @❪i1,f❫ ≘ j1 & j1 ≤ j2.
-#j2 elim j2 -j2 [2: #j2 #IH ] #i2 #f #Hf
-[ elim (at_inv_xxn … Hf) -Hf [1,3: * |*: // ]
- #g [ #x2 ] #Hg [ #H2 ] #H0
- [ * /3 width=3 by at_refl, ex2_intro/
- #i1 #Hi12 destruct lapply (ple_inv_succ_bi … Hi12) -Hi12
- #Hi12 elim (IH … Hg … Hi12) -x2 -IH
- /3 width=7 by at_push, ex2_intro, ple_succ_bi/
- | #i1 #Hi12 elim (IH … Hg … Hi12) -IH -i2
- /3 width=5 by at_next, ex2_intro, ple_succ_bi/
- ]
-| elim (at_inv_xxp … Hf) -Hf //
- #g * -i2 #H2 #i1 #Hi12 <(ple_inv_unit_dx … Hi12)
- /3 width=3 by at_refl, ex2_intro/
-]
-qed-.
-
-lemma at_id_le: ∀i1,i2. i1 ≤ i2 → ∀f. @❪i2,f❫ ≘ i2 → @❪i1,f❫ ≘ i1.
-#i1 #i2 #H @(ple_ind_alt … H) -i1 -i2 [ #i2 | #i1 #i2 #_ #IH ]
-#f #Hf elim (at_fwd_id_ex … Hf) /4 width=7 by at_inv_npn, at_push, at_refl/
-qed-.
-
-(* Main properties **********************************************************)
-
-theorem at_monotonic: ∀j2,i2,f. @❪i2,f❫ ≘ j2 → ∀j1,i1. @❪i1,f❫ ≘ j1 →
- i1 < i2 → j1 < j2.
-#j2 elim j2 -j2
-[ #i2 #f #H2f elim (at_inv_xxp … H2f) -H2f //
- #g #H21 #_ #j1 #i1 #_ #Hi elim (plt_ge_false … Hi) -Hi //
-| #j2 #IH #i2 #f #H2f * //
- #j1 #i1 #H1f #Hi elim (plt_inv_gen … Hi)
- #_ #Hi2 elim (at_inv_nxn … H2f (↓i2)) -H2f [1,3: * |*: // ]
- #g #H2g #H
- [ elim (at_inv_xpn … H1f … H) -f
- /4 width=8 by plt_inv_succ_bi, plt_succ_bi/
- | /4 width=8 by at_inv_xnn, plt_succ_bi/
- ]
-]
-qed-.
-
-theorem at_inv_monotonic: ∀j1,i1,f. @❪i1,f❫ ≘ j1 → ∀j2,i2. @❪i2,f❫ ≘ j2 →
- j1 < j2 → i1 < i2.
-#j1 elim j1 -j1
-[ #i1 #f #H1f elim (at_inv_xxp … H1f) -H1f //
- #g * -i1 #H #j2 #i2 #H2f #Hj lapply (plt_des_gen … Hj) -Hj
- #H22 elim (at_inv_xpn … H2f … (↓j2) H) -f //
-| #j1 #IH *
- [ #f #H1f elim (at_inv_pxn … H1f) -H1f [ |*: // ]
- #g #H1g #H #j2 #i2 #H2f #Hj elim (plt_inv_succ_sn … Hj) -Hj
- /3 width=7 by at_inv_xnn/
- | #i1 #f #H1f #j2 #i2 #H2f #Hj elim (plt_inv_succ_sn … Hj) -Hj
- #Hj #H22 elim (at_inv_nxn … H1f) -H1f [1,4: * |*: // ]
- #g #Hg #H
- [ elim (at_inv_xpn … H2f … (↓j2) H) -f
- /3 width=7 by plt_succ_bi/
- | /3 width=7 by at_inv_xnn/
- ]
- ]
-]
-qed-.
-
-theorem at_mono: ∀f,i,i1. @❪i,f❫ ≘ i1 → ∀i2. @❪i,f❫ ≘ i2 → i2 = i1.
-#f #i #i1 #H1 #i2 #H2 elim (pnat_split_lt_eq_gt i2 i1) //
-#Hi elim (plt_ge_false i i) /3 width=6 by at_inv_monotonic, eq_sym/
-qed-.
-
-theorem at_inj: ∀f,i1,i. @❪i1,f❫ ≘ i → ∀i2. @❪i2,f❫ ≘ i → i1 = i2.
-#f #i1 #i #H1 #i2 #H2 elim (pnat_split_lt_eq_gt i2 i1) //
-#Hi elim (plt_ge_false i i) /2 width=6 by at_monotonic/
-qed-.
-
-theorem at_div_comm: ∀f2,g2,f1,g1.
- H_at_div f2 g2 f1 g1 → H_at_div g2 f2 g1 f1.
-#f2 #g2 #f1 #g1 #IH #jg #jf #j #Hg #Hf
-elim (IH … Hf Hg) -IH -j /2 width=3 by ex2_intro/
-qed-.
-
-theorem at_div_pp: ∀f2,g2,f1,g1.
- H_at_div f2 g2 f1 g1 → H_at_div (⫯f2) (⫯g2) (⫯f1) (⫯g1).
-#f2 #g2 #f1 #g1 #IH #jf #jg #j #Hf #Hg
-elim (at_inv_xpx … Hf) -Hf [1,2: * |*: // ]
-[ #H1 #H2 destruct -IH
- lapply (at_inv_xpp … Hg ???) -Hg [4: |*: // ] #H destruct
- /3 width=3 by at_refl, ex2_intro/
-| #xf #i #Hf2 #H1 #H2 destruct
- lapply (at_inv_xpn … Hg ????) -Hg [5: * |*: // ] #xg #Hg2 #H destruct
- elim (IH … Hf2 Hg2) -IH -i /3 width=9 by at_push, ex2_intro/
-]
-qed-.
-
-theorem at_div_nn: ∀f2,g2,f1,g1.
- H_at_div f2 g2 f1 g1 → H_at_div (↑f2) (↑g2) (f1) (g1).
-#f2 #g2 #f1 #g1 #IH #jf #jg #j #Hf #Hg
-elim (at_inv_xnx … Hf) -Hf [ |*: // ] #i #Hf2 #H destruct
-lapply (at_inv_xnn … Hg ????) -Hg [5: |*: // ] #Hg2
-elim (IH … Hf2 Hg2) -IH -i /2 width=3 by ex2_intro/
-qed-.
-
-theorem at_div_np: ∀f2,g2,f1,g1.
- H_at_div f2 g2 f1 g1 → H_at_div (↑f2) (⫯g2) (f1) (↑g1).
-#f2 #g2 #f1 #g1 #IH #jf #jg #j #Hf #Hg
-elim (at_inv_xnx … Hf) -Hf [ |*: // ] #i #Hf2 #H destruct
-lapply (at_inv_xpn … Hg ????) -Hg [5: * |*: // ] #xg #Hg2 #H destruct
-elim (IH … Hf2 Hg2) -IH -i /3 width=7 by at_next, ex2_intro/
-qed-.
-
-theorem at_div_pn: ∀f2,g2,f1,g1.
- H_at_div f2 g2 f1 g1 → H_at_div (⫯f2) (↑g2) (↑f1) (g1).
-/4 width=6 by at_div_np, at_div_comm/ qed-.
-
-(* Properties on tls ********************************************************)
-
-(* Note: this requires ↑ on first n *)
-lemma at_pxx_tls: ∀n,f. @❪𝟏,f❫ ≘ ↑n → @❪𝟏,⫱*[n]f❫ ≘ 𝟏.
-#n @(nat_ind_succ … n) -n //
-#n #IH #f #Hf
-cases (at_inv_pxn … Hf) -Hf [ |*: // ] #g #Hg #H0 destruct
-<tls_xn /2 width=1 by/
-qed.
-
-(* Note: this requires ↑ on third n2 *)
-lemma at_tls: ∀n2,f. ⫯⫱*[↑n2]f ≡ ⫱*[n2]f → ∃i1. @❪i1,f❫ ≘ ↑n2.
-#n2 @(nat_ind_succ … n2) -n2
-[ /4 width=4 by at_eq_repl_back, at_refl, ex_intro/
-| #n2 #IH #f <tls_xn <tls_xn in ⊢ (??%→?); #H
- elim (IH … H) -IH -H #i1 #Hf
- elim (pn_split f) * #g #Hg destruct /3 width=8 by at_push, at_next, ex_intro/
-]
-qed-.
-
-(* Inversion lemmas with tls ************************************************)
-
-(* Note: this does not require ↑ on second and third p *)
-lemma at_inv_nxx: ∀p,g,i1,j2. @❪↑i1,g❫ ≘ j2 → @❪𝟏,g❫ ≘ p →
- ∃∃i2. @❪i1,⫱*[p]g❫ ≘ i2 & p+i2 = j2.
-#n elim n -n
-[ #g #i1 #j2 #Hg #H
- elim (at_inv_pxp … H) -H [ |*: // ] #f #H0
- elim (at_inv_npx … Hg … H0) -Hg [ |*: // ] #x2 #Hf #H2 destruct
- /2 width=3 by ex2_intro/
-| #n #IH #g #i1 #j2 #Hg #H
- elim (at_inv_pxn … H) -H [ |*: // ] #f #Hf2 #H0
- elim (at_inv_xnx … Hg … H0) -Hg #x2 #Hf1 #H2 destruct
- elim (IH … Hf1 Hf2) -IH -Hf1 -Hf2 #i2 #Hf #H2 destruct
- /2 width=3 by ex2_intro/
-]
-qed-.
-
-(* Note: this requires ↑ on first n2 *)
-lemma at_inv_tls: ∀n2,i1,f. @❪i1,f❫ ≘ ↑n2 → ⫯⫱*[↑n2]f ≡ ⫱*[n2]f.
-#n2 @(nat_ind_succ … n2) -n2
-[ #i1 #f #Hf elim (at_inv_xxp … Hf) -Hf // #g #H1 #H destruct
- /2 width=1 by eq_refl/
-| #n2 #IH #i1 #f #Hf
- elim (at_inv_xxn … Hf) -Hf [1,3: * |*: // ]
- [ #g #j1 #Hg #H1 #H2 | #g #Hg #Ho ] destruct
- <tls_xn /2 width=2 by/
-]
-qed-.
-
-(* Advanced inversion lemmas on isid ****************************************)
-
-lemma isid_inv_at: ∀i,f. 𝐈❪f❫ → @❪i,f❫ ≘ i.
-#i elim i -i
-[ #f #H elim (isid_inv_gen … H) -H /2 width=2 by at_refl/
-| #i #IH #f #H elim (isid_inv_gen … H) -H /3 width=7 by at_push/
-]
-qed.
-
-lemma isid_inv_at_mono: ∀f,i1,i2. 𝐈❪f❫ → @❪i1,f❫ ≘ i2 → i1 = i2.
-/3 width=6 by isid_inv_at, at_mono/ qed-.
-
-(* Advanced properties on isid **********************************************)
-
-corec lemma isid_at: ∀f. (∀i. @❪i,f❫ ≘ i) → 𝐈❪f❫.
-#f #Hf lapply (Hf (𝟏))
-#H cases (at_fwd_id_ex … H) -H
-#g #H @(isid_push … H) /3 width=7 by at_inv_npn/
-qed-.
-
-(* Advanced properties on id ************************************************)
-
-lemma id_inv_at: ∀f. (∀i. @❪i,f❫ ≘ i) → 𝐈𝐝 ≡ f.
-/3 width=1 by isid_at, eq_id_inv_isid/ qed-.
-
-lemma id_at: ∀i. @❪i,𝐈𝐝❫ ≘ i.
-/2 width=1 by isid_inv_at/ qed.
-
-(* Advanced forward lemmas on id ********************************************)
-
-lemma at_id_fwd: ∀i1,i2. @❪i1,𝐈𝐝❫ ≘ i2 → i1 = i2.
-/2 width=4 by at_mono/ qed.
-
-(* Main properties on id ****************************************************)
-
-theorem at_div_id_dx: ∀f. H_at_div f 𝐈𝐝 𝐈𝐝 f.
-#f #jf #j0 #j #Hf #H0
-lapply (at_id_fwd … H0) -H0 #H destruct
-/2 width=3 by ex2_intro/
-qed-.
-
-theorem at_div_id_sn: ∀f. H_at_div 𝐈𝐝 f f 𝐈𝐝.
-/3 width=6 by at_div_id_dx, at_div_comm/ qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.tcs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "ground/arith/nat_rplus_succ.ma".
-include "ground/relocation/rtmap_uni.ma".
-include "ground/relocation/rtmap_at.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-(* Properties with uniform relocations **************************************)
-
-lemma at_uni: ∀n,i. @❪i,𝐔❨n❩❫ ≘ i+n.
-#n @(nat_ind_succ … n) -n /2 width=5 by at_next/
-qed.
-
-(* Inversion lemmas with uniform relocations ********************************)
-
-lemma at_inv_uni: ∀n,i,j. @❪i,𝐔❨n❩❫ ≘ j → j = i+n.
-/2 width=4 by at_mono/ 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 "ground/notation/functions/basic_2.ma".
-include "ground/relocation/rtmap_uni.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-definition basic: nat → nat → rtmap ≝ λm,n. ⫯*[m] 𝐔❨n❩.
-
-interpretation "basic relocation (rtmap)"
- 'Basic m n = (basic m n).
-
-(* Basic properties *********************************************************)
-
-lemma at_basic_succ_sn (m) (n): ⫯𝐁❨m,n❩ = 𝐁❨↑m,n❩.
-#m #n >pushs_S //
-qed.
-
-lemma at_basic_zero_succ (n): ↑𝐁❨𝟎,n❩ = 𝐁❨𝟎,↑n❩.
-#n >nexts_S //
-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 "ground/arith/nat_le_pred.ma".
-include "ground/relocation/rtmap_after_uni.ma".
-include "ground/relocation/rtmap_basic.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-(* Properties with composition **********************************************)
-
-lemma after_basic_rc (m2,m1):
- m1 ≤ m2 → ∀n2,n1.m2 ≤ n1+m1 → 𝐁❨m2,n2❩ ⊚ 𝐁❨m1,n1❩ ≘ 𝐁❨m1,n1+n2❩.
-#m2 #m1 @(nat_ind_2_succ … m2 m1) -m2 -m1
-[ #m1 #H #n2 #n1 #_
- <(nle_inv_zero_dx … H) -m1 //
-| #m2 #IH #_ #n2 #n1 <nplus_zero_dx #H
- elim (nle_inv_succ_sn … H) -H #Hm2 #Hn1
- >Hn1 -Hn1 <nplus_succ_sn
- /3 width=7 by after_push/
-| #m2 #m1 #IH #H1 #n2 #n1 <nplus_succ_dx #H2
- lapply (nle_inv_succ_bi … H1) -H1 #H1
- lapply (nle_inv_succ_bi … H2) -H2 #H2
- /3 width=7 by after_refl/
-]
-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 "ground/arith/nat_plus_rplus.ma".
-include "ground/relocation/rtmap_basic_nat.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-(* Prioerties with application **********************************************)
-
-lemma at_basic_lt (m) (n) (i):
- ninj i ≤ m → @❪i, 𝐁❨m,n❩❫ ≘ i.
-#m #n #i >(npsucc_pred i) #Hmi
-/2 width=1 by rm_nat_basic_lt/
-qed.
-
-lemma at_basic_ge (m) (n) (i):
- m < ninj i → @❪i, 𝐁❨m,n❩❫ ≘ i+n.
-#m #n #i >(npsucc_pred i) #Hmi <nrplus_npsucc_sn
-/3 width=1 by rm_nat_basic_ge, nlt_inv_succ_dx/
-qed.
-
-(* Inversion lemmas with application ****************************************)
-
-lemma at_basic_inv_lt (m) (n) (i) (j):
- ninj i ≤ m → @❪i, 𝐁❨m,n❩❫ ≘ j → i = j.
-/3 width=4 by at_basic_lt, at_mono/ qed-.
-
-lemma at_basic_inv_ge (m) (n) (i) (j):
- m < ninj i → @❪i, 𝐁❨m,n❩❫ ≘ j → i+n = j.
-/3 width=4 by at_basic_ge, at_mono/ 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 "ground/relocation/rtmap_nat_uni.ma".
-include "ground/relocation/rtmap_basic.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-(* Prioerties with application **********************************************)
-
-lemma rm_nat_basic_lt (m) (n) (l):
- l < m → @↑❪l, 𝐁❨m,n❩❫ ≘ l.
-#m @(nat_ind_succ … m) -m
-[ #n #i #H elim (nlt_inv_zero_dx … H)
-| #m #IH #n #l @(nat_ind_succ … l) -l
- [ #_ /2 width=2 by refl, at_refl/
- | #l #_ #H
- lapply (nlt_inv_succ_bi … H) -H #Hlm
- /3 width=7 by refl, at_push/
- ]
-]
-qed.
-
-lemma rm_nat_basic_ge (m) (n) (l):
- m ≤ l → @↑❪l, 𝐁❨m,n❩❫ ≘ l+n.
-#m @(nat_ind_succ … m) -m //
-#m #IH #n #l #H
-elim (nle_inv_succ_sn … H) -H #Hml #H >H -H
-/3 width=7 by rm_nat_push/
-qed.
-
-(* Inversion lemmas with application ****************************************)
-
-lemma rm_nat_basic_inv_lt (m) (n) (l) (k):
- l < m → @↑❪l, 𝐁❨m,n❩❫ ≘ k → l = k.
-/3 width=4 by rm_nat_basic_lt, rm_nat_mono/ qed-.
-
-lemma rm_nat_basic_inv_ge (m) (n) (l) (k):
- m ≤ l → @↑❪l, 𝐁❨m,n❩❫ ≘ k → l+n = k.
-/3 width=4 by rm_nat_basic_ge, rm_nat_mono/ 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 "ground/notation/relations/rcoafter_3.ma".
-include "ground/relocation/rtmap_sor.ma".
-include "ground/relocation/rtmap_nat.ma".
-include "ground/relocation/rtmap_after.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-coinductive coafter: relation3 rtmap rtmap rtmap ≝
-| coafter_refl: ∀f1,f2,f,g1,g2,g. coafter f1 f2 f →
- ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → coafter g1 g2 g
-| coafter_push: ∀f1,f2,f,g1,g2,g. coafter f1 f2 f →
- ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → coafter g1 g2 g
-| coafter_next: ∀f1,f2,f,g1,g. coafter f1 f2 f →
- ↑f1 = g1 → ⫯f = g → coafter g1 f2 g
-.
-
-interpretation "relational co-composition (rtmap)"
- 'RCoAfter f1 f2 f = (coafter f1 f2 f).
-
-definition H_coafter_inj: predicate rtmap ≝
- λf1. 𝐓❪f1❫ →
- ∀f,f21,f22. f1 ~⊚ f21 ≘ f → f1 ~⊚ f22 ≘ f → f21 ≡ f22.
-
-definition H_coafter_fwd_isid2: predicate rtmap ≝
- λf1. ∀f2,f. f1 ~⊚ f2 ≘ f → 𝐓❪f1❫ → 𝐈❪f❫ → 𝐈❪f2❫.
-
-definition H_coafter_isfin2_fwd: predicate rtmap ≝
- λf1. ∀f2. 𝐅❪f2❫ → 𝐓❪f1❫ → ∀f. f1 ~⊚ f2 ≘ f → 𝐅❪f❫.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma coafter_inv_ppx: ∀g1,g2,g. g1 ~⊚ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 →
- ∃∃f. f1 ~⊚ f2 ≘ f & ⫯f = g.
-#g1 #g2 #g * -g1 -g2 -g #f1 #f2 #f #g1
-[ #g2 #g #Hf #H1 #H2 #H #x1 #x2 #Hx1 #Hx2 destruct
- >(injective_push … Hx1) >(injective_push … Hx2) -x2 -x1
- /2 width=3 by ex2_intro/
-| #g2 #g #_ #_ #H2 #_ #x1 #x2 #_ #Hx2 destruct
- elim (discr_push_next … Hx2)
-| #g #_ #H1 #_ #x1 #x2 #Hx1 #_ destruct
- elim (discr_push_next … Hx1)
-]
-qed-.
-
-lemma coafter_inv_pnx: ∀g1,g2,g. g1 ~⊚ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 →
- ∃∃f. f1 ~⊚ f2 ≘ f & ↑f = g.
-#g1 #g2 #g * -g1 -g2 -g #f1 #f2 #f #g1
-[ #g2 #g #_ #_ #H2 #_ #x1 #x2 #_ #Hx2 destruct
- elim (discr_next_push … Hx2)
-| #g2 #g #Hf #H1 #H2 #H3 #x1 #x2 #Hx1 #Hx2 destruct
- >(injective_push … Hx1) >(injective_next … Hx2) -x2 -x1
- /2 width=3 by ex2_intro/
-| #g #_ #H1 #_ #x1 #x2 #Hx1 #_ destruct
- elim (discr_push_next … Hx1)
-]
-qed-.
-
-lemma coafter_inv_nxx: ∀g1,f2,g. g1 ~⊚ f2 ≘ g → ∀f1. ↑f1 = g1 →
- ∃∃f. f1 ~⊚ f2 ≘ f & ⫯f = g.
-#g1 #f2 #g * -g1 -f2 -g #f1 #f2 #f #g1
-[ #g2 #g #_ #H1 #_ #_ #x1 #Hx1 destruct
- elim (discr_next_push … Hx1)
-| #g2 #g #_ #H1 #_ #_ #x1 #Hx1 destruct
- elim (discr_next_push … Hx1)
-| #g #Hf #H1 #H #x1 #Hx1 destruct
- >(injective_next … Hx1) -x1
- /2 width=3 by ex2_intro/
-]
-qed-.
-
-(* Advanced inversion lemmas ************************************************)
-
-lemma coafter_inv_ppp: ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
- ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → f1 ~⊚ f2 ≘ f.
-#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H
-elim (coafter_inv_ppx … Hg … H1 H2) -g1 -g2 #x #Hf #Hx destruct
-<(injective_push … Hx) -f //
-qed-.
-
-lemma coafter_inv_ppn: ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
- ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ↑f = g → ⊥.
-#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H
-elim (coafter_inv_ppx … Hg … H1 H2) -g1 -g2 #x #Hf #Hx destruct
-elim (discr_push_next … Hx)
-qed-.
-
-lemma coafter_inv_pnn: ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
- ∀f1,f2,f. ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → f1 ~⊚ f2 ≘ f.
-#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H
-elim (coafter_inv_pnx … Hg … H1 H2) -g1 -g2 #x #Hf #Hx destruct
-<(injective_next … Hx) -f //
-qed-.
-
-lemma coafter_inv_pnp: ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
- ∀f1,f2,f. ⫯f1 = g1 → ↑f2 = g2 → ⫯f = g → ⊥.
-#g1 #g2 #g #Hg #f1 #f2 #f #H1 #H2 #H
-elim (coafter_inv_pnx … Hg … H1 H2) -g1 -g2 #x #Hf #Hx destruct
-elim (discr_next_push … Hx)
-qed-.
-
-lemma coafter_inv_nxp: ∀g1,f2,g. g1 ~⊚ f2 ≘ g →
- ∀f1,f. ↑f1 = g1 → ⫯f = g → f1 ~⊚ f2 ≘ f.
-#g1 #f2 #g #Hg #f1 #f #H1 #H
-elim (coafter_inv_nxx … Hg … H1) -g1 #x #Hf #Hx destruct
-<(injective_push … Hx) -f //
-qed-.
-
-lemma coafter_inv_nxn: ∀g1,f2,g. g1 ~⊚ f2 ≘ g →
- ∀f1,f. ↑f1 = g1 → ↑f = g → ⊥.
-#g1 #f2 #g #Hg #f1 #f #H1 #H
-elim (coafter_inv_nxx … Hg … H1) -g1 #x #Hf #Hx destruct
-elim (discr_push_next … Hx)
-qed-.
-
-lemma coafter_inv_pxp: ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
- ∀f1,f. ⫯f1 = g1 → ⫯f = g →
- ∃∃f2. f1 ~⊚ f2 ≘ f & ⫯f2 = g2.
-#g1 #g2 #g #Hg #f1 #f #H1 #H elim (pn_split g2) * #f2 #H2
-[ lapply (coafter_inv_ppp … Hg … H1 H2 H) -g1 -g /2 width=3 by ex2_intro/
-| elim (coafter_inv_pnp … Hg … H1 H2 H)
-]
-qed-.
-
-lemma coafter_inv_pxn: ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
- ∀f1,f. ⫯f1 = g1 → ↑f = g →
- ∃∃f2. f1 ~⊚ f2 ≘ f & ↑f2 = g2.
-#g1 #g2 #g #Hg #f1 #f #H1 #H elim (pn_split g2) * #f2 #H2
-[ elim (coafter_inv_ppn … Hg … H1 H2 H)
-| lapply (coafter_inv_pnn … Hg … H1 … H) -g1 -g /2 width=3 by ex2_intro/
-]
-qed-.
-
-lemma coafter_inv_xxn: ∀g1,g2,g. g1 ~⊚ g2 ≘ g → ∀f. ↑f = g →
- ∃∃f1,f2. f1 ~⊚ f2 ≘ f & ⫯f1 = g1 & ↑f2 = g2.
-#g1 #g2 #g #Hg #f #H elim (pn_split g1) * #f1 #H1
-[ elim (coafter_inv_pxn … Hg … H1 H) -g /2 width=5 by ex3_2_intro/
-| elim (coafter_inv_nxn … Hg … H1 H)
-]
-qed-.
-
-lemma coafter_inv_xnn: ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
- ∀f2,f. ↑f2 = g2 → ↑f = g →
- ∃∃f1. f1 ~⊚ f2 ≘ f & ⫯f1 = g1.
-#g1 #g2 #g #Hg #f2 #f #H2 destruct #H
-elim (coafter_inv_xxn … Hg … H) -g
-#z1 #z2 #Hf #H1 #H2 destruct /2 width=3 by ex2_intro/
-qed-.
-
-lemma coafter_inv_xxp: ∀g1,g2,g. g1 ~⊚ g2 ≘ g → ∀f. ⫯f = g →
- (∃∃f1,f2. f1 ~⊚ f2 ≘ f & ⫯f1 = g1 & ⫯f2 = g2) ∨
- ∃∃f1. f1 ~⊚ g2 ≘ f & ↑f1 = g1.
-#g1 #g2 #g #Hg #f #H elim (pn_split g1) * #f1 #H1
-[ elim (coafter_inv_pxp … Hg … H1 H) -g
- /3 width=5 by or_introl, ex3_2_intro/
-| /4 width=5 by coafter_inv_nxp, or_intror, ex2_intro/
-]
-qed-.
-
-lemma coafter_inv_pxx: ∀g1,g2,g. g1 ~⊚ g2 ≘ g → ∀f1. ⫯f1 = g1 →
- (∃∃f2,f. f1 ~⊚ f2 ≘ f & ⫯f2 = g2 & ⫯f = g) ∨
- (∃∃f2,f. f1 ~⊚ f2 ≘ f & ↑f2 = g2 & ↑f = g).
-#g1 #g2 #g #Hg #f1 #H1 elim (pn_split g2) * #f2 #H2
-[ elim (coafter_inv_ppx … Hg … H1 H2) -g1
- /3 width=5 by or_introl, ex3_2_intro/
-| elim (coafter_inv_pnx … Hg … H1 H2) -g1
- /3 width=5 by or_intror, ex3_2_intro/
-]
-qed-.
-
-(* Basic properties *********************************************************)
-
-corec lemma coafter_eq_repl_back2: ∀f1,f. eq_repl_back (λf2. f2 ~⊚ f1 ≘ f).
-#f1 #f #f2 * -f2 -f1 -f
-#f21 #f1 #f #g21 [1,2: #g1 ] #g #Hf #H21 [1,2: #H1 ] #H #g22 #H0
-[ cases (eq_inv_px … H0 … H21) -g21 /3 width=7 by coafter_refl/
-| cases (eq_inv_px … H0 … H21) -g21 /3 width=7 by coafter_push/
-| cases (eq_inv_nx … H0 … H21) -g21 /3 width=5 by coafter_next/
-]
-qed-.
-
-lemma coafter_eq_repl_fwd2: ∀f1,f. eq_repl_fwd (λf2. f2 ~⊚ f1 ≘ f).
-#f1 #f @eq_repl_sym /2 width=3 by coafter_eq_repl_back2/
-qed-.
-
-corec lemma coafter_eq_repl_back1: ∀f2,f. eq_repl_back (λf1. f2 ~⊚ f1 ≘ f).
-#f2 #f #f1 * -f2 -f1 -f
-#f2 #f11 #f #g2 [1,2: #g11 ] #g #Hf #H2 [1,2: #H11 ] #H #g2 #H0
-[ cases (eq_inv_px … H0 … H11) -g11 /3 width=7 by coafter_refl/
-| cases (eq_inv_nx … H0 … H11) -g11 /3 width=7 by coafter_push/
-| @(coafter_next … H2 H) /2 width=5 by/
-]
-qed-.
-
-lemma coafter_eq_repl_fwd1: ∀f2,f. eq_repl_fwd (λf1. f2 ~⊚ f1 ≘ f).
-#f2 #f @eq_repl_sym /2 width=3 by coafter_eq_repl_back1/
-qed-.
-
-corec lemma coafter_eq_repl_back0: ∀f1,f2. eq_repl_back (λf. f2 ~⊚ f1 ≘ f).
-#f2 #f1 #f * -f2 -f1 -f
-#f2 #f1 #f01 #g2 [1,2: #g1 ] #g01 #Hf01 #H2 [1,2: #H1 ] #H01 #g02 #H0
-[ cases (eq_inv_px … H0 … H01) -g01 /3 width=7 by coafter_refl/
-| cases (eq_inv_nx … H0 … H01) -g01 /3 width=7 by coafter_push/
-| cases (eq_inv_px … H0 … H01) -g01 /3 width=5 by coafter_next/
-]
-qed-.
-
-lemma coafter_eq_repl_fwd0: ∀f2,f1. eq_repl_fwd (λf. f2 ~⊚ f1 ≘ f).
-#f2 #f1 @eq_repl_sym /2 width=3 by coafter_eq_repl_back0/
-qed-.
-
-(* Main inversion lemmas ****************************************************)
-
-corec theorem coafter_mono: ∀f1,f2,x,y. f1 ~⊚ f2 ≘ x → f1 ~⊚ f2 ≘ y → x ≡ y.
-#f1 #f2 #x #y * -f1 -f2 -x
-#f1 #f2 #x #g1 [1,2: #g2 ] #g #Hx #H1 [1,2: #H2 ] #H0x #Hy
-[ cases (coafter_inv_ppx … Hy … H1 H2) -g1 -g2 /3 width=8 by eq_push/
-| cases (coafter_inv_pnx … Hy … H1 H2) -g1 -g2 /3 width=8 by eq_next/
-| cases (coafter_inv_nxx … Hy … H1) -g1 /3 width=8 by eq_push/
-]
-qed-.
-
-lemma coafter_mono_eq: ∀f1,f2,f. f1 ~⊚ f2 ≘ f → ∀g1,g2,g. g1 ~⊚ g2 ≘ g →
- f1 ≡ g1 → f2 ≡ g2 → f ≡ g.
-/4 width=4 by coafter_mono, coafter_eq_repl_back1, coafter_eq_repl_back2/ qed-.
-
-(* Forward lemmas with pushs ************************************************)
-
-lemma coafter_fwd_pushs: ∀k,l,g2,f1,g. g2 ~⊚ ⫯*[l]f1 ≘ g → @↑❪l, g2❫ ≘ k →
- ∃∃f. ⫱*[k]g2 ~⊚ f1 ≘ f & ⫯*[k] f = g.
-#k @(nat_ind_succ … k) -k
-[ #l #g2 #f1 #g #Hg #H
- elim (rm_nat_inv_xxp … H) -H [|*: // ] #f2 #H1 #H2 destruct
- /2 width=3 by ex2_intro/
-| #k #IH * [| #l ] #g2 #f1 #g #Hg #H
- [ elim (rm_nat_inv_pxn … H) -H [|*: // ] #f2 #Hlk #H destruct
- elim (coafter_inv_nxx … Hg) -Hg [|*: // ] #f #Hf #H destruct
- elim (IH … Hf Hlk) -IH -Hf -Hlk /2 width=3 by ex2_intro/
- | elim (rm_nat_inv_nxn … H) -H [1,4: * |*: // ] #f2 #Hlk #H destruct
- [ elim (coafter_inv_ppx … Hg) -Hg [|*: // ] #f #Hf #H destruct
- elim (IH … Hf Hlk) -IH -Hf -Hlk /2 width=3 by ex2_intro/
- | elim (coafter_inv_nxx … Hg) -Hg [|*: // ] #f #Hf #H destruct
- elim (IH … Hf Hlk) -IH -Hf -Hlk /2 width=3 by ex2_intro/
- ]
- ]
-]
-qed-.
-
-(* Inversion lemmas with tail ***********************************************)
-
-lemma coafter_inv_tl1: ∀g2,g1,g. g2 ~⊚ ⫱g1 ≘ g →
- ∃∃f. ⫯g2 ~⊚ g1 ≘ f & ⫱f = g.
-#g2 #g1 #g elim (pn_split g1) * #f1 #H1 #H destruct
-[ /3 width=7 by coafter_refl, ex2_intro/
-| @(ex2_intro … (↑g)) /2 width=7 by coafter_push/ (**) (* full auto fails *)
-]
-qed-.
-
-lemma coafter_inv_tl0: ∀g2,g1,g. g2 ~⊚ g1 ≘ ⫱g →
- ∃∃f1. ⫯g2 ~⊚ f1 ≘ g & ⫱f1 = g1.
-#g2 #g1 #g elim (pn_split g) * #f #H0 #H destruct
-[ /3 width=7 by coafter_refl, ex2_intro/
-| @(ex2_intro … (↑g1)) /2 width=7 by coafter_push/ (**) (* full auto fails *)
-]
-qed-.
-
-(* Properties with iterated tail ********************************************)
-
-lemma coafter_tls: ∀l2,l1,f1,f2,f. @↑❪l1, f1❫ ≘ l2 →
- f1 ~⊚ f2 ≘ f → ⫱*[l2]f1 ~⊚ ⫱*[l1]f2 ≘ ⫱*[l2]f.
-#l2 @(nat_ind_succ … l2) -l2 [ #l1 | #l2 #IH * [| #l1 ] ] #f1 #f2 #f #Hf1 #Hf
-[ elim (rm_nat_inv_xxp … Hf1) -Hf1 [ |*: // ] #g1 #Hg1 #H1 destruct //
-| elim (rm_nat_inv_pxn … Hf1) -Hf1 [ |*: // ] #g1 #Hg1 #H1
- elim (coafter_inv_nxx … Hf … H1) -Hf #g #Hg #H0 destruct
- lapply (IH … Hg1 Hg) -IH -Hg1 -Hg //
-| elim (rm_nat_inv_xxn … Hf1) -Hf1 [1,3: * |*: // ] #g1 [ #k1 ] #Hg1 [ #H ] #H1
- [ elim (coafter_inv_pxx … Hf … H1) -Hf * #g2 #g #Hg #H2 #H0 destruct
- lapply (IH … Hg1 Hg) -IH -Hg1 -Hg #H //
- | elim (coafter_inv_nxx … Hf … H1) -Hf #g #Hg #H0 destruct
- lapply (IH … Hg1 Hg) -IH -Hg1 -Hg #H //
- ]
-]
-qed.
-
-lemma coafter_tls_O: ∀k,f1,f2,f. @↑❪𝟎, f1❫ ≘ k →
- f1 ~⊚ f2 ≘ f → ⫱*[k]f1 ~⊚ f2 ≘ ⫱*[k]f.
-/2 width=1 by coafter_tls/ qed.
-
-(* Note: this does not require ↑ first and second j *)
-lemma coafter_tls_succ: ∀g2,g1,g. g2 ~⊚ g1 ≘ g →
- ∀j. @❪𝟏, g2❫ ≘ j → ⫱*[j]g2 ~⊚ ⫱g1 ≘ ⫱*[j]g.
-#g2 #g1 #g #Hg #j #Hg2
-lapply (rm_nat_pred_bi … Hg2) -Hg2 #Hg2
-lapply (coafter_tls … Hg2 … Hg) -Hg #Hg
-lapply (at_pxx_tls … Hg2) -Hg2 #H
-elim (at_inv_pxp … H) -H [ |*: // ] #f2 #H2
-elim (coafter_inv_pxx … Hg … H2) -Hg * #f1 #f #Hf #H1 #H0
->(npsucc_pred j) <tls_S <tls_S //
-qed.
-(*
-lemma coafter_fwd_xpx_pushs: ∀g2,f1,g,i,j. @❪i, g2❫ ≘ j → g2 ~⊚ ⫯*[i]⫯f1 ≘ g →
- ∃∃f. ⫱*[↑j]g2 ~⊚ f1 ≘ f & ⫯*[j]⫯f = g.
-#g2 #g1 #g #i #j #Hg2 <pushs_xn #Hg(coafter_fwd_pushs … Hg Hg2) #f #H0 destruct
-lapply (coafter_tls … Hg2 Hg) -Hg <tls_pushs <tls_pushs #Hf
-lapply (at_inv_tls … Hg2) -Hg2 #H
-lapply (coafter_eq_repl_fwd2 … Hf … H) -H -Hf #Hf
-elim (coafter_inv_ppx … Hf) [|*: // ] -Hf #g #Hg #H destruct
-/2 width=3 by ex2_intro/
-qed-.
-
-lemma coafter_fwd_xnx_pushs: ∀g2,f1,g,i,j. @❪i, g2❫ ≘ j → g2 ~⊚ ⫯*[i]↑f1 ≘ g →
- ∃∃f. ⫱*[↑j]g2 ~⊚ f1 ≘ f & ⫯*[j] ↑f = g.
-#g2 #g1 #g #i #j #Hg2 #Hg
-elim (coafter_fwd_pushs … Hg Hg2) #f #H0 destruct
-lapply (coafter_tls … Hg2 Hg) -Hg <tls_pushs <tls_pushs #Hf
-lapply (at_inv_tls … Hg2) -Hg2 #H
-lapply (coafter_eq_repl_fwd2 … Hf … H) -H -Hf #Hf
-elim (coafter_inv_pnx … Hf) [|*: // ] -Hf #g #Hg #H destruct
-/2 width=3 by ex2_intro/
-qed-.
-*)
-(* Properties with test for identity ****************************************)
-
-corec lemma coafter_isid_sn: ∀f1. 𝐈❪f1❫ → ∀f2. f1 ~⊚ f2 ≘ f2.
-#f1 * -f1 #f1 #g1 #Hf1 #H1 #f2 cases (pn_split f2) * #g2 #H2
-/3 width=7 by coafter_push, coafter_refl/
-qed.
-
-corec lemma coafter_isid_dx: ∀f2,f. 𝐈❪f2❫ → 𝐈❪f❫ → ∀f1. f1 ~⊚ f2 ≘ f.
-#f2 #f * -f2 #f2 #g2 #Hf2 #H2 * -f #f #g #Hf #H #f1 cases (pn_split f1) * #g1 #H1
-[ /3 width=7 by coafter_refl/
-| @(coafter_next … H1 … H) /3 width=3 by isid_push/
-]
-qed.
-
-(* Inversion lemmas with test for identity **********************************)
-
-lemma coafter_isid_inv_sn: ∀f1,f2,f. f1 ~⊚ f2 ≘ f → 𝐈❪f1❫ → f2 ≡ f.
-/3 width=6 by coafter_isid_sn, coafter_mono/ qed-.
-
-lemma coafter_isid_inv_dx: ∀f1,f2,f. f1 ~⊚ f2 ≘ f → 𝐈❪f2❫ → 𝐈❪f❫.
-/4 width=4 by eq_id_isid, coafter_isid_dx, coafter_mono/ qed-.
-
-(* Forward lemmas with istot ************************************************)
-
-corec fact coafter_inj_O_aux: ∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_coafter_inj f1.
-#f1 #H1f1 #H2f1 #f #f21 #f22 #H1f #H2f
-cases (at_inv_pxp … H1f1) -H1f1 [ |*: // ] #g1 #H1
-lapply (istot_inv_push … H2f1 … H1) -H2f1 #H2g1
-cases (H2g1 (𝟏)) #n #Hn
-cases (coafter_inv_pxx … H1f … H1) -H1f * #g21 #g #H1g #H21 #H
-[ cases (coafter_inv_pxp … H2f … H1 H) -f1 -f #g22 #H2g #H22
- @(eq_push … H21 H22) -f21 -f22
-| cases (coafter_inv_pxn … H2f … H1 H) -f1 -f #g22 #H2g #H22
- @(eq_next … H21 H22) -f21 -f22
-]
-@(coafter_inj_O_aux (⫱*[↓n]g1) … (⫱*[↓n]g)) -coafter_inj_O_aux
-/2 width=1 by coafter_tls, istot_tls, at_pxx_tls/
-qed-.
-
-fact coafter_inj_aux: (∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_coafter_inj f1) →
- ∀i2,f1. @❪𝟏, f1❫ ≘ i2 → H_coafter_inj f1.
-#H0 #i2 elim i2 -i2 /2 width=1 by/ -H0
-#i2 #IH #f1 #H1f1 #H2f1 #f #f21 #f22 #H1f #H2f
-elim (at_inv_pxn … H1f1) -H1f1 [ |*: // ] #g1 #H1g1 #H1
-elim (coafter_inv_nxx … H1f … H1) -H1f #g #H1g #H
-lapply (coafter_inv_nxp … H2f … H1 H) -f #H2g
-/3 width=6 by istot_inv_next/
-qed-.
-
-theorem coafter_inj: ∀f1. H_coafter_inj f1.
-#f1 #H cases (H (𝟏)) /3 width=7 by coafter_inj_aux, coafter_inj_O_aux/
-qed-.
-
-corec fact coafter_fwd_isid2_O_aux: ∀f1. @❪𝟏, f1❫ ≘ 𝟏 →
- H_coafter_fwd_isid2 f1.
-#f1 #H1f1 #f2 #f #H #H2f1 #Hf
-cases (at_inv_pxp … H1f1) -H1f1 [ |*: // ] #g1 #H1
-lapply (istot_inv_push … H2f1 … H1) -H2f1 #H2g1
-cases (H2g1 (𝟏)) #n #Hn
-cases (coafter_inv_pxx … H … H1) -H * #g2 #g #H #H2 #H0
-[ lapply (isid_inv_push … Hf … H0) -Hf #Hg
- @(isid_push … H2) -H2
- /3 width=7 by coafter_tls_O, at_pxx_tls, istot_tls, isid_tls/
-| cases (isid_inv_next … Hf … H0)
-]
-qed-.
-
-fact coafter_fwd_isid2_aux: (∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_coafter_fwd_isid2 f1) →
- ∀i2,f1. @❪𝟏, f1❫ ≘ i2 → H_coafter_fwd_isid2 f1.
-#H0 #i2 elim i2 -i2 /2 width=1 by/ -H0
-#i2 #IH #f1 #H1f1 #f2 #f #H #H2f1 #Hf
-elim (at_inv_pxn … H1f1) -H1f1 [ |*: // ] #g1 #Hg1 #H1
-elim (coafter_inv_nxx … H … H1) -H #g #Hg #H0
-@(IH … Hg1 … Hg) /2 width=3 by istot_inv_next, isid_inv_push/ (**) (* full auto fails *)
-qed-.
-
-lemma coafter_fwd_isid2: ∀f1. H_coafter_fwd_isid2 f1.
-#f1 #f2 #f #Hf #H cases (H (𝟏))
-/3 width=7 by coafter_fwd_isid2_aux, coafter_fwd_isid2_O_aux/
-qed-.
-
-fact coafter_isfin2_fwd_O_aux: ∀f1. @❪𝟏, f1❫ ≘ 𝟏 →
- H_coafter_isfin2_fwd f1.
-#f1 #Hf1 #f2 #H
-generalize in match Hf1; generalize in match f1; -f1
-@(isfin_ind … H) -f2
-[ /3 width=4 by coafter_isid_inv_dx, isfin_isid/ ]
-#f2 #_ #IH #f1 #H #Hf1 #f #Hf
-elim (at_inv_pxp … H) -H [ |*: // ] #g1 #H1
-lapply (istot_inv_push … Hf1 … H1) -Hf1 #Hg1
-elim (Hg1 (𝟏)) #n #Hn
-[ elim (coafter_inv_ppx … Hf) | elim (coafter_inv_pnx … Hf)
-] -Hf [1,6: |*: // ] #g #Hg #H0 destruct
-/5 width=6 by isfin_next, isfin_push, isfin_inv_tls, istot_tls, at_pxx_tls, coafter_tls_O/
-qed-.
-
-fact coafter_isfin2_fwd_aux: (∀f1. @❪𝟏, f1❫ ≘ 𝟏 → H_coafter_isfin2_fwd f1) →
- ∀i2,f1. @❪𝟏, f1❫ ≘ i2 → H_coafter_isfin2_fwd f1.
-#H0 #i2 elim i2 -i2 /2 width=1 by/ -H0
-#i2 #IH #f1 #H1f1 #f2 #Hf2 #H2f1 #f #Hf
-elim (at_inv_pxn … H1f1) -H1f1 [ |*: // ] #g1 #Hg1 #H1
-elim (coafter_inv_nxx … Hf … H1) -Hf #g #Hg #H0
-lapply (IH … Hg1 … Hg) -i2 -Hg
-/2 width=4 by istot_inv_next, isfin_push/ (**) (* full auto fails *)
-qed-.
-
-lemma coafter_isfin2_fwd: ∀f1. H_coafter_isfin2_fwd f1.
-#f1 #f2 #Hf2 #Hf1 cases (Hf1 (𝟏))
-/3 width=7 by coafter_isfin2_fwd_aux, coafter_isfin2_fwd_O_aux/
-qed-.
-
-lemma coafter_inv_sor: ∀f. 𝐅❪f❫ → ∀f2. 𝐓❪f2❫ → ∀f1. f2 ~⊚ f1 ≘ f → ∀fa,fb. fa ⋓ fb ≘ f →
- ∃∃f1a,f1b. f2 ~⊚ f1a ≘ fa & f2 ~⊚ f1b ≘ fb & f1a ⋓ f1b ≘ f1.
-@isfin_ind
-[ #f #Hf #f2 #Hf2 #f1 #H1f #fa #fb #H2f
- elim (sor_inv_isid3 … H2f) -H2f //
- lapply (coafter_fwd_isid2 … H1f ??) -H1f //
- /3 width=5 by ex3_2_intro, coafter_isid_dx, sor_isid/
-| #f #_ #IH #f2 #Hf2 #f1 #H1 #fa #fb #H2
- elim (sor_inv_xxp … H2) -H2 [ |*: // ] #ga #gb #H2f
- elim (coafter_inv_xxp … H1) -H1 [1,3: * |*: // ] #g2 [ #g1 ] #H1f #Hgf2
- [ lapply (istot_inv_push … Hf2 … Hgf2) | lapply (istot_inv_next … Hf2 … Hgf2) ] -Hf2 #Hg2
- elim (IH … Hg2 … H1f … H2f) -f -Hg2
- /3 width=11 by sor_pp, ex3_2_intro, coafter_refl, coafter_next/
-| #f #_ #IH #f2 #Hf2 #f1 #H1 #fa #fb #H2
- elim (coafter_inv_xxn … H1) -H1 [ |*: // ] #g2 #g1 #H1f #Hgf2
- lapply (istot_inv_push … Hf2 … Hgf2) -Hf2 #Hg2
- elim (sor_inv_xxn … H2) -H2 [1,3,4: * |*: // ] #ga #gb #H2f
- elim (IH … Hg2 … H1f … H2f) -f -Hg2
- /3 width=11 by sor_np, sor_pn, sor_nn, ex3_2_intro, coafter_refl, coafter_push/
-]
-qed-.
-
-(* Properties with istot ****************************************************)
-
-lemma coafter_sor: ∀f. 𝐅❪f❫ → ∀f2. 𝐓❪f2❫ → ∀f1. f2 ~⊚ f1 ≘ f → ∀f1a,f1b. f1a ⋓ f1b ≘ f1 →
- ∃∃fa,fb. f2 ~⊚ f1a ≘ fa & f2 ~⊚ f1b ≘ fb & fa ⋓ fb ≘ f.
-@isfin_ind
-[ #f #Hf #f2 #Hf2 #f1 #Hf #f1a #f1b #Hf1
- lapply (coafter_fwd_isid2 … Hf ??) -Hf // #H2f1
- elim (sor_inv_isid3 … Hf1) -Hf1 //
- /3 width=5 by coafter_isid_dx, sor_idem, ex3_2_intro/
-| #f #_ #IH #f2 #Hf2 #f1 #H1 #f1a #f1b #H2
- elim (coafter_inv_xxp … H1) -H1 [1,3: * |*: // ]
- [ #g2 #g1 #Hf #Hgf2 #Hgf1
- elim (sor_inv_xxp … H2) -H2 [ |*: // ] #ga #gb #Hg1
- lapply (istot_inv_push … Hf2 … Hgf2) -Hf2 #Hg2
- elim (IH … Hf … Hg1) // -f1 -g1 -IH -Hg2
- /3 width=11 by coafter_refl, sor_pp, ex3_2_intro/
- | #g2 #Hf #Hgf2
- lapply (istot_inv_next … Hf2 … Hgf2) -Hf2 #Hg2
- elim (IH … Hf … H2) // -f1 -IH -Hg2
- /3 width=11 by coafter_next, sor_pp, ex3_2_intro/
- ]
-| #f #_ #IH #f2 #Hf2 #f1 #H1 #f1a #f1b #H2
- elim (coafter_inv_xxn … H1) -H1 [ |*: // ] #g2 #g1 #Hf #Hgf2 #Hgf1
- lapply (istot_inv_push … Hf2 … Hgf2) -Hf2 #Hg2
- elim (sor_inv_xxn … H2) -H2 [1,3,4: * |*: // ] #ga #gb #Hg1
- elim (IH … Hf … Hg1) // -f1 -g1 -IH -Hg2
- /3 width=11 by coafter_refl, coafter_push, sor_np, sor_pn, sor_nn, ex3_2_intro/
-]
-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 "ground/relocation/rtmap_uni.ma".
-include "ground/relocation/rtmap_coafter.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-(* Properties with test for uniform relocations *****************************)
-
-lemma coafter_isuni_isid: ∀f2. 𝐈❪f2❫ → ∀f1. 𝐔❪f1❫ → f1 ~⊚ f2 ≘ f2.
-#f #Hf #g #H elim H -g
-/3 width=5 by coafter_isid_sn, coafter_eq_repl_back0, coafter_next, eq_push_inv_isid/
-qed.
-
-(* Properties with uniform relocations **************************************)
-
-lemma coafter_uni_sn: ∀n,f. 𝐔❨n❩ ~⊚ f ≘ ⫯*[n] f.
-#n @(nat_ind_succ … n) -n
-/2 width=5 by coafter_isid_sn, coafter_next/
-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 "ground/xoa/ex_3_2.ma".
-include "ground/notation/relations/ideq_2.ma".
-include "ground/relocation/rtmap.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-coinductive eq: relation rtmap ≝
-| eq_push: ∀f1,f2,g1,g2. eq f1 f2 → ⫯f1 = g1 → ⫯f2 = g2 → eq g1 g2
-| eq_next: ∀f1,f2,g1,g2. eq f1 f2 → ↑f1 = g1 → ↑f2 = g2 → eq g1 g2
-.
-
-interpretation "extensional equivalence (rtmap)"
- 'IdEq f1 f2 = (eq f1 f2).
-
-definition eq_repl (R:relation …) ≝
- ∀f1,f2. f1 ≡ f2 → R f1 f2.
-
-definition eq_repl_back (R:predicate …) ≝
- ∀f1. R f1 → ∀f2. f1 ≡ f2 → R f2.
-
-definition eq_repl_fwd (R:predicate …) ≝
- ∀f1. R f1 → ∀f2. f2 ≡ f1 → R f2.
-
-(* Basic properties *********************************************************)
-
-corec lemma eq_refl: reflexive … eq.
-#f cases (pn_split f) *
-#g #Hg [ @(eq_push … Hg Hg) | @(eq_next … Hg Hg) ] -Hg //
-qed.
-
-corec lemma eq_sym: symmetric … eq.
-#f1 #f2 * -f1 -f2
-#f1 #f2 #g1 #g2 #Hf #H1 #H2
-[ @(eq_push … H2 H1) | @(eq_next … H2 H1) ] -g2 -g1 /2 width=1 by/
-qed-.
-
-lemma eq_repl_sym: ∀R. eq_repl_back R → eq_repl_fwd R.
-/3 width=3 by eq_sym/ qed-.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma eq_inv_px: ∀g1,g2. g1 ≡ g2 → ∀f1. ⫯f1 = g1 →
- ∃∃f2. f1 ≡ f2 & ⫯f2 = g2.
-#g1 #g2 * -g1 -g2
-#f1 #f2 #g1 #g2 #Hf * * -g1 -g2
-#x1 #H
-[ lapply (injective_push … H) -H /2 width=3 by ex2_intro/
-| elim (discr_push_next … H)
-]
-qed-.
-
-lemma eq_inv_nx: ∀g1,g2. g1 ≡ g2 → ∀f1. ↑f1 = g1 →
- ∃∃f2. f1 ≡ f2 & ↑f2 = g2.
-#g1 #g2 * -g1 -g2
-#f1 #f2 #g1 #g2 #Hf * * -g1 -g2
-#x1 #H
-[ elim (discr_next_push … H)
-| lapply (injective_next … H) -H /2 width=3 by ex2_intro/
-]
-qed-.
-
-lemma eq_inv_xp: ∀g1,g2. g1 ≡ g2 → ∀f2. ⫯f2 = g2 →
- ∃∃f1. f1 ≡ f2 & ⫯f1 = g1.
-#g1 #g2 * -g1 -g2
-#f1 #f2 #g1 #g2 #Hf * * -g1 -g2
-#x2 #H
-[ lapply (injective_push … H) -H /2 width=3 by ex2_intro/
-| elim (discr_push_next … H)
-]
-qed-.
-
-lemma eq_inv_xn: ∀g1,g2. g1 ≡ g2 → ∀f2. ↑f2 = g2 →
- ∃∃f1. f1 ≡ f2 & ↑f1 = g1.
-#g1 #g2 * -g1 -g2
-#f1 #f2 #g1 #g2 #Hf * * -g1 -g2
-#x2 #H
-[ elim (discr_next_push … H)
-| lapply (injective_next … H) -H /2 width=3 by ex2_intro/
-]
-qed-.
-
-(* Advanced inversion lemmas ************************************************)
-
-lemma eq_inv_pp: ∀g1,g2. g1 ≡ g2 → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 → f1 ≡ f2.
-#g1 #g2 #H #f1 #f2 #H1 elim (eq_inv_px … H … H1) -g1
-#x2 #Hx2 * -g2
-#H lapply (injective_push … H) -H //
-qed-.
-
-lemma eq_inv_nn: ∀g1,g2. g1 ≡ g2 → ∀f1,f2. ↑f1 = g1 → ↑f2 = g2 → f1 ≡ f2.
-#g1 #g2 #H #f1 #f2 #H1 elim (eq_inv_nx … H … H1) -g1
-#x2 #Hx2 * -g2
-#H lapply (injective_next … H) -H //
-qed-.
-
-lemma eq_inv_pn: ∀g1,g2. g1 ≡ g2 → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 → ⊥.
-#g1 #g2 #H #f1 #f2 #H1 elim (eq_inv_px … H … H1) -g1
-#x2 #Hx2 * -g2
-#H elim (discr_next_push … H)
-qed-.
-
-lemma eq_inv_np: ∀g1,g2. g1 ≡ g2 → ∀f1,f2. ↑f1 = g1 → ⫯f2 = g2 → ⊥.
-#g1 #g2 #H #f1 #f2 #H1 elim (eq_inv_nx … H … H1) -g1
-#x2 #Hx2 * -g2
-#H elim (discr_push_next … H)
-qed-.
-
-lemma eq_inv_gen: ∀f1,f2. f1 ≡ f2 →
- (∃∃g1,g2. g1 ≡ g2 & ⫯g1 = f1 & ⫯g2 = f2) ∨
- ∃∃g1,g2. g1 ≡ g2 & ↑g1 = f1 & ↑g2 = f2.
-#f1 elim (pn_split f1) * #g1 #H1 #f2 #Hf
-[ elim (eq_inv_px … Hf … H1) -Hf /3 width=5 by or_introl, ex3_2_intro/
-| elim (eq_inv_nx … Hf … H1) -Hf /3 width=5 by or_intror, ex3_2_intro/
-]
-qed-.
-
-(* Main properties **********************************************************)
-
-corec theorem eq_trans: Transitive … eq.
-#f1 #f * -f1 -f
-#f1 #f #g1 #g #Hf1 #H1 #H #f2 #Hf2
-[ cases (eq_inv_px … Hf2 … H) | cases (eq_inv_nx … Hf2 … H) ] -g
-/3 width=5 by eq_push, eq_next/
-qed-.
-
-theorem eq_canc_sn: ∀f2. eq_repl_back (λf. f ≡ f2).
-/3 width=3 by eq_trans, eq_sym/ qed-.
-
-theorem eq_canc_dx: ∀f1. eq_repl_fwd (λf. f1 ≡ f).
-/3 width=3 by eq_trans, eq_sym/ 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 "ground/notation/relations/rcolength_2.ma".
-include "ground/relocation/rtmap_isid.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-inductive fcla: relation2 rtmap nat ≝
-| fcla_isid: ∀f. 𝐈❪f❫ → fcla f (𝟎)
-| fcla_push: ∀f,n. fcla f n → fcla (⫯f) n
-| fcla_next: ∀f,n. fcla f n → fcla (↑f) (↑n)
-.
-
-interpretation "finite colength assignment (rtmap)"
- 'RCoLength f n = (fcla f n).
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma fcla_inv_px: ∀g,m. 𝐂❪g❫ ≘ m → ∀f. ⫯f = g → 𝐂❪f❫ ≘ m.
-#g #m * -g -m /3 width=3 by fcla_isid, isid_inv_push/
-#g #m #_ #f #H elim (discr_push_next … H)
-qed-.
-
-lemma fcla_inv_nx: ∀g,m. 𝐂❪g❫ ≘ m → ∀f. ↑f = g →
- ∃∃n. 𝐂❪f❫ ≘ n & ↑n = m.
-#g #m * -g -m /2 width=3 by ex2_intro/
-[ #g #Hg #f #H elim (isid_inv_next … H) -H //
-| #g #m #_ #f #H elim (discr_next_push … H)
-]
-qed-.
-
-(* Advanced inversion lemmas ************************************************)
-
-lemma cla_inv_nn: ∀g,m. 𝐂❪g❫ ≘ m → ∀f,n. ↑f = g → ↑n = m → 𝐂❪f❫ ≘ n.
-#g #m #H #f #n #H1 #H2 elim (fcla_inv_nx … H … H1) -g
-#x #Hf #H destruct <(eq_inv_nsucc_bi … H) -n //
-qed-.
-
-lemma cla_inv_np: ∀g,m. 𝐂❪g❫ ≘ m → ∀f. ↑f = g → 𝟎 = m → ⊥.
-#g #m #H #f #H1 elim (fcla_inv_nx … H … H1) -g
-#x #_ #H1 #H2 destruct /2 width=2 by eq_inv_zero_nsucc/
-qed-.
-
-lemma fcla_inv_xp: ∀g,m. 𝐂❪g❫ ≘ m → 𝟎 = m → 𝐈❪g❫.
-#g #m #H elim H -g -m /3 width=3 by isid_push/
-#g #m #_ #_ #H destruct elim (eq_inv_zero_nsucc … H)
-qed-.
-
-lemma fcla_inv_isid: ∀f,n. 𝐂❪f❫ ≘ n → 𝐈❪f❫ → 𝟎 = n.
-#f #n #H elim H -f -n /3 width=3 by isid_inv_push/
-#f #n #_ #_ #H elim (isid_inv_next … H) -H //
-qed-.
-
-(* Main forward lemmas ******************************************************)
-
-theorem fcla_mono: ∀f,n1. 𝐂❪f❫ ≘ n1 → ∀n2. 𝐂❪f❫ ≘ n2 → n1 = n2.
-#f #n #H elim H -f -n
-[ /2 width=3 by fcla_inv_isid/
-| /3 width=3 by fcla_inv_px/
-| #f #n1 #_ #IH #n2 #H elim (fcla_inv_nx … H) -H [2,3 : // ]
- #g #Hf #H destruct >IH //
-]
-qed-.
-
-(* Basic properties *********************************************************)
-
-lemma fcla_eq_repl_back: ∀n. eq_repl_back … (λf. 𝐂❪f❫ ≘ n).
-#n #f1 #H elim H -f1 -n /3 width=3 by fcla_isid, isid_eq_repl_back/
-#f1 #n #_ #IH #g2 #H [ elim (eq_inv_px … H) | elim (eq_inv_nx … H) ] -H
-/3 width=3 by fcla_push, fcla_next/
-qed-.
-
-lemma fcla_eq_repl_fwd: ∀n. eq_repl_fwd … (λf. 𝐂❪f❫ ≘ n).
-#n @eq_repl_sym /2 width=3 by fcla_eq_repl_back/
-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 "ground/relocation/pstream_id.ma".
-include "ground/relocation/rtmap_isid.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-(* Basic properties *********************************************************)
-
-lemma id_isid: 𝐈❪𝐈𝐝❫.
-/3 width=5 by eq_push_isid/ qed.
-
-(* Alternative definition of isid *******************************************)
-
-lemma eq_id_isid: ∀f. 𝐈𝐝 ≡ f → 𝐈❪f❫.
-/2 width=3 by isid_eq_repl_back/ qed.
-
-lemma eq_id_inv_isid: ∀f. 𝐈❪f❫ → 𝐈𝐝 ≡ f.
-/2 width=1 by isid_inv_eq_repl/ 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 "ground/notation/relations/isdivergent_1.ma".
-include "ground/relocation/rtmap_nexts.ma".
-include "ground/relocation/rtmap_tls.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-coinductive isdiv: predicate rtmap ≝
-| isdiv_next: ∀f,g. isdiv f → ↑f = g → isdiv g
-.
-
-interpretation "test for divergence (rtmap)"
- 'IsDivergent f = (isdiv f).
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma isdiv_inv_gen: ∀g. 𝛀❪g❫ → ∃∃f. 𝛀❪f❫ & ↑f = g.
-#g * -g
-#f #g #Hf * /2 width=3 by ex2_intro/
-qed-.
-
-(* Advanced inversion lemmas ************************************************)
-
-lemma isdiv_inv_next: ∀g. 𝛀❪g❫ → ∀f. ↑f = g → 𝛀❪f❫.
-#g #H elim (isdiv_inv_gen … H) -H
-#f #Hf * -g #g #H >(injective_next … H) -H //
-qed-.
-
-lemma isdiv_inv_push: ∀g. 𝛀❪g❫ → ∀f. ⫯f = g → ⊥.
-#g #H elim (isdiv_inv_gen … H) -H
-#f #Hf * -g #g #H elim (discr_push_next … H)
-qed-.
-
-(* Main inversion lemmas ****************************************************)
-
-corec theorem isdiv_inv_eq_repl: ∀f1,f2. 𝛀❪f1❫ → 𝛀❪f2❫ → f1 ≡ f2.
-#f1 #f2 #H1 #H2
-cases (isdiv_inv_gen … H1) -H1
-cases (isdiv_inv_gen … H2) -H2
-/3 width=5 by eq_next/
-qed-.
-
-(* Basic properties *********************************************************)
-
-corec lemma isdiv_eq_repl_back: eq_repl_back … isdiv.
-#f1 #H cases (isdiv_inv_gen … H) -H
-#g1 #Hg1 #H1 #f2 #Hf cases (eq_inv_nx … Hf … H1) -f1
-/3 width=3 by isdiv_next/
-qed-.
-
-lemma isdiv_eq_repl_fwd: eq_repl_fwd … isdiv.
-/3 width=3 by isdiv_eq_repl_back, eq_repl_sym/ qed-.
-
-(* Alternative definition ***************************************************)
-
-corec lemma eq_next_isdiv: ∀f. ↑f ≡ f → 𝛀❪f❫.
-#f #H cases (eq_inv_nx … H) -H /4 width=3 by isdiv_next, eq_trans/
-qed.
-
-corec lemma eq_next_inv_isdiv: ∀f. 𝛀❪f❫ → ↑f ≡ f.
-#f * -f
-#f #g #Hf #Hg @(eq_next … Hg) [2: @eq_next_inv_isdiv // | skip ]
-@eq_f //
-qed-.
-
-(* Properties with iterated next ********************************************)
-
-lemma isdiv_nexts: ∀n,f. 𝛀❪f❫ → 𝛀❪↑*[n]f❫.
-#n @(nat_ind_succ … n) -n /3 width=3 by isdiv_next/
-qed.
-
-(* Inversion lemmas with iterated next **************************************)
-
-lemma isdiv_inv_nexts: ∀n,g. 𝛀❪↑*[n]g❫ → 𝛀❪g❫.
-#n @(nat_ind_succ … n) -n /3 width=3 by isdiv_inv_next/
-qed.
-
-(* Properties with tail *****************************************************)
-
-lemma isdiv_tl: ∀f. 𝛀❪f❫ → 𝛀❪⫱f❫.
-#f cases (pn_split f) * #g * -f #H
-[ elim (isdiv_inv_push … H) -H //
-| /2 width=3 by isdiv_inv_next/
-]
-qed.
-
-(* Properties with iterated tail ********************************************)
-
-lemma isdiv_tls: ∀n,g. 𝛀❪g❫ → 𝛀❪⫱*[n]g❫.
-#n @(nat_ind_succ … n) -n /3 width=1 by isdiv_tl/
-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 "ground/notation/relations/isfinite_1.ma".
-include "ground/relocation/rtmap_fcla.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-definition isfin: predicate rtmap ≝
- λf. ∃n. 𝐂❪f❫ ≘ n.
-
-interpretation "test for finite colength (rtmap)"
- 'IsFinite f = (isfin f).
-
-(* Basic eliminators ********************************************************)
-
-lemma isfin_ind (R:predicate rtmap): (∀f. 𝐈❪f❫ → R f) →
- (∀f. 𝐅❪f❫ → R f → R (⫯f)) →
- (∀f. 𝐅❪f❫ → R f → R (↑f)) →
- ∀f. 𝐅❪f❫ → R f.
-#R #IH1 #IH2 #IH3 #f #H elim H -H
-#n #H elim H -f -n /3 width=2 by ex_intro/
-qed-.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma isfin_inv_push: ∀g. 𝐅❪g❫ → ∀f. ⫯f = g → 𝐅❪f❫.
-#g * /3 width=4 by fcla_inv_px, ex_intro/
-qed-.
-
-lemma isfin_inv_next: ∀g. 𝐅❪g❫ → ∀f. ↑f = g → 𝐅❪f❫.
-#g * #n #H #f #H0 elim (fcla_inv_nx … H … H0) -g
-/2 width=2 by ex_intro/
-qed-.
-
-(* Basic properties *********************************************************)
-
-lemma isfin_eq_repl_back: eq_repl_back … isfin.
-#f1 * /3 width=4 by fcla_eq_repl_back, ex_intro/
-qed-.
-
-lemma isfin_eq_repl_fwd: eq_repl_fwd … isfin.
-/3 width=3 by isfin_eq_repl_back, eq_repl_sym/ qed-.
-
-lemma isfin_isid: ∀f. 𝐈❪f❫ → 𝐅❪f❫.
-/3 width=2 by fcla_isid, ex_intro/ qed.
-
-lemma isfin_push: ∀f. 𝐅❪f❫ → 𝐅❪⫯f❫.
-#f * /3 width=2 by fcla_push, ex_intro/
-qed.
-
-lemma isfin_next: ∀f. 𝐅❪f❫ → 𝐅❪↑f❫.
-#f * /3 width=2 by fcla_next, ex_intro/
-qed.
-
-(* Properties with iterated push ********************************************)
-
-lemma isfin_pushs: ∀n,f. 𝐅❪f❫ → 𝐅❪⫯*[n]f❫.
-#n @(nat_ind_succ … n) -n /3 width=3 by isfin_push/
-qed.
-
-(* Inversion lemmas with iterated push **************************************)
-
-lemma isfin_inv_pushs: ∀n,g. 𝐅❪⫯*[n]g❫ → 𝐅❪g❫.
-#n @(nat_ind_succ … n) -n /3 width=3 by isfin_inv_push/
-qed.
-
-(* Properties with tail *****************************************************)
-
-lemma isfin_tl: ∀f. 𝐅❪f❫ → 𝐅❪⫱f❫.
-#f elim (pn_split f) * #g #H #Hf destruct
-/3 width=3 by isfin_inv_push, isfin_inv_next/
-qed.
-
-(* Inversion lemmas with tail ***********************************************)
-
-lemma isfin_inv_tl: ∀f. 𝐅❪⫱f❫ → 𝐅❪f❫.
-#f elim (pn_split f) * /2 width=1 by isfin_next, isfin_push/
-qed-.
-
-(* Inversion lemmas with iterated tail **************************************)
-
-lemma isfin_inv_tls: ∀n,f. 𝐅❪⫱*[n]f❫ → 𝐅❪f❫.
-#n @(nat_ind_succ … n) -n /3 width=1 by isfin_inv_tl/
-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 "ground/notation/relations/isidentity_1.ma".
-include "ground/relocation/rtmap_tls.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-coinductive isid: predicate rtmap ≝
-| isid_push: ∀f,g. isid f → ⫯f = g → isid g
-.
-
-interpretation "test for identity (rtmap)"
- 'IsIdentity f = (isid f).
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma isid_inv_gen: ∀g. 𝐈❪g❫ → ∃∃f. 𝐈❪f❫ & ⫯f = g.
-#g * -g
-#f #g #Hf * /2 width=3 by ex2_intro/
-qed-.
-
-(* Advanced inversion lemmas ************************************************)
-
-lemma isid_inv_push: ∀g. 𝐈❪g❫ → ∀f. ⫯f = g → 𝐈❪f❫.
-#g #H elim (isid_inv_gen … H) -H
-#f #Hf * -g #g #H >(injective_push … H) -H //
-qed-.
-
-lemma isid_inv_next: ∀g. 𝐈❪g❫ → ∀f. ↑f = g → ⊥.
-#g #H elim (isid_inv_gen … H) -H
-#f #Hf * -g #g #H elim (discr_next_push … H)
-qed-.
-
-(* Main inversion lemmas ****************************************************)
-
-corec theorem isid_inv_eq_repl: ∀f1,f2. 𝐈❪f1❫ → 𝐈❪f2❫ → f1 ≡ f2.
-#f1 #f2 #H1 #H2
-cases (isid_inv_gen … H1) -H1
-cases (isid_inv_gen … H2) -H2
-/3 width=5 by eq_push/
-qed-.
-
-(* Basic properties *********************************************************)
-
-corec lemma isid_eq_repl_back: eq_repl_back … isid.
-#f1 #H cases (isid_inv_gen … H) -H
-#g1 #Hg1 #H1 #f2 #Hf cases (eq_inv_px … Hf … H1) -f1
-/3 width=3 by isid_push/
-qed-.
-
-lemma isid_eq_repl_fwd: eq_repl_fwd … isid.
-/3 width=3 by isid_eq_repl_back, eq_repl_sym/ qed-.
-
-(* Alternative definition ***************************************************)
-
-corec lemma eq_push_isid: ∀f. ⫯f ≡ f → 𝐈❪f❫.
-#f #H cases (eq_inv_px … H) -H /4 width=3 by isid_push, eq_trans/
-qed.
-
-corec lemma eq_push_inv_isid: ∀f. 𝐈❪f❫ → ⫯f ≡ f.
-#f * -f
-#f #g #Hf #Hg @(eq_push … Hg) [2: @eq_push_inv_isid // | skip ]
-@eq_f //
-qed-.
-
-(* Properties with iterated push ********************************************)
-
-lemma isid_pushs: ∀n,f. 𝐈❪f❫ → 𝐈❪⫯*[n]f❫.
-#n @(nat_ind_succ … n) -n /3 width=3 by isid_push/
-qed.
-
-(* Inversion lemmas with iterated push **************************************)
-
-lemma isid_inv_pushs: ∀n,g. 𝐈❪⫯*[n]g❫ → 𝐈❪g❫.
-#n @(nat_ind_succ … n) -n /3 width=3 by isid_inv_push/
-qed.
-
-(* Properties with tail *****************************************************)
-
-lemma isid_tl: ∀f. 𝐈❪f❫ → 𝐈❪⫱f❫.
-#f cases (pn_split f) * #g * -f #H
-[ /2 width=3 by isid_inv_push/
-| elim (isid_inv_next … H) -H //
-]
-qed.
-
-(* Properties with iterated tail ********************************************)
-
-lemma isid_tls: ∀n,g. 𝐈❪g❫ → 𝐈❪⫱*[n]g❫.
-#n @(nat_ind_succ … n) -n /3 width=1 by isid_tl/
-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 "ground/notation/relations/ist_1.ma".
-include "ground/relocation/rtmap_at.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-definition istot: predicate rtmap ≝ λf. ∀i. ∃j. @❪i,f❫ ≘ j.
-
-interpretation "test for totality (rtmap)"
- 'IsT f = (istot f).
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma istot_inv_push: ∀g. 𝐓❪g❫ → ∀f. ⫯f = g → 𝐓❪f❫.
-#g #Hg #f #H #i elim (Hg (↑i)) -Hg
-#j #Hg elim (at_inv_npx … Hg … H) -Hg -H /2 width=3 by ex_intro/
-qed-.
-
-lemma istot_inv_next: ∀g. 𝐓❪g❫ → ∀f. ↑f = g → 𝐓❪f❫.
-#g #Hg #f #H #i elim (Hg i) -Hg
-#j #Hg elim (at_inv_xnx … Hg … H) -Hg -H /2 width=2 by ex_intro/
-qed-.
-
-(* Properties on tl *********************************************************)
-
-lemma istot_tl: ∀f. 𝐓❪f❫ → 𝐓❪⫱f❫.
-#f cases (pn_split f) *
-#g * -f /2 width=3 by istot_inv_next, istot_inv_push/
-qed.
-
-(* Properties on tls ********************************************************)
-
-lemma istot_tls: ∀n,f. 𝐓❪f❫ → 𝐓❪⫱*[n]f❫.
-#n @(nat_ind_succ … n) -n //
-#n #IH #f #Hf <tls_S
-/3 width=1 by istot_tl/
-qed.
-
-(* Main forward lemmas on at ************************************************)
-
-corec theorem at_ext: ∀f1,f2. 𝐓❪f1❫ → 𝐓❪f2❫ →
- (∀i,i1,i2. @❪i,f1❫ ≘ i1 → @❪i,f2❫ ≘ i2 → i1 = i2) →
- f1 ≡ f2.
-#f1 cases (pn_split f1) * #g1 #H1
-#f2 cases (pn_split f2) * #g2 #H2
-#Hf1 #Hf2 #Hi
-[ @(eq_push … H1 H2) @at_ext -at_ext /2 width=3 by istot_inv_push/ -Hf1 -Hf2
- #i #i1 #i2 #Hg1 #Hg2 lapply (Hi (↑i) (↑i1) (↑i2) ??) /2 width=7 by at_push/
-| cases (Hf2 (𝟏)) -Hf1 -Hf2 -at_ext
- #j2 #Hf2 cases (at_increasing_strict … Hf2 … H2) -H2
- lapply (Hi (𝟏) (𝟏) j2 … Hf2) /2 width=2 by at_refl/ -Hi -Hf2 -H1
- #H2 #H cases (plt_ge_false … H) -H //
-| cases (Hf1 (𝟏)) -Hf1 -Hf2 -at_ext
- #j1 #Hf1 cases (at_increasing_strict … Hf1 … H1) -H1
- lapply (Hi (𝟏) j1 (𝟏) Hf1 ?) /2 width=2 by at_refl/ -Hi -Hf1 -H2
- #H1 #H cases (plt_ge_false … H) -H //
-| @(eq_next … H1 H2) @at_ext -at_ext /2 width=3 by istot_inv_next/ -Hf1 -Hf2
- #i #i1 #i2 #Hg1 #Hg2 lapply (Hi i (↑i1) (↑i2) ??) /2 width=5 by at_next/
-]
-qed-.
-
-(* Advanced properties on at ************************************************)
-
-lemma at_dec: ∀f,i1,i2. 𝐓❪f❫ → Decidable (@❪i1,f❫ ≘ i2).
-#f #i1 #i2 #Hf lapply (Hf i1) -Hf *
-#j2 #Hf elim (eq_pnat_dec i2 j2)
-[ #H destruct /2 width=1 by or_introl/
-| /4 width=6 by at_mono, or_intror/
-]
-qed-.
-
-lemma is_at_dec: ∀f,i2. 𝐓❪f❫ → Decidable (∃i1. @❪i1,f❫ ≘ i2).
-#f #i2 #Hf
-lapply (dec_plt (λi1.@❪i1,f❫ ≘ i2) … (↑i2)) [| * ]
-[ /2 width=1 by at_dec/
-| * /3 width=2 by ex_intro, or_introl/
-| #H @or_intror * #i1 #Hi12
- /5 width=3 by at_increasing, plt_succ_dx, ex2_intro/
-]
-qed-.
-
-(* Advanced properties on isid **********************************************)
-
-lemma isid_at_total: ∀f. 𝐓❪f❫ → (∀i1,i2. @❪i1,f❫ ≘ i2 → i1 = i2) → 𝐈❪f❫.
-#f #H1f #H2f @isid_at
-#i lapply (H1f i) -H1f *
-#j #Hf >(H2f … Hf) in ⊢ (???%); -H2f //
-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 "ground/notation/relations/isuniform_1.ma".
-include "ground/relocation/rtmap_isfin.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-inductive isuni: predicate rtmap ≝
-| isuni_isid: ∀f. 𝐈❪f❫ → isuni f
-| isuni_next: ∀f. isuni f → ∀g. ↑f = g → isuni g
-.
-
-interpretation "test for uniformity (rtmap)"
- 'IsUniform f = (isuni f).
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma isuni_inv_push: ∀g. 𝐔❪g❫ → ∀f. ⫯f = g → 𝐈❪f❫.
-#g * -g /2 width=3 by isid_inv_push/
-#f #_ #g #H #x #Hx destruct elim (discr_push_next … Hx)
-qed-.
-
-lemma isuni_inv_next: ∀g. 𝐔❪g❫ → ∀f. ↑f = g → 𝐔❪f❫.
-#g * -g #f #Hf
-[ #x #Hx elim (isid_inv_next … Hf … Hx)
-| #g #H #x #Hx destruct /2 width=1 by injective_push/
-]
-qed-.
-
-lemma isuni_split: ∀g. 𝐔❪g❫ → (∃∃f. 𝐈❪f❫ & ⫯f = g) ∨ (∃∃f.𝐔❪f❫ & ↑f = g).
-#g #H elim (pn_split g) * #f #Hf
-/4 width=3 by isuni_inv_next, isuni_inv_push, or_introl, or_intror, ex2_intro/
-qed-.
-
-(* basic forward lemmas *****************************************************)
-
-lemma isuni_fwd_push: ∀g. 𝐔❪g❫ → ∀f. ⫯f = g → 𝐔❪f❫.
-/3 width=3 by isuni_inv_push, isuni_isid/ qed-.
-
-(* Forward lemmas with test for finite colength *****************************)
-
-lemma isuni_fwd_isfin: ∀f. 𝐔❪f❫ → 𝐅❪f❫.
-#f #H elim H -f /3 width=1 by isfin_next, isfin_isid/
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.tcs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "ground/notation/relations/ratsucc_3.ma".
-include "ground/arith/nat_lt_pred.ma".
-include "ground/relocation/rtmap_at.ma".
-
-(* NON-NEGATIVE APPLICATION FOR RELOCATION MAPS *****************************)
-
-definition rm_nat: relation3 rtmap nat nat ≝
- λf,l1,l2. @❪↑l1,f❫ ≘ ↑l2.
-
-interpretation
- "relational non-negative application (relocation maps)"
- 'RAtSucc l1 f l2 = (rm_nat f l1 l2).
-
-(* Basic properties *********************************************************)
-
-lemma rm_nat_refl (f) (g) (k1) (k2):
- (⫯f) = g → 𝟎 = k1 → 𝟎 = k2 → @↑❪k1,g❫ ≘ k2.
-#f #g #k1 #k2 #H1 #H2 #H3 destruct
-/2 width=2 by at_refl/
-qed.
-
-lemma rm_nat_push (f) (l1) (l2) (g) (k1) (k2):
- @↑❪l1,f❫ ≘ l2 → ⫯f = g → ↑l1 = k1 → ↑l2 = k2 → @↑❪k1,g❫ ≘ k2.
-#f #l1 #l2 #g #k1 #k2 #Hf #H1 #H2 #H3 destruct
-/2 width=7 by at_push/
-qed.
-
-lemma rm_nat_next (f) (l1) (l2) (g) (k2):
- @↑❪l1,f❫ ≘ l2 → ↑f = g → ↑l2 = k2 → @↑❪l1,g❫ ≘ k2.
-#f #l1 #l2 #g #k2 #Hf #H1 #H2 destruct
-/2 width=5 by at_next/
-qed.
-
-lemma rm_nat_pred_bi (f) (i1) (i2):
- @❪i1,f❫ ≘ i2 → @↑❪↓i1,f❫ ≘ ↓i2.
-#f #i1 #i2
->(npsucc_pred i1) in ⊢ (%→?); >(npsucc_pred i2) in ⊢ (%→?);
-//
-qed.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma rm_nat_inv_ppx (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀g. 𝟎 = l1 → ⫯g = f → 𝟎 = l2.
-#f #l1 #l2 #H #g #H1 #H2 destruct
-lapply (at_inv_ppx … H ???) -H
-/2 width=2 by eq_inv_npsucc_bi/
-qed-.
-
-lemma rm_nat_inv_npx (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀g,k1. ↑k1 = l1 → ⫯g = f →
- ∃∃k2. @↑❪k1,g❫ ≘ k2 & ↑k2 = l2.
-#f #l1 #l2 #H #g #k1 #H1 #H2 destruct
-elim (at_inv_npx … H) -H [|*: // ] #k2 #Hg
->(npsucc_pred (↑l2)) #H
-@(ex2_intro … (↓k2)) //
-<pnpred_psucc //
-qed-.
-
-lemma rm_nat_inv_xnx (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀g. ↑g = f →
- ∃∃k2. @↑❪l1,g❫ ≘ k2 & ↑k2 = l2.
-#f #l1 #l2 #H #g #H1 destruct
-elim (at_inv_xnx … H) -H [|*: // ] #k2
->(npsucc_pred (k2)) in ⊢ (%→?→?); #Hg #H
-@(ex2_intro … (↓k2)) //
-<pnpred_psucc //
-qed-.
-
-(* Advanced inversion lemmas ************************************************)
-
-lemma rm_nat_inv_ppn (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀g,k2. 𝟎 = l1 → ⫯g = f → ↑k2 = l2 → ⊥.
-#f #l1 #l2 #Hf #g #k2 #H1 #H <(rm_nat_inv_ppx … Hf … H1 H) -f -g -l1 -l2
-/2 width=3 by eq_inv_nsucc_zero/
-qed-.
-
-lemma rm_nat_inv_npp (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀g,k1. ↑k1 = l1 → ⫯g = f → 𝟎 = l2 → ⊥.
-#f #l1 #l2 #Hf #g #k1 #H1 #H elim (rm_nat_inv_npx … Hf … H1 H) -f -l1
-#x2 #Hg * -l2 /2 width=3 by eq_inv_zero_nsucc/
-qed-.
-
-lemma rm_nat_inv_npn (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀g,k1,k2. ↑k1 = l1 → ⫯g = f → ↑k2 = l2 → @↑❪k1,g❫ ≘ k2.
-#f #l1 #l2 #Hf #g #k1 #k2 #H1 #H elim (rm_nat_inv_npx … Hf … H1 H) -f -l1
-#x2 #Hg * -l2 #H >(eq_inv_nsucc_bi … H) -k2 //
-qed-.
-
-lemma rm_nat_inv_xnp (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀g. ↑g = f → 𝟎 = l2 → ⊥.
-#f #l1 #l2 #Hf #g #H elim (rm_nat_inv_xnx … Hf … H) -f
-#x2 #Hg * -l2 /2 width=3 by eq_inv_zero_nsucc/
-qed-.
-
-lemma rm_nat_inv_xnn (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀g,k2. ↑g = f → ↑k2 = l2 → @↑❪l1,g❫ ≘ k2.
-#f #l1 #l2 #Hf #g #k2 #H elim (rm_nat_inv_xnx … Hf … H) -f
-#x2 #Hg * -l2 #H >(eq_inv_nsucc_bi … H) -k2 //
-qed-.
-
-lemma rm_nat_inv_pxp (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → 𝟎 = l1 → 𝟎 = l2 → ∃g. ⫯g = f.
-#f elim (pn_split … f) * /2 width=2 by ex_intro/
-#g #H #l1 #l2 #Hf #H1 #H2 cases (rm_nat_inv_xnp … Hf … H H2)
-qed-.
-
-lemma rm_nat_inv_pxn (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀k2. 𝟎 = l1 → ↑k2 = l2 →
- ∃∃g. @↑❪l1,g❫ ≘ k2 & ↑g = f.
-#f elim (pn_split … f) *
-#g #H #l1 #l2 #Hf #k2 #H1 #H2
-[ elim (rm_nat_inv_ppn … Hf … H1 H H2)
-| /3 width=5 by rm_nat_inv_xnn, ex2_intro/
-]
-qed-.
-
-lemma rm_nat_inv_nxp (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀k1. ↑k1 = l1 → 𝟎 = l2 → ⊥.
-#f elim (pn_split f) *
-#g #H #l1 #l2 #Hf #k1 #H1 #H2
-[ elim (rm_nat_inv_npp … Hf … H1 H H2)
-| elim (rm_nat_inv_xnp … Hf … H H2)
-]
-qed-.
-
-lemma rm_nat_inv_nxn (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀k1,k2. ↑k1 = l1 → ↑k2 = l2 →
- ∨∨ ∃∃g. @↑❪k1,g❫ ≘ k2 & ⫯g = f
- | ∃∃g. @↑❪l1,g❫ ≘ k2 & ↑g = f.
-#f elim (pn_split f) *
-/4 width=7 by rm_nat_inv_xnn, rm_nat_inv_npn, ex2_intro, or_intror, or_introl/
-qed-.
-
-(* Note: the following inversion lemmas must be checked *)
-lemma rm_nat_inv_xpx (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀g. ⫯g = f →
- ∨∨ ∧∧ 𝟎 = l1 & 𝟎 = l2
- | ∃∃k1,k2. @↑❪k1,g❫ ≘ k2 & ↑k1 = l1 & ↑k2 = l2.
-#f * [2: #l1 ] #l2 #Hf #g #H
-[ elim (rm_nat_inv_npx … Hf … H) -f /3 width=5 by or_intror, ex3_2_intro/
-| >(rm_nat_inv_ppx … Hf … H) -f /3 width=1 by conj, or_introl/
-]
-qed-.
-
-lemma rm_nat_inv_xpp (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀g. ⫯g = f → 𝟎 = l2 → 𝟎 = l1.
-#f #l1 #l2 #Hf #g #H elim (rm_nat_inv_xpx … Hf … H) -f * //
-#k1 #k2 #_ #_ * -l2 #H elim (eq_inv_zero_nsucc … H)
-qed-.
-
-lemma rm_nat_inv_xpn (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → ∀g,k2. ⫯g = f → ↑k2 = l2 →
- ∃∃k1. @↑❪k1,g❫ ≘ k2 & ↑k1 = l1.
-#f #l1 #l2 #Hf #g #k2 #H elim (rm_nat_inv_xpx … Hf … H) -f *
-[ #_ * -l2 #H elim (eq_inv_nsucc_zero … H)
-| #x1 #x2 #Hg #H1 * -l2 #H
- lapply (eq_inv_nsucc_bi … H) -H #H destruct
- /2 width=3 by ex2_intro/
-]
-qed-.
-
-lemma rm_nat_inv_xxp (f) (l1) (l2):
- @↑❪l1,f❫ ≘ l2 → 𝟎 = l2 → ∃∃g. 𝟎 = l1 & ⫯g = f.
-#f elim (pn_split f) *
-#g #H #l1 #l2 #Hf #H2
-[ /3 width=6 by rm_nat_inv_xpp, ex2_intro/
-| elim (rm_nat_inv_xnp … Hf … H H2)
-]
-qed-.
-
-lemma rm_nat_inv_xxn (f) (l1) (l2): @↑❪l1,f❫ ≘ l2 → ∀k2. ↑k2 = l2 →
- ∨∨ ∃∃g,k1. @↑❪k1,g❫ ≘ k2 & ↑k1 = l1 & ⫯g = f
- | ∃∃g. @↑❪l1,g❫ ≘ k2 & ↑g = f.
-#f elim (pn_split f) *
-#g #H #l1 #l2 #Hf #k2 #H2
-[ elim (rm_nat_inv_xpn … Hf … H H2) -l2 /3 width=5 by or_introl, ex3_2_intro/
-| lapply (rm_nat_inv_xnn … Hf … H H2) -l2 /3 width=3 by or_intror, ex2_intro/
-]
-qed-.
-
-(* Main destructions ********************************************************)
-
-theorem rm_nat_monotonic (k2) (l2) (f):
- @↑❪l2,f❫ ≘ k2 → ∀k1,l1. @↑❪l1,f❫ ≘ k1 → l1 < l2 → k1 < k2.
-#k2 @(nat_ind_succ … k2) -k2
-[ #l2 #f #H2f elim (rm_nat_inv_xxp … H2f) -H2f //
- #g #H21 #_ #k1 #l1 #_ #Hi destruct
- elim (nlt_inv_zero_dx … Hi)
-| #k2 #IH #l2 #f #H2f #k1 @(nat_ind_succ … k1) -k1 //
- #k1 #_ #l1 #H1f #Hl elim (nlt_inv_gen … Hl)
- #_ #Hl2 elim (rm_nat_inv_nxn … H2f (↓l2)) -H2f [1,3: * |*: // ]
- #g #H2g #H
- [ elim (rm_nat_inv_xpn … H1f … H) -f
- /4 width=8 by nlt_inv_succ_bi, nlt_succ_bi/
- | /4 width=8 by rm_nat_inv_xnn, nlt_succ_bi/
- ]
-]
-qed-.
-
-theorem rm_nat_inv_monotonic (k1) (l1) (f):
- @↑❪l1,f❫ ≘ k1 → ∀k2,l2. @↑❪l2,f❫ ≘ k2 → k1 < k2 → l1 < l2.
-#k1 @(nat_ind_succ … k1) -k1
-[ #l1 #f #H1f elim (rm_nat_inv_xxp … H1f) -H1f //
- #g * -l1 #H #k2 #l2 #H2f #Hk
- lapply (nlt_des_gen … Hk) -Hk #H22
- elim (rm_nat_inv_xpn … H2f … (↓k2) H) -f //
-| #k1 #IH #l1 @(nat_ind_succ … l1) -l1
- [ #f #H1f elim (rm_nat_inv_pxn … H1f) -H1f [ |*: // ]
- #g #H1g #H #k2 #l2 #H2f #Hj elim (nlt_inv_succ_sn … Hj) -Hj
- /3 width=7 by rm_nat_inv_xnn/
- | #l1 #_ #f #H1f #k2 #l2 #H2f #Hj elim (nlt_inv_succ_sn … Hj) -Hj
- #Hj #H22 elim (rm_nat_inv_nxn … H1f) -H1f [1,4: * |*: // ]
- #g #Hg #H
- [ elim (rm_nat_inv_xpn … H2f … (↓k2) H) -f
- /3 width=7 by nlt_succ_bi/
- | /3 width=7 by rm_nat_inv_xnn/
- ]
- ]
-]
-qed-.
-
-theorem rm_nat_mono (f) (l) (l1) (l2):
- @↑❪l,f❫ ≘ l1 → @↑❪l,f❫ ≘ l2 → l2 = l1.
-#f #l #l1 #l2 #H1 #H2 elim (nat_split_lt_eq_gt l2 l1) //
-#Hi elim (nlt_ge_false l l) /3 width=6 by rm_nat_inv_monotonic, eq_sym/
-qed-.
-
-theorem rm_nat_inj (f) (l1) (l2) (l):
- @↑❪l1,f❫ ≘ l → @↑❪l2,f❫ ≘ l → l1 = l2.
-#f #l1 #l2 #l #H1 #H2 elim (nat_split_lt_eq_gt l2 l1) //
-#Hi elim (nlt_ge_false l l) /2 width=6 by rm_nat_monotonic/
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.tcs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "ground/arith/nat_plus.ma".
-include "ground/relocation/rtmap_uni.ma".
-include "ground/relocation/rtmap_nat.ma".
-
-(* NON-NEGATIVE APPLICATION FOR RELOCATION MAPS *****************************)
-
-(* Properties with uniform relocations **************************************)
-
-lemma rm_nat_uni (n) (l): @↑❪l,𝐔❨n❩❫ ≘ l+n.
-#n @(nat_ind_succ … n) -n /2 width=5 by rm_nat_next/
-qed.
-
-(* Inversion lemmas with uniform relocations ********************************)
-
-lemma rm_nat_inv_uni (n) (l) (k): @↑❪l,𝐔❨n❩❫ ≘ k → k = l+n.
-/2 width=4 by rm_nat_mono/ 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 "ground/notation/functions/uparrowstar_2.ma".
-include "ground/arith/nat_succ_iter.ma".
-include "ground/relocation/rtmap_eq.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-definition nexts (f:rtmap) (n:nat) ≝ next^n f.
-
-interpretation "nexts (rtmap)" 'UpArrowStar n f = (nexts f n).
-
-(* Basic properties *********************************************************)
-
-lemma nexts_O: ∀f. f = ↑*[𝟎] f.
-// qed.
-
-lemma nexts_S: ∀f,n. ↑↑*[n] f = ↑*[↑n] f.
-#f #n @(niter_succ … next)
-qed.
-
-lemma nexts_eq_repl: ∀n. eq_repl (λf1,f2. ↑*[n] f1 ≡ ↑*[n] f2).
-#n @(nat_ind_succ … n) -n /3 width=5 by eq_next/
-qed.
-
-(* Advanced properties ******************************************************)
-
-lemma nexts_swap: ∀f,n. ↑↑*[n] f = ↑*[n] ↑f.
-#f #n @(niter_appl … next)
-qed.
-
-lemma nexts_xn: ∀n,f. ↑*[n] ↑f = ↑*[↑n] f.
-// qed.
-
-(* Basic_inversion lemmas *****************************************************)
-
-lemma eq_inv_nexts_sn: ∀n,f1,g2. ↑*[n] f1 ≡ g2 →
- ∃∃f2. f1 ≡ f2 & ↑*[n] f2 = g2.
-#n @(nat_ind_succ … n) -n /2 width=3 by ex2_intro/
-#n #IH #f1 #g2 #H elim (eq_inv_nx … H) -H [|*: // ]
-#f0 #Hf10 #H1 elim (IH … Hf10) -IH -Hf10 #f2 #Hf12 #H2 destruct
-/2 width=3 by ex2_intro/
-qed-.
-
-lemma eq_inv_nexts_dx: ∀n,f2,g1. g1 ≡ ↑*[n] f2 →
- ∃∃f1. f1 ≡ f2 & ↑*[n] f1 = g1.
-#n @(nat_ind_succ … n) -n /2 width=3 by ex2_intro/
-#n #IH #f2 #g1 #H elim (eq_inv_xn … H) -H [|*: // ]
-#f0 #Hf02 #H1 elim (IH … Hf02) -IH -Hf02 #f1 #Hf12 #H2 destruct
-/2 width=3 by ex2_intro/
-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 "ground/notation/functions/upspoonstar_2.ma".
-include "ground/arith/nat_succ_iter.ma".
-include "ground/relocation/rtmap_eq.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-definition pushs (f:rtmap) (n:nat) ≝ push^n f.
-
-interpretation "pushs (rtmap)" 'UpSpoonStar n f = (pushs f n).
-
-(* Basic properties *********************************************************)
-
-lemma pushs_O: ∀f. f = ⫯*[𝟎] f.
-// qed.
-
-lemma pushs_S: ∀f,n. ⫯⫯*[n] f = ⫯*[↑n] f.
-#f #n @(niter_succ … push)
-qed.
-
-lemma pushs_eq_repl: ∀n. eq_repl (λf1,f2. ⫯*[n] f1 ≡ ⫯*[n] f2).
-#n @(nat_ind_succ … n) -n /3 width=5 by eq_push/
-qed.
-
-(* Advanced properties ******************************************************)
-
-lemma push_swap (n) (f): ⫯⫯*[n] f = ⫯*[n] ⫯f.
-#n #f @(niter_appl … push)
-qed.
-
-lemma pushs_xn: ∀n,f. ⫯*[n] ⫯f = ⫯*[↑n] f.
-// qed.
-
-(* Basic_inversion lemmas *****************************************************)
-
-lemma eq_inv_pushs_sn: ∀n,f1,g2. ⫯*[n] f1 ≡ g2 →
- ∃∃f2. f1 ≡ f2 & ⫯*[n] f2 = g2.
-#n @(nat_ind_succ … n) -n /2 width=3 by ex2_intro/
-#n #IH #f1 #g2 #H elim (eq_inv_px … H) -H [|*: // ]
-#f0 #Hf10 #H1 elim (IH … Hf10) -IH -Hf10 #f2 #Hf12 #H2 destruct
-/2 width=3 by ex2_intro/
-qed-.
-
-lemma eq_inv_pushs_dx: ∀n,f2,g1. g1 ≡ ⫯*[n] f2 →
- ∃∃f1. f1 ≡ f2 & ⫯*[n] f1 = g1.
-#n @(nat_ind_succ … n) -n /2 width=3 by ex2_intro/
-#n #IH #f2 #g1 #H elim (eq_inv_xp … H) -H [|*: // ]
-#f0 #Hf02 #H1 elim (IH … Hf02) -IH -Hf02 #f1 #Hf12 #H2 destruct
-/2 width=3 by ex2_intro/
-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 "ground/notation/relations/rintersection_3.ma".
-include "ground/relocation/rtmap_sle.ma".
-
-coinductive sand: relation3 rtmap rtmap rtmap ≝
-| sand_pp: ∀f1,f2,f,g1,g2,g. sand f1 f2 f → ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → sand g1 g2 g
-| sand_np: ∀f1,f2,f,g1,g2,g. sand f1 f2 f → ↑f1 = g1 → ⫯f2 = g2 → ⫯f = g → sand g1 g2 g
-| sand_pn: ∀f1,f2,f,g1,g2,g. sand f1 f2 f → ⫯f1 = g1 → ↑f2 = g2 → ⫯f = g → sand g1 g2 g
-| sand_nn: ∀f1,f2,f,g1,g2,g. sand f1 f2 f → ↑f1 = g1 → ↑f2 = g2 → ↑f = g → sand g1 g2 g
-.
-
-interpretation "intersection (rtmap)"
- 'RIntersection f1 f2 f = (sand f1 f2 f).
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma sand_inv_ppx: ∀g1,g2,g. g1 ⋒ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 →
- ∃∃f. f1 ⋒ f2 ≘ f & ⫯f = g.
-#g1 #g2 #g * -g1 -g2 -g
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
-try (>(injective_push … Hx1) -x1) try (>(injective_next … Hx1) -x1)
-try elim (discr_push_next … Hx1) try elim (discr_next_push … Hx1)
-try (>(injective_push … Hx2) -x2) try (>(injective_next … Hx2) -x2)
-try elim (discr_push_next … Hx2) try elim (discr_next_push … Hx2)
-/2 width=3 by ex2_intro/
-qed-.
-
-lemma sand_inv_npx: ∀g1,g2,g. g1 ⋒ g2 ≘ g → ∀f1,f2. ↑f1 = g1 → ⫯f2 = g2 →
- ∃∃f. f1 ⋒ f2 ≘ f & ⫯f = g.
-#g1 #g2 #g * -g1 -g2 -g
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
-try (>(injective_push … Hx1) -x1) try (>(injective_next … Hx1) -x1)
-try elim (discr_push_next … Hx1) try elim (discr_next_push … Hx1)
-try (>(injective_push … Hx2) -x2) try (>(injective_next … Hx2) -x2)
-try elim (discr_push_next … Hx2) try elim (discr_next_push … Hx2)
-/2 width=3 by ex2_intro/
-qed-.
-
-lemma sand_inv_pnx: ∀g1,g2,g. g1 ⋒ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 →
- ∃∃f. f1 ⋒ f2 ≘ f & ⫯f = g.
-#g1 #g2 #g * -g1 -g2 -g
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
-try (>(injective_push … Hx1) -x1) try (>(injective_next … Hx1) -x1)
-try elim (discr_push_next … Hx1) try elim (discr_next_push … Hx1)
-try (>(injective_push … Hx2) -x2) try (>(injective_next … Hx2) -x2)
-try elim (discr_push_next … Hx2) try elim (discr_next_push … Hx2)
-/2 width=3 by ex2_intro/
-qed-.
-
-lemma sand_inv_nnx: ∀g1,g2,g. g1 ⋒ g2 ≘ g → ∀f1,f2. ↑f1 = g1 → ↑f2 = g2 →
- ∃∃f. f1 ⋒ f2 ≘ f & ↑f = g.
-#g1 #g2 #g * -g1 -g2 -g
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
-try (>(injective_push … Hx1) -x1) try (>(injective_next … Hx1) -x1)
-try elim (discr_push_next … Hx1) try elim (discr_next_push … Hx1)
-try (>(injective_push … Hx2) -x2) try (>(injective_next … Hx2) -x2)
-try elim (discr_push_next … Hx2) try elim (discr_next_push … Hx2)
-/2 width=3 by ex2_intro/
-qed-.
-
-(* Basic properties *********************************************************)
-
-corec lemma sand_eq_repl_back1: ∀f2,f. eq_repl_back … (λf1. f1 ⋒ f2 ≘ f).
-#f2 #f #f1 * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x #Hx
-try cases (eq_inv_px … Hx … H1) try cases (eq_inv_nx … Hx … H1) -g1
-/3 width=7 by sand_pp, sand_np, sand_pn, sand_nn/
-qed-.
-
-lemma sand_eq_repl_fwd1: ∀f2,f. eq_repl_fwd … (λf1. f1 ⋒ f2 ≘ f).
-#f2 #f @eq_repl_sym /2 width=3 by sand_eq_repl_back1/
-qed-.
-
-corec lemma sand_eq_repl_back2: ∀f1,f. eq_repl_back … (λf2. f1 ⋒ f2 ≘ f).
-#f1 #f #f2 * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf #H #H2 #H0 #x #Hx
-try cases (eq_inv_px … Hx … H2) try cases (eq_inv_nx … Hx … H2) -g2
-/3 width=7 by sand_pp, sand_np, sand_pn, sand_nn/
-qed-.
-
-lemma sand_eq_repl_fwd2: ∀f1,f. eq_repl_fwd … (λf2. f1 ⋒ f2 ≘ f).
-#f1 #f @eq_repl_sym /2 width=3 by sand_eq_repl_back2/
-qed-.
-
-corec lemma sand_eq_repl_back3: ∀f1,f2. eq_repl_back … (λf. f1 ⋒ f2 ≘ f).
-#f1 #f2 #f * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf #H #H2 #H0 #x #Hx
-try cases (eq_inv_px … Hx … H0) try cases (eq_inv_nx … Hx … H0) -g
-/3 width=7 by sand_pp, sand_np, sand_pn, sand_nn/
-qed-.
-
-lemma sand_eq_repl_fwd3: ∀f1,f2. eq_repl_fwd … (λf. f1 ⋒ f2 ≘ f).
-#f1 #f2 @eq_repl_sym /2 width=3 by sand_eq_repl_back3/
-qed-.
-
-corec lemma sand_refl: ∀f. f ⋒ f ≘ f.
-#f cases (pn_split f) * #g #H
-[ @(sand_pp … H H H) | @(sand_nn … H H H) ] -H //
-qed.
-
-corec lemma sand_sym: ∀f1,f2,f. f1 ⋒ f2 ≘ f → f2 ⋒ f1 ≘ f.
-#f1 #f2 #f * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf * * * -g1 -g2 -g
-[ @sand_pp | @sand_pn | @sand_np | @sand_nn ] /2 width=7 by/
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.tcs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "ground/notation/relations/parallel_2.ma".
-include "ground/relocation/rtmap_isid.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-coinductive sdj: relation rtmap ≝
-| sdj_pp: ∀f1,f2,g1,g2. sdj f1 f2 → ⫯f1 = g1 → ⫯f2 = g2 → sdj g1 g2
-| sdj_np: ∀f1,f2,g1,g2. sdj f1 f2 → ↑f1 = g1 → ⫯f2 = g2 → sdj g1 g2
-| sdj_pn: ∀f1,f2,g1,g2. sdj f1 f2 → ⫯f1 = g1 → ↑f2 = g2 → sdj g1 g2
-.
-
-interpretation "disjointness (rtmap)"
- 'Parallel f1 f2 = (sdj f1 f2).
-
-(* Basic properties *********************************************************)
-
-axiom sdj_eq_repl_back1: ∀f2. eq_repl_back … (λf1. f1 ∥ f2).
-
-lemma sdj_eq_repl_fwd1: ∀f2. eq_repl_fwd … (λf1. f1 ∥ f2).
-#f2 @eq_repl_sym /2 width=3 by sdj_eq_repl_back1/
-qed-.
-
-axiom sdj_eq_repl_back2: ∀f1. eq_repl_back … (λf2. f1 ∥ f2).
-
-lemma sdj_eq_repl_fwd2: ∀f1. eq_repl_fwd … (λf2. f1 ∥ f2).
-#f1 @eq_repl_sym /2 width=3 by sdj_eq_repl_back2/
-qed-.
-
-corec lemma sdj_sym: symmetric … sdj.
-#f1 #f2 * -f1 -f2
-#f1 #f2 #g1 #g2 #Hf #H1 #H2
-[ @(sdj_pp … H2 H1) | @(sdj_pn … H2 H1) | @(sdj_np … H2 H1) ] -g2 -g1
-/2 width=1 by/
-qed-.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma sdj_inv_pp: ∀g1,g2. g1 ∥ g2 → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 → f1 ∥ f2.
-#g1 #g2 * -g1 -g2
-#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #x2 #Hx1 #Hx2 destruct
-[ lapply (injective_push … Hx1) -Hx1
- lapply (injective_push … Hx2) -Hx2 //
-| elim (discr_push_next … Hx1)
-| elim (discr_push_next … Hx2)
-]
-qed-.
-
-lemma sdj_inv_np: ∀g1,g2. g1 ∥ g2 → ∀f1,f2. ↑f1 = g1 → ⫯f2 = g2 → f1 ∥ f2.
-#g1 #g2 * -g1 -g2
-#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #x2 #Hx1 #Hx2 destruct
-[ elim (discr_next_push … Hx1)
-| lapply (injective_next … Hx1) -Hx1
- lapply (injective_push … Hx2) -Hx2 //
-| elim (discr_push_next … Hx2)
-]
-qed-.
-
-lemma sdj_inv_pn: ∀g1,g2. g1 ∥ g2 → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 → f1 ∥ f2.
-#g1 #g2 * -g1 -g2
-#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #x2 #Hx1 #Hx2 destruct
-[ elim (discr_next_push … Hx2)
-| elim (discr_push_next … Hx1)
-| lapply (injective_push … Hx1) -Hx1
- lapply (injective_next … Hx2) -Hx2 //
-]
-qed-.
-
-lemma sdj_inv_nn: ∀g1,g2. g1 ∥ g2 → ∀f1,f2. ↑f1 = g1 → ↑f2 = g2 → ⊥.
-#g1 #g2 * -g1 -g2
-#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #x2 #Hx1 #Hx2 destruct
-[ elim (discr_next_push … Hx1)
-| elim (discr_next_push … Hx2)
-| elim (discr_next_push … Hx1)
-]
-qed-.
-
-(* Advanced inversion lemmas ************************************************)
-
-lemma sdj_inv_nx: ∀g1,g2. g1 ∥ g2 → ∀f1. ↑f1 = g1 →
- ∃∃f2. f1 ∥ f2 & ⫯f2 = g2.
-#g1 #g2 elim (pn_split g2) * #f2 #H2 #H #f1 #H1
-[ lapply (sdj_inv_np … H … H1 H2) -H /2 width=3 by ex2_intro/
-| elim (sdj_inv_nn … H … H1 H2)
-]
-qed-.
-
-lemma sdj_inv_xn: ∀g1,g2. g1 ∥ g2 → ∀f2. ↑f2 = g2 →
- ∃∃f1. f1 ∥ f2 & ⫯f1 = g1.
-#g1 #g2 elim (pn_split g1) * #f1 #H1 #H #f2 #H2
-[ lapply (sdj_inv_pn … H … H1 H2) -H /2 width=3 by ex2_intro/
-| elim (sdj_inv_nn … H … H1 H2)
-]
-qed-.
-
-lemma sdj_inv_xp: ∀g1,g2. g1 ∥ g2 → ∀f2. ⫯f2 = g2 →
- ∨∨ ∃∃f1. f1 ∥ f2 & ⫯f1 = g1
- | ∃∃f1. f1 ∥ f2 & ↑f1 = g1.
-#g1 #g2 elim (pn_split g1) * #f1 #H1 #H #f2 #H2
-[ lapply (sdj_inv_pp … H … H1 H2) | lapply (sdj_inv_np … H … H1 H2) ] -H -H2
-/3 width=3 by ex2_intro, or_introl, or_intror/
-qed-.
-
-lemma sdj_inv_px: ∀g1,g2. g1 ∥ g2 → ∀f1. ⫯f1 = g1 →
- ∨∨ ∃∃f2. f1 ∥ f2 & ⫯f2 = g2
- | ∃∃f2. f1 ∥ f2 & ↑f2 = g2.
-#g1 #g2 elim (pn_split g2) * #f2 #H2 #H #f1 #H1
-[ lapply (sdj_inv_pp … H … H1 H2) | lapply (sdj_inv_pn … H … H1 H2) ] -H -H1
-/3 width=3 by ex2_intro, or_introl, or_intror/
-qed-.
-
-(* Properties with isid *****************************************************)
-
-corec lemma sdj_isid_dx: ∀f2. 𝐈❪f2❫ → ∀f1. f1 ∥ f2.
-#f2 * -f2
-#f2 #g2 #Hf2 #H2 #f1 cases (pn_split f1) *
-/3 width=5 by sdj_np, sdj_pp/
-qed.
-
-corec lemma sdj_isid_sn: ∀f1. 𝐈❪f1❫ → ∀f2. f1 ∥ f2.
-#f1 * -f1
-#f1 #g1 #Hf1 #H1 #f2 cases (pn_split f2) *
-/3 width=5 by sdj_pn, sdj_pp/
-qed.
-
-(* Inversion lemmas with isid ***********************************************)
-
-corec lemma sdj_inv_refl: ∀f. f ∥ f → 𝐈❪f❫.
-#f cases (pn_split f) * #g #Hg #H
-[ lapply (sdj_inv_pp … H … Hg Hg) -H /3 width=3 by isid_push/
-| elim (sdj_inv_nn … H … Hg Hg)
-]
-qed-.
+++ /dev/null
-(**************************************************************************)
-(* ___ *)
-(* ||M|| *)
-(* ||A|| A project by Andrea Asperti *)
-(* ||T|| *)
-(* ||I|| Developers: *)
-(* ||T|| The HELM team. *)
-(* ||A|| http://helm.tcs.unibo.it *)
-(* \ / *)
-(* \ / This file is distributed under the terms of the *)
-(* v GNU General Public License Version 2 *)
-(* *)
-(**************************************************************************)
-
-include "ground/relocation/rtmap_isid.ma".
-include "ground/relocation/rtmap_isdiv.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-coinductive sle: relation rtmap ≝
-| sle_push: ∀f1,f2,g1,g2. sle f1 f2 → ⫯f1 = g1 → ⫯f2 = g2 → sle g1 g2
-| sle_next: ∀f1,f2,g1,g2. sle f1 f2 → ↑f1 = g1 → ↑f2 = g2 → sle g1 g2
-| sle_weak: ∀f1,f2,g1,g2. sle f1 f2 → ⫯f1 = g1 → ↑f2 = g2 → sle g1 g2
-.
-
-interpretation "inclusion (rtmap)"
- 'subseteq f1 f2 = (sle f1 f2).
-
-(* Basic properties *********************************************************)
-
-axiom sle_eq_repl_back1: ∀f2. eq_repl_back … (λf1. f1 ⊆ f2).
-
-lemma sle_eq_repl_fwd1: ∀f2. eq_repl_fwd … (λf1. f1 ⊆ f2).
-#f2 @eq_repl_sym /2 width=3 by sle_eq_repl_back1/
-qed-.
-
-axiom sle_eq_repl_back2: ∀f1. eq_repl_back … (λf2. f1 ⊆ f2).
-
-lemma sle_eq_repl_fwd2: ∀f1. eq_repl_fwd … (λf2. f1 ⊆ f2).
-#f1 @eq_repl_sym /2 width=3 by sle_eq_repl_back2/
-qed-.
-
-corec lemma sle_refl: ∀f. f ⊆ f.
-#f cases (pn_split f) * #g #H
-[ @(sle_push … H H) | @(sle_next … H H) ] -H //
-qed.
-
-lemma sle_refl_eq: ∀f1,f2. f1 ≡ f2 → f1 ⊆ f2.
-/2 width=3 by sle_eq_repl_back2/ qed.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma sle_inv_xp: ∀g1,g2. g1 ⊆ g2 → ∀f2. ⫯f2 = g2 →
- ∃∃f1. f1 ⊆ f2 & ⫯f1 = g1.
-#g1 #g2 * -g1 -g2
-#f1 #f2 #g1 #g2 #H #H1 #H2 #x2 #Hx2 destruct
-[ lapply (injective_push … Hx2) -Hx2 /2 width=3 by ex2_intro/ ]
-elim (discr_push_next … Hx2)
-qed-.
-
-lemma sle_inv_nx: ∀g1,g2. g1 ⊆ g2 → ∀f1. ↑f1 = g1 →
- ∃∃f2. f1 ⊆ f2 & ↑f2 = g2.
-#g1 #g2 * -g1 -g2
-#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #Hx1 destruct
-[2: lapply (injective_next … Hx1) -Hx1 /2 width=3 by ex2_intro/ ]
-elim (discr_next_push … Hx1)
-qed-.
-
-lemma sle_inv_pn: ∀g1,g2. g1 ⊆ g2 → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 → f1 ⊆ f2.
-#g1 #g2 * -g1 -g2
-#f1 #f2 #g1 #g2 #H #H1 #H2 #x1 #x2 #Hx1 #Hx2 destruct
-[ elim (discr_next_push … Hx2)
-| elim (discr_push_next … Hx1)
-| lapply (injective_push … Hx1) -Hx1
- lapply (injective_next … Hx2) -Hx2 //
-]
-qed-.
-
-(* Advanced inversion lemmas ************************************************)
-
-lemma sle_inv_pp: ∀g1,g2. g1 ⊆ g2 → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 → f1 ⊆ f2.
-#g1 #g2 #H #f1 #f2 #H1 #H2 elim (sle_inv_xp … H … H2) -g2
-#x1 #H #Hx1 destruct lapply (injective_push … Hx1) -Hx1 //
-qed-.
-
-lemma sle_inv_nn: ∀g1,g2. g1 ⊆ g2 → ∀f1,f2. ↑f1 = g1 → ↑f2 = g2 → f1 ⊆ f2.
-#g1 #g2 #H #f1 #f2 #H1 #H2 elim (sle_inv_nx … H … H1) -g1
-#x2 #H #Hx2 destruct lapply (injective_next … Hx2) -Hx2 //
-qed-.
-
-lemma sle_inv_px: ∀g1,g2. g1 ⊆ g2 → ∀f1. ⫯f1 = g1 →
- (∃∃f2. f1 ⊆ f2 & ⫯f2 = g2) ∨ ∃∃f2. f1 ⊆ f2 & ↑f2 = g2.
-#g1 #g2 elim (pn_split g2) * #f2 #H2 #H #f1 #H1
-[ lapply (sle_inv_pp … H … H1 H2) | lapply (sle_inv_pn … H … H1 H2) ] -H -H1
-/3 width=3 by ex2_intro, or_introl, or_intror/
-qed-.
-
-lemma sle_inv_xn: ∀g1,g2. g1 ⊆ g2 → ∀f2. ↑f2 = g2 →
- (∃∃f1. f1 ⊆ f2 & ⫯f1 = g1) ∨ ∃∃f1. f1 ⊆ f2 & ↑f1 = g1.
-#g1 #g2 elim (pn_split g1) * #f1 #H1 #H #f2 #H2
-[ lapply (sle_inv_pn … H … H1 H2) | lapply (sle_inv_nn … H … H1 H2) ] -H -H2
-/3 width=3 by ex2_intro, or_introl, or_intror/
-qed-.
-
-(* Main properties **********************************************************)
-
-corec theorem sle_trans: Transitive … sle.
-#f1 #f * -f1 -f
-#f1 #f #g1 #g #Hf #H1 #H #g2 #H0
-[ cases (sle_inv_px … H0 … H) * |*: cases (sle_inv_nx … H0 … H) ] -g
-/3 width=5 by sle_push, sle_next, sle_weak/
-qed-.
-
-(* Properties with iterated push ********************************************)
-
-lemma sle_pushs: ∀f1,f2. f1 ⊆ f2 → ∀n. ⫯*[n] f1 ⊆ ⫯*[n] f2.
-#f1 #f2 #Hf12 #n @(nat_ind_succ … n) -n
-/2 width=5 by sle_push/
-qed.
-
-(* Properties with tail *****************************************************)
-
-lemma sle_px_tl: ∀g1,g2. g1 ⊆ g2 → ∀f1. ⫯f1 = g1 → f1 ⊆ ⫱g2.
-#g1 #g2 #H #f1 #H1 elim (sle_inv_px … H … H1) -H -H1 * //
-qed.
-
-lemma sle_xn_tl: ∀g1,g2. g1 ⊆ g2 → ∀f2. ↑f2 = g2 → ⫱g1 ⊆ f2.
-#g1 #g2 #H #f2 #H2 elim (sle_inv_xn … H … H2) -H -H2 * //
-qed.
-
-lemma sle_tl: ∀f1,f2. f1 ⊆ f2 → ⫱f1 ⊆ ⫱f2.
-#f1 elim (pn_split f1) * #g1 #H1 #f2 #H
-[ lapply (sle_px_tl … H … H1) -H //
-| elim (sle_inv_nx … H … H1) -H //
-]
-qed.
-
-(* Inversion lemmas with tail ***********************************************)
-
-lemma sle_inv_tl_sn: ∀f1,f2. ⫱f1 ⊆ f2 → f1 ⊆ ↑f2.
-#f1 elim (pn_split f1) * #g1 #H destruct
-/2 width=5 by sle_next, sle_weak/
-qed-.
-
-lemma sle_inv_tl_dx: ∀f1,f2. f1 ⊆ ⫱f2 → ⫯f1 ⊆ f2.
-#f1 #f2 elim (pn_split f2) * #g2 #H destruct
-/2 width=5 by sle_push, sle_weak/
-qed-.
-
-(* Properties with iteraded tail ********************************************)
-
-lemma sle_tls: ∀f1,f2. f1 ⊆ f2 → ∀n. ⫱*[n] f1 ⊆ ⫱*[n] f2.
-#f1 #f2 #Hf12 #n @(nat_ind_succ … n) -n
-/2 width=5 by sle_tl/
-qed.
-
-(* Properties with isid *****************************************************)
-
-corec lemma sle_isid_sn: ∀f1. 𝐈❪f1❫ → ∀f2. f1 ⊆ f2.
-#f1 * -f1
-#f1 #g1 #Hf1 #H1 #f2 cases (pn_split f2) *
-/3 width=5 by sle_weak, sle_push/
-qed.
-
-(* Inversion lemmas with isid ***********************************************)
-
-corec lemma sle_inv_isid_dx: ∀f1,f2. f1 ⊆ f2 → 𝐈❪f2❫ → 𝐈❪f1❫.
-#f1 #f2 * -f1 -f2
-#f1 #f2 #g1 #g2 #Hf * * #H
-[2,3: elim (isid_inv_next … H) // ]
-lapply (isid_inv_push … H ??) -H
-/3 width=3 by isid_push/
-qed-.
-
-(* Properties with isdiv ****************************************************)
-
-corec lemma sle_isdiv_dx: ∀f2. 𝛀❪f2❫ → ∀f1. f1 ⊆ f2.
-#f2 * -f2
-#f2 #g2 #Hf2 #H2 #f1 cases (pn_split f1) *
-/3 width=5 by sle_weak, sle_next/
-qed.
-
-(* Inversion lemmas with isdiv **********************************************)
-
-corec lemma sle_inv_isdiv_sn: ∀f1,f2. f1 ⊆ f2 → 𝛀❪f1❫ → 𝛀❪f2❫.
-#f1 #f2 * -f1 -f2
-#f1 #f2 #g1 #g2 #Hf * * #H
-[1,3: elim (isdiv_inv_push … H) // ]
-lapply (isdiv_inv_next … H ??) -H
-/3 width=3 by isdiv_next/
-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 "ground/xoa/or_3.ma".
-include "ground/xoa/ex_3_1.ma".
-include "ground/xoa/ex_4_2.ma".
-include "ground/notation/relations/runion_3.ma".
-include "ground/arith/nat_plus.ma".
-include "ground/arith/nat_le_max.ma".
-include "ground/relocation/rtmap_isfin.ma".
-include "ground/relocation/rtmap_sle.ma".
-
-coinductive sor: relation3 rtmap rtmap rtmap ≝
-| sor_pp: ∀f1,f2,f,g1,g2,g. sor f1 f2 f → ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → sor g1 g2 g
-| sor_np: ∀f1,f2,f,g1,g2,g. sor f1 f2 f → ↑f1 = g1 → ⫯f2 = g2 → ↑f = g → sor g1 g2 g
-| sor_pn: ∀f1,f2,f,g1,g2,g. sor f1 f2 f → ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → sor g1 g2 g
-| sor_nn: ∀f1,f2,f,g1,g2,g. sor f1 f2 f → ↑f1 = g1 → ↑f2 = g2 → ↑f = g → sor g1 g2 g
-.
-
-interpretation "union (rtmap)"
- 'RUnion f1 f2 f = (sor f1 f2 f).
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma sor_inv_ppx: ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ⫯f2 = g2 →
- ∃∃f. f1 ⋓ f2 ≘ f & ⫯f = g.
-#g1 #g2 #g * -g1 -g2 -g
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
-try (>(injective_push … Hx1) -x1) try (>(injective_next … Hx1) -x1)
-try elim (discr_push_next … Hx1) try elim (discr_next_push … Hx1)
-try (>(injective_push … Hx2) -x2) try (>(injective_next … Hx2) -x2)
-try elim (discr_push_next … Hx2) try elim (discr_next_push … Hx2)
-/2 width=3 by ex2_intro/
-qed-.
-
-lemma sor_inv_npx: ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f1,f2. ↑f1 = g1 → ⫯f2 = g2 →
- ∃∃f. f1 ⋓ f2 ≘ f & ↑f = g.
-#g1 #g2 #g * -g1 -g2 -g
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
-try (>(injective_push … Hx1) -x1) try (>(injective_next … Hx1) -x1)
-try elim (discr_push_next … Hx1) try elim (discr_next_push … Hx1)
-try (>(injective_push … Hx2) -x2) try (>(injective_next … Hx2) -x2)
-try elim (discr_push_next … Hx2) try elim (discr_next_push … Hx2)
-/2 width=3 by ex2_intro/
-qed-.
-
-lemma sor_inv_pnx: ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f1,f2. ⫯f1 = g1 → ↑f2 = g2 →
- ∃∃f. f1 ⋓ f2 ≘ f & ↑f = g.
-#g1 #g2 #g * -g1 -g2 -g
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
-try (>(injective_push … Hx1) -x1) try (>(injective_next … Hx1) -x1)
-try elim (discr_push_next … Hx1) try elim (discr_next_push … Hx1)
-try (>(injective_push … Hx2) -x2) try (>(injective_next … Hx2) -x2)
-try elim (discr_push_next … Hx2) try elim (discr_next_push … Hx2)
-/2 width=3 by ex2_intro/
-qed-.
-
-lemma sor_inv_nnx: ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f1,f2. ↑f1 = g1 → ↑f2 = g2 →
- ∃∃f. f1 ⋓ f2 ≘ f & ↑f = g.
-#g1 #g2 #g * -g1 -g2 -g
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x1 #x2 #Hx1 #Hx2 destruct
-try (>(injective_push … Hx1) -x1) try (>(injective_next … Hx1) -x1)
-try elim (discr_push_next … Hx1) try elim (discr_next_push … Hx1)
-try (>(injective_push … Hx2) -x2) try (>(injective_next … Hx2) -x2)
-try elim (discr_push_next … Hx2) try elim (discr_next_push … Hx2)
-/2 width=3 by ex2_intro/
-qed-.
-
-(* Advanced inversion lemmas ************************************************)
-
-lemma sor_inv_ppn: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ↑f = g → ⊥.
-#g1 #g2 #g #H #f1 #f2 #f #H1 #H2 #H0
-elim (sor_inv_ppx … H … H1 H2) -g1 -g2 #x #_ #H destruct
-/2 width=3 by discr_push_next/
-qed-.
-
-lemma sor_inv_nxp: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f1,f. ↑f1 = g1 → ⫯f = g → ⊥.
-#g1 #g2 #g #H #f1 #f #H1 #H0
-elim (pn_split g2) * #f2 #H2
-[ elim (sor_inv_npx … H … H1 H2)
-| elim (sor_inv_nnx … H … H1 H2)
-] -g1 -g2 #x #_ #H destruct
-/2 width=3 by discr_next_push/
-qed-.
-
-lemma sor_inv_xnp: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f2,f. ↑f2 = g2 → ⫯f = g → ⊥.
-#g1 #g2 #g #H #f2 #f #H2 #H0
-elim (pn_split g1) * #f1 #H1
-[ elim (sor_inv_pnx … H … H1 H2)
-| elim (sor_inv_nnx … H … H1 H2)
-] -g1 -g2 #x #_ #H destruct
-/2 width=3 by discr_next_push/
-qed-.
-
-lemma sor_inv_ppp: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f1,f2,f. ⫯f1 = g1 → ⫯f2 = g2 → ⫯f = g → f1 ⋓ f2 ≘ f.
-#g1 #g2 #g #H #f1 #f2 #f #H1 #H2 #H0
-elim (sor_inv_ppx … H … H1 H2) -g1 -g2 #x #Hx #H destruct
-<(injective_push … H) -f //
-qed-.
-
-lemma sor_inv_npn: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f1,f2,f. ↑f1 = g1 → ⫯f2 = g2 → ↑f = g → f1 ⋓ f2 ≘ f.
-#g1 #g2 #g #H #f1 #f2 #f #H1 #H2 #H0
-elim (sor_inv_npx … H … H1 H2) -g1 -g2 #x #Hx #H destruct
-<(injective_next … H) -f //
-qed-.
-
-lemma sor_inv_pnn: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f1,f2,f. ⫯f1 = g1 → ↑f2 = g2 → ↑f = g → f1 ⋓ f2 ≘ f.
-#g1 #g2 #g #H #f1 #f2 #f #H1 #H2 #H0
-elim (sor_inv_pnx … H … H1 H2) -g1 -g2 #x #Hx #H destruct
-<(injective_next … H) -f //
-qed-.
-
-lemma sor_inv_nnn: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f1,f2,f. ↑f1 = g1 → ↑f2 = g2 → ↑f = g → f1 ⋓ f2 ≘ f.
-#g1 #g2 #g #H #f1 #f2 #f #H1 #H2 #H0
-elim (sor_inv_nnx … H … H1 H2) -g1 -g2 #x #Hx #H destruct
-<(injective_next … H) -f //
-qed-.
-
-lemma sor_inv_pxp: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f1,f. ⫯f1 = g1 → ⫯f = g →
- ∃∃f2. f1 ⋓ f2 ≘ f & ⫯f2 = g2.
-#g1 #g2 #g #H #f1 #f #H1 #H0
-elim (pn_split g2) * #f2 #H2
-[ /3 width=7 by sor_inv_ppp, ex2_intro/
-| elim (sor_inv_xnp … H … H2 H0)
-]
-qed-.
-
-lemma sor_inv_xpp: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f2,f. ⫯f2 = g2 → ⫯f = g →
- ∃∃f1. f1 ⋓ f2 ≘ f & ⫯f1 = g1.
-#g1 #g2 #g #H #f2 #f #H2 #H0
-elim (pn_split g1) * #f1 #H1
-[ /3 width=7 by sor_inv_ppp, ex2_intro/
-| elim (sor_inv_nxp … H … H1 H0)
-]
-qed-.
-
-lemma sor_inv_pxn: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f1,f. ⫯f1 = g1 → ↑f = g →
- ∃∃f2. f1 ⋓ f2 ≘ f & ↑f2 = g2.
-#g1 #g2 #g #H #f1 #f #H1 #H0
-elim (pn_split g2) * #f2 #H2
-[ elim (sor_inv_ppn … H … H1 H2 H0)
-| /3 width=7 by sor_inv_pnn, ex2_intro/
-]
-qed-.
-
-lemma sor_inv_xpn: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f2,f. ⫯f2 = g2 → ↑f = g →
- ∃∃f1. f1 ⋓ f2 ≘ f & ↑f1 = g1.
-#g1 #g2 #g #H #f2 #f #H2 #H0
-elim (pn_split g1) * #f1 #H1
-[ elim (sor_inv_ppn … H … H1 H2 H0)
-| /3 width=7 by sor_inv_npn, ex2_intro/
-]
-qed-.
-
-lemma sor_inv_xxp: ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f. ⫯f = g →
- ∃∃f1,f2. f1 ⋓ f2 ≘ f & ⫯f1 = g1 & ⫯f2 = g2.
-#g1 #g2 #g #H #f #H0
-elim (pn_split g1) * #f1 #H1
-[ elim (sor_inv_pxp … H … H1 H0) -g /2 width=5 by ex3_2_intro/
-| elim (sor_inv_nxp … H … H1 H0)
-]
-qed-.
-
-lemma sor_inv_nxn: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f1,f. ↑f1 = g1 → ↑f = g →
- (∃∃f2. f1 ⋓ f2 ≘ f & ⫯f2 = g2) ∨
- ∃∃f2. f1 ⋓ f2 ≘ f & ↑f2 = g2.
-#g1 #g2 elim (pn_split g2) *
-/4 width=7 by sor_inv_npn, sor_inv_nnn, ex2_intro, or_intror, or_introl/
-qed-.
-
-lemma sor_inv_xnn: ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f2,f. ↑f2 = g2 → ↑f = g →
- (∃∃f1. f1 ⋓ f2 ≘ f & ⫯f1 = g1) ∨
- ∃∃f1. f1 ⋓ f2 ≘ f & ↑f1 = g1.
-#g1 elim (pn_split g1) *
-/4 width=7 by sor_inv_pnn, sor_inv_nnn, ex2_intro, or_intror, or_introl/
-qed-.
-
-lemma sor_inv_xxn: ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f. ↑f = g →
- ∨∨ ∃∃f1,f2. f1 ⋓ f2 ≘ f & ↑f1 = g1 & ⫯f2 = g2
- | ∃∃f1,f2. f1 ⋓ f2 ≘ f & ⫯f1 = g1 & ↑f2 = g2
- | ∃∃f1,f2. f1 ⋓ f2 ≘ f & ↑f1 = g1 & ↑f2 = g2.
-#g1 #g2 #g #H #f #H0
-elim (pn_split g1) * #f1 #H1
-[ elim (sor_inv_pxn … H … H1 H0) -g
- /3 width=5 by or3_intro1, ex3_2_intro/
-| elim (sor_inv_nxn … H … H1 H0) -g *
- /3 width=5 by or3_intro0, or3_intro2, ex3_2_intro/
-]
-qed-.
-
-(* Main inversion lemmas ****************************************************)
-
-corec theorem sor_mono: ∀f1,f2,x,y. f1 ⋓ f2 ≘ x → f1 ⋓ f2 ≘ y → x ≡ y.
-#f1 #f2 #x #y * -f1 -f2 -x
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #H
-[ cases (sor_inv_ppx … H … H1 H2)
-| cases (sor_inv_npx … H … H1 H2)
-| cases (sor_inv_pnx … H … H1 H2)
-| cases (sor_inv_nnx … H … H1 H2)
-] -g1 -g2
-/3 width=5 by eq_push, eq_next/
-qed-.
-
-(* Basic properties *********************************************************)
-
-corec lemma sor_eq_repl_back1: ∀f2,f. eq_repl_back … (λf1. f1 ⋓ f2 ≘ f).
-#f2 #f #f1 * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0 #x #Hx
-try cases (eq_inv_px … Hx … H1) try cases (eq_inv_nx … Hx … H1) -g1
-/3 width=7 by sor_pp, sor_np, sor_pn, sor_nn/
-qed-.
-
-lemma sor_eq_repl_fwd1: ∀f2,f. eq_repl_fwd … (λf1. f1 ⋓ f2 ≘ f).
-#f2 #f @eq_repl_sym /2 width=3 by sor_eq_repl_back1/
-qed-.
-
-corec lemma sor_eq_repl_back2: ∀f1,f. eq_repl_back … (λf2. f1 ⋓ f2 ≘ f).
-#f1 #f #f2 * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf #H #H2 #H0 #x #Hx
-try cases (eq_inv_px … Hx … H2) try cases (eq_inv_nx … Hx … H2) -g2
-/3 width=7 by sor_pp, sor_np, sor_pn, sor_nn/
-qed-.
-
-lemma sor_eq_repl_fwd2: ∀f1,f. eq_repl_fwd … (λf2. f1 ⋓ f2 ≘ f).
-#f1 #f @eq_repl_sym /2 width=3 by sor_eq_repl_back2/
-qed-.
-
-corec lemma sor_eq_repl_back3: ∀f1,f2. eq_repl_back … (λf. f1 ⋓ f2 ≘ f).
-#f1 #f2 #f * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf #H #H2 #H0 #x #Hx
-try cases (eq_inv_px … Hx … H0) try cases (eq_inv_nx … Hx … H0) -g
-/3 width=7 by sor_pp, sor_np, sor_pn, sor_nn/
-qed-.
-
-lemma sor_eq_repl_fwd3: ∀f1,f2. eq_repl_fwd … (λf. f1 ⋓ f2 ≘ f).
-#f1 #f2 @eq_repl_sym /2 width=3 by sor_eq_repl_back3/
-qed-.
-
-corec lemma sor_idem: ∀f. f ⋓ f ≘ f.
-#f cases (pn_split f) * #g #H
-[ @(sor_pp … H H H) | @(sor_nn … H H H) ] -H //
-qed.
-
-corec lemma sor_comm: ∀f1,f2,f. f1 ⋓ f2 ≘ f → f2 ⋓ f1 ≘ f.
-#f1 #f2 #f * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf * * * -g1 -g2 -g
-[ @sor_pp | @sor_pn | @sor_np | @sor_nn ] /2 width=7 by/
-qed-.
-
-(* Properties with tail *****************************************************)
-
-lemma sor_tl: ∀f1,f2,f. f1 ⋓ f2 ≘ f → ⫱f1 ⋓ ⫱f2 ≘ ⫱f.
-#f1 cases (pn_split f1) * #g1 #H1
-#f2 cases (pn_split f2) * #g2 #H2
-#f #Hf
-[ cases (sor_inv_ppx … Hf … H1 H2)
-| cases (sor_inv_pnx … Hf … H1 H2)
-| cases (sor_inv_npx … Hf … H1 H2)
-| cases (sor_inv_nnx … Hf … H1 H2)
-] -Hf #g #Hg #H destruct //
-qed.
-
-lemma sor_xxn_tl: ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f. ↑f = g →
- (∃∃f1,f2. f1 ⋓ f2 ≘ f & ↑f1 = g1 & ⫱g2 = f2) ∨
- (∃∃f1,f2. f1 ⋓ f2 ≘ f & ⫱g1 = f1 & ↑f2 = g2).
-#g1 #g2 #g #H #f #H0 elim (sor_inv_xxn … H … H0) -H -H0 *
-/3 width=5 by ex3_2_intro, or_introl, or_intror/
-qed-.
-
-lemma sor_xnx_tl: ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f2. ↑f2 = g2 →
- ∃∃f1,f. f1 ⋓ f2 ≘ f & ⫱g1 = f1 & ↑f = g.
-#g1 elim (pn_split g1) * #f1 #H1 #g2 #g #H #f2 #H2
-[ elim (sor_inv_pnx … H … H1 H2) | elim (sor_inv_nnx … H … H1 H2) ] -g2
-/3 width=5 by ex3_2_intro/
-qed-.
-
-lemma sor_nxx_tl: ∀g1,g2,g. g1 ⋓ g2 ≘ g → ∀f1. ↑f1 = g1 →
- ∃∃f2,f. f1 ⋓ f2 ≘ f & ⫱g2 = f2 & ↑f = g.
-#g1 #g2 elim (pn_split g2) * #f2 #H2 #g #H #f1 #H1
-[ elim (sor_inv_npx … H … H1 H2) | elim (sor_inv_nnx … H … H1 H2) ] -g1
-/3 width=5 by ex3_2_intro/
-qed-.
-
-(* Properties with iterated tail ********************************************)
-
-lemma sor_tls: ∀f1,f2,f. f1 ⋓ f2 ≘ f →
- ∀n. ⫱*[n]f1 ⋓ ⫱*[n]f2 ≘ ⫱*[n]f.
-#f1 #f2 #f #Hf #n @(nat_ind_succ … n) -n
-/2 width=1 by sor_tl/
-qed.
-
-(* Properies with test for identity *****************************************)
-
-corec lemma sor_isid_sn: ∀f1. 𝐈❪f1❫ → ∀f2. f1 ⋓ f2 ≘ f2.
-#f1 * -f1
-#f1 #g1 #Hf1 #H1 #f2 cases (pn_split f2) *
-/3 width=7 by sor_pp, sor_pn/
-qed.
-
-corec lemma sor_isid_dx: ∀f2. 𝐈❪f2❫ → ∀f1. f1 ⋓ f2 ≘ f1.
-#f2 * -f2
-#f2 #g2 #Hf2 #H2 #f1 cases (pn_split f1) *
-/3 width=7 by sor_pp, sor_np/
-qed.
-
-lemma sor_isid: ∀f1,f2,f. 𝐈❪f1❫ → 𝐈❪f2❫ → 𝐈❪f❫ → f1 ⋓ f2 ≘ f.
-/4 width=3 by sor_eq_repl_back2, sor_eq_repl_back1, isid_inv_eq_repl/ qed.
-
-(* Inversion lemmas with tail ***********************************************)
-
-lemma sor_inv_tl_sn: ∀f1,f2,f. ⫱f1 ⋓ f2 ≘ f → f1 ⋓ ↑f2 ≘ ↑f.
-#f1 #f2 #f elim (pn_split f1) *
-#g1 #H destruct /2 width=7 by sor_pn, sor_nn/
-qed-.
-
-lemma sor_inv_tl_dx: ∀f1,f2,f. f1 ⋓ ⫱f2 ≘ f → ↑f1 ⋓ f2 ≘ ↑f.
-#f1 #f2 #f elim (pn_split f2) *
-#g2 #H destruct /2 width=7 by sor_np, sor_nn/
-qed-.
-
-(* Inversion lemmas with test for identity **********************************)
-
-lemma sor_isid_inv_sn: ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐈❪f1❫ → f2 ≡ f.
-/3 width=4 by sor_isid_sn, sor_mono/
-qed-.
-
-lemma sor_isid_inv_dx: ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐈❪f2❫ → f1 ≡ f.
-/3 width=4 by sor_isid_dx, sor_mono/
-qed-.
-
-corec lemma sor_fwd_isid1: ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐈❪f❫ → 𝐈❪f1❫.
-#f1 #f2 #f * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H #Hg
-[ /4 width=6 by isid_inv_push, isid_push/ ]
-cases (isid_inv_next … Hg … H)
-qed-.
-
-corec lemma sor_fwd_isid2: ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐈❪f❫ → 𝐈❪f2❫.
-#f1 #f2 #f * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H #Hg
-[ /4 width=6 by isid_inv_push, isid_push/ ]
-cases (isid_inv_next … Hg … H)
-qed-.
-
-lemma sor_inv_isid3: ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐈❪f❫ → 𝐈❪f1❫ ∧ 𝐈❪f2❫.
-/3 width=4 by sor_fwd_isid2, sor_fwd_isid1, conj/ qed-.
-
-(* Properties with finite colength assignment *******************************)
-
-lemma sor_fcla_ex: ∀f1,n1. 𝐂❪f1❫ ≘ n1 → ∀f2,n2. 𝐂❪f2❫ ≘ n2 →
- ∃∃f,n. f1 ⋓ f2 ≘ f & 𝐂❪f❫ ≘ n & (n1 ∨ n2) ≤ n & n ≤ n1 + n2.
-#f1 #n1 #Hf1 elim Hf1 -f1 -n1 /3 width=6 by sor_isid_sn, ex4_2_intro/
-#f1 #n1 #Hf1 #IH #f2 #n2 * -f2 -n2 /3 width=6 by fcla_push, fcla_next, ex4_2_intro, sor_isid_dx/
-#f2 #n2 #Hf2 elim (IH … Hf2) -IH -Hf2 -Hf1 [2,4: #f #n <nplus_succ_dx ] (**) (* full auto fails *)
-[ /3 width=7 by fcla_next, sor_pn, nle_max_sn_succ_dx, nle_succ_bi, ex4_2_intro/
-| /4 width=7 by fcla_next, sor_nn, nle_succ_dx, nle_succ_bi, ex4_2_intro/
-| /3 width=7 by fcla_push, sor_pp, ex4_2_intro/
-| /3 width=7 by fcla_next, sor_np, nle_max_sn_succ_sn, nle_succ_bi, ex4_2_intro/
-]
-qed-.
-
-lemma sor_fcla: ∀f1,n1. 𝐂❪f1❫ ≘ n1 → ∀f2,n2. 𝐂❪f2❫ ≘ n2 → ∀f. f1 ⋓ f2 ≘ f →
- ∃∃n. 𝐂❪f❫ ≘ n & (n1 ∨ n2) ≤ n & n ≤ n1 + n2.
-#f1 #n1 #Hf1 #f2 #n2 #Hf2 #f #Hf elim (sor_fcla_ex … Hf1 … Hf2) -Hf1 -Hf2
-/4 width=6 by sor_mono, fcla_eq_repl_back, ex3_intro/
-qed-.
-
-(* Forward lemmas with finite colength **************************************)
-
-lemma sor_fwd_fcla_sn_ex: ∀f,n. 𝐂❪f❫ ≘ n → ∀f1,f2. f1 ⋓ f2 ≘ f →
- ∃∃n1. 𝐂❪f1❫ ≘ n1 & n1 ≤ n.
-#f #n #H elim H -f -n
-[ /4 width=4 by sor_fwd_isid1, fcla_isid, ex2_intro/
-| #f #n #_ #IH #f1 #f2 #H
- elim (sor_inv_xxp … H) -H [ |*: // ] #g1 #g2 #Hf #H1 #H2 destruct
- elim (IH … Hf) -f /3 width=3 by fcla_push, ex2_intro/
-| #f #n #_ #IH #f1 #f2 #H
- elim (sor_inv_xxn … H) -H [1,3,4: * |*: // ] #g1 #g2 #Hf #H1 #H2 destruct
- elim (IH … Hf) -f /3 width=3 by fcla_push, fcla_next, nle_succ_bi, nle_succ_dx, ex2_intro/
-]
-qed-.
-
-lemma sor_fwd_fcla_dx_ex: ∀f,n. 𝐂❪f❫ ≘ n → ∀f1,f2. f1 ⋓ f2 ≘ f →
- ∃∃n2. 𝐂❪f2❫ ≘ n2 & n2 ≤ n.
-/3 width=4 by sor_fwd_fcla_sn_ex, sor_comm/ qed-.
-
-(* Properties with test for finite colength *********************************)
-
-lemma sor_isfin_ex: ∀f1,f2. 𝐅❪f1❫ → 𝐅❪f2❫ → ∃∃f. f1 ⋓ f2 ≘ f & 𝐅❪f❫.
-#f1 #f2 * #n1 #H1 * #n2 #H2 elim (sor_fcla_ex … H1 … H2) -H1 -H2
-/3 width=4 by ex2_intro, ex_intro/
-qed-.
-
-lemma sor_isfin: ∀f1,f2. 𝐅❪f1❫ → 𝐅❪f2❫ → ∀f. f1 ⋓ f2 ≘ f → 𝐅❪f❫.
-#f1 #f2 #Hf1 #Hf2 #f #Hf elim (sor_isfin_ex … Hf1 … Hf2) -Hf1 -Hf2
-/3 width=6 by sor_mono, isfin_eq_repl_back/
-qed-.
-
-(* Forward lemmas with test for finite colength *****************************)
-
-lemma sor_fwd_isfin_sn: ∀f. 𝐅❪f❫ → ∀f1,f2. f1 ⋓ f2 ≘ f → 𝐅❪f1❫.
-#f * #n #Hf #f1 #f2 #H
-elim (sor_fwd_fcla_sn_ex … Hf … H) -f -f2 /2 width=2 by ex_intro/
-qed-.
-
-lemma sor_fwd_isfin_dx: ∀f. 𝐅❪f❫ → ∀f1,f2. f1 ⋓ f2 ≘ f → 𝐅❪f2❫.
-#f * #n #Hf #f1 #f2 #H
-elim (sor_fwd_fcla_dx_ex … Hf … H) -f -f1 /2 width=2 by ex_intro/
-qed-.
-
-(* Inversion lemmas with test for finite colength ***************************)
-
-lemma sor_inv_isfin3: ∀f1,f2,f. f1 ⋓ f2 ≘ f → 𝐅❪f❫ → 𝐅❪f1❫ ∧ 𝐅❪f2❫.
-/3 width=4 by sor_fwd_isfin_dx, sor_fwd_isfin_sn, conj/ qed-.
-
-(* Inversion lemmas with inclusion ******************************************)
-
-corec lemma sor_inv_sle_sn: ∀f1,f2,f. f1 ⋓ f2 ≘ f → f1 ⊆ f.
-#f1 #f2 #f * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0
-/3 width=5 by sle_push, sle_next, sle_weak/
-qed-.
-
-corec lemma sor_inv_sle_dx: ∀f1,f2,f. f1 ⋓ f2 ≘ f → f2 ⊆ f.
-#f1 #f2 #f * -f1 -f2 -f
-#f1 #f2 #f #g1 #g2 #g #Hf #H1 #H2 #H0
-/3 width=5 by sle_push, sle_next, sle_weak/
-qed-.
-
-lemma sor_inv_sle_sn_trans: ∀f1,f2,f. f1 ⋓ f2 ≘ f → ∀g. g ⊆ f1 → g ⊆ f.
-/3 width=4 by sor_inv_sle_sn, sle_trans/ qed-.
-
-lemma sor_inv_sle_dx_trans: ∀f1,f2,f. f1 ⋓ f2 ≘ f → ∀g. g ⊆ f2 → g ⊆ f.
-/3 width=4 by sor_inv_sle_dx, sle_trans/ qed-.
-
-axiom sor_inv_sle: ∀f1,f2,f. f1 ⋓ f2 ≘ f → ∀g. f1 ⊆ g → f2 ⊆ g → f ⊆ g.
-
-(* Properties with inclusion ************************************************)
-
-corec lemma sor_sle_dx: ∀f1,f2. f1 ⊆ f2 → f1 ⋓ f2 ≘ f2.
-#f1 #f2 * -f1 -f2 /3 width=7 by sor_pp, sor_nn, sor_pn/
-qed.
-
-corec lemma sor_sle_sn: ∀f1,f2. f1 ⊆ f2 → f2 ⋓ f1 ≘ f2.
-#f1 #f2 * -f1 -f2 /3 width=7 by sor_pp, sor_nn, sor_np/
-qed.
-
-(* Main properties **********************************************************)
-
-axiom monotonic_sle_sor: ∀f1,g1. f1 ⊆ g1 → ∀f2,g2. f2 ⊆ g2 →
- ∀f. f1 ⋓ f2 ≘ f → ∀g. g1 ⋓ g2 ≘ g → f ⊆ g.
-
-axiom sor_assoc_dx: ∀f0,f3,f4. f0 ⋓ f3 ≘ f4 →
- ∀f1,f2. f1 ⋓ f2 ≘ f0 →
- ∀f. f2 ⋓ f3 ≘ f → f1 ⋓ f ≘ f4.
-
-axiom sor_assoc_sn: ∀f1,f0,f4. f1 ⋓ f0 ≘ f4 →
- ∀f2, f3. f2 ⋓ f3 ≘ f0 →
- ∀f. f1 ⋓ f2 ≘ f → f ⋓ f3 ≘ f4.
-
-lemma sor_comm_23: ∀f0,f1,f2,f3,f4,f.
- f0⋓f4 ≘ f1 → f1⋓f2 ≘ f → f0⋓f2 ≘ f3 → f3⋓f4 ≘ f.
-/4 width=6 by sor_comm, sor_assoc_dx/ qed-.
-
-corec theorem sor_comm_23_idem: ∀f0,f1,f2. f0 ⋓ f1 ≘ f2 →
- ∀f. f1 ⋓ f2 ≘ f → f1 ⋓ f0 ≘ f.
-#f0 #f1 #f2 * -f0 -f1 -f2
-#f0 #f1 #f2 #g0 #g1 #g2 #Hf2 #H0 #H1 #H2 #g #Hg
-[ cases (sor_inv_ppx … Hg … H1 H2)
-| cases (sor_inv_pnx … Hg … H1 H2)
-| cases (sor_inv_nnx … Hg … H1 H2)
-| cases (sor_inv_nnx … Hg … H1 H2)
-] -g2 #f #Hf #H
-/3 width=7 by sor_nn, sor_np, sor_pn, sor_pp/
-qed-.
-
-corec theorem sor_coll_dx: ∀f1,f2,f. f1 ⋓ f2 ≘ f → ∀g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀g0. g1 ⋓ g0 ≘ f1 → g2 ⋓ g0 ≘ f2 → g ⋓ g0 ≘ f.
-#f1 #f2 #f cases (pn_split f) * #x #Hx #Hf #g1 #g2 #g #Hg #g0 #Hf1 #Hf2
-[ cases (sor_inv_xxp … Hf … Hx) -Hf #x1 #x2 #Hf #Hx1 #Hx2
- cases (sor_inv_xxp … Hf1 … Hx1) -f1 #y1 #y0 #Hf1 #Hy1 #Hy0
- cases (sor_inv_xpp … Hf2 … Hy0 … Hx2) -f2 #y2 #Hf2 #Hy2
- cases (sor_inv_ppx … Hg … Hy1 Hy2) -g1 -g2 #y #Hg #Hy
- @(sor_pp … Hy Hy0 Hx) -g -g0 -f /2 width=8 by/
-| cases (pn_split g) * #y #Hy
- [ cases (sor_inv_xxp … Hg … Hy) -Hg #y1 #y2 #Hg #Hy1 #Hy2
- cases (sor_xxn_tl … Hf … Hx) * #x1 #x2 #_ #Hx1 #Hx2
- [ cases (sor_inv_pxn … Hf1 … Hy1 Hx1) -g1 #y0 #Hf1 #Hy0
- cases (sor_inv_pnx … Hf2 … Hy2 Hy0) -g2 -x2 #x2 #Hf2 #Hx2
- | cases (sor_inv_pxn … Hf2 … Hy2 Hx2) -g2 #y0 #Hf2 #Hy0
- cases (sor_inv_pnx … Hf1 … Hy1 Hy0) -g1 -x1 #x1 #Hf1 #Hx1
- ]
- lapply (sor_inv_nnn … Hf … Hx1 Hx2 Hx) -f1 -f2 #Hf
- @(sor_pn … Hy Hy0 Hx) -g -g0 -f /2 width=8 by/
- | lapply (sor_tl … Hf) -Hf #Hf
- lapply (sor_tl … Hg) -Hg #Hg
- lapply (sor_tl … Hf1) -Hf1 #Hf1
- lapply (sor_tl … Hf2) -Hf2 #Hf2
- cases (pn_split g0) * #y0 #Hy0
- [ @(sor_np … Hy Hy0 Hx) /2 width=8 by/
- | @(sor_nn … Hy Hy0 Hx) /2 width=8 by/
- ]
- ]
-]
-qed-.
-
-corec theorem sor_distr_dx: ∀g0,g1,g2,g. g1 ⋓ g2 ≘ g →
- ∀f1,f2,f. g1 ⋓ g0 ≘ f1 → g2 ⋓ g0 ≘ f2 → g ⋓ g0 ≘ f →
- f1 ⋓ f2 ≘ f.
-#g0 cases (pn_split g0) * #y0 #H0 #g1 #g2 #g
-[ * -g1 -g2 -g #y1 #y2 #y #g1 #g2 #g #Hy #Hy1 #Hy2 #Hy #f1 #f2 #f #Hf1 #Hf2 #Hf
- [ cases (sor_inv_ppx … Hf1 … Hy1 H0) -g1
- cases (sor_inv_ppx … Hf2 … Hy2 H0) -g2
- cases (sor_inv_ppx … Hf … Hy H0) -g
- | cases (sor_inv_npx … Hf1 … Hy1 H0) -g1
- cases (sor_inv_ppx … Hf2 … Hy2 H0) -g2
- cases (sor_inv_npx … Hf … Hy H0) -g
- | cases (sor_inv_ppx … Hf1 … Hy1 H0) -g1
- cases (sor_inv_npx … Hf2 … Hy2 H0) -g2
- cases (sor_inv_npx … Hf … Hy H0) -g
- | cases (sor_inv_npx … Hf1 … Hy1 H0) -g1
- cases (sor_inv_npx … Hf2 … Hy2 H0) -g2
- cases (sor_inv_npx … Hf … Hy H0) -g
- ] -g0 #y #Hy #H #y2 #Hy2 #H2 #y1 #Hy1 #H1
- /3 width=8 by sor_nn, sor_np, sor_pn, sor_pp/
-| #H #f1 #f2 #f #Hf1 #Hf2 #Hf
- cases (sor_xnx_tl … Hf1 … H0) -Hf1
- cases (sor_xnx_tl … Hf2 … H0) -Hf2
- cases (sor_xnx_tl … Hf … H0) -Hf
- -g0 #y #x #Hx #Hy #H #y2 #x2 #Hx2 #Hy2 #H2 #y1 #x1 #Hx1 #Hy1 #H1
- /4 width=8 by sor_tl, sor_nn/
-]
-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 "ground/notation/functions/droppred_1.ma".
-include "ground/relocation/rtmap_eq.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-definition tl: rtmap → rtmap.
-@case_type0 #f @f
-defined.
-
-interpretation "tail (rtmap)" 'DropPred f = (tl f).
-
-(* Basic properties *********************************************************)
-
-lemma tl_rew: ∀f. case_type0 (λ_:rtmap.rtmap) (λf:rtmap.f) (λf:rtmap.f) f = ⫱f.
-// qed.
-
-lemma tl_push_rew: ∀f. f = ⫱⫯f.
-#f <tl_rew <iota_push //
-qed.
-
-lemma tl_next_rew: ∀f. f = ⫱↑f.
-#f <tl_rew <iota_next //
-qed.
-
-lemma tl_eq_repl: eq_repl … (λf1,f2. ⫱f1 ≡ ⫱f2).
-#f1 #f2 * -f1 -f2 //
-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 "ground/notation/functions/droppreds_2.ma".
-include "ground/relocation/rtmap_pushs.ma".
-include "ground/relocation/rtmap_tl.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-definition tls (f:rtmap) (n:nat) ≝ tl^n f.
-
-interpretation "tls (rtmap)" 'DropPreds n f = (tls f n).
-
-(* Basic properties *********************************************************)
-
-lemma tls_O: ∀f. f = ⫱*[𝟎] f.
-// qed.
-
-lemma tls_S: ∀f,n. ⫱ ⫱*[n] f = ⫱*[↑n] f.
-#f #n @(niter_succ … tl)
-qed.
-
-lemma tls_eq_repl: ∀n. eq_repl (λf1,f2. ⫱*[n] f1 ≡ ⫱*[n] f2).
-#n @(nat_ind_succ … n) -n /3 width=1 by tl_eq_repl/
-qed.
-
-(* Advanced properties ******************************************************)
-
-lemma tls_swap (n) (f): ⫱ ⫱*[n] f = ⫱*[n] ⫱f.
-#f #n @(niter_appl … tl)
-qed.
-
-lemma tls_xn: ∀n,f. ⫱*[n] ⫱f = ⫱*[↑n] f.
-// qed.
-
-(* Properties with pushs ****************************************************)
-
-lemma tls_pushs: ∀n,f. f = ⫱*[n] ⫯*[n] f.
-#n @(nat_ind_succ … n) -n //
-#n #IH #f <tls_xn <pushs_S <tl_push_rew //
-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 "ground/notation/functions/uniform_1.ma".
-include "ground/relocation/rtmap_nexts.ma".
-include "ground/relocation/rtmap_id.ma".
-include "ground/relocation/rtmap_isuni.ma".
-
-(* RELOCATION MAP ***********************************************************)
-
-definition uni (n) ≝ ↑*[n] 𝐈𝐝.
-
-interpretation "uniform relocation (rtmap)"
- 'Uniform n = (uni n).
-
-(* Basic properties *********************************************************)
-
-lemma uni_zero: 𝐈𝐝 = 𝐔❨𝟎❩.
-// qed.
-
-lemma uni_succ: ∀n. ↑𝐔❨n❩ = 𝐔❨↑n❩.
-/2 width=1 by nexts_S/ qed.
-
-(* Basic inversion lemmas ***************************************************)
-
-lemma uni_inv_push_dx: ∀f,n. 𝐔❨n❩ ≡ ⫯f → 𝟎 = n ∧ 𝐈𝐝 ≡ f.
-#f #n @(nat_ind_succ … n) -n
-[ /3 width=5 by eq_inv_pp, conj/
-| #n #_ <uni_succ #H elim (eq_inv_np … H) -H //
-]
-qed-.
-
-lemma uni_inv_push_sn: ∀f,n. ⫯f ≡ 𝐔❨n❩ → 𝟎 = n ∧ 𝐈𝐝 ≡ f.
-/3 width=1 by uni_inv_push_dx, eq_sym/ qed-.
-
-lemma uni_inv_id_dx: ∀n. 𝐔❨n❩ ≡ 𝐈𝐝 → 𝟎 = n.
-#n <id_rew #H elim (uni_inv_push_dx … H) -H //
-qed-.
-
-lemma uni_inv_id_sn: ∀n. 𝐈𝐝 ≡ 𝐔❨n❩ → 𝟎 = n.
-/3 width=1 by uni_inv_id_dx, eq_sym/ qed-.
-
-lemma uni_inv_next_dx: ∀f,n. 𝐔❨n❩ ≡ ↑f → ∃∃m. 𝐔❨m❩ ≡ f & ↑m = n.
-#f #n @(nat_ind_succ … n) -n
-[ <uni_zero <id_rew #H elim (eq_inv_pn … H) -H //
-| #n #_ <uni_succ /3 width=5 by eq_inv_nn, ex2_intro/
-]
-qed-.
-
-lemma uni_inv_next_sn: ∀f,n. ↑f ≡ 𝐔❨n❩ → ∃∃m. 𝐔❨m❩ ≡ f & ↑m = n.
-/3 width=1 by uni_inv_next_dx, eq_sym/ qed-.
-
-(* Properties with test for identity ****************************************)
-
-lemma uni_isid: ∀f. 𝐈❪f❫ → 𝐔❨𝟎❩ ≡ f.
-/2 width=1 by eq_id_inv_isid/ qed-.
-
-(* Inversion lemmas with test for identity **********************************)
-
-lemma uni_inv_isid: ∀f. 𝐔❨𝟎❩ ≡ f → 𝐈❪f❫.
-/2 width=1 by eq_id_isid/ qed-.
-
-(* Properties with finite colength assignment ***************************)
-
-lemma fcla_uni: ∀n. 𝐂❪𝐔❨n❩❫ ≘ n.
-#n @(nat_ind_succ … n) -n
-/2 width=1 by fcla_isid, fcla_next/
-qed.
-
-(* Properties with test for finite colength ***************************)
-
-lemma isfin_uni: ∀n. 𝐅❪𝐔❨n❩❫.
-/3 width=2 by ex_intro/ qed.
-
-(* Properties with test for uniformity **************************************)
-
-lemma isuni_uni: ∀n. 𝐔❪𝐔❨n❩❫.
-#n @(nat_ind_succ … n) -n
-/3 width=3 by isuni_isid, isuni_next/
-qed.
-
-lemma uni_isuni: ∀f. 𝐔❪f❫ → ∃n. 𝐔❨n❩ ≡ f.
-#f #H elim H -f /3 width=2 by uni_isid, ex_intro/
-#f #_ #g #H * /3 width=6 by eq_next, ex_intro/
-qed-.
-
-(* Inversion lemmas with test for uniformity ********************************)
-
-lemma uni_inv_isuni: ∀n,f. 𝐔❨n❩ ≡ f → 𝐔❪f❫.
-#n @(nat_ind_succ … n) -n
-[ /3 width=1 by uni_inv_isid, isuni_isid/
-| #n #IH #x <uni_succ #H elim (eq_inv_nx … H) -H /3 width=3 by isuni_next/
-]
-qed-.
</body>
<table name="ground_sum"/>
+ <news class="gamma" date="2021-05-29.">
+ Generic relocation maps are streams of booleans
+ (delayed anniversary milestone).
+ </news>
<news class="gamma" date="2021-02-15.">
Primitive arithmetics library.
</news>
}
]
class "water"
- [ { "generic rt-transition counter" * } {
+ [ { "generic rt-transition counters" * } {
[ { "" * } {
[ "rtc_ist ( 𝐓❪?,?❫ )" "rtc_ist_shift" "rtc_ist_plus" "rtc_ist_max" * ]
[ "rtc_ism ( 𝐌❪?,?❫ )" "rtc_ism_shift" "rtc_ism_plus" "rtc_ism_max" "rtc_ism_max_shift" * ]
}
]
class "green"
- [ { "multiple relocation" * } {
+ [ { "relocation maps" * } {
+ [ { "finite relocation with pairs" * } {
+ [ "fr2_nat ( @❪?,?❫ ≘ ? )" "fr2_nat_nat" * ]
+ [ "fr2_minus ( ? ▭ ? ≘ ? )" * ]
+ [ "fr2_append ( ?@@? )" * ]
+ [ "fr2_plus ( ?+? )" * ]
+ [ "fr2_map ( ◊ ) ( ❨?,?❩;? )" * ]
+ ]
+ [ { "generic relocation" * } {
+ [ "gr_sor ( ? ⋓ ? ≘ ? )" "gr_sor_eq" "gr_sor_tls" "gr_sor_isi" "gr_sor_fcla" "gr_sor_isf" "gr_sor_coafter_ist_isf" "gr_sor_sle" "gr_sor_sor" "gr_sor_sor_sle" * ]
+ [ "gr_sand ( ? ⋒ ? ≘ ? )" "gr_sand_eq" * ]
+ [ "gr_sdj ( ? ∥ ? )" "gr_sdj_eq" "gr_sdj_isi" * ]
+ [ "gr_sle ( ? ⊆ ? )" "gr_sle_eq" "gr_sle_pushs" "gr_sle_tls" "gr_sle_isi" "gr_sle_isd" "gr_sle_sle" * ]
+ [ "gr_coafter ( ? ~⊚ ? ≘ ? )" "gr_coafter_eq" "gr_coafter_uni_pushs" "gr_coafter_pat_tls" "gr_coafter_nat_tls" "gr_coafter_nat_tls_pushs" "gr_coafter_isi" "gr_coafter_isu" "gr_coafter_ist_isi" "gr_coafter_ist_isf" "gr_coafter_coafter" "gr_coafter_coafter_ist" * ]
+ [ "gr_after ( ? ⊚ ? ≘ ? )" "gr_after_eq" "gr_after_uni" "gr_after_basic" "gr_after_pat" "gr_after_pat_tls" "gr_after_pat_uni" "gr_after_nat_uni" "gr_after_isi" "gr_after_isu" "gr_after_ist" "gr_after_ist_isi" "gr_after_after" "gr_after_after_ist" * ]
+ [ "gr_isd ( 𝛀❪?❫ )" "gr_isd_eq" "gr_isd_tl" "gr_isd_nexts" "gr_isd_tls" * ]
+ [ "gr_ist ( 𝐓❪?❫ )" "gr_ist_tls" "gr_ist_isi" "gr_ist_ist" * ]
+ [ "gr_isf ( 𝐅❪?❫ )" "gr_isf_eq" "gr_isf_tl" "gr_isf_pushs" "fr_isf_tls" "gr_ifs_uni" "gr_isf_isu" * ]
+ [ "gr_fcla ( 𝐂❪?❫ ≘ ? )" "gr_fcla_eq" "fcla_uni" "gr_fcla_fcla" * ]
+ [ "gr_isu ( 𝐔❪?❫ )" "gr_isu_tl" "gr_isu_uni" * ]
+ [ "gr_isi ( 𝐈❪?❫ )" "gr_isi_eq" "gr_isi_tl" "gr_isi_pushs" "gr_isi_tls" "gr_isi_id" "gr_isi_uni" "gr_isi_pat" * ]
+ [ "gr_nat ( @↑❪?,?❫ ≘ ? )" "gr_nat_uni" "gr_nat_basic" "gr_nat_nat" * ]
+ [ "gr_pat ( @❪?,?❫ ≘ ? )" "gr_pat_lt" "gr_pat_eq" "gr_pat_tls" "gr_pat_id" "gr_pat_uni" "gr_pat_basic" "gr_pat_pat" "gr_pat_pat_id" * ]
+ [ "gr_basic ( 𝐛❨?,?❩ )" * ]
+ [ "gr_uni ( 𝐮❨?❩ )" "gr_uni_eq" * ]
+ [ "gr_id ( 𝐢 ) " "gr_id_eq" * ]
+ [ "gr_tls ( ⫱*[?]? )" "gr_tls_eq" "gr_tls_pushs" "gr_tls_pushs_eq" "gr_tls_nexts_eq" * ]
+ [ "gr_nexts ( ↑*[?]? )" "gr_nexts_eq" * ]
+ [ "gr_pushs ( ⫯*[?]? )" "gr_pushs_eq" * ]
+ [ "gr_tl ( ⫱? )" "gr_tl_eq" "gr_tl_eq_eq" * ]
+ [ "gr_eq ( ? ≡ ? )" * ]
+ [ "gr_map ( ⫯? ) ( ↑? )" * ]
+ ]
+(*
[ { "" * } {
- [ "rtmap" "rtmap_eq ( ? ≡ ? )" "rtmap_pushs ( ⫯*[?]? )" "rtmap_nexts ( ↑*[?]? )"
- "rtmap_tl ( ⫱? )" "rtmap_tls ( ⫱*[?]? )" "rtmap_isid ( 𝐈❪?❫ )" "rtmap_id" "rtmap_isdiv ( 𝛀❪?❫ )"
- "rtmap_fcla ( 𝐂❪?❫ ≘ ? )" "rtmap_isfin ( 𝐅❪?❫ )" "rtmap_isuni ( 𝐔❪?❫ )" "rtmap_uni ( 𝐔❨?❩ )"
- "rtmap_sle ( ? ⊆ ? )" "rtmap_sdj ( ? ∥ ? )" "rtmap_sand ( ? ⋒ ? ≘ ? )" "rtmap_sor ( ? ⋓ ? ≘ ? )"
- "rtmap_at ( @❪?,?❫ ≘ ? )" "rtmap_istot ( 𝐓❪?❫ )" "rtmap_after ( ? ⊚ ? ≘ ? )" "rtmap_coafter ( ? ~⊚ ? ≘ ? )"
- "rtmap_basic ( 𝐁❨?,?❩ )" "rtmap_basic_after"
- * ]
[ "nstream ( ⫯? ) ( ↑? )" "nstream_eq" "" ""
- "" "" "nstream_isid" "nstream_id ( ð\9d\90\88ð\9d\90\9d )" ""
+ "" "" "nstream_isid" "nstream_id ( ð\9d\90¢ )" ""
"" "" "" ""
"" "" "" "nstream_sor"
"" "nstream_istot ( ?@❨?❩ )" "nstream_after ( ? ∘ ? )" "nstream_coafter ( ? ~∘ ? )"
"nstream_basic" ""
* ]
+*)
(*
[ "trace ( ∥?∥ )" "trace_at ( @❪?,?❫ ≘ ? )" "trace_after ( ? ⊚ ? ≘ ? )" "trace_isid ( 𝐈❪?❫ )" "trace_isun ( 𝐔❪?❫ )"
"trace_sle ( ? ⊆ ? )" "trace_sor ( ? ⋓ ? ≘ ? )" "trace_snot ( ∁ ? )" * ]
*)
- [ "mr2 ( ◊ ) ( ❨?,?❩;? )" "mr2_append ( ? @@? )" "mr2_at ( @❪?,?❫ ≘ ? )" "mr2_plus ( ? + ? )" "mr2_minus ( ? ▭ ? ≘ ? )" * ]
}
]
}
]
class "yellow"
[ { "extensions to the library" * } {
+ [ { "streams" * } {
+ [ "stream_tls ( ⫰*{?}[?]? )" "stream_tls_eq" * ]
+ [ "stream_hdtl ( ⫰{?}? )" * ]
+ [ "stream_eq ( ? ≗{?} ? )" "stream_eq_eq" * ]
+ [ "stream ( ? ⨮{?} ? )" * ]
+ }
+ ]
[ { "" * } {
- [ "stream ( ? ⨮{?} ? )" "stream_eq ( ? ≗{?} ? )" "stream_hdtl ( ⫰{?}? )" "stream_tls ( ⫰*{?}[?]? )" * ]
[ "list ( Ⓔ{?} ) ( ? ⨮{?} ? )" "list_eq" "list_length ( |?| )" * ]
[ "bool ( Ⓕ ) ( Ⓣ )" "bool_or" "bool_and" * ]
[ "ltc" "ltc_ctc" * ]
| #f2 #I #L1 #L2 #_ #IHL #J #K #H elim (IHL … H) -IHL
/3 width=7 by after_next, ex3_2_intro, drops_drop/
| #f2 #I1 #I2 #L1 #L2 #HL #_ #_ #J #K #H destruct
- lapply (after_isid_dx ð\9d\90\88ð\9d\90\9d … f2) /3 width=9 by after_push, ex3_2_intro, drops_drop/
+ lapply (after_isid_dx ð\9d\90¢ … f2) /3 width=9 by after_push, ex3_2_intro, drops_drop/
]
qed-.
(* Basic_2A1: includes: drop_mono *)
lemma drops_mono: ∀b1,f,L,L1. ⇩*[b1,f] L ≘ L1 →
∀b2,L2. ⇩*[b2,f] L ≘ L2 → L1 = L2.
-#b1 #f #L #L1 lapply (after_isid_dx ð\9d\90\88ð\9d\90\9d … f)
+#b1 #f #L #L1 lapply (after_isid_dx ð\9d\90¢ … f)
/3 width=8 by drops_conf, drops_fwd_isid/
qed-.
lemma lex_CTC (R): s_rs_transitive … R (λ_. lex R) →
TC … (lex R) ⊆ lex (CTC … R).
#R #HR #L1 #L2 #HL12
-lapply (monotonic_TC â\80¦ (sex cfull (cext2 R) ð\9d\90\88ð\9d\90\9d) … HL12) -HL12
+lapply (monotonic_TC â\80¦ (sex cfull (cext2 R) ð\9d\90¢) … HL12) -HL12
[ #L1 #L2 * /3 width=3 by sex_eq_repl_fwd, eq_id_inv_isid/
| /5 width=9 by s_rs_transitive_lex_inv_isid, sex_tc_dx, sex_co, ext2_tc, ex2_intro/
]
(* Basic_2A1: includes: lift_inj *)
lemma lifts_inj: ∀f. is_inj2 … (lifts f).
-#f #T1 #U #H1 #T2 #H2 lapply (after_isid_dx ð\9d\90\88ð\9d\90\9d … f)
+#f #T1 #U #H1 #T2 #H2 lapply (after_isid_dx ð\9d\90¢ … f)
/3 width=6 by lifts_div3, lifts_fwd_isid/
qed-.
(* Basic_2A1: includes: lift_mono *)
lemma lifts_mono: ∀f,T. is_mono … (lifts f T).
-#f #T #U1 #H1 #U2 #H2 lapply (after_isid_sn ð\9d\90\88ð\9d\90\9d … f)
+#f #T #U1 #H1 #U2 #H2 lapply (after_isid_sn ð\9d\90¢ … f)
/3 width=6 by lifts_conf, lifts_fwd_isid/
qed-.
(* Advanced proprerties *****************************************************)
lemma liftsb_inj: ∀f. is_inj2 … (liftsb f).
-#f #T1 #U #H1 #T2 #H2 lapply (after_isid_dx ð\9d\90\88ð\9d\90\9d … f)
+#f #T1 #U #H1 #T2 #H2 lapply (after_isid_dx ð\9d\90¢ … f)
/3 width=6 by liftsb_div3, liftsb_fwd_isid/
qed-.
lemma liftsb_mono: ∀f,T. is_mono … (liftsb f T).
-#f #T #U1 #H1 #U2 #H2 lapply (after_isid_sn ð\9d\90\88ð\9d\90\9d … f)
+#f #T #U1 #H1 #U2 #H2 lapply (after_isid_sn ð\9d\90¢ … f)
/3 width=6 by liftsb_conf, liftsb_fwd_isid/
qed-.
letin s ≝ 0 (* one sort must exist *)
lapply (cp1 … H1RP G L s) #HK
lapply (s2 … IHB G L (Ⓔ) … HK) // #HB
- lapply (H (ð\9d\90\88ð\9d\90\9d) L (⋆s) T ? ? ?) -H
+ lapply (H (ð\9d\90¢) L (⋆s) T ? ? ?) -H
/3 width=6 by s1, cp3, drops_refl, lifts_refl/
| #G #L #Vs #HVs #T #H1T #H2T #f #L0 #V0 #X #HL0 #H #HB
elim (lifts_inv_applv1 … H) -H #V0s #T0 #HV0s #HT0 #H destruct
∀L1,L2,T. L1 ⪤[R,T] L2 →
∃∃L. L1 ≡[T] L & L ⪤[R] L2.
#R #H1R #H2R #L1 #L2 #T * #f1 #Hf1 #HL
-elim (sex_sdj_split_dx â\80¦ ceq_ext â\80¦ HL ð\9d\90\88ð\9d\90\9d) -HL
+elim (sex_sdj_split_dx â\80¦ ceq_ext â\80¦ HL ð\9d\90¢) -HL
[ #L0 #HL10 #HL02
lapply (sex_sdj … HL02 f1 ?) /2 width=1 by sdj_isid_sn/ #H
/3 width=5 by (* 2x *) ex2_intro/
∀L1,L2,T. L1 ⪤[R,T] L2 →
∃∃L. L1 ⪤[R] L & L ≡[T] L2.
#R #H1R #H2R #L1 #L2 #T * #f1 #Hf1 #HL
-elim (sex_sdj_split_sn â\80¦ ceq_ext â\80¦ HL ð\9d\90\88ð\9d\90\9d ?) -HL
+elim (sex_sdj_split_sn â\80¦ ceq_ext â\80¦ HL ð\9d\90¢ ?) -HL
[ #L0 #HL10 #HL02 |*: /2 width=1 by ext2_refl, sdj_isid_dx/ ] -H1R
lapply (sex_sdj … HL10 f1 ?) /2 width=1 by sdj_isid_sn/ #H
elim (frees_sex_conf_fsge … Hf1 … H) // -H2R -H #f0 #Hf0 #Hf01
projects / helm.git / commitdiff