diff --git a/examples/CCS/BisimulationUptoScript.sml b/examples/CCS/BisimulationUptoScript.sml index 23bc8c8d68..d9a43fcf58 100644 --- a/examples/CCS/BisimulationUptoScript.sml +++ b/examples/CCS/BisimulationUptoScript.sml @@ -26,7 +26,7 @@ val _ = new_theory "BisimulationUpto"; (* Define the strong bisimulation relation up to STRONG_EQUIV *) val STRONG_BISIM_UPTO = new_definition ( "STRONG_BISIM_UPTO", - ``STRONG_BISIM_UPTO (Bsm :('a, 'b) simulation) = + ``STRONG_BISIM_UPTO (Bsm :'a simulation) = !E E'. Bsm E E' ==> !u. (!E1. TRANS E u E1 ==> @@ -45,14 +45,14 @@ val IDENTITY_STRONG_BISIM_UPTO = store_thm ( PURE_ONCE_REWRITE_TAC [STRONG_BISIM_UPTO] >> rpt STRIP_TAC (* 2 sub-goals *) >| [ (* goal 1 *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``E:('a, 'b) CCS = E'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E:'a CCS = E'``] (ASSUME ``TRANS E u E1``)) \\ - EXISTS_TAC ``E1 :('a, 'b) CCS`` \\ + EXISTS_TAC ``E1 :'a CCS`` \\ ASM_REWRITE_TAC [] \\ REWRITE_TAC [IDENTITY_STRONG_BISIM_UPTO_lemma], (* goal 2 *) PURE_ONCE_ASM_REWRITE_TAC [] \\ - EXISTS_TAC ``E2 :('a, 'b) CCS`` \\ + EXISTS_TAC ``E2 :'a CCS`` \\ ASM_REWRITE_TAC [] \\ REWRITE_TAC [IDENTITY_STRONG_BISIM_UPTO_lemma] ]); @@ -164,7 +164,7 @@ val STRONG_BISIM_UPTO_THM = store_thm ( >> IMP_RES_TAC STRONG_BISIM_SUBSET_STRONG_EQUIV >> Suff `Bsm RSUBSET (STRONG_EQUIV O Bsm O STRONG_EQUIV)` >- ( DISCH_TAC \\ - Know `transitive ((RSUBSET) :('a, 'b) simulation -> ('a, 'b) simulation -> bool)` + Know `transitive ((RSUBSET) :'a simulation -> 'a simulation -> bool)` >- PROVE_TAC [RSUBSET_WeakOrder, WeakOrder] \\ RW_TAC std_ss [transitive_def] >> RES_TAC ) >> KILL_TAC @@ -194,7 +194,7 @@ val STRONG_EQUIV_BY_BISIM_UPTO = store_thm ( *) val WEAK_BISIM_UPTO = new_definition ( "WEAK_BISIM_UPTO", - ``WEAK_BISIM_UPTO (Wbsm: ('a, 'b) simulation) = + ``WEAK_BISIM_UPTO (Wbsm: 'a simulation) = !E E'. Wbsm E E' ==> (!l. (!E1. TRANS E (label l) E1 ==> @@ -260,7 +260,7 @@ val IDENTITY_WEAK_BISIM_UPTO = store_thm ( PURE_ONCE_REWRITE_TAC [WEAK_BISIM_UPTO] >> rpt STRIP_TAC (* 4 sub-goals here *) >| [ (* goal 1 (of 4) *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E (label l) E1``)) \\ IMP_RES_TAC TRANS_IMP_WEAK_TRANS \\ Q.EXISTS_TAC `E1` >> art [] \\ @@ -270,7 +270,7 @@ val IDENTITY_WEAK_BISIM_UPTO = store_thm ( Q.EXISTS_TAC `E2` >> art [] \\ REWRITE_TAC [IDENTITY_WEAK_BISIM_UPTO_lemma'], (* goal 3 (of 4) *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E tau E1``)) \\ IMP_RES_TAC ONE_TAU \\ Q.EXISTS_TAC `E1` >> art [] \\ @@ -585,7 +585,7 @@ val WEAK_BISIM_UPTO_THM = store_thm ( >> IMP_RES_TAC WEAK_BISIM_SUBSET_WEAK_EQUIV >> Suff `Wbsm RSUBSET (WEAK_EQUIV O Wbsm O WEAK_EQUIV)` >- ( DISCH_TAC \\ - Know `transitive ((RSUBSET) :('a, 'b) simulation -> ('a, 'b) simulation -> bool)` + Know `transitive ((RSUBSET) :'a simulation -> 'a simulation -> bool)` >- PROVE_TAC [RSUBSET_WeakOrder, WeakOrder] \\ RW_TAC std_ss [transitive_def] >> RES_TAC ) >> KILL_TAC @@ -612,7 +612,7 @@ val WEAK_EQUIV_BY_BISIM_UPTO = store_thm ( corrected Definition 5.8 in the ERRATA (1990) of [1]. *) val WEAK_BISIM_UPTO_ALT = new_definition ( "WEAK_BISIM_UPTO_ALT", - ``WEAK_BISIM_UPTO_ALT (Wbsm: ('a, 'b) simulation) = + ``WEAK_BISIM_UPTO_ALT (Wbsm: 'a simulation) = !E E'. Wbsm E E' ==> (!l. (!E1. WEAK_TRANS E (label l) E1 ==> @@ -779,7 +779,7 @@ val WEAK_BISIM_UPTO_ALT_THM = store_thm ( >> IMP_RES_TAC WEAK_BISIM_SUBSET_WEAK_EQUIV >> Suff `Wbsm RSUBSET (WEAK_EQUIV O Wbsm O WEAK_EQUIV)` >- ( DISCH_TAC \\ - Know `transitive ((RSUBSET) :('a, 'b) simulation -> ('a, 'b) simulation -> bool)` + Know `transitive ((RSUBSET) :'a simulation -> 'a simulation -> bool)` >- PROVE_TAC [RSUBSET_WeakOrder, WeakOrder] \\ RW_TAC std_ss [transitive_def] >> RES_TAC ) >> KILL_TAC @@ -805,7 +805,7 @@ val WEAK_EQUIV_BY_BISIM_UPTO_ALT = store_thm ( (* this work is now useless *) val OBS_BISIM_UPTO = new_definition ( "OBS_BISIM_UPTO", - ``OBS_BISIM_UPTO (Obsm: ('a, 'b) simulation) = + ``OBS_BISIM_UPTO (Obsm: 'a simulation) = !E E'. Obsm E E' ==> !u. (!E1. TRANS E u E1 ==> ?E2. WEAK_TRANS E' u E2 /\ (WEAK_EQUIV O Obsm O STRONG_EQUIV) E1 E2) /\ @@ -833,7 +833,7 @@ val IDENTITY_OBS_BISIM_UPTO = store_thm ( PURE_ONCE_REWRITE_TAC [OBS_BISIM_UPTO] >> rpt STRIP_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 4) *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)) \\ IMP_RES_TAC TRANS_IMP_WEAK_TRANS \\ Q.EXISTS_TAC `E1` >> art [] \\ @@ -1195,16 +1195,16 @@ val OBS_CONGR_BY_BISIM_UPTO = store_thm ( >> irule (REWRITE_RULE [RSUBSET] OBS_BISIM_UPTO_THM) >> Q.EXISTS_TAC `Obsm` >> art []); +val _ = export_theory (); +val _ = html_theory "BisimulationUpto"; + (* Bibliography: * * [1] Milner, R.: Communication and concurrency. (1989). -.* [2] Gorrieri, R., Versari, C.: Introduction to Concurrency Theory. Springer, Cham (2015). - * [3] Sangiorgi, D.: Introduction to Bisimulation and Coinduction. Cambridge University Press (2011). + * [2] Gorrieri, R., Versari, C.: Introduction to Concurrency Theory. Springer, Cham (2015). + * [3] Sangiorgi, D.: Introduction to Bisimulation and Coinduction. + Cambridge University Press (2011). * [4] Sangiorgi, D., Rutten, J.: Advanced Topics in Bisimulation and Coinduction. Cambridge University Press (2011). *) -val _ = export_theory (); -val _ = html_theory "BisimulationUpto"; - -(* last updated: Aug 5, 2017 *) diff --git a/examples/CCS/CCSLib.sml b/examples/CCS/CCSLib.sml index 161a011491..279ac679af 100644 --- a/examples/CCS/CCSLib.sml +++ b/examples/CCS/CCSLib.sml @@ -9,6 +9,8 @@ struct open HolKernel Parse boolLib bossLib; +open hurdUtils; + (******************************************************************************) (* *) (* Backward compatibility and utility tactic/tacticals (2019) *) @@ -19,15 +21,6 @@ open HolKernel Parse boolLib bossLib; fun fix ts = MAP_EVERY Q.X_GEN_TAC ts; (* from HOL Light *) fun unset ts = MAP_EVERY Q.UNABBREV_TAC ts; (* from HOL mizar mode *) fun take ts = MAP_EVERY Q.EXISTS_TAC ts; (* from HOL mizar mode *) -val Know = Q_TAC KNOW_TAC; (* from util_prob *) -val Suff = Q_TAC SUFF_TAC; (* from util_prob *) -fun K_TAC _ = ALL_TAC; (* from util_prob *) -val KILL_TAC = POP_ASSUM_LIST K_TAC; (* from util_prob *) -fun wrap a = [a]; (* from util_prob *) -val art = ASM_REWRITE_TAC; -val Rewr = DISCH_THEN (REWRITE_TAC o wrap); (* from util_prob *) -val Rewr' = DISCH_THEN (ONCE_REWRITE_TAC o wrap); -val POP_ORW = POP_ASSUM (fn thm => ONCE_REWRITE_TAC [thm]); fun PRINT_TAC s gl = (* from cardinalTheory *) (print ("** " ^ s ^ "\n"); ALL_TAC gl); @@ -37,12 +30,6 @@ fun COUNT_TAC tac g = (* from Konrad Slind *) val _ = print ("subgoals: " ^ Int.toString (List.length sg) ^ "\n") in res end; -local - val th = prove (``!a b. a /\ (a ==> b) ==> a /\ b``, PROVE_TAC []) -in - val STRONG_CONJ_TAC :tactic = MATCH_MP_TAC th >> CONJ_TAC -end; - fun NDISJ_TAC n = (NTAC n DISJ2_TAC) >> TRY DISJ1_TAC; (******************************************************************************) @@ -124,11 +111,11 @@ fun STRIP_FORALL_RULE f th = (* The rule EQ_IMP_LR returns the implication from left to right of a given equational theorem. *) -val EQ_IMP_LR = STRIP_FORALL_RULE (fst o EQ_IMP_RULE); +val EQ_IMP_LR = iffLR; (* STRIP_FORALL_RULE (fst o EQ_IMP_RULE); *) (* The rule EQ_IMP_RL returns the implication from right to left of a given equational theorem. *) -val EQ_IMP_RL = STRIP_FORALL_RULE (snd o EQ_IMP_RULE); +val EQ_IMP_RL = iffRL; (* STRIP_FORALL_RULE (snd o EQ_IMP_RULE); *) (* Functions to get the left and right hand side of the equational conclusion of a theorem. *) diff --git a/examples/CCS/CCSScript.sml b/examples/CCS/CCSScript.sml index 1e280a06d3..10b17bb300 100644 --- a/examples/CCS/CCSScript.sml +++ b/examples/CCS/CCSScript.sml @@ -1,63 +1,70 @@ -(* - * Copyright 1991-1995 University of Cambridge (Author: Monica Nesi) - * Copyright 2016-2017 University of Bologna, Italy (Author: Chun Tian) - * Copyright 2018-2019 Fondazione Bruno Kessler, Italy (Author: Chun Tian) - *) +(* ========================================================================== *) +(* FILE : CCSScript.sml *) +(* DESCRIPTION : A formalization of the process algebra CCS in HOL *) +(* *) +(* COPYRIGHTS : 1991-1995 University of Cambridge, UK (Monica Nesi) *) +(* 2016-2017 University of Bologna, Italy (Chun Tian) *) +(* 2018-2019 Fondazione Bruno Kessler, Italy (Chun Tian) *) +(* 2023-2024 The Australian National University (Chun Tian) *) +(******************************************************************************) open HolKernel Parse boolLib bossLib; -open pred_setTheory pred_setLib relationTheory optionTheory listTheory CCSLib; +open pred_setTheory pred_setLib relationTheory optionTheory listTheory CCSLib + rich_listTheory finite_mapTheory; -local open termTheory; in end; (* for SUB's syntax only *) +open generic_termsTheory binderLib nomsetTheory nomdatatype; val _ = new_theory "CCS"; -val lset_ss = std_ss ++ PRED_SET_ss; +val set_ss = std_ss ++ PRED_SET_ss; -(******************************************************************************) -(* *) -(* Labels and Actions *) -(* *) -(******************************************************************************) +(* ---------------------------------------------------------------------- + Labels and Actions + ---------------------------------------------------------------------- *) (* Define the set of labels as the union of names (`in`) (strings) and co-names (`out`) (complement of names) *) -Datatype: Label = name 'b | coname 'b +Datatype: Label = name 'a | coname 'a End (* Define structural induction on labels !P. (!s. P (name s)) /\ (!s. P (coname s)) ==> !L. P L *) -val Label_induction = TypeBase.induction_of ``:'b Label``; +val Label_induction = TypeBase.induction_of ``:'a Label``; (* The structural cases theorem for the type Label !LL. (?s. LL = name s) \/ ?s. LL = coname s *) -val Label_cases = TypeBase.nchotomy_of ``:'b Label``; +val Label_cases = TypeBase.nchotomy_of ``:'a Label``; (* The distinction and injectivity theorems for the type Label !a' a. name a <> coname a' (!a a'. (name a = name a') <=> (a = a')) /\ !a a'. (coname a = coname a') <=> (a = a') *) -val Label_distinct = TypeBase.distinct_of ``:'b Label``; +val Label_distinct = TypeBase.distinct_of ``:'a Label``; val Label_distinct' = save_thm ("Label_distinct'", GSYM Label_distinct); +(* |- !a' a. name a = coname a' <=> F *) val Label_not_eq = save_thm ( "Label_not_eq", STRIP_FORALL_RULE EQF_INTRO Label_distinct); +(* |- !a' a. coname a' = name a <=> F *) val Label_not_eq' = save_thm ( "Label_not_eq'", STRIP_FORALL_RULE (PURE_REWRITE_RULE [SYM_CONV ``name s = coname s'``]) Label_not_eq); -val Label_11 = TypeBase.one_one_of ``:'b Label``; +(* |- (!a a'. name a = name a' <=> a = a') /\ + !a a'. coname a = coname a' <=> a = a' *) +val Label_11 = TypeBase.one_one_of ``:'a Label``; (* NEW: define the set of actions as the OPTION of Label *) -Type Action[pp] = ``:'b Label option``; +Type Action[pp] = ``:'a Label option``; -val _ = overload_on ("tau", ``NONE :'b Action``); -val _ = overload_on ("label", ``SOME :'b Label -> 'b Action``); +val _ = overload_on ("tau", ``NONE :'a Action``); +val _ = overload_on ("label", ``SOME :'a Label -> 'a Action``); val _ = Unicode.unicode_version { u = UnicodeChars.tau, tmnm = "tau" }; val _ = TeX_notation { hol = "tau", TeX = ("\\ensuremath{\\tau}", 1) }; @@ -74,26 +81,26 @@ val _ = TeX_notation { hol = "Out", TeX = ("\\HOLTokenOutputAct", 1) }; !P. P tau /\ (!L. P (label L)) ==> !A. P A *) val Action_induction = save_thm ( - "Action_induction", INST_TYPE [``:'a`` |-> ``:'b Label``] option_induction); + "Action_induction", INST_TYPE [``:'a`` |-> ``:'a Label``] option_induction); (* The structural cases theorem for the type Action !AA. (AA = tau) \/ ?L. AA = label L *) val Action_cases = save_thm ( - "Action_cases", INST_TYPE [``:'a`` |-> ``:'b Label``] option_nchotomy); + "Action_cases", INST_TYPE [``:'a`` |-> ``:'a Label``] option_nchotomy); (* The distinction and injectivity theorems for the type Action !a. tau <> label a !a a'. (label a = label a') <=> (a = a') *) val Action_distinct = save_thm ( - "Action_distinct", INST_TYPE [``:'a`` |-> ``:'b Label``] NOT_NONE_SOME); + "Action_distinct", INST_TYPE [``:'a`` |-> ``:'a Label``] NOT_NONE_SOME); val Action_distinct_label = save_thm ( - "Action_distinct_label", INST_TYPE [``:'a`` |-> ``:'b Label``] NOT_SOME_NONE); + "Action_distinct_label", INST_TYPE [``:'a`` |-> ``:'a Label``] NOT_SOME_NONE); val Action_11 = save_thm ( - "Action_11", INST_TYPE [``:'a`` |-> ``:'b Label``] SOME_11); + "Action_11", INST_TYPE [``:'a`` |-> ``:'a Label``] SOME_11); (* !A. A <> tau ==> ?L. A = label L *) val Action_no_tau_is_Label = save_thm ( @@ -101,43 +108,43 @@ val Action_no_tau_is_Label = save_thm ( Q.GEN `A` (DISJ_IMP (Q.SPEC `A` Action_cases))); (* Extract the label from a visible action, LABEL: Action -> Label. *) -val _ = overload_on ("LABEL", ``THE :'b Label option -> 'b Label``); +val _ = overload_on ("LABEL", ``THE :'a Label option -> 'a Label``); (* |- !x. LABEL (label x) = x *) val LABEL_def = save_thm ( - "LABEL_def", INST_TYPE [``:'a`` |-> ``:'b Label``] THE_DEF); + "LABEL_def", INST_TYPE [``:'a`` |-> ``:'a Label``] THE_DEF); (* |- (!x. IS_SOME (label x) <=> T) /\ (IS_SOME 't <=> F) *) val IS_LABEL_def = save_thm ( - "IS_LABEL_def", INST_TYPE [``:'a`` |-> ``:'b Label``] IS_SOME_DEF); + "IS_LABEL_def", INST_TYPE [``:'a`` |-> ``:'a Label``] IS_SOME_DEF); val _ = export_rewrites ["LABEL_def", "IS_LABEL_def"]; (* Define the complement of a label, COMPL: Label -> Label. *) -val COMPL_LAB_def = Define `(COMPL_LAB (name (s :'b)) = (coname s)) /\ +val COMPL_LAB_def = Define `(COMPL_LAB (name (s :'a)) = (coname s)) /\ (COMPL_LAB (coname s) = (name s))`; val _ = overload_on ("COMPL", ``COMPL_LAB``); val _ = export_rewrites ["COMPL_LAB_def"]; val coname_COMPL = store_thm - ("coname_COMPL", ``!(s :'b). coname s = COMPL (name s)``, + ("coname_COMPL", ``!(s :'a). coname s = COMPL (name s)``, REWRITE_TAC [COMPL_LAB_def]); val COMPL_COMPL_LAB = store_thm ( - "COMPL_COMPL_LAB", ``!(l :'b Label). COMPL_LAB (COMPL_LAB l) = l``, + "COMPL_COMPL_LAB", ``!(l :'a Label). COMPL_LAB (COMPL_LAB l) = l``, Induct >> REWRITE_TAC [COMPL_LAB_def]); (* Extend the complement to actions, COMPL_ACT: Action -> Action. *) val COMPL_ACT_def = Define ` - (COMPL_ACT (label (l: 'b Label)) = label (COMPL l)) /\ + (COMPL_ACT (label (l: 'a Label)) = label (COMPL l)) /\ (COMPL_ACT tau = tau)`; val _ = overload_on ("COMPL", ``COMPL_ACT``); val _ = export_rewrites ["COMPL_ACT_def"]; Theorem COMPL_COMPL_ACT : - !(a :'b Action). COMPL_ACT (COMPL_ACT a) = a + !(a :'a Action). COMPL_ACT (COMPL_ACT a) = a Proof Induct_on `a` >- REWRITE_TAC [COMPL_ACT_def] @@ -146,7 +153,7 @@ QED (* auxiliary theorem about complementary labels. *) Theorem COMPL_THM : - !(l :'b Label) s. (l <> name s ==> COMPL l <> coname s) /\ + !(l :'a Label) s. (l <> name s ==> COMPL l <> coname s) /\ (l <> coname s ==> COMPL l <> name s) Proof Induct_on `l` @@ -160,12 +167,12 @@ Proof REWRITE_TAC [Label_11, COMPL_LAB_def] ] ] QED -(* Relabeling function is subtype of `:'b Label -> 'b Label *) +(* Relabeling function is subtype of `:'a Label -> 'a Label *) val Is_Relabeling_def = Define ` - Is_Relabeling (f: 'b Label -> 'b Label) = (!s. f (coname s) = COMPL (f (name s)))`; + Is_Relabeling (f: 'a Label -> 'a Label) = (!s. f (coname s) = COMPL (f (name s)))`; val EXISTS_Relabeling = store_thm ("EXISTS_Relabeling", - ``?(f: 'b Label -> 'b Label). Is_Relabeling f``, + ``?(f: 'a Label -> 'a Label). Is_Relabeling f``, Q.EXISTS_TAC `\a. a` >> PURE_ONCE_REWRITE_TAC [Is_Relabeling_def] >> BETA_TAC @@ -204,7 +211,7 @@ val [ABS_Relabeling_one_one, ABS_Relabeling_onto, prove_rep_fn_one_one, prove_rep_fn_onto]; Theorem REP_Relabeling_THM : - !rf :'b Relabeling. Is_Relabeling (REP_Relabeling rf) + !rf :'a Relabeling. Is_Relabeling (REP_Relabeling rf) Proof GEN_TAC >> REWRITE_TAC [REP_Relabeling_onto] @@ -214,24 +221,24 @@ QED (* Relabeling labels is extended to actions by renaming tau as tau. *) val relabel_def = Define ` - (relabel (rf :'b Relabeling) tau = tau) /\ + (relabel (rf :'a Relabeling) tau = tau) /\ (relabel rf (label l) = label (REP_Relabeling rf l))`; (* If the renaming of an action is a label, that action is a label. *) Theorem Relab_label : - !(rf :'b Relabeling) u l. (relabel rf u = label l) ==> ?l'. u = label l' + !(rf :'a Relabeling) u l. (relabel rf u = label l) ==> ?l'. u = label l' Proof Induct_on `u` >- REWRITE_TAC [relabel_def, Action_distinct] >> REWRITE_TAC [relabel_def] >> rpt STRIP_TAC - >> EXISTS_TAC ``a :'b Label`` + >> EXISTS_TAC ``a :'a Label`` >> REWRITE_TAC [] QED (* If the renaming of an action is tau, that action is tau. *) Theorem Relab_tau : - !(rf :'b Relabeling) u. (relabel rf u = tau) ==> (u = tau) + !(rf :'a Relabeling) u. (relabel rf u = tau) ==> (u = tau) Proof Induct_on `u` >> REWRITE_TAC [relabel_def, Action_distinct_label] @@ -241,14 +248,14 @@ QED (SND of any pair is a name, FST can be either name or coname) *) val Apply_Relab_def = Define ` - (Apply_Relab ([]: ('b Label # 'b Label) list) l = l) /\ - (Apply_Relab ((newold: 'b Label # 'b Label) :: ls) l = + (Apply_Relab ([]: ('a Label # 'a Label) list) l = l) /\ + (Apply_Relab ((newold: 'a Label # 'a Label) :: ls) l = if (SND newold = l) then (FST newold) else if (COMPL (SND newold) = l) then (COMPL (FST newold)) else (Apply_Relab ls l))`; Theorem Apply_Relab_COMPL_THM : - !labl (s: 'b). Apply_Relab labl (coname s) = + !labl (s: 'a). Apply_Relab labl (coname s) = COMPL (Apply_Relab labl (name s)) Proof Induct >- REWRITE_TAC [Apply_Relab_def, COMPL_LAB_def] @@ -256,13 +263,13 @@ Proof >> REWRITE_TAC [Apply_Relab_def] >> COND_CASES_TAC >- art [Label_distinct', COMPL_LAB_def, COMPL_COMPL_LAB] - >> ASM_CASES_TAC ``SND (h :'b Label # 'b Label) = name s`` + >> ASM_CASES_TAC ``SND (h :'a Label # 'a Label) = name s`` >- art [COMPL_LAB_def] >> IMP_RES_TAC COMPL_THM >> art [] QED Theorem IS_RELABELING : - !labl :('b Label # 'b Label) list. Is_Relabeling (Apply_Relab labl) + !labl :('a Label # 'a Label) list. Is_Relabeling (Apply_Relab labl) Proof Induct >- REWRITE_TAC [Is_Relabeling_def, Apply_Relab_def, COMPL_LAB_def] @@ -271,7 +278,7 @@ Proof >> GEN_TAC >> COND_CASES_TAC >- art [Label_distinct', COMPL_LAB_def, COMPL_COMPL_LAB] - >> ASM_CASES_TAC ``SND (h :'b Label # 'b Label) = name s`` + >> ASM_CASES_TAC ``SND (h :'a Label # 'a Label) = name s`` >- art [COMPL_LAB_def] >> IMP_RES_TAC COMPL_THM >> art [Apply_Relab_COMPL_THM] @@ -281,7 +288,7 @@ QED RELAB: (Label # Label) list -> Relabeling *) val RELAB_def = Define ` - RELAB (labl :('b Label # 'b Label) list) = ABS_Relabeling (Apply_Relab labl)`; + RELAB (labl :('a Label # 'a Label) list) = ABS_Relabeling (Apply_Relab labl)`; (* !labl labl'. (RELAB labl = RELAB labl') <=> (Apply_Relab labl = Apply_Relab labl') @@ -296,155 +303,1429 @@ val APPLY_RELAB_THM = save_thm ( (******************************************************************************) (* *) -(* Syntax of pure CCS ('a, 'b) (general formalization) *) +(* Syntax of pure CCS (general formalization) *) (* *) (******************************************************************************) -(* Define the type of (pure) CCS agent expressions. *) -Datatype: CCS = nil - | var 'a - | prefix ('b Action) CCS - | sum CCS CCS - | par CCS CCS - | restr (('b Label) set) CCS - | relab CCS ('b Relabeling) - | rec 'a CCS -End +(* The (equivalent) old way (no alpha conversion) +Datatype: CCS = nil + | var string + | prefix ('a Action) CCS + | sum CCS CCS + | par CCS CCS + | restr ('a Label set) CCS + | relab CCS ('a Relabeling) + | rec string CCS +End + *) + +(* The new way based on "examples/lambda/basics/generic_termsTheory + + NOTE: it defines “:'a CCS” where 'a is 'b of the old “:('a,'b) CCS”. + *) +val tyname = "CCS"; + +(* ‘GVAR s vv’ corresponds to ‘var 'a’ *) +val vp = “(\n u:unit. n = 0)”; (* 0. var *) + +val rep_t = “:unit + 'a Action + unit + unit + 'a Label set + 'a Relabeling + unit”; +val d_tm = mk_var("d", rep_t); + +(* ‘GLAM v bv ts us’ corresponds to everything else. *) +val lp = + “(\n ^d_tm tns uns. + n = 0 /\ ISL d /\ tns = [] ∧ uns = [] \/ (* 1. nil *) + n = 0 /\ ISR d /\ ISL (OUTR d) /\ tns = [] /\ uns = [0] \/ (* 2. prefix *) + n = 0 /\ ISR d /\ ISR (OUTR d) /\ ISL (OUTR (OUTR d)) /\ + tns = [] /\ uns = [0;0] \/ (* 3. sum *) + n = 0 /\ ISR d /\ ISR (OUTR d) /\ ISR (OUTR (OUTR d)) /\ + ISL (OUTR (OUTR (OUTR d))) /\ + tns = [] /\ uns = [0;0] \/ (* 4. par *) + n = 0 /\ ISR d /\ ISR (OUTR d) /\ ISR (OUTR (OUTR d)) /\ + ISR (OUTR (OUTR (OUTR d))) /\ + ISL (OUTR (OUTR (OUTR (OUTR d)))) /\ + tns = [] ∧ uns = [0] \/ (* 5. restr *) + n = 0 /\ ISR d /\ ISR (OUTR d) /\ ISR (OUTR (OUTR d)) /\ + ISR (OUTR (OUTR (OUTR d))) /\ + ISR (OUTR (OUTR (OUTR (OUTR d)))) /\ + ISL (OUTR (OUTR (OUTR (OUTR (OUTR d))))) /\ + tns = [] /\ uns = [0] \/ (* 6. relab *) + n = 0 /\ ISR d /\ ISR (OUTR d) /\ ISR (OUTR (OUTR d)) /\ + ISR (OUTR (OUTR (OUTR d))) /\ + ISR (OUTR (OUTR (OUTR (OUTR d)))) /\ + ISR (OUTR (OUTR (OUTR (OUTR (OUTR d))))) /\ + tns = [0] ∧ uns = [])”; (* 7. rec *) + +val {term_ABS_pseudo11, term_REP_11, genind_term_REP, genind_exists, + termP, absrep_id, repabs_pseudo_id, term_REP_t, term_ABS_t, newty, ...} = + new_type_step1 tyname 0 {vp = vp, lp = lp}; + +(* ---------------------------------------------------------------------- + CCS operators + ---------------------------------------------------------------------- *) + +val [gvar,glam] = genind_rules |> SPEC_ALL |> CONJUNCTS; + +(* var *) +val var_t = mk_var("var", “:string -> ^newty”) +val var_def = new_definition( + "var_def", “^var_t s = ^term_ABS_t (GVAR s ())”); +val var_termP = prove( + mk_comb(termP, var_def |> SPEC_ALL |> concl |> rhs |> rand), + srw_tac [][genind_rules]); +val var_t = defined_const var_def; + +(* nil *) +val nil_t = mk_var("nil", “:^newty”); +val nil_def = new_definition( + "nil_def", “^nil_t = ^term_ABS_t (GLAM ARB (INL ()) [] [])”); +val nil_termP = prove(“^termP (GLAM x (INL ()) [] [])”, + match_mp_tac glam >> srw_tac [][genind_term_REP]); +val nil_t = defined_const nil_def; +val nil_def' = prove(“^term_ABS_t (GLAM v (INL ()) [] []) = ^nil_t”, + srw_tac [][nil_def, GLAM_NIL_EQ, term_ABS_pseudo11, nil_termP]); + +val _ = TeX_notation { hol = "nil", TeX = ("\\ensuremath{\\mathbf{0}}", 1) }; + +(* prefix *) +val prefix_t = mk_var("prefix", “:'a Action -> ^newty -> ^newty”); +val prefix_def = new_definition( + "prefix_def", + “^prefix_t u E = ^term_ABS_t (GLAM ARB (INR (INL u)) [] [^term_REP_t E])”); +val prefix_termP = prove( + “^termP (GLAM x (INR (INL u)) [] [^term_REP_t E])”, + match_mp_tac glam >> srw_tac [][genind_term_REP]); +val prefix_t = defined_const prefix_def; +val prefix_def' = prove( + “^term_ABS_t (GLAM v (INR (INL u)) [] [^term_REP_t E]) = ^prefix_t u E”, + srw_tac [][prefix_def, GLAM_NIL_EQ, term_ABS_pseudo11, prefix_termP]); + +(* sum *) +val sum_t = mk_var("sum", “:^newty -> ^newty -> ^newty”); +val sum_def = new_definition( + "sum_def", + “^sum_t E1 E2 = ^term_ABS_t (GLAM ARB (INR (INR (INL ()))) [] + [^term_REP_t E1; ^term_REP_t E2])”); +val sum_termP = prove( + “^termP (GLAM x (INR (INR (INL ()))) [] [^term_REP_t E1; ^term_REP_t E2])”, + match_mp_tac glam >> srw_tac [][genind_term_REP]); +val sum_t = defined_const sum_def; +val sum_def' = prove( + “^term_ABS_t (GLAM v (INR (INR (INL ()))) [] + [^term_REP_t E1; ^term_REP_t E2]) = ^sum_t E1 E2”, + srw_tac [][sum_def, GLAM_NIL_EQ, term_ABS_pseudo11, sum_termP]); + +val _ = overload_on ("+", ``sum``); (* priority: 500 *) +val _ = TeX_notation { hol = "+", TeX = ("\\ensuremath{+}", 1) }; + +(* par *) +val par_t = mk_var("par", “:^newty -> ^newty -> ^newty”); +val par_def = new_definition( + "par_def", + “^par_t E1 E2 = ^term_ABS_t (GLAM ARB (INR (INR (INR (INL ())))) [] + [^term_REP_t E1; ^term_REP_t E2])”); +val par_termP = prove( + “^termP (GLAM x (INR (INR (INR (INL ())))) [] + [^term_REP_t E1; ^term_REP_t E2])”, + match_mp_tac glam >> srw_tac [][genind_term_REP]); +val par_t = defined_const par_def; +val par_def' = prove( + “^term_ABS_t (GLAM v (INR (INR (INR (INL ())))) [] + [^term_REP_t E1; ^term_REP_t E2]) = ^par_t E1 E2”, + srw_tac [][par_def, GLAM_NIL_EQ, term_ABS_pseudo11, par_termP]); + +val _ = set_mapped_fixity {fixity = Infixl 600, + tok = "||", term_name = "par"}; + +(* val _ = Unicode.unicode_version {u = UTF8.chr 0x007C, tmnm = "par"}; *) +val _ = TeX_notation { hol = "||", TeX = ("\\ensuremath{\\mid}", 1) }; + +(* restr *) +val restr_t = mk_var("restr", “:'a Label set -> ^newty -> ^newty”); +val restr_def = new_definition( + "restr_def", + “^restr_t L E = ^term_ABS_t (GLAM ARB (INR (INR (INR (INR (INL L))))) [] + [^term_REP_t E])”); +val restr_termP = prove( + “^termP (GLAM x (INR (INR (INR (INR (INL L))))) [] [^term_REP_t E])”, + match_mp_tac glam >> srw_tac [][genind_term_REP]); +val restr_t = defined_const restr_def; +val restr_def' = prove( + “^term_ABS_t (GLAM v (INR (INR (INR (INR (INL L))))) [] [^term_REP_t E]) = + ^restr_t L E”, + srw_tac [][restr_def, GLAM_NIL_EQ, term_ABS_pseudo11, restr_termP]); + +(* compact representation for single-action restriction *) +val _ = overload_on("nu", “λ(n :'a) P. restr {name n} P”); + +val _ = add_rule {term_name = "nu", fixity = Closefix, + pp_elements = [TOK ("(" ^ UnicodeChars.nu), TM, TOK ")"], + paren_style = OnlyIfNecessary, + block_style = (AroundEachPhrase, (PP.INCONSISTENT, 2))}; + +(* relab *) +val relab_t = mk_var("relab", “:^newty -> 'a Relabeling -> ^newty”); +val relab_def = new_definition( + "relab_def", + “^relab_t E rf = + ^term_ABS_t (GLAM ARB (INR (INR (INR (INR (INR (INL rf)))))) [] + [^term_REP_t E])”); +val relab_termP = prove( + “^termP (GLAM x (INR (INR (INR (INR (INR (INL rf)))))) [] [^term_REP_t E])”, + match_mp_tac glam >> srw_tac [][genind_term_REP]); +val relab_t = defined_const relab_def; +val relab_def' = prove( + “^term_ABS_t (GLAM v (INR (INR (INR (INR (INR (INL rf)))))) [] + [^term_REP_t E]) = + ^relab_t E rf”, + srw_tac [][relab_def, GLAM_NIL_EQ, term_ABS_pseudo11, relab_termP]); + +(* rec *) +val rec_t = mk_var("rec", “:string -> ^newty -> ^newty”); +val rec_def = new_definition( + "rec_def", + “^rec_t X E = + ^term_ABS_t (GLAM X (INR (INR (INR (INR (INR (INR ())))))) + [^term_REP_t E] [])”); +val rec_termP = prove( + “^termP (GLAM X (INR (INR (INR (INR (INR (INR ())))))) [^term_REP_t E] [])”, + match_mp_tac glam >> srw_tac [][genind_term_REP]); +val rec_t = defined_const rec_def; + +val _ = + add_rule { term_name = "prefix", fixity = Infixr 700, + pp_elements = [ BreakSpace(0,0), TOK "..", BreakSpace(0,0) ], + paren_style = OnlyIfNecessary, + block_style = (AroundSamePrec, (PP.CONSISTENT, 0)) }; + +val _ = TeX_notation { hol = "..", TeX = ("\\ensuremath{\\ldotp}", 1) }; + +(* ---------------------------------------------------------------------- + tpm (permutation of CCS recursion variables) + ---------------------------------------------------------------------- *) + +val cons_info = + [{con_termP = var_termP, con_def = var_def}, + {con_termP = nil_termP, con_def = SYM nil_def'}, + {con_termP = prefix_termP, con_def = SYM prefix_def'}, + {con_termP = sum_termP, con_def = SYM sum_def'}, + {con_termP = par_termP, con_def = SYM par_def'}, + {con_termP = restr_termP, con_def = SYM restr_def'}, + {con_termP = relab_termP, con_def = SYM relab_def'}, + {con_termP = rec_termP, con_def = rec_def}]; + +val tpm_name_pfx = "t"; +val {tpm_thm, term_REP_tpm, t_pmact_t, tpm_t} = + define_permutation {name_pfx = tpm_name_pfx, name = tyname, + term_REP_t = term_REP_t, + term_ABS_t = term_ABS_t, + absrep_id = absrep_id, + repabs_pseudo_id = repabs_pseudo_id, + cons_info = cons_info, newty = newty, + genind_term_REP = genind_term_REP}; + +Theorem tpm_eqr : + t = tpm pi u <=> tpm (REVERSE pi) t = (u :'a CCS) +Proof + METIS_TAC [pmact_inverse] +QED + +Theorem tpm_eql : + tpm pi t = u <=> t = tpm (REVERSE pi) (u :'a CCS) +Proof + simp[tpm_eqr] +QED + +Theorem tpm_CONS : + tpm ((x,y)::pi) (t :'a CCS) = tpm [(x,y)] (tpm pi t) +Proof + SRW_TAC [][GSYM pmact_decompose] +QED + +(* ---------------------------------------------------------------------- + support and FV + ---------------------------------------------------------------------- *) + +val term_REP_eqv = prove( + “support (fn_pmact ^t_pmact_t gt_pmact) ^term_REP_t {}”, + srw_tac [][support_def, fnpm_def, FUN_EQ_THM, term_REP_tpm, pmact_sing_inv]); + +val supp_term_REP = prove( + “supp (fn_pmact ^t_pmact_t gt_pmact) ^term_REP_t = {}”, + REWRITE_TAC [GSYM SUBSET_EMPTY] + >> MATCH_MP_TAC (GEN_ALL supp_smallest) + >> srw_tac [][term_REP_eqv]); + +val tpm_def' = + term_REP_tpm |> AP_TERM term_ABS_t |> PURE_REWRITE_RULE [absrep_id]; + +val t = mk_var("t", newty); + +val supptpm_support = prove( + “support ^t_pmact_t ^t (supp gt_pmact (^term_REP_t ^t))”, + srw_tac [][support_def, tpm_def', supp_fresh, absrep_id]); + +val supptpm_apart = prove( + “x IN supp gt_pmact (^term_REP_t ^t) /\ y NOTIN supp gt_pmact (^term_REP_t ^t) + ==> ^tpm_t [(x,y)] ^t <> ^t”, + srw_tac [][tpm_def'] + >> DISCH_THEN (MP_TAC o AP_TERM term_REP_t) + >> srw_tac [][repabs_pseudo_id, genind_gtpm_eqn, genind_term_REP, supp_apart]); + +val supp_tpm = prove( + “supp ^t_pmact_t ^t = supp gt_pmact (^term_REP_t ^t)”, + match_mp_tac (GEN_ALL supp_unique_apart) + >> srw_tac [][supptpm_support, supptpm_apart, FINITE_GFV]); + +val _ = overload_on ("FV", “supp ^t_pmact_t”); + +val _ = set_fixity "#" (Infix(NONASSOC, 450)); +val _ = overload_on ("#", “\X (E :'a CCS). X NOTIN FV E”); + +Theorem FINITE_FV[simp] : + FINITE (FV (t :'a CCS)) +Proof + srw_tac [][supp_tpm, FINITE_GFV] +QED + +Theorem FV_EMPTY : + FV t = {} <=> !v. v NOTIN FV (t :'a CCS) +Proof + SIMP_TAC (srw_ss()) [EXTENSION] +QED + +fun supp_clause {con_termP, con_def} = let + val t = mk_comb(“supp ^t_pmact_t”, lhand (concl (SPEC_ALL con_def))) +in + t |> REWRITE_CONV [supp_tpm, con_def, MATCH_MP repabs_pseudo_id con_termP, + GFV_thm] + |> REWRITE_RULE [supp_listpm, EMPTY_DELETE, UNION_EMPTY] + |> REWRITE_RULE [GSYM supp_tpm] + |> GEN_ALL +end + +Theorem FV_thm[simp] = LIST_CONJ (map supp_clause cons_info) +Theorem FV_def = FV_thm + +val [FV_var, FV_nil, FV_prefix, FV_sum, FV_par, + FV_restr, FV_relab, FV_rec] = + map save_thm + (combine (["FV_var", "FV_nil", "FV_prefix", "FV_sum", "FV_par", + "FV_restr", "FV_relab", "FV_rec"], CONJUNCTS FV_thm)); + +(* |- !x t p. x IN FV (tpm p t) <=> lswapstr (REVERSE p) x IN FV t *) +Theorem FV_tpm[simp] = “x IN FV (tpm p (t :'a CCS))” + |> REWRITE_CONV [perm_supp, pmact_IN] + |> GEN_ALL + +(* ---------------------------------------------------------------------- + term induction + ---------------------------------------------------------------------- *) + +fun genit th = let + val (_, args) = strip_comb (concl th) + val (tm, x) = case args of [x,y] => (x,y) | _ => raise Fail "Bind" + val ty = type_of tm + val t = mk_var("t", ty) +in + th |> INST [tm |-> t] |> GEN x |> GEN t +end + +val LIST_REL_CONS1 = listTheory.LIST_REL_CONS1; +val LIST_REL_NIL = listTheory.LIST_REL_NIL; + +val term_ind = + bvc_genind + |> INST_TYPE [alpha |-> rep_t, beta |-> “:unit”] + |> Q.INST [‘vp’ |-> ‘^vp’, ‘lp’ |-> ‘^lp’] + |> SIMP_RULE std_ss [LIST_REL_CONS1, RIGHT_AND_OVER_OR, + LEFT_AND_OVER_OR, DISJ_IMP_THM, LIST_REL_NIL] + |> Q.SPECL [‘\n t0 x. Q t0 x’, ‘fv’] + |> UNDISCH |> Q.SPEC ‘0’ |> DISCH_ALL + |> SIMP_RULE (std_ss ++ DNF_ss) + [sumTheory.FORALL_SUM, supp_listpm, + IN_UNION, NOT_IN_EMPTY, oneTheory.FORALL_ONE, + genind_exists, LIST_REL_CONS1, LIST_REL_NIL] + |> Q.INST [‘Q’ |-> ‘\t. P (^term_ABS_t t)’] + |> SIMP_RULE std_ss [GSYM var_def, GSYM nil_def, nil_def', prefix_def', + sum_def', par_def', restr_def', relab_def', + GSYM rec_def, absrep_id] + |> SIMP_RULE (srw_ss()) [GSYM supp_tpm] + |> elim_unnecessary_atoms {finite_fv = FINITE_FV} + [ASSUME “!x:'c. FINITE (fv x:string set)”] + |> SPEC_ALL |> UNDISCH + |> genit |> DISCH_ALL |> Q.GENL [‘P’, ‘fv’]; + +fun mkX_ind th = th |> Q.SPECL [‘\t x. Q t’, ‘\x. X’] + |> SIMP_RULE std_ss [] |> Q.GEN ‘X’ + |> Q.INST [‘Q’ |-> ‘P’] |> Q.GEN ‘P’; + +(* NOTE: not recommended unless in generated theorems *) +Theorem nc_INDUCTION[local] = mkX_ind term_ind + +(* The recommended induction theorem containing correctly named + binding variables (L, rf, y, etc.) + *) +Theorem nc_INDUCTION2 : + !P X. + (!s. P (var s)) /\ P nil /\ (!u E. P E ==> P (u..E)) /\ + (!E1 E2. P E1 /\ P E2 ==> P (E1 + E2)) /\ + (!E1 E2. P E1 /\ P E2 ==> P (E1 || E2)) /\ + (!L E. P E ==> P (restr L E)) /\ + (!E rf. P E ==> P (relab E rf)) /\ + (!y E. P E /\ y NOTIN X ==> P (rec y E)) /\ FINITE X ==> + !t. P t +Proof + rpt STRIP_TAC + >> MATCH_MP_TAC nc_INDUCTION + >> Q.EXISTS_TAC ‘X’ >> rw [] +QED + +Theorem simple_induction = + nc_INDUCTION2 |> Q.SPECL [‘P’, ‘{}’] + |> REWRITE_RULE [FINITE_EMPTY, NOT_IN_EMPTY] + |> Q.GEN ‘P’ + +Theorem rec_eq_thm = + “(rec u t1 = rec v t2 :'a CCS)” + |> SIMP_CONV (srw_ss()) [rec_def, rec_termP, term_ABS_pseudo11, + GLAM_eq_thm, term_REP_11, GSYM term_REP_tpm, + GSYM supp_tpm] + |> Q.GENL [‘u’, ‘v’, ‘t1’, ‘t2’] + +Theorem tpm_ALPHA : + v # (u :'a CCS) ==> rec x u = rec v (tpm [(v,x)] u) +Proof + SRW_TAC [boolSimps.CONJ_ss][rec_eq_thm, pmact_flip_args] +QED + +(* ---------------------------------------------------------------------- + term recursion + ---------------------------------------------------------------------- *) + +val (_, repty) = dom_rng (type_of term_REP_t); +val repty' = ty_antiq repty; + +val termP_elim = prove( + “(!g. ^termP g ==> P g) <=> (!t. P (^term_REP_t t))”, + srw_tac [][EQ_IMP_THM] >- srw_tac [][genind_term_REP] + >> first_x_assum (qspec_then ‘^term_ABS_t g’ mp_tac) + >> srw_tac [][repabs_pseudo_id]); + +val termP_removal = + nomdatatype.termP_removal { + elimth = termP_elim, absrep_id = absrep_id, + tpm_def = AP_TERM term_ABS_t term_REP_tpm |> REWRITE_RULE [absrep_id], + termP = termP, repty = repty}; + +val termP0 = prove( + “genind ^vp ^lp n t <=> ^termP t ∧ (n = 0)”, + EQ_TAC >> simp_tac (srw_ss()) [] >> strip_tac + >> qsuff_tac ‘n = 0’ >- (strip_tac >> srw_tac [][]) + >> pop_assum mp_tac + >> Q.ISPEC_THEN ‘t’ STRUCT_CASES_TAC gterm_cases + >> srw_tac [][genind_GVAR, genind_GLAM_eqn]); + +(* “tvf :string -> 'q -> 'r” *) +val tvf = “λ(s:string) (u:unit) (p:ρ). tvf s p : 'r”; (* var *) + +(* Type of constants occurring in tlf: + + nil: “tnf :'q -> 'r” + prefix: “tff :('q -> 'r) -> 'a Action -> 'a CCS -> 'q -> 'r” + sum: “tsf :('q -> 'r) -> ('q -> 'r) -> 'a CCS -> 'a CCS -> 'q -> 'r” + par: “tpf :('q -> 'r) -> ('q -> 'r) -> 'a CCS -> 'a CCS -> 'q -> 'r” + restr: “trf :('q -> 'r) -> ('a Label -> bool) -> 'a CCS -> 'q -> 'r” + relab: “tlf :('q -> 'r) -> 'a CCS -> 'a Relabeling -> 'q -> 'r” + rec: “tcf :('q -> 'r) -> string -> 'a CCS -> 'q -> 'r” + *) +val u_tm = mk_var("u", rep_t); +val tlf = + “λ(v:string) ^u_tm (ds1:('q -> 'r) list) (ds2:('q -> 'r) list) + (ts1:^repty' list) (ts2:^repty' list) (p :'q). + if ISL u then + tnf p :'r + else if ISL (OUTR u) then + tff (HD ds2) (OUTL (OUTR u)) (^term_ABS_t (HD ts2)) p :'r + else if ISL (OUTR (OUTR u)) then + tsf (HD ds2) (HD (TL ds2)) + (^term_ABS_t (HD ts2)) (^term_ABS_t (HD (TL ts2))) p :'r + else if ISL (OUTR (OUTR (OUTR u))) then + tpf (HD ds2) (HD (TL ds2)) + (^term_ABS_t (HD ts2)) (^term_ABS_t (HD (TL ts2))) p :'r + else if ISL (OUTR (OUTR (OUTR (OUTR u)))) then + trf (HD ds2) (OUTL (OUTR (OUTR (OUTR (OUTR u))))) + (^term_ABS_t (HD ts2)) p :'r + else if ISL (OUTR (OUTR (OUTR (OUTR (OUTR u))))) then + tlf (HD ds2) (^term_ABS_t (HD ts2)) + (OUTL (OUTR (OUTR (OUTR (OUTR (OUTR u)))))) p :'r + else + tcf (HD ds1) v (^term_ABS_t (HD ts1)) p :'r”; + +Theorem parameter_tm_recursion = + parameter_gtm_recursion + |> INST_TYPE [alpha |-> rep_t, beta |-> “:unit”, gamma |-> “:'r”] + |> Q.INST [‘lf’ |-> ‘^tlf’, ‘vf’ |-> ‘^tvf’, ‘vp’ |-> ‘^vp’, + ‘lp’ |-> ‘^lp’, ‘n’ |-> ‘0’] + |> SIMP_RULE (srw_ss()) [sumTheory.FORALL_SUM, FORALL_AND_THM, + GSYM RIGHT_FORALL_IMP_THM, IMP_CONJ_THM, + GSYM RIGHT_EXISTS_AND_THM, + GSYM LEFT_EXISTS_AND_THM, + GSYM LEFT_FORALL_IMP_THM, + LIST_REL_CONS1, genind_GVAR, + genind_GLAM_eqn, sidecond_def, + NEWFCB_def, relsupp_def, + LENGTH_NIL_SYM, LENGTH1, LENGTH2] + |> ONCE_REWRITE_RULE [termP0] + |> SIMP_RULE (srw_ss() ++ DNF_ss) [LENGTH1, LENGTH2, LENGTH_NIL] + |> CONV_RULE (DEPTH_CONV termP_removal) + |> SIMP_RULE (srw_ss()) [GSYM supp_tpm, SYM term_REP_tpm] + |> UNDISCH + |> rpt_hyp_dest_conj + |> lift_exfunction {repabs_pseudo_id = repabs_pseudo_id, + term_REP_t = term_REP_t, + cons_info = cons_info} + |> DISCH_ALL + |> elim_unnecessary_atoms {finite_fv = FINITE_FV} + [ASSUME ``FINITE (A:string set)``, + ASSUME ``!p:ρ. FINITE (supp ppm p)``] + |> UNDISCH_ALL |> DISCH_ALL + |> REWRITE_RULE [AND_IMP_INTRO] + |> CONV_RULE (LAND_CONV (REWRITE_CONV [GSYM CONJ_ASSOC])) + |> Q.INST [‘tvf’ |-> ‘vr’, (* var *) + ‘tnf’ |-> ‘nl’, (* nil *) + ‘tff’ |-> ‘pf’, (* prefix *) + ‘tsf’ |-> ‘sm’, (* sum *) + ‘tpf’ |-> ‘pr’, (* par *) + ‘trf’ |-> ‘rs’, (* restr *) + ‘tlf’ |-> ‘rl’, (* relab *) + ‘tcf’ |-> ‘re’, (* rec *) + ‘dpm’ |-> ‘apm’] + |> CONV_RULE (REDEPTH_CONV sort_uvars) + +val FORALL_ONE = oneTheory.FORALL_ONE; +val FORALL_ONE_FN = oneTheory.FORALL_ONE_FN; +val EXISTS_ONE_FN = oneTheory.EXISTS_ONE_FN; + +Theorem tm_recursion = + parameter_tm_recursion + |> Q.INST_TYPE [‘:'q’ |-> ‘:unit’] + |> Q.INST [‘ppm’ |-> ‘discrete_pmact’, + ‘vr’ |-> ‘\s u. vru s’, + ‘nl’ |-> ‘\u. nlu’, + ‘pf’ |-> ‘\r a t u. pfu (r()) a t’, + ‘sm’ |-> ‘\r1 r2 t1 t2 u. smu (r1()) (r2()) t1 t2’, + ‘pr’ |-> ‘\r1 r2 t1 t2 u. pru (r1()) (r2()) t1 t2’, + ‘rs’ |-> ‘\r L t u. rsu (r()) L t’, + ‘rl’ |-> ‘\r t rf u. rlu (r()) t rf’, + ‘re’ |-> ‘\r v t u. reu (r()) v t’] + |> SIMP_RULE (srw_ss()) [FORALL_ONE, FORALL_ONE_FN, EXISTS_ONE_FN, + fnpm_def] + |> SIMP_RULE (srw_ss() ++ CONJ_ss) [supp_unitfn] + |> Q.INST [‘vru’ |-> ‘vr’, + ‘nlu’ |-> ‘nl’, + ‘pfu’ |-> ‘pf’, + ‘smu’ |-> ‘sm’, + ‘pru’ |-> ‘pr’, + ‘rsu’ |-> ‘rs’, + ‘rlu’ |-> ‘rl’, + ‘reu’ |-> ‘re’] + +(* ---------------------------------------------------------------------- + cases, distinct and one-one theorems + ---------------------------------------------------------------------- *) + +Theorem CCS_cases : + !t. (t :'a CCS) = nil \/ (?a. t = var a) \/ (?u E. t = prefix u E) \/ + (?E1 E2. t = sum E1 E2) \/ (?E1 E2. t = par E1 E2) \/ + (?L E. t = restr L E) \/ (?E rf. t = relab E rf) \/ + ?X E. t = rec X E +Proof + HO_MATCH_MP_TAC simple_induction + >> SRW_TAC [][] (* 161 subgoals here *) + >> METIS_TAC [] +QED + +Theorem CCS_distinct[simp] : + (nil <> var X :'a CCS) /\ + (nil <> prefix u E :'a CCS) /\ + (nil <> E1 + E2 :'a CCS) /\ + (nil <> E1 || E2 :'a CCS) /\ + (nil <> restr L E :'a CCS) /\ + (nil <> relab E rf :'a CCS) /\ + (nil <> rec X E :'a CCS) /\ + (var X <> prefix u E :'a CCS) /\ + (var X <> E1 + E2 :'a CCS) /\ + (var X <> E1 || E2 :'a CCS) /\ + (var X <> restr L E :'a CCS) /\ + (var X <> relab E rf :'a CCS) /\ + (var X <> rec Y E :'a CCS) /\ + (prefix u E <> E1 + E2 :'a CCS) /\ + (prefix u E <> E1 || E2 :'a CCS) /\ + (prefix u E <> restr L E' :'a CCS) /\ + (prefix u E <> relab E' rf :'a CCS) /\ + (prefix u E <> rec X E' :'a CCS) /\ + (E1 + E2 <> E3 || E4 :'a CCS) /\ + (E1 + E2 <> restr L E :'a CCS) /\ + (E1 + E2 <> relab E rf :'a CCS) /\ + (E1 + E2 <> rec X E :'a CCS) /\ + (E1 || E2 <> (restr L) E :'a CCS) /\ + (E1 || E2 <> relab E rf :'a CCS) /\ + (E1 || E2 <> rec X E :'a CCS) /\ + (restr L E <> relab E' rf :'a CCS) /\ + (restr L E <> rec X E' :'a CCS) /\ + relab E rf <> rec X E' :'a CCS +Proof + rw [nil_def, nil_termP, var_def, var_termP, prefix_def, prefix_termP, + sum_def, sum_termP, par_def, par_termP, restr_def, restr_termP, + relab_def, relab_termP, rec_def, rec_termP, + term_ABS_pseudo11, gterm_distinct, GLAM_eq_thm] +QED + +local + val thm = CONJUNCTS CCS_distinct; + val CCS_distinct_LIST = thm @ (map GSYM thm); +in + val CCS_distinct' = save_thm + ("CCS_distinct'", LIST_CONJ CCS_distinct_LIST); +end + +Theorem CCS_distinct_exists : + !(p :'a CCS). ?q. q <> p +Proof + Q.X_GEN_TAC ‘p’ + >> MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] + >- (Q.EXISTS_TAC ‘nil + nil’ >> rw [CCS_distinct']) + >> Q.EXISTS_TAC ‘nil’ + >> rw [CCS_distinct] +QED + +Theorem CCS_distinct_exists_FV : + !X (p :'a CCS). ?q. q <> p /\ DISJOINT (FV q) X +Proof + rw [] + >> MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] + >- (Q.EXISTS_TAC ‘prefix a nil’ >> rw [CCS_distinct']) + >> Q.EXISTS_TAC ‘nil’ + >> rw [CCS_distinct] +QED + +(* cf. rec_eq_thm for “rec X E = rec X' E'” *) +Theorem CCS_one_one[simp] : + (!X X'. var X = var X' :'a CCS <=> X = X') /\ + (!u E u' E' :'a CCS. prefix u E = prefix u' E' <=> u = u' /\ E = E') /\ + (!E1 E2 E1' E2' :'a CCS. E1 + E2 = E1' + E2' <=> E1 = E1' /\ E2 = E2') /\ + (!E1 E2 E1' E2' :'a CCS. E1 || E2 = E1' || E2' <=> E1 = E1' /\ E2 = E2') /\ + (!L E L' E' :'a CCS. restr L E = restr L' E' <=> L = L' /\ E = E') /\ + (!(E :'a CCS) rf E' rf'. relab E rf = relab E' rf' <=> E = E' /\ rf = rf') +Proof + srw_tac [] [nil_def, nil_termP, var_def, var_termP, + prefix_def, prefix_termP, sum_def, sum_termP, + par_def, par_termP, restr_def, restr_termP, + relab_def, relab_termP, + term_ABS_pseudo11, gterm_11, term_REP_11] + >> rw [Once CONJ_COMM] +QED + +Theorem sum_acyclic : + !t1 t2 :'a CCS. t1 <> t1 + t2 /\ t1 <> t2 + t1 +Proof + HO_MATCH_MP_TAC simple_induction >> SRW_TAC [][] +QED + +Theorem par_acyclic : + !t1 t2 :'a CCS. t1 <> t1 || t2 /\ t1 <> t2 || t1 +Proof + HO_MATCH_MP_TAC simple_induction >> SRW_TAC [][] +QED + +Theorem FORALL_TERM : + (!(t :'a CCS). P t) <=> + P nil /\ (!s. P (var s)) /\ (!u t. P (prefix u t)) /\ + (!t1 t2. P (t1 + t2)) /\ (!t1 t2. P (t1 || t2)) /\ + (!L t. P (restr L t)) /\ (!t rf. P (relab t rf)) /\ + (!v t. P (rec v t)) +Proof + EQ_TAC >> SRW_TAC [][] + >> Q.SPEC_THEN ‘t’ STRUCT_CASES_TAC CCS_cases >> SRW_TAC [][] +QED + +(* ---------------------------------------------------------------------- + Establish substitution function + ---------------------------------------------------------------------- *) + +Theorem tpm_COND[local] : + tpm pi (if P then x else y) = if P then tpm pi x else tpm pi y +Proof + SRW_TAC [][] +QED + +Theorem tpm_apart : + !(t :'a CCS). x NOTIN FV t /\ y IN FV t ==> tpm [(x,y)] t <> t +Proof + metis_tac[supp_apart, pmact_flip_args] +QED + +Theorem tpm_fresh : + !(t :'a CCS) x y. x NOTIN FV t /\ y NOTIN FV t ==> tpm [(x,y)] t = t +Proof + srw_tac [][supp_fresh] +QED + +val rewrite_pairing = prove( + “(?f: 'a CCS -> (string # 'a CCS) -> 'a CCS. P f) <=> + (?f: 'a CCS -> string -> 'a CCS -> 'a CCS. P (\M (x,N). f N x M))”, + EQ_TAC >> strip_tac >| [ + qexists_tac ‘\N x M. f M (x,N)’ >> srw_tac [][] \\ + CONV_TAC (DEPTH_CONV pairLib.PAIRED_ETA_CONV) \\ + srw_tac [ETA_ss][], + qexists_tac ‘\M (x,N). f N x M’ >> srw_tac [][] + ]); + +val subst_exists = + parameter_tm_recursion + |> INST_TYPE [“:'r” |-> “:'a CCS”, + “:'q” |-> “:string # 'a CCS”] + |> SPEC_ALL + |> Q.INST [‘A’ |-> ‘{}’, ‘apm’ |-> ‘^t_pmact_t’, + ‘ppm’ |-> ‘pair_pmact string_pmact ^t_pmact_t’, + ‘vr’ |-> ‘\s (x,N). if s = x then N else var s’, + ‘nl’ |-> ‘\r. nil’, + ‘pf’ |-> ‘\r x t p. prefix x (r p)’, + ‘sm’ |-> ‘\r1 r2 t1 t2 p. r1 p + r2 p’, + ‘pr’ |-> ‘\r1 r2 t1 t2 p. r1 p || r2 p’, + ‘rs’ |-> ‘\r L t p. restr L (r p)’, + ‘rl’ |-> ‘\r t rf p. relab (r p) rf’, + ‘re’ |-> ‘\r s t p. rec s (r p)’] + |> CONV_RULE (LAND_CONV (SIMP_CONV (srw_ss()) [pairTheory.FORALL_PROD])) + |> SIMP_RULE (srw_ss()) [support_def, FUN_EQ_THM, fnpm_def, + tpm_COND, tpm_fresh, pmact_sing_inv, + basic_swapTheory.swapstr_eq_left] + |> SIMP_RULE (srw_ss()) [rewrite_pairing, pairTheory.FORALL_PROD] + |> CONV_RULE (DEPTH_CONV (rename_vars [("p_1", "u"), ("p_2", "E")])) + |> prove_alpha_fcbhyp {ppm = ``pair_pmact string_pmact ^t_pmact_t``, + rwts = [], + alphas = [tpm_ALPHA]}; + +val SUB_DEF = new_specification("SUB_DEF", ["SUB"], subst_exists); + +val _ = add_rule {term_name = "SUB", fixity = Closefix, + pp_elements = [TOK "[", TM, TOK "/", TM, TOK "]"], + paren_style = OnlyIfNecessary, + block_style = (AroundEachPhrase, (PP.INCONSISTENT, 2))}; + +val _ = TeX_notation { hol = "[", TeX = ("\\ensuremath{[}", 1) }; +val _ = TeX_notation { hol = "/", TeX = ("\\ensuremath{/}", 1) }; +val _ = TeX_notation { hol = "]", TeX = ("\\ensuremath{]}", 1) }; + +val SUB_THMv = prove( + “([N/x](var x) = (N :'a CCS)) /\ (x <> y ==> [N/y](var x) = var x)”, + SRW_TAC [][SUB_DEF]); + +val SUB_COMM = prove( + “!N x x' y (t :'a CCS). + x' <> x /\ x' # N ∧ y <> x /\ y # N ==> + (tpm [(x',y)] ([N/x] t) = [N/x] (tpm [(x',y)] t))”, + srw_tac [][SUB_DEF, supp_fresh]); + +val SUB_THM = save_thm("SUB_THM", + let val (eqns,_) = CONJ_PAIR SUB_DEF + in + CONJ (REWRITE_RULE [GSYM CONJ_ASSOC] + (LIST_CONJ (SUB_THMv :: tl (CONJUNCTS eqns)))) + SUB_COMM + end); +val _ = export_rewrites ["SUB_THM"]; + +(* |- !Y X E. [E/X] (var Y) = if Y = X then E else var Y *) +Theorem SUB_VAR = hd (CONJUNCTS SUB_DEF) |> Q.SPECL [‘Y’, ‘X’] |> GEN_ALL + +(* |- !Y X E' E. Y <> X /\ Y # E' ==> [E'/X] (rec Y E) = rec Y ([E'/X] E) *) +Theorem SUB_REC = List.nth (CONJUNCTS SUB_DEF, 7) + |> Q.SPECL [‘Y’, ‘X’, ‘E'’, ‘E’] |> GEN_ALL + +(* ---------------------------------------------------------------------- + Results about substitution + ---------------------------------------------------------------------- *) + +Theorem fresh_tpm_subst : + !t. u # (t :'a CCS) ==> (tpm [(u,v)] t = [var u/v] t) +Proof + HO_MATCH_MP_TAC nc_INDUCTION >> Q.EXISTS_TAC ‘{u;v}’ + >> SRW_TAC [][SUB_THM, SUB_VAR] +QED + +Theorem tpm_subst : + !N :'a CCS. tpm pi ([M/v] N) = [tpm pi M/lswapstr pi v] (tpm pi N) +Proof + HO_MATCH_MP_TAC nc_INDUCTION + >> Q.EXISTS_TAC ‘v INSERT FV M’ + >> SRW_TAC [][SUB_THM, SUB_VAR] +QED + +Theorem tpm_subst_out : + [M/v] (tpm pi (N :'a CCS)) = + tpm pi ([tpm (REVERSE pi) M/lswapstr (REVERSE pi) v] N) +Proof + SRW_TAC [][tpm_subst] +QED + +Theorem lemma14a[simp] : + !t. [var v/v] t = (t :'a CCS) +Proof + HO_MATCH_MP_TAC nc_INDUCTION >> Q.EXISTS_TAC ‘{v}’ + >> SRW_TAC [][SUB_THM, SUB_VAR] +QED + +Theorem lemma14b : + !M. v # M ==> [N/v] M = (M :'a CCS) +Proof + HO_MATCH_MP_TAC nc_INDUCTION >> Q.EXISTS_TAC ‘v INSERT FV N’ + >> SRW_TAC [][SUB_THM, SUB_VAR] +QED + +(* Note: this is the opposite direction of lemma14b *) +Theorem SUB_FIX_IMP_NOTIN_FV : + !x t. (!u. [u/x] t = t) ==> x NOTIN FV t +Proof + rpt GEN_TAC + >> Suff ‘(?u. u # t /\ [var u/x] t = t) ==> x # t’ + >- (rw [] \\ + FIRST_X_ASSUM MATCH_MP_TAC \\ + Q_TAC (NEW_TAC "z") ‘FV t’ \\ + Q.EXISTS_TAC ‘z’ >> rw []) + >> simp [PULL_EXISTS] + >> Q.X_GEN_TAC ‘u’ + >> Q.ID_SPEC_TAC ‘t’ + >> HO_MATCH_MP_TAC nc_INDUCTION + >> Q.EXISTS_TAC ‘{x;u}’ >> rw [rec_eq_thm] + >> CCONTR_TAC >> fs [] +QED + +Theorem lemma14b_ext1 : + !v M. v # M <=> !N. ([N/v] M = M) +Proof + rpt GEN_TAC + >> EQ_TAC >- rw [lemma14b] + >> DISCH_TAC + >> rw [SUB_FIX_IMP_NOTIN_FV] +QED + +Theorem SUB_EQ_IMP_NOTIN_FV : + !x t. (!t1 t2. [t1/x] t = [t2/x] t) ==> x NOTIN FV t +Proof + rpt GEN_TAC + >> Suff ‘(?u u'. u <> u' /\ u # t /\ u' # t /\ + [var u/x] t = [var u'/x] t) ==> x # t’ + >- (rw [] \\ + FIRST_X_ASSUM MATCH_MP_TAC \\ + Q_TAC (NEW_TAC "z") ‘FV t’ \\ + Q.EXISTS_TAC ‘z’ >> rw [] \\ + Q_TAC (NEW_TAC "z'") ‘{z} UNION FV t’ \\ + Q.EXISTS_TAC ‘z'’ >> rw []) + >> simp [PULL_EXISTS] + >> rpt GEN_TAC + >> Q.ID_SPEC_TAC ‘t’ + >> HO_MATCH_MP_TAC nc_INDUCTION + >> Q.EXISTS_TAC ‘{x;u;u'}’ >> rw [rec_eq_thm] + >> CCONTR_TAC >> fs [] +QED + +Theorem lemma14b_ext2 : + !v M. v # M <=> !N1 N2. [N1/v] M = [N2/v] M +Proof + rpt GEN_TAC + >> EQ_TAC >- rw [lemma14b] + >> rw [SUB_EQ_IMP_NOTIN_FV] +QED + +Theorem lemma14c : + !t x u :'a CCS. x IN FV u ==> (FV ([t/x]u) = FV t UNION (FV u DELETE x)) +Proof + NTAC 2 GEN_TAC + >> HO_MATCH_MP_TAC nc_INDUCTION + >> Q.EXISTS_TAC ‘x INSERT FV t’ + >> SRW_TAC [][SUB_THM, SUB_VAR, EXTENSION] + >> METIS_TAC [lemma14b] +QED + +Theorem FV_SUB : + !(t :'a CCS) u v. FV ([t/v] u) = + if v IN FV u then FV t UNION (FV u DELETE v) else FV u +Proof + PROVE_TAC [lemma14b, lemma14c] +QED + +Theorem lemma15a : + !M :'a CCS. v # M ==> [N/v] ([var v/x] M) = [N/x] M +Proof + HO_MATCH_MP_TAC nc_INDUCTION >> Q.EXISTS_TAC ‘{x;v} UNION FV N’ + >> SRW_TAC [][SUB_THM, SUB_VAR] +QED + +Theorem lemma15b : + v # (M :'a CCS) ==> [var u/v] ([var v/u] M) = M +Proof + SRW_TAC [][lemma15a] +QED + +Theorem SUB_TWICE_ONE_VAR : + !M :'a CCS. [x/v] ([y/v] M) = [[x/v] y/v] M +Proof + HO_MATCH_MP_TAC nc_INDUCTION + >> SRW_TAC [][SUB_THM, SUB_VAR] + >> Q.EXISTS_TAC ‘v INSERT FV x UNION FV y’ + >> SRW_TAC [][SUB_THM] + >> Cases_on ‘v IN FV y’ + >> SRW_TAC [][SUB_THM, lemma14c, lemma14b] +QED + +Theorem swap_eq_3substs : + z # (M :'a CCS) /\ x <> z /\ y <> z ==> + tpm [(x,y)] M = [var y/z] ([var x/y] ([var z/x] M)) +Proof + SRW_TAC [][GSYM fresh_tpm_subst] + >> ‘tpm [(x,y)] (tpm [(z,x)] M) = + tpm [(swapstr x y z, swapstr x y x)] (tpm [(x,y)] M)’ + by (SRW_TAC [][Once (GSYM pmact_sing_to_back), SimpLHS] \\ + SRW_TAC [][]) + >> POP_ASSUM SUBST_ALL_TAC + >> SRW_TAC [][pmact_flip_args] +QED + +(* ---------------------------------------------------------------------- + alpha-convertibility results + ---------------------------------------------------------------------- *) + +Theorem SIMPLE_ALPHA : + y # (u :'a CCS) ==> !x. rec x u = rec y ([var y/x] u) +Proof + SRW_TAC [][GSYM fresh_tpm_subst] + >> SRW_TAC [boolSimps.CONJ_ss][rec_eq_thm, pmact_flip_args] +QED + +(* ---------------------------------------------------------------------- + size function + ---------------------------------------------------------------------- *) + +val size_exists = + tm_recursion + |> INST_TYPE [“:'r” |-> “:num”] + |> SPEC_ALL + |> Q.INST [‘A’ |-> ‘{}’, ‘apm’ |-> ‘discrete_pmact’, + ‘vr’ |-> ‘\s. 1’, + ‘nl’ |-> ‘1’, + ‘pf’ |-> ‘\m u E. m + 1’, + ‘sm’ |-> ‘\m n t1 t2. m + n + 1’, + ‘pr’ |-> ‘\m n t1 t2. m + n + 1’, + ‘rs’ |-> ‘\m L t. m + 1’, + ‘rl’ |-> ‘\m t rf. m + 1’, + ‘re’ |-> ‘\m v t. m + 1’] + |> SIMP_RULE (srw_ss()) [] + +val size_def = new_specification("CCS_size_def", ["CCS_size"], size_exists); + +Theorem size_thm[simp] = CONJUNCT1 size_def + +Theorem size_tpm[simp] = GSYM (CONJUNCT2 size_def) + +Theorem size_nonzero : + !t :'a CCS. 0 < CCS_size t +Proof + HO_MATCH_MP_TAC simple_induction + >> SRW_TAC [ARITH_ss][] +QED + +(* |- !t. CCS_size t <> 0 *) +Theorem size_nz = + REWRITE_RULE [GSYM arithmeticTheory.NOT_ZERO_LT_ZERO] size_nonzero + +Theorem size_vsubst[simp]: + !M :'a CCS. CCS_size ([var v/u] M) = CCS_size M +Proof + HO_MATCH_MP_TAC nc_INDUCTION >> Q.EXISTS_TAC ‘{u;v}’ + >> SRW_TAC [][SUB_VAR, SUB_THM] +QED + +(* ---------------------------------------------------------------------- + CCS_Subst + ---------------------------------------------------------------------- *) + +Definition CCS_Subst : + CCS_Subst E E' X = [E'/X] (E :'a CCS) +End + +(* NOTE: “Y # E'” is additionally required in case of ‘rec’ *) +Theorem CCS_Subst_def : + (CCS_Subst nil E' X = nil) /\ + (CCS_Subst (prefix u E) E' X = prefix u (CCS_Subst E E' X)) /\ + (CCS_Subst (sum E1 E2) E' X = sum (CCS_Subst E1 E' X) + (CCS_Subst E2 E' X)) /\ + (CCS_Subst (par E1 E2) E' X = par (CCS_Subst E1 E' X) + (CCS_Subst E2 E' X)) /\ + (CCS_Subst (restr L E) E' X = restr L (CCS_Subst E E' X)) /\ + (CCS_Subst (relab E rf) E' X = relab (CCS_Subst E E' X) rf) /\ + (CCS_Subst (var Y) E' X = if (Y = X) then E' else (var Y)) /\ + (Y <> X /\ Y # E' ==> + CCS_Subst (rec Y E) E' X = rec Y (CCS_Subst E E' X)) +Proof + rw [CCS_Subst] +QED + +val [CCS_Subst_nil, CCS_Subst_prefix, CCS_Subst_sum, CCS_Subst_par, + CCS_Subst_restr, CCS_Subst_relab, CCS_Subst_var, CCS_Subst_rec] = + map save_thm + (combine (["CCS_Subst_nil", "CCS_Subst_prefix", + "CCS_Subst_sum", "CCS_Subst_par", + "CCS_Subst_restr", "CCS_Subst_relab", + "CCS_Subst_var", "CCS_Subst_rec"], + CONJUNCTS CCS_Subst_def)); + +(* 1st fixed point of CCS_Subst *) +Theorem CCS_Subst_rec_fix[simp] : + !X E E'. CCS_Subst (rec X E) E' X = rec X E +Proof + rw [CCS_Subst] >> MATCH_MP_TAC lemma14b >> rw [] +QED + +(* 2nd fixed point of CCS_Subst *) +Theorem CCS_Subst_var_fix[simp] : + !X E. CCS_Subst (var X) E X = E +Proof + rw [CCS_Subst_var] +QED + +(* 3rd fixed point of CCS_Subst *) +Theorem CCS_Subst_self[simp] : + !X E. CCS_Subst E (var X) X = E +Proof + rw [CCS_Subst] +QED + +(* !t1 t2. (if T then t1 else t2) = t1) /\ (if F then t1 else t2) = t2) *) +Theorem CCS_COND_CLAUSES = INST_TYPE [“:'a” |-> “:'a CCS”] COND_CLAUSES + +Theorem FV_SUBSET : + !X E E'. FV (CCS_Subst E E' X) SUBSET (FV E) UNION (FV E') +Proof + rw [CCS_Subst, FV_SUB] + >> MATCH_MP_TAC SUBSET_TRANS + >> Q.EXISTS_TAC ‘FV E’ + >> SET_TAC [] +QED + +Theorem FV_SUBSET' : + !X E E'. FV (CCS_Subst E E' X) SUBSET (FV E DELETE X) UNION (FV E') +Proof + rw [CCS_Subst, FV_SUB] + >> ASM_SET_TAC [] +QED + +Theorem FV_SUBSET_REC : + !X E. FV (CCS_Subst E (rec X E) X) SUBSET (FV E) +Proof + rpt GEN_TAC + >> ASSUME_TAC (Q.SPECL [`X`, `E`, `rec X E`] FV_SUBSET) + >> ASM_SET_TAC [FV_thm] +QED + +(* NOTE: this theorem is key to prove TRANS_FV *) +Theorem FV_SUBSET_REC' : + !X E. FV (CCS_Subst E (rec X E) X) SUBSET (FV E DELETE X) +Proof + rpt GEN_TAC + >> ASSUME_TAC (Q.SPECL [`X`, `E`, `rec X E`] FV_SUBSET') + >> ASM_SET_TAC [FV_thm] +QED + +Theorem CCS_Subst_elim : + !X E. X # E ==> !E'. (CCS_Subst E E' X = E) +Proof + rw [CCS_Subst] + >> MATCH_MP_TAC lemma14b >> art [] +QED + +Theorem CCS_Subst_FIX_IMP_NOTIN_FV : + !X E. (!E'. CCS_Subst E E' X = E) ==> X NOTIN (FV E) +Proof + rw [CCS_Subst] + >> MATCH_MP_TAC SUB_FIX_IMP_NOTIN_FV >> rw [] +QED + +(* If E[t/X] = E[t'/X] for all t t', X must not be free in E *) +Theorem CCS_Subst_EQ_IMP_NOTIN_FV : + !X E. (!E1 E2. CCS_Subst E E1 X = CCS_Subst E E2 X) ==> X NOTIN (FV E) +Proof + rw [CCS_Subst] + >> MATCH_MP_TAC SUB_EQ_IMP_NOTIN_FV >> rw [] +QED + +Theorem FV_REC_PREF : + !X E u E'. FV (CCS_Subst E (rec X (prefix u E')) X) = + FV (CCS_Subst E (rec X E') X) +Proof + rw [CCS_Subst, FV_SUB] +QED + +Theorem FV_REC_SUM : + !X E E1 E2. FV (CCS_Subst E (rec X (E1 + E2)) X) = + (FV (CCS_Subst E (rec X E1) X)) UNION (FV (CCS_Subst E (rec X E2) X)) +Proof + rw [CCS_Subst, FV_SUB] >> SET_TAC [] +QED + +Theorem FV_REC_PAR : + !X E E1 E2. FV (CCS_Subst E (rec X (par E1 E2)) X) = + (FV (CCS_Subst E (rec X E1) X)) UNION (FV (CCS_Subst E (rec X E2) X)) +Proof + rw [CCS_Subst, FV_SUB] >> SET_TAC [] +QED + +Theorem FV_SUBSET_lemma : + !P X Y. FV P SUBSET {X} /\ Y <> X ==> Y # P +Proof + rpt STRIP_TAC + >> ‘Y IN {X}’ by METIS_TAC [SUBSET_DEF] + >> fs [] +QED + +(* i.e. closed term *) +Definition IS_PROC_def : + IS_PROC E <=> (FV E = EMPTY) +End + +Overload closed = “IS_PROC” +Theorem closed_def = IS_PROC_def + +Definition ALL_PROC_def : + ALL_PROC Es <=> EVERY IS_PROC Es +End + +Theorem IS_PROC_EL : + !Es n. ALL_PROC Es /\ n < LENGTH Es ==> IS_PROC (EL n Es) +Proof + RW_TAC list_ss [ALL_PROC_def, EVERY_MEM, MEM_EL] + >> FIRST_X_ASSUM MATCH_MP_TAC + >> Q.EXISTS_TAC `n` >> art [] +QED + +Theorem closed_nil[simp] : + closed nil +Proof + rw [closed_def] +QED + +Theorem not_closed_var[simp] : + ~closed (var X) +Proof + rw [closed_def] +QED + +Theorem IS_PROC_prefix[simp] : + !P u. IS_PROC (prefix u P) <=> IS_PROC P +Proof + RW_TAC std_ss [IS_PROC_def, FV_thm] +QED + +Theorem IS_PROC_sum[simp] : + !P Q. IS_PROC (sum P Q) <=> IS_PROC P /\ IS_PROC Q +Proof + RW_TAC set_ss [IS_PROC_def, FV_thm] +QED + +Theorem IS_PROC_par[simp] : + !P Q. IS_PROC (par P Q) <=> IS_PROC P /\ IS_PROC Q +Proof + RW_TAC set_ss [IS_PROC_def, FV_thm] +QED + +Theorem IS_PROC_restr[simp] : + !P L. IS_PROC (restr L P) <=> IS_PROC P +Proof + RW_TAC set_ss [IS_PROC_def, FV_thm] +QED + +Theorem IS_PROC_relab[simp] : + !P rf. IS_PROC (relab P rf) <=> IS_PROC P +Proof + RW_TAC set_ss [IS_PROC_def, FV_thm] +QED -val _ = TeX_notation { hol = "nil", TeX = ("\\ensuremath{\\mathbf{0}}", 1) }; +val PREF_ACT_exists = + tm_recursion + |> INST_TYPE [“:'r” |-> “:'a Action”] + |> SPEC_ALL + |> Q.INST [‘A’ |-> ‘{}’, ‘apm’ |-> ‘discrete_pmact’, + ‘vr’ |-> ‘\s. tau’, + ‘nl’ |-> ‘tau’, + ‘pf’ |-> ‘\m u E. u’, (* here *) + ‘sm’ |-> ‘\m n t1 t2. tau’, + ‘pr’ |-> ‘\m n t1 t2. tau’, + ‘rs’ |-> ‘\m L t. tau’, + ‘rl’ |-> ‘\m t rf. tau’, + ‘re’ |-> ‘\m v t. tau’] + |> SIMP_RULE (srw_ss()) []; + +local val lemma = Q.prove (‘?f. !u E. f (u..E) = u’, + METIS_TAC [PREF_ACT_exists]); +in +(* !u E. PREF_ACT (u..E) = u *) +val PREF_ACT_def = new_specification + ("PREF_ACT_def", ["PREF_ACT"], lemma); +end -(* compact representation for single-action restriction *) -val _ = overload_on ("nu", ``\(n :'b) P. restr {name n} P``); -val _ = overload_on ("nu", ``restr``); +val PREF_PROC_exists = + tm_recursion + |> INST_TYPE [“:'r” |-> “:'a CCS”] + |> SPEC_ALL + |> Q.INST [‘A’ |-> ‘{}’, + ‘apm’ |-> ‘^t_pmact_t’, + ‘ppm’ |-> ‘pair_pmact string_pmact ^t_pmact_t’, + ‘vr’ |-> ‘\s. nil’, + ‘nl’ |-> ‘nil’, + ‘pf’ |-> ‘\m u E. E’, (* here *) + ‘sm’ |-> ‘\m n t1 t2. nil’, + ‘pr’ |-> ‘\m n t1 t2. nil’, + ‘rs’ |-> ‘\m L t. nil’, + ‘rl’ |-> ‘\m t rf. nil’, + ‘re’ |-> ‘\m v t. nil’] + |> SIMP_RULE (srw_ss()) []; + +local val lemma = Q.prove (‘?f. !u E. f (u..E) = E’, + METIS_TAC [PREF_PROC_exists]); +in +(* |- !u E. PREF_PROC (u..E) = E *) +val PREF_PROC_def = new_specification + ("PREF_PROC_def", ["PREF_PROC"], lemma); +end -val _ = add_rule {term_name = "nu", fixity = Closefix, - pp_elements = [TOK ("(" ^ UnicodeChars.nu), TM, TOK ")"], - paren_style = OnlyIfNecessary, - block_style = (AroundEachPhrase, (PP.INCONSISTENT, 2))}; +(* ---------------------------------------------------------------------- + Simultaneous substitution (using a finite map) - much more interesting + ---------------------------------------------------------------------- *) -val _ = TeX_notation { hol = "(" ^ UnicodeChars.nu, - TeX = ("\\ensuremath{(\\nu}", 1) }; +Overload fmFV = “supp (fm_pmact string_pmact ^t_pmact_t)” +Overload tmsFV = “supp (set_pmact ^t_pmact_t)” +Overload fmtpm = “fmpm string_pmact term_pmact” -(* TODO: send to HOL's boolTheory *) -val _ = TeX_notation { hol = "(", TeX = ("\\ensuremath{(}", 1) }; -val _ = TeX_notation { hol = ")", TeX = ("\\ensuremath{)}", 1) }; -val _ = TeX_notation { hol = "=", TeX = ("\\ensuremath{=}", 1) }; +Theorem strterm_fmap_supp: + fmFV fmap = FDOM fmap ∪ tmsFV (FRANGE fmap) +Proof + SRW_TAC [][fmap_supp] +QED -(* disabled: this "\mu" is conflict with the \mu action used in CCS papers -val _ = overload_on ("mu", ``rec``); -val _ = Unicode.unicode_version { u = UnicodeChars.mu, tmnm = "mu" }; -val _ = TeX_notation { hol = "mu", TeX = ("\\ensuremath{\\mu}", 1) }; - *) +Theorem FINITE_strterm_fmap_supp[simp]: + FINITE (fmFV fmap) +Proof + SRW_TAC [][strterm_fmap_supp, supp_setpm] >> SRW_TAC [][] +QED -val _ = overload_on ("+", ``sum``); (* priority: 500 *) -val _ = TeX_notation { hol = "+", TeX = ("\\ensuremath{+}", 1) }; +val lem1 = prove( + ``∃a. ~(a ∈ supp (fm_pmact string_pmact ^t_pmact_t) fm)``, + Q_TAC (NEW_TAC "z") `supp (fm_pmact string_pmact ^t_pmact_t) fm` THEN + METIS_TAC []); -val _ = set_mapped_fixity { fixity = Infix(LEFT, 600), - tok = "||", term_name = "par" }; +val supp_FRANGE = prove( + ``~(x ∈ supp (set_pmact ^t_pmact_t) (FRANGE fm)) = + ∀y. y ∈ FDOM fm ==> ~(x ∈ FV (fm ' y))``, + SRW_TAC [][supp_setpm, finite_mapTheory.FRANGE_DEF] >> METIS_TAC []); -(* val _ = Unicode.unicode_version {u = UTF8.chr 0x007C, tmnm = "par"}; *) -val _ = TeX_notation { hol = "||", TeX = ("\\ensuremath{\\mid}", 1) }; +fun ex_conj1 thm = let + val (v,c) = dest_exists (concl thm) + val c1 = CONJUNCT1 (ASSUME c) + val fm = mk_exists(v,concl c1) +in + CHOOSE (v, thm) (EXISTS(fm,v) c1) +end -val _ = - add_rule { term_name = "prefix", fixity = Infix(RIGHT, 700), - pp_elements = [ BreakSpace(0,0), TOK "..", BreakSpace(0,0) ], - paren_style = OnlyIfNecessary, - block_style = (AroundSamePrec, (PP.CONSISTENT, 0)) }; +val supp_EMPTY = prove( + ``(supp (set_pmact apm) {} = {})``, + srw_tac [][EXTENSION] >> match_mp_tac notinsupp_I >> + qexists_tac `{}` >> srw_tac [][support_def]); -val _ = TeX_notation { hol = "..", TeX = ("\\ensuremath{\\ldotp}", 1) }; +Theorem lem2[local] : + ∀fm. FINITE (tmsFV (FRANGE fm)) +Proof + srw_tac [][supp_setpm] >> srw_tac [][] +QED -(* Define structural induction on CCS agent expressions. *) -val CCS_induct = TypeBase.induction_of ``:('a, 'b) CCS``; +val ordering = prove( + ``(∃f. P f) <=> (∃f. P (combin$C f))``, + srw_tac [][EQ_IMP_THM] >- + (qexists_tac `λx y. f y x` >> srw_tac [ETA_ss][combinTheory.C_DEF]) >> + metis_tac []) -(* The structural cases theorem for the type CCS. *) -val CCS_cases = TypeBase.nchotomy_of ``:('a, 'b) CCS``; +Theorem notin_frange: + v ∉ tmsFV (FRANGE p) <=> ∀y. y ∈ FDOM p ==> v ∉ FV (p ' y) +Proof + srw_tac [][supp_setpm, EQ_IMP_THM, finite_mapTheory.FRANGE_DEF] + >> metis_tac [] +QED -(* Prove that the constructors of the type CCS are distinct. *) -val CCS_distinct = TypeBase.distinct_of ``:('a, 'b) CCS``; +val ssub_exists = + parameter_tm_recursion + |> INST_TYPE [“:'r” |-> “:'a CCS”, “:'q” |-> “:string |-> 'a CCS”] + |> Q.INST [‘A’ |-> ‘{}’, ‘apm’ |-> ‘^t_pmact_t’, + ‘ppm’ |-> ‘fm_pmact string_pmact ^t_pmact_t’, + ‘vr’ |-> ‘\s fm. if s IN FDOM fm then fm ' s else var s’, + ‘re’ |-> ‘\r v t fm. rec v (r fm)’, + ‘nl’ |-> ‘\r. nil’, + ‘pf’ |-> ‘\r u t fm. prefix u (r fm)’, + ‘sm’ |-> ‘\r1 r2 t1 t2 fm. r1 fm + r2 fm’, + ‘pr’ |-> ‘\r1 r2 t1 t2 fm. r1 fm || r2 fm’, + ‘rs’ |-> ‘\r L t fm. restr L (r fm)’, + ‘rl’ |-> ‘\r t rf fm. relab (r fm) rf’] + |> SIMP_RULE (srw_ss()) [tpm_COND, strterm_fmap_supp, lem2, + FAPPLY_eqv_lswapstr, supp_fresh, + pmact_sing_inv, fnpm_def, + fmpm_FDOM, notin_frange] + |> SIMP_RULE (srw_ss()) [Once ordering] + |> CONV_RULE (DEPTH_CONV (rename_vars [("p", "fm")])) + |> prove_alpha_fcbhyp {ppm = “fm_pmact string_pmact ^t_pmact_t”, + rwts = [notin_frange, strterm_fmap_supp], + alphas = [tpm_ALPHA]}; + +val ssub_def = new_specification ("ssub_def", ["ssub"], ssub_exists) + +(* |- (!s fm. ssub fm (var s) = if s IN FDOM fm then fm ' s else var s) /\ + (!fm. ssub fm nil = nil) /\ (!x fm t. ssub fm (x..t) = x..ssub fm t) /\ + (!fm t t'. ssub fm (t' + t) = ssub fm t' + ssub fm t) /\ + (!fm t t'. ssub fm (t' || t) = ssub fm t' || ssub fm t) /\ + (!x fm t. ssub fm (restr x t) = restr x (ssub fm t)) /\ + (!x fm t. ssub fm (relab t x) = relab (ssub fm t) x) /\ + !v fm t. + v NOTIN FDOM fm /\ (!y. y IN FDOM fm ==> v # fm ' y) ==> + ssub fm (rec v t) = rec v (ssub fm t) + *) +Theorem ssub_thm[simp] = CONJUNCT1 ssub_def -(* size definition *) -val (CCS_size_tm, CCS_size_def) = TypeBase.size_of ``:('a, 'b) CCS``; +val _ = overload_on ("'", “ssub”); -local - val thm = CONJUNCTS CCS_distinct; - val CCS_distinct_LIST = thm @ (map GSYM thm); -in - val CCS_distinct' = save_thm ("CCS_distinct'", LIST_CONJ CCS_distinct_LIST); -end +val tpm_ssub = save_thm("tpm_ssub", CONJUNCT2 ssub_def); -Theorem CCS_distinct_exists : - !p :('a, 'b) CCS. ?q. q <> p +Theorem single_ssub : + !N. (FEMPTY |+ (s,M)) ' N = [M/s] N Proof - GEN_TAC >> Cases_on `p` >> rpt STRIP_TAC - >- (Q.EXISTS_TAC `prefix a nil` >> REWRITE_TAC [CCS_distinct']) - >> Q.EXISTS_TAC `nil` - >> REWRITE_TAC [CCS_distinct] + HO_MATCH_MP_TAC nc_INDUCTION >> Q.EXISTS_TAC `s INSERT FV M` + >> SRW_TAC [][SUB_VAR, SUB_THM] QED -(* Prove that the constructors of the type CCS are one-to-one. *) -val CCS_11 = TypeBase.one_one_of ``:('a, 'b) CCS``; +Theorem in_fmap_supp: + x IN fmFV fm <=> x IN FDOM fm \/ ?y. y IN FDOM fm /\ x IN FV (fm ' y) +Proof + SRW_TAC [][strterm_fmap_supp, nomsetTheory.supp_setpm] + >> SRW_TAC [boolSimps.DNF_ss][finite_mapTheory.FRANGE_DEF] + >> METIS_TAC [] +QED -(* Given any agent expression, define the substitution of an agent expression - E' for an agent variable X. +Theorem not_in_fmap_supp[simp]: + x NOTIN fmFV fm <=> x NOTIN FDOM fm /\ !y. y IN FDOM fm ==> x NOTIN FV (fm ' y) +Proof + METIS_TAC [in_fmap_supp] +QED - This works under the hypothesis that the Barendregt convention holds. *) -Definition CCS_Subst_def : - (CCS_Subst nil E' X = nil) /\ - (CCS_Subst (prefix u E) E' X = prefix u (CCS_Subst E E' X)) /\ - (CCS_Subst (sum E1 E2) E' X = sum (CCS_Subst E1 E' X) - (CCS_Subst E2 E' X)) /\ - (CCS_Subst (par E1 E2) E' X = par (CCS_Subst E1 E' X) - (CCS_Subst E2 E' X)) /\ - (CCS_Subst (restr L E) E' X = restr L (CCS_Subst E E' X)) /\ - (CCS_Subst (relab E rf) E' X = relab (CCS_Subst E E' X) rf) /\ - (CCS_Subst (var Y) E' X = if (Y = X) then E' else (var Y)) /\ - (CCS_Subst (rec Y E) E' X = if (Y = X) then (rec Y E) - else (rec Y (CCS_Subst E E' X))) -End +Theorem ssub_14b: + !t. DISJOINT (FV t) (FDOM phi) ==> (phi : string |-> 'a CCS) ' t = t +Proof + HO_MATCH_MP_TAC nc_INDUCTION + >> Q.EXISTS_TAC ‘fmFV phi’ + >> SRW_TAC [][DISJOINT_DEF, SUB_THM, SUB_VAR, pred_setTheory.EXTENSION] + >> METIS_TAC [] +QED -val [CCS_Subst_nil, CCS_Subst_prefix, CCS_Subst_sum, CCS_Subst_par, - CCS_Subst_restr, CCS_Subst_relab, CCS_Subst_var, CCS_Subst_rec] = - map save_thm - (combine (["CCS_Subst_nil", "CCS_Subst_prefix", - "CCS_Subst_sum", "CCS_Subst_par", - "CCS_Subst_restr", "CCS_Subst_relab", - "CCS_Subst_var", "CCS_Subst_rec"], - CONJUNCTS CCS_Subst_def)); +Theorem ssub_value : + FV t = EMPTY ==> (phi : string |-> 'a CCS) ' t = t +Proof + SRW_TAC [][ssub_14b] +QED -(* `[E'/X] E`, learnt from /examples/lambda/basics/termScript.sml *) -val _ = overload_on ("SUB", ``\E' X E. CCS_Subst E E' X``); +(* |- !t phi. closed t ==> phi ' t = t *) +Theorem ssub_value' = + ssub_value |> REWRITE_RULE [GSYM closed_def] |> GEN_ALL -val _ = TeX_notation { hol = "[", TeX = ("\\ensuremath{[}", 1) }; -val _ = TeX_notation { hol = "/", TeX = ("\\ensuremath{/}", 1) }; -val _ = TeX_notation { hol = "]", TeX = ("\\ensuremath{]}", 1) }; +Theorem ssub_FEMPTY[simp]: + !t. (FEMPTY :string |-> 'a CCS) ' t = t +Proof + HO_MATCH_MP_TAC simple_induction >> SRW_TAC [][] +QED + +Theorem FV_ssub : + !fm N. (!y. y IN FDOM fm ==> FV (fm ' y) = {}) ==> + FV (fm ' N) = FV N DIFF FDOM fm +Proof + rpt STRIP_TAC + >> Q.ID_SPEC_TAC ‘N’ + >> HO_MATCH_MP_TAC nc_INDUCTION + >> Q.EXISTS_TAC ‘FDOM fm’ + >> rw [SUB_VAR, SUB_THM, ssub_thm] + >> SET_TAC [] +QED -(* Note that in the rec clause, if Y = X then all occurrences of Y in E are X - and bound, so there exist no free variables X in E to be replaced with E'. - Hence, the term rec Y E is returned. +Theorem fresh_ssub: + !N. y NOTIN FV N /\ (!k :string. k IN FDOM fm ==> y # fm ' k) ==> y # fm ' N +Proof + ho_match_mp_tac nc_INDUCTION + >> qexists ‘fmFV fm’ >> rw [] >> metis_tac[] +QED - Below are two typical cases by CCS_Subst: *) +Theorem ssub_SUBST : + !M. (!k. k IN FDOM fm ==> v # fm ' k) /\ v NOTIN FDOM fm ==> + fm ' ([N/v] M) = [fm ' N/v] (fm ' M) +Proof + ho_match_mp_tac nc_INDUCTION + >> qexists ‘fmFV fm UNION {v} UNION FV N’ + >> rw [] >> rw [lemma14b, SUB_VAR] + >> gvs [DECIDE “~p \/ q <=> p ==> q”, PULL_FORALL] + >> rename1 ‘y # N’ + >> ‘y # fm ' N’ suffices_by simp[SUB_THM] + >> irule fresh_ssub >> simp [] +QED -(* !X E E'. CCS_Subst (rec X E) E' X = rec X E (1st fixed point of CCS_Subst) *) -val CCS_Subst_rec_fix = save_thm ( - "CCS_Subst_rec_fix[simp]", - Q.GENL [`X`, `E`, `E'`] - (REWRITE_CONV [CCS_Subst_def] ``CCS_Subst (rec X E) E' X``)); +(* |- !v fm t. + v NOTIN FDOM fm /\ (!y. y IN FDOM fm ==> v # fm ' y) ==> + fm ' (rec v t) = rec v (fm ' t) + *) +Theorem ssub_rec = List.nth(CONJUNCTS ssub_thm, 7) -(* !X E. CCS_Subst (var X) E X = E (2nd fixed point of CCS_Subst) *) -val CCS_Subst_var_fix = save_thm ( - "CCS_Subst_var_fix[simp]", - Q.GENL [`X`, `E`] - (REWRITE_CONV [CCS_Subst_def] ``CCS_Subst (var X) E X``)); +Theorem ssub_update_apply_SUBST : + !M. (!k. k IN FDOM fm ==> v # fm ' k) /\ v NOTIN FDOM fm /\ + DISJOINT (FDOM fm) (FV N) ==> + (fm |+ (v,N)) ' M = fm ' ([N/v] M) +Proof + HO_MATCH_MP_TAC nc_INDUCTION + >> Q.EXISTS_TAC ‘v INSERT fmFV fm UNION FV M UNION FV N’ + >> rw [SUB_VAR, SUB_THM, ssub_thm, FAPPLY_FUPDATE_THM] + >> TRY (METIS_TAC []) + >- (MATCH_MP_TAC (GSYM ssub_14b) \\ + rw [GSYM DISJOINT_DEF, Once DISJOINT_SYM]) + >> rename1 ‘y # N’ + >> Suff ‘(fm |+ (v,N)) ' (rec y M') = rec y ((fm |+ (v,N)) ' M')’ >- rw [] + >> MATCH_MP_TAC ssub_rec + >> rw [FAPPLY_FUPDATE_THM] +QED -Theorem CCS_Subst_self[simp] : (* (3rd fixed point of CCS_Subst) *) - !X E. CCS_Subst E (var X) X = E +(* A combined version of ssub_update_apply_SUBST and ssub_SUBST *) +Theorem ssub_update_apply_SUBST' : + !M. (!k. k IN FDOM fm ==> v # fm ' k) /\ v NOTIN FDOM fm /\ + DISJOINT (FDOM fm) (FV N) ==> + (fm |+ (v,N)) ' M = [fm ' N/v] (fm ' M) Proof - GEN_TAC >> Induct_on `E` >> RW_TAC std_ss [CCS_Subst_def] + rpt STRIP_TAC + >> Know ‘[fm ' N/v] (fm ' M) = fm ' ([N/v] M)’ + >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\ + MATCH_MP_TAC ssub_SUBST >> art []) + >> Rewr' + >> MATCH_MP_TAC ssub_update_apply_SUBST >> art [] QED -(* !t1 t2. ((T => t1 | t2) = t1) /\ ((F => t1 | t2) = t2) *) -val CCS_COND_CLAUSES = save_thm ( - "CCS_COND_CLAUSES", INST_TYPE [``:'a`` |-> ``:('a, 'b) CCS``] COND_CLAUSES); +Theorem FEMPTY_update_apply : + !M. (FEMPTY |+ (v,N)) ' M = [N/v] M +Proof + Q.X_GEN_TAC ‘M’ + >> ‘[N/v] M = FEMPTY ' ([N/v] M)’ by rw [] + >> POP_ORW + >> MATCH_MP_TAC ssub_update_apply_SUBST + >> rw [] +QED (******************************************************************************) (* *) @@ -452,8 +1733,7 @@ val CCS_COND_CLAUSES = save_thm ( (* *) (******************************************************************************) -val _ = type_abbrev_pp ("transition", - ``:('a, 'b) CCS -> 'b Action -> ('a, 'b) CCS -> bool``); +Type transition[pp] = “:'a CCS -> 'a Action -> 'a CCS -> bool” (* Inductive definition of the transition relation TRANS for CCS. TRANS: CCS -> Action -> CCS -> bool @@ -498,10 +1778,10 @@ val TRANS_IND = save_thm ("TRANS_IND", (* The process nil has no transitions. !u E. ~TRANS nil u E *) -val NIL_NO_TRANS = save_thm ("NIL_NO_TRANS", - Q.GENL [`u`, `E`] - (REWRITE_RULE [CCS_distinct] - (SPECL [``nil``, ``u :'b Action``, ``E :('a, 'b) CCS``] TRANS_cases))); +Theorem NIL_NO_TRANS = + TRANS_cases |> Q.SPECL [‘nil’, ‘u’, ‘E’] + |> REWRITE_RULE [CCS_distinct] + |> Q.GENL [‘u’, ‘E’] (* !u E. nil --u-> E <=> F *) val NIL_NO_TRANS_EQF = save_thm ( @@ -520,18 +1800,15 @@ QED *) val VAR_NO_TRANS = save_thm ("VAR_NO_TRANS", Q.GENL [`X`, `u`, `E`] - (REWRITE_RULE [CCS_distinct', CCS_11] + (REWRITE_RULE [CCS_distinct', CCS_one_one] (Q.SPECL [`var X`, `u`, `E`] TRANS_cases))); -(* !u E u' E'. TRANS (prefix u E) u' E' = (u' = u) /\ (E' = E) *) -val TRANS_PREFIX_EQ = save_thm ( - "TRANS_PREFIX_EQ", - ((Q.GENL [`u`, `E`, `u'`, `E'`]) o - (ONCE_REWRITE_RHS_RULE [EQ_SYM_EQ]) o - SPEC_ALL o - (REWRITE_RULE [CCS_distinct', CCS_11])) - (SPECL [``prefix (u :'b Action) E``, ``u' :'b Action``, ``E' :('a, 'b) CCS``] - TRANS_cases)); +(* !u E u' E'. TRANS (prefix u E) u' E' <=> (u' = u) /\ (E' = E) *) +Theorem TRANS_PREFIX_EQ = + TRANS_cases |> Q.SPECL [‘prefix u E’, ‘u'’, ‘E'’] + |> REWRITE_RULE [CCS_distinct', CCS_one_one] + |> ONCE_REWRITE_RHS_RULE [EQ_SYM_EQ] + |> Q.GENL [‘u’, ‘E’, ‘u'’, ‘E'’] (* !u E u' E'. u..E --u'-> E' ==> (u' = u) /\ (E' = E) *) val TRANS_PREFIX = save_thm ( @@ -548,12 +1825,10 @@ val TRANS_PREFIX = save_thm ( (?E E'. (P = E /\ P' = E') /\ E --u-> P'') \/ ?E E'. (P = E' /\ P' = E) /\ E --u-> P'' *) -val SUM_cases_EQ = save_thm ( - "SUM_cases_EQ", - Q.GENL [`P`, `P'`, `u`, `P''`] - (REWRITE_RULE [CCS_distinct', CCS_11] - (SPECL [``sum P P'``, ``u :'b Action``, ``P'' :('a, 'b) CCS``] - TRANS_cases))); +Theorem SUM_cases_EQ = + TRANS_cases |> Q.SPECL [‘sum P P'’, ‘u’, ‘P''’] + |> REWRITE_RULE [CCS_distinct', CCS_one_one] + |> Q.GENL [‘P’, ‘P'’, ‘u’, ‘P''’] val SUM_cases = save_thm ( "SUM_cases", EQ_IMP_LR SUM_cases_EQ); @@ -657,7 +1932,7 @@ val TRANS_P_SUM_P = save_thm val PAR_cases_EQ = save_thm ("PAR_cases_EQ", Q.GENL [`P`, `P'`, `u`, `P''`] - (REWRITE_RULE [CCS_distinct', CCS_11] + (REWRITE_RULE [CCS_distinct', CCS_one_one] (Q.SPECL [`par P P'`, `u`, `P''`] TRANS_cases))); val PAR_cases = save_thm ("PAR_cases", EQ_IMP_LR PAR_cases_EQ); @@ -704,7 +1979,7 @@ val TRANS_PAR_P_NIL = store_thm ("TRANS_PAR_P_NIL", IMP_RES_TAC NIL_NO_TRANS ]); val TRANS_PAR_NO_SYNCR = store_thm ("TRANS_PAR_NO_SYNCR", - ``!(l :'b Label) l'. l <> COMPL l' ==> + ``!(l :'a Label) l'. l <> COMPL l' ==> !E E' E''. ~(TRANS (par (prefix (label l) E) (prefix (label l') E')) tau E'')``, rpt STRIP_TAC >> IMP_RES_TAC TRANS_PAR (* 3 sub-goals here *) @@ -712,15 +1987,15 @@ val TRANS_PAR_NO_SYNCR = store_thm ("TRANS_PAR_NO_SYNCR", IMP_RES_TAC TRANS_PREFIX >> IMP_RES_TAC Action_distinct, IMP_RES_TAC TRANS_PREFIX >> IMP_RES_TAC Action_11 \\ CHECK_ASSUME_TAC - (REWRITE_RULE [SYM (ASSUME ``(l'' :'b Label) = l``), - SYM (ASSUME ``COMPL (l'' :'b Label) = l'``), COMPL_COMPL_LAB] - (ASSUME ``~(l = COMPL (l' :'b Label))``)) \\ + (REWRITE_RULE [SYM (ASSUME ``(l'' :'a Label) = l``), + SYM (ASSUME ``COMPL (l'' :'a Label) = l'``), COMPL_COMPL_LAB] + (ASSUME ``~(l = COMPL (l' :'a Label))``)) \\ RW_TAC bool_ss [] ]); val RESTR_cases_EQ = save_thm ( "RESTR_cases_EQ", Q.GENL [`P'`, `u`, `L`, `P`] - (REWRITE_RULE [CCS_distinct', CCS_11, Action_distinct, Action_11] + (REWRITE_RULE [CCS_distinct', CCS_one_one, Action_distinct, Action_11] (Q.SPECL [`restr L P`, `u`, `P'`] TRANS_cases))); val RESTR_cases = save_thm ( @@ -732,8 +2007,8 @@ Theorem TRANS_RESTR_EQ : ?E'' l. (E' = restr L E'') /\ TRANS E u E'' /\ ((u = tau) \/ ((u = label l) /\ l NOTIN L /\ (COMPL l) NOTIN L)) Proof - let val a1 = ASSUME ``(u :'b Action) = tau`` - and a2 = ASSUME ``u = label (l :'b Label)`` + let val a1 = ASSUME ``(u :'a Action) = tau`` + and a2 = ASSUME ``u = label (l :'a Label)`` and a3 = ASSUME ``TRANS E'' u E'''`` and a4 = ASSUME ``TRANS E u E''`` in @@ -766,17 +2041,18 @@ val TRANS_P_RESTR = store_thm ( "TRANS_P_RESTR", ``!E u E' L. TRANS (restr L E) u (restr L E') ==> TRANS E u E'``, let - val thm = REWRITE_RULE [CCS_11] (ASSUME ``restr (L :'b Label set) E' = restr L E''``) + val thm = REWRITE_RULE [CCS_one_one] + (ASSUME ``restr (L :'a Label set) E' = restr L E''``) in rpt STRIP_TAC \\ IMP_RES_TAC TRANS_RESTR >| (* 2 sub-goals here *) - [ FILTER_ASM_REWRITE_TAC (fn t => t !~ ``(u :'b Action) = tau``) [thm], - FILTER_ASM_REWRITE_TAC (fn t => t !~ ``(u :'b Action) = label l``) [thm] + [ FILTER_ASM_REWRITE_TAC (fn t => t !~ ``(u :'a Action) = tau``) [thm], + FILTER_ASM_REWRITE_TAC (fn t => t !~ ``(u :'a Action) = label l``) [thm] ] end); val RESTR_NIL_NO_TRANS = store_thm ("RESTR_NIL_NO_TRANS", - ``!(L :'b Label set) u E. ~(TRANS (restr L nil) u E)``, + ``!(L :'a Label set) u E. ~(TRANS (restr L nil) u E)``, rpt STRIP_TAC >> IMP_RES_TAC TRANS_RESTR (* two sub-goals here, but same proofs *) >> IMP_RES_TAC NIL_NO_TRANS); @@ -797,7 +2073,7 @@ val TRANS_RESTR_NO_NIL = store_thm ("TRANS_RESTR_NO_NIL", >> IMP_RES_TAC NIL_NO_TRANS); val RESTR_LABEL_NO_TRANS = store_thm ("RESTR_LABEL_NO_TRANS", - ``!(l :'b Label) L. (l IN L) \/ ((COMPL l) IN L) ==> + ``!(l :'a Label) L. (l IN L) \/ ((COMPL l) IN L) ==> (!E u E'. ~(TRANS (restr L (prefix (label l) E)) u E'))``, rpt STRIP_TAC (* 2 goals here *) >| [ (* goal 1 *) @@ -805,31 +2081,31 @@ val RESTR_LABEL_NO_TRANS = store_thm ("RESTR_LABEL_NO_TRANS", [ (* goal 1.1 *) IMP_RES_TAC TRANS_PREFIX \\ CHECK_ASSUME_TAC - (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``, Action_distinct] - (ASSUME ``(u :'b Action) = label l``)), + (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``, Action_distinct] + (ASSUME ``(u :'a Action) = label l``)), (* goal 1.2 *) IMP_RES_TAC TRANS_PREFIX \\ CHECK_ASSUME_TAC (MP (REWRITE_RULE - [REWRITE_RULE [ASSUME ``(u :'b Action) = label l'``, Action_11] - (ASSUME ``(u :'b Action) = label l``)] - (ASSUME ``~((l' :'b Label) IN L)``)) - (ASSUME ``(l :'b Label) IN L``)) ], + [REWRITE_RULE [ASSUME ``(u :'a Action) = label l'``, Action_11] + (ASSUME ``(u :'a Action) = label l``)] + (ASSUME ``~((l' :'a Label) IN L)``)) + (ASSUME ``(l :'a Label) IN L``)) ], (* goal 2 *) IMP_RES_TAC TRANS_RESTR >| (* 2 sub-goals here *) [ (* goal 2.1 *) IMP_RES_TAC TRANS_PREFIX \\ CHECK_ASSUME_TAC - (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``, Action_distinct] - (ASSUME ``(u :'b Action) = label l``)), + (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``, Action_distinct] + (ASSUME ``(u :'a Action) = label l``)), (* goal 2.2 *) IMP_RES_TAC TRANS_PREFIX \\ CHECK_ASSUME_TAC (MP (REWRITE_RULE - [REWRITE_RULE [ASSUME ``(u :'b Action) = label l'``, Action_11] - (ASSUME ``(u :'b Action) = label l``)] - (ASSUME ``~((COMPL (l' :'b Label)) IN L)``)) - (ASSUME ``(COMPL (l :'b Label)) IN L``)) ] ]); + [REWRITE_RULE [ASSUME ``(u :'a Action) = label l'``, Action_11] + (ASSUME ``(u :'a Action) = label l``)] + (ASSUME ``~((COMPL (l' :'a Label)) IN L)``)) + (ASSUME ``(COMPL (l :'a Label)) IN L``)) ] ]); (* |- !E rf u P. relab E rf --u-> P <=> @@ -840,7 +2116,7 @@ val RESTR_LABEL_NO_TRANS = store_thm ("RESTR_LABEL_NO_TRANS", val RELAB_cases_EQ = save_thm ("RELAB_cases_EQ", TRANS_cases |> (Q.SPEC `relab E rf`) - |> (REWRITE_RULE [CCS_distinct', CCS_11]) + |> (REWRITE_RULE [CCS_distinct', CCS_one_one]) |> (Q.SPECL [`u`, `P`]) |> (Q.GENL [`E`, `rf`, `u`, `P`])); @@ -870,7 +2146,7 @@ val TRANS_RELAB_labl = save_thm ("TRANS_RELAB_labl", Q.GENL [`E`, `labl`] (Q.SPECL [`E`, `RELAB labl`] TRANS_RELAB)); val RELAB_NIL_NO_TRANS = store_thm ("RELAB_NIL_NO_TRANS", - ``!(rf :'b Relabeling) u E. ~(TRANS (relab nil rf) u E)``, + ``!(rf :'a Relabeling) u E. ~(TRANS (relab nil rf) u E)``, rpt STRIP_TAC >> IMP_RES_TAC TRANS_RELAB >> IMP_RES_TAC NIL_NO_TRANS); @@ -882,7 +2158,7 @@ val RELAB_NIL_NO_TRANS = store_thm ("RELAB_NIL_NO_TRANS", val REC_cases_EQ = save_thm ("REC_cases_EQ", TRANS_cases |> (Q.SPEC `rec X E`) - |> (REWRITE_RULE [CCS_distinct', CCS_11]) + |> (REWRITE_RULE [CCS_distinct', CCS_one_one]) |> (Q.SPECL [`u`, `E'`]) |> (Q.GENL [`X`, `E`, `u`, `E'`])); @@ -892,276 +2168,41 @@ Theorem TRANS_REC_EQ : !X E u E'. TRANS (rec X E) u E' <=> TRANS (CCS_Subst E (rec X E) X) u E' Proof rpt GEN_TAC - >> EQ_TAC - >| [ (* goal 1 (of 2) *) - PURE_ONCE_REWRITE_TAC [REC_cases_EQ] \\ - rpt STRIP_TAC \\ - PURE_ASM_REWRITE_TAC [], - (* goal 2 (of 2) *) - PURE_ONCE_REWRITE_TAC [REC] ] + >> reverse EQ_TAC + >- PURE_ONCE_REWRITE_TAC [REC] + >> PURE_ONCE_REWRITE_TAC [REC_cases_EQ] + >> rpt STRIP_TAC + >> fs [rec_eq_thm, CCS_Subst] + >> rename1 ‘X <> Y’ + >> rename1 ‘X # P’ + (* stage work *) + >> rw [fresh_tpm_subst] + >> Q.ABBREV_TAC ‘E = [var X/Y] P’ + >> Know ‘rec X E = rec Y ([var Y/X] E)’ + >- (MATCH_MP_TAC SIMPLE_ALPHA \\ + rw [Abbr ‘E’, FV_SUB]) + >> Rewr' + >> rw [Abbr ‘E’] + >> Know ‘[var Y/X] ([var X/Y] P) = P’ + >- (MATCH_MP_TAC lemma15b >> art []) + >> Rewr' + >> Suff ‘[rec Y P/X] ([var X/Y] P) = [rec Y P/Y] P’ + >- rw [] + >> MATCH_MP_TAC lemma15a >> art [] QED val TRANS_REC = save_thm ("TRANS_REC", EQ_IMP_LR TRANS_REC_EQ); -(**********************************************************************) -(* Free and bound (recursion) variables *) -(**********************************************************************) - -(* ('a, 'b) CCS -> 'a set (set of free variables) *) -Definition FV_def : - (FV (nil :('a, 'b) CCS) = (EMPTY :'a set)) /\ - (FV (prefix u p) = FV p) /\ - (FV (sum p q) = (FV p) UNION (FV q)) /\ - (FV (par p q) = (FV p) UNION (FV q)) /\ - (FV (restr L p) = FV p) /\ - (FV (relab p rf) = FV p) /\ - (FV (var X) = {X}) /\ - (FV (rec X p) = (FV p) DELETE X) -End - -(* broken into separate theorems *) -val [FV_nil, FV_prefix, FV_sum, FV_par, - FV_restr, FV_relab, FV_var, FV_rec] = - map save_thm - (combine (["FV_nil", "FV_prefix", - "FV_sum", "FV_par", - "FV_restr", "FV_relab", - "FV_var", "FV_rec"], CONJUNCTS FV_def)); - -Theorem FV_SUBSET : - !X E E'. FV (CCS_Subst E E' X) SUBSET (FV E) UNION (FV E') -Proof - GEN_TAC >> Induct_on `E` - >> RW_TAC lset_ss [FV_def, CCS_Subst_def] - >> ASM_SET_TAC [] -QED - -(* This stronger result doesn't lead to a simpler proof - of TRANS_FV, as FV_SUBSET_REC cannot be further improved *) -Theorem FV_SUBSET_PRO : - !X E E'. FV (CCS_Subst E E' X) SUBSET ((FV E) DELETE X) UNION (FV E') -Proof - GEN_TAC >> Induct_on `E` - >> RW_TAC lset_ss [FV_def, CCS_Subst_def] - >> ASM_SET_TAC [] -QED - -Theorem FV_SUBSET_REC : - !X E. FV (CCS_Subst E (rec X E) X) SUBSET (FV E) -Proof - rpt GEN_TAC - >> ASSUME_TAC (Q.SPECL [`X`, `E`, `rec X E`] FV_SUBSET) - >> ASM_SET_TAC [FV_def] -QED - -Theorem NOTIN_FV_lemma : - !X E E'. X NOTIN FV (CCS_Subst E (rec X E') X) -Proof - GEN_TAC >> Induct_on `E` - >> RW_TAC lset_ss [CCS_Subst_def, FV_def] -QED - -Theorem FV_SUBSET_REC_PRO : - !X E. FV (CCS_Subst E (rec X E) X) SUBSET (FV E) DELETE X -Proof - rpt GEN_TAC - >> ASSUME_TAC (Q.SPECL [`X`, `E`] FV_SUBSET_REC) - >> ASSUME_TAC (Q.SPECL [`X`, `E`, `E`] NOTIN_FV_lemma) - >> ASM_SET_TAC [] -QED - Theorem TRANS_FV : !E u E'. TRANS E u E' ==> FV E' SUBSET (FV E) Proof HO_MATCH_MP_TAC TRANS_IND (* strongind is useless *) - >> RW_TAC lset_ss [FV_def] (* 7 subgoals *) + >> RW_TAC set_ss [FV_thm] (* 7 subgoals *) >> TRY (ASM_SET_TAC []) (* 1 - 6 *) >> MATCH_MP_TAC SUBSET_TRANS >> Q.EXISTS_TAC `FV (CCS_Subst E (rec X E) X)` >> POP_ASSUM (REWRITE_TAC o wrap) - >> REWRITE_TAC [FV_SUBSET_REC_PRO] -QED - -Theorem CCS_Subst_elim : - !X E. X NOTIN (FV E) ==> !E'. (CCS_Subst E E' X = E) -Proof - GEN_TAC >> Induct_on `E` (* 8 subgoals *) - >> RW_TAC lset_ss [CCS_Subst_def, FV_def] (* one left *) - >> Cases_on `a = X` >- fs [] - >> RES_TAC >> ASM_SIMP_TAC std_ss [] -QED - -Theorem CCS_Subst_elim_IMP_NOTIN : - !X E. (!E'. CCS_Subst E E' X = E) ==> X NOTIN (FV E) -Proof - GEN_TAC >> Induct_on `E` (* 8 subgoals *) - >> RW_TAC lset_ss [CCS_Subst_def, FV_def] (* 2 goals left *) - >- (CCONTR_TAC >> fs [] \\ - PROVE_TAC [Q.SPEC `var a` CCS_distinct_exists]) - >> Cases_on `X = a` >- fs [] - >> DISJ1_TAC >> fs [] -QED - -(* if E[t/X] = E[t'/X] for all t t', X must not be free in E *) -Theorem CCS_Subst_IMP_NOTIN_FV : - !X E. (!E1 E2. CCS_Subst E E1 X = CCS_Subst E E2 X) ==> X NOTIN (FV E) -Proof - Suff `!X E. X IN (FV E) ==> ?E1 E2. CCS_Subst E E1 X <> CCS_Subst E E2 X` - >- METIS_TAC [] - >> GEN_TAC >> Induct_on `E` (* 8 subgoals *) - >> RW_TAC lset_ss [CCS_Subst_def, FV_def] (* 5 subgoals left *) - >- (Q.EXISTS_TAC `nil` >> METIS_TAC [CCS_distinct_exists]) >> - RES_TAC >> take [`E1`, `E2`] >> art [] -QED - -Theorem FV_REC_PREF : - !X E u E'. FV (CCS_Subst E (rec X (prefix u E')) X) = - FV (CCS_Subst E (rec X E') X) -Proof - GEN_TAC >> Induct_on `E` - >> RW_TAC lset_ss [CCS_Subst_def, FV_def] -QED - -Theorem FV_REC_SUM : - !X E E1 E2. FV (CCS_Subst E (rec X (E1 + E2)) X) = - (FV (CCS_Subst E (rec X E1) X)) UNION (FV (CCS_Subst E (rec X E2) X)) -Proof - GEN_TAC >> Induct_on `E` - >> RW_TAC lset_ss [CCS_Subst_def, FV_def] (* 4 subgoals *) - >> SET_TAC [] -QED - -Theorem FV_REC_PAR : - !X E E1 E2. FV (CCS_Subst E (rec X (par E1 E2)) X) = - (FV (CCS_Subst E (rec X E1) X)) UNION (FV (CCS_Subst E (rec X E2) X)) -Proof - GEN_TAC >> Induct_on `E` - >> RW_TAC lset_ss [CCS_Subst_def, FV_def] (* 4 subgoals *) - >> SET_TAC [] -QED - -Theorem FINITE_FV : - !E. FINITE (FV E) -Proof - Induct_on `E` - >> RW_TAC lset_ss [CCS_Subst_def, FV_def] -QED - -(* ('a, 'b) CCS -> 'a set (set of bound variables) *) -Definition BV_def : - (BV (nil :('a, 'b) CCS) = (EMPTY :'a set)) /\ - (BV (prefix u p) = BV p) /\ - (BV (sum p q) = (BV p) UNION (BV q)) /\ - (BV (par p q) = (BV p) UNION (BV q)) /\ - (BV (restr L p) = BV p) /\ - (BV (relab p rf) = BV p) /\ - (BV (var X) = EMPTY) /\ - (BV (rec X p) = X INSERT (BV p)) -End - -(* broken into separate theorems *) -val [BV_nil, BV_prefix, BV_sum, BV_par, - BV_restr, BV_relab, BV_var, BV_rec] = - map save_thm - (combine (["BV_nil", "BV_prefix", - "BV_sum", "BV_par", - "BV_restr", "BV_relab", - "BV_var", "BV_rec"], CONJUNCTS BV_def)); - -Theorem BV_SUBSET : - !X E E'. BV (CCS_Subst E E' X) SUBSET (BV E) UNION (BV E') -Proof - GEN_TAC >> Induct_on `E` - >> RW_TAC lset_ss [BV_def, CCS_Subst_def] - >> ASM_SET_TAC [] -QED - -Theorem BV_SUBSET_REC : - !X E. BV (CCS_Subst E (rec X E) X) SUBSET (X INSERT (BV E)) -Proof - rpt GEN_TAC - >> ASSUME_TAC (Q.SPECL [`X`, `E`, `rec X E`] BV_SUBSET) - >> ASM_SET_TAC [BV_def] -QED - -Theorem TRANS_BV : - !E u E'. TRANS E u E' ==> BV E' SUBSET BV E -Proof - HO_MATCH_MP_TAC TRANS_ind - >> RW_TAC lset_ss [BV_def] (* 7 subgoals *) - >> TRY (ASM_SET_TAC []) (* 1 - 6 *) - >> MATCH_MP_TAC SUBSET_TRANS - >> Q.EXISTS_TAC `BV (CCS_Subst E (rec X E) X)` >> art [] - >> fs [BV_SUBSET_REC] -QED - -Theorem BV_REC : - !X E. X IN BV (rec X E) -Proof - RW_TAC std_ss [BV_def, IN_INSERT] -QED - -Theorem BV_SUBSET_rules : - !X E E'. (BV E) SUBSET (BV (rec X E)) /\ - (BV E) SUBSET (BV (sum E E')) /\ - (BV E') SUBSET (BV (sum E E')) /\ - (BV E) SUBSET (BV (par E E')) /\ - (BV E') SUBSET (BV (par E E')) -Proof - rpt GEN_TAC >> SET_TAC [BV_def] -QED - -Theorem FINITE_BV : - !E. FINITE (BV E) -Proof - Induct_on `E` - >> RW_TAC lset_ss [CCS_Subst_def, BV_def] -QED - -Definition IS_PROC_def : - IS_PROC E <=> (FV E = EMPTY) -End - -Definition ALL_PROC_def : - ALL_PROC Es <=> EVERY IS_PROC Es -End - -Theorem IS_PROC_EL : - !Es n. ALL_PROC Es /\ n < LENGTH Es ==> IS_PROC (EL n Es) -Proof - RW_TAC list_ss [ALL_PROC_def, EVERY_MEM, MEM_EL] - >> FIRST_X_ASSUM MATCH_MP_TAC - >> Q.EXISTS_TAC `n` >> art [] -QED - -Theorem IS_PROC_prefix : - !P u. IS_PROC (prefix u P) <=> IS_PROC P -Proof - RW_TAC std_ss [IS_PROC_def, FV_def] -QED - -Theorem IS_PROC_sum : - !P Q. IS_PROC (sum P Q) <=> IS_PROC P /\ IS_PROC Q -Proof - RW_TAC lset_ss [IS_PROC_def, FV_def] -QED - -Theorem IS_PROC_par : - !P Q. IS_PROC (par P Q) <=> IS_PROC P /\ IS_PROC Q -Proof - RW_TAC lset_ss [IS_PROC_def, FV_def] -QED - -Theorem IS_PROC_restr : - !P L. IS_PROC (restr L P) <=> IS_PROC P -Proof - RW_TAC lset_ss [IS_PROC_def, FV_def] -QED - -Theorem IS_PROC_relab : - !P rf. IS_PROC (relab P rf) <=> IS_PROC P -Proof - RW_TAC lset_ss [IS_PROC_def, FV_def] + >> REWRITE_TAC [FV_SUBSET_REC'] QED Theorem TRANS_PROC : @@ -1172,138 +2213,49 @@ Proof >> rfs [] QED -(**********************************************************************) -(* Free and bound names (sorts) ('b) *) -(**********************************************************************) - -(* To be moved to rich_listTheory *) -Definition DELETE_ELEMENT : - (DELETE_ELEMENT e [] = []) /\ - (DELETE_ELEMENT e (x :: l) = if (e = x) then DELETE_ELEMENT e l - else x :: DELETE_ELEMENT e l) -End - -Theorem NOT_IN_DELETE_ELEMENT : - !e L. ~MEM e (DELETE_ELEMENT e L) -Proof - GEN_TAC >> Induct_on `L` - >- REWRITE_TAC [DELETE_ELEMENT, MEM] - >> GEN_TAC >> REWRITE_TAC [DELETE_ELEMENT] - >> Cases_on `e = h` >> fs [] -QED - -Theorem DELETE_ELEMENT_FILTER : - !e L. DELETE_ELEMENT e L = FILTER ((<>) e) L -Proof - GEN_TAC >> Induct_on `L` - >- REWRITE_TAC [DELETE_ELEMENT, FILTER] - >> GEN_TAC >> REWRITE_TAC [DELETE_ELEMENT, FILTER] - >> Cases_on `e = h` >> fs [] -QED - -Theorem LENGTH_DELETE_ELEMENT_LEQ : - !e L. LENGTH (DELETE_ELEMENT e L) <= LENGTH L -Proof - rpt GEN_TAC - >> REWRITE_TAC [DELETE_ELEMENT_FILTER] - >> MP_TAC (Q.SPECL [`\y. e <> y`, `\y. T`] LENGTH_FILTER_LEQ_MONO) - >> BETA_TAC >> simp [] -QED - -Theorem LENGTH_DELETE_ELEMENT_LE : - !e L. MEM e L ==> LENGTH (DELETE_ELEMENT e L) < LENGTH L -Proof - rpt GEN_TAC >> Induct_on `L` - >- REWRITE_TAC [MEM] - >> GEN_TAC >> REWRITE_TAC [MEM, DELETE_ELEMENT] - >> Cases_on `e = h` >> fs [] - >> MP_TAC (Q.SPECL [`h`, `L`] LENGTH_DELETE_ELEMENT_LEQ) - >> KILL_TAC >> RW_TAC arith_ss [] -QED +Theorem TRANS_closed = TRANS_PROC + +(* ---------------------------------------------------------------------- + Set up the recursion functionality in binderLib + ---------------------------------------------------------------------- *) + +val lemma = prove( + “(!x y t. pmact apm [(x,y)] (h t) = h (tpm [(x,y)] t)) <=> + !pi t. pmact apm pi (h t) = h (tpm pi t)”, + simp_tac (srw_ss()) [EQ_IMP_THM] + >> ONCE_REWRITE_TAC [EQ_SYM_EQ] + >> strip_tac >> Induct_on ‘pi’ + >> asm_simp_tac (srw_ss()) [pmact_nil, pairTheory.FORALL_PROD] + >> srw_tac [][Once tpm_CONS] >> srw_tac [][GSYM pmact_decompose]); + +Theorem tm_recursion_nosideset = + tm_recursion |> Q.INST [‘A’ |-> ‘{}’] |> SIMP_RULE (srw_ss()) [lemma] + +val term_info_string = + "local\n\ + \fun k |-> v = {redex = k, residue = v}\n\ + \open binderLib\n\ + \val term_info = \n\ + \ {nullfv = “rec \"\" (var \"\") :'a CCS”,\n\ + \ pm_rewrites = [],\n\ + \ pm_constant = “(nomset$mk_pmact CCS$raw_tpm) :'a CCS pmact”,\n\ + \ fv_rewrites = [],\n\ + \ recursion_thm = SOME tm_recursion_nosideset,\n\ + \ binders = [(“CCS$rec :string -> 'a CCS -> 'a CCS”, 0, tpm_ALPHA)]}\n\ + \val _ = binderLib.type_db :=\n\ + \ Binarymap.insert(!binderLib.type_db,\n\ + \ {Thy=\"CCS\", Name = \"CCS\"},\n\ + \ binderLib.NTI term_info)\n\ + \in end;\n"; + +val _ = adjoin_after_completion (fn _ => PP.add_string term_info_string); -Theorem EVERY_DELETE_ELEMENT : - !e L P. P e /\ EVERY P (DELETE_ELEMENT e L) ==> EVERY P L -Proof - GEN_TAC >> Induct_on `L` - >- RW_TAC std_ss [DELETE_ELEMENT] - >> rpt GEN_TAC >> REWRITE_TAC [DELETE_ELEMENT] - >> Cases_on `e = h` >> fs [] -QED +val _ = export_theory (); +val _ = html_theory "CCS"; -Theorem DELETE_ELEMENT_APPEND : - !a L L'. DELETE_ELEMENT a (L ++ L') = - DELETE_ELEMENT a L ++ DELETE_ELEMENT a L' -Proof - REWRITE_TAC [DELETE_ELEMENT_FILTER] - >> REWRITE_TAC [GSYM FILTER_APPEND_DISTRIB] -QED +(* Bibliography: -(* Learnt from Robert Beers (not used so far) *) -Definition ALL_IDENTICAL : - ALL_IDENTICAL t = ?x. !y. MEM y t ==> (y = x) -End + [1] Milner, Robin. Communication and concurrency. Prentice hall, 1989. + [2] Gorrieri, R., Versari, C.: Introduction to Concurrency Theory. Springer (2015). -(* (FN :('a, 'b) CCS -> 'a list -> 'b Label set) *) -val FN_definition = ` - (FN (nil :('a, 'b) CCS) J = (EMPTY :'b Label set)) /\ - (FN (prefix (label l) p) J = l INSERT (FN p J)) /\ (* here! *) - (FN (prefix tau p) J = FN p J) /\ - (FN (sum p q) J = (FN p J) UNION (FN q J)) /\ - (FN (par p q) J = (FN p J) UNION (FN q J)) /\ - (FN (restr L p) J = (FN p J) DIFF (L UNION (IMAGE COMPL_LAB L))) /\ - (FN (relab p rf) J = IMAGE (REP_Relabeling rf) (FN p J)) /\ (* here *) - (FN (var X) J = EMPTY) /\ - (FN (rec X p) J = if (MEM X J) then - FN (CCS_Subst p (rec X p) X) (DELETE_ELEMENT X J) - else EMPTY)`; - -(* (BN :('a, 'b) CCS -> 'a list -> 'b Label set) *) -val BN_definition = ` - (BN (nil :('a, 'b) CCS) J = (EMPTY :'b Label set)) /\ - (BN (prefix u p) J = BN p J) /\ - (BN (sum p q) J = (BN p J) UNION (BN q J)) /\ - (BN (par p q) J = (BN p J) UNION (BN q J)) /\ - (BN (restr L p) J = (BN p J) UNION L) /\ (* here *) - (BN (relab p rf) J = BN p J) /\ - (BN (var X) J = EMPTY) /\ - (BN (rec X p) J = if (MEM X J) then - BN (CCS_Subst p (rec X p) X) (DELETE_ELEMENT X J) - else EMPTY)`; - -(* This is how we get the correct tactics (FN_tac): - - val FN_defn = Hol_defn "FN" FN_definition; - - Defn.tgoal FN_defn; *) -local - val tactic = (* the use of `($< LEX $<)` is learnt from Ramana Kumar *) - WF_REL_TAC `inv_image ($< LEX $<) - (\x. (LENGTH (SND x), ^CCS_size_tm (\x. 0) (\x. 0) (FST x)))` - >> rpt STRIP_TAC >- (IMP_RES_TAC LENGTH_DELETE_ELEMENT_LE >> art []) - >> REWRITE_TAC [CCS_size_def] - >> simp []; -in - val FN_def = TotalDefn.tDefine "FN" FN_definition tactic; - val BN_def = TotalDefn.tDefine "BN" BN_definition tactic; -end; - -(* (free_names :('a, 'b) CCS -> 'b Label set) collects all visible - labels (also called "sorts") as the prefix, w.r.t relabeling operators. *) -val free_names_def = Define - `free_names p = FN p (SET_TO_LIST (BV p))`; - -(* (bound_names :('a, 'b) CCS -> 'b Label set) collects all visible - labels by the restriction operator. *) -val bound_names_def = Define - `bound_names p = BN p (SET_TO_LIST (BV p))`; - -val FN_UNIV1 = store_thm ("FN_UNIV1", - ``!p. free_names p <> (UNIV :'b Label set) ==> ?a. a NOTIN free_names p``, - PROVE_TAC [EQ_UNIV]); - -val FN_UNIV2 = store_thm ("FN_UNIV2", - ``!p q. free_names p UNION free_names q <> (UNIV :'b Label set) ==> - ?a. a NOTIN free_names p /\ a NOTIN free_names q``, - PROVE_TAC [EQ_UNIV, IN_UNION]); - -val _ = export_theory (); -val _ = html_theory "CCS"; diff --git a/examples/CCS/CCSSyntax.sml b/examples/CCS/CCSSyntax.sml index ce261e7d43..4c84fd0ac0 100644 --- a/examples/CCS/CCSSyntax.sml +++ b/examples/CCS/CCSSyntax.sml @@ -214,5 +214,3 @@ in end; end (* struct *) - -(* last updated: May 14, 2017 *) diff --git a/examples/CCS/CoarsestCongrScript.sml b/examples/CCS/CoarsestCongrScript.sml index 0f58fd4937..3646396ad4 100644 --- a/examples/CCS/CoarsestCongrScript.sml +++ b/examples/CCS/CoarsestCongrScript.sml @@ -1,18 +1,19 @@ -(* - * Copyright 1991-1995 University of Cambridge (Author: Monica Nesi) - * Copyright 2017 University of Bologna (Author: Chun Tian) - *) +(* ========================================================================== *) +(* FILE : CoarsestCongrScript.sml *) +(* DESCRIPTION : The coarsest congruence contained in weal bisimilarity *) +(* *) +(* COPYRIGHTS : 1991-1995 University of Cambridge (Monica Nesi) *) +(* 2016-2017 University of Bologna, Italy (Chun Tian) *) +(******************************************************************************) open HolKernel Parse boolLib bossLib; open pred_setTheory relationTheory pairTheory sumTheory listTheory; open prim_recTheory arithmeticTheory combinTheory; -open CCSLib CCSTheory; -open StrongEQTheory StrongEQLib StrongLawsTheory; -open WeakEQTheory WeakEQLib WeakLawsTheory; -open ObsCongrTheory ObsCongrLib ObsCongrLawsTheory ObsCongrConv; -open TraceTheory CongruenceTheory; +open CCSLib CCSTheory StrongEQTheory StrongEQLib + StrongLawsTheory WeakEQTheory WeakEQLib WeakLawsTheory ObsCongrTheory + ObsCongrLib ObsCongrLawsTheory ObsCongrConv TraceTheory CongruenceTheory; val _ = new_theory "CoarsestCongr"; val _ = temp_loose_equality (); @@ -188,21 +189,22 @@ val OBS_CONGR_IMP_WEAK_CONGR = store_thm ((* NEW *) >> IMP_RES_TAC CC_is_coarsest >> ASM_REWRITE_TAC []); -val SUM_EQUIV = new_definition ((* NEW *) - "SUM_EQUIV", ``SUM_EQUIV = (\p q. !r. WEAK_EQUIV (sum p r) (sum q r))``); - -val WEAK_CONGR_IMP_SUM_EQUIV = store_thm ((* NEW *) - "WEAK_CONGR_IMP_SUM_EQUIV", - ``!p q. WEAK_CONGR p q ==> SUM_EQUIV p q``, - REWRITE_TAC [WEAK_CONGR, SUM_EQUIV, CC_def] - >> BETA_TAC >> rpt STRIP_TAC - >> POP_ASSUM MP_TAC - >> Know `CONTEXT (\(t :('a, 'b) CCS). t) /\ CONTEXT (\t. r)` - >- REWRITE_TAC [CONTEXT1, CONTEXT2] +Definition SUM_EQUIV : + SUM_EQUIV = (\p q. !r. WEAK_EQUIV (sum p r) (sum q r)) +End + +Theorem WEAK_CONGR_IMP_SUM_EQUIV : + !p q. WEAK_CONGR p q ==> SUM_EQUIV p q +Proof + rw [WEAK_CONGR, SUM_EQUIV, CC_def] + >> Q.PAT_X_ASSUM ‘!c. CONTEXT c ==> _’ MP_TAC + >> Know `CONTEXT (\(t :'a CCS). t) /\ CONTEXT (\t. r)` + >- rw [CONTEXT1, CONTEXT2] >> DISCH_TAC >> POP_ASSUM (ASSUME_TAC o (MATCH_MP CONTEXT4)) >> DISCH_TAC >> RES_TAC - >> POP_ASSUM (MP_TAC o BETA_RULE) >> Rewr); + >> POP_ASSUM (MP_TAC o BETA_RULE) >> Rewr +QED (******************************************************************************) (* *) @@ -210,27 +212,29 @@ val WEAK_CONGR_IMP_SUM_EQUIV = store_thm ((* NEW *) (* *) (******************************************************************************) -val COARSEST_CONGR_LR = store_thm ((* NEW *) - "COARSEST_CONGR_LR", - ``!p q. OBS_CONGR p q ==> !r. WEAK_EQUIV (sum p r) (sum q r)``, +Theorem COARSEST_CONGR_LR : + !p q. OBS_CONGR p q ==> !r. WEAK_EQUIV (sum p r) (sum q r) +Proof rpt STRIP_TAC >> MATCH_MP_TAC OBS_CONGR_IMP_WEAK_EQUIV - >> RW_TAC std_ss [OBS_CONGR_SUBST_SUM_R]); + >> RW_TAC std_ss [OBS_CONGR_SUBST_SUM_R] +QED (* The property as assumptions on processes in COARSEST_CONGR_THM *) -val free_action_def = Define ` - free_action p = ?a. !p'. ~(WEAK_TRANS p (label a) p')`; - -val COARSEST_CONGR_RL = store_thm ((* NEW *) - "COARSEST_CONGR_RL", - ``!p q. free_action p /\ free_action q ==> - (!r. WEAK_EQUIV (sum p r) (sum q r)) ==> OBS_CONGR p q``, - REWRITE_TAC [free_action_def, OBS_CONGR] +Definition free_action_def : + free_action p = ?a. !p'. ~(WEAK_TRANS p (label a) p') +End + +Theorem COARSEST_CONGR_RL : + !p q. free_action p /\ free_action q ==> + (!r. WEAK_EQUIV (sum p r) (sum q r)) ==> OBS_CONGR p q +Proof + rw [free_action_def, OBS_CONGR] >> rpt STRIP_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) ASSUME_TAC (Q.SPEC `prefix (label a) nil` (ASSUME ``!r. WEAK_EQUIV (sum p r) (sum q r)``)) \\ - IMP_RES_TAC SUM1 \\ + fs [] >> IMP_RES_TAC SUM1 \\ POP_ASSUM (ASSUME_TAC o (Q.SPEC `prefix (label a) nil`)) \\ Cases_on `u` >| (* 2 sub-goals here *) [ (* goal 1.1 (of 2) *) @@ -246,7 +250,7 @@ val COARSEST_CONGR_RL = store_thm ((* NEW *) (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] (ASSUME ``WEAK_EQUIV E1 E2``)) \\ RES_TAC \\ IMP_RES_TAC TRANS_TAU_AND_WEAK \\ - RES_TAC, (* initial assumption of `p` is used here *) + RES_TAC, (* goal 1.1.2 (of 2) *) PAT_X_ASSUM ``TRANS (sum q (prefix (label a) nil)) tau u`` (STRIP_ASSUME_TAC o (MATCH_MP TRANS_SUM)) >| (* 2 sub-goals here *) @@ -290,7 +294,7 @@ val COARSEST_CONGR_RL = store_thm ((* NEW *) (* goal 2, completely symmetric with goal 1 *) ASSUME_TAC (Q.SPEC `prefix (label a') nil` (ASSUME ``!r. WEAK_EQUIV (sum p r) (sum q r)``)) \\ - IMP_RES_TAC SUM1 \\ + fs [] >> IMP_RES_TAC SUM1 \\ POP_ASSUM (ASSUME_TAC o (Q.SPEC `prefix (label a') nil`)) \\ Cases_on `u` >| (* 2 sub-goals here *) [ (* goal 2.1 (of 2) *) @@ -345,7 +349,8 @@ val COARSEST_CONGR_RL = store_thm ((* NEW *) PAT_X_ASSUM ``label L = label a'`` (ASSUME_TAC o (REWRITE_RULE [Action_11])) \\ `TRANS q (label a') E2` by RW_TAC std_ss [] \\ POP_ASSUM (ASSUME_TAC o (MATCH_MP TRANS_IMP_WEAK_TRANS)) \\ - RES_TAC ] ] ] ] ); (* initial assumption of `q` is used here *) + RES_TAC ] ] ] ] +QED (* Theorem 4.5. (Coarsest congruence contained in WEAK_EQUIV) in Gorrieri's book. OBS_CONGR congruences theorems shouldn't depend on this result. @@ -366,19 +371,19 @@ val COARSEST_CONGR_THM = store_thm ((* NEW *) (******************************************************************************) (* The shared core lemma used in PROP3's proof *) -val PROP3_COMMON = store_thm ((* NEW *) - "PROP3_COMMON", - ``!p q. (?k. STABLE k /\ +Theorem PROP3_COMMON : + !p q. (?k. STABLE k /\ closed k /\ (!p' u. WEAK_TRANS p u p' ==> ~(WEAK_EQUIV p' k)) /\ (!q' u. WEAK_TRANS q u q' ==> ~(WEAK_EQUIV q' k))) ==> - (!r. WEAK_EQUIV (sum p r) (sum q r)) ==> OBS_CONGR p q``, + (!r. WEAK_EQUIV (sum p r) (sum q r)) ==> OBS_CONGR p q +Proof rpt STRIP_TAC - >> PAT_X_ASSUM ``!r. WEAK_EQUIV (sum p r) (sum q r)`` - (ASSUME_TAC o (Q.SPEC `prefix (label a) k`)) + >> Q.PAT_X_ASSUM ‘!r. WEAK_EQUIV (sum p r) (sum q r)’ + (ASSUME_TAC o (Q.SPEC ‘prefix (label a) k’)) >> REWRITE_TAC [OBS_CONGR] >> rpt STRIP_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) - IMP_RES_TAC SUM1 \\ + rfs [] >> IMP_RES_TAC SUM1 \\ POP_ASSUM (ASSUME_TAC o (Q.SPEC `prefix (label a) k`)) \\ PAT_X_ASSUM ``WEAK_EQUIV (sum p (prefix (label a) k)) (sum q (prefix (label a) k))`` (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR])) \\ @@ -448,7 +453,7 @@ val PROP3_COMMON = store_thm ((* NEW *) IMP_RES_TAC TRANS_PREFIX \\ RW_TAC std_ss [Action_11] ] ] ] ], (* goal 2 (of 2), almost symmetric with goal 1 *) - IMP_RES_TAC SUM1 \\ + rfs [] >> IMP_RES_TAC SUM1 \\ POP_ASSUM (ASSUME_TAC o (Q.SPEC `prefix (label a) k`)) \\ PAT_X_ASSUM ``WEAK_EQUIV (sum p (prefix (label a) k)) (sum h (prefix (label a) k))`` (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR])) \\ @@ -517,25 +522,33 @@ val PROP3_COMMON = store_thm ((* NEW *) IMP_RES_TAC TRANS_AND_EPS, (* goal 2.2.2.2.2 (of 2) *) IMP_RES_TAC TRANS_PREFIX \\ - RW_TAC std_ss [Action_11] ] ] ] ] ]); + RW_TAC std_ss [Action_11] ] ] ] ] ] +QED (* A variant of Proposition 9 (Jan Willem Klop) from [vGl05]. In this theory, all CCS processes are finitary, and this makes the lemma relatively easy. *) -(* (KLOP :'b Label -> num -> ('a, 'b) CCS) *) +(* (KLOP :'a Label -> num -> 'a CCS) *) val KLOP_def = Define ` - (KLOP (a: 'b Label) (0 :num) = nil) /\ + (KLOP (a: 'a Label) (0 :num) = nil) /\ (KLOP a (SUC n) = sum (KLOP a n) (prefix (label a) (KLOP a n))) `; +Theorem KLOP_closed : + !a n. closed (KLOP a n) +Proof + Q.X_GEN_TAC ‘a’ + >> Induct_on ‘n’ >> rw [KLOP_def] +QED + val K0_NO_TRANS = store_thm ( - "K0_NO_TRANS", ``!(a :'b Label) u E. ~(TRANS (KLOP a 0) u E)``, + "K0_NO_TRANS", ``!(a :'a Label) u E. ~(TRANS (KLOP a 0) u E)``, rpt GEN_TAC >> REWRITE_TAC [KLOP_def] >> REWRITE_TAC [NIL_NO_TRANS]); (* Klop processes are STABLE. *) val KLOP_PROP0 = store_thm ((* NEW *) - "KLOP_PROP0", ``!(a :'b Label) n. STABLE (KLOP a n)``, + "KLOP_PROP0", ``!(a :'a Label) n. STABLE (KLOP a n)``, GEN_TAC >> Induct_on `n` (* 2 sub-goals here *) >- REWRITE_TAC [STABLE, KLOP_def, NIL_NO_TRANS] @@ -551,7 +564,7 @@ val KLOP_PROP0 = store_thm ((* NEW *) this also implies that Klop processes are tau-free. *) val KLOP_PROP1_LR = store_thm ((* NEW *) "KLOP_PROP1_LR", - ``!(a :'b Label) n E. TRANS (KLOP a n) (label a) E ==> ?m. m < n /\ (E = KLOP a m)``, + ``!(a :'a Label) n E. TRANS (KLOP a n) (label a) E ==> ?m. m < n /\ (E = KLOP a m)``, GEN_TAC >> Induct_on `n` (* 2 sub-goals here, first one is easy *) >- PROVE_TAC [K0_NO_TRANS] @@ -571,7 +584,7 @@ val KLOP_PROP1_LR = store_thm ((* NEW *) val KLOP_PROP1_RL = store_thm ((* NEW *) "KLOP_PROP1_RL", - ``!(a :'b Label) n E. (?m. m < n /\ (E = KLOP a m)) ==> TRANS (KLOP a n) (label a) E``, + ``!(a :'a Label) n E. (?m. m < n /\ (E = KLOP a m)) ==> TRANS (KLOP a n) (label a) E``, GEN_TAC >> Induct_on `n` (* 2 sub-goals here *) >> rpt STRIP_TAC @@ -588,7 +601,7 @@ val KLOP_PROP1_RL = store_thm ((* NEW *) (* Klop processes are closed under transition *) val KLOP_PROP1 = store_thm ((* NEW *) "KLOP_PROP1", - ``!(a :'b Label) n E. TRANS (KLOP a n) (label a) E = (?m. m < n /\ (E = KLOP a m))``, + ``!(a :'a Label) n E. TRANS (KLOP a n) (label a) E = (?m. m < n /\ (E = KLOP a m))``, rpt GEN_TAC >> EQ_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) @@ -599,7 +612,7 @@ val KLOP_PROP1 = store_thm ((* NEW *) (* Klop processes are closed under weak transition *) val KLOP_PROP1' = store_thm ((* NEW *) "KLOP_PROP1'", - ``!(a :'b Label) n E. WEAK_TRANS (KLOP a n) (label a) E = (?m. m < n /\ (E = KLOP a m))``, + ``!(a :'a Label) n E. WEAK_TRANS (KLOP a n) (label a) E = (?m. m < n /\ (E = KLOP a m))``, rpt GEN_TAC >> EQ_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) @@ -624,37 +637,37 @@ val KLOP_PROP1' = store_thm ((* NEW *) (* Klop processes are strongly distinct with each other *) val KLOP_PROP2 = store_thm ((* NEW *) "KLOP_PROP2", - ``!(a :'b Label) n m. m < n ==> ~(STRONG_EQUIV (KLOP a m) (KLOP a n))``, + ``!(a :'a Label) n m. m < n ==> ~(STRONG_EQUIV (KLOP a m) (KLOP a n))``, GEN_TAC >> completeInduct_on `n` >> rpt STRIP_TAC >> `TRANS (KLOP a n) (label a) (KLOP a m)` by PROVE_TAC [KLOP_PROP1] >> STRIP_ASSUME_TAC (((Q.SPEC `label a`) o (ONCE_REWRITE_RULE [PROPERTY_STAR])) - (ASSUME ``STRONG_EQUIV (KLOP (a :'b Label) m) (KLOP a n)``)) + (ASSUME ``STRONG_EQUIV (KLOP (a :'a Label) m) (KLOP a n)``)) >> RES_TAC - >> PAT_X_ASSUM ``TRANS (KLOP (a :'b Label) m) (label a) E1`` + >> PAT_X_ASSUM ``TRANS (KLOP (a :'a Label) m) (label a) E1`` (STRIP_ASSUME_TAC o (REWRITE_RULE [KLOP_PROP1])) >> PROVE_TAC []); (* Klop processes are weakly distinct with each other *) val KLOP_PROP2' = store_thm ((* NEW *) "KLOP_PROP2'", - ``!(a :'b Label) n m. m < n ==> ~(WEAK_EQUIV (KLOP a m) (KLOP a n))``, + ``!(a :'a Label) n m. m < n ==> ~(WEAK_EQUIV (KLOP a m) (KLOP a n))``, GEN_TAC >> completeInduct_on `n` >> rpt STRIP_TAC >> `TRANS (KLOP a n) (label a) (KLOP a m)` by PROVE_TAC [KLOP_PROP1] >> STRIP_ASSUME_TAC (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] - (ASSUME ``WEAK_EQUIV (KLOP (a :'b Label) m) (KLOP a n)``)) + (ASSUME ``WEAK_EQUIV (KLOP (a :'a Label) m) (KLOP a n)``)) >> RES_TAC - >> PAT_X_ASSUM ``WEAK TRANS (KLOP (a :'b Label) m) (label a) E1`` + >> PAT_X_ASSUM ``WEAK TRANS (KLOP (a :'a Label) m) (label a) E1`` (STRIP_ASSUME_TAC o (REWRITE_RULE [KLOP_PROP1'])) >> PROVE_TAC []); val KLOP_ONE_ONE = store_thm ((* NEW *) - "KLOP_ONE_ONE", ``!(a :'b Label). ONE_ONE (KLOP a)``, + "KLOP_ONE_ONE", ``!(a :'a Label). ONE_ONE (KLOP a)``, REWRITE_TAC [ONE_ONE_DEF] >> BETA_TAC >> rpt STRIP_TAC @@ -698,9 +711,6 @@ val KLOP_ONE_ONE = store_thm ((* NEW *) *) -val IN_APP = Q.prove (`!x P. (x IN P) = P x`, - SIMP_TAC bool_ss [IN_DEF]); - (* The pure Math part in the proof of KLOP_LEMMA_FINITE *) val INFINITE_EXISTS_LEMMA = store_thm ((* NEW *) "INFINITE_EXISTS_LEMMA", @@ -764,12 +774,12 @@ val INFINITE_EXISTS_LEMMA = store_thm ((* NEW *) RES_TAC ] ) >> DISCH_TAC >> ASM_REWRITE_TAC []); -val KLOP_LEMMA_FINITE = store_thm ((* NEW *) - "KLOP_LEMMA_FINITE", - ``!p q. finite_state p /\ finite_state q ==> - ?k. STABLE k /\ +Theorem KLOP_LEMMA_FINITE : + !p q. finite_state p /\ finite_state q ==> + ?k. STABLE k /\ closed k /\ (!p' u. WEAK_TRANS p u p' ==> ~(WEAK_EQUIV p' k)) /\ - (!q' u. WEAK_TRANS q u q' ==> ~(WEAK_EQUIV q' k))``, + (!q' u. WEAK_TRANS q u q' ==> ~(WEAK_EQUIV q' k)) +Proof rpt STRIP_TAC (* Part 1: assert that the union of all nodes in g and h is finite *) >> PAT_X_ASSUM ``finite_state p`` @@ -785,7 +795,7 @@ val KLOP_LEMMA_FINITE = store_thm ((* NEW *) 3. FINITE nodes *) (* Part 2: assert an infinite set of Klop processes *) - >> Q.ABBREV_TAC `a = (ARB :'b Label)` + >> Q.ABBREV_TAC `a = (ARB :'a Label)` >> Q.ABBREV_TAC `f = KLOP a` >> `!x y. (f x = f y) ==> (x = y)` by PROVE_TAC [KLOP_ONE_ONE, ONE_ONE_DEF] >> Q.ABBREV_TAC `klops = IMAGE f (UNIV :num set)` @@ -813,9 +823,9 @@ val KLOP_LEMMA_FINITE = store_thm ((* NEW *) (* Part 4: assert the existence of k *) >> ASSUME_TAC WEAK_EQUIV_equivalence >> POP_ASSUM (MP_TAC o - (MATCH_MP (ISPECL [``WEAK_EQUIV :('a, 'b) simulation``, - ``nodes :('a, 'b) CCS -> bool``, - ``klops :('a, 'b) CCS -> bool``] INFINITE_EXISTS_LEMMA))) + (MATCH_MP (ISPECL [``WEAK_EQUIV :'a simulation``, + ``nodes :'a CCS -> bool``, + ``klops :'a CCS -> bool``] INFINITE_EXISTS_LEMMA))) >> RW_TAC std_ss [] (* 9. ∀x y. x ∈ klops ∧ y ∈ klops ∧ x ≠ y ⇒ ¬(x ≈ y) @@ -823,10 +833,14 @@ val KLOP_LEMMA_FINITE = store_thm ((* NEW *) 11. ∀n. n ∈ nodes ⇒ ¬(n ≈ k) *) >> Q.EXISTS_TAC `k` - >> CONJ_TAC (* 2 sub-goals here *) - >- ( `k IN IMAGE f UNIV` by PROVE_TAC [] \\ - POP_ASSUM (STRIP_ASSUME_TAC o (REWRITE_RULE [IN_IMAGE])) \\ - PROVE_TAC [KLOP_PROP0] ) + >> CONJ_TAC (* STABLE k *) + >- (`k IN IMAGE f UNIV` by PROVE_TAC [] \\ + POP_ASSUM (STRIP_ASSUME_TAC o (REWRITE_RULE [IN_IMAGE])) \\ + PROVE_TAC [KLOP_PROP0]) + >> CONJ_TAC (* closed k *) + >- (Q.PAT_X_ASSUM ‘k IN klops’ MP_TAC \\ + simp [Abbr ‘klops’, Abbr ‘f’] >> rw [] \\ + rw [KLOP_closed]) (* Part 5: final check *) >> `!n. n IN (NODES p) ==> ~(WEAK_EQUIV n k)` by PROVE_TAC [IN_UNION] >> `!n. n IN (NODES q) ==> ~(WEAK_EQUIV n k)` by PROVE_TAC [IN_UNION] @@ -838,13 +852,14 @@ val KLOP_LEMMA_FINITE = store_thm ((* NEW *) (* goal 2 (of 2) *) rpt STRIP_TAC \\ IMP_RES_TAC WEAK_TRANS_IN_NODES \\ - PROVE_TAC [] ]); + PROVE_TAC [] ] +QED (* The finite version of COARSEST_CONGR_THM (PROP3) *) val COARSEST_CONGR_FINITE = store_thm ((* NEW *) "COARSEST_CONGR_FINITE", ``!p q. finite_state p /\ finite_state q ==> - (OBS_CONGR p q = !r. WEAK_EQUIV (sum p r) (sum q r))``, + (OBS_CONGR p q <=> !r. WEAK_EQUIV (sum p r) (sum q r))``, rpt STRIP_TAC >> EQ_TAC >- REWRITE_TAC [COARSEST_CONGR_LR] >> MP_TAC (Q.SPECL [`p`, `q`] KLOP_LEMMA_FINITE) diff --git a/examples/CCS/CongruenceScript.sml b/examples/CCS/CongruenceScript.sml index 95d3937425..4fa950a783 100644 --- a/examples/CCS/CongruenceScript.sml +++ b/examples/CCS/CongruenceScript.sml @@ -1,32 +1,27 @@ (* ========================================================================== *) (* FILE : CongruenceScript.sml *) -(* DESCRIPTION : The theory of congruence and guarded contexts *) +(* DESCRIPTION : The theory of congruence and (guarded) contexts *) (* *) -(* THESIS : A Formalization of Unique Solutions of Equations in *) -(* Process Algebra *) -(* AUTHOR : (c) 2017 Chun Tian, University of Bologna, Italy *) -(* (c) 2018 Chun Tian, Fondazione Bruno Kessler (FBK) *) -(* DATE : 2017-2018 *) -(* ========================================================================== *) +(* COPYRIGHTS : 1991-1995 University of Cambridge (Monica Nesi) *) +(* 2016-2017 University of Bologna, Italy (Chun Tian) *) +(* 2018-2019 Fondazione Bruno Kessler, Italy (Chun Tian) *) +(* 2023-2024 Australian National University (Chun Tian) *) +(******************************************************************************) open HolKernel Parse boolLib bossLib; -open pred_setTheory relationTheory combinTheory arithmeticTheory; +open pred_setTheory pred_setLib relationTheory combinTheory arithmeticTheory; + +open binderLib; + open CCSLib CCSTheory; open StrongEQTheory StrongLawsTheory WeakEQTheory WeakLawsTheory; open ObsCongrTheory ObsCongrLib ObsCongrLawsTheory ObsCongrConv; open BisimulationUptoTheory; val _ = new_theory "Congruence"; -val _ = temp_loose_equality (); - -(******************************************************************************) -(* *) -(* STRONG_EQ is preserved by recursive definition *) -(* *) -(******************************************************************************) -(* moved to MultivariateScript.sml *) +val set_ss = std_ss ++ PRED_SET_ss; (******************************************************************************) (* *) @@ -34,20 +29,46 @@ val _ = temp_loose_equality (); (* *) (******************************************************************************) -val _ = type_abbrev_pp ("context", ``:('a, 'b) CCS -> ('a, 'b) CCS``); +val _ = type_abbrev_pp ("context", ``:'a CCS -> 'a CCS``); Definition IS_CONST_def : - IS_CONST (e :('a, 'b) context) <=> !t1 t2. e t1 = e t2 + IS_CONST (e :'a context) <=> !t1 t2. e t1 = e t2 End Theorem IS_CONST_alt : - !e. IS_CONST e <=> ?p. !t. (e t = p) + !e. IS_CONST e <=> ?p. !t. e t = p Proof RW_TAC std_ss [IS_CONST_def] >> METIS_TAC [] QED -(* ONE HOLE CONTEXT (unused) *) +Theorem IS_CONST_thm : + !e. IS_CONST e <=> ?p. e = \t. p +Proof + rw [IS_CONST_alt, FUN_EQ_THM] +QED + +(* not used *) +Definition closed_const : + closed_const (e :'a context) <=> IS_CONST e /\ !t. closed (e t) +End + +Theorem closed_const_def = closed_const |> REWRITE_RULE [IS_CONST_def] + +Theorem closed_const_alt : + !e. closed_const e <=> ?p. closed p /\ !t. e t = p +Proof + rw [closed_const_def, IS_CONST_alt] + >> METIS_TAC [] +QED + +Theorem closed_const_thm : + !e. closed_const e <=> ?p. closed p /\ e = \t. p +Proof + rw [closed_const_alt, FUN_EQ_THM] +QED + +(* ONE HOLE CONTEXT (not used) *) Inductive OH_CONTEXT : ( OH_CONTEXT (\t. t)) /\ (* OH_CONTEXT1 *) (!a c. OH_CONTEXT c ==> OH_CONTEXT (\t. prefix a (c t))) /\ (* OH_CONTEXT2 *) @@ -84,17 +105,22 @@ val OH_CONTEXT_combin = store_thm ( FULL_SIMP_TAC std_ss [OH_CONTEXT7], FULL_SIMP_TAC std_ss [OH_CONTEXT8] ]); -(* Multi-hole (or non-hole) contexts (Univariate CCS equations) *) +(******************************************************************************) +(* *) +(* Multi-hole (or no-hole) contexts (CONTEXT) *) +(* *) +(******************************************************************************) + Inductive CONTEXT : - ( CONTEXT (\t. t)) /\ (* CONTEXT1 *) - (!p. CONTEXT (\t. p)) /\ (* CONTEXT2 *) + ( CONTEXT (\t. t)) /\ (* CONTEXT1 *) + (!p. CONTEXT (\t. p)) /\ (* CONTEXT2 *) (!a e. CONTEXT e ==> CONTEXT (\t. prefix a (e t))) /\ (* CONTEXT3 *) (!e1 e2. CONTEXT e1 /\ CONTEXT e2 ==> CONTEXT (\t. sum (e1 t) (e2 t))) /\ (* CONTEXT4 *) (!e1 e2. CONTEXT e1 /\ CONTEXT e2 ==> CONTEXT (\t. par (e1 t) (e2 t))) /\ (* CONTEXT5 *) (!L e. CONTEXT e ==> CONTEXT (\t. restr L (e t))) /\ (* CONTEXT6 *) - (!rf e. CONTEXT e ==> CONTEXT (\t. relab (e t) rf)) (* CONTEXT7 *) + (!e rf. CONTEXT e ==> CONTEXT (\t. relab (e t) rf)) (* CONTEXT7 *) End val [CONTEXT1, CONTEXT2, CONTEXT3, CONTEXT4, CONTEXT5, CONTEXT6, CONTEXT7] = @@ -103,31 +129,35 @@ val [CONTEXT1, CONTEXT2, CONTEXT3, CONTEXT4, CONTEXT5, CONTEXT6, CONTEXT7] = "CONTEXT6", "CONTEXT7"], CONJUNCTS CONTEXT_rules)); -val CONTEXT3a = store_thm ( - "CONTEXT3a", - ``!a :'b Action. CONTEXT (\t. prefix a t)``, +Theorem CONTEXT3a : + !a :'a Action. CONTEXT (\t. prefix a t) +Proof ASSUME_TAC CONTEXT1 >> IMP_RES_TAC CONTEXT3 >> POP_ASSUM MP_TAC - >> BETA_TAC >> REWRITE_TAC []); + >> BETA_TAC >> REWRITE_TAC [] +QED Theorem CONTEXT_CONST : !e. IS_CONST e ==> CONTEXT e Proof - RW_TAC std_ss [IS_CONST_def] - >> Know `e = (\t. e nil)` >- fs [FUN_EQ_THM] - >> Rewr' >> REWRITE_TAC [CONTEXT2] + rw [IS_CONST_def] + >> ‘e = (\t. e nil)’ by fs [FUN_EQ_THM] + >> POP_ORW >> rw [CONTEXT2] QED Theorem NO_CONTEXT8 : !e X. ~IS_CONST e ==> ~CONTEXT (\t. rec X (e t)) Proof - rpt GEN_TAC >> ONCE_REWRITE_TAC [CONTEXT_cases] + rpt GEN_TAC + >> ONCE_REWRITE_TAC [CONTEXT_cases] >> fs [FUN_EQ_THM, IS_CONST_def] >> rpt STRIP_TAC - >- (Q.EXISTS_TAC `nil` >> rw []) - >> Cases_on `p` >> fs [FUN_EQ_THM] - >> METIS_TAC [] + >- (Q.EXISTS_TAC ‘nil’ >> rw []) + >> MP_TAC (Q.SPEC ‘p’ CCS_cases) + >> rw [] >> CCONTR_TAC >> fs [] + >> rename1 ‘!t. rec X (e t) = rec Y E’ + >> Cases_on ‘X = Y’ >> fs [rec_eq_thm] QED Theorem CONTEXT8_IMP_CONST : @@ -144,66 +174,101 @@ Proof (ONCE_REWRITE_RULE [CONTEXT_cases])) >> fs [FUN_EQ_THM] (* 3 subgoals left *) >| [ (* goal 1 (of 3) *) - POP_ASSUM (MP_TAC o (Q.SPEC `nil`)) >> rw [], + POP_ASSUM (MP_TAC o (Q.SPEC ‘nil’)) >> rw [], (* goal 2 (of 3) *) - Cases_on `p` (* 8 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- (FULL_SIMP_TAC std_ss [CCS_11] \\ - rename1 `!t. (u = o') /\ (e t = C')` \\ - `(e = \t. C')` by PROVE_TAC [] >> art [CONTEXT2]) - >> PROVE_TAC [CCS_distinct], + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e = \t. E’ by PROVE_TAC [] >> POP_ORW \\ + rw [CONTEXT2], (* goal 3 (of 3) *) METIS_TAC [] ] QED +Theorem CONTEXT3_full : + !e u. CONTEXT (\t. prefix u (e t)) <=> CONTEXT e +Proof + rpt GEN_TAC + >> EQ_TAC + >- REWRITE_TAC [CONTEXT3_backward] + >> REWRITE_TAC [CONTEXT3] +QED + Theorem CONTEXT4_backward : !e e'. CONTEXT (\t. sum (e t) (e' t)) ==> CONTEXT e /\ CONTEXT e' Proof - rpt STRIP_TAC \\ (* 2 sub-goals here, same tacticals *) - ( POP_ASSUM (STRIP_ASSUME_TAC o - (ONCE_REWRITE_RULE [CONTEXT_cases])) (* 7 sub-goals here *) - >> fs [FUN_EQ_THM] (* 3 subgoals left *) - >| [ (* goal 1 (of 3) *) - POP_ASSUM (MP_TAC o (Q.SPEC `nil`)) \\ - SIMP_TAC std_ss [CCS_distinct], - (* goal 2 (of 3) *) - Cases_on `p` (* 8 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- (FULL_SIMP_TAC std_ss [CCS_11] \\ - rename1 `!t. (e t = C') /\ (e' t = C0)` \\ - `(e = \t. C') /\ (e' = \t. C0)` by PROVE_TAC [] \\ - ASM_REWRITE_TAC [CONTEXT2]) - >> PROVE_TAC [CCS_distinct], - (* goal 3 (of 3) *) - METIS_TAC [] ] ) + rpt STRIP_TAC + >| [ (* goal 1 (of 2) *) + POP_ASSUM (STRIP_ASSUME_TAC o + (ONCE_REWRITE_RULE [CONTEXT_cases])) \\ (* 7 sub-goals here *) + fs [FUN_EQ_THM] >| (* 2 subgoals left *) + [ (* goal 1.1 (of 3) *) + POP_ASSUM (MP_TAC o (Q.SPEC ‘nil’)) >> fs [], + (* goal 1.2 (of 3) *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e = \t. E1’ by PROVE_TAC [] >> POP_ORW \\ + rw [CONTEXT2], + (* goal 1.3 (of 3) *) + METIS_TAC [] ], + (* goal 2 (of 2) *) + POP_ASSUM (STRIP_ASSUME_TAC o + (ONCE_REWRITE_RULE [CONTEXT_cases])) \\ (* 7 sub-goals here *) + fs [FUN_EQ_THM] >| (* 2 subgoals left *) + [ (* goal 2.1 (of 3) *) + POP_ASSUM (MP_TAC o (Q.SPEC ‘nil’)) >> fs [], + (* goal 2.2 (of 3) *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e' = \t. E2’ by PROVE_TAC [] >> POP_ORW \\ + rw [CONTEXT2], + (* goal 2.3 (of 3) *) + METIS_TAC [] ] ] QED +Theorem CONTEXT4_full : + !e e'. CONTEXT (\t. sum (e t) (e' t)) <=> CONTEXT e /\ CONTEXT e' +Proof + rpt GEN_TAC + >> EQ_TAC + >- REWRITE_TAC [CONTEXT4_backward] + >> REWRITE_TAC [CONTEXT4] +QED + +(* NOTE: This proof is identical with CONTEXT4_backward *) Theorem CONTEXT5_backward : !e e'. CONTEXT (\t. par (e t) (e' t)) ==> CONTEXT e /\ CONTEXT e' Proof - rpt STRIP_TAC \\ (* 2 sub-goals here, same tacticals *) - ( POP_ASSUM (STRIP_ASSUME_TAC o - (ONCE_REWRITE_RULE [CONTEXT_cases])) (* 7 sub-goals here *) - >> fs [FUN_EQ_THM] (* 3 subgoals left *) - >| [ (* goal 1 (of 3) *) - POP_ASSUM (MP_TAC o (Q.SPEC `nil`)) \\ - SIMP_TAC std_ss [CCS_distinct], - (* goal 2 (of 3) *) - Cases_on `p` (* 8 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- (FULL_SIMP_TAC std_ss [CCS_11] \\ - rename1 `!t. (e t = C') /\ (e' t = C0)` \\ - `(e = \t. C') /\ (e' = \t. C0)` by PROVE_TAC [] \\ - ASM_REWRITE_TAC [CONTEXT2]) - >> PROVE_TAC [CCS_distinct], - (* goal 3 (of 3) *) - METIS_TAC [] ] ) + rpt STRIP_TAC + >| [ (* goal 1 (of 2) *) + POP_ASSUM (STRIP_ASSUME_TAC o + (ONCE_REWRITE_RULE [CONTEXT_cases])) \\ (* 7 sub-goals here *) + fs [FUN_EQ_THM] >| (* 2 subgoals left *) + [ (* goal 1.1 (of 3) *) + POP_ASSUM (MP_TAC o (Q.SPEC ‘nil’)) >> fs [], + (* goal 1.2 (of 3) *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e = \t. E1’ by PROVE_TAC [] >> POP_ORW \\ + rw [CONTEXT2], + (* goal 1.3 (of 3) *) + METIS_TAC [] ], + (* goal 2 (of 2) *) + POP_ASSUM (STRIP_ASSUME_TAC o + (ONCE_REWRITE_RULE [CONTEXT_cases])) \\ (* 7 sub-goals here *) + fs [FUN_EQ_THM] >| (* 2 subgoals left *) + [ (* goal 2.1 (of 3) *) + POP_ASSUM (MP_TAC o (Q.SPEC ‘nil’)) >> fs [], + (* goal 2.2 (of 3) *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e' = \t. E2’ by PROVE_TAC [] >> POP_ORW \\ + rw [CONTEXT2], + (* goal 2.3 (of 3) *) + METIS_TAC [] ] ] +QED + +Theorem CONTEXT5_full : + !e e'. CONTEXT (\t. par (e t) (e' t)) <=> CONTEXT e /\ CONTEXT e' +Proof + rpt GEN_TAC + >> EQ_TAC + >- REWRITE_TAC [CONTEXT5_backward] + >> REWRITE_TAC [CONTEXT5] QED Theorem CONTEXT6_backward : @@ -213,23 +278,24 @@ Proof >> POP_ASSUM (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [CONTEXT_cases])) >> fs [FUN_EQ_THM] (* 3 subgoals left *) >| [ (* goal 1 (of 3) *) - POP_ASSUM (MP_TAC o (Q.SPEC `nil`)) \\ - SIMP_TAC std_ss [CCS_distinct], + POP_ASSUM (MP_TAC o (Q.SPEC ‘nil’)) >> fs [], (* goal 2 (of 3) *) - Cases_on `p` (* 8 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- (FULL_SIMP_TAC std_ss [CCS_11] \\ - rename1 `!t. (L = f) /\ (e t = C')` \\ - `(e = \t. C')` by PROVE_TAC [] >> art [CONTEXT2]) - >> PROVE_TAC [CCS_distinct], + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e = \t. E’ by PROVE_TAC [] >> POP_ORW \\ + rw [CONTEXT2], (* goal 3 (of 3) *) METIS_TAC [] ] QED +Theorem CONTEXT6_full : + !e L. CONTEXT (\t. restr L (e t)) <=> CONTEXT e +Proof + rpt GEN_TAC + >> EQ_TAC + >- REWRITE_TAC [CONTEXT6_backward] + >> REWRITE_TAC [CONTEXT6] +QED + Theorem CONTEXT7_backward : !e rf. CONTEXT (\t. relab (e t) rf) ==> CONTEXT e Proof @@ -240,21 +306,22 @@ Proof POP_ASSUM (MP_TAC o (Q.SPEC `nil`)) \\ SIMP_TAC std_ss [CCS_distinct], (* goal 2 (of 3) *) - Cases_on `p` (* 8 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- (FULL_SIMP_TAC std_ss [CCS_11] \\ - rename1 `!t. (e t = C') /\ (rf = R)` \\ - `(e = \t. C')` by PROVE_TAC [] >> art [CONTEXT2]) - >> PROVE_TAC [CCS_distinct], + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e = \t. E’ by PROVE_TAC [] >> POP_ORW \\ + rw [CONTEXT2], (* goal 3 (of 3) *) METIS_TAC [] ] QED +Theorem CONTEXT7_full : + !e rf. CONTEXT (\t. relab (e t) rf) <=> CONTEXT e +Proof + rpt GEN_TAC + >> EQ_TAC + >- REWRITE_TAC [CONTEXT7_backward] + >> REWRITE_TAC [CONTEXT7] +QED + Theorem CONTEXT8_backward : !e X. CONTEXT (\t. rec X (e t)) ==> CONTEXT e Proof @@ -264,92 +331,96 @@ Proof >> Q.EXISTS_TAC `X` >> art [] QED -val CONTEXT_combin = store_thm ( - "CONTEXT_combin", ``!c1 c2. CONTEXT c1 /\ CONTEXT c2 ==> CONTEXT (c1 o c2)``, +Theorem CONTEXT_combin : + !c1 c2. CONTEXT c1 /\ CONTEXT c2 ==> CONTEXT (c1 o c2) +Proof REPEAT STRIP_TAC >> NTAC 2 (POP_ASSUM MP_TAC) - >> Q.SPEC_TAC (`c1`, `c`) + >> Q.SPEC_TAC (‘c1’, ‘c’) >> HO_MATCH_MP_TAC CONTEXT_ind >> REWRITE_TAC [o_DEF] >> BETA_TAC >> REWRITE_TAC [ETA_AX] - >> REPEAT STRIP_TAC (* 6 sub-goals here *) - >| [ REWRITE_TAC [CONTEXT2], + >> rpt STRIP_TAC (* 6 sub-goals here *) + >| [ rw [CONTEXT2], FULL_SIMP_TAC std_ss [CONTEXT3], FULL_SIMP_TAC std_ss [CONTEXT4], FULL_SIMP_TAC std_ss [CONTEXT5], FULL_SIMP_TAC std_ss [CONTEXT6], - FULL_SIMP_TAC std_ss [CONTEXT7] ]); + FULL_SIMP_TAC std_ss [CONTEXT7] ] +QED (* One-hole contexts are also multi-hole contexts *) -val OH_CONTEXT_IMP_CONTEXT = store_thm ( - "OH_CONTEXT_IMP_CONTEXT", ``!c. OH_CONTEXT c ==> CONTEXT c``, +Theorem OH_CONTEXT_IMP_CONTEXT : + !c. OH_CONTEXT c ==> CONTEXT c +Proof Induct_on `OH_CONTEXT` >> rpt STRIP_TAC (* 8 sub-goals here *) >| [ (* goal 1 (of 8) *) REWRITE_TAC [CONTEXT1], (* goal 2 (of 8) *) - MATCH_MP_TAC CONTEXT3 >> ASM_REWRITE_TAC [], + MATCH_MP_TAC CONTEXT3 >> art [], (* goal 3 (of 8) *) - `CONTEXT (\y. x)` by REWRITE_TAC [CONTEXT2] \\ + `CONTEXT (\y. x)` by REWRITE_TAC [CONTEXT2] \\ Know `CONTEXT (\t. c t + (\y. x) t)` - >- ( MATCH_MP_TAC CONTEXT4 >> ASM_REWRITE_TAC [] ) \\ + >- (MATCH_MP_TAC CONTEXT4 >> art []) \\ BETA_TAC >> REWRITE_TAC [], (* goal 4 (of 8) *) - `CONTEXT (\y. x)` by REWRITE_TAC [CONTEXT2] \\ + `CONTEXT (\y. x)` by REWRITE_TAC [CONTEXT2] \\ Know `CONTEXT (\t. (\y. x) t + c t)` - >- ( MATCH_MP_TAC CONTEXT4 >> ASM_REWRITE_TAC [] ) \\ + >- (MATCH_MP_TAC CONTEXT4 >> art []) \\ BETA_TAC >> REWRITE_TAC [], (* goal 5 (of 8) *) - `CONTEXT (\y. x)` by REWRITE_TAC [CONTEXT2] \\ + `CONTEXT (\y. x)` by REWRITE_TAC [CONTEXT2] \\ Know `CONTEXT (\t. par (c t) ((\y. x) t))` - >- ( MATCH_MP_TAC CONTEXT5 >> ASM_REWRITE_TAC [] ) \\ + >- (MATCH_MP_TAC CONTEXT5 >> art []) \\ BETA_TAC >> REWRITE_TAC [], (* goal 6 (of 8) *) - `CONTEXT (\y. x)` by REWRITE_TAC [CONTEXT2] \\ + `CONTEXT (\y. x)` by REWRITE_TAC [CONTEXT2] \\ Know `CONTEXT (\t. par ((\y. x) t) (c t))` - >- ( MATCH_MP_TAC CONTEXT5 >> ASM_REWRITE_TAC [] ) \\ + >- (MATCH_MP_TAC CONTEXT5 >> art []) \\ BETA_TAC >> REWRITE_TAC [], (* goal 7 (of 8) *) - MATCH_MP_TAC CONTEXT6 >> ASM_REWRITE_TAC [], + MATCH_MP_TAC CONTEXT6 >> art [], (* goal 8 (of 8) *) - MATCH_MP_TAC CONTEXT7 >> ASM_REWRITE_TAC [] ]); + MATCH_MP_TAC CONTEXT7 >> art [] ] +QED -val STRONG_EQUIV_SUBST_CONTEXT = store_thm ( - "STRONG_EQUIV_SUBST_CONTEXT", - ``!P Q. STRONG_EQUIV P Q ==> !E. CONTEXT E ==> STRONG_EQUIV (E P) (E Q)``, +Theorem STRONG_EQUIV_SUBST_CONTEXT : + !P Q. STRONG_EQUIV P Q ==> !E. CONTEXT E ==> STRONG_EQUIV (E P) (E Q) +Proof rpt GEN_TAC >> DISCH_TAC - >> Induct_on `CONTEXT` >> BETA_TAC >> rpt STRIP_TAC (* 7 sub-goals here *) - >- ASM_REWRITE_TAC [] - >- REWRITE_TAC [STRONG_EQUIV_REFL] + >> HO_MATCH_MP_TAC CONTEXT_strongind + >> rw [STRONG_EQUIV_REFL] (* 5 subgoals left *) >| [ (* goal 1 (of 5) *) - MATCH_MP_TAC STRONG_EQUIV_SUBST_PREFIX >> ASM_REWRITE_TAC [], + MATCH_MP_TAC STRONG_EQUIV_SUBST_PREFIX >> art [], (* goal 2 (of 5) *) - IMP_RES_TAC STRONG_EQUIV_PRESD_BY_SUM, + MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_SUM >> art [], (* goal 3 (of 5) *) - IMP_RES_TAC STRONG_EQUIV_PRESD_BY_PAR, + MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art [], (* goal 4 (of 5) *) - MATCH_MP_TAC STRONG_EQUIV_SUBST_RESTR >> ASM_REWRITE_TAC [], + MATCH_MP_TAC STRONG_EQUIV_SUBST_RESTR >> art [], (* goal 5 (of 5) *) - MATCH_MP_TAC STRONG_EQUIV_SUBST_RELAB >> ASM_REWRITE_TAC [] ]); + MATCH_MP_TAC STRONG_EQUIV_SUBST_RELAB >> art [] ] +QED -val OBS_CONGR_SUBST_CONTEXT = store_thm ( - "OBS_CONGR_SUBST_CONTEXT", - ``!P Q. OBS_CONGR P Q ==> !E. CONTEXT E ==> OBS_CONGR (E P) (E Q)``, +Theorem OBS_CONGR_SUBST_CONTEXT : + !P Q. OBS_CONGR P Q ==> !E. CONTEXT E ==> OBS_CONGR (E P) (E Q) +Proof rpt GEN_TAC >> DISCH_TAC - >> Induct_on `CONTEXT` >> BETA_TAC >> rpt STRIP_TAC (* 7 sub-goals here *) - >- ASM_REWRITE_TAC [] - >- REWRITE_TAC [OBS_CONGR_REFL] + >> HO_MATCH_MP_TAC CONTEXT_strongind + >> rw [OBS_CONGR_REFL] (* 5 subgoals left *) >| [ (* goal 1 (of 5) *) - MATCH_MP_TAC OBS_CONGR_SUBST_PREFIX >> ASM_REWRITE_TAC [], + MATCH_MP_TAC OBS_CONGR_SUBST_PREFIX >> art [], (* goal 2 (of 5) *) - IMP_RES_TAC OBS_CONGR_PRESD_BY_SUM, + MATCH_MP_TAC OBS_CONGR_PRESD_BY_SUM >> art [], (* goal 3 (of 5) *) - IMP_RES_TAC OBS_CONGR_PRESD_BY_PAR, + MATCH_MP_TAC OBS_CONGR_PRESD_BY_PAR >> art [], (* goal 4 (of 5) *) - MATCH_MP_TAC OBS_CONGR_SUBST_RESTR >> ASM_REWRITE_TAC [], - (* goal 5 (of 5) *) - MATCH_MP_TAC OBS_CONGR_SUBST_RELAB >> ASM_REWRITE_TAC [] ]); + MATCH_MP_TAC OBS_CONGR_SUBST_RESTR >> art [], + (* goal 5 (of 6) *) + MATCH_MP_TAC OBS_CONGR_SUBST_RELAB >> art [] ] +QED (******************************************************************************) (* *) @@ -358,8 +429,8 @@ val OBS_CONGR_SUBST_CONTEXT = store_thm ( (******************************************************************************) Inductive GCONTEXT : - ( GCONTEXT (\t. t)) /\ (* GCONTEXT1 *) - (!p. GCONTEXT (\t. p)) /\ (* GCONTEXT2 *) + ( GCONTEXT (\t. t)) /\ (* GCONTEXT1 *) + (!p. GCONTEXT (\t. p)) /\ (* GCONTEXT2 *) (!a e. GCONTEXT e ==> GCONTEXT (\t. prefix a (e t))) /\ (* GCONTEXT3 *) (!a1 a2 e1 e2. GCONTEXT e1 /\ GCONTEXT e2 @@ -368,7 +439,7 @@ Inductive GCONTEXT : (!e1 e2. GCONTEXT e1 /\ GCONTEXT e2 ==> GCONTEXT (\t. par (e1 t) (e2 t))) /\ (* GCONTEXT5 *) (!L e. GCONTEXT e ==> GCONTEXT (\t. restr L (e t))) /\ (* GCONTEXT6 *) - (!rf e. GCONTEXT e ==> GCONTEXT (\t. relab (e t) rf)) (* GCONTEXT7 *) + (!e rf. GCONTEXT e ==> GCONTEXT (\t. relab (e t) rf)) (* GCONTEXT7 *) End val [GCONTEXT1, GCONTEXT2, GCONTEXT3, GCONTEXT4, GCONTEXT5, @@ -378,77 +449,81 @@ val [GCONTEXT1, GCONTEXT2, GCONTEXT3, GCONTEXT4, GCONTEXT5, "GCONTEXT5", "GCONTEXT6", "GCONTEXT7"], CONJUNCTS GCONTEXT_rules)); -val GCONTEXT3a = store_thm ( - "GCONTEXT3a", - ``!a :'b Action. GCONTEXT (\t. prefix a t)``, +Theorem GCONTEXT3a : + !a :'a Action. GCONTEXT (\t. prefix a t) +Proof ASSUME_TAC GCONTEXT1 >> IMP_RES_TAC GCONTEXT3 >> POP_ASSUM MP_TAC - >> BETA_TAC >> REWRITE_TAC []); + >> BETA_TAC >> REWRITE_TAC [] +QED -val GCONTEXT_combin = store_thm ( - "GCONTEXT_combin", ``!c1 c2. GCONTEXT c1 /\ GCONTEXT c2 ==> GCONTEXT (c1 o c2)``, - REPEAT STRIP_TAC +Theorem GCONTEXT_combin : + !c1 c2. GCONTEXT c1 /\ GCONTEXT c2 ==> GCONTEXT (c1 o c2) +Proof + rpt STRIP_TAC >> NTAC 2 (POP_ASSUM MP_TAC) - >> Q.SPEC_TAC (`c1`, `c`) + >> Q.ID_SPEC_TAC ‘c1’ >> HO_MATCH_MP_TAC GCONTEXT_ind >> REWRITE_TAC [o_DEF] >> BETA_TAC >> REWRITE_TAC [ETA_AX] >> rpt STRIP_TAC (* 6 sub-goals here *) - >| [ REWRITE_TAC [GCONTEXT2], + >| [ rw [GCONTEXT2], FULL_SIMP_TAC std_ss [GCONTEXT3], FULL_SIMP_TAC std_ss [GCONTEXT4], FULL_SIMP_TAC std_ss [GCONTEXT5], FULL_SIMP_TAC std_ss [GCONTEXT6], - FULL_SIMP_TAC std_ss [GCONTEXT7] ]); + FULL_SIMP_TAC std_ss [GCONTEXT7] ] +QED -val GCONTEXT_IMP_CONTEXT = store_thm ( - "GCONTEXT_IMP_CONTEXT", ``!c. GCONTEXT c ==> CONTEXT c``, - Induct_on `GCONTEXT` +Theorem GCONTEXT_IMP_CONTEXT : + !c. GCONTEXT c ==> CONTEXT c +Proof + HO_MATCH_MP_TAC GCONTEXT_strongind >> rpt STRIP_TAC (* 7 sub-goals here *) >| [ (* goal 1 (of 7) *) REWRITE_TAC [CONTEXT1], (* goal 2 (of 7) *) - REWRITE_TAC [CONTEXT2], + rw [CONTEXT2], (* goal 3 (of 7) *) - MATCH_MP_TAC CONTEXT3 >> ASM_REWRITE_TAC [], + MATCH_MP_TAC CONTEXT3 >> art [], (* goal 4 (of 7) *) - Know `CONTEXT (\t. (prefix a1 (e1 t)))` - >- ( MATCH_MP_TAC CONTEXT3 >> ASM_REWRITE_TAC [] ) \\ - Know `CONTEXT (\t. (prefix a2 (e2 t)))` - >- ( MATCH_MP_TAC CONTEXT3 >> ASM_REWRITE_TAC [] ) \\ - KILL_TAC \\ - NTAC 2 DISCH_TAC \\ - Know `CONTEXT (\t. (\t. (prefix a1 (e1 t))) t + (\t. (prefix a2 (e2 t))) t)` - >- ( MATCH_MP_TAC CONTEXT4 >> ASM_REWRITE_TAC [] ) \\ + Know `CONTEXT (\t. prefix a1 (e1 t))` + >- (MATCH_MP_TAC CONTEXT3 >> art []) \\ + Know `CONTEXT (\t. prefix a2 (e2 t))` + >- (MATCH_MP_TAC CONTEXT3 >> art []) \\ + KILL_TAC >> NTAC 2 DISCH_TAC \\ + Know `CONTEXT (\t. (\t. prefix a1 (e1 t)) t + (\t. prefix a2 (e2 t)) t)` + >- (MATCH_MP_TAC CONTEXT4 >> art []) \\ BETA_TAC >> REWRITE_TAC [], (* goal 5 (of 7) *) - MATCH_MP_TAC CONTEXT5 >> ASM_REWRITE_TAC [], + MATCH_MP_TAC CONTEXT5 >> art [], (* goal 6 (of 7) *) - MATCH_MP_TAC CONTEXT6 >> ASM_REWRITE_TAC [], + MATCH_MP_TAC CONTEXT6 >> art [], (* goal 7 (of 7) *) - MATCH_MP_TAC CONTEXT7 >> ASM_REWRITE_TAC [] ]); + MATCH_MP_TAC CONTEXT7 >> art [] ] +QED -val WEAK_EQUIV_SUBST_GCONTEXT = store_thm ( - "WEAK_EQUIV_SUBST_GCONTEXT", - ``!P Q. WEAK_EQUIV P Q ==> !E. GCONTEXT E ==> WEAK_EQUIV (E P) (E Q)``, +Theorem WEAK_EQUIV_SUBST_GCONTEXT : + !P Q. WEAK_EQUIV P Q ==> !E. GCONTEXT E ==> WEAK_EQUIV (E P) (E Q) +Proof rpt GEN_TAC >> DISCH_TAC >> Induct_on `GCONTEXT` >> BETA_TAC >> rpt STRIP_TAC (* 7 sub-goals here *) >- ASM_REWRITE_TAC [] >- REWRITE_TAC [WEAK_EQUIV_REFL] >| [ (* goal 1 (of 5) *) - MATCH_MP_TAC WEAK_EQUIV_SUBST_PREFIX >> ASM_REWRITE_TAC [], + MATCH_MP_TAC WEAK_EQUIV_SUBST_PREFIX >> art [], (* goal 2 (of 5) *) - MATCH_MP_TAC WEAK_EQUIV_PRESD_BY_GUARDED_SUM \\ - ASM_REWRITE_TAC [], + MATCH_MP_TAC WEAK_EQUIV_PRESD_BY_GUARDED_SUM >> art [], (* goal 3 (of 5) *) - IMP_RES_TAC WEAK_EQUIV_PRESD_BY_PAR, + MATCH_MP_TAC WEAK_EQUIV_PRESD_BY_PAR >> art [], (* goal 4 (of 5) *) - MATCH_MP_TAC WEAK_EQUIV_SUBST_RESTR >> ASM_REWRITE_TAC [], + MATCH_MP_TAC WEAK_EQUIV_SUBST_RESTR >> art [], (* goal 5 (of 5) *) - MATCH_MP_TAC WEAK_EQUIV_SUBST_RELAB >> ASM_REWRITE_TAC [] ]); + MATCH_MP_TAC WEAK_EQUIV_SUBST_RELAB >> art [] ] +QED (******************************************************************************) (* *) @@ -457,42 +532,48 @@ val WEAK_EQUIV_SUBST_GCONTEXT = store_thm ( (******************************************************************************) Definition precongruence : - precongruence R = PreOrder R /\ + precongruence R <=> PreOrder R /\ !x y ctx. CONTEXT ctx ==> R x y ==> R (ctx x) (ctx y) End (* a special version of precongruence with only guarded sums *) Definition precongruence' : - precongruence' R = PreOrder R /\ + precongruence' R <=> PreOrder R /\ !x y ctx. GCONTEXT ctx ==> R x y ==> R (ctx x) (ctx y) End (* The definition of congruence for CCS, TODO: use precongruence *) Definition congruence : - congruence R = equivalence R /\ + congruence R <=> equivalence R /\ !x y ctx. CONTEXT ctx ==> R x y ==> R (ctx x) (ctx y) End (* a special version of congruence with only guarded sums *) Definition congruence' : - congruence' R = equivalence R /\ + congruence' R <=> equivalence R /\ !x y ctx. GCONTEXT ctx ==> R x y ==> R (ctx x) (ctx y) End -val STRONG_EQUIV_congruence = store_thm ( - "STRONG_EQUIV_congruence", ``congruence STRONG_EQUIV``, +Theorem STRONG_EQUIV_congruence : + congruence STRONG_EQUIV +Proof REWRITE_TAC [congruence, STRONG_EQUIV_equivalence] - >> PROVE_TAC [STRONG_EQUIV_SUBST_CONTEXT]); + >> PROVE_TAC [STRONG_EQUIV_SUBST_CONTEXT] +QED -val WEAK_EQUIV_congruence = store_thm ( - "WEAK_EQUIV_congruence", ``congruence' WEAK_EQUIV``, +Theorem WEAK_EQUIV_congruence : + congruence' WEAK_EQUIV +Proof REWRITE_TAC [congruence', WEAK_EQUIV_equivalence] - >> PROVE_TAC [WEAK_EQUIV_SUBST_GCONTEXT]); + >> PROVE_TAC [WEAK_EQUIV_SUBST_GCONTEXT] +QED -val OBS_CONGR_congruence = store_thm ( - "OBS_CONGR_congruence", ``congruence OBS_CONGR``, +Theorem OBS_CONGR_congruence : + congruence OBS_CONGR +Proof REWRITE_TAC [congruence, OBS_CONGR_equivalence] - >> PROVE_TAC [OBS_CONGR_SUBST_CONTEXT]); + >> PROVE_TAC [OBS_CONGR_SUBST_CONTEXT] +QED (* Building (pre)congruence closure from any relation on CCS *) val CC_def = Define ` @@ -520,7 +601,7 @@ val CC_precongruence = store_thm ( `CONTEXT (c o ctx)` by PROVE_TAC [CONTEXT_combin] \\ RES_TAC >> FULL_SIMP_TAC std_ss [o_THM] ]); -(* The built relation is indeed congruence *) +(* The relation built by CC is indeed a congruence *) val CC_congruence = store_thm ( "CC_congruence", ``!R. equivalence R ==> congruence (CC R)``, REWRITE_TAC [congruence, CC_def] @@ -589,8 +670,8 @@ val [WG2, WG3, WG4, WG5, WG6, WG7] = map save_thm (combine (["WG2", "WG3", "WG4", "WG5", "WG6", "WG7"], CONJUNCTS WG_rules)); -Theorem WG1 : (* WG1 is derivable from WG3 *) - !a :'b Action. WG (\t. prefix a t) +Theorem WG1 : + !a. WG (\t. prefix a t) Proof ASSUME_TAC CONTEXT1 >> IMP_RES_TAC WG3 @@ -612,9 +693,9 @@ QED Theorem WG_CONST : !e. IS_CONST e ==> WG e Proof - RW_TAC std_ss [IS_CONST_def] - >> Know `e = (\t. e nil)` >- fs [FUN_EQ_THM] - >> Rewr' >> REWRITE_TAC [WG2] + rw [IS_CONST_def] + >> ‘e = (\t. e nil)’ by fs [FUN_EQ_THM] + >> POP_ORW >> rw [WG2] QED Theorem NO_WG8 : @@ -623,8 +704,10 @@ Proof rpt GEN_TAC >> ONCE_REWRITE_TAC [WG_cases] >> fs [FUN_EQ_THM, IS_CONST_def] >> rpt STRIP_TAC - >> Cases_on `p` >> fs [FUN_EQ_THM] - >> METIS_TAC [] + >> MP_TAC (Q.SPEC ‘p’ CCS_cases) + >> rw [] >> CCONTR_TAC >> fs [] + >> rename1 ‘!t. rec X (e t) = rec Y E’ + >> Cases_on ‘X = Y’ >> fs [rec_eq_thm] QED Theorem WG8_IMP_CONST : @@ -638,15 +721,11 @@ Theorem WG3_backward : Proof rpt GEN_TAC >> ONCE_REWRITE_TAC [WG_cases] - >> RW_TAC std_ss [FUN_EQ_THM] (* 2 subgoals left *) + >> rw [FUN_EQ_THM] (* 2 subgoals left *) >| [ (* goal 1 (of 2) *) - Cases_on `p` (* 8 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- (FULL_SIMP_TAC std_ss [CCS_11] \\ - rename1 `!t. (u = o') /\ (e t = C')` \\ - `(e = \t. C')` by PROVE_TAC [] >> art [CONTEXT2]) - >> PROVE_TAC [CCS_distinct], + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e = \t. E’ by PROVE_TAC [] >> POP_ORW \\ + rw [CONTEXT2], (* goal 2 (of 2) *) METIS_TAC [] ] QED @@ -654,52 +733,49 @@ QED Theorem WG4_backward : !e e'. WG (\t. sum (e t) (e' t)) ==> WG e /\ WG e' Proof - rpt STRIP_TAC \\ (* 2 sub-goals here, same tacticals *) - ( POP_ASSUM (STRIP_ASSUME_TAC o - (ONCE_REWRITE_RULE [WG_cases])) (* 6 sub-goals here *) - >| [ (* goal 1 (of 6) *) - fs [FUN_EQ_THM] \\ - Cases_on `p` (* 8 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- (FULL_SIMP_TAC std_ss [CCS_11] \\ - rename1 `!t. (e t = C') /\ (e' t = C0)` \\ - `(e = \t. C') /\ (e' = \t. C0)` by PROVE_TAC [] \\ - ASM_REWRITE_TAC [WG2]) - >> PROVE_TAC [CCS_distinct], - (* goal 2 (of 6) *) - fs [FUN_EQ_THM], - (* goal 3 (of 6) *) - fs [FUN_EQ_THM] >> METIS_TAC [], - (* goal 4 (of 6) *) - fs [FUN_EQ_THM], - (* goal 5 (of 6) *) - fs [FUN_EQ_THM], - (* goal 6 (of 6) *) - fs [FUN_EQ_THM] ] ) + rpt STRIP_TAC + >| [ (* goal 1 (of 2) *) + POP_ASSUM (STRIP_ASSUME_TAC o + (ONCE_REWRITE_RULE [WG_cases])) \\ (* 6 subgoals here *) + fs [FUN_EQ_THM] >| (* 2 subgoals left *) + [ (* goal 1.1 (of 2) *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e = \t. E1’ by PROVE_TAC [] >> POP_ORW >> rw [WG2], + (* goal 1.2 (of 2) *) + METIS_TAC [] ], + (* goal 2 (of 2) *) + POP_ASSUM (STRIP_ASSUME_TAC o + (ONCE_REWRITE_RULE [WG_cases])) \\ (* 6 subgoals here *) + fs [FUN_EQ_THM] >| (* 2 subgoals left *) + [ (* goal 2.1 (of 2) *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e' = \t. E2’ by PROVE_TAC [] >> POP_ORW >> rw [WG2], + (* goal 2.2 (of 2) *) + METIS_TAC [] ] ] QED Theorem WG5_backward : !e e'. WG (\t. par (e t) (e' t)) ==> WG e /\ WG e' Proof - rpt STRIP_TAC \\ (* 2 subgoals here, same tacticals *) - ( POP_ASSUM (STRIP_ASSUME_TAC o - (ONCE_REWRITE_RULE [WG_cases])) \\ (* 6 subgoals here *) - fs [FUN_EQ_THM] (* 2 subgoals left *) + rpt STRIP_TAC >| [ (* goal 1 (of 2) *) - Cases_on `p` (* 8 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- (FULL_SIMP_TAC std_ss [CCS_11] \\ - rename1 `!t. (e t = C') /\ (e' t = C0)` \\ - `(e = \t. C') /\ (e' = \t. C0)` by PROVE_TAC [] \\ - ASM_REWRITE_TAC [WG2]) - >> PROVE_TAC [CCS_distinct], + POP_ASSUM (STRIP_ASSUME_TAC o + (ONCE_REWRITE_RULE [WG_cases])) \\ (* 6 subgoals here *) + fs [FUN_EQ_THM] >| (* 2 subgoals left *) + [ (* goal 1.1 (of 2) *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e = \t. E1’ by PROVE_TAC [] >> POP_ORW >> rw [WG2], + (* goal 1.2 (of 2) *) + METIS_TAC [] ], (* goal 2 (of 2) *) - METIS_TAC [] ] ) + POP_ASSUM (STRIP_ASSUME_TAC o + (ONCE_REWRITE_RULE [WG_cases])) \\ (* 6 subgoals here *) + fs [FUN_EQ_THM] >| (* 2 subgoals left *) + [ (* goal 2.1 (of 2) *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e' = \t. E2’ by PROVE_TAC [] >> POP_ORW >> rw [WG2], + (* goal 2.2 (of 2) *) + METIS_TAC [] ] ] QED Theorem WG6_backward : @@ -709,16 +785,8 @@ Proof >> POP_ASSUM (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [WG_cases])) >> fs [FUN_EQ_THM] (* 2 subgoals left *) >| [ (* goal 1 (of 2) *) - Cases_on `p` (* 8 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- (FULL_SIMP_TAC std_ss [CCS_11] \\ - rename1 `!t. (L = f) /\ (e t = C')` \\ - `(e = \t. C')` by PROVE_TAC [] >> art [WG2]) - >> PROVE_TAC [CCS_distinct], + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e = \t. E’ by PROVE_TAC [] >> POP_ORW >> rw [WG2], (* goal 2 (of 2) *) METIS_TAC [] ] QED @@ -728,19 +796,10 @@ Theorem WG7_backward : Proof rpt STRIP_TAC >> POP_ASSUM (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [WG_cases])) - >> fs [FUN_EQ_THM] + >> fs [FUN_EQ_THM] (* 2 subgoals left *) >| [ (* goal 1 (of 2) *) - Cases_on `p` (* 8 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- (FULL_SIMP_TAC std_ss [CCS_11] \\ - rename1 `!t. (e t = C') /\ (rf = R)` \\ - `(e = \t. C')` by PROVE_TAC [] >> art [WG2]) - >> PROVE_TAC [CCS_distinct], + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] >> fs [] \\ + ‘e = \t. E’ by PROVE_TAC [] >> POP_ORW >> rw [WG2], (* goal 2 (of 2) *) METIS_TAC [] ] QED @@ -755,47 +814,51 @@ Proof QED (* Weakly guarded expressions are also expressions *) -val WG_IMP_CONTEXT = store_thm ( - "WG_IMP_CONTEXT", ``!e. WG e ==> CONTEXT e``, - Induct_on `WG` +Theorem WG_IMP_CONTEXT : + !e. WG e ==> CONTEXT e +Proof + HO_MATCH_MP_TAC WG_ind >> rpt STRIP_TAC (* 6 sub-goals here *) - >| [ REWRITE_TAC [CONTEXT2], + >| [ rw [CONTEXT2], MATCH_MP_TAC CONTEXT3 >> art [], MATCH_MP_TAC CONTEXT4 >> art [], MATCH_MP_TAC CONTEXT5 >> art [], MATCH_MP_TAC CONTEXT6 >> art [], - MATCH_MP_TAC CONTEXT7 >> art [] ]); + MATCH_MP_TAC CONTEXT7 >> art [] ] +QED -val CONTEXT_WG_combin = store_thm ( - "CONTEXT_WG_combin", ``!c e. CONTEXT c /\ WG e ==> WG (c o e)``, +Theorem CONTEXT_WG_combin : + !c e. CONTEXT c /\ WG e ==> WG (c o e) +Proof rpt STRIP_TAC >> NTAC 2 (POP_ASSUM MP_TAC) - >> Q.SPEC_TAC (`c`, `c`) + >> Q.ID_SPEC_TAC ‘c’ >> HO_MATCH_MP_TAC CONTEXT_ind >> REWRITE_TAC [o_DEF] >> BETA_TAC >> REWRITE_TAC [ETA_AX] >> rpt STRIP_TAC >> RES_TAC (* 6 sub-goals here *) >| [ (* goal 1 (of 6) *) - REWRITE_TAC [WG2], + rw [WG2], (* goal 2 (of 6) *) IMP_RES_TAC WG_IMP_CONTEXT \\ - MP_TAC (Q.SPECL [`a`, `(\x. (c :('a, 'b) context) (e x))`] WG3) \\ + MP_TAC (Q.SPECL [`a`, `(\x. (c :'a context) (e x))`] WG3) \\ BETA_TAC >> RW_TAC std_ss [], (* goal 3 (of 6) *) - MP_TAC (Q.SPECL [`(\x. (c :('a, 'b) context) (e x))`, - `(\x. (c' :('a, 'b) context) (e x))`] WG4) \\ + MP_TAC (Q.SPECL [`(\x. (c :'a context) (e x))`, + `(\x. (c' :'a context) (e x))`] WG4) \\ BETA_TAC >> RW_TAC std_ss [], (* goal 4 (of 6) *) - MP_TAC (Q.SPECL [`(\x. (c :('a, 'b) context) (e x))`, - `(\x. (c' :('a, 'b) context) (e x))`] WG5) \\ + MP_TAC (Q.SPECL [`(\x. (c :'a context) (e x))`, + `(\x. (c' :'a context) (e x))`] WG5) \\ BETA_TAC >> RW_TAC std_ss [], (* goal 5 (of 6) *) - MP_TAC (Q.SPECL [`L`, `(\x. (c :('a, 'b) context) (e x))`] WG6) \\ + MP_TAC (Q.SPECL [`L`, `(\x. (c :'a context) (e x))`] WG6) \\ BETA_TAC >> RW_TAC std_ss [], (* goal 6 (of 6) *) - MP_TAC (Q.SPECL [`rf`, `(\x. (c :('a, 'b) context) (e x))`] WG7) \\ - BETA_TAC >> RW_TAC std_ss [] ]); + MP_TAC (Q.SPECL [`rf`, `(\x. (c :'a context) (e x))`] WG7) \\ + BETA_TAC >> RW_TAC std_ss [] ] +QED (******************************************************************************) (* *) @@ -820,12 +883,20 @@ val [SG1, SG2, SG3, SG4, SG5, SG6, SG7] = (combine (["SG1", "SG2", "SG3", "SG4", "SG5", "SG6", "SG7"], CONJUNCTS SG_rules)); +Theorem SG_CONST : + !e. IS_CONST e ==> SG e +Proof + rw [IS_CONST_def] + >> ‘e = (\t. e nil)’ by fs [FUN_EQ_THM] + >> POP_ORW >> rw [SG1] +QED + (* Strongly guarded expressions are expressions *) val SG_IMP_CONTEXT = store_thm ( "SG_IMP_CONTEXT", ``!e. SG e ==> CONTEXT e``, Induct_on `SG` >> rpt STRIP_TAC (* 7 sub-goals here *) - >| [ REWRITE_TAC [CONTEXT2], + >| [ rw [CONTEXT2], MATCH_MP_TAC CONTEXT3 >> art [], MATCH_MP_TAC CONTEXT3 >> art [], MATCH_MP_TAC CONTEXT4 >> art [], @@ -838,7 +909,7 @@ val SG_IMP_WG = store_thm ( "SG_IMP_WG", ``!e. SG e ==> WG e``, Induct_on `SG` >> rpt STRIP_TAC (* 7 sub-goals here *) - >| [ REWRITE_TAC [WG2], + >| [ rw [WG2], MATCH_MP_TAC WG3 >> art [], MATCH_MP_TAC WG3 >> IMP_RES_TAC SG_IMP_CONTEXT, MATCH_MP_TAC WG4 >> art [], @@ -846,11 +917,6 @@ val SG_IMP_WG = store_thm ( MATCH_MP_TAC WG6 >> art [], MATCH_MP_TAC WG7 >> art [] ]); -val lemma = Q.prove (`!p :('a, 'b) CCS. ?q. q <> p`, - Cases_on `p` - >- ( Q.EXISTS_TAC `nil + nil` >> PROVE_TAC [CCS_distinct'] ) - >> ( Q.EXISTS_TAC `nil` >> PROVE_TAC [CCS_distinct'] )); - (* an important backward property of SG *) Theorem SG3_backward : !e. SG (\t. prefix tau (e t)) ==> SG e @@ -859,21 +925,21 @@ Proof >> POP_ASSUM (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [SG_cases])) (* 7 sub-goals here *) >| [ (* goal 1 (of 7) *) POP_ASSUM (ASSUME_TAC o BETA_RULE o (ONCE_REWRITE_RULE [FUN_EQ_THM])) \\ - Cases_on `p` (* 8 or 9 sub-goals here *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] (* 8 subgoals *) >- PROVE_TAC [CCS_distinct'] >- PROVE_TAC [CCS_distinct'] - >- ( FULL_SIMP_TAC std_ss [CCS_11] \\ - `(e = \t. C') \/ (e = \t. C)` by PROVE_TAC [] \\ (* 2 sub-goals *) - ASM_REWRITE_TAC [] >> REWRITE_TAC [SG1] ) + >- (fs [CCS_one_one, FUN_EQ_THM] \\ + ‘e = \t. E’ by PROVE_TAC [] >> POP_ORW \\ + rw [SG1]) >> PROVE_TAC [CCS_distinct'], (* goal 2 (of 7) *) qpat_x_assum `(\t. prefix tau (e t)) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ - PROVE_TAC [CCS_11, Action_distinct], + PROVE_TAC [CCS_one_one, Action_distinct], (* goal 3 (of 7) *) qpat_x_assum `(\t. prefix tau (e t)) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ - FULL_SIMP_TAC std_ss [CCS_11] \\ + FULL_SIMP_TAC std_ss [CCS_one_one] \\ METIS_TAC [], (* goal 4 (of 7) *) qpat_x_assum `(\t. prefix tau (e t)) = X` @@ -901,13 +967,13 @@ Proof ( POP_ASSUM (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [SG_cases])) (* 7 sub-goals here *) >| [ (* goal 1 (of 7) *) POP_ASSUM (ASSUME_TAC o BETA_RULE o (ONCE_REWRITE_RULE [FUN_EQ_THM])) \\ - Cases_on `p` (* 8 or 9 sub-goals here *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] (* 8 subgoals *) >- PROVE_TAC [CCS_distinct] >- PROVE_TAC [CCS_distinct] >- PROVE_TAC [CCS_distinct] - >- ( FULL_SIMP_TAC std_ss [CCS_11] \\ - `((e = \t. C) \/ (e = \t. C')) /\ (e' = \t. C0)` by PROVE_TAC [] \\ - ASM_REWRITE_TAC [] >> REWRITE_TAC [SG1] ) + >- (fs [FUN_EQ_THM, CCS_one_one] \\ + ‘(e = \t. E1) /\ (e' = \t. E2)’ by PROVE_TAC [] >> art [] \\ + rw [SG1]) >> PROVE_TAC [CCS_distinct], (* goal 2 (of 7) *) qpat_x_assum `(\t. sum (e t) (e' t)) = X` @@ -920,7 +986,7 @@ Proof (* goal 4 (of 7) *) qpat_x_assum `(\t. sum (e t) (e' t)) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ - FULL_SIMP_TAC std_ss [CCS_11] \\ + FULL_SIMP_TAC std_ss [CCS_one_one] \\ METIS_TAC [], (* goal 5 (of 7) *) qpat_x_assum `(\t. sum (e t) (e' t)) = X` @@ -936,25 +1002,26 @@ Proof PROVE_TAC [CCS_distinct'] ] ) QED -val SG10 = store_thm ("SG10", - ``!e e'. SG (\t. sum (prefix tau (e t)) (prefix tau (e' t))) ==> SG e /\ SG e'``, +Theorem SG10 : + !e e'. SG (\t. sum (prefix tau (e t)) (prefix tau (e' t))) ==> SG e /\ SG e' +Proof rpt STRIP_TAC >| [ (* goal 1 (of 2) *) POP_ASSUM (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [SG_cases])) >| (* 7 sub-goals here *) [ (* goal 1.1 (of 7) *) POP_ASSUM (ASSUME_TAC o BETA_RULE o (ONCE_REWRITE_RULE [FUN_EQ_THM])) \\ - Cases_on `p` (* 8 or 9 sub-goals here *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] (* 8 subgoals *) >- PROVE_TAC [CCS_distinct] >- PROVE_TAC [CCS_distinct] >- PROVE_TAC [CCS_distinct] - >- ( FULL_SIMP_TAC std_ss [CCS_11] \\ - (TRY (Cases_on `C'`) >> TRY (Cases_on `C`)) (* 8 or 9 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- ( FULL_SIMP_TAC std_ss [CCS_11] \\ - `(e = \t. C'') \/ (e = \t. C')` by PROVE_TAC [] \\ - ASM_REWRITE_TAC [] >> REWRITE_TAC [SG1] ) - >> PROVE_TAC [CCS_distinct] ) + >- (fs [CCS_one_one, FUN_EQ_THM] \\ + MP_TAC (Q.SPEC ‘E1’ CCS_cases) >> rw [] (* 8 subgoals *) + >- PROVE_TAC [CCS_distinct] + >- PROVE_TAC [CCS_distinct] + >- (fs [CCS_one_one, FUN_EQ_THM] \\ + ‘e = \t. E’ by PROVE_TAC [] >> POP_ORW \\ + rw [SG1]) + >> PROVE_TAC [CCS_distinct]) >> PROVE_TAC [CCS_distinct], (* goal 1.2 (of 7) *) qpat_x_assum `(\t. sum (prefix tau (e t)) (prefix tau (e' t))) = X` @@ -967,7 +1034,7 @@ val SG10 = store_thm ("SG10", (* goal 1.4 (of 7) *) qpat_x_assum `(\t. sum (prefix tau (e t)) (prefix tau (e' t))) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ - FULL_SIMP_TAC std_ss [CCS_11] \\ + FULL_SIMP_TAC std_ss [CCS_one_one] \\ `e1 = \t. prefix tau (e t)` by PROVE_TAC [] \\ FULL_SIMP_TAC std_ss [] \\ IMP_RES_TAC SG3_backward, @@ -985,67 +1052,69 @@ val SG10 = store_thm ("SG10", PROVE_TAC [CCS_distinct'] ], (* goal 2 (of 2) *) POP_ASSUM (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [SG_cases])) >| (* 7 sub-goals here *) - [ (* goal 1.1 (of 7) *) + [ (* goal 2.1 (of 7) *) POP_ASSUM (ASSUME_TAC o BETA_RULE o (ONCE_REWRITE_RULE [FUN_EQ_THM])) \\ - Cases_on `p` (* 8 or 9 sub-goals here *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] (* 8 subgoals *) >- PROVE_TAC [CCS_distinct] >- PROVE_TAC [CCS_distinct] >- PROVE_TAC [CCS_distinct] - >- ( FULL_SIMP_TAC std_ss [CCS_11] \\ - Cases_on `C0` (* 8 or 9 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- ( FULL_SIMP_TAC std_ss [CCS_11] \\ - `(e' = \t. C'') \/ (e' = \t. C')` by PROVE_TAC [] \\ - ASM_REWRITE_TAC [] >> REWRITE_TAC [SG1] ) - >> PROVE_TAC [CCS_distinct] ) + >- (fs [CCS_one_one, FUN_EQ_THM] \\ + MP_TAC (Q.SPEC ‘E2’ CCS_cases) >> rw [] (* 8 subgoals *) + >- PROVE_TAC [CCS_distinct] + >- PROVE_TAC [CCS_distinct] + >- (fs [CCS_one_one, FUN_EQ_THM] \\ + ‘e' = \t. E’ by PROVE_TAC [] >> POP_ORW \\ + rw [SG1]) + >> PROVE_TAC [CCS_distinct]) >> PROVE_TAC [CCS_distinct], - (* goal 1.2 (of 7) *) + (* goal 2.2 (of 7) *) qpat_x_assum `(\t. sum (prefix tau (e t)) (prefix tau (e' t))) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ PROVE_TAC [CCS_distinct'], - (* goal 1.3 (of 7) *) + (* goal 2.3 (of 7) *) qpat_x_assum `(\t. sum (prefix tau (e t)) (prefix tau (e' t))) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ PROVE_TAC [CCS_distinct'], - (* goal 1.4 (of 7) *) + (* goal 2.4 (of 7) *) qpat_x_assum `(\t. sum (prefix tau (e t)) (prefix tau (e' t))) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ - FULL_SIMP_TAC std_ss [CCS_11] \\ + FULL_SIMP_TAC std_ss [CCS_one_one] \\ `e2 = \t. prefix tau (e' t)` by PROVE_TAC [] \\ FULL_SIMP_TAC std_ss [] \\ IMP_RES_TAC SG3_backward, - (* goal 1.5 (of 7) *) + (* goal 2.5 (of 7) *) qpat_x_assum `(\t. sum (prefix tau (e t)) (prefix tau (e' t))) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ PROVE_TAC [CCS_distinct'], - (* goal 1.6 (of 7) *) + (* goal 2.6 (of 7) *) qpat_x_assum `(\t. sum (prefix tau (e t)) (prefix tau (e' t))) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ PROVE_TAC [CCS_distinct'], (* goal 1.7 (of 7) *) qpat_x_assum `(\t. sum (prefix tau (e t)) (prefix tau (e' t))) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ - PROVE_TAC [CCS_distinct'] ]]); + PROVE_TAC [CCS_distinct'] ] ] +QED -val SG11 = store_thm ("SG11", - ``!e e' L. SG (\t. sum (prefix tau (e t)) (prefix (label L) (e' t))) ==> SG e``, +Theorem SG11 : + !e e' L. SG (\t. sum (prefix tau (e t)) (prefix (label L) (e' t))) ==> SG e +Proof rpt STRIP_TAC >> POP_ASSUM (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [SG_cases])) (* 7 sub-goals here *) >| [ (* goal 1 (of 7) *) POP_ASSUM (ASSUME_TAC o BETA_RULE o (ONCE_REWRITE_RULE [FUN_EQ_THM])) \\ - Cases_on `p` (* 8 or 9 sub-goals here *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] (* 8 subgoals *) >- PROVE_TAC [CCS_distinct] >- PROVE_TAC [CCS_distinct] >- PROVE_TAC [CCS_distinct] - >- ( FULL_SIMP_TAC std_ss [CCS_11] \\ - (TRY (Cases_on `C'`) >> TRY (Cases_on `C`)) (* 8 or 9 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- ( FULL_SIMP_TAC std_ss [CCS_11] \\ - `(e = \t. C'') \/ (e = \t. C')` by PROVE_TAC [] \\ - ASM_REWRITE_TAC [] >> REWRITE_TAC [SG1] ) - >> PROVE_TAC [CCS_distinct] ) + >- (fs [CCS_one_one, FUN_EQ_THM] \\ + MP_TAC (Q.SPEC ‘E1’ CCS_cases) >> rw [] (* 8 subgoals *) + >- PROVE_TAC [CCS_distinct] + >- PROVE_TAC [CCS_distinct] + >- (fs [CCS_one_one, FUN_EQ_THM] \\ + ‘e = \t. E’ by PROVE_TAC [] >> POP_ORW \\ + rw [SG1]) + >> PROVE_TAC [CCS_distinct]) >> PROVE_TAC [CCS_distinct], (* goal 2 (of 7) *) qpat_x_assum `(\t. sum (prefix tau (e t)) (prefix (label L) (e' t))) = X` @@ -1058,7 +1127,7 @@ val SG11 = store_thm ("SG11", (* goal 4 (of 7) *) qpat_x_assum `(\t. sum (prefix tau (e t)) (prefix (label L) (e' t))) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ - FULL_SIMP_TAC std_ss [CCS_11] \\ + FULL_SIMP_TAC std_ss [CCS_one_one] \\ `e1 = \t. prefix tau (e t)` by PROVE_TAC [] \\ FULL_SIMP_TAC std_ss [] \\ IMP_RES_TAC SG3_backward, @@ -1073,26 +1142,28 @@ val SG11 = store_thm ("SG11", (* goal 7 (of 7) *) qpat_x_assum `(\t. sum (prefix tau (e t)) (prefix (label L) (e' t))) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ - PROVE_TAC [CCS_distinct'] ]); + PROVE_TAC [CCS_distinct'] ] +QED -val SG11' = store_thm ("SG11'", - ``!e e' L. SG (\t. sum (prefix (label L) (e t)) (prefix tau (e' t))) ==> SG e'``, +Theorem SG11' : + !e e' L. SG (\t. sum (prefix (label L) (e t)) (prefix tau (e' t))) ==> SG e' +Proof rpt STRIP_TAC >> POP_ASSUM (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [SG_cases])) (* 7 sub-goals here *) >| [ (* goal 1 (of 7) *) POP_ASSUM (ASSUME_TAC o BETA_RULE o (ONCE_REWRITE_RULE [FUN_EQ_THM])) \\ - Cases_on `p` (* 8 or 9 sub-goals here *) + MP_TAC (Q.SPEC ‘p’ CCS_cases) >> rw [] (* 8 subgoals *) >- PROVE_TAC [CCS_distinct] >- PROVE_TAC [CCS_distinct] >- PROVE_TAC [CCS_distinct] - >- ( FULL_SIMP_TAC std_ss [CCS_11] \\ - Cases_on `C0` (* 8 or 9 sub-goals here *) - >- PROVE_TAC [CCS_distinct] - >- PROVE_TAC [CCS_distinct] - >- ( FULL_SIMP_TAC std_ss [CCS_11] \\ - `(e' = \t. C'') \/ (e' = \t. C')` by PROVE_TAC [] \\ - ASM_REWRITE_TAC [] >> REWRITE_TAC [SG1] ) - >> PROVE_TAC [CCS_distinct] ) + >- (fs [CCS_one_one, FUN_EQ_THM] \\ + MP_TAC (Q.SPEC ‘E2’ CCS_cases) >> rw [] (* 8 subgoals *) + >- PROVE_TAC [CCS_distinct] + >- PROVE_TAC [CCS_distinct] + >- (fs [CCS_one_one, FUN_EQ_THM] \\ + ‘e' = \t. E’ by PROVE_TAC [] >> POP_ORW \\ + rw [SG1]) + >> PROVE_TAC [CCS_distinct]) >> PROVE_TAC [CCS_distinct], (* goal 2 (of 7) *) qpat_x_assum `(\t. sum (prefix (label L) (e t)) (prefix tau (e' t))) = X` @@ -1105,7 +1176,7 @@ val SG11' = store_thm ("SG11'", (* goal 4 (of 7) *) qpat_x_assum `(\t. sum (prefix (label L) (e t)) (prefix tau (e' t))) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ - FULL_SIMP_TAC std_ss [CCS_11] \\ + FULL_SIMP_TAC std_ss [CCS_one_one] \\ `e2 = \t. prefix tau (e' t)` by PROVE_TAC [] \\ FULL_SIMP_TAC std_ss [] \\ IMP_RES_TAC SG3_backward, @@ -1120,7 +1191,8 @@ val SG11' = store_thm ("SG11'", (* goal 7 (of 7) *) qpat_x_assum `(\t. sum (prefix (label L) (e t)) (prefix tau (e' t))) = X` (ASSUME_TAC o BETA_RULE o (REWRITE_RULE [FUN_EQ_THM])) \\ - PROVE_TAC [CCS_distinct'] ]); + PROVE_TAC [CCS_distinct'] ] +QED (******************************************************************************) (* *) @@ -1141,20 +1213,22 @@ val [SEQ1, SEQ2, SEQ3, SEQ4] = map save_thm (combine (["SEQ1", "SEQ2", "SEQ3", "SEQ4"], CONJUNCTS SEQ_rules)); val SEQ3a = store_thm ("SEQ3a", - ``!a :'b Action. SEQ (\t. prefix a t)``, + ``!a :'a Action. SEQ (\t. prefix a t)``, ASSUME_TAC SEQ1 >> IMP_RES_TAC SEQ3 >> POP_ASSUM MP_TAC >> BETA_TAC >> REWRITE_TAC []); -val SEQ_IMP_CONTEXT = store_thm ( - "SEQ_IMP_CONTEXT", ``!e. SEQ e ==> CONTEXT e``, - Induct_on `SEQ` +Theorem SEQ_IMP_CONTEXT : + !e. SEQ e ==> CONTEXT e +Proof + HO_MATCH_MP_TAC SEQ_ind >> rpt STRIP_TAC (* 4 sub-goals here *) >| [ REWRITE_TAC [CONTEXT1], - REWRITE_TAC [CONTEXT2], - MATCH_MP_TAC CONTEXT3 >> ASM_REWRITE_TAC [], - MATCH_MP_TAC CONTEXT4 >> ASM_REWRITE_TAC [] ]); + rw [CONTEXT2], + MATCH_MP_TAC CONTEXT3 >> art [], + MATCH_MP_TAC CONTEXT4 >> art [] ] +QED val SEQ_combin = store_thm ( "SEQ_combin", ``!E. SEQ E ==> !E'. SEQ E' ==> SEQ (E o E')``, @@ -1163,7 +1237,7 @@ val SEQ_combin = store_thm ( >> REWRITE_TAC [ETA_THM] >> rpt STRIP_TAC (* 3 sub-goals here *) >| [ (* goal 1 (of 3) *) - REWRITE_TAC [SEQ2], + rw [SEQ2], (* goal 2 (of 3) *) RES_TAC >> IMP_RES_TAC SEQ3 \\ NTAC 2 (POP_ASSUM K_TAC) \\ @@ -1202,23 +1276,33 @@ val [GSEQ1, GSEQ2, GSEQ3, GSEQ4] = CONJUNCTS GSEQ_rules)); val GSEQ3a = store_thm ("GSEQ3a", - ``!a :'b Action. GSEQ (\t. prefix a t)``, + ``!a :'a Action. GSEQ (\t. prefix a t)``, ASSUME_TAC GSEQ1 >> IMP_RES_TAC GSEQ3 >> POP_ASSUM MP_TAC >> BETA_TAC >> REWRITE_TAC []); -val GSEQ_IMP_CONTEXT = store_thm ( - "GSEQ_IMP_CONTEXT", ``!e. GSEQ e ==> CONTEXT e``, - Induct_on `GSEQ` +Theorem GSEQ_CONST : + !e. IS_CONST e ==> GSEQ e +Proof + RW_TAC std_ss [IS_CONST_def] + >> Know `e = (\t. e nil)` >- fs [FUN_EQ_THM] + >> Rewr' >> REWRITE_TAC [GSEQ2] +QED + +Theorem GSEQ_IMP_CONTEXT : + !e. GSEQ e ==> CONTEXT e +Proof + HO_MATCH_MP_TAC GSEQ_ind >> rpt STRIP_TAC (* 4 sub-goals here *) >| [ REWRITE_TAC [CONTEXT1], - REWRITE_TAC [CONTEXT2], - MATCH_MP_TAC CONTEXT3 >> ASM_REWRITE_TAC [], + rw [CONTEXT2], + MATCH_MP_TAC CONTEXT3 >> art [], qpat_x_assum `CONTEXT e1` (ASSUME_TAC o (Q.SPEC `a1`) o (MATCH_MP CONTEXT3)) \\ qpat_x_assum `CONTEXT e2` (ASSUME_TAC o (Q.SPEC `a2`) o (MATCH_MP CONTEXT3)) \\ MP_TAC (Q.SPECL [`\t. (prefix a1 (e1 t))`, `\t. (prefix a2 (e2 t))`] CONTEXT4) \\ - BETA_TAC >> RW_TAC std_ss [] ]); + BETA_TAC >> RW_TAC std_ss [] ] +QED val GSEQ_combin = store_thm ( "GSEQ_combin", ``!E. GSEQ E ==> !E'. GSEQ E' ==> GSEQ (E o E')``, @@ -1227,7 +1311,7 @@ val GSEQ_combin = store_thm ( >> REWRITE_TAC [ETA_THM] >> rpt STRIP_TAC (* 3 sub-goals here *) >| [ (* goal 1 (of 3) *) - REWRITE_TAC [GSEQ2], + rw [GSEQ2], (* goal 2 (of 3) *) RES_TAC >> IMP_RES_TAC GSEQ3 \\ NTAC 2 (POP_ASSUM K_TAC) \\ @@ -1255,27 +1339,27 @@ val WEAK_EQUIV_SUBST_GSEQ = store_thm ( this induction theorem than defining another combined inductive relation SG_SEQ and prove SG /\ SEQ = SQ_SEQ, which is a combinatorial explosion of cases. *) -val SG_SEQ_strong_induction = store_thm ( - "SG_SEQ_strong_induction", - ``!R. (!p. R (\t. p)) /\ - (!(l :'b Label) e. SEQ e ==> R (\t. prefix (label l) (e t))) /\ - (!(a :'b Action) e. SG e /\ SEQ e /\ R e ==> R (\t. prefix a (e t))) /\ +Theorem SG_SEQ_strong_induction : + !R. (!p. R (\t. p)) /\ + (!(l :'a Label) e. SEQ e ==> R (\t. prefix (label l) (e t))) /\ + (!(a :'a Action) e. SG e /\ SEQ e /\ R e ==> R (\t. prefix a (e t))) /\ (!e1 e2. SG e1 /\ SEQ e1 /\ R e1 /\ SG e2 /\ SEQ e2 /\ R e2 ==> R (\t. sum (e1 t) (e2 t))) - ==> (!e. SG e /\ SEQ e ==> R e)``, + ==> (!e. SG e /\ SEQ e ==> R e) +Proof rpt STRIP_TAC - >> qpat_x_assum `SG e` MP_TAC + >> qpat_x_assum ‘SG e’ MP_TAC >> POP_ASSUM MP_TAC - >> Q.SPEC_TAC (`e`, `e`) - >> Induct_on `SEQ` - >> rpt STRIP_TAC >> FULL_SIMP_TAC std_ss [] (* 3 sub-goals here *) + >> Q.ID_SPEC_TAC ‘e’ + >> HO_MATCH_MP_TAC SEQ_strongind + >> rpt STRIP_TAC >> fs [] (* 3 sub-goals here *) >| [ (* goal 1 (of 3) *) Suff `~SG (\t. t)` >- PROVE_TAC [] \\ KILL_TAC \\ CCONTR_TAC >> FULL_SIMP_TAC std_ss [] \\ POP_ASSUM (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [SG_cases])) (* 7 sub-goals here *) - >- ( POP_ASSUM (MP_TAC o BETA_RULE o (ONCE_REWRITE_RULE [FUN_EQ_THM])) \\ - STRIP_ASSUME_TAC (Q.SPEC `p` lemma) >> PROVE_TAC [] ) \\ + >- (POP_ASSUM (MP_TAC o BETA_RULE o (ONCE_REWRITE_RULE [FUN_EQ_THM])) \\ + STRIP_ASSUME_TAC (Q.SPEC `p` CCS_distinct_exists) >> PROVE_TAC []) \\ qpat_x_assum `(\t. t) = X` (ASSUME_TAC o BETA_RULE o (Q.SPEC `nil`) o (REWRITE_RULE [FUN_EQ_THM])) \\ PROVE_TAC [CCS_distinct'], @@ -1285,23 +1369,23 @@ val SG_SEQ_strong_induction = store_thm ( qpat_x_assum `!l e. SEQ e ==> P` MATCH_MP_TAC \\ ASM_REWRITE_TAC [], (* goal 2.2 (of 2) *) - Suff `SG e` >- ( DISCH_TAC \\ - qpat_x_assum `!a e. SG e /\ SEQ e /\ R e ==> P` MATCH_MP_TAC \\ - ASM_REWRITE_TAC [] >> METIS_TAC [] ) \\ + Suff `SG e` >- (DISCH_TAC \\ + qpat_x_assum `!a e. SG e /\ SEQ e /\ R e ==> P` MATCH_MP_TAC \\ + ASM_REWRITE_TAC [] >> METIS_TAC []) \\ POP_ASSUM MP_TAC >> KILL_TAC >> DISCH_TAC \\ - MATCH_MP_TAC SG3_backward >> ASM_REWRITE_TAC [] ], + MATCH_MP_TAC SG3_backward >> art [] ], (* goal 3 (of 3) *) qpat_x_assum `!e1 e2. X` MATCH_MP_TAC \\ ASM_REWRITE_TAC [] \\ - Suff `SG e /\ SG e'` >- ( STRIP_TAC >> ASM_REWRITE_TAC [] >> METIS_TAC [] ) \\ + Suff `SG e /\ SG e'` >- (STRIP_TAC >> art [] >> METIS_TAC []) \\ POP_ASSUM MP_TAC >> KILL_TAC >> DISCH_TAC \\ - MATCH_MP_TAC SG4_backward >> ASM_REWRITE_TAC [] ]); + MATCH_MP_TAC SG4_backward >> art [] ] +QED -val SG_GSEQ_strong_induction = store_thm ( - "SG_GSEQ_strong_induction", - ``!R. (!p. R (\t. p)) /\ - (!(l :'b Label) e. GSEQ e ==> R (\t. prefix (label l) (e t))) /\ - (!(a :'b Action) e. SG e /\ GSEQ e /\ R e ==> R (\t. prefix a (e t))) /\ +Theorem SG_GSEQ_strong_induction : + !R. (!p. R (\t. p)) /\ + (!(l :'a Label) e. GSEQ e ==> R (\t. prefix (label l) (e t))) /\ + (!(a :'a Action) e. SG e /\ GSEQ e /\ R e ==> R (\t. prefix a (e t))) /\ (!e1 e2. SG e1 /\ GSEQ e1 /\ R e1 /\ SG e2 /\ GSEQ e2 /\ R e2 ==> R (\t. sum (prefix tau (e1 t)) (prefix tau (e2 t)))) /\ (!l2 e1 e2. SG e1 /\ GSEQ e1 /\ R e1 /\ GSEQ e2 @@ -1310,20 +1394,21 @@ val SG_GSEQ_strong_induction = store_thm ( ==> R (\t. sum (prefix (label l1) (e1 t)) (prefix tau (e2 t)))) /\ (!l1 l2 e1 e2. GSEQ e1 /\ GSEQ e2 ==> R (\t. sum (prefix (label l1) (e1 t)) (prefix (label l2) (e2 t)))) - ==> (!e. SG e /\ GSEQ e ==> R e)``, + ==> (!e. SG e /\ GSEQ e ==> R e) +Proof rpt STRIP_TAC - >> qpat_x_assum `SG e` MP_TAC + >> qpat_x_assum ‘SG e’ MP_TAC >> POP_ASSUM MP_TAC - >> Q.SPEC_TAC (`e`, `e`) - >> Induct_on `GSEQ` - >> rpt STRIP_TAC >> FULL_SIMP_TAC std_ss [] (* 3 sub-goals here *) + >> Q.ID_SPEC_TAC ‘e’ + >> HO_MATCH_MP_TAC GSEQ_strongind + >> rpt STRIP_TAC >> fs [] (* 3 sub-goals here *) >| [ (* goal 1 (of 3) *) Suff `~SG (\t. t)` >- PROVE_TAC [] \\ KILL_TAC \\ CCONTR_TAC >> FULL_SIMP_TAC std_ss [] \\ POP_ASSUM (STRIP_ASSUME_TAC o (ONCE_REWRITE_RULE [SG_cases])) (* 7 sub-goals here *) - >- ( POP_ASSUM (MP_TAC o BETA_RULE o (ONCE_REWRITE_RULE [FUN_EQ_THM])) \\ - STRIP_ASSUME_TAC (Q.SPEC `p` lemma) >> PROVE_TAC [] ) \\ + >- (POP_ASSUM (MP_TAC o BETA_RULE o (ONCE_REWRITE_RULE [FUN_EQ_THM])) \\ + STRIP_ASSUME_TAC (Q.SPEC `p` CCS_distinct_exists) >> PROVE_TAC []) \\ qpat_x_assum `(\t. t) = X` (ASSUME_TAC o BETA_RULE o (Q.SPEC `nil`) o (REWRITE_RULE [FUN_EQ_THM])) \\ PROVE_TAC [CCS_distinct'], @@ -1333,55 +1418,56 @@ val SG_GSEQ_strong_induction = store_thm ( qpat_x_assum `!l e. GSEQ e ==> P` MATCH_MP_TAC \\ ASM_REWRITE_TAC [], (* goal 2.2 (of 2) *) - Suff `SG e` >- ( DISCH_TAC \\ - qpat_x_assum `!a e. SG e /\ GSEQ e /\ R e ==> P` MATCH_MP_TAC \\ - ASM_REWRITE_TAC [] >> METIS_TAC [] ) \\ + Suff `SG e` >- (DISCH_TAC \\ + qpat_x_assum `!a e. SG e /\ GSEQ e /\ R e ==> P` MATCH_MP_TAC \\ + ASM_REWRITE_TAC [] >> METIS_TAC []) \\ POP_ASSUM MP_TAC >> KILL_TAC >> DISCH_TAC \\ - MATCH_MP_TAC SG3_backward >> ASM_REWRITE_TAC [] ], + MATCH_MP_TAC SG3_backward >> art [] ], (* goal 3 (of 3) *) Cases_on `a1` >> Cases_on `a2` >| (* 4 sub-goals here *) [ (* goal 3.1 (of 4) *) qpat_x_assum `!e1 e2. X ==> R (\t. prefix tau (e1 t) + prefix tau (e2 t))` MATCH_MP_TAC \\ ASM_REWRITE_TAC [] \\ - Suff `SG e /\ SG e'` >- ( STRIP_TAC >> ASM_REWRITE_TAC [] >> METIS_TAC [] ) \\ + Suff `SG e /\ SG e'` >- (STRIP_TAC >> art [] >> METIS_TAC []) \\ POP_ASSUM MP_TAC >> KILL_TAC >> DISCH_TAC \\ - MATCH_MP_TAC SG10 >> ASM_REWRITE_TAC [], + MATCH_MP_TAC SG10 >> art [], (* goal 3.2 (of 4) *) qpat_x_assum `!l2 e1 e2. X ==> R (\t. prefix tau (e1 t) + prefix (label l2) (e2 t))` MATCH_MP_TAC \\ ASM_REWRITE_TAC [] \\ - Suff `SG e` >- ( STRIP_TAC >> ASM_REWRITE_TAC [] >> METIS_TAC [] ) \\ + Suff `SG e` >- (STRIP_TAC >> art [] >> METIS_TAC []) \\ POP_ASSUM MP_TAC >> KILL_TAC >> DISCH_TAC \\ - MATCH_MP_TAC SG11 >> take [`e'`, `x`] >> ASM_REWRITE_TAC [], + MATCH_MP_TAC SG11 >> take [`e'`, `x`] >> art [], (* goal 3.2 (of 4) *) qpat_x_assum `!l1 e1 e2. X ==> R (\t. prefix (label l1) (e1 t) + prefix tau (e2 t))` - MATCH_MP_TAC \\ - ASM_REWRITE_TAC [] \\ - Suff `SG e'` >- ( STRIP_TAC >> ASM_REWRITE_TAC [] >> METIS_TAC [] ) \\ + MATCH_MP_TAC >> art [] \\ + Suff `SG e'` >- (STRIP_TAC >> art [] >> METIS_TAC []) \\ POP_ASSUM MP_TAC >> KILL_TAC >> DISCH_TAC \\ - MATCH_MP_TAC SG11' >> take [`e`, `x`] >> ASM_REWRITE_TAC [], + MATCH_MP_TAC SG11' >> take [`e`, `x`] >> art [], (* goal 3.4 (of 4) *) qpat_x_assum `!l1 l2 e1 e2. X ==> R (\t. prefix (label l1) (e1 t) + prefix (label l2) (e2 t))` MATCH_MP_TAC \\ - ASM_REWRITE_TAC [] ] ]); + ASM_REWRITE_TAC [] ] ] +QED -val SG_SEQ_combin = store_thm ( - "SG_SEQ_combin", ``!E. SG E /\ SEQ E ==> !H. SEQ H ==> (SG (H o E) /\ SEQ (H o E))``, +Theorem SG_SEQ_combin : + !E. SG E /\ SEQ E ==> !H. SEQ H ==> (SG (H o E) /\ SEQ (H o E)) +Proof HO_MATCH_MP_TAC SG_SEQ_strong_induction >> REWRITE_TAC [o_DEF] >> BETA_TAC >> rpt STRIP_TAC (* 8 sub-goals here *) >| [ (* goal 1 (of 8) *) - REWRITE_TAC [SG1], + rw [SG1], (* goal 2 (of 8) *) - REWRITE_TAC [SEQ2], + rw [SEQ2], (* goal 3 (of 8) *) - POP_ASSUM MP_TAC >> Q.SPEC_TAC (`H`, `H`) \\ + POP_ASSUM MP_TAC >> Q.ID_SPEC_TAC ‘H’ \\ Induct_on `SEQ` >> BETA_TAC >> rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 3.1 (of 4) *) IMP_RES_TAC SEQ_IMP_CONTEXT \\ - MATCH_MP_TAC SG2 >> ASM_REWRITE_TAC [], + MATCH_MP_TAC SG2 >> art [], (* goal 3.2 (of 4) *) - REWRITE_TAC [SG1], + rw [SG1], (* goal 3.3 (of 4) *) IMP_RES_TAC SG3 \\ POP_ASSUM MP_TAC >> BETA_TAC \\ @@ -1403,15 +1489,15 @@ val SG_SEQ_combin = store_thm ( REWRITE_TAC [], (* goal 5 (of 8) *) POP_ASSUM MP_TAC \\ - Q.SPEC_TAC (`H`, `H`) \\ + Q.ID_SPEC_TAC ‘H’ \\ Induct_on `SEQ` >> BETA_TAC >> rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 5.1 (of 4) *) - MATCH_MP_TAC SG3 >> ASM_REWRITE_TAC [], + MATCH_MP_TAC SG3 >> art [], (* goal 5.2 (of 4) *) - REWRITE_TAC [SG1], + rw [SG1], (* goal 5.3 (of 4) *) - ASSUME_TAC (Q.SPECL [`a' :'b Action`, - `\x. (H :('a, 'b) CCS -> ('a, 'b) CCS) (prefix a (E x))`] SG3) \\ + ASSUME_TAC (Q.SPECL [`a' :'a Action`, + `\x. (H :'a CCS -> 'a CCS) (prefix a (E x))`] SG3) \\ POP_ASSUM MP_TAC \\ BETA_TAC >> rpt STRIP_TAC >> RES_TAC, (* goal 5.4 (of 4) *) @@ -1422,7 +1508,7 @@ val SG_SEQ_combin = store_thm ( BETA_TAC >> DISCH_TAC \\ METIS_TAC [] ], (* goal 6 (of 8) *) - ASSUME_TAC (Q.SPECL [`a :'b Action`, `E`] SEQ3) \\ + ASSUME_TAC (Q.SPECL [`a :'a Action`, `E`] SEQ3) \\ RES_TAC >> NTAC 4 (POP_ASSUM K_TAC) \\ ASSUME_TAC (Q.SPEC `H` SEQ_combin) \\ POP_ASSUM (ASSUME_TAC o (fn th => MP th (ASSUME ``SEQ H``))) \\ @@ -1432,15 +1518,15 @@ val SG_SEQ_combin = store_thm ( PROVE_TAC [], (* goal 7 (of 8) *) POP_ASSUM MP_TAC \\ - Q.SPEC_TAC (`H`, `H`) \\ + Q.ID_SPEC_TAC ‘H’ \\ Induct_on `SEQ` >> BETA_TAC >> rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 7.1 (of 4) *) - MATCH_MP_TAC SG4 >> ASM_REWRITE_TAC [], + MATCH_MP_TAC SG4 >> art [], (* goal 7.2 (of 4) *) - REWRITE_TAC [SG1], + rw [SG1], (* goal 7.3 (of 4) *) - ASSUME_TAC (Q.SPECL [`a :'b Action`, - `\x. (H :('a, 'b) CCS -> ('a, 'b) CCS) (E x + E' x)`] SG3) \\ + ASSUME_TAC (Q.SPECL [`a :'a Action`, + `\x. (H :'a CCS -> 'a CCS) (E x + E' x)`] SG3) \\ POP_ASSUM MP_TAC >> BETA_TAC >> rpt STRIP_TAC \\ PROVE_TAC [], (* goal 7.4 (of 4) *) @@ -1456,25 +1542,28 @@ val SG_SEQ_combin = store_thm ( NTAC 2 (qpat_x_assum `!H. X` K_TAC) >> RES_TAC \\ ASSUME_TAC (Q.SPEC `H` SEQ_combin) \\ RES_TAC >> NTAC 3 (POP_ASSUM K_TAC) \\ - POP_ASSUM MP_TAC >> REWRITE_TAC [o_DEF] >> BETA_TAC >> REWRITE_TAC [] ]); + POP_ASSUM MP_TAC >> REWRITE_TAC [o_DEF] \\ + BETA_TAC >> REWRITE_TAC [] ] +QED -val SG_GSEQ_combin = store_thm ( - "SG_GSEQ_combin", ``!E. SG E /\ GSEQ E ==> !H. GSEQ H ==> (SG (H o E) /\ GSEQ (H o E))``, +Theorem SG_GSEQ_combin : + !E. SG E /\ GSEQ E ==> !H. GSEQ H ==> (SG (H o E) /\ GSEQ (H o E)) +Proof HO_MATCH_MP_TAC SG_GSEQ_strong_induction >> REWRITE_TAC [o_DEF] >> BETA_TAC >> rpt STRIP_TAC (* 14 sub-goals here *) >| [ (* goal 1 (of 14) *) - REWRITE_TAC [SG1], + rw [SG1], (* goal 2 (of 14) *) - REWRITE_TAC [GSEQ2], + rw [GSEQ2], (* goal 3 (of 14) *) - POP_ASSUM MP_TAC >> Q.SPEC_TAC (`H`, `H`) \\ + POP_ASSUM MP_TAC >> Q.ID_SPEC_TAC ‘H’ \\ Induct_on `GSEQ` >> BETA_TAC >> rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 3.1 (of 4) *) IMP_RES_TAC GSEQ_IMP_CONTEXT \\ - MATCH_MP_TAC SG2 >> ASM_REWRITE_TAC [], + MATCH_MP_TAC SG2 >> art [], (* goal 3.2 (of 4) *) - REWRITE_TAC [SG1], + rw [SG1], (* goal 3.3 (of 4) *) IMP_RES_TAC SG3 \\ POP_ASSUM MP_TAC >> BETA_TAC \\ @@ -1500,15 +1589,15 @@ val SG_GSEQ_combin = store_thm ( REWRITE_TAC [], (* goal 5 (of 14) *) POP_ASSUM MP_TAC \\ - Q.SPEC_TAC (`H`, `H`) \\ + Q.ID_SPEC_TAC ‘H’ \\ Induct_on `GSEQ` >> BETA_TAC >> rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 5.1 (of 4) *) - MATCH_MP_TAC SG3 >> ASM_REWRITE_TAC [], + MATCH_MP_TAC SG3 >> art [], (* goal 5.2 (of 4) *) - REWRITE_TAC [SG1], + rw [SG1], (* goal 5.3 (of 4) *) - ASSUME_TAC (Q.SPECL [`a' :'b Action`, - `\x. (H :('a, 'b) CCS -> ('a, 'b) CCS) (prefix a (E x))`] SG3) \\ + ASSUME_TAC (Q.SPECL [`a' :'a Action`, + `\x. (H :'a CCS -> 'a CCS) (prefix a (E x))`] SG3) \\ POP_ASSUM MP_TAC \\ BETA_TAC >> rpt STRIP_TAC >> RES_TAC, (* goal 5.4 (of 4) *) @@ -1523,7 +1612,7 @@ val SG_GSEQ_combin = store_thm ( POP_ASSUM K_TAC \\ BETA_TAC >> DISCH_TAC >> METIS_TAC [] ], (* goal 6 (of 14) *) - ASSUME_TAC (Q.SPECL [`a :'b Action`, `E`] GSEQ3) \\ + ASSUME_TAC (Q.SPECL [`a :'a Action`, `E`] GSEQ3) \\ RES_TAC >> NTAC 4 (POP_ASSUM K_TAC) \\ ASSUME_TAC (Q.SPEC `H` GSEQ_combin) \\ POP_ASSUM (ASSUME_TAC o (fn th => MP th (ASSUME ``GSEQ H``))) \\ @@ -1533,7 +1622,7 @@ val SG_GSEQ_combin = store_thm ( PROVE_TAC [], (* goal 7 (of 14) *) POP_ASSUM MP_TAC \\ - Q.SPEC_TAC (`H`, `H`) \\ + Q.ID_SPEC_TAC ‘H’ \\ Induct_on `GSEQ` >> BETA_TAC >> rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 7.1 (of 4) *) IMP_RES_TAC SG3 \\ @@ -1544,11 +1633,11 @@ val SG_GSEQ_combin = store_thm ( POP_ASSUM K_TAC \\ BETA_TAC >> DISCH_TAC >> METIS_TAC [], (* goal 7.2 (of 4) *) - REWRITE_TAC [SG1], + rw [SG1], (* goal 7.3 (of 4) *) ASSUME_TAC - (Q.SPECL [`a :'b Action`, - `\x. (H :('a, 'b) CCS -> ('a, 'b) CCS) (tau..(E x) + tau..(E' x))`] SG3) \\ + (Q.SPECL [`a :'a Action`, + `\x. (H :'a CCS -> 'a CCS) (tau..(E x) + tau..(E' x))`] SG3) \\ POP_ASSUM MP_TAC >> BETA_TAC >> rpt STRIP_TAC \\ PROVE_TAC [], (* goal 7.4 (of 4) *) @@ -1571,7 +1660,7 @@ val SG_GSEQ_combin = store_thm ( POP_ASSUM MP_TAC >> REWRITE_TAC [o_DEF] >> BETA_TAC >> REWRITE_TAC [], (* goal 9 (of 14) *) POP_ASSUM MP_TAC \\ - Q.SPEC_TAC (`H`, `H`) \\ + Q.ID_SPEC_TAC ‘H’ \\ Induct_on `GSEQ` >> BETA_TAC >> rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 9.1 (of 4) *) IMP_RES_TAC SG3 \\ @@ -1584,11 +1673,11 @@ val SG_GSEQ_combin = store_thm ( POP_ASSUM MP_TAC \\ BETA_TAC >> DISCH_TAC >> METIS_TAC [], (* goal 9.2 (of 4) *) - REWRITE_TAC [SG1], + rw [SG1], (* goal 9.3 (of 4) *) ASSUME_TAC - (Q.SPECL [`a :'b Action`, - `\x. (H :('a, 'b) CCS -> ('a, 'b) CCS) (tau..(E x) + (label l2)..(e2 x))`] SG3) \\ + (Q.SPECL [`a :'a Action`, + `\x. (H :'a CCS -> 'a CCS) (tau..(E x) + (label l2)..(e2 x))`] SG3) \\ POP_ASSUM MP_TAC >> BETA_TAC >> rpt STRIP_TAC \\ PROVE_TAC [], (* goal 9.4 (of 4) *) @@ -1611,7 +1700,7 @@ val SG_GSEQ_combin = store_thm ( POP_ASSUM MP_TAC >> REWRITE_TAC [o_DEF] >> BETA_TAC >> REWRITE_TAC [], (* goal 11 (of 14) *) POP_ASSUM MP_TAC \\ - Q.SPEC_TAC (`H`, `H`) \\ + Q.ID_SPEC_TAC ‘H’ \\ Induct_on `GSEQ` >> BETA_TAC >> rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 11.1 (of 4) *) IMP_RES_TAC SG3 \\ @@ -1625,11 +1714,11 @@ val SG_GSEQ_combin = store_thm ( POP_ASSUM MP_TAC \\ BETA_TAC >> DISCH_TAC >> METIS_TAC [], (* goal 11.2 (of 4) *) - REWRITE_TAC [SG1], + rw [SG1], (* goal 11.3 (of 4) *) ASSUME_TAC - (Q.SPECL [`a :'b Action`, - `\x. (H :('a, 'b) CCS -> ('a, 'b) CCS) + (Q.SPECL [`a :'a Action`, + `\x. (H :'a CCS -> 'a CCS) ((label l1)..(e1 x) + tau..(E x))`] SG3) \\ POP_ASSUM MP_TAC >> BETA_TAC >> rpt STRIP_TAC \\ PROVE_TAC [], @@ -1653,7 +1742,7 @@ val SG_GSEQ_combin = store_thm ( POP_ASSUM MP_TAC >> REWRITE_TAC [o_DEF] >> BETA_TAC >> REWRITE_TAC [], (* goal 13 (of 14) *) POP_ASSUM MP_TAC \\ - Q.SPEC_TAC (`H`, `H`) \\ + Q.ID_SPEC_TAC ‘H’ \\ Induct_on `GSEQ` >> BETA_TAC >> rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 13.1 (of 4) *) IMP_RES_TAC GSEQ_IMP_CONTEXT \\ @@ -1667,11 +1756,11 @@ val SG_GSEQ_combin = store_thm ( POP_ASSUM MP_TAC >> KILL_TAC \\ BETA_TAC >> DISCH_TAC >> METIS_TAC [], (* goal 13.2 (of 4) *) - REWRITE_TAC [SG1], + rw [SG1], (* goal 13.3 (of 4) *) ASSUME_TAC - (Q.SPECL [`a :'b Action`, - `\x. (H :('a, 'b) CCS -> ('a, 'b) CCS) + (Q.SPECL [`a :'a Action`, + `\x. (H :'a CCS -> 'a CCS) ((label l1)..(e1 x) + (label l2)..(e2 x))`] SG3) \\ POP_ASSUM MP_TAC >> BETA_TAC >> rpt STRIP_TAC >> PROVE_TAC [], (* goal 13.4 (of 4) *) @@ -1690,7 +1779,8 @@ val SG_GSEQ_combin = store_thm ( RW_TAC std_ss [] \\ qpat_x_assum `!E'. GSEQ E' ==> X` (MP_TAC o (Q.SPEC `\t. (label l1)..(e1 t) + (label l2)..(e2 t)`)) \\ - REWRITE_TAC [o_DEF] >> BETA_TAC >> METIS_TAC [] ]); + REWRITE_TAC [o_DEF] >> BETA_TAC >> METIS_TAC [] ] +QED (******************************************************************************) (* *) @@ -1718,9 +1808,17 @@ val [WGS2, WGS3, WGS4, WGS5, WGS6, WGS7] = (combine (["WGS2", "WGS3", "WGS4", "WGS5", "WGS6", "WGS7"], CONJUNCTS WGS_rules)); +Theorem WGS_CONST : + !e. IS_CONST e ==> WGS e +Proof + RW_TAC std_ss [IS_CONST_def] + >> Know `e = (\t. e nil)` >- fs [FUN_EQ_THM] + >> Rewr' >> REWRITE_TAC [WGS2] +QED + (** WGS1 is derivable from WGS3 *) val WGS1 = store_thm ("WGS1", - ``!a :'b Action. WGS (\t. prefix a t)``, + ``!a :'a Action. WGS (\t. prefix a t)``, ASSUME_TAC GCONTEXT1 >> IMP_RES_TAC WGS3 >> POP_ASSUM MP_TAC @@ -1731,7 +1829,7 @@ val WGS_IMP_GCONTEXT = store_thm ( "WGS_IMP_GCONTEXT", ``!e. WGS e ==> GCONTEXT e``, Induct_on `WGS` >> rpt STRIP_TAC (* 6 sub-goals here *) - >| [ REWRITE_TAC [GCONTEXT2], + >| [ rw [GCONTEXT2], MATCH_MP_TAC GCONTEXT3 >> ASM_REWRITE_TAC [], MATCH_MP_TAC GCONTEXT4 >> ASM_REWRITE_TAC [], MATCH_MP_TAC GCONTEXT5 >> ASM_REWRITE_TAC [], @@ -1744,39 +1842,45 @@ val WGS_IMP_CONTEXT = store_thm ( >> MATCH_MP_TAC GCONTEXT_IMP_CONTEXT >> IMP_RES_TAC WGS_IMP_GCONTEXT); -val GCONTEXT_WGS_combin = store_thm ( - "GCONTEXT_WGS_combin", ``!c e. GCONTEXT c /\ WGS e ==> WGS (c o e)``, +Theorem GCONTEXT_WGS_combin : + !c e. GCONTEXT c /\ WGS e ==> WGS (c o e) +Proof rpt STRIP_TAC >> NTAC 2 (POP_ASSUM MP_TAC) - >> Q.SPEC_TAC (`c`, `c`) + >> Q.ID_SPEC_TAC ‘c’ >> HO_MATCH_MP_TAC GCONTEXT_ind >> REWRITE_TAC [o_DEF] >> BETA_TAC >> REWRITE_TAC [ETA_AX] >> rpt STRIP_TAC >> RES_TAC (* 6 sub-goals here *) >| [ (* goal 1 (of 6) *) - REWRITE_TAC [WGS2], + rw [WGS2], (* goal 2 (of 6) *) IMP_RES_TAC WGS_IMP_GCONTEXT \\ - MP_TAC (Q.SPECL [`a`, `(\x. (c :('a, 'b) context) (e x))`] WGS3) \\ + MP_TAC (Q.SPECL [`a`, `(\x. (c :'a context) (e x))`] WGS3) \\ BETA_TAC >> RW_TAC std_ss [], (* goal 3 (of 6) *) - MP_TAC (Q.SPECL [`a1`, `a2`, `(\x. (c :('a, 'b) context) (e x))`, - `(\x. (c' :('a, 'b) context) (e x))`] WGS4) \\ + MP_TAC (Q.SPECL [`a1`, `a2`, `(\x. (c :'a context) (e x))`, + `(\x. (c' :'a context) (e x))`] WGS4) \\ BETA_TAC \\ IMP_RES_TAC WGS_IMP_GCONTEXT >> RW_TAC std_ss [], (* goal 4 (of 6) *) - MP_TAC (Q.SPECL [`(\x. (c :('a, 'b) context) (e x))`, - `(\x. (c' :('a, 'b) context) (e x))`] WGS5) \\ + MP_TAC (Q.SPECL [`(\x. (c :'a context) (e x))`, + `(\x. (c' :'a context) (e x))`] WGS5) \\ BETA_TAC >> RW_TAC std_ss [], (* goal 5 (of 6) *) - MP_TAC (Q.SPECL [`L`, `(\x. (c :('a, 'b) context) (e x))`] WGS6) \\ + MP_TAC (Q.SPECL [`L`, `(\x. (c :'a context) (e x))`] WGS6) \\ BETA_TAC >> RW_TAC std_ss [], (* goal 6 (of 6) *) - MP_TAC (Q.SPECL [`rf`, `(\x. (c :('a, 'b) context) (e x))`] WGS7) \\ - BETA_TAC >> RW_TAC std_ss [] ]); + MP_TAC (Q.SPECL [`rf`, `(\x. (c :'a context) (e x))`] WGS7) \\ + BETA_TAC >> RW_TAC std_ss [] ] +QED val _ = export_theory (); val _ = html_theory "Congruence"; -(* last updated: Oct 12, 2017 *) +(* Bibliography: + + [1] Milner, Robin. Communication and concurrency. Prentice hall, 1989. + + *) diff --git a/examples/CCS/ContractionScript.sml b/examples/CCS/ContractionScript.sml index fab265cfd8..e7be88325e 100644 --- a/examples/CCS/ContractionScript.sml +++ b/examples/CCS/ContractionScript.sml @@ -12,12 +12,11 @@ open HolKernel Parse boolLib bossLib; open relationTheory combinTheory listTheory; -open CCSLib CCSTheory; -open StrongEQTheory StrongLawsTheory; -open WeakEQTheory WeakEQLib WeakLawsTheory; -open ObsCongrTheory ObsCongrLib ObsCongrLawsTheory ObsCongrConv; -open TraceTheory CongruenceTheory CoarsestCongrTheory; -open ExpansionTheory; + +open CCSLib CCSTheory StrongEQTheory StrongLawsTheory + WeakEQTheory WeakEQLib WeakLawsTheory ObsCongrTheory ObsCongrLib + ObsCongrLawsTheory ObsCongrConv TraceTheory CongruenceTheory + CoarsestCongrTheory ExpansionTheory; val _ = new_theory "Contraction"; val _ = temp_loose_equality (); @@ -29,8 +28,8 @@ val _ = temp_loose_equality (); (******************************************************************************) val CONTRACTION = new_definition ("CONTRACTION", - ``CONTRACTION (Con: ('a, 'b) simulation) = - !(E :('a, 'b) CCS) (E' :('a, 'b) CCS). Con E E' ==> + ``CONTRACTION (Con :'a simulation) = + !(E :'a CCS) (E' :'a CCS). Con E E' ==> (!l. (!E1. TRANS E (label l) E1 ==> ?E2. TRANS E' (label l) E2 /\ Con E1 E2) /\ @@ -54,7 +53,7 @@ val IDENTITY_CONTRACTION = store_thm ( (* the proof is the same with EXPANSION_EPS *) val CONTRACTION_EPS = store_thm ( "CONTRACTION_EPS", - ``!(Con: ('a, 'b) simulation). CONTRACTION Con ==> + ``!(Con :'a simulation). CONTRACTION Con ==> !E E'. Con E E' ==> !E1. EPS E E1 ==> ?E2. EPS E' E2 /\ Con E1 E2``, REPEAT STRIP_TAC >> qpat_x_assum `Con E E'` MP_TAC @@ -69,7 +68,7 @@ val CONTRACTION_EPS = store_thm ( RES_TAC \\ IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E1 E2``)) + (ASSUME ``(Con :'a simulation) E1 E2``)) >- ( Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [] ) \\ Q.EXISTS_TAC `E2'` >> ASM_REWRITE_TAC [] \\ IMP_RES_TAC ONE_TAU \\ @@ -77,7 +76,7 @@ val CONTRACTION_EPS = store_thm ( val CONTRACTION_WEAK_TRANS_label' = store_thm ( "CONTRACTION_WEAK_TRANS_label'", - ``!(Con: ('a, 'b) simulation). CONTRACTION Con ==> + ``!(Con :'a simulation). CONTRACTION Con ==> !E E'. Con E E' ==> !l E2. WEAK_TRANS E' (label l) E2 ==> ?E1. WEAK_TRANS E (label l) E1 /\ WEAK_EQUIV E1 E2``, REPEAT STRIP_TAC @@ -85,7 +84,7 @@ val CONTRACTION_WEAK_TRANS_label' = store_thm ( >| [ (* goal 1 (of 2) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Con :'a simulation) E E'``)) \\ IMP_RES_TAC (MATCH_MP WEAK_EQUIV_WEAK_TRANS_label' (ASSUME ``WEAK_EQUIV E1 E''``)) \\ Q.EXISTS_TAC `E1'` >> ASM_REWRITE_TAC [] \\ @@ -94,7 +93,7 @@ val CONTRACTION_WEAK_TRANS_label' = store_thm ( (* goal 2 (of 2) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Con :'a simulation) E E'``)) \\ IMP_RES_TAC (MATCH_MP WEAK_EQUIV_EPS' (ASSUME ``WEAK_EQUIV E1 E''``)) \\ Q.EXISTS_TAC `E1'` >> ASM_REWRITE_TAC [] \\ @@ -110,12 +109,12 @@ val EXPANSION_IMP_CONTRACTION = store_thm ( >| [ (* goal 1 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION] (ASSUME ``EXPANSION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Con :'a simulation) E E'``)) \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [], (* goal 2 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION] (ASSUME ``EXPANSION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Con :'a simulation) E E'``)) \\ Q.EXISTS_TAC `E1` >> ASM_REWRITE_TAC [] \\ REWRITE_TAC [WEAK_EQUIV] \\ Q.EXISTS_TAC `Con` >> ASM_REWRITE_TAC [] \\ @@ -123,14 +122,14 @@ val EXPANSION_IMP_CONTRACTION = store_thm ( (* goal 3 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION] (ASSUME ``EXPANSION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E E'``)) (* 2 sub-goals here *) + (ASSUME ``(Con :'a simulation) E E'``)) (* 2 sub-goals here *) >- ( DISJ1_TAC >> ASM_REWRITE_TAC [] ) \\ DISJ2_TAC \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [], (* goal 4 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION] (ASSUME ``EXPANSION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Con :'a simulation) E E'``)) \\ IMP_RES_TAC WEAK_TRANS_IMP_EPS \\ Q.EXISTS_TAC `E1` >> ASM_REWRITE_TAC [] \\ REWRITE_TAC [WEAK_EQUIV] \\ @@ -147,7 +146,7 @@ val EXPANSION_IMP_CONTRACTION = store_thm ( any path in P. *) CoInductive contracts : - !(E :('a, 'b) CCS) (E' :('a, 'b) CCS). + !(E :'a CCS) (E' :'a CCS). (!l. (!E1. TRANS E (label l) E1 ==> ?E2. TRANS E' (label l) E2 /\ $contracts E1 E2) /\ @@ -259,26 +258,26 @@ val contracts_IMP_WEAK_EQUIV = store_thm ( >| [ (* goal 1 (of 8) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Con :'a simulation) E E'``)) \\ Q.EXISTS_TAC `E2` \\ CONJ_TAC >- ( MATCH_MP_TAC TRANS_IMP_WEAK_TRANS >> ASM_REWRITE_TAC [] ) \\ DISJ1_TAC >> ASM_REWRITE_TAC [], (* goal 2 (of 8) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Con :'a simulation) E E'``)) \\ Q.EXISTS_TAC `E1` >> ASM_REWRITE_TAC [], (* goal 3 (of 8) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E E'``)) (* 2 sub-goals here *) + (ASSUME ``(Con :'a simulation) E E'``)) (* 2 sub-goals here *) >- ( Q.EXISTS_TAC `E'` >> ASM_REWRITE_TAC [EPS_REFL] ) \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [] \\ IMP_RES_TAC ONE_TAU, (* goal 4 (of 8) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Con :'a simulation) E E'``)) \\ Q.EXISTS_TAC `E1` >> ASM_REWRITE_TAC [], (* goal 5 (of 8) *) IMP_RES_TAC WEAK_EQUIV_TRANS_label \\ @@ -296,7 +295,7 @@ val contracts_IMP_WEAK_EQUIV = store_thm ( (* This proof depends on `contracts_IMP_WEAK_EQUIV`, that's why it's here *) val CONTRACTION_EPS' = store_thm ( "CONTRACTION_EPS'", - ``!(Con: ('a, 'b) simulation). CONTRACTION Con ==> + ``!(Con :'a simulation). CONTRACTION Con ==> !E E'. Con E E' ==> !u E2. EPS E' E2 ==> ?E1. EPS E E1 /\ WEAK_EQUIV E1 E2``, REPEAT STRIP_TAC @@ -329,29 +328,29 @@ val COMP_CONTRACTION = store_thm ( >| [ (* goal 1 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con1``)) - (ASSUME ``(Con1 :('a, 'b) simulation) E y``)) \\ + (ASSUME ``(Con1 :'a simulation) E y``)) \\ IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con2``)) - (ASSUME ``(Con2 :('a, 'b) simulation) y E'``)) \\ + (ASSUME ``(Con2 :'a simulation) y E'``)) \\ Q.EXISTS_TAC `E2'` >> ASM_REWRITE_TAC [] \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [], (* goal 2 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con2``)) - (ASSUME ``(Con2 :('a, 'b) simulation) y E'``)) \\ + (ASSUME ``(Con2 :'a simulation) y E'``)) \\ IMP_RES_TAC (MATCH_MP (MATCH_MP CONTRACTION_WEAK_TRANS_label' (ASSUME ``CONTRACTION Con1``)) - (ASSUME ``(Con1 :('a, 'b) simulation) E y``)) \\ + (ASSUME ``(Con1 :'a simulation) E y``)) \\ Q.EXISTS_TAC `E1'` >> ASM_REWRITE_TAC [] \\ IMP_RES_TAC WEAK_EQUIV_TRANS, (* goal 3 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con1``)) - (ASSUME ``(Con1 :('a, 'b) simulation) E y``)) (* 2 sub-goals here *) + (ASSUME ``(Con1 :'a simulation) E y``)) (* 2 sub-goals here *) >- ( DISJ1_TAC >> Q.EXISTS_TAC `y` >> ASM_REWRITE_TAC [] ) \\ IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con2``)) - (ASSUME ``(Con2 :('a, 'b) simulation) y E'``)) (* 2 sub-goals here *) + (ASSUME ``(Con2 :'a simulation) y E'``)) (* 2 sub-goals here *) >- ( DISJ1_TAC >> Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [] ) \\ DISJ2_TAC \\ Q.EXISTS_TAC `E2'` >> ASM_REWRITE_TAC [] \\ @@ -359,10 +358,10 @@ val COMP_CONTRACTION = store_thm ( (* goal 4 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con2``)) - (ASSUME ``(Con2 :('a, 'b) simulation) y E'``)) \\ + (ASSUME ``(Con2 :'a simulation) y E'``)) \\ IMP_RES_TAC (MATCH_MP (MATCH_MP CONTRACTION_EPS' (ASSUME ``CONTRACTION Con1``)) - (ASSUME ``(Con1 :('a, 'b) simulation) E y``)) \\ + (ASSUME ``(Con1 :'a simulation) E y``)) \\ Q.EXISTS_TAC `E1'` >> ASM_REWRITE_TAC [] \\ IMP_RES_TAC WEAK_EQUIV_TRANS ]); @@ -754,9 +753,9 @@ val contracts_SUBST_RESTR = store_thm ( Q.EXISTS_TAC `restr L' E2'` \\ ASM_REWRITE_TAC [MATCH_MP WEAK_RESTR_label - (LIST_CONJ [ASSUME ``~((l': 'b Label) IN L')``, - ASSUME ``~((COMPL (l': 'b Label)) IN L')``, - REWRITE_RULE [ASSUME ``label (l :'b Label) = label l'``] + (LIST_CONJ [ASSUME ``~((l' :'a Label) IN L')``, + ASSUME ``~((COMPL (l' :'a Label)) IN L')``, + REWRITE_RULE [ASSUME ``label (l :'a Label) = label l'``] (ASSUME ``WEAK_TRANS E2 (label l) E2'``)])] \\ CONJ_TAC >- ( MATCH_MP_TAC RESTR >> Q.EXISTS_TAC `l'` >> rfs [Action_11] ) \\ take [`E''''`, `E2'`, `L'`] >> ASM_REWRITE_TAC [], @@ -768,9 +767,9 @@ val contracts_SUBST_RESTR = store_thm ( Q.EXISTS_TAC `restr L' E1'` \\ ASM_REWRITE_TAC [MATCH_MP WEAK_RESTR_label - (LIST_CONJ [ASSUME ``~((l': 'b Label) IN L')``, - ASSUME ``~((COMPL (l': 'b Label)) IN L')``, - REWRITE_RULE [ASSUME ``label (l :'b Label) = label l'``] + (LIST_CONJ [ASSUME ``~((l' :'a Label) IN L')``, + ASSUME ``~((COMPL (l' :'a Label)) IN L')``, + REWRITE_RULE [ASSUME ``label (l :'a Label) = label l'``] (ASSUME ``WEAK_TRANS E1 (label l) E1'``)])] \\ MATCH_MP_TAC WEAK_EQUIV_SUBST_RESTR >> ASM_REWRITE_TAC [], (* goal 3 (of 4) *) @@ -814,7 +813,7 @@ val contracts_SUBST_RELAB = store_thm ( IMP_RES_TAC TRANS_RELAB \\ qpat_x_assum `label l = relabel rf' u'` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_label \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = label l'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = label l'``] (ASSUME ``TRANS E1 u' E''''``)) \\ IMP_RES_TAC (MATCH_MP contracts_TRANS_label (ASSUME ``E1 contracts E2``)) \\ EXISTS_TAC ``relab E2' rf'`` \\ @@ -829,7 +828,7 @@ val contracts_SUBST_RELAB = store_thm ( IMP_RES_TAC TRANS_RELAB \\ qpat_x_assum `label l = relabel rf' u'` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_label \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = label l'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = label l'``] (ASSUME ``TRANS E2 u' E''''``)) \\ IMP_RES_TAC (MATCH_MP contracts_TRANS_label' (ASSUME ``E1 contracts E2``)) \\ EXISTS_TAC ``relab E1' rf'`` \\ @@ -844,7 +843,7 @@ val contracts_SUBST_RELAB = store_thm ( IMP_RES_TAC TRANS_RELAB \\ qpat_x_assum `tau = relabel rf' u'` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_tau \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = tau``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = tau``] (ASSUME ``TRANS E1 u' E''''``)) \\ IMP_RES_TAC (MATCH_MP contracts_TRANS_tau (ASSUME ``E1 contracts E2``)) >- ( DISJ1_TAC >> ASM_REWRITE_TAC [] \\ @@ -861,7 +860,7 @@ val contracts_SUBST_RELAB = store_thm ( IMP_RES_TAC TRANS_RELAB \\ qpat_x_assum `tau = relabel rf' u'` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_tau \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = tau``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = tau``] (ASSUME ``TRANS E2 u' E''''``)) \\ IMP_RES_TAC (MATCH_MP contracts_TRANS_tau' (ASSUME ``E1 contracts E2``)) \\ EXISTS_TAC ``relab E1' rf'`` \\ @@ -984,7 +983,7 @@ val contracts_AND_TRACE_tau_lemma = Q.prove ( REWRITE_TAC [TRACE_REFL, LENGTH] >> RW_TAC arith_ss [] ) >> IMP_RES_TAC NO_LABEL_cases >> qpat_x_assum `NO_LABEL xs ==> X` - (ASSUME_TAC o (fn thm => MATCH_MP thm (ASSUME ``NO_LABEL (xs :'b Action list)``))) + (ASSUME_TAC o (fn thm => MATCH_MP thm (ASSUME ``NO_LABEL (xs :'a Action list)``))) >> Cases_on `h` >> FULL_SIMP_TAC std_ss [Action_distinct_label, LENGTH] >> IMP_RES_TAC contracts_TRANS_tau >> RES_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) @@ -1082,7 +1081,7 @@ val contracts_AND_TRACE_label' = store_thm ( (* val BISIM_UPTO_contracts_and_C = new_definition ( "BISIM_UPTO_contracts_and_C", - ``BISIM_UPTO_contracts_and_C (Wbsm: ('a, 'b) simulation) = + ``BISIM_UPTO_contracts_and_C (Wbsm :'a simulation) = !E E'. Wbsm E E' ==> (!l. @@ -1105,8 +1104,8 @@ val BISIM_UPTO_contracts_and_C = new_definition ( (******************************************************************************) val OBS_contracts = new_definition ("OBS_contracts", - ``OBS_contracts (E :('a, 'b) CCS) (E' :('a, 'b) CCS) = - (!(u :'b Action). + ``OBS_contracts (E :'a CCS) (E' :'a CCS) = + (!(u :'a Action). (!E1. TRANS E u E1 ==> ?E2. TRANS E' u E2 /\ E1 contracts E2) /\ (!E2. TRANS E' u E2 ==> @@ -1150,26 +1149,26 @@ val OBS_contracts_BY_CONTRACTION = store_thm ( >| [ (* goal 1 (of 8) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E'' E'''``)) \\ + (ASSUME ``(Con :'a simulation) E'' E'''``)) \\ Q.EXISTS_TAC `E2'` \\ CONJ_TAC >- ( MATCH_MP_TAC TRANS_IMP_WEAK_TRANS >> art [] ) \\ DISJ1_TAC >> art [], (* goal 2 (of 8) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E'' E'''``)) \\ + (ASSUME ``(Con :'a simulation) E'' E'''``)) \\ Q.EXISTS_TAC `E1'` >> art [], (* goal 3 (of 8) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E'' E'''``)) (* 2 sub-goals here *) + (ASSUME ``(Con :'a simulation) E'' E'''``)) (* 2 sub-goals here *) >- ( Q.EXISTS_TAC `E'''` >> art [EPS_REFL] ) \\ Q.EXISTS_TAC `E2'` >> art [] \\ IMP_RES_TAC ONE_TAU, (* goal 4 (of 8) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [CONTRACTION] (ASSUME ``CONTRACTION Con``)) - (ASSUME ``(Con :('a, 'b) simulation) E'' E'''``)) \\ + (ASSUME ``(Con :'a simulation) E'' E'''``)) \\ Q.EXISTS_TAC `E1'` >> art [], (* goal 5 (of 8) *) IMP_RES_TAC WEAK_EQUIV_TRANS_label \\ @@ -1186,13 +1185,13 @@ val OBS_contracts_BY_CONTRACTION = store_thm ( val OBS_contracts_TRANS_LEFT = store_thm ( "OBS_contracts_TRANS_LEFT", - ``!E E'. OBS_contracts (E :('a, 'b) CCS) (E' :('a, 'b) CCS) ==> + ``!E E'. OBS_contracts (E :'a CCS) (E' :'a CCS) ==> !u E1. TRANS E u E1 ==> ?E2. TRANS E' u E2 /\ E1 contracts E2``, PROVE_TAC [OBS_contracts]); val OBS_contracts_TRANS_RIGHT = store_thm ( "OBS_contracts_TRANS_RIGHT", - ``!E E'. OBS_contracts (E :('a, 'b) CCS) (E' :('a, 'b) CCS) ==> + ``!E E'. OBS_contracts (E :'a CCS) (E' :'a CCS) ==> !u E2. TRANS E' u E2 ==> ?E1. WEAK_TRANS E u E1 /\ WEAK_EQUIV E1 E2``, PROVE_TAC [OBS_contracts]); @@ -1248,7 +1247,7 @@ val OBS_contracts_IMP_WEAK_EQUIV' = store_thm ( val OBS_contracts_EPS' = store_thm ( "OBS_contracts_EPS'", - ``!E E'. OBS_contracts (E :('a, 'b) CCS) (E' :('a, 'b) CCS) ==> + ``!E E'. OBS_contracts (E :'a CCS) (E' :'a CCS) ==> !E2. EPS E' E2 ==> ?E1. EPS E E1 /\ WEAK_EQUIV E1 E2``, rpt STRIP_TAC >> PAT_X_ASSUM ``OBS_contracts E E'`` MP_TAC @@ -1268,7 +1267,7 @@ val OBS_contracts_EPS' = store_thm ( val OBS_contracts_WEAK_TRANS' = store_thm ( "OBS_contracts_WEAK_TRANS'", - ``!E E'. OBS_contracts (E :('a, 'b) CCS) (E' :('a, 'b) CCS) ==> + ``!E E'. OBS_contracts (E :'a CCS) (E' :'a CCS) ==> !u E2. WEAK_TRANS E' u E2 ==> ?E1. WEAK_TRANS E u E1 /\ WEAK_EQUIV E1 E2``, rpt STRIP_TAC >> Cases_on `u` (* 2 sub-goals here *) @@ -1561,7 +1560,7 @@ val OBS_contracts_SUBST_RESTR = store_thm ( RES_TAC \\ ASSUME_TAC (MATCH_MP WEAK_RESTR_tau - (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``] + (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``] (ASSUME ``WEAK_TRANS E u E1``))) \\ Q.EXISTS_TAC `restr L E1` \\ IMP_RES_TAC WEAK_EQUIV_SUBST_RESTR >> art [], @@ -1569,9 +1568,9 @@ val OBS_contracts_SUBST_RESTR = store_thm ( RES_TAC \\ ASSUME_TAC (MATCH_MP WEAK_RESTR_label - (LIST_CONJ [ASSUME ``~((l: 'b Label) IN L)``, - ASSUME ``~((COMPL (l :'b Label)) IN L)``, - REWRITE_RULE [ASSUME ``(u :'b Action) = label l``] + (LIST_CONJ [ASSUME ``~((l :'a Label) IN L)``, + ASSUME ``~((COMPL (l :'a Label)) IN L)``, + REWRITE_RULE [ASSUME ``(u :'a Action) = label l``] (ASSUME ``WEAK_TRANS E u E1``)])) \\ Q.EXISTS_TAC `restr L E1` \\ IMP_RES_TAC WEAK_EQUIV_SUBST_RESTR >> art [] ] ]); @@ -1729,21 +1728,22 @@ val OBS_contracts_IMP_C_contracts = store_thm ( by PROVE_TAC [OBS_contracts_IMP_contracts, GSYM RSUBSET] >> MATCH_MP_TAC PCC_is_coarsest >> art []); -val SUM_contracts = new_definition ("SUM_contracts", - ``SUM_contracts = (\p q. !r. (sum p r) contracts (sum q r))``); +Definition SUM_contracts : + SUM_contracts = (\p q. !r. closed r ==> (sum p r) contracts (sum q r)) +End -val C_contracts_IMP_SUM_contracts = store_thm ( - "C_contracts_IMP_SUM_contracts", - ``!p q. C_contracts p q ==> SUM_contracts p q``, - REWRITE_TAC [C_contracts, SUM_contracts, CC_def] - >> BETA_TAC >> rpt STRIP_TAC - >> POP_ASSUM MP_TAC - >> Know `CONTEXT (\(t :('a, 'b) CCS). t) /\ CONTEXT (\t. r)` - >- REWRITE_TAC [CONTEXT1, CONTEXT2] +Theorem C_contracts_IMP_SUM_contracts : + !p q. C_contracts p q ==> SUM_contracts p q +Proof + rw [C_contracts, SUM_contracts, CC_def] + >> Q.PAT_X_ASSUM ‘!c. CONTEXT c ==> _’ MP_TAC + >> Know `CONTEXT (\(t :'a CCS). t) /\ CONTEXT (\t. r)` + >- rw [CONTEXT1, CONTEXT2] >> DISCH_TAC >> POP_ASSUM (ASSUME_TAC o (MATCH_MP CONTEXT4)) >> DISCH_TAC >> RES_TAC - >> POP_ASSUM (MP_TAC o BETA_RULE) >> Rewr); + >> POP_ASSUM (MP_TAC o BETA_RULE) >> Rewr +QED val OBS_contracts_IMP_SUM_contracts = store_thm ( "OBS_contracts_IMP_SUM_contracts", @@ -1755,18 +1755,19 @@ val OBS_contracts_IMP_SUM_contracts = store_thm ( (* OBS_contracts ==> C_contracts (coarsest) ==> SUM_contracts /\ || || || - ++===================<<<====================++ *) -val SUM_contracts_IMP_OBS_contracts = store_thm ( - "SUM_contracts_IMP_OBS_contracts", - ``!p q. free_action p /\ free_action q ==> - (SUM_contracts p q ==> OBS_contracts p q)``, + ++===================<<<====================++ + *) +Theorem SUM_contracts_IMP_OBS_contracts : + !p q. free_action p /\ free_action q ==> + (SUM_contracts p q ==> OBS_contracts p q) +Proof REWRITE_TAC [SUM_contracts, free_action_def, OBS_contracts] >> BETA_TAC >> reverse (rpt STRIP_TAC) (* 2 sub-goals here *) >| [ (* goal 1 (of 2), same as goal 2 of COARSEST_CONGR_RL *) ASSUME_TAC (Q.SPEC `prefix (label a') nil` - (ASSUME ``!r. (sum p r) contracts (sum q r)``)) \\ - IMP_RES_TAC SUM1 \\ + (ASSUME ``!r. closed r ==> (sum p r) contracts (sum q r)``)) \\ + fs [] >> IMP_RES_TAC SUM1 \\ POP_ASSUM (ASSUME_TAC o (Q.SPEC `prefix (label a') nil`)) \\ Cases_on `u` >| (* 2 sub-goals here *) [ (* goal 1.1 (of 2) *) @@ -1822,8 +1823,8 @@ val SUM_contracts_IMP_OBS_contracts = store_thm ( RES_TAC ] ] ], (* initial assumption of `q` is used here *) (* goal 2 (of 2) *) ASSUME_TAC (Q.SPEC `prefix (label a) nil` - (ASSUME ``!r. (sum p r) contracts (sum q r)``)) \\ - IMP_RES_TAC SUM1 \\ + (ASSUME ``!r. closed r ==> (sum p r) contracts (sum q r)``)) \\ + fs [] >> IMP_RES_TAC SUM1 \\ POP_ASSUM (ASSUME_TAC o (Q.SPEC `prefix (label a) nil`)) \\ Cases_on `u` >| (* 2 sub-goals here *) [ (* goal 2.1 (of 2) *) @@ -1838,7 +1839,7 @@ val SUM_contracts_IMP_OBS_contracts = store_thm ( (ASSUME ``E1 contracts E2``)) \\ RES_TAC \\ IMP_RES_TAC TRANS_TAU_AND_WEAK \\ - RES_TAC, (* initial assumption of `p` is used here *) + RES_TAC, (* goal 2.1.2 (of 2) *) PAT_X_ASSUM ``TRANS (sum q (prefix (label a) nil)) tau E2`` (STRIP_ASSUME_TAC o (MATCH_MP TRANS_SUM)) >| (* 2 sub-goals here *) @@ -1862,7 +1863,8 @@ val SUM_contracts_IMP_OBS_contracts = store_thm ( (ASSUME_TAC o (REWRITE_RULE [Action_11])) \\ `TRANS p (label a) E1` by RW_TAC std_ss [] \\ POP_ASSUM (ASSUME_TAC o (MATCH_MP TRANS_IMP_WEAK_TRANS)) \\ - RES_TAC ] ] ]); (* initial assumption of `p` is used here *) + RES_TAC ] ] ] +QED val COARSEST_PRECONGR_RL = save_thm ( "COARSEST_PRECONGR_RL", @@ -1878,9 +1880,13 @@ val COARSEST_PRECONGR_THM = store_thm ( >- REWRITE_TAC [OBS_contracts_IMP_SUM_contracts] >> MATCH_MP_TAC SUM_contracts_IMP_OBS_contracts >> art []); -(* |- ∀p q. free_action p ∧ free_action q ⇒ (p ⪰ᶜ q ⇔ ∀r. p + r ⪰ᵇ q + r) *) +(* |- !p q. + free_action p /\ free_action q ==> + (OBS_contracts p q <=> !r. closed r ==> p + r contracts q + r) + *) val COARSEST_PRECONGR_THM' = save_thm ( - "COARSEST_PRECONGR_THM'", BETA_RULE (REWRITE_RULE [SUM_contracts] COARSEST_PRECONGR_THM)); + "COARSEST_PRECONGR_THM'", + BETA_RULE (REWRITE_RULE [SUM_contracts] COARSEST_PRECONGR_THM)); (******************************************************************************) (* *) @@ -1888,7 +1894,7 @@ val COARSEST_PRECONGR_THM' = save_thm ( (* *) (******************************************************************************) -(* |- `∀p q. p ⪰ᶜ q ⇒ ∀r. p + r ⪰ᵇ q + r` *) +(* |- !p q. OBS_contracts p q ==> !r. closed r ==> p + r contracts q + r *) val COARSEST_PRECONGR_LR = save_thm ((* NEW *) "COARSEST_PRECONGR_LR", BETA_RULE (REWRITE_RULE [SUM_contracts] OBS_contracts_IMP_SUM_contracts)); @@ -1898,15 +1904,16 @@ val COARSEST_PRECONGR_LR = save_thm ((* NEW *) >> RW_TAC std_ss [OBS_contracts_SUBST_SUM_R] *) (* This is the OBS_contracts version of PROP3_COMMON *) -val COARSEST_PRECONGR_LEMMA = store_thm ((* NEW *) - "COARSEST_PRECONGR_LEMMA", - ``!p q. (?k. STABLE k /\ +Theorem COARSEST_PRECONGR_LEMMA : + !p q. (?k. STABLE k /\ closed k /\ (!p' u. WEAK_TRANS p u p' ==> ~(WEAK_EQUIV p' k)) /\ (!q' u. WEAK_TRANS q u q' ==> ~(WEAK_EQUIV q' k))) ==> - (!r. (sum p r) contracts (sum q r)) ==> OBS_contracts p q``, + (!r. closed r ==> (sum p r) contracts (sum q r)) ==> OBS_contracts p q +Proof rpt STRIP_TAC - >> PAT_X_ASSUM ``!r. (sum p r) contracts (sum q r)`` - (ASSUME_TAC o (Q.SPEC `prefix (label a) k`)) + >> Q.PAT_X_ASSUM ‘!r. closed r ==> (sum p r) contracts (sum q r)’ + (ASSUME_TAC o (Q.SPEC `prefix (label a) k`)) + >> rfs [] >> REWRITE_TAC [OBS_contracts] >> rpt STRIP_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) @@ -2017,14 +2024,15 @@ val COARSEST_PRECONGR_LEMMA = store_thm ((* NEW *) IMP_RES_TAC TRANS_AND_EPS, (* goal 2.2.2.2.2 (of 2) *) IMP_RES_TAC TRANS_PREFIX \\ - RW_TAC std_ss [Action_11] ] ] ] ] ]); + RW_TAC std_ss [Action_11] ] ] ] ] ] +QED (* The finite-state version of COARSEST_PRECONGR_THM; i. e. The contraction version of COARSEST_CONGR_FINITE (van Glabbeek scenario) *) val COARSEST_PRECONGR_FINITE = store_thm ((* NEW *) "COARSEST_PRECONGR_FINITE", ``!p q. finite_state p /\ finite_state q ==> - (OBS_contracts p q = !r. (sum p r) contracts (sum q r))``, + (OBS_contracts p q = !r. closed r ==> (sum p r) contracts (sum q r))``, rpt STRIP_TAC >> EQ_TAC >- REWRITE_TAC [COARSEST_PRECONGR_LR] >> MP_TAC (Q.SPECL [`p`, `q`] KLOP_LEMMA_FINITE) (* in CoarsestCongrTheory *) diff --git a/examples/CCS/ExampleScript.sml b/examples/CCS/ExampleScript.sml index 679bca0590..02f97acc4e 100644 --- a/examples/CCS/ExampleScript.sml +++ b/examples/CCS/ExampleScript.sml @@ -29,112 +29,13 @@ val _ = disable_tyabbrev_printing "simulation"; (******************************************************************************) (* *) -(* The proof of PROPERTY_STAR (old way as in Milner's book) *) +(* The coffee machine model [2] *) (* *) (******************************************************************************) -(* - In StrongEQScript.ml, currently we define STRONG_EQUIV (strong bisimilarity) by - HOL's co-inductive package (Hol_coreln): - -val (STRONG_EQUIV_rules, STRONG_EQUIV_coind, STRONG_EQUIV_cases) = Hol_coreln ` - (!(E :('a, 'b) CCS) (E' :('a, 'b) CCS). - (!u. - (!E1. TRANS E u E1 ==> - (?E2. TRANS E' u E2 /\ STRONG_EQUIV E1 E2)) /\ - (!E2. TRANS E' u E2 ==> - (?E1. TRANS E u E1 /\ STRONG_EQUIV E1 E2))) ==> STRONG_EQUIV E E')`; - - then the 3rd returned value (STRONG_EQUIV_cases) is just the PROPERTY_STAR: - -(* Prop. 4, page 91: strong equivalence satisfies property [*] *) -val PROPERTY_STAR = save_thm ((* NEW *) - "PROPERTY_STAR", STRONG_EQUIV_cases); - - However, if we started with the original definition of STRONG_EQUIV, which now - becomes a theorem: - -val STRONG_EQUIV = new_definition ( - "STRONG_EQUIV", - ``STRONG_EQUIV E E' = ?Bsm. Bsm E E' /\ STRONG_BISIM Bsm``); - - It's not easy to prove PROPERTY_STAR, below is the proof of Robin Milner through - a temporarily definition STRONG_EQUIV', originally formalized by Monica Nesi. - - *) - -(* Definition 3, page 91 in Milner's book. *) -val STRONG_EQUIV' = new_definition ( - "STRONG_EQUIV'", - ``STRONG_EQUIV' E E' = - (!u. - (!E1. TRANS E u E1 ==> - (?E2. TRANS E' u E2 /\ STRONG_EQUIV E1 E2)) /\ - (!E2. TRANS E' u E2 ==> - (?E1. TRANS E u E1 /\ STRONG_EQUIV E1 E2)))``); - -(* Strong equivalence implies the new relation. *) -val STRONG_EQUIV_IMP_STRONG_EQUIV' = store_thm ( - "STRONG_EQUIV_IMP_STRONG_EQUIV'", - ``!E E'. STRONG_EQUIV E E' ==> STRONG_EQUIV' E E'``, - rpt GEN_TAC - >> REWRITE_TAC [STRONG_EQUIV', STRONG_EQUIV] - >> rpt STRIP_TAC (* 2 sub-goals *) - >> IMP_RES_TAC - (MATCH_MP (EQ_MP STRONG_BISIM (ASSUME ``STRONG_BISIM Bsm``)) - (ASSUME ``(Bsm: ('a, 'b) simulation) E E'``)) - >| [ Q.EXISTS_TAC `E2`, - Q.EXISTS_TAC `E1` ] - >> ASM_REWRITE_TAC [] - >> Q.EXISTS_TAC `Bsm` - >> ASM_REWRITE_TAC [] ); - -val STRONG_EQUIV'_IS_STRONG_BISIM = store_thm ( - "STRONG_EQUIV'_IS_STRONG_BISIM", - ``STRONG_BISIM STRONG_EQUIV'``, - PURE_ONCE_REWRITE_TAC [STRONG_BISIM] - >> rpt STRIP_TAC (* 2 sub-goals here *) - >> IMP_RES_TAC - (EQ_MP (Q.SPECL [`E`, `E'`] STRONG_EQUIV') - (ASSUME ``STRONG_EQUIV' E E'``)) - >| [ Q.EXISTS_TAC `E2`, - Q.EXISTS_TAC `E1` ] - >> IMP_RES_TAC STRONG_EQUIV_IMP_STRONG_EQUIV' - >> ASM_REWRITE_TAC []); - -(* The new relation implies strong equivalence. *) -val STRONG_EQUIV'_IMP_STRONG_EQUIV = store_thm ( - "STRONG_EQUIV'_IMP_STRONG_EQUIV", - ``!E E'. STRONG_EQUIV' E E' ==> STRONG_EQUIV E E'``, - rpt STRIP_TAC - >> PURE_ONCE_REWRITE_TAC [STRONG_EQUIV] - >> EXISTS_TAC ``STRONG_EQUIV'`` - >> ASM_REWRITE_TAC [STRONG_EQUIV'_IS_STRONG_BISIM]); - -(* Prop. 4, page 91: strong equivalence satisfies property [*] *) -val PROPERTY_STAR' = store_thm ( - "PROPERTY_STAR'", - ``!E E'. STRONG_EQUIV E E' = - (!u. - (!E1. TRANS E u E1 ==> - (?E2. TRANS E' u E2 /\ STRONG_EQUIV E1 E2)) /\ - (!E2. TRANS E' u E2 ==> - (?E1. TRANS E u E1 /\ STRONG_EQUIV E1 E2)))``, - rpt GEN_TAC - >> EQ_TAC (* 2 sub-goals here *) - >| [ PURE_ONCE_REWRITE_TAC - [ONCE_REWRITE_RULE [STRONG_EQUIV'] STRONG_EQUIV_IMP_STRONG_EQUIV'], - PURE_ONCE_REWRITE_TAC - [ONCE_REWRITE_RULE [STRONG_EQUIV'] STRONG_EQUIV'_IMP_STRONG_EQUIV] ]); - -(******************************************************************************) -(* *) -(* The coffee machine model *) -(* *) -(******************************************************************************) - -val VM = ``rec "VM" (In "coin"..(In "ask-esp"..rec "VM1" (Out "esp-coffee"..var "VM") + - In "ask-am"..rec "VM2" (Out "am-coffee"..var "VM")))``; +val VM = “rec "VM" (In "coin".. + (In "ask-esp"..rec "VM1" (Out "esp-coffee"..var "VM") + + In "ask-am"..rec "VM2" (Out "am-coffee"..var "VM")))”; (* ex1 = |- label (name "a")..label (name "b")..nil + @@ -196,7 +97,8 @@ val List_eq_coList = store_thm ( (******************************************************************************) local - val (temp_A, trans) = CCS_TRANS ``label (name "a")..nil || label (coname "a")..nil``; + val (temp_A, trans) = + CCS_TRANS “label (name "a")..nil || label (coname "a")..nil”; val nodes = map (fn (l, s) => CCS_TRANS s) trans; in val ex_A = save_thm ("ex_A", temp_A); @@ -269,4 +171,9 @@ val _ = else {}; -(* last updated: Oct 15, 2017 *) +(* Bibliography: + + [1] Milner, Robin. Communication and concurrency. Prentice hall, 1989. + [2] Gorrieri, R., Versari, C.: Introduction to Concurrency Theory. Springer (2015). + + *) diff --git a/examples/CCS/ExpansionScript.sml b/examples/CCS/ExpansionScript.sml index 357e57be28..cc3121fb31 100644 --- a/examples/CCS/ExpansionScript.sml +++ b/examples/CCS/ExpansionScript.sml @@ -11,10 +11,9 @@ open HolKernel Parse boolLib bossLib; open relationTheory listTheory; -open CCSLib CCSTheory; -open StrongEQTheory StrongLawsTheory; -open WeakEQTheory WeakLawsTheory; -open CongruenceTheory TraceTheory; + +open CCSLib CCSTheory StrongEQTheory StrongLawsTheory; +open WeakEQTheory WeakLawsTheory CongruenceTheory TraceTheory; val _ = new_theory "Expansion"; val _ = temp_loose_equality (); @@ -27,8 +26,8 @@ val _ = temp_loose_equality (); (* The definitin is confirmed with [1], [2] and [3] *) val EXPANSION = new_definition ("EXPANSION", - ``EXPANSION (Exp: ('a, 'b) simulation) = - !(E :('a, 'b) CCS) (E' :('a, 'b) CCS). Exp E E' ==> + ``EXPANSION (Exp: 'a simulation) = + !(E :'a CCS) (E' :'a CCS). Exp E E' ==> (!l. (!E1. TRANS E (label l) E1 ==> ?E2. TRANS E' (label l) E2 /\ Exp E1 E2) /\ @@ -40,8 +39,8 @@ val EXPANSION = new_definition ("EXPANSION", (* alternative definition *) val EXPANSION_ALT = store_thm ( "EXPANSION_ALT", - ``EXPANSION (Exp: ('a, 'b) simulation) = - !(E :('a, 'b) CCS) (E' :('a, 'b) CCS). Exp E E' ==> + ``EXPANSION (Exp: 'a simulation) = + !(E :'a CCS) (E' :'a CCS). Exp E E' ==> (!l E1. TRANS E (label l) E1 ==> ?E2. TRANS E' (label l) E2 /\ Exp E1 E2) /\ (! E1. TRANS E tau E1 ==> Exp E1 E' \/ ?E2. TRANS E' tau E2 /\ Exp E1 E2) /\ (!u E2. TRANS E' u E2 ==> ?E1. WEAK_TRANS E u E1 /\ Exp E1 E2)``, @@ -79,7 +78,7 @@ val IDENTITY_EXPANSION = store_thm ( val EXPANSION_EPS = store_thm ( "EXPANSION_EPS", - ``!(Exp: ('a, 'b) simulation). EXPANSION Exp ==> + ``!(Exp: 'a simulation). EXPANSION Exp ==> !E E'. Exp E E' ==> !E1. EPS E E1 ==> ?E2. EPS E' E2 /\ Exp E1 E2``, REPEAT STRIP_TAC >> qpat_x_assum `Exp E E'` MP_TAC @@ -94,7 +93,7 @@ val EXPANSION_EPS = store_thm ( RES_TAC \\ IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION] (ASSUME ``EXPANSION Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E1 E2``)) + (ASSUME ``(Exp :'a simulation) E1 E2``)) >- ( Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [] ) \\ Q.EXISTS_TAC `E2'` >> ASM_REWRITE_TAC [] \\ IMP_RES_TAC ONE_TAU \\ @@ -102,7 +101,7 @@ val EXPANSION_EPS = store_thm ( val EXPANSION_EPS' = store_thm ( "EXPANSION_EPS'", - ``!(Exp: ('a, 'b) simulation). EXPANSION Exp ==> + ``!(Exp: 'a simulation). EXPANSION Exp ==> !E E'. Exp E E' ==> !E2. EPS E' E2 ==> ?E1. EPS E E1 /\ Exp E1 E2``, REPEAT STRIP_TAC >> qpat_x_assum `Exp E E'` MP_TAC @@ -117,7 +116,7 @@ val EXPANSION_EPS' = store_thm ( RES_TAC \\ IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION_ALT] (ASSUME ``EXPANSION Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E1 E2``)) \\ + (ASSUME ``(Exp :'a simulation) E1 E2``)) \\ `WEAK_TRANS E tau E1'` by PROVE_TAC [EPS_AND_WEAK_TRANS] \\ `EPS E E1'` by PROVE_TAC [WEAK_TRANS_IMP_EPS] \\ Q.EXISTS_TAC `E1'` >> ASM_REWRITE_TAC [] ]); @@ -125,20 +124,20 @@ val EXPANSION_EPS' = store_thm ( (* NOTE: EXPANSION_WEAK_TRANS doens't hold *) val EXPANSION_WEAK_TRANS' = store_thm ( "EXPANSION_WEAK_TRANS'", - ``!(Exp: ('a, 'b) simulation). EXPANSION Exp ==> + ``!(Exp: 'a simulation). EXPANSION Exp ==> !E E'. Exp E E' ==> !u E2. WEAK_TRANS E' u E2 ==> ?E1. WEAK_TRANS E u E1 /\ Exp E1 E2``, REPEAT STRIP_TAC >> IMP_RES_TAC WEAK_TRANS >> IMP_RES_TAC (MATCH_MP (MATCH_MP EXPANSION_EPS' (ASSUME ``EXPANSION Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E E'``)) + (ASSUME ``(Exp :'a simulation) E E'``)) >> IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION_ALT] (ASSUME ``EXPANSION Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E1' E1``)) + (ASSUME ``(Exp :'a simulation) E1' E1``)) >> IMP_RES_TAC (MATCH_MP (MATCH_MP EXPANSION_EPS' (ASSUME ``EXPANSION Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E1'' E2'``)) + (ASSUME ``(Exp :'a simulation) E1'' E2'``)) >> Q.EXISTS_TAC `E1'''` >> ASM_REWRITE_TAC [] >> MATCH_MP_TAC EPS_WEAK_EPS @@ -157,33 +156,33 @@ val COMP_EXPANSION = store_thm ( IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION_ALT] (ASSUME ``EXPANSION Exp1``)) - (ASSUME ``(Exp1 :('a, 'b) simulation) E y``)) \\ + (ASSUME ``(Exp1 :'a simulation) E y``)) \\ IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION_ALT] (ASSUME ``EXPANSION Exp2``)) - (ASSUME ``(Exp2 :('a, 'b) simulation) y E'``)) \\ + (ASSUME ``(Exp2 :'a simulation) y E'``)) \\ Q.EXISTS_TAC `E2'` >> ASM_REWRITE_TAC [] \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [], (* goal 2 (of 3) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION_ALT] (ASSUME ``EXPANSION Exp1``)) - (ASSUME ``(Exp1 :('a, 'b) simulation) E y``)) (* 2 sub-goals here *) + (ASSUME ``(Exp1 :'a simulation) E y``)) (* 2 sub-goals here *) >- ( DISJ1_TAC >> Q.EXISTS_TAC `y` >> ASM_REWRITE_TAC [] ) \\ IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION_ALT] (ASSUME ``EXPANSION Exp2``)) - (ASSUME ``(Exp2 :('a, 'b) simulation) y E'``)) (* 2 sub-goals here *) + (ASSUME ``(Exp2 :'a simulation) y E'``)) (* 2 sub-goals here *) >- ( DISJ1_TAC >> Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [] ) \\ DISJ2_TAC >> Q.EXISTS_TAC `E2'` >> ASM_REWRITE_TAC [] \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [], (* goal 2 (of 3) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION_ALT] (ASSUME ``EXPANSION Exp2``)) - (ASSUME ``(Exp2 :('a, 'b) simulation) y E'``)) \\ + (ASSUME ``(Exp2 :'a simulation) y E'``)) \\ IMP_RES_TAC (MATCH_MP (MATCH_MP EXPANSION_WEAK_TRANS' (ASSUME ``EXPANSION Exp1``)) - (ASSUME ``(Exp1 :('a, 'b) simulation) E y``)) \\ + (ASSUME ``(Exp1 :'a simulation) E y``)) \\ Q.EXISTS_TAC `E1'` >> ASM_REWRITE_TAC [] \\ Q.EXISTS_TAC `E1` >> ASM_REWRITE_TAC [] ]); @@ -195,24 +194,24 @@ val STRONG_BISIM_IMP_EXPANSION = store_thm ( >| [ (* goal 1 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [STRONG_BISIM] (ASSUME ``STRONG_BISIM Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Exp :'a simulation) E E'``)) \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [], (* goal 2 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [STRONG_BISIM] (ASSUME ``STRONG_BISIM Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Exp :'a simulation) E E'``)) \\ Q.EXISTS_TAC `E1` >> ASM_REWRITE_TAC [] \\ IMP_RES_TAC TRANS_IMP_WEAK_TRANS, (* goal 3 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [STRONG_BISIM] (ASSUME ``STRONG_BISIM Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Exp :'a simulation) E E'``)) \\ DISJ2_TAC \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [], (* goal 4 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [STRONG_BISIM] (ASSUME ``STRONG_BISIM Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Exp :'a simulation) E E'``)) \\ Q.EXISTS_TAC `E1` >> ASM_REWRITE_TAC [] \\ IMP_RES_TAC TRANS_IMP_WEAK_TRANS ]); @@ -225,25 +224,25 @@ val EXPANSION_IMP_WEAK_BISIM = store_thm ( >| [ (* goal 1 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION] (ASSUME ``EXPANSION Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Exp :'a simulation) E E'``)) \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [] \\ IMP_RES_TAC TRANS_IMP_WEAK_TRANS, (* goal 2 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION] (ASSUME ``EXPANSION Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Exp :'a simulation) E E'``)) \\ Q.EXISTS_TAC `E1` >> ASM_REWRITE_TAC [], (* goal 3 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION] (ASSUME ``EXPANSION Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E E'``)) (* 2 sub-goals here *) + (ASSUME ``(Exp :'a simulation) E E'``)) (* 2 sub-goals here *) >- ( Q.EXISTS_TAC `E'` >> ASM_REWRITE_TAC [EPS_REFL] ) \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [] \\ IMP_RES_TAC ONE_TAU, (* goal 4 (of 4) *) IMP_RES_TAC (MATCH_MP (REWRITE_RULE [EXPANSION] (ASSUME ``EXPANSION Exp``)) - (ASSUME ``(Exp :('a, 'b) simulation) E E'``)) \\ + (ASSUME ``(Exp :'a simulation) E E'``)) \\ Q.EXISTS_TAC `E1` >> ASM_REWRITE_TAC [] \\ IMP_RES_TAC WEAK_TRANS_IMP_EPS ]); @@ -252,7 +251,7 @@ val EXPANSION_IMP_WEAK_BISIM = store_thm ( * resources as P". *) CoInductive expands : - !(E :('a, 'b) CCS) (E' :('a, 'b) CCS). + !(E :'a CCS) (E' :'a CCS). (!l. (!E1. TRANS E (label l) E1 ==> ?E2. TRANS E' (label l) E2 /\ $expands E1 E2) /\ @@ -702,9 +701,9 @@ val expands_SUBST_RESTR = store_thm ( Q.EXISTS_TAC `restr L' E2'` \\ ASM_REWRITE_TAC [MATCH_MP WEAK_RESTR_label - (LIST_CONJ [ASSUME ``~((l': 'b Label) IN L')``, - ASSUME ``~((COMPL (l': 'b Label)) IN L')``, - REWRITE_RULE [ASSUME ``label (l :'b Label) = label l'``] + (LIST_CONJ [ASSUME ``~((l' :'a Label) IN L')``, + ASSUME ``~((COMPL (l' :'a Label)) IN L')``, + REWRITE_RULE [ASSUME ``label (l :'a Label) = label l'``] (ASSUME ``WEAK_TRANS E2 (label l) E2'``)])] \\ CONJ_TAC >- ( MATCH_MP_TAC RESTR >> Q.EXISTS_TAC `l'` >> rfs [Action_11] ) \\ take [`E''''`, `E2'`, `L'`] >> ASM_REWRITE_TAC [], @@ -716,9 +715,9 @@ val expands_SUBST_RESTR = store_thm ( Q.EXISTS_TAC `restr L' E1'` \\ ASM_REWRITE_TAC [MATCH_MP WEAK_RESTR_label - (LIST_CONJ [ASSUME ``~((l': 'b Label) IN L')``, - ASSUME ``~((COMPL (l': 'b Label)) IN L')``, - REWRITE_RULE [ASSUME ``label (l :'b Label) = label l'``] + (LIST_CONJ [ASSUME ``~((l' :'a Label) IN L')``, + ASSUME ``~((COMPL (l' :'a Label)) IN L')``, + REWRITE_RULE [ASSUME ``label (l :'a Label) = label l'``] (ASSUME ``WEAK_TRANS E1 (label l) E1'``)])] \\ take [`E1'`, `E''''`, `L'`] >> ASM_REWRITE_TAC [], (* goal 3 (of 4) *) @@ -766,7 +765,7 @@ val expands_SUBST_RELAB = store_thm ( IMP_RES_TAC TRANS_RELAB \\ qpat_x_assum `label l = relabel rf' u'` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_label \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = label l'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = label l'``] (ASSUME ``TRANS E1 u' E''''``)) \\ IMP_RES_TAC (MATCH_MP expands_TRANS_label (ASSUME ``E1 expands E2``)) \\ EXISTS_TAC ``relab E2' rf'`` \\ @@ -781,7 +780,7 @@ val expands_SUBST_RELAB = store_thm ( IMP_RES_TAC TRANS_RELAB \\ qpat_x_assum `label l = relabel rf' u'` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_label \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = label l'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = label l'``] (ASSUME ``TRANS E2 u' E''''``)) \\ IMP_RES_TAC (MATCH_MP expands_TRANS_label' (ASSUME ``E1 expands E2``)) \\ EXISTS_TAC ``relab E1' rf'`` \\ @@ -795,7 +794,7 @@ val expands_SUBST_RELAB = store_thm ( IMP_RES_TAC TRANS_RELAB \\ qpat_x_assum `tau = relabel rf' u'` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_tau \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = tau``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = tau``] (ASSUME ``TRANS E1 u' E''''``)) \\ IMP_RES_TAC (MATCH_MP expands_TRANS_tau (ASSUME ``E1 expands E2``)) >- ( DISJ1_TAC >> ASM_REWRITE_TAC [] \\ @@ -812,7 +811,7 @@ val expands_SUBST_RELAB = store_thm ( IMP_RES_TAC TRANS_RELAB \\ qpat_x_assum `tau = relabel rf' u'` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_tau \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = tau``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = tau``] (ASSUME ``TRANS E2 u' E''''``)) \\ IMP_RES_TAC (MATCH_MP expands_TRANS_tau' (ASSUME ``E1 expands E2``)) \\ EXISTS_TAC ``relab E1' rf'`` \\ @@ -868,7 +867,7 @@ val expands_AND_TRACE_tau_lemma = Q.prove ( REWRITE_TAC [TRACE_REFL, LENGTH] >> RW_TAC arith_ss [] ) >> IMP_RES_TAC NO_LABEL_cases >> qpat_x_assum `NO_LABEL xs ==> X` - (ASSUME_TAC o (fn thm => MATCH_MP thm (ASSUME ``NO_LABEL (xs :'b Action list)``))) + (ASSUME_TAC o (fn thm => MATCH_MP thm (ASSUME ``NO_LABEL (xs :'a Action list)``))) >> Cases_on `h` >> FULL_SIMP_TAC std_ss [Action_distinct_label, LENGTH] >> IMP_RES_TAC expands_TRANS_tau >> RES_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) @@ -948,7 +947,7 @@ val expands_AND_TRACE_label = store_thm ( (* val BISIM_UPTO_expands_and_C = new_definition ( "BISIM_UPTO_expands_and_C", - ``BISIM_UPTO_expands_and_C (Wbsm: ('a, 'b) simulation) = + ``BISIM_UPTO_expands_and_C (Wbsm: 'a simulation) = !E E'. Wbsm E E' ==> (!l. diff --git a/examples/CCS/Holmakefile b/examples/CCS/Holmakefile index 8dbe7c1d6c..f8da59f454 100644 --- a/examples/CCS/Holmakefile +++ b/examples/CCS/Holmakefile @@ -1,18 +1,10 @@ INCDIRS = examples/lambda/basics src/finite_maps src/TeX -INCLUDES = $(patsubst %,$(dprot $(HOLDIR)/%),$(INCDIRS)) - -EXTRA_CLEANS = heap munge.exe selftest.exe ccs-selftest.log - -ifdef POLY -HOLHEAP = heap -OBJNAMES = src/finite_maps/finite_map sigobj/bisimulation -OBJS = $(patsubst %,$(dprot $(HOLDIR)/%Theory.uo),$(OBJNAMES)) -all: $(HOLHEAP) +INCLUDES = $(patsubst %,$(dprot $(HOLDIR)/%),$(INCDIRS)) -$(HOLHEAP): $(OBJS) $(dprot $(HOLDIR)/bin/hol.state) - $(protect $(HOLDIR)/bin/buildheap) -o $@ $(protect $(HOLDIR)/src/finite_maps/finite_mapTheory) bisimulationTheory -endif +EXTRA_CLEANS = munge.exe selftest.exe ccs-selftest.log \ + $(patsubst %Theory.uo,%Theory.html,$(DEFAULT_TARGETS)) \ + $(patsubst %Theory.uo,%Theory.lst,$(DEFAULT_TARGETS)) all: $(DEFAULT_TARGETS) munge.exe selftest.exe diff --git a/examples/CCS/MultivariateScript.sml b/examples/CCS/MultivariateScript.sml index c2d234a8fe..dcdb5d60f2 100644 --- a/examples/CCS/MultivariateScript.sml +++ b/examples/CCS/MultivariateScript.sml @@ -2,13 +2,14 @@ (* FILE : MultivariateScript.sml *) (* DESCRIPTION : Unique Solution of CCS Equations (Multivariate Version) *) (* *) -(* COPYRIGHT : (c) 2019 Chun Tian, Fondazione Bruno Kessler, Italy *) +(* COPYRIGHTS : 2019-2020 Fondazione Bruno Kessler, Italy (Chun Tian) *) +(* 2023-2024 The Australian National University (Chun Tian) *) (* ========================================================================== *) open HolKernel Parse boolLib bossLib; -open relationTheory pred_setTheory pred_setLib listTheory finite_mapTheory; -open combinTheory arithmeticTheory; (* for o_DEF and FUNPOW *) +open combinTheory relationTheory pred_setTheory pred_setLib finite_mapTheory + arithmeticTheory listTheory; open CCSLib CCSTheory StrongEQTheory StrongLawsTheory WeakEQTheory TraceTheory ObsCongrTheory ContractionTheory CongruenceTheory BisimulationUptoTheory @@ -43,7 +44,7 @@ val _ = hide "fromList"; 1. What's a multivariate CCS equation? - Xs: A list of equation variables: [X1; X2; ...; Xn] :'a list - - Es: A list of arbitrary CCS terms: [E1; E2; ...; En] :('a,'b) CCS list + - Es: A list of arbitrary CCS terms: [E1; E2; ...; En] :'a CCS list ``ALL_DISTINCT Xs /\ (LENGTH Xs = LENGTH Es)`` must hold. @@ -68,7 +69,7 @@ val _ = hide "fromList"; 2. What's a solution of (above) multiviriate CCS equation (group)? - - Ps: A list of arbitrary CCS terms: [P1; P2; ...; Pn] :('a,'b) CCS list + - Ps: A list of arbitrary CCS terms: [P1; P2; ...; Pn] :'a CCS list `Ps` is a solution of (above) multivariate CCS equation (group) iff: @@ -82,7 +83,7 @@ val _ = hide "fromList"; Ps = MAP (SUBST (ZIP Xs Ps)) Es - (where ``ZIP Xs Ps`` is an alist of type ``:('a # ('a,'b) CCS) list``) + (where ``ZIP Xs Ps`` is an alist of type ``:('a # 'a CCS) list``) or (abbrev.) @@ -160,8 +161,7 @@ val _ = hide "fromList"; (* Section I: Multivariate Variable Substitution *) (* ========================================================================== *) -(* The use of alistTheory/finite_mapTheory to get rid of substitution - orders was suggested by Konrad Slind: (HOL-info, Oct 23, 2017): +(* This is now ‘ssub’ defined in CCSTheory. Original notes by Konrad Slind: "There are all kinds of issues with substitutions and applying them to term-like structures. I would probably start by choosing finite @@ -174,52 +174,17 @@ val _ = hide "fromList"; Also see /examples/unification/triangular/first-order for a unification case study." *) -Definition CCS_SUBST_def : - (CCS_SUBST (fm :('a |-> ('a, 'b) CCS)) nil = nil) /\ - (CCS_SUBST fm (prefix u E) = prefix u (CCS_SUBST fm E)) /\ - (CCS_SUBST fm (sum E1 E2) = sum (CCS_SUBST fm E1) - (CCS_SUBST fm E2)) /\ - (CCS_SUBST fm (par E1 E2) = par (CCS_SUBST fm E1) - (CCS_SUBST fm E2)) /\ - (CCS_SUBST fm (restr L E) = restr L (CCS_SUBST fm E)) /\ - (CCS_SUBST fm (relab E rf) = relab (CCS_SUBST fm E) rf) /\ - (CCS_SUBST fm (var X) = if X IN FDOM fm then fm ' X else (var X)) /\ - (CCS_SUBST fm (rec X E) = if X IN FDOM fm - then (rec X (CCS_SUBST (fm \\ X) E)) - else (rec X (CCS_SUBST fm E))) -End - -(* TODO: move to relationTheory *) -val _ = TeX_notation {hol = "\\\\", TeX = ("\\ensuremath{\\setminus}", 1)} - -(* broken into separate "axioms" *) -val [CCS_SUBST_nil, CCS_SUBST_prefix, CCS_SUBST_sum, CCS_SUBST_par, - CCS_SUBST_restr, CCS_SUBST_relab, CCS_SUBST_var, CCS_SUBST_rec] = - map save_thm - (combine (["CCS_SUBST_nil", "CCS_SUBST_prefix", - "CCS_SUBST_sum", "CCS_SUBST_par", - "CCS_SUBST_restr", "CCS_SUBST_relab", - "CCS_SUBST_var", "CCS_SUBST_rec"], - CONJUNCTS CCS_SUBST_def)); +val _ = TeX_notation {hol = "\\\\", TeX = ("\\ensuremath{\\setminus}", 1)}; -Theorem CCS_SUBST_FEMPTY : - !E. CCS_SUBST FEMPTY E = E -Proof - Induct_on `E` >> SRW_TAC [] [CCS_SUBST_def] -QED +Overload CCS_SUBST[local] = “ssub” -(* CCS_Subst can be expressed in CCS_SUBST *) -Theorem CCS_SUBST_SING : - !X E E'. CCS_SUBST (FEMPTY |+ (X,E')) E = CCS_Subst E E' X -Proof - GEN_TAC >> Induct_on `E` - >> SRW_TAC [] [CCS_SUBST_def, CCS_Subst_def] - >> REWRITE_TAC [CCS_SUBST_FEMPTY] -QED +Theorem CCS_SUBST_def = ssub_thm +Theorem CCS_SUBST_FEMPTY[local] = ssub_FEMPTY +Theorem CCS_SUBST_SING[local] = FEMPTY_update_apply (* from a key list and a value list (of same length) to an alist *) Definition fromList_def : - fromList (Xs :'a list) (Ps :('a, 'b) CCS list) = FEMPTY |++ ZIP (Xs,Ps) + fromList (Xs :string list) (Ps :'a CCS list) = FEMPTY |++ ZIP (Xs,Ps) End (* new pretty print format: ``[Ps/Xs] E`` (from termTheory) *) @@ -229,7 +194,7 @@ Theorem CCS_SUBST_sing : !X E E'. CCS_SUBST (fromList [X] [E']) E = CCS_Subst E E' X Proof RW_TAC list_ss [fromList_def, ZIP, FUPDATE_LIST_THM] - >> rw [CCS_SUBST_SING] + >> rw [CCS_SUBST_SING, CCS_Subst] QED Theorem fromList_EMPTY : @@ -304,16 +269,7 @@ Proof QED (* slightly more general then CCS_SUBST_elim *) -Theorem CCS_SUBST_elim' : - !E fm. DISJOINT (FV E) (FDOM fm) ==> (CCS_SUBST fm E = E) -Proof - Induct_on `E` (* 8 subgoals *) - >> reverse (RW_TAC lset_ss [Once CCS_SUBST_def, BV_def, FV_def]) - >- (`DISJOINT (FV E) (FDOM fm)` by ASM_SET_TAC [] \\ - METIS_TAC []) - >> FIRST_X_ASSUM MATCH_MP_TAC >> fs [] - >> ASM_SET_TAC [] -QED +Theorem CCS_SUBST_elim'[local] = GEN_ALL ssub_14b (* KEY result: if Xs is disjoint with free variables of E, then E{? / Xs} = E *) Theorem CCS_SUBST_elim : @@ -324,41 +280,35 @@ Proof >> MATCH_MP_TAC CCS_SUBST_elim' >> fs [FDOM_fromList] QED -val lemma0 = Q.prove ( - `!X P E fm. X NOTIN (FDOM fm) /\ +Theorem lemma0[local] : + !X P E fm. X NOTIN (FDOM fm) /\ DISJOINT (FDOM fm) (FV P) /\ FEVERY (\(k,v). X NOTIN (FV v)) fm ==> - (CCS_SUBST (fm |+ (X,P)) E = CCS_Subst (CCS_SUBST fm E) P X)`, - (* proof *) - NTAC 2 GEN_TAC - >> Induct_on `E` >> SRW_TAC [] [] - >> fs [CCS_Subst_def, CCS_SUBST_def, EVERY_MEM] (* 2 subgoals left *) - >- (Cases_on `a = X` >> fs [] \\ - Cases_on `a NOTIN FDOM fm` >> fs [] - >- (MATCH_MP_TAC EQ_SYM \\ - MATCH_MP_TAC CCS_Subst_elim >> rw [FV_def]) \\ - fs [FAPPLY_FUPDATE_THM] \\ - MATCH_MP_TAC EQ_SYM \\ - MATCH_MP_TAC CCS_Subst_elim \\ - fs [FEVERY_DEF]) - >> Cases_on `a = X` >> fs [DOMSUB_NOT_IN_DOM] - >> Cases_on `a NOTIN FDOM fm` >> fs [CCS_Subst_rec] - >> Know `fm |+ (X,P) \\ a = fm \\ a |+ (X,P)` - >- (MATCH_MP_TAC DOMSUB_FUPDATE_NEQ >> METIS_TAC []) >> Rewr' - >> FIRST_X_ASSUM MATCH_MP_TAC - >> fs [FDOM_DOMSUB, FEVERY_DEF] - >> RW_TAC std_ss [] - >> fs [DOMSUB_FAPPLY_NEQ]); + (CCS_SUBST (fm |+ (X,P)) E = CCS_Subst (CCS_SUBST fm E) P X) +Proof + rw [CCS_Subst] + (* applying ssub_update_apply_subst *) + >> Know ‘CCS_SUBST (fm |+ (X,P)) E = [CCS_SUBST fm P/X] (CCS_SUBST fm E)’ + >- (MATCH_MP_TAC ssub_update_apply_SUBST' >> fs [FEVERY_DEF]) + >> Rewr' + >> Suff ‘CCS_SUBST fm P = P’ >- rw [] + >> MATCH_MP_TAC ssub_14b >> rw [DISJOINT_SYM] +QED -(* CCS_SUBST_reduce leads to CCS_SUBST_FOLDR *) +(* CCS_SUBST_reduce leads to CCS_SUBST_FOLDR + + NOTE: added ‘DISJOINT (set Xs) (FV P)’ when switching to ‘ssub’ + *) Theorem CCS_SUBST_reduce : !X Xs P Ps. ~MEM X Xs /\ ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) /\ - EVERY (\e. X NOTIN (FV e)) Ps ==> - !E. (CCS_SUBST (fromList (X::Xs) (P::Ps)) E = - CCS_Subst (CCS_SUBST (fromList Xs Ps) E) P X) + EVERY (\e. X NOTIN (FV e)) Ps /\ + DISJOINT (set Xs) (FV P) ==> + !E. CCS_SUBST (fromList (X::Xs) (P::Ps)) E = + CCS_Subst (CCS_SUBST (fromList Xs Ps) E) P X Proof rpt STRIP_TAC >> Know `fromList (X::Xs) (P::Ps) = (fromList Xs Ps) |+ (X,P)` - >- (MATCH_MP_TAC fromList_HD >> art []) >> Rewr' + >- (MATCH_MP_TAC fromList_HD >> art []) + >> Rewr' >> MATCH_MP_TAC lemma0 >> fs [FDOM_fromList, FEVERY_DEF] >> RW_TAC std_ss [] @@ -370,11 +320,12 @@ Proof QED (* CCS_SUBST_reduce in another form *) -Theorem lemma1[local]: +Theorem lemma1[local] : !E E' map. map <> [] /\ ~MEM (FST (HD map)) (MAP FST (TL map)) /\ ALL_DISTINCT (MAP FST (TL map)) /\ + DISJOINT (set (MAP FST (TL map))) (FV (SND (HD map))) /\ EVERY (\e. (FST (HD map)) NOTIN (FV e)) (MAP SND (TL map)) /\ CCS_SUBST (FEMPTY |++ (TL map)) E = E' ==> @@ -393,56 +344,69 @@ Proof >> DISCH_THEN (fs o wrap) >> Know `(MAP SND (ZIP (Xs,Ps))) = Ps` >- PROVE_TAC [MAP_ZIP] >> DISCH_THEN (fs o wrap) - >> MP_TAC (REWRITE_RULE [fromList_def] (Q.SPECL [`q`,`Xs`,`r`,`Ps`] CCS_SUBST_reduce)) - >> RW_TAC std_ss [] - >> first_x_assum (qspec_then ‘E’ (MP_TAC o REWRITE_RULE [ZIP, LIST_TO_SET])) - >> rw [] + >> rename1 ‘~MEM X Xs’ + >> MP_TAC (REWRITE_RULE [fromList_def] (Q.SPECL [`X`,`Xs`,`r`,`Ps`] CCS_SUBST_reduce)) + >> simp [] QED (* Let map = ZIP(Xs,Ps), to convert CCS_SUBST to a folding of CCS_Subst, each P of Ps must contains free variables up to the corresponding X of Xs. *) -val lemma2 = Q.prove ( - `!E map. ALL_DISTINCT (MAP FST map) /\ - EVERY (\(x,p). FV p SUBSET {x}) map ==> +Theorem lemma2[local] : + !E map. ALL_DISTINCT (MAP FST map) /\ + EVERY (\(x,p). DISJOINT (set (MAP FST map)) (FV p)) map ==> (CCS_SUBST (FEMPTY |++ map) E = - FOLDR (\l e. CCS_Subst e (SND l) (FST l)) E map)`, - (* proof *) + FOLDR (\l e. CCS_Subst e (SND l) (FST l)) E map) +Proof GEN_TAC >> Induct_on `map` >- SRW_TAC [] [FUPDATE_LIST_THM, CCS_SUBST_FEMPTY] >> rpt STRIP_TAC >> fs [MAP] >> MP_TAC (Q.SPECL [`E`, `CCS_SUBST (FEMPTY |++ map) E`, `h::map`] lemma1) >> fs [] + >> Know ‘DISJOINT (set (MAP FST map)) (FV (SND h)) /\ + EVERY (\e. FST h # e) (MAP SND map)’ + >- (Cases_on ‘h’ >> fs [] \\ + Q.PAT_X_ASSUM ‘EVERY (\(x,p). DISJOINT (set (MAP FST map)) (FV p) /\ q # p) map’ + MP_TAC >> rw [EVERY_MEM, MEM_MAP] \\ + Q.PAT_X_ASSUM ‘!e. MEM e map ==> _’ (MP_TAC o (Q.SPEC ‘y’)) \\ + Cases_on ‘y’ >> rw []) + >> rw [] >> Cases_on `h` >> fs [] - >> rename1 `FV P SUBSET {X}` - >> Know `EVERY (\e. X NOTIN (FV e)) (MAP SND map)` - >- (fs [EVERY_MEM] >> RW_TAC std_ss [] \\ - fs [MEM_MAP] \\ - `X <> FST y` by METIS_TAC [] \\ - CCONTR_TAC >> fs [] >> RES_TAC \\ - Cases_on `y` >> fs [] >> ASM_SET_TAC []) - >> RW_TAC std_ss []); + >> rename1 `X # P` + >> Suff ‘CCS_SUBST (FEMPTY |++ map) E = + FOLDR (\l e. CCS_Subst e (SND l) (FST l)) E map’ >- rw [] + >> FIRST_X_ASSUM MATCH_MP_TAC + >> Q.PAT_X_ASSUM + ‘EVERY (\(x,p). DISJOINT (set (MAP FST map)) (FV p) /\ X # p) map’ MP_TAC + >> rw [EVERY_MEM] + >> Q.PAT_X_ASSUM ‘!e. MEM e map ==> _’ (MP_TAC o (Q.SPEC ‘e’)) + >> Cases_on ‘e’ >> rw [] +QED (* lemma2 in another form; this is less general than CCS_SUBST_reduce *) Theorem CCS_SUBST_FOLDR : - !Xs Ps E. ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) /\ - EVERY (\(x,p). FV p SUBSET {x}) (ZIP (Xs,Ps)) ==> + !Xs Ps E. ALL_DISTINCT Xs /\ LENGTH Ps = LENGTH Xs /\ + EVERY (\p. DISJOINT (set Xs) (FV p)) Ps ==> (CCS_SUBST (fromList Xs Ps) E = FOLDR (\(x,y) e. CCS_Subst e y x) E (ZIP (Xs,Ps))) Proof RW_TAC std_ss [] >> MP_TAC (Q.SPECL [`E`, `ZIP (Xs,Ps)`] lemma2) >> RW_TAC std_ss [MAP_ZIP, fromList_def] - >> KILL_TAC - >> Suff `(\l e. CCS_Subst e (SND l) (FST l)) = (\(x,y) e. CCS_Subst e y x)` - >- SIMP_TAC std_ss [] - >> rw [FUN_EQ_THM] - >> Cases_on `l` >> rw [] + >> Know `(\l e. CCS_Subst e (SND l) (FST l)) = (\(x,y) e. CCS_Subst e y x)` + >- (rw [FUN_EQ_THM] >> Cases_on `l` >> rw []) + >> DISCH_THEN (fs o wrap) + >> POP_ASSUM MATCH_MP_TAC + >> POP_ASSUM MP_TAC >> rw [EVERY_MEM, MEM_ZIP] + >> simp [] + >> FIRST_X_ASSUM MATCH_MP_TAC + >> rw [MEM_EL] + >> Q.EXISTS_TAC ‘n’ >> art [] QED Theorem CCS_SUBST_FOLDR' : - !Xs Ps E. ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) /\ - FEVERY (\(x,p). FV p SUBSET {x}) (fromList Xs Ps) ==> + !Xs Ps E. ALL_DISTINCT Xs /\ LENGTH Ps = LENGTH Xs /\ + EVERY (\p. DISJOINT (set Xs) (FV p)) Ps ==> (CCS_SUBST (fromList Xs Ps) E = FOLDR (\(x,y) e. CCS_Subst e y x) E (ZIP (Xs,Ps))) Proof @@ -450,13 +414,6 @@ Proof >> MATCH_MP_TAC CCS_SUBST_FOLDR >> art [] >> fs [FEVERY_DEF, EVERY_MEM] >> RW_TAC std_ss [MEM_ZIP] - >> fs [] - >> Know `FDOM (fromList Xs Ps) = set Xs` - >- (MATCH_MP_TAC FDOM_fromList >> art []) - >> DISCH_THEN (fs o wrap) - >> `MEM (EL n Xs) Xs` by METIS_TAC [MEM_EL] - >> RES_TAC - >> METIS_TAC [fromList_FAPPLY_EL] QED (* A FOLDL-like version of CCS_SUBST_reduce @@ -472,7 +429,6 @@ Proof QED *) -(* not used any more. *) Theorem CCS_SUBST_self : !E Xs. ALL_DISTINCT Xs ==> (CCS_SUBST (fromList Xs (MAP var Xs)) E = E) Proof @@ -482,163 +438,141 @@ Proof >> RW_TAC std_ss [] >> MP_TAC (Q.SPECL [`h`, `Xs`, `var h`, `MAP var Xs`] CCS_SUBST_reduce) >> `LENGTH (MAP var Xs) = LENGTH Xs` by PROVE_TAC [LENGTH_MAP] - >> Suff `EVERY (\e. h NOTIN FV e) (MAP var Xs)` >- fs [] - >> RW_TAC std_ss [EVERY_MEM, MEM_MAP] - >> ASM_SET_TAC [FV_def] + >> simp [] + >> Suff ‘EVERY (\e. h # e) (MAP var Xs)’ + >- RW_TAC std_ss [EVERY_MEM, MEM_MAP] + >> rw [EVERY_MAP, EVERY_MEM, FV_thm] QED -(* KEY result. `DISJOINT (BV C) (set Xs)` (usually from `context Xs C`) - is not really necessary but makes the proof (much) easier. - *) Theorem CCS_SUBST_nested : - !Xs Ps Es C. - ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) /\ (LENGTH Es = LENGTH Xs) /\ - DISJOINT (BV C) (set Xs) ==> - (CCS_SUBST (fromList Xs Ps) (CCS_SUBST (fromList Xs Es) C) = - CCS_SUBST (fromList Xs (MAP (CCS_SUBST (fromList Xs Ps)) Es)) C) + !Xs Ps Es E. + ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) /\ (LENGTH Es = LENGTH Xs) ==> + (CCS_SUBST (fromList Xs Ps) (CCS_SUBST (fromList Xs Es) E) = + CCS_SUBST (fromList Xs (MAP (CCS_SUBST (fromList Xs Ps)) Es)) E) Proof Suff (* rewriting for induction *) `!Xs Ps Es. ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) /\ (LENGTH Es = LENGTH Xs) ==> - !C. DISJOINT (BV C) (set Xs) ==> - (CCS_SUBST (fromList Xs Ps) - (CCS_SUBST (fromList Xs Es) C) = - CCS_SUBST (fromList Xs (MAP (CCS_SUBST (fromList Xs Ps)) Es)) C)` + !E. CCS_SUBST (fromList Xs Ps) + (CCS_SUBST (fromList Xs Es) E) = + CCS_SUBST (fromList Xs (MAP (CCS_SUBST (fromList Xs Ps)) Es)) E` >- METIS_TAC [] >> rpt GEN_TAC >> STRIP_TAC - >> Induct_on `C` (* 8 subgoals *) - >- RW_TAC std_ss [CCS_SUBST_nil] - >- (RW_TAC lset_ss [BV_def, CCS_SUBST_var, FDOM_fromList, LENGTH_MAP] \\ - fs [MEM_EL] >> rename1 `X = EL n Xs` \\ + >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> qabbrev_tac ‘fm2 = fromList Xs Ps’ + >> Q.EXISTS_TAC ‘set Xs UNION BIGUNION (IMAGE FV (set Es)) + UNION BIGUNION (IMAGE FV (set Ps)) + UNION BIGUNION (IMAGE (\e. FV (CCS_SUBST fm2 e)) (set Es))’ + >> rw [Abbr ‘fm2’, FDOM_fromList] (* 5 subgoals *) + >> TRY (rw [FINITE_FV]) (* 2 subgoals left *) + >- (fs [MEM_EL] >> rename1 `X = EL n Xs` \\ `LENGTH (MAP (CCS_SUBST (fromList Xs Ps)) Es) = LENGTH Xs` by PROVE_TAC [LENGTH_MAP] \\ ASM_SIMP_TAC std_ss [fromList_FAPPLY_EL, EL_MAP]) - >- RW_TAC std_ss [BV_def, CCS_SUBST_prefix] - >- (RW_TAC std_ss [BV_def, CCS_SUBST_sum] \\ - FIRST_X_ASSUM MATCH_MP_TAC >> ASM_SET_TAC []) - >- (RW_TAC std_ss [BV_def, CCS_SUBST_par] \\ - FIRST_X_ASSUM MATCH_MP_TAC >> ASM_SET_TAC []) - >- RW_TAC std_ss [BV_def, CCS_SUBST_restr] - >- RW_TAC std_ss [BV_def, CCS_SUBST_relab] - (* The last goal is hard *) - >> RW_TAC std_ss [BV_def] - >> `DISJOINT (BV C') (set Xs)` by ASM_SET_TAC [SUBSET_DISJOINT] - >> RES_TAC >> `LENGTH (MAP (CCS_SUBST (fromList Xs Ps)) Es) = LENGTH Xs` by PROVE_TAC [LENGTH_MAP] - >> RW_TAC list_ss [CCS_SUBST_rec, FDOM_fromList, LENGTH_MAP] - >> ASM_SET_TAC [] + (* stage work *) + >> qabbrev_tac ‘fm1 = fromList Xs Es’ + >> qabbrev_tac ‘fm2 = fromList Xs Ps’ + (* applying ssub_rec *) + >> Know ‘CCS_SUBST fm1 (rec y E) = rec y (CCS_SUBST fm1 E)’ + >- (MATCH_MP_TAC ssub_rec >> rw [Abbr ‘fm1’, FDOM_fromList] \\ + fs [MEM_EL] >> rename1 `X = EL n Xs` \\ + ASM_SIMP_TAC std_ss [fromList_FAPPLY_EL, EL_MAP] \\ + METIS_TAC []) + >> Rewr' + >> Know ‘CCS_SUBST fm2 (rec y (CCS_SUBST fm1 E)) = + rec y (CCS_SUBST fm2 (CCS_SUBST fm1 E))’ + >- (MATCH_MP_TAC ssub_rec >> rw [Abbr ‘fm2’, FDOM_fromList] \\ + fs [MEM_EL] >> rename1 `X = EL n Xs` \\ + ASM_SIMP_TAC std_ss [fromList_FAPPLY_EL, EL_MAP] \\ + METIS_TAC []) + >> Rewr' + >> qabbrev_tac ‘fm3 = fromList Xs (MAP (CCS_SUBST fm2) Es)’ + >> Know ‘CCS_SUBST fm3 (rec y E) = rec y (CCS_SUBST fm3 E)’ + >- (MATCH_MP_TAC ssub_rec >> rw [Abbr ‘fm3’, FDOM_fromList] \\ + FULL_SIMP_TAC std_ss [MEM_EL] >> rename1 `X = EL n Xs` \\ + ASM_SIMP_TAC std_ss [fromList_FAPPLY_EL, EL_MAP] \\ + (* NOTE: this is why we put + ‘BIGUNION (IMAGE (\e. FV (CCS_SUBST fm2 e)) (set Es))’ + into the exclusive set required by nc_INDUCTION2. *) + METIS_TAC []) + >> Rewr' + >> rw [rec_eq_thm] QED -val DISJOINT_SUBSET' = Q.prove ( - `!s t u. DISJOINT s t /\ u SUBSET s ==> DISJOINT u t`, SET_TAC []); - (* Now consider a (non-trivial) generalization of FV_SUBSET and BV_SUBSET: [FV_SUBSET] Theorem ⊢ !X E E'. FV (CCS_Subst E E' X) SUBSET FV E UNION FV E' - [BV_SUBSET] Theorem - ⊢ !X E E'. BV (CCS_Subst E E' X) SUBSET BV E UNION BV E' - If, instead of just substituting one (free) variable of E, we substitute more of them, can we say that: [FV_SUBSET_BIGUNION] |- !Xs Ps E. FV (CCS_SUBST (Xs |-> Ps) E) SUBSET (FV E) UNION BIGUNION (IMAGE FV (set Ps))` - - and - - [BV_SUBSET_BIGUNION] - |- !Xs Ps E. BV (CCS_SUBST (Xs |-> Ps) E) SUBSET - (BV E) UNION BIGUNION (IMAGE BV (set Ps))` hold? *) (* `ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs)` is not really necessary but makes the proof (much) easier. - - `DISJOINT (BV E) (set Xs)` (usually comes from `context Xs E` - or `weakly_guarded Xs E`) is also not necessary but makes the - proof even more easier. *) -Theorem BV_SUBSET_BIGUNION : - !Xs Ps E. ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) /\ - DISJOINT (BV E) (set Xs) ==> - BV (CCS_SUBST (fromList Xs Ps) E) SUBSET - (BV E) UNION BIGUNION (IMAGE BV (set Ps)) -Proof - NTAC 2 GEN_TAC - >> Induct_on `E` - >> RW_TAC lset_ss [CCS_SUBST_def, BV_def, FDOM_fromList] (* 6 subgoals *) - >- (fs [MEM_EL, fromList_FAPPLY_EL] \\ - `MEM (EL n Ps) Ps` by PROVE_TAC [MEM_EL] >> ASM_SET_TAC []) - (* 5 subgoals left ... *) - >> ASM_SET_TAC [] -QED - Theorem FV_SUBSET_BIGUNION : - !Xs Ps E. ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) /\ - DISJOINT (BV E) (set Xs) ==> + !Xs Ps E. ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) ==> FV (CCS_SUBST (fromList Xs Ps) E) SUBSET (FV E) UNION BIGUNION (IMAGE FV (set Ps)) Proof NTAC 2 GEN_TAC - >> Induct_on `E` - >> RW_TAC lset_ss [CCS_SUBST_def, FV_def, BV_def, FDOM_fromList] (* 6 subgoals *) + >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> Q.EXISTS_TAC ‘set Xs UNION BIGUNION (IMAGE FV (set Ps))’ + >> rw [FDOM_fromList, ssub_thm] (* 7 subgoals *) >- (fs [MEM_EL, fromList_FAPPLY_EL] \\ `MEM (EL n Ps) Ps` by PROVE_TAC [MEM_EL] >> ASM_SET_TAC []) - (* 5 subgoals left ... *) - >> ASM_SET_TAC [] + >> TRY (rw [FINITE_FV] >> ASM_SET_TAC []) + >> qabbrev_tac ‘fm = fromList Xs Ps’ + >> Know ‘CCS_SUBST fm (rec y E) = rec y (CCS_SUBST fm E)’ + >- (MATCH_MP_TAC ssub_rec \\ + rw [Abbr ‘fm’, FDOM_fromList] \\ + fs [MEM_EL, fromList_FAPPLY_EL] \\ + METIS_TAC []) + >> Rewr' + >> fs [FV_rec] + >> qabbrev_tac ‘A = CCS_SUBST fm E’ + >> qabbrev_tac ‘B = BIGUNION (IMAGE FV (set Ps))’ + >> Q.PAT_X_ASSUM ‘FV A SUBSET FV E UNION B’ MP_TAC + >> SET_TAC [] QED (* A more precise estimation with `set Xs` *) Theorem FV_SUBSET_BIGUNION_PRO : - !Xs Ps E. ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) /\ - DISJOINT (BV E) (set Xs) ==> + !Xs Ps E. ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) ==> FV (CCS_SUBST (fromList Xs Ps) E) SUBSET ((FV E) DIFF (set Xs)) UNION BIGUNION (IMAGE FV (set Ps)) Proof NTAC 2 GEN_TAC - >> Induct_on `E` - >> RW_TAC lset_ss [CCS_SUBST_def, FV_def, BV_def, FDOM_fromList] (* 6 subgoals *) + >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> Q.EXISTS_TAC ‘set Xs UNION BIGUNION (IMAGE FV (set Ps))’ + >> rw [FDOM_fromList, ssub_thm] (* 7 subgoals *) >- (fs [MEM_EL, fromList_FAPPLY_EL] \\ - `MEM (EL n Ps) Ps` by PROVE_TAC [MEM_EL] \\ - ASM_SET_TAC []) - (* 5 subgoals left ... *) - >- (Q.PAT_X_ASSUM `_ ==> _ SUBSET _` MP_TAC >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM `_ ==> _ SUBSET _` MP_TAC >> RW_TAC bool_ss [] \\ - MATCH_MP_TAC SUBSET_TRANS \\ - Q.EXISTS_TAC - `FV E DIFF set Xs UNION BIGUNION (IMAGE FV (set Ps))` >> art [] \\ - SET_TAC []) - >- (Q.PAT_X_ASSUM `_ ==> _ SUBSET _` MP_TAC >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM `_ ==> _ SUBSET _` MP_TAC >> RW_TAC bool_ss [] \\ - MATCH_MP_TAC SUBSET_TRANS \\ - Q.EXISTS_TAC - `FV E' DIFF set Xs UNION BIGUNION (IMAGE FV (set Ps))` >> art [] \\ - SET_TAC []) - >- (Q.PAT_X_ASSUM `_ ==> _ SUBSET _` MP_TAC >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM `_ ==> _ SUBSET _` MP_TAC >> RW_TAC bool_ss [] \\ - MATCH_MP_TAC SUBSET_TRANS \\ - Q.EXISTS_TAC - `FV E DIFF set Xs UNION BIGUNION (IMAGE FV (set Ps))` >> art [] \\ - SET_TAC []) - >- (Q.PAT_X_ASSUM `_ ==> _ SUBSET _` MP_TAC >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM `_ ==> _ SUBSET _` MP_TAC >> RW_TAC bool_ss [] \\ - MATCH_MP_TAC SUBSET_TRANS \\ - Q.EXISTS_TAC - `FV E' DIFF set Xs UNION BIGUNION (IMAGE FV (set Ps))` >> art [] \\ - SET_TAC []) - >> Q.PAT_X_ASSUM `_ ==> _ SUBSET _` MP_TAC >> RW_TAC bool_ss [] - >> ASM_SET_TAC [] (* ?! *) + `MEM (EL n Ps) Ps` by PROVE_TAC [MEM_EL] >> ASM_SET_TAC []) + >> TRY (rw [FINITE_FV] >> ASM_SET_TAC []) + >> qabbrev_tac ‘fm = fromList Xs Ps’ + >> Know ‘CCS_SUBST fm (rec y E) = rec y (CCS_SUBST fm E)’ + >- (MATCH_MP_TAC ssub_rec \\ + rw [Abbr ‘fm’, FDOM_fromList] \\ + fs [MEM_EL, fromList_FAPPLY_EL] \\ + METIS_TAC []) >> Rewr' + >> fs [FV_rec] + >> qabbrev_tac ‘A = CCS_SUBST fm E’ + >> qabbrev_tac ‘B = BIGUNION (IMAGE FV (set Ps))’ + >> Q.PAT_X_ASSUM ‘FV A SUBSET FV E DIFF set Xs UNION B’ MP_TAC + >> SET_TAC [] QED (* KEY result *) Theorem CCS_SUBST_IS_PROC : !Xs Ps E. ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) /\ - ALL_PROC Ps /\ FV E SUBSET (set Xs) /\ - DISJOINT (BV E) (set Xs) ==> + ALL_PROC Ps /\ FV E SUBSET (set Xs) ==> IS_PROC (CCS_SUBST (fromList Xs Ps) E) Proof RW_TAC lset_ss [IS_PROC_def, ALL_PROC_def, EVERY_MEM] @@ -657,30 +591,13 @@ QED `LENGTH Ps = LENGTH Xs` is due to the limitation of "MAP_ZIP" *) Theorem CCS_SUBST_PROC : - !Xs Ps P. (LENGTH Ps = LENGTH Xs) /\ DISJOINT (BV P) (set Xs) /\ - IS_PROC P ==> (CCS_SUBST (fromList Xs Ps) P = P) + !Xs Ps P. LENGTH Ps = LENGTH Xs /\ IS_PROC P ==> + CCS_SUBST (fromList Xs Ps) P = P Proof RW_TAC std_ss [IS_PROC_def] >> MATCH_MP_TAC CCS_SUBST_elim >> art [DISJOINT_EMPTY] QED -Theorem DISJOINT_BV_CCS_SUBST : - !Xs Ps E. ALL_DISTINCT Xs /\ (LENGTH Ps = LENGTH Xs) /\ - EVERY (\e. DISJOINT (BV e) (set Xs)) Ps /\ - DISJOINT (BV E) (set Xs) ==> - DISJOINT (BV (CCS_SUBST (fromList Xs Ps) E)) (set Xs) -Proof - rpt STRIP_TAC - >> MP_TAC (Q.SPECL [`Xs`, `Ps`, `E`] BV_SUBSET_BIGUNION) - >> RW_TAC std_ss [] - >> MATCH_MP_TAC DISJOINT_SUBSET' - >> Q.EXISTS_TAC `(BV E) UNION (BIGUNION (IMAGE BV (set Ps)))` - >> POP_ASSUM (REWRITE_TAC o wrap) - >> art [DISJOINT_UNION] - >> RW_TAC lset_ss [DISJOINT_BIGUNION] - >> fs [EVERY_MEM] -QED - (* ========================================================================== *) (* Section II: Multivariate CCS contexts *) (* ========================================================================== *) @@ -692,14 +609,14 @@ End Theorem context_nil : !Xs. context Xs nil Proof - RW_TAC std_ss [context_def, EVERY_MEM, BV_def, CCS_Subst_def, + RW_TAC std_ss [context_def, EVERY_MEM, CCS_Subst_def, DISJOINT_EMPTY, CONTEXT2] QED Theorem context_prefix : !Xs u E. context Xs (prefix u E) ==> context Xs E Proof - RW_TAC std_ss [context_def, EVERY_MEM, BV_def] + RW_TAC std_ss [context_def, EVERY_MEM] >> RES_TAC >> fs [CCS_Subst_def] >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `CONTEXT (\t. prefix u (e t))` @@ -710,7 +627,7 @@ QED Theorem context_prefix_rule : !Xs u E. context Xs E ==> context Xs (prefix u E) Proof - RW_TAC std_ss [context_def, EVERY_MEM, BV_def] + RW_TAC std_ss [context_def, EVERY_MEM] >> RES_TAC >> fs [CCS_Subst_def] >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `CONTEXT (\t. prefix u (e t))` @@ -727,29 +644,23 @@ Proof >> MATCH_MP_TAC context_prefix_rule >> art [] QED -local - val t1 = - (MATCH_MP_TAC SUBSET_DISJOINT \\ - take [`BV (E1 + E2)`, `set Xs`] >> art [BV_SUBSET_rules, SUBSET_REFL]); - val t2 = - (RES_TAC >> fs [CCS_Subst_def] \\ +Theorem context_sum : + !Xs E1 E2. context Xs (sum E1 E2) ==> context Xs E1 /\ context Xs E2 +Proof + RW_TAC std_ss [context_def, EVERY_MEM] (* 2 subgoals, same tactics *) + >> ( RES_TAC >> fs [CCS_Subst_def] \\ Q.ABBREV_TAC `e1 = \t. CCS_Subst E1 t X` \\ Q.ABBREV_TAC `e2 = \t. CCS_Subst E2 t X` \\ Know `CONTEXT (\t. e1 t + e2 t)` >- (Q.UNABBREV_TAC `e1` >> Q.UNABBREV_TAC `e2` \\ ASM_SIMP_TAC bool_ss []) \\ - DISCH_TAC >> IMP_RES_TAC CONTEXT4_backward); -in - val context_sum = store_thm - ("context_sum", - ``!Xs E1 E2. context Xs (sum E1 E2) ==> context Xs E1 /\ context Xs E2``, - RW_TAC std_ss [context_def, EVERY_MEM] >> t2); -end; + DISCH_TAC >> IMP_RES_TAC CONTEXT4_backward ) +QED Theorem context_sum_rule : !Xs E1 E2. context Xs E1 /\ context Xs E2 ==> context Xs (sum E1 E2) Proof - RW_TAC std_ss [context_def, EVERY_MEM, BV_def, CCS_Subst_def] + RW_TAC std_ss [context_def, EVERY_MEM, CCS_Subst_def] >> TRY (ASM_SET_TAC []) >> RES_TAC >> Q.ABBREV_TAC `e1 = \t. CCS_Subst E1 t X` @@ -773,29 +684,23 @@ Proof >> MATCH_MP_TAC context_sum_rule >> art [] QED -local - val t1 = - (MATCH_MP_TAC SUBSET_DISJOINT \\ - take [`BV (E1 || E2)`, `set Xs`] >> art [BV_SUBSET_rules, SUBSET_REFL]); - val t2 = - (RES_TAC >> fs [CCS_Subst_def] \\ +Theorem context_par : + !Xs E1 E2. context Xs (par E1 E2) ==> context Xs E1 /\ context Xs E2 +Proof + RW_TAC std_ss [context_def, EVERY_MEM] + >> ( RES_TAC >> fs [CCS_Subst_def] \\ Q.ABBREV_TAC `e1 = \t. CCS_Subst E1 t X` \\ Q.ABBREV_TAC `e2 = \t. CCS_Subst E2 t X` \\ Know `CONTEXT (\t. e1 t || e2 t)` >- (Q.UNABBREV_TAC `e1` >> Q.UNABBREV_TAC `e2` \\ ASM_SIMP_TAC bool_ss []) \\ - DISCH_TAC >> IMP_RES_TAC CONTEXT5_backward); -in - val context_par = store_thm - ("context_par", - ``!Xs E1 E2. context Xs (par E1 E2) ==> context Xs E1 /\ context Xs E2``, - RW_TAC std_ss [context_def, EVERY_MEM] >> t2); -end; + DISCH_TAC >> IMP_RES_TAC CONTEXT5_backward ) +QED Theorem context_par_rule : !Xs E1 E2. context Xs E1 /\ context Xs E2 ==> context Xs (par E1 E2) Proof - RW_TAC std_ss [context_def, EVERY_MEM, BV_def, CCS_Subst_def] + RW_TAC std_ss [context_def, EVERY_MEM, CCS_Subst_def] >> TRY (ASM_SET_TAC []) >> RES_TAC >> Q.ABBREV_TAC `e1 = \t. CCS_Subst E1 t X` @@ -822,7 +727,7 @@ QED Theorem context_restr : !Xs L E. context Xs (restr L E) ==> context Xs E Proof - RW_TAC std_ss [context_def, EVERY_MEM, BV_def] + RW_TAC std_ss [context_def, EVERY_MEM] >> RES_TAC >> fs [CCS_Subst_def] >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `CONTEXT (\t. restr L (e t))` @@ -833,7 +738,7 @@ QED Theorem context_restr_rule : !Xs L E. context Xs E ==> context Xs (restr L E) Proof - RW_TAC std_ss [context_def, EVERY_MEM, BV_def, CCS_Subst_def] + RW_TAC std_ss [context_def, EVERY_MEM, CCS_Subst_def] >> RES_TAC >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `CONTEXT (\t. e t)` @@ -856,7 +761,7 @@ QED Theorem context_relab : !Xs E rf. context Xs (relab E rf) ==> context Xs E Proof - RW_TAC std_ss [context_def, EVERY_MEM, BV_def] + RW_TAC std_ss [context_def, EVERY_MEM] >> RES_TAC >> fs [CCS_Subst_def] >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `CONTEXT (\t. relab (e t) rf)` @@ -867,7 +772,7 @@ QED Theorem context_relab_rule : !Xs E rf. context Xs E ==> context Xs (relab E rf) Proof - RW_TAC std_ss [context_def, EVERY_MEM, BV_def, CCS_Subst_def] + RW_TAC std_ss [context_def, EVERY_MEM, CCS_Subst_def] >> RES_TAC >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `CONTEXT (\t. e t)` @@ -890,7 +795,7 @@ QED Theorem context_var : !Xs Y. context Xs (var Y) Proof - RW_TAC lset_ss [context_def, EVERY_MEM, BV_def, CCS_Subst_def] + RW_TAC lset_ss [context_def, EVERY_MEM, CCS_Subst_def] >> Cases_on `Y = X` >> fs [CONTEXT_rules] QED @@ -900,16 +805,18 @@ Proof rpt GEN_TAC >> DISCH_TAC >> fs [context_def, EVERY_MEM] >> CCONTR_TAC >> fs [IN_DISJOINT] - >> RES_TAC - >> `Y <> x` by PROVE_TAC [] - >> fs [CCS_Subst_def] - >> Q.ABBREV_TAC `e = \t. CCS_Subst E t x` - >> Know `CONTEXT (\t. rec Y (e t))` >- (Q.UNABBREV_TAC `e` >> fs []) - >> Q.PAT_X_ASSUM `CONTEXT (\t. P)` K_TAC (* cleanup *) - >> DISCH_TAC - >> IMP_RES_TAC CONTEXT8_IMP_CONST - >> Q.UNABBREV_TAC `e` >> fs [IS_CONST_def] - >> POP_ASSUM (STRIP_ASSUME_TAC o (MATCH_MP CCS_Subst_IMP_NOTIN_FV)) + >> rename1 ‘X <> Y’ + >> `Y <> X` by PROVE_TAC [] + >> Q.PAT_X_ASSUM ‘!X. MEM X Xs ==> P’ (MP_TAC o (Q.SPEC ‘X’)) + >> RW_TAC std_ss [] + >> rw [Once CONTEXT_cases, FUN_EQ_THM] + (* 7 subgoals *) + >- (Q.EXISTS_TAC ‘var X’ >> rw []) + >- (CCONTR_TAC >> fs [] \\ + Know ‘X # rec Y E’ + >- (MATCH_MP_TAC CCS_Subst_EQ_IMP_NOTIN_FV >> rw []) \\ + rw [FV_thm]) + >> DISJ1_TAC >> Q.EXISTS_TAC ‘var X’ >> rw [] QED (* a collection of all (forward) rules of `context` *) @@ -934,66 +841,66 @@ Theorem STRONG_EQUIV_subst_context : (CCS_SUBST (fromList Xs Qs) E) Proof rpt GEN_TAC >> STRIP_TAC - >> Induct_on `E` >> RW_TAC lset_ss [CCS_SUBST_def] (* 14 subgoals *) - >- REWRITE_TAC [STRONG_EQUIV_REFL] + >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> Q.EXISTS_TAC ‘set Xs UNION (BIGUNION (IMAGE FV (set Ps))) + UNION (BIGUNION (IMAGE FV (set Qs)))’ + >> rw [ssub_thm, STRONG_EQUIV_REFL] >> rw [FINITE_FV] + (* 9 subgoals left *) >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ fs [FDOM_fromList, MEM_EL, LIST_REL_EL_EQN] \\ rw [fromList_FAPPLY_EL]) - (* impossible case *) + (* 8 subgoals left *) >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ METIS_TAC [FDOM_fromList]) - (* impossible case *) + (* 7 subgoals left *) >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ METIS_TAC [FDOM_fromList]) - (* 10 cases left *) - >- REWRITE_TAC [STRONG_EQUIV_REFL] - (* 9 cases left *) + (* 6 subgoals left *) >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PREFIX \\ FIRST_X_ASSUM MATCH_MP_TAC \\ IMP_RES_TAC context_prefix) - (* 8 cases left *) + (* 5 subgoals left *) >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_SUM \\ IMP_RES_TAC context_sum \\ RES_TAC >> art []) - (* 7 cases left *) + (* 4 subgoals left *) >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR \\ IMP_RES_TAC context_par \\ RES_TAC >> art []) - (* 6 cases left *) + (* 3 subgoals left *) >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_RESTR \\ FIRST_X_ASSUM MATCH_MP_TAC \\ IMP_RES_TAC context_restr) - (* 5 cases left *) + (* 2 subgoals left *) >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_RELAB \\ FIRST_X_ASSUM MATCH_MP_TAC \\ IMP_RES_TAC context_relab) - (* 4 cases left *) - >- (IMP_RES_TAC context_rec \\ - `LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - Know `CCS_SUBST ((fromList Xs Ps) \\ a) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - ASM_SIMP_TAC std_ss [FDOM_DOMSUB, FDOM_fromList] \\ - ASM_SET_TAC []) >> Rewr' \\ - Know `CCS_SUBST ((fromList Xs Qs) \\ a) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - ASM_SIMP_TAC std_ss [FDOM_DOMSUB, FDOM_fromList] \\ - ASM_SET_TAC []) >> Rewr' \\ - REWRITE_TAC [STRONG_EQUIV_REFL]) - (* 3 cases left *) - >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - METIS_TAC [FDOM_fromList]) - (* 2 cases left *) - >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - METIS_TAC [FDOM_fromList]) - >> (IMP_RES_TAC context_rec \\ - `LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - Know `CCS_SUBST (fromList Xs Ps) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - fs [FDOM_fromList] >> ASM_SET_TAC []) >> Rewr' \\ - Know `CCS_SUBST (fromList Xs Qs) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - fs [FDOM_fromList] >> ASM_SET_TAC []) >> Rewr' \\ - REWRITE_TAC [STRONG_EQUIV_REFL]) + (* 1 subgoal left *) + >> IMP_RES_TAC context_rec + >> `LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] + (* applying ssub_rec *) + >> qabbrev_tac ‘fm = fromList Xs Ps’ + >> Know ‘CCS_SUBST fm (rec y E) = rec y (CCS_SUBST fm E)’ + >- (MATCH_MP_TAC ssub_rec \\ + rw [Abbr ‘fm’, FDOM_fromList] \\ + fs [MEM_EL, fromList_FAPPLY_EL] >> METIS_TAC []) + >> Rewr' + >> qabbrev_tac ‘fm' = fromList Xs Qs’ + >> Know ‘CCS_SUBST fm' (rec y E) = rec y (CCS_SUBST fm' E)’ + >- (MATCH_MP_TAC ssub_rec \\ + rw [Abbr ‘fm'’, FDOM_fromList] \\ + fs [MEM_EL, fromList_FAPPLY_EL] >> METIS_TAC []) + >> Rewr' + >> qunabbrevl_tac [‘fm’, ‘fm'’] + >> Know `CCS_SUBST (fromList Xs Ps) E = E` + >- (MATCH_MP_TAC CCS_SUBST_elim' \\ + fs [FDOM_fromList] >> ASM_SET_TAC []) + >> Rewr' + >> Know `CCS_SUBST (fromList Xs Qs) E = E` + >- (MATCH_MP_TAC CCS_SUBST_elim' \\ + fs [FDOM_fromList] >> ASM_SET_TAC []) + >> Rewr' + >> REWRITE_TAC [STRONG_EQUIV_REFL] QED (* c.f. OBS_CONGR_SUBST_CONTEXT *) @@ -1005,66 +912,66 @@ Theorem OBS_CONGR_subst_context : (CCS_SUBST (fromList Xs Qs) E) Proof rpt GEN_TAC >> STRIP_TAC - >> Induct_on `E` >> RW_TAC lset_ss [CCS_SUBST_def] (* 14 subgoals *) - >- REWRITE_TAC [OBS_CONGR_REFL] + >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> Q.EXISTS_TAC ‘set Xs UNION (BIGUNION (IMAGE FV (set Ps))) + UNION (BIGUNION (IMAGE FV (set Qs)))’ + >> rw [ssub_thm, OBS_CONGR_REFL] >> rw [FINITE_FV] + (* 9 subgoals left *) >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ fs [FDOM_fromList, MEM_EL, LIST_REL_EL_EQN] \\ rw [fromList_FAPPLY_EL]) - (* impossible case *) + (* 8 subgoals left *) >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ METIS_TAC [FDOM_fromList]) - (* impossible case *) + (* 7 subgoals left *) >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ METIS_TAC [FDOM_fromList]) - (* 10 cases left *) - >- REWRITE_TAC [OBS_CONGR_REFL] - (* 9 cases left *) + (* 6 subgoals left *) >- (MATCH_MP_TAC OBS_CONGR_SUBST_PREFIX \\ FIRST_X_ASSUM MATCH_MP_TAC \\ IMP_RES_TAC context_prefix) - (* 8 cases left *) + (* 5 subgoals left *) >- (MATCH_MP_TAC OBS_CONGR_PRESD_BY_SUM \\ IMP_RES_TAC context_sum \\ RES_TAC >> art []) - (* 7 cases left *) + (* 4 subgoals left *) >- (MATCH_MP_TAC OBS_CONGR_PRESD_BY_PAR \\ IMP_RES_TAC context_par \\ RES_TAC >> art []) - (* 6 cases left *) + (* 3 subgoals left *) >- (MATCH_MP_TAC OBS_CONGR_SUBST_RESTR \\ FIRST_X_ASSUM MATCH_MP_TAC \\ IMP_RES_TAC context_restr) - (* 5 cases left *) + (* 2 subgoals left *) >- (MATCH_MP_TAC OBS_CONGR_SUBST_RELAB \\ FIRST_X_ASSUM MATCH_MP_TAC \\ IMP_RES_TAC context_relab) - (* 4 cases left *) - >- (IMP_RES_TAC context_rec \\ - `LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - Know `CCS_SUBST ((fromList Xs Ps) \\ a) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - ASM_SIMP_TAC std_ss [FDOM_DOMSUB, FDOM_fromList] \\ - ASM_SET_TAC []) >> Rewr' \\ - Know `CCS_SUBST ((fromList Xs Qs) \\ a) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - ASM_SIMP_TAC std_ss [FDOM_DOMSUB, FDOM_fromList] \\ - ASM_SET_TAC []) >> Rewr' \\ - REWRITE_TAC [OBS_CONGR_REFL]) - (* 3 cases left *) - >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - METIS_TAC [FDOM_fromList]) - (* 2 cases left *) - >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - METIS_TAC [FDOM_fromList]) - >> (IMP_RES_TAC context_rec \\ - `LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - Know `CCS_SUBST (fromList Xs Ps) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - fs [FDOM_fromList] >> ASM_SET_TAC []) >> Rewr' \\ - Know `CCS_SUBST (fromList Xs Qs) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - fs [FDOM_fromList] >> ASM_SET_TAC []) >> Rewr' \\ - REWRITE_TAC [OBS_CONGR_REFL]) + (* 1 subgoal left *) + >> IMP_RES_TAC context_rec + >> `LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] + (* applying ssub_rec *) + >> qabbrev_tac ‘fm = fromList Xs Ps’ + >> Know ‘CCS_SUBST fm (rec y E) = rec y (CCS_SUBST fm E)’ + >- (MATCH_MP_TAC ssub_rec \\ + rw [Abbr ‘fm’, FDOM_fromList] \\ + fs [MEM_EL, fromList_FAPPLY_EL] >> METIS_TAC []) + >> Rewr' + >> qabbrev_tac ‘fm' = fromList Xs Qs’ + >> Know ‘CCS_SUBST fm' (rec y E) = rec y (CCS_SUBST fm' E)’ + >- (MATCH_MP_TAC ssub_rec \\ + rw [Abbr ‘fm'’, FDOM_fromList] \\ + fs [MEM_EL, fromList_FAPPLY_EL] >> METIS_TAC []) + >> Rewr' + >> qunabbrevl_tac [‘fm’, ‘fm'’] + >> Know `CCS_SUBST (fromList Xs Ps) E = E` + >- (MATCH_MP_TAC CCS_SUBST_elim' \\ + fs [FDOM_fromList] >> ASM_SET_TAC []) + >> Rewr' + >> Know `CCS_SUBST (fromList Xs Qs) E = E` + >- (MATCH_MP_TAC CCS_SUBST_elim' \\ + fs [FDOM_fromList] >> ASM_SET_TAC []) + >> Rewr' + >> REWRITE_TAC [OBS_CONGR_REFL] QED (* c.f. OBS_contracts_SUBST_CONTEXT *) @@ -1076,66 +983,66 @@ Theorem OBS_contracts_subst_context : (CCS_SUBST (fromList Xs Qs) E) Proof rpt GEN_TAC >> STRIP_TAC - >> Induct_on `E` >> RW_TAC lset_ss [CCS_SUBST_def] (* 14 subgoals *) - >- REWRITE_TAC [OBS_contracts_REFL] + >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> Q.EXISTS_TAC ‘set Xs UNION (BIGUNION (IMAGE FV (set Ps))) + UNION (BIGUNION (IMAGE FV (set Qs)))’ + >> rw [ssub_thm, OBS_contracts_REFL] >> rw [FINITE_FV] + (* 9 subgoals left *) >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ fs [FDOM_fromList, MEM_EL, LIST_REL_EL_EQN] \\ rw [fromList_FAPPLY_EL]) - (* impossible case *) + (* 8 subgoals left *) >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ METIS_TAC [FDOM_fromList]) - (* impossible case *) + (* 7 subgoals left *) >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ METIS_TAC [FDOM_fromList]) - (* 10 cases left *) - >- REWRITE_TAC [OBS_contracts_REFL] - (* 9 cases left *) + (* 6 subgoals left *) >- (MATCH_MP_TAC OBS_contracts_SUBST_PREFIX \\ FIRST_X_ASSUM MATCH_MP_TAC \\ IMP_RES_TAC context_prefix) - (* 8 cases left *) + (* 5 subgoals left *) >- (MATCH_MP_TAC OBS_contracts_PRESD_BY_SUM \\ IMP_RES_TAC context_sum \\ RES_TAC >> art []) - (* 7 cases left *) + (* 4 subgoals left *) >- (MATCH_MP_TAC OBS_contracts_PRESD_BY_PAR \\ IMP_RES_TAC context_par \\ RES_TAC >> art []) - (* 6 cases left *) + (* 3 subgoals left *) >- (MATCH_MP_TAC OBS_contracts_SUBST_RESTR \\ FIRST_X_ASSUM MATCH_MP_TAC \\ IMP_RES_TAC context_restr) - (* 5 cases left *) + (* 2 subgoals left *) >- (MATCH_MP_TAC OBS_contracts_SUBST_RELAB \\ FIRST_X_ASSUM MATCH_MP_TAC \\ IMP_RES_TAC context_relab) - (* 4 cases left *) - >- (IMP_RES_TAC context_rec \\ - Know `CCS_SUBST ((fromList Xs Ps) \\ a) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - ASM_SIMP_TAC std_ss [FDOM_DOMSUB, FDOM_fromList] \\ - ASM_SET_TAC []) >> Rewr' \\ - Know `CCS_SUBST ((fromList Xs Qs) \\ a) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - `LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - ASM_SIMP_TAC std_ss [FDOM_DOMSUB, FDOM_fromList] \\ - ASM_SET_TAC []) >> Rewr' \\ - REWRITE_TAC [OBS_contracts_REFL]) - (* 3 cases left *) - >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - METIS_TAC [FDOM_fromList]) - (* 2 cases left *) - >- (`LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - METIS_TAC [FDOM_fromList]) - >> (IMP_RES_TAC context_rec \\ - `LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] \\ - Know `CCS_SUBST (fromList Xs Ps) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - fs [FDOM_fromList] >> ASM_SET_TAC []) >> Rewr' \\ - Know `CCS_SUBST (fromList Xs Qs) E = E` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - fs [FDOM_fromList] >> ASM_SET_TAC []) >> Rewr' \\ - REWRITE_TAC [OBS_contracts_REFL]) + (* 1 subgoal left *) + >> IMP_RES_TAC context_rec + >> `LENGTH Qs = LENGTH Xs` by METIS_TAC [LIST_REL_LENGTH] + (* applying ssub_rec *) + >> qabbrev_tac ‘fm = fromList Xs Ps’ + >> Know ‘CCS_SUBST fm (rec y E) = rec y (CCS_SUBST fm E)’ + >- (MATCH_MP_TAC ssub_rec \\ + rw [Abbr ‘fm’, FDOM_fromList] \\ + fs [MEM_EL, fromList_FAPPLY_EL] >> METIS_TAC []) + >> Rewr' + >> qabbrev_tac ‘fm' = fromList Xs Qs’ + >> Know ‘CCS_SUBST fm' (rec y E) = rec y (CCS_SUBST fm' E)’ + >- (MATCH_MP_TAC ssub_rec \\ + rw [Abbr ‘fm'’, FDOM_fromList] \\ + fs [MEM_EL, fromList_FAPPLY_EL] >> METIS_TAC []) + >> Rewr' + >> qunabbrevl_tac [‘fm’, ‘fm'’] + >> Know `CCS_SUBST (fromList Xs Ps) E = E` + >- (MATCH_MP_TAC CCS_SUBST_elim' \\ + fs [FDOM_fromList] >> ASM_SET_TAC []) + >> Rewr' + >> Know `CCS_SUBST (fromList Xs Qs) E = E` + >- (MATCH_MP_TAC CCS_SUBST_elim' \\ + fs [FDOM_fromList] >> ASM_SET_TAC []) + >> Rewr' + >> REWRITE_TAC [OBS_contracts_REFL] QED (* KEY result: multivariate version of CongruenceTheory.CONTEXT_combin *) @@ -1149,55 +1056,51 @@ Proof EVERY (context Xs) Es /\ (LENGTH Es = LENGTH Xs) ==> context Xs (CCS_SUBST (fromList Xs Es) C)` >- METIS_TAC [] >> NTAC 3 STRIP_TAC - >> Induct_on `C` >> RW_TAC std_ss [CCS_SUBST_def] (* 8 subgoals *) - (* goal 1 (of 8): not easy *) - >- (Know `FDOM (fromList Xs Es) = set Xs` - >- (MATCH_MP_TAC FDOM_fromList >> art []) >> DISCH_THEN (fs o wrap) \\ - fs [EVERY_MEM, MEM_EL] \\ - Know `(fromList Xs Es) ' (EL n Xs) = EL n Es` - >- (MATCH_MP_TAC fromList_FAPPLY_EL >> art []) >> Rewr' \\ + >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> Q.EXISTS_TAC ‘set Xs UNION (BIGUNION (IMAGE FV (set Es)))’ + >> rw [ssub_thm] >> rw [FINITE_FV] + (* 7 subgoals left *) + >- (fs [FDOM_fromList, EVERY_MEM, MEM_EL] \\ + fs [fromList_FAPPLY_EL] \\ FIRST_X_ASSUM MATCH_MP_TAC \\ Q.EXISTS_TAC `n` >> art []) - (* goal 2 (of 8): easy *) + (* 6 subgoals left *) >- (Q.PAT_X_ASSUM `context Xs C' ==> _` MP_TAC >> RW_TAC std_ss [] \\ IMP_RES_TAC context_prefix >> RES_TAC \\ MATCH_MP_TAC context_prefix_rule >> art []) - (* goal 3 (of 8): easy *) + (* 5 subgoals *) >- (IMP_RES_TAC context_sum \\ Q.PAT_X_ASSUM `context Xs C'' ==> _` MP_TAC \\ Q.PAT_X_ASSUM `context Xs C' ==> _` MP_TAC >> RW_TAC std_ss [] \\ MATCH_MP_TAC context_sum_rule >> art []) - (* goal 4 (of 8): easy *) + (* 4 subgoals *) >- (IMP_RES_TAC context_par \\ Q.PAT_X_ASSUM `context Xs C'' ==> _` MP_TAC \\ Q.PAT_X_ASSUM `context Xs C' ==> _` MP_TAC >> RW_TAC std_ss [] \\ MATCH_MP_TAC context_par_rule >> art []) - (* goal 5 (of 8): easy *) + (* 3 subgoals *) >- (IMP_RES_TAC context_restr \\ Q.PAT_X_ASSUM `context Xs C' ==> _` MP_TAC >> RW_TAC std_ss [] \\ MATCH_MP_TAC context_restr_rule >> art []) - (* goal 6 (of 8): easy *) + (* 2 subgoals *) >- (IMP_RES_TAC context_relab \\ Q.PAT_X_ASSUM `context Xs C' ==> _` MP_TAC >> RW_TAC std_ss [] \\ MATCH_MP_TAC context_relab_rule >> art []) - (* goal 7 (of 8): hard *) - >- (Know `FDOM (fromList Xs Es) = set Xs` - >- (MATCH_MP_TAC FDOM_fromList >> art []) >> DISCH_THEN (fs o wrap) \\ - IMP_RES_TAC context_rec \\ - rename1 `MEM X Xs` \\ - Suff `CCS_SUBST ((fromList Xs Es) \\ X) C' = C'` >- fs [] \\ - MATCH_MP_TAC CCS_SUBST_elim' \\ - ASM_SIMP_TAC std_ss [FDOM_DOMSUB, FDOM_fromList] \\ - ASM_SET_TAC []) - (* goal 8 (of 8): not hard *) - >> Know `FDOM (fromList Xs Es) = set Xs` - >- (MATCH_MP_TAC FDOM_fromList >> art []) >> DISCH_THEN (fs o wrap) - >> rename1 `~MEM Y Xs` + (* 1 subgoal *) + >> rename1 ‘context Xs (rec Y E)’ >> IMP_RES_TAC context_rec - >> Suff `CCS_SUBST (fromList Xs Es) C' = C'` >- fs [] + (* applying ssub_rec *) + >> qabbrev_tac ‘fm = fromList Xs Es’ + >> Know ‘CCS_SUBST fm (rec Y E) = rec Y (CCS_SUBST fm E)’ + >- (MATCH_MP_TAC ssub_rec \\ + rw [Abbr ‘fm’, FDOM_fromList] \\ + fs [MEM_EL, fromList_FAPPLY_EL] >> METIS_TAC []) + >> Rewr' + >> gs [] + >> qunabbrev_tac ‘fm’ + >> Suff `CCS_SUBST (fromList Xs Es) E = E` >- rw [] >> MATCH_MP_TAC CCS_SUBST_elim' - >> ASM_SIMP_TAC std_ss [FDOM_DOMSUB, FDOM_fromList] - >> ASM_SET_TAC [] + >> fs [FDOM_fromList] >> ASM_SET_TAC [] QED Theorem LIST_REL_equivalence : (* unused *) @@ -1247,14 +1150,14 @@ QED Theorem weakly_guarded_nil : !Xs. weakly_guarded Xs nil Proof - RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, BV_def, CCS_Subst_def, + RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, CCS_Subst_def, DISJOINT_EMPTY, WG2] QED Theorem weakly_guarded_prefix : !Xs u E. weakly_guarded Xs (prefix u E) ==> context Xs E Proof - RW_TAC std_ss [weakly_guarded_def, context_def, EVERY_MEM, BV_def] + RW_TAC std_ss [weakly_guarded_def, context_def, EVERY_MEM] >> RES_TAC >> fs [CCS_Subst_def] >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `WG (\t. prefix u (e t))` @@ -1265,7 +1168,7 @@ QED Theorem weakly_guarded_prefix_rule : !Xs u E. context Xs E ==> weakly_guarded Xs (prefix u E) Proof - RW_TAC std_ss [weakly_guarded_def, context_def, EVERY_MEM, BV_def] + RW_TAC std_ss [weakly_guarded_def, context_def, EVERY_MEM] >> RES_TAC >> rw [CCS_Subst_def] >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `WG (\t. prefix u (CCS_Subst E t X)) = WG (\t. prefix u (e t))` @@ -1273,31 +1176,25 @@ Proof >> MATCH_MP_TAC WG3 >> art [] QED -local - val t1 = - MATCH_MP_TAC SUBSET_DISJOINT \\ - take [`BV (E1 + E2)`, `set Xs`] >> art [BV_SUBSET_rules, SUBSET_REFL]; - val t2 = - RES_TAC >> fs [CCS_Subst_def] \\ +Theorem weakly_guarded_sum : + !Xs E1 E2. weakly_guarded Xs (sum E1 E2) ==> + weakly_guarded Xs E1 /\ weakly_guarded Xs E2 +Proof + RW_TAC std_ss [weakly_guarded_def, EVERY_MEM] + >> ( RES_TAC >> fs [CCS_Subst_def] \\ Q.ABBREV_TAC `e1 = \t. CCS_Subst E1 t X` \\ Q.ABBREV_TAC `e2 = \t. CCS_Subst E2 t X` \\ Know `WG (\t. e1 t + e2 t)` >- (Q.UNABBREV_TAC `e1` >> Q.UNABBREV_TAC `e2` \\ ASM_SIMP_TAC bool_ss []) \\ - DISCH_TAC >> IMP_RES_TAC WG4_backward; -in - val weakly_guarded_sum = store_thm - ("weakly_guarded_sum", - ``!Xs E1 E2. weakly_guarded Xs (sum E1 E2) ==> - weakly_guarded Xs E1 /\ weakly_guarded Xs E2``, - RW_TAC std_ss [weakly_guarded_def, EVERY_MEM] >> t2); -end; + DISCH_TAC >> IMP_RES_TAC WG4_backward ) +QED Theorem weakly_guarded_sum_rule : !Xs E1 E2. weakly_guarded Xs E1 /\ weakly_guarded Xs E2 ==> weakly_guarded Xs (sum E1 E2) Proof - RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, BV_def, CCS_Subst_def] + RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, CCS_Subst_def] >> TRY (ASM_SET_TAC []) >> RES_TAC >> Q.ABBREV_TAC `e1 = \t. CCS_Subst E1 t X` @@ -1321,31 +1218,25 @@ Proof >> MATCH_MP_TAC weakly_guarded_sum_rule >> art [] QED -local - val t1 = - (MATCH_MP_TAC SUBSET_DISJOINT \\ - take [`BV (E1 || E2)`, `set Xs`] >> art [BV_SUBSET_rules, SUBSET_REFL]); - val t2 = - (RES_TAC >> fs [CCS_Subst_def] \\ +Theorem weakly_guarded_par : + !Xs E1 E2. weakly_guarded Xs (par E1 E2) ==> + weakly_guarded Xs E1 /\ weakly_guarded Xs E2 +Proof + RW_TAC std_ss [weakly_guarded_def, EVERY_MEM] + >> ( RES_TAC >> fs [CCS_Subst_def] \\ Q.ABBREV_TAC `e1 = \t. CCS_Subst E1 t X` \\ Q.ABBREV_TAC `e2 = \t. CCS_Subst E2 t X` \\ Know `WG (\t. e1 t || e2 t)` >- (Q.UNABBREV_TAC `e1` >> Q.UNABBREV_TAC `e2` \\ ASM_SIMP_TAC bool_ss []) \\ - DISCH_TAC >> IMP_RES_TAC WG5_backward); -in - val weakly_guarded_par = store_thm - ("weakly_guarded_par", - ``!Xs E1 E2. weakly_guarded Xs (par E1 E2) ==> - weakly_guarded Xs E1 /\ weakly_guarded Xs E2``, - RW_TAC std_ss [weakly_guarded_def, EVERY_MEM] >> t2); -end; + DISCH_TAC >> IMP_RES_TAC WG5_backward ) +QED Theorem weakly_guarded_par_rule : !Xs E1 E2. weakly_guarded Xs E1 /\ weakly_guarded Xs E2 ==> weakly_guarded Xs (par E1 E2) Proof - RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, BV_def, CCS_Subst_def] + RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, CCS_Subst_def] >> TRY (ASM_SET_TAC []) >> RES_TAC >> Q.ABBREV_TAC `e1 = \t. CCS_Subst E1 t X` @@ -1372,7 +1263,7 @@ QED Theorem weakly_guarded_restr : !Xs L E. weakly_guarded Xs (restr L E) ==> weakly_guarded Xs E Proof - RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, BV_def] + RW_TAC std_ss [weakly_guarded_def, EVERY_MEM] >> RES_TAC >> fs [CCS_Subst_def] >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `WG (\t. restr L (e t))` @@ -1383,7 +1274,7 @@ QED Theorem weakly_guarded_restr_rule : !Xs L E. weakly_guarded Xs E ==> weakly_guarded Xs (restr L E) Proof - RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, BV_def, CCS_Subst_def] + RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, CCS_Subst_def] >> RES_TAC >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `WG (\t. e t)` @@ -1406,7 +1297,7 @@ QED Theorem weakly_guarded_relab : !Xs E rf. weakly_guarded Xs (relab E rf) ==> weakly_guarded Xs E Proof - RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, BV_def] + RW_TAC std_ss [weakly_guarded_def, EVERY_MEM] >> RES_TAC >> fs [CCS_Subst_def] >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `WG (\t. relab (e t) rf)` @@ -1417,7 +1308,7 @@ QED Theorem weakly_guarded_relab_rule : !Xs E rf. weakly_guarded Xs E ==> weakly_guarded Xs (relab E rf) Proof - RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, BV_def, CCS_Subst_def] + RW_TAC std_ss [weakly_guarded_def, EVERY_MEM, CCS_Subst_def] >> RES_TAC >> Q.ABBREV_TAC `e = \t. CCS_Subst E t X` >> Know `WG (\t. e t)` @@ -1450,7 +1341,7 @@ QED Theorem weakly_guarded_var_rule : !Xs Y. ~MEM Y Xs ==> weakly_guarded Xs (var Y) Proof - RW_TAC lset_ss [weakly_guarded_def, EVERY_MEM, BV_def, CCS_Subst_def] + RW_TAC lset_ss [weakly_guarded_def, EVERY_MEM, CCS_Subst_def] >> Cases_on `Y = X` >> fs [WG_rules] QED @@ -1487,7 +1378,7 @@ val weakly_guarded_backward_rules = save_thm Theorem disjoint_imp_weakly_guarded : !Xs E. DISJOINT (FV E) (set Xs) ==> weakly_guarded Xs E Proof - RW_TAC std_ss [weakly_guarded_def, BV_def, EVERY_MEM] + RW_TAC std_ss [weakly_guarded_def, EVERY_MEM] >> MATCH_MP_TAC WG_CONST >> RW_TAC std_ss [IS_CONST_def] >> `X NOTIN (FV E)` by ASM_SET_TAC [] @@ -1514,66 +1405,59 @@ Proof weakly_guarded Xs (CCS_SUBST (fromList Xs Es) C)` >- METIS_TAC [] >> NTAC 3 STRIP_TAC (* up to `!C.` *) - >> Induct_on `C` >> RW_TAC std_ss [CCS_SUBST_def] (* 10 subgoals *) - (* goal 1 (of 10): easy *) - >- REWRITE_TAC [weakly_guarded_nil] - (* goal 2 (of 10): not easy *) - >- (Know `FDOM (fromList Xs Es) = set Xs` - >- (MATCH_MP_TAC FDOM_fromList >> art []) >> DISCH_THEN (fs o wrap) \\ - fs [EVERY_MEM, MEM_EL] \\ - Know `(fromList Xs Es) ' (EL n Xs) = EL n Es` - >- (MATCH_MP_TAC fromList_FAPPLY_EL >> art []) >> Rewr' \\ - FIRST_X_ASSUM MATCH_MP_TAC \\ - Q.EXISTS_TAC `n` >> art []) - (* goal 3 (of 10): not hard *) - >- (Know `FDOM (fromList Xs Es) = set Xs` - >- (MATCH_MP_TAC FDOM_fromList >> art []) >> DISCH_THEN (fs o wrap) \\ + >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> Q.EXISTS_TAC ‘set Xs UNION (BIGUNION (IMAGE FV (set Es)))’ + >> rw [ssub_thm] >> rw [FINITE_FV] + (* 9 subgoals *) + >- (fs [FDOM_fromList, MEM_EL, LIST_REL_EL_EQN] \\ + rw [fromList_FAPPLY_EL] \\ + fs [EVERY_EL]) + (* 8 subgoals *) + >- (fs [FDOM_fromList] \\ MATCH_MP_TAC weakly_guarded_var_rule >> art []) - (* goal 4 (of 10): not hard *) + (* 7 subgoals *) + >- (rw [weakly_guarded_nil]) + (* 6 subgoals *) >- (IMP_RES_TAC context_prefix \\ Q.PAT_X_ASSUM `context Xs C' ==> _` MP_TAC >> RW_TAC std_ss [] \\ MATCH_MP_TAC weakly_guarded_prefix_rule \\ MATCH_MP_TAC weakly_guarded_imp_context >> art []) - (* goal 5 (of 10): easy *) + (* 5 subgoals *) >- (IMP_RES_TAC context_sum \\ Q.PAT_X_ASSUM `context Xs C'' ==> _` MP_TAC \\ Q.PAT_X_ASSUM `context Xs C' ==> _` MP_TAC >> RW_TAC std_ss [] \\ MATCH_MP_TAC weakly_guarded_sum_rule >> art []) - (* goal 6 (of 10): easy *) + (* 4 subgoals *) >- (IMP_RES_TAC context_par \\ Q.PAT_X_ASSUM `context Xs C'' ==> _` MP_TAC \\ Q.PAT_X_ASSUM `context Xs C' ==> _` MP_TAC >> RW_TAC std_ss [] \\ MATCH_MP_TAC weakly_guarded_par_rule >> art []) - (* goal 7 (of 10): easy *) + (* 3 subgoals *) >- (IMP_RES_TAC context_restr \\ Q.PAT_X_ASSUM `context Xs C' ==> _` MP_TAC >> RW_TAC std_ss [] \\ MATCH_MP_TAC weakly_guarded_restr_rule >> art []) - (* goal 8 (of 10): easy *) + (* 2 subgoals *) >- (IMP_RES_TAC context_relab \\ Q.PAT_X_ASSUM `context Xs C' ==> _` MP_TAC >> RW_TAC std_ss [] \\ MATCH_MP_TAC weakly_guarded_relab_rule >> art []) - (* goal 9 (of 10): hard, impossible case *) - >- (Know `FDOM (fromList Xs Es) = set Xs` - >- (MATCH_MP_TAC FDOM_fromList >> art []) >> DISCH_THEN (fs o wrap) \\ - IMP_RES_TAC context_rec \\ - rename1 `MEM X Xs` \\ - Know `CCS_SUBST ((fromList Xs Es) \\ X) C' = C'` - >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - ASM_SIMP_TAC std_ss [FDOM_DOMSUB, FDOM_fromList] \\ - ASM_SET_TAC [context_def]) >> Rewr' \\ - MATCH_MP_TAC disjoint_imp_weakly_guarded \\ - fs [FV_def, BV_def, context_def]) - (* goal 10 (of 10): not easy *) - >> Know `FDOM (fromList Xs Es) = set Xs` - >- (MATCH_MP_TAC FDOM_fromList >> art []) >> DISCH_THEN (fs o wrap) + (* 1 subgoal *) + >> rename1 ‘context Xs (rec Y E)’ >> IMP_RES_TAC context_rec - >> Know `CCS_SUBST (fromList Xs Es) C' = C'` + (* applying ssub_rec *) + >> qabbrev_tac ‘fm = fromList Xs Es’ + >> Know ‘CCS_SUBST fm (rec Y E) = rec Y (CCS_SUBST fm E)’ + >- (MATCH_MP_TAC ssub_rec \\ + rw [Abbr ‘fm’, FDOM_fromList] \\ + fs [MEM_EL, fromList_FAPPLY_EL] >> METIS_TAC []) + >> Rewr' + >> gs [] + >> qunabbrev_tac ‘fm’ + >> Know `CCS_SUBST (fromList Xs Es) E = E` >- (MATCH_MP_TAC CCS_SUBST_elim' \\ - fs [FDOM_fromList] >> ASM_SET_TAC []) + fs [FDOM_fromList] >> ASM_SET_TAC []) >> DISCH_THEN (fs o wrap) - >> rename1 `~MEM Y Xs` >> MATCH_MP_TAC disjoint_imp_weakly_guarded - >> fs [context_def, FV_def] + >> rw [FV_thm] QED (* ========================================================================== *) @@ -1582,22 +1466,17 @@ QED (* NOTE: each E in Es MUST contain free variables up to Xs *) Definition CCS_equation_def : - CCS_equation (Xs :'a list) (Es :('a, 'b) CCS list) <=> - ALL_DISTINCT Xs /\ (LENGTH Es = LENGTH Xs) /\ - EVERY (\e. (FV e) SUBSET (set Xs)) Es /\ - EVERY (\e. DISJOINT (BV e) (set Xs)) Es + CCS_equation (Xs :string list) (Es :'a CCS list) <=> + ALL_DISTINCT Xs /\ LENGTH Es = LENGTH Xs /\ + EVERY (\e. (FV e) SUBSET (set Xs)) Es End (* A solution Ps of the CCS equation (group) Es[Xs] up to R, `ALL_PROC Ps` is required in (all) unique-solution proofs. - - `EVERY (\e. DISJOINT (BV e) (set Xs)) Ps` is not necessary but makes proofs - (much) easier. *) Definition CCS_solution_def : CCS_solution R Xs Es Ps <=> ALL_PROC Ps /\ - EVERY (\e. DISJOINT (BV e) (set Xs)) Ps /\ LIST_REL R Ps (MAP (CCS_SUBST (fromList Xs Ps)) Es) End @@ -1623,46 +1502,39 @@ QED NOTE1: `ALL_PROC Ps` is not required here. NOTE2: `FV E SUBSET (set Xs)` and `FV E' SUBSET (set Xs)` were added - NOTE3: `DISJOINT (BV E) (set Xs)` and `DISJOINT (BV E') (set Xs)` were - moved from weakly_guarded_def and context_def. *) Theorem strong_unique_solution_lemma : - !Xs E. weakly_guarded Xs E /\ - FV E SUBSET (set Xs) /\ DISJOINT (BV E) (set Xs) ==> + !Xs E. weakly_guarded Xs E /\ FV E SUBSET (set Xs) ==> !Ps. (LENGTH Ps = LENGTH Xs) ==> !u P'. TRANS (CCS_SUBST (fromList Xs Ps) E) u P' ==> ?E'. context Xs E' /\ FV E' SUBSET (set Xs) /\ - DISJOINT (BV E') (set Xs) /\ (P' = CCS_SUBST (fromList Xs Ps) E') /\ !Qs. (LENGTH Qs = LENGTH Xs) ==> TRANS (CCS_SUBST (fromList Xs Qs) E) u (CCS_SUBST (fromList Xs Qs) E') Proof Q.X_GEN_TAC `Xs` - >> Induct_on `E` >> rpt STRIP_TAC (* 8 subgoals *) - (* Case 0: E = nil, impossible *) - >- fs [CCS_SUBST_def, NIL_NO_TRANS] - (* Case 1: E = Y, a variable, still impossible *) + >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> Q.EXISTS_TAC ‘set Xs’ >> rw [FDOM_fromList] (* 8 subgoals *) + (* Case 0: E = var s, impossible *) >- (rename1 `weakly_guarded Xs (var Y)` \\ - IMP_RES_TAC weakly_guarded_var \\ - `Y NOTIN (FDOM (fromList Xs Ps))` by METIS_TAC [FDOM_fromList] \\ - fs [CCS_SUBST_def, VAR_NO_TRANS]) + IMP_RES_TAC weakly_guarded_var) + (* Case 1: E = nil, still impossible *) + >- (fs [NIL_NO_TRANS]) (* Case 2: E = b.E' *) >- (rename1 `weakly_guarded Xs (prefix b E)` \\ - fs [CCS_SUBST_def, TRANS_PREFIX_EQ, FV_def] \\ + fs [CCS_SUBST_def, TRANS_PREFIX_EQ] \\ Q.EXISTS_TAC `E` >> art [] \\ - IMP_RES_TAC weakly_guarded_prefix \\ - fs [BV_def]) + IMP_RES_TAC weakly_guarded_prefix) (* Case 3: E = E1 + E2 *) >- (IMP_RES_TAC weakly_guarded_sum \\ - fs [CCS_SUBST_def, TRANS_SUM_EQ, BV_def, FV_def] \\ (* 2 subgoals, same tactics *) - RES_TAC >> fs [FV_def, BV_def] \\ - Q.EXISTS_TAC `E''` >> fs []) + fs [CCS_SUBST_def, TRANS_SUM_EQ] \\ (* 2 subgoals, same tactics *) + RES_TAC >> Q.EXISTS_TAC `E''` >> fs []) (* Case 4: E = E1 || E2 *) >- (rename1 `weakly_guarded Xs (E1 || E2)` \\ IMP_RES_TAC weakly_guarded_par \\ - fs [CCS_SUBST_def, TRANS_PAR_EQ, BV_def, FV_def] >| (* 3 subgoals *) + fs [CCS_SUBST_def, TRANS_PAR_EQ, FV_def] >| (* 3 subgoals *) [ (* goal 1 (of 3) *) Q.PAT_X_ASSUM `!Ps. _ ==> !u P'. TRANS (CCS_SUBST (fromList Xs Ps) E1) u P' ==> _` @@ -1676,8 +1548,7 @@ Proof >- (MATCH_MP_TAC context_par_rule >> art [] \\ MATCH_MP_TAC weakly_guarded_imp_context >> art []) \\ CONJ_TAC >- ASM_SET_TAC [FV_def] \\ - ASM_SIMP_TAC std_ss [CCS_SUBST_def, BV_def, FV_def] \\ - CONJ_TAC >- ASM_SET_TAC [] \\ + ASM_SIMP_TAC std_ss [CCS_SUBST_def, FV_def] \\ GEN_TAC >> DISCH_TAC >> DISJ1_TAC \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) E'` >> REWRITE_TAC [] \\ FIRST_X_ASSUM MATCH_MP_TAC >> art [], @@ -1696,8 +1567,7 @@ Proof >- (MATCH_MP_TAC context_par_rule >> art [] \\ MATCH_MP_TAC weakly_guarded_imp_context >> art []) \\ CONJ_TAC >- ASM_SET_TAC [FV_def] \\ - ASM_SIMP_TAC std_ss [CCS_SUBST_def, BV_def, FV_def] \\ - CONJ_TAC >- ASM_SET_TAC [] \\ + ASM_SIMP_TAC std_ss [CCS_SUBST_def, FV_def] \\ GEN_TAC >> DISCH_TAC >> DISJ2_TAC >> DISJ1_TAC \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) E''` >> REWRITE_TAC [] \\ FIRST_X_ASSUM MATCH_MP_TAC >> art [], @@ -1715,54 +1585,52 @@ Proof Q.EXISTS_TAC `E' || E''` \\ CONJ_TAC >- (MATCH_MP_TAC context_par_rule >> art []) \\ CONJ_TAC >- ASM_SET_TAC [FV_def] \\ - ASM_SIMP_TAC std_ss [CCS_SUBST_def, BV_def, FV_def] \\ - CONJ_TAC >- ASM_SET_TAC [] \\ + ASM_SIMP_TAC std_ss [CCS_SUBST_def, FV_def] \\ GEN_TAC >> DISCH_TAC >> NTAC 2 DISJ2_TAC \\ take [`CCS_SUBST (fromList Xs Qs) E'`, `CCS_SUBST (fromList Xs Qs) E''`, `l`] >> fs [] ]) (* Case 5: E = restr f E' *) >- (IMP_RES_TAC weakly_guarded_restr \\ - fs [CCS_SUBST_def, TRANS_RESTR_EQ, BV_def, FV_def] >| (* 2 subgoals *) + fs [CCS_SUBST_def, TRANS_RESTR_EQ, FV_def] >| (* 2 subgoals *) [ (* goal 1 (of 2) *) Q.PAT_X_ASSUM `!Ps. (LENGTH Ps = LENGTH Xs) ==> _` (MP_TAC o (Q.SPEC `Ps`)) \\ RW_TAC std_ss [] \\ POP_ASSUM (MP_TAC o (Q.SPECL [`tau`, `E''`])) >> RW_TAC std_ss [] \\ - Q.EXISTS_TAC `restr f E'` \\ - rfs [CCS_SUBST_def, BV_def, FV_def] \\ + Q.EXISTS_TAC `restr L E'` \\ + rfs [CCS_SUBST_def, FV_def] \\ MATCH_MP_TAC context_restr_rule >> art [], (* goal 2 (of 2) *) Q.PAT_X_ASSUM `!Ps. (LENGTH Ps = LENGTH Xs) ==> _` (MP_TAC o (Q.SPEC `Ps`)) \\ RW_TAC std_ss [] \\ POP_ASSUM (MP_TAC o (Q.SPECL [`label l`, `E''`])) >> RW_TAC std_ss [] \\ - Q.EXISTS_TAC `restr f E'` \\ - rfs [CCS_SUBST_def, BV_def, FV_def] \\ + Q.EXISTS_TAC `restr L E'` \\ + rfs [CCS_SUBST_def, FV_def] \\ MATCH_MP_TAC context_restr_rule >> art [] ]) (* Case 6: E = relab E' R *) >- (IMP_RES_TAC weakly_guarded_relab \\ Q.PAT_X_ASSUM `weakly_guarded Xs E /\ _ ==> _` MP_TAC \\ - fs [BV_def, FV_def] >> rpt STRIP_TAC \\ + fs [FV_def] >> rpt STRIP_TAC \\ POP_ASSUM (MP_TAC o (Q.SPEC `Ps`)) >> RW_TAC std_ss [] \\ fs [CCS_SUBST_def, TRANS_RELAB_EQ] \\ POP_ASSUM (MP_TAC o (Q.SPECL [`u'`, `E''`])) >> RW_TAC std_ss [] \\ - Q.EXISTS_TAC `relab E' R` \\ + Q.EXISTS_TAC `relab E' rf` \\ CONJ_TAC >- (MATCH_MP_TAC context_relab_rule >> art []) \\ - ASM_SIMP_TAC std_ss [CCS_SUBST_def, BV_def, FV_def] \\ + ASM_SIMP_TAC std_ss [CCS_SUBST_def, FV_def] \\ GEN_TAC >> DISCH_TAC \\ take [`u'`, `CCS_SUBST (fromList Xs Qs) E'`] >> art [] \\ FIRST_X_ASSUM MATCH_MP_TAC >> art []) (* Case 7 (difficult): E = rec Y E' *) - >> rename1 `weakly_guarded Xs (rec Y E)` >> IMP_RES_TAC weakly_guarded_rec - >> `DISJOINT (FV (rec Y E)) (set Xs)` by ASM_SET_TAC [FV_def] - (* simplify `CCS_Subst (rec Y E) (Ps |-> Qs)` *) - >> Know `CCS_SUBST (fromList Xs Ps) (rec Y E) = rec Y E` + >> `DISJOINT (FV (rec y E)) (set Xs)` by ASM_SET_TAC [FV_def] + (* simplify `CCS_Subst (rec y E) (Ps |-> Qs)` *) + >> Know `CCS_SUBST (fromList Xs Ps) (rec y E) = rec y E` >- (MATCH_MP_TAC CCS_SUBST_elim >> art []) - >> DISCH_THEN (fs o wrap) + >> DISCH_THEN (FULL_SIMP_TAC std_ss o wrap) (* KEY step: let E' = P' *) >> Q.EXISTS_TAC `P'` >> Know `DISJOINT (FV P') (set Xs)` >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `FV (rec Y E)` >> art [] \\ + Q.EXISTS_TAC `FV (rec y E)` >> art [] \\ MATCH_MP_TAC TRANS_FV \\ Q.EXISTS_TAC `u` >> art []) >> DISCH_TAC >> CONJ_TAC (* context Xs P' *) @@ -1771,18 +1639,13 @@ Proof >- (Rewr' >> REWRITE_TAC [CONTEXT2]) \\ MATCH_MP_TAC CCS_Subst_elim >> ASM_SET_TAC []) >> CONJ_TAC (* FV P' SUBSET set Xs *) - >- (`FV P' SUBSET FV (rec Y E)` by PROVE_TAC [TRANS_FV] \\ + >- (`FV P' SUBSET FV (rec y E)` by PROVE_TAC [TRANS_FV] \\ MATCH_MP_TAC SUBSET_TRANS \\ - Q.EXISTS_TAC `FV (rec Y E)` >> art []) (* Yeah! *) - >> CONJ_TAC (* DISJOINT (BV P') (set Xs) *) - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (rec Y E)` >> art [] \\ - MATCH_MP_TAC TRANS_BV \\ - Q.EXISTS_TAC `u` >> art []) + Q.EXISTS_TAC `FV (rec y E)` >> rw []) (* Yeah! *) >> CONJ_TAC (* P' = CCS_SUBST (Xs |-> Ps) P' *) >- (MATCH_MP_TAC EQ_SYM >> irule CCS_SUBST_elim >> art []) >> rpt STRIP_TAC - >> Know `CCS_SUBST (fromList Xs Qs) (rec Y E) = rec Y E` + >> Know `CCS_SUBST (fromList Xs Qs) (rec y E) = rec y E` >- (irule CCS_SUBST_elim >> art []) >> Rewr' >> Know `CCS_SUBST (fromList Xs Qs) P' = P'` >- (irule CCS_SUBST_elim >> art []) >> Rewr' >> art [] @@ -1808,25 +1671,22 @@ Proof (* `FV G SUBSET (set Xs)` is necessary for the case of `par`; - `IS_PROC x /\ DISJOINT (BV x) (set Xs)` is for the same case: they - guarantee that `CCS_SUBST (Xs |-> Ps) x = x`. (This is not needed + `IS_PROC x` is for the same case: they guarantee that + `CCS_SUBST (Xs |-> Ps) x = x`. (This is not needed when "CCS equations" are formalized as another type, e.g. in case - of STRONG_UNIQUE_SOLUTION where uni-variate equations are lambda- - functions of type CCS->CCS.) + of STRONG_UNIQUE_SOLUTION where univariate equations are lambda- + functions of type 'a CCS -> 'a CCS.) *) - >> Q.EXISTS_TAC `\x y. IS_PROC x /\ DISJOINT (BV x) (set Xs) /\ - IS_PROC y /\ DISJOINT (BV y) (set Xs) /\ + >> Q.EXISTS_TAC `\x y. IS_PROC x /\ IS_PROC y /\ ((x = y) \/ (?G. context Xs G /\ (FV G) SUBSET (set Xs) /\ (x = CCS_SUBST (fromList Xs Ps) G) /\ (y = CCS_SUBST (fromList Xs Qs) G)))` >> BETA_TAC >> reverse CONJ_TAC - >- (Know `IS_PROC P /\ IS_PROC Q` >- METIS_TAC [IS_PROC_EL] \\ - Know `DISJOINT (BV P) (set Xs) /\ DISJOINT (BV Q) (set Xs)` - >- (fs [EVERY_MEM, MEM_EL] >> METIS_TAC []) >> rw [] \\ + >- (`IS_PROC P /\ IS_PROC Q` by METIS_TAC [IS_PROC_EL] >> simp [] \\ DISJ2_TAC >> Q.EXISTS_TAC `var (EL n Xs)` \\ unset [`P`, `Q`] \\ - SRW_TAC [] [CCS_SUBST_def, FV_def, MEM_EL, FDOM_fromList] (* 5 subgoals *) + SRW_TAC [] [CCS_SUBST_def, FV_def, MEM_EL, FDOM_fromList] (* 6 subgoals *) >- REWRITE_TAC [context_var] >- (Q.EXISTS_TAC `n` >> art []) >- (MATCH_MP_TAC EQ_SYM >> MATCH_MP_TAC fromList_FAPPLY_EL >> art []) @@ -1842,857 +1702,726 @@ Proof Q.EXISTS_TAC `E1` >> art [STRONG_EQUIV_REFL] \\ Q.EXISTS_TAC `E1` >> art [STRONG_EQUIV_REFL] \\ BETA_TAC >> fs [] \\ - Know `IS_PROC E1` - >- (MATCH_MP_TAC TRANS_PROC >> take [`P'`, `u`] >> art []) \\ - Know `DISJOINT (BV E1) (set Xs)` - >- (IMP_RES_TAC TRANS_BV >> ASM_SET_TAC []) >> rw [], + MATCH_MP_TAC TRANS_PROC >> take [`P'`, `u`] >> art [], (* goal 2 (of 2) *) Q.EXISTS_TAC `E2` >> art [O_DEF] \\ Q.EXISTS_TAC `E2` >> art [STRONG_EQUIV_REFL] \\ Q.EXISTS_TAC `E2` >> art [STRONG_EQUIV_REFL] \\ BETA_TAC >> fs [] \\ - Know `IS_PROC E2` - >- (MATCH_MP_TAC TRANS_PROC >> take [`P'`, `u`] >> art []) \\ - Know `DISJOINT (BV E2) (set Xs)` - >- (IMP_RES_TAC TRANS_BV >> ASM_SET_TAC []) >> rw [] ]) - (* eliminate `P'` and `Q'` *) - >> Q.PAT_X_ASSUM `IS_PROC P'` MP_TAC + MATCH_MP_TAC TRANS_PROC >> take [`P'`, `u`] >> art [] ]) + (* move up `P'` and `Q'` *) >> Q.PAT_X_ASSUM `IS_PROC Q'` MP_TAC - >> Q.PAT_X_ASSUM `DISJOINT (BV P') (set Xs)` MP_TAC - >> Q.PAT_X_ASSUM `DISJOINT (BV Q') (set Xs)` MP_TAC + >> Q.PAT_X_ASSUM `IS_PROC P'` MP_TAC >> NTAC 2 POP_ORW (* P' = ... /\ Q' = ... *) - >> Induct_on `G` (* 8 subgoals *) - (* Case 0: E = nil, impossible *) - >- RW_TAC std_ss [CCS_SUBST_def, FV_def, NIL_NO_TRANS] - (* Case 1: E = var Y *) - >- (Q.X_GEN_TAC `Y` >> NTAC 6 STRIP_TAC \\ - reverse (Cases_on `Y IN set Xs`) - >- (`DISJOINT (FV (var Y)) (set Xs)` by ASM_SET_TAC [FV_def] \\ - `DISJOINT (BV (var Y)) (set Xs)` by ASM_SET_TAC [BV_def] \\ - `(CCS_SUBST (fromList Xs Ps) (var Y) = var Y) /\ - (CCS_SUBST (fromList Xs Qs) (var Y) = var Y)` - by METIS_TAC [CCS_SUBST_elim] \\ - RW_TAC std_ss [VAR_NO_TRANS]) \\ - fs [MEM_EL] >> rename1 `i < LENGTH Xs` \\ - Know `!Zs. (LENGTH Zs = LENGTH Xs) ==> - (CCS_SUBST (fromList Xs Zs) (var (EL i Xs)) = EL i Zs)` - >- (RW_TAC std_ss [CCS_SUBST_def, fromList_FAPPLY_EL, FDOM_fromList] \\ - METIS_TAC [MEM_EL]) >> DISCH_TAC \\ - `(CCS_SUBST (fromList Xs Ps) (var (EL i Xs)) = EL i Ps) /\ - (CCS_SUBST (fromList Xs Qs) (var (EL i Xs)) = EL i Qs)` by PROVE_TAC [] \\ - (* applying strong_unique_solution_lemma (the only time) *) - RW_TAC std_ss [BV_def, FV_def] >| (* 2 subgoals (symmetric) *) - [ (* goal 1 (of 2) *) - `STRONG_EQUIV (EL i Ps) (CCS_SUBST (fromList Xs Ps) (EL i Es))` - by METIS_TAC [EL_MAP] \\ - IMP_RES_TAC PROPERTY_STAR_LEFT \\ - Q.ABBREV_TAC `E = EL i Es` >> `MEM E Es` by PROVE_TAC [MEM_EL] \\ - Know `weakly_guarded Xs E /\ FV E SUBSET (set Xs)` - >- (fs [EVERY_MEM, MEM_EL] \\ - `MEM E Es` by PROVE_TAC [MEM_EL] >> METIS_TAC []) >> STRIP_TAC \\ - `DISJOINT (BV E) (set Xs)` by fs [EVERY_MEM] \\ - `LENGTH Ps = LENGTH Xs` by PROVE_TAC [] \\ - `?E'. context Xs E' /\ - FV E' SUBSET (set Xs) /\ - DISJOINT (BV E') (set Xs) /\ - (E2 = CCS_SUBST (fromList Xs Ps) E') /\ - !Qs. (LENGTH Qs = LENGTH Xs) ==> - TRANS (CCS_SUBST (fromList Xs Qs) E) u - (CCS_SUBST (fromList Xs Qs) E')` - by METIS_TAC [Q.SPECL [`Xs`, `E`] strong_unique_solution_lemma] \\ - POP_ASSUM (MP_TAC o (Q.SPEC `Qs`)) >> RW_TAC std_ss [] \\ - `STRONG_EQUIV (EL i Qs) (CCS_SUBST (fromList Xs Qs) E)` - by METIS_TAC [EL_MAP] \\ - `?E2. TRANS (EL i Qs) u E2 /\ - STRONG_EQUIV (CCS_SUBST (fromList Xs Qs) E') E2` - by METIS_TAC [PROPERTY_STAR_RIGHT, STRONG_EQUIV_SYM] \\ - Q.EXISTS_TAC `E2` >> RW_TAC std_ss [O_DEF] \\ - Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) E'` >> art [] \\ - Q.EXISTS_TAC `CCS_SUBST (fromList Xs Ps) E'` >> art [] \\ - CONJ_TAC (* `IS_PROC ...` #1 *) - >- (MATCH_MP_TAC CCS_SUBST_IS_PROC >> fs [context_def]) \\ - CONJ_TAC (* `DISJOINT ...` #1 *) - >- (MATCH_MP_TAC DISJOINT_BV_CCS_SUBST >> art [] \\ - fs [EVERY_MEM, context_def, MEM_EL]) \\ - CONJ_TAC (* `IS_PROC ...` #2 *) - >- (MATCH_MP_TAC CCS_SUBST_IS_PROC >> fs [context_def]) \\ - CONJ_TAC (* `DISJOINT ...` #2 *) - >- (MATCH_MP_TAC DISJOINT_BV_CCS_SUBST >> art [] \\ - fs [EVERY_MEM, context_def, MEM_EL]) \\ - DISJ2_TAC >> Q.EXISTS_TAC `E'` >> art [], - (* goal 2 (of 2) *) - `STRONG_EQUIV (EL i Qs) (CCS_SUBST (fromList Xs Qs) (EL i Es))` - by METIS_TAC [EL_MAP] \\ - Q.ABBREV_TAC `E = EL i Es` >> `MEM E Es` by PROVE_TAC [MEM_EL] \\ - Know `weakly_guarded Xs E /\ FV E SUBSET (set Xs)` - >- (fs [EVERY_MEM, MEM_EL] \\ - `MEM E Es` by PROVE_TAC [MEM_EL] >> METIS_TAC []) >> STRIP_TAC \\ - `?E2'. TRANS (CCS_SUBST (fromList Xs Qs) E) u E2' /\ STRONG_EQUIV E2' E2` - by METIS_TAC [PROPERTY_STAR_LEFT, STRONG_EQUIV_SYM] \\ - `DISJOINT (BV E) (set Xs)` by fs [EVERY_MEM] \\ - `LENGTH Qs = LENGTH Xs` by PROVE_TAC [] \\ - `?E'. context Xs E' /\ - FV E' SUBSET (set Xs) /\ - DISJOINT (BV E') (set Xs) /\ - (E2' = CCS_SUBST (fromList Xs Qs) E') /\ - !Ps. (LENGTH Ps = LENGTH Xs) ==> - TRANS (CCS_SUBST (fromList Xs Ps) E) u - (CCS_SUBST (fromList Xs Ps) E')` - by METIS_TAC [Q.SPECL [`Xs`, `E`] strong_unique_solution_lemma] \\ - POP_ASSUM (MP_TAC o (Q.SPEC `Ps`)) >> RW_TAC std_ss [] \\ - `STRONG_EQUIV (EL i Ps) (CCS_SUBST (fromList Xs Ps) E)` - by METIS_TAC [EL_MAP] \\ - `?E1. TRANS (EL i Ps) u E1 /\ - STRONG_EQUIV E1 (CCS_SUBST (fromList Xs Ps) E')` - by METIS_TAC [PROPERTY_STAR_RIGHT] \\ - Q.EXISTS_TAC `E1` >> RW_TAC std_ss [O_DEF] \\ - Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) E'` >> art [] \\ - Q.EXISTS_TAC `CCS_SUBST (fromList Xs Ps) E'` >> art [] \\ - CONJ_TAC (* `IS_PROC ...` #1 *) - >- (MATCH_MP_TAC CCS_SUBST_IS_PROC >> fs [context_def]) \\ - CONJ_TAC (* `DISJOINT ...` #1 *) - >- (MATCH_MP_TAC DISJOINT_BV_CCS_SUBST >> art [] \\ - fs [EVERY_MEM, context_def, MEM_EL]) \\ - CONJ_TAC (* `IS_PROC ...` #2 *) - >- (MATCH_MP_TAC CCS_SUBST_IS_PROC >> fs [context_def]) \\ - CONJ_TAC (* `DISJOINT ...` #2 *) - >- (MATCH_MP_TAC DISJOINT_BV_CCS_SUBST >> art [] \\ - fs [EVERY_MEM, context_def, MEM_EL]) \\ - DISJ2_TAC >> Q.EXISTS_TAC `E'` >> art [] ]) - (* Case 2: E = prefix u G (easy) *) - >- (RW_TAC std_ss [FV_def, BV_def, context_prefix_rewrite, CCS_SUBST_prefix, - TRANS_PREFIX_EQ, IS_PROC_prefix] \\ - Q.PAT_X_ASSUM `context Xs G ==> _` MP_TAC >> RW_TAC bool_ss [] \\ + (* move up all about G *) + >> NTAC 2 (POP_ASSUM MP_TAC) + >> Q.ID_SPEC_TAC ‘G’ + >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> Q.EXISTS_TAC ‘set Xs UNION BIGUNION (IMAGE FV (set Es)) + UNION BIGUNION (IMAGE FV (set Ps)) + UNION BIGUNION (IMAGE FV (set Qs))’ + >> rw [] >> fs [FDOM_fromList, FINITE_FV, NIL_NO_TRANS] + (* 14 subgoals left *) + >- (rename1 ‘MEM X Xs’ \\ + gs [MEM_EL, fromList_FAPPLY_EL, FDOM_fromList, EL_MAP] \\ + rename1 ‘X = EL i Xs’ \\ + `STRONG_EQUIV (EL i Ps) (CCS_SUBST (fromList Xs Ps) (EL i Es))` by PROVE_TAC [] \\ + IMP_RES_TAC PROPERTY_STAR_LEFT \\ + Q.ABBREV_TAC `E = EL i Es` >> `MEM E Es` by PROVE_TAC [MEM_EL] \\ + Know `weakly_guarded Xs E /\ FV E SUBSET (set Xs)` + >- (fs [EVERY_MEM, MEM_EL] \\ + `MEM E Es` by PROVE_TAC [MEM_EL] >> METIS_TAC []) >> STRIP_TAC \\ + `?E'. context Xs E' /\ + FV E' SUBSET (set Xs) /\ + (E2 = CCS_SUBST (fromList Xs Ps) E') /\ + !Qs. (LENGTH Qs = LENGTH Xs) ==> + TRANS (CCS_SUBST (fromList Xs Qs) E) u + (CCS_SUBST (fromList Xs Qs) E')` + by METIS_TAC [Q.SPECL [`Xs`, `E`] strong_unique_solution_lemma] \\ + POP_ASSUM (MP_TAC o (Q.SPEC `Qs`)) >> RW_TAC std_ss [] \\ + `STRONG_EQUIV (EL i Qs) (CCS_SUBST (fromList Xs Qs) E)` by PROVE_TAC [] \\ + `?E2. TRANS (EL i Qs) u E2 /\ + STRONG_EQUIV (CCS_SUBST (fromList Xs Qs) E') E2` + by METIS_TAC [PROPERTY_STAR_RIGHT, STRONG_EQUIV_SYM] \\ + Q.EXISTS_TAC `E2` >> RW_TAC std_ss [O_DEF] \\ + Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) E'` >> art [] \\ + Q.EXISTS_TAC `CCS_SUBST (fromList Xs Ps) E'` >> art [] \\ + CONJ_TAC (* `IS_PROC ...` #1 *) + >- (MATCH_MP_TAC CCS_SUBST_IS_PROC >> fs [context_def]) \\ + CONJ_TAC (* `IS_PROC ...` #2 *) + >- (MATCH_MP_TAC CCS_SUBST_IS_PROC >> fs [context_def]) \\ + DISJ2_TAC >> Q.EXISTS_TAC `E'` >> art []) + (* 13 subgoals left *) + >- (rename1 ‘MEM X Xs’ \\ + gs [MEM_EL, fromList_FAPPLY_EL, FDOM_fromList, EL_MAP] \\ + rename1 ‘X = EL i Xs’ \\ + `STRONG_EQUIV (EL i Qs) (CCS_SUBST (fromList Xs Qs) (EL i Es))` by PROVE_TAC [] \\ + Q.ABBREV_TAC `E = EL i Es` >> `MEM E Es` by PROVE_TAC [MEM_EL] \\ + Know `weakly_guarded Xs E /\ FV E SUBSET (set Xs)` + >- (fs [EVERY_MEM, MEM_EL] \\ + `MEM E Es` by PROVE_TAC [MEM_EL] >> METIS_TAC []) >> STRIP_TAC \\ + `?E2'. TRANS (CCS_SUBST (fromList Xs Qs) E) u E2' /\ STRONG_EQUIV E2' E2` + by METIS_TAC [PROPERTY_STAR_LEFT, STRONG_EQUIV_SYM] \\ + `?E'. context Xs E' /\ + FV E' SUBSET (set Xs) /\ + (E2' = CCS_SUBST (fromList Xs Qs) E') /\ + !Ps. (LENGTH Ps = LENGTH Xs) ==> + TRANS (CCS_SUBST (fromList Xs Ps) E) u + (CCS_SUBST (fromList Xs Ps) E')` + by METIS_TAC [Q.SPECL [`Xs`, `E`] strong_unique_solution_lemma] \\ + POP_ASSUM (MP_TAC o (Q.SPEC `Ps`)) >> RW_TAC std_ss [] \\ + `STRONG_EQUIV (EL i Ps) (CCS_SUBST (fromList Xs Ps) E)` by PROVE_TAC [] \\ + `?E1. TRANS (EL i Ps) u E1 /\ + STRONG_EQUIV E1 (CCS_SUBST (fromList Xs Ps) E')` + by METIS_TAC [PROPERTY_STAR_RIGHT] \\ + Q.EXISTS_TAC `E1` >> RW_TAC std_ss [O_DEF] \\ + Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) E'` >> art [] \\ + Q.EXISTS_TAC `CCS_SUBST (fromList Xs Ps) E'` >> art [] \\ + CONJ_TAC (* `IS_PROC ...` #1 *) + >- (MATCH_MP_TAC CCS_SUBST_IS_PROC >> fs [context_def]) \\ + CONJ_TAC (* `IS_PROC ...` #2 *) + >- (MATCH_MP_TAC CCS_SUBST_IS_PROC >> fs [context_def]) \\ + DISJ2_TAC >> Q.EXISTS_TAC `E'` >> art []) + (* 12 subgoals left, E = prefix u G (easy) *) + >- (fs [FV_def, context_prefix_rewrite, ssub_thm, TRANS_PREFIX_EQ, IS_PROC_prefix] \\ + RW_TAC std_ss [O_DEF] \\ + Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) G` >> art [STRONG_EQUIV_REFL] \\ + Q.EXISTS_TAC `CCS_SUBST (fromList Xs Ps) G` >> art [STRONG_EQUIV_REFL] \\ + DISJ2_TAC >> Q.EXISTS_TAC `G` >> rw []) + (* 11 subgoals left *) + >- (fs [FV_def, context_prefix_rewrite, ssub_thm, TRANS_PREFIX_EQ, IS_PROC_prefix] \\ RW_TAC std_ss [O_DEF] \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) G` >> art [STRONG_EQUIV_REFL] \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Ps) G` >> art [STRONG_EQUIV_REFL] \\ DISJ2_TAC >> Q.EXISTS_TAC `G` >> rw []) - (* Case 3: E = G + G' (not hard) *) - >- (DISCH_THEN (STRIP_ASSUME_TAC o (REWRITE_RULE [context_sum_rewrite])) \\ - DISCH_THEN (STRIP_ASSUME_TAC o (REWRITE_RULE [UNION_SUBSET, FV_def])) \\ - DISCH_THEN (STRIP_ASSUME_TAC o - (REWRITE_RULE [CCS_SUBST_def, BV_def, DISJOINT_UNION])) \\ - DISCH_THEN (STRIP_ASSUME_TAC o - (REWRITE_RULE [CCS_SUBST_def, BV_def, DISJOINT_UNION])) \\ - DISCH_THEN (STRIP_ASSUME_TAC o (REWRITE_RULE [IS_PROC_sum, CCS_SUBST_def])) \\ - DISCH_THEN (STRIP_ASSUME_TAC o (REWRITE_RULE [IS_PROC_sum, CCS_SUBST_def])) \\ - RW_TAC std_ss [CCS_SUBST_def, TRANS_SUM_EQ] >| (* 4 subgoals *) - [ (* goal 1 (of 4) *) - Q.PAT_X_ASSUM `context Xs G' ==> _` K_TAC \\ - Q.PAT_X_ASSUM `context Xs G ==> _` MP_TAC >> RW_TAC bool_ss [] \\ - POP_ASSUM (MP_TAC o (Q.SPEC `u`)) >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM `!E2. TRANS (CCS_SUBST (fromList Xs Qs) G) u E2 ==> _` K_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPEC `E1`)) >> RW_TAC std_ss [O_DEF] >| + (* 10 subgoals left, E = G + G' (not hard) *) + >- (fs [context_sum_rewrite, TRANS_SUM_EQ] >| (* 2 subgoals *) + [ (* goal 1 (of 2) *) + Q.PAT_X_ASSUM ‘!u. (!E1. [Ps/Xs] G --u-> E1 ==> _) /\ _’ (MP_TAC o (Q.SPEC ‘u’)) \\ + Q.PAT_X_ASSUM ‘!u. (!E1. [Ps/Xs] G' --u-> E1 ==> _) /\ _’ K_TAC \\ + RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM ‘!E1. [Ps/Xs] G --u-> E1 ==> _’ (MP_TAC o (Q.SPEC ‘E1’)) \\ + Q.PAT_X_ASSUM ‘!E2. [Qs/Xs] G --u-> E2 ==> _’ K_TAC \\ + RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) [ (* goal 1.1 (of 2) *) - Q.EXISTS_TAC `E2` >> CONJ_TAC >- (DISJ1_TAC >> art []) \\ + Q.EXISTS_TAC `E2` >> simp [] \\ Q.EXISTS_TAC `E2` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ `STRONG_EQUIV E1 E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ Q.EXISTS_TAC `E2` >> art [] \\ - Know `IS_PROC E2` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`CCS_SUBST (fromList Xs Qs) G`, `u`] >> art []) \\ - Know `DISJOINT (BV E2) (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (CCS_SUBST (fromList Xs Qs) G)` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `u` >> art []) >> rw [], + MATCH_MP_TAC TRANS_PROC \\ + take [`CCS_SUBST (fromList Xs Qs) G`, `u`] >> art [], (* goal 1.2 (of 2) *) - Q.EXISTS_TAC `E2` \\ - CONJ_TAC >- (DISJ1_TAC >> art []) \\ + Q.EXISTS_TAC `E2` >> simp [] \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) G''` >> art [] \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Ps) G''` >> art [] \\ DISJ2_TAC >> Q.EXISTS_TAC `G''` >> art [] ], - (* goal 2 (of 4) *) - Q.PAT_X_ASSUM `context Xs G ==> _` K_TAC \\ - Q.PAT_X_ASSUM `context Xs G' ==> _` MP_TAC >> RW_TAC bool_ss [] \\ - POP_ASSUM (MP_TAC o (Q.SPEC `u`)) >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM `!E2. TRANS (CCS_SUBST (fromList Xs Qs) G') u E2 ==> _` K_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPEC `E1`)) >> RW_TAC std_ss [O_DEF] >| + (* goal 2 (of 2) *) + Q.PAT_X_ASSUM ‘!u. (!E1. [Ps/Xs] G --u-> E1 ==> _) /\ _’ K_TAC \\ + Q.PAT_X_ASSUM ‘!u. (!E1. [Ps/Xs] G' --u-> E1 ==> _) /\ _’ (MP_TAC o (Q.SPEC ‘u’)) \\ + RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM ‘!E1. [Ps/Xs] G' --u-> E1 ==> _’ (MP_TAC o (Q.SPEC ‘E1’)) \\ + Q.PAT_X_ASSUM ‘!E2. [Qs/Xs] G' --u-> E2 ==> _’ K_TAC \\ + RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) [ (* goal 2.1 (of 2) *) - Q.EXISTS_TAC `E2` \\ - CONJ_TAC >- (DISJ2_TAC >> art []) \\ + Q.EXISTS_TAC `E2` >> simp [] \\ Q.EXISTS_TAC `E2` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ `STRONG_EQUIV E1 E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ Q.EXISTS_TAC `E2` >> art [] \\ - Know `IS_PROC E2` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`CCS_SUBST (fromList Xs Qs) G'`, `u`] >> art []) \\ - Know `DISJOINT (BV E2) (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (CCS_SUBST (fromList Xs Qs) G')` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `u` >> art []) >> rw [], + MATCH_MP_TAC TRANS_PROC \\ + take [`CCS_SUBST (fromList Xs Qs) G'`, `u`] >> art [], (* goal 2.2 (of 2) *) - Q.EXISTS_TAC `E2` >> CONJ_TAC >- (DISJ2_TAC >> art []) \\ + Q.EXISTS_TAC `E2` >> simp [] \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) G''` >> art [] \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Ps) G''` >> art [] \\ - DISJ2_TAC >> Q.EXISTS_TAC `G''` >> art [] ], - (* goal 3 (of 4) *) - Q.PAT_X_ASSUM `context Xs G' ==> _` K_TAC \\ - Q.PAT_X_ASSUM `context Xs G ==> _` MP_TAC >> RW_TAC bool_ss [] \\ - POP_ASSUM (MP_TAC o (Q.SPEC `u`)) >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM `!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u E1 ==> _` K_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPEC `E2`)) >> RW_TAC std_ss [O_DEF] >| - [ (* goal 3.1 (of 2) *) - Q.EXISTS_TAC `E1` >> CONJ_TAC >- (DISJ1_TAC >> art []) \\ + DISJ2_TAC >> Q.EXISTS_TAC `G''` >> art [] ] ]) + (* 9 subgoals *) + >- (fs [context_sum_rewrite, TRANS_SUM_EQ] >| (* 2 subgoals *) + [ (* goal 1 (of 2) *) + Q.PAT_X_ASSUM ‘!u. (!E1. [Ps/Xs] G --u-> E1 ==> _) /\ _’ (MP_TAC o (Q.SPEC ‘u’)) \\ + Q.PAT_X_ASSUM ‘!u. (!E1. [Ps/Xs] G' --u-> E1 ==> _) /\ _’ K_TAC \\ + RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM ‘!E1. [Ps/Xs] G --u-> E1 ==> _’ K_TAC \\ + Q.PAT_X_ASSUM ‘!E2. [Qs/Xs] G --u-> E2 ==> _’ (MP_TAC o (Q.SPEC ‘E2’)) \\ + RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) + [ (* goal 1.1 (of 2) *) + Q.EXISTS_TAC `E1` >> simp [] \\ Q.EXISTS_TAC `E2` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ `STRONG_EQUIV E1 E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ Q.EXISTS_TAC `E2` >> art [] \\ - Know `IS_PROC E2` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`CCS_SUBST (fromList Xs Qs) G`, `u`] >> art []) \\ - Know `DISJOINT (BV E2) (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (CCS_SUBST (fromList Xs Qs) G)` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `u` >> art []) >> rw [], - (* goal 3.2 (of 2) *) - Q.EXISTS_TAC `E1` \\ - CONJ_TAC >- (DISJ1_TAC >> art []) \\ + MATCH_MP_TAC TRANS_PROC \\ + take [`CCS_SUBST (fromList Xs Qs) G`, `u`] >> art [], + (* goal 1.2 (of 2) *) + Q.EXISTS_TAC `E1` >> simp [] \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) G''` >> art [] \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Ps) G''` >> art [] \\ DISJ2_TAC >> Q.EXISTS_TAC `G''` >> art [] ], - (* goal 4 (of 4) *) - Q.PAT_X_ASSUM `context Xs G ==> _` K_TAC \\ - Q.PAT_X_ASSUM `context Xs G' ==> _` MP_TAC >> RW_TAC bool_ss [] \\ - POP_ASSUM (MP_TAC o (Q.SPEC `u`)) >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM `!E1. TRANS (CCS_SUBST (fromList Xs Ps) G') u E1 ==> _` K_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPEC `E2`)) >> RW_TAC std_ss [O_DEF] >| + (* goal 2 (of 2) *) + Q.PAT_X_ASSUM ‘!u. (!E1. [Ps/Xs] G --u-> E1 ==> _) /\ _’ K_TAC \\ + Q.PAT_X_ASSUM ‘!u. (!E1. [Ps/Xs] G' --u-> E1 ==> _) /\ _’ (MP_TAC o (Q.SPEC ‘u’)) \\ + RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM ‘!E1. [Ps/Xs] G' --u-> E1 ==> _’ K_TAC \\ + Q.PAT_X_ASSUM ‘!E2. [Qs/Xs] G' --u-> E2 ==> _’ (MP_TAC o (Q.SPEC ‘E2’)) \\ + RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) [ (* goal 1.1 (of 2) *) - Q.EXISTS_TAC `E1` >> CONJ_TAC >- (DISJ2_TAC >> art []) \\ + Q.EXISTS_TAC `E1` >> simp [] \\ Q.EXISTS_TAC `E2` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ `STRONG_EQUIV E1 E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ Q.EXISTS_TAC `E2` >> art [] \\ - Know `IS_PROC E2` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`CCS_SUBST (fromList Xs Qs) G'`, `u`] >> art []) \\ - Know `DISJOINT (BV E2) (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (CCS_SUBST (fromList Xs Qs) G')` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `u` >> art []) >> rw [], + MATCH_MP_TAC TRANS_PROC \\ + take [`CCS_SUBST (fromList Xs Qs) G'`, `u`] >> art [], (* goal 1.2 (of 2) *) - Q.EXISTS_TAC `E1` >> CONJ_TAC >- (DISJ2_TAC >> art []) \\ + Q.EXISTS_TAC `E1` >> simp [] \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Qs) G''` >> art [] \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Ps) G''` >> art [] \\ DISJ2_TAC >> Q.EXISTS_TAC `G''` >> art [] ] ]) - (* Case 4: E = G || G' (hard) *) - >- (DISCH_THEN (STRIP_ASSUME_TAC o (REWRITE_RULE [context_par_rewrite])) \\ - DISCH_THEN (STRIP_ASSUME_TAC o (REWRITE_RULE [UNION_SUBSET, FV_def])) \\ - DISCH_THEN (STRIP_ASSUME_TAC o - (REWRITE_RULE [CCS_SUBST_def, BV_def, DISJOINT_UNION])) \\ - DISCH_THEN (STRIP_ASSUME_TAC o - (REWRITE_RULE [CCS_SUBST_def, BV_def, DISJOINT_UNION])) \\ - DISCH_THEN (STRIP_ASSUME_TAC o (REWRITE_RULE [IS_PROC_par, CCS_SUBST_def])) \\ - DISCH_THEN (STRIP_ASSUME_TAC o (REWRITE_RULE [IS_PROC_par, CCS_SUBST_def])) \\ - RW_TAC std_ss [CCS_SUBST_def] >| (* 2 subgoals *) - [ (* goal 1 (of 2) *) - Q.PAT_X_ASSUM `context Xs G' ==> _` MP_TAC >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM `context Xs G ==> _` MP_TAC >> RW_TAC bool_ss [] \\ - Q.ABBREV_TAC `GP = CCS_SUBST (fromList Xs Ps) G` \\ - Q.ABBREV_TAC `GQ = CCS_SUBST (fromList Xs Qs) G` \\ - Q.ABBREV_TAC `G'P = CCS_SUBST (fromList Xs Ps) G'` \\ - Q.ABBREV_TAC `G'Q = CCS_SUBST (fromList Xs Qs) G'` \\ - IMP_RES_TAC TRANS_PAR >| (* 3 subgoals from: GP || G'P --u-> E1 *) - [ (* goal 1.1 (of 3): + (* 8 subgoals: E = G || G' (hard) *) + >- (fs [context_par_rewrite] \\ + Q.ABBREV_TAC `GP = CCS_SUBST (fromList Xs Ps) G` \\ + Q.ABBREV_TAC `GQ = CCS_SUBST (fromList Xs Qs) G` \\ + Q.ABBREV_TAC `G'P = CCS_SUBST (fromList Xs Ps) G'` \\ + Q.ABBREV_TAC `G'Q = CCS_SUBST (fromList Xs Qs) G'` \\ + IMP_RES_TAC TRANS_PAR >| (* 3 subgoals from: GP || G'P --u-> E1 *) + [ (* goal 1 (of 3): GP --u-> E1' /\ (E1 = E1' || G'P), GP || G'P --u-> (E1 = E1' || G'P) - *) - Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` K_TAC \\ - Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` - (MP_TAC o (Q.SPEC `u`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `!E2. TRANS GQ u E2 => _` K_TAC \\ - Q.PAT_X_ASSUM `!E1. TRANS GP u E1 => _` - (MP_TAC o (Q.SPEC `E1'`)) >> RW_TAC std_ss [] \\ - POP_ASSUM (STRIP_ASSUME_TAC o (SIMP_RULE std_ss [O_DEF])) - >- (fs [] >> Q.PAT_X_ASSUM `x' = y` K_TAC \\ - Q.EXISTS_TAC `E2 || G'Q` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR1 >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - `STRONG_EQUIV E1' E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ - (* stage work *) - Q.EXISTS_TAC `y || G'Q` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ - Q.EXISTS_TAC `y || G'P` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ - ASM_SIMP_TAC std_ss [IS_PROC_par, BV_def, DISJOINT_UNION] \\ - DISJ2_TAC >> Q.EXISTS_TAC `y || G'` \\ - ASM_SIMP_TAC (srw_ss()) [context_par_rewrite, - FV_def, CCS_SUBST_def, UNION_SUBSET] \\ - STRONG_CONJ_TAC (* `context Xs y` *) - >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ - CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ - CONJ_TAC \\ (* s subgoals, same tactics *) - MATCH_MP_TAC EQ_SYM \\ - MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) \\ + *) + Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` K_TAC \\ + Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` + (MP_TAC o (Q.SPEC `u`)) >> RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM `!E1. TRANS GP u E1 => _` (MP_TAC o (Q.SPEC `E1'`))\\ + Q.PAT_X_ASSUM `!E2. TRANS GQ u E2 => _` K_TAC \\ + RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) + [ (* goal 1.1 (of 2) *) Q.EXISTS_TAC `E2 || G'Q` \\ CONJ_TAC >- (MATCH_MP_TAC PAR1 >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ + `STRONG_EQUIV E1' E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ + rename1 ‘closed y’ \\ Q.EXISTS_TAC `y || G'Q` \\ reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ - rename1 `STRONG_EQUIV E1' x'` \\ - Q.EXISTS_TAC `x' || G'P` \\ + Q.EXISTS_TAC `y || G'P` \\ CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION] \\ - DISJ2_TAC >> Q.EXISTS_TAC `G'' || G'` \\ - ASM_SIMP_TAC lset_ss [context_par_rewrite, - FV_def, CCS_SUBST_def, UNION_SUBSET], - (* goal 1.2 (of 3): + ASM_SIMP_TAC std_ss [IS_PROC_par, DISJOINT_UNION] \\ + DISJ2_TAC >> Q.EXISTS_TAC `y || G'` \\ + ASM_SIMP_TAC (srw_ss()) [context_par_rewrite, + FV_def, CCS_SUBST_def, UNION_SUBSET] \\ + STRONG_CONJ_TAC (* `context Xs y` *) + >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ + ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ + CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ + CONJ_TAC \\ (* s subgoals, same tactics *) + MATCH_MP_TAC EQ_SYM \\ + MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ + ASM_SET_TAC [IS_PROC_def], + (* goal 1.2 (of 2) *) + Q.EXISTS_TAC `E2 || G'Q` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR1 >> art []) \\ + qabbrev_tac ‘x = [Ps/Xs] G''’ \\ + qabbrev_tac ‘y = [Qs/Xs] G''’ \\ + Q.EXISTS_TAC `y || G'Q` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ + Q.EXISTS_TAC `x || G'P` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ + fs [IS_PROC_par, DISJOINT_UNION] \\ + DISJ2_TAC >> Q.EXISTS_TAC ‘G'' || G'’ \\ + rw [Abbr ‘x’, Abbr ‘y’, Abbr ‘G'P’, Abbr ‘G'Q’, context_par_rewrite] ], + (* goal 2 (of 3): G'P --u-> E1' /\ (E1 = GP || E1') GP || G'P --u-> (E1 = GP || E1') - *) - Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` K_TAC \\ - Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` - (MP_TAC o (Q.SPEC `u`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `!E2. TRANS G'Q u E2 ==> _` K_TAC \\ - Q.PAT_X_ASSUM `!E1. TRANS G'P u E1 => _` - (MP_TAC o (Q.SPEC `E1'`)) >> RW_TAC std_ss [] \\ - POP_ASSUM (STRIP_ASSUME_TAC o (SIMP_RULE std_ss [O_DEF])) - >- (fs [] >> Q.PAT_X_ASSUM `x' = y` K_TAC \\ - Q.EXISTS_TAC `GQ || E2` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR2 >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - `STRONG_EQUIV E1' E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ - (* stage work *) - Q.EXISTS_TAC `GQ || y` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ - Q.EXISTS_TAC `GP || y` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ - ASM_SIMP_TAC std_ss [IS_PROC_par, BV_def, DISJOINT_UNION] \\ - DISJ2_TAC >> Q.EXISTS_TAC `G || y` \\ - ASM_SIMP_TAC (srw_ss()) [context_par_rewrite, - FV_def, CCS_SUBST_def, UNION_SUBSET] \\ - STRONG_CONJ_TAC (* `context Xs y` *) - >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ - CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ - CONJ_TAC \\ (* s subgoals, same tactics *) - MATCH_MP_TAC EQ_SYM \\ - MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) \\ + *) + Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` K_TAC \\ + Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` + (MP_TAC o (Q.SPEC `u`)) >> RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM `!E2. TRANS G'Q u E2 ==> _` K_TAC \\ + Q.PAT_X_ASSUM `!E1. TRANS G'P u E1 => _` (MP_TAC o (Q.SPEC `E1'`)) \\ + RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) + [ (* goal 2.1 (of 2) *) Q.EXISTS_TAC `GQ || E2` \\ CONJ_TAC >- (MATCH_MP_TAC PAR2 >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ + `STRONG_EQUIV E1' E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ + rename1 ‘closed y’ \\ Q.EXISTS_TAC `GQ || y` \\ reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ - rename1 `STRONG_EQUIV E1' x'` \\ - Q.EXISTS_TAC `GP || x'` \\ + Q.EXISTS_TAC `GP || y` \\ CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION] \\ + ASM_SIMP_TAC std_ss [IS_PROC_par, DISJOINT_UNION] \\ + DISJ2_TAC >> Q.EXISTS_TAC `G || y` \\ + ASM_SIMP_TAC (srw_ss()) [context_par_rewrite, + FV_def, CCS_SUBST_def, UNION_SUBSET] \\ + STRONG_CONJ_TAC (* `context Xs y` *) + >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ + ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ + CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ + CONJ_TAC \\ (* s subgoals, same tactics *) + MATCH_MP_TAC EQ_SYM \\ + MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ + ASM_SET_TAC [IS_PROC_def], + (* goal 2.2 (of 2) *) + Q.EXISTS_TAC `GQ || E2` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR2 >> art []) \\ + qabbrev_tac ‘x = [Ps/Xs] G''’ \\ + qabbrev_tac ‘y = [Qs/Xs] G''’ \\ + Q.EXISTS_TAC `GQ || y` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ + Q.EXISTS_TAC `GP || x` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ + fs [IS_PROC_par, DISJOINT_UNION] \\ DISJ2_TAC >> Q.EXISTS_TAC `G || G''` \\ - ASM_SIMP_TAC lset_ss [context_par_rewrite, - FV_def, CCS_SUBST_def, UNION_SUBSET], - (* goal 1.3 (of 3): + rw [Abbr ‘x’, Abbr ‘y’, Abbr ‘GP’, Abbr ‘GQ’, context_par_rewrite] ], + (* goal 3 (of 3): GP --label l-> E1' /\ G'P --label (COMPL l)-> E2 GP || G'P --tau-> (E1 = E1' || E2) - *) - Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` - (MP_TAC o (Q.SPEC `label l`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` - (MP_TAC o (Q.SPEC `label (COMPL l)`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `!E2. TRANS GQ (label l) E2 ==> _` K_TAC \\ - Q.PAT_X_ASSUM `!E2. TRANS G'Q (label (COMPL l)) E2 ==> _` K_TAC \\ - Q.PAT_X_ASSUM `!E1. TRANS GP (label l) E1 => _` - (MP_TAC o (Q.SPEC `E1'`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `!E1. TRANS G'P (label (COMPL l)) E1 => _` - (MP_TAC o (Q.SPEC `E2`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `_ E1' E2'` (MP_TAC o (SIMP_RULE std_ss [O_DEF])) \\ - Q.PAT_X_ASSUM `_ E2 E2''` (MP_TAC o (SIMP_RULE std_ss [O_DEF])) \\ - RW_TAC std_ss [] >| (* 4 subgoals *) - [ (* goal 1.3.1 (of 4) *) - Q.EXISTS_TAC `E2' || E2''` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - rename1 `STRONG_EQUIV y E2'` \\ - rename1 `STRONG_EQUIV E2 x` \\ - Q.EXISTS_TAC `y || x` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - Q.EXISTS_TAC `y || x` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION], - (* goal 1.3.2 (of 4) *) - Q.EXISTS_TAC `E2' || E2''` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - rename1 `STRONG_EQUIV E2 y` \\ - Q.EXISTS_TAC `(CCS_SUBST (fromList Xs Qs) G'') || y` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - Q.EXISTS_TAC `(CCS_SUBST (fromList Xs Ps) G'') || y` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION] \\ - DISJ2_TAC >> Q.EXISTS_TAC `G'' || y` \\ - fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] \\ - STRONG_CONJ_TAC (* `context Xs y` *) - >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ - CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ - CONJ_TAC \\ (* s subgoals, same tactics *) - MATCH_MP_TAC EQ_SYM \\ - MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ - ASM_SET_TAC [IS_PROC_def], - (* goal 1.3.3 (of 4) *) - Q.EXISTS_TAC `E2' || E2''` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - rename1 `STRONG_EQUIV y E2'` \\ - Q.EXISTS_TAC `y || (CCS_SUBST (fromList Xs Qs) G'')` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - Q.EXISTS_TAC `y || (CCS_SUBST (fromList Xs Ps) G'')` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION] \\ - DISJ2_TAC >> Q.EXISTS_TAC `y || G''` \\ - fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] \\ - STRONG_CONJ_TAC (* `context Xs y` *) - >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ - CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ - CONJ_TAC \\ (* s subgoals, same tactics *) - MATCH_MP_TAC EQ_SYM \\ - MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ - ASM_SET_TAC [IS_PROC_def], - (* goal 1.3.4 (of 4) *) - Q.EXISTS_TAC `E2' || E2''` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - Q.EXISTS_TAC `par (CCS_SUBST (fromList Xs Qs) G''') - (CCS_SUBST (fromList Xs Qs) G'')` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - Q.EXISTS_TAC `par (CCS_SUBST (fromList Xs Ps) G''') - (CCS_SUBST (fromList Xs Ps) G'')` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION] \\ - DISJ2_TAC >> Q.EXISTS_TAC `G''' || G''` \\ - fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] ] ], - (* goal 2 (of 2) *) - Q.PAT_X_ASSUM `context Xs G' ==> _` MP_TAC >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM `context Xs G ==> _` MP_TAC >> RW_TAC bool_ss [] \\ - Q.ABBREV_TAC `GP = CCS_SUBST (fromList Xs Ps) G` \\ - Q.ABBREV_TAC `GQ = CCS_SUBST (fromList Xs Qs) G` \\ - Q.ABBREV_TAC `G'P = CCS_SUBST (fromList Xs Ps) G'` \\ - Q.ABBREV_TAC `G'Q = CCS_SUBST (fromList Xs Qs) G'` \\ - IMP_RES_TAC TRANS_PAR >| (* 3 subgoals from: GQ || G'Q --u-> E2 *) - [ (* goal 2.1 (of 3): + *) + Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` + (MP_TAC o (Q.SPEC `label l`)) >> RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` + (MP_TAC o (Q.SPEC `label (COMPL l)`)) >> RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM `!E2. TRANS GQ (label l) E2 ==> _` K_TAC \\ + Q.PAT_X_ASSUM `!E2. TRANS G'Q (label (COMPL l)) E2 ==> _` K_TAC \\ + Q.PAT_X_ASSUM `!E1. TRANS GP (label l) E1 => _` + (MP_TAC o (Q.SPEC `E1'`)) >> RW_TAC std_ss [O_DEF] \\ + Q.PAT_X_ASSUM `!E1. TRANS G'P (label (COMPL l)) E1 => _` + (MP_TAC o (Q.SPEC `E2`)) >> RW_TAC std_ss [O_DEF] >| (* 4 subgoals *) + [ (* goal 3.1 (of 4) *) + Q.EXISTS_TAC `E2' || E2''` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ + rename1 `STRONG_EQUIV y E2'` \\ + rename1 `STRONG_EQUIV x E2''` \\ + Q.EXISTS_TAC `y || x` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + Q.EXISTS_TAC `y || x` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + fs [IS_PROC_par, DISJOINT_UNION], + (* goal 3.2 (of 4) *) + Q.EXISTS_TAC `E2' || E2''` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ + qabbrev_tac ‘x = [Ps/Xs] G''’ \\ + qabbrev_tac ‘y = [Qs/Xs] G''’ \\ + Q.EXISTS_TAC `x' || y` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + Q.EXISTS_TAC `x' || x` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + fs [IS_PROC_par, DISJOINT_UNION] \\ + DISJ2_TAC >> Q.EXISTS_TAC `x' || G''` \\ + fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] \\ + STRONG_CONJ_TAC (* `context Xs y` *) + >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ + ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ + CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ + CONJ_TAC \\ (* s subgoals, same tactics *) + MATCH_MP_TAC EQ_SYM \\ + MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ + ASM_SET_TAC [IS_PROC_def], + (* goal 3.3 (of 4) *) + Q.EXISTS_TAC `E2' || E2''` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ + qabbrev_tac ‘y = [Qs/Xs] G''’ \\ + qabbrev_tac ‘x = [Ps/Xs] G''’ \\ + Q.EXISTS_TAC `y || x'` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + Q.EXISTS_TAC `x || x'` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + fs [IS_PROC_par, DISJOINT_UNION] \\ + DISJ2_TAC >> Q.EXISTS_TAC `G'' || x'` \\ + fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] \\ + STRONG_CONJ_TAC (* `context Xs y` *) + >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ + ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ + CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ + CONJ_TAC \\ (* s subgoals, same tactics *) + MATCH_MP_TAC EQ_SYM \\ + MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ + ASM_SET_TAC [IS_PROC_def], + (* goal 3.4 (of 4) *) + Q.EXISTS_TAC `E2' || E2''` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ + Q.EXISTS_TAC `par (CCS_SUBST (fromList Xs Qs) G'') + (CCS_SUBST (fromList Xs Qs) G''')` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + Q.EXISTS_TAC `par (CCS_SUBST (fromList Xs Ps) G'') + (CCS_SUBST (fromList Xs Ps) G''')` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + fs [IS_PROC_par, DISJOINT_UNION] \\ + DISJ2_TAC >> Q.EXISTS_TAC `G'' || G'''` \\ + fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] ] ]) + (* 7 subgoals left *) + >- (fs [context_par_rewrite] \\ + Q.ABBREV_TAC `GP = CCS_SUBST (fromList Xs Ps) G` \\ + Q.ABBREV_TAC `GQ = CCS_SUBST (fromList Xs Qs) G` \\ + Q.ABBREV_TAC `G'P = CCS_SUBST (fromList Xs Ps) G'` \\ + Q.ABBREV_TAC `G'Q = CCS_SUBST (fromList Xs Qs) G'` \\ + IMP_RES_TAC TRANS_PAR >| (* 3 subgoals from: GQ || G'Q --u-> E2 *) + [ (* goal 1 (of 3): GQ --u-> E1 /\ (E2 = E1 || G'Q), GQ || G'Q --u-> (E2 = E1 || G'Q) - *) - Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` K_TAC \\ - Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` - (MP_TAC o (Q.SPEC `u`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `!E1. TRANS GP u E1 => _` K_TAC \\ - Q.PAT_X_ASSUM `!E2. TRANS GQ u E2 => _` - (MP_TAC o (Q.SPEC `E1`)) >> RW_TAC std_ss [] \\ - POP_ASSUM (STRIP_ASSUME_TAC o (SIMP_RULE std_ss [O_DEF])) - >- (fs [] >> Q.PAT_X_ASSUM `x' = y` K_TAC \\ - Q.EXISTS_TAC `E1' || G'P` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR1 >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - `STRONG_EQUIV E1' E1` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ - (* stage work *) - Q.EXISTS_TAC `y || G'Q` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ - Q.EXISTS_TAC `y || G'P` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ - ASM_SIMP_TAC std_ss [IS_PROC_par, BV_def, DISJOINT_UNION] \\ - DISJ2_TAC >> Q.EXISTS_TAC `y || G'` \\ - ASM_SIMP_TAC (srw_ss()) [context_par_rewrite, - FV_def, CCS_SUBST_def, UNION_SUBSET] \\ - STRONG_CONJ_TAC (* `context Xs y` *) - >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ - CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ - CONJ_TAC \\ (* s subgoals, same tactics *) - MATCH_MP_TAC EQ_SYM \\ - MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) \\ + *) + Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` K_TAC \\ + Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` + (MP_TAC o (Q.SPEC `u`)) >> RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM `!E1. TRANS GP u E1 => _` K_TAC \\ + Q.PAT_X_ASSUM `!E2. TRANS GQ u E2 => _` + (MP_TAC o (Q.SPEC `E1`)) >> RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) + [ (* goal 1.1 (of 2) *) Q.EXISTS_TAC `E1' || G'P` \\ CONJ_TAC >- (MATCH_MP_TAC PAR1 >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ + `STRONG_EQUIV E1' E1` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ + rename1 ‘closed y’ \\ Q.EXISTS_TAC `y || G'Q` \\ reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ - rename1 `STRONG_EQUIV E1' x'` \\ - Q.EXISTS_TAC `x' || G'P` \\ + Q.EXISTS_TAC `y || G'P` \\ CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION] \\ + ASM_SIMP_TAC std_ss [IS_PROC_par, DISJOINT_UNION] \\ + DISJ2_TAC >> Q.EXISTS_TAC `y || G'` \\ + ASM_SIMP_TAC (srw_ss()) [context_par_rewrite, + FV_def, CCS_SUBST_def, UNION_SUBSET] \\ + STRONG_CONJ_TAC (* `context Xs y` *) + >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ + ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ + CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ + CONJ_TAC \\ (* 2 subgoals, same tactics *) + MATCH_MP_TAC EQ_SYM \\ + MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ + ASM_SET_TAC [IS_PROC_def], + (* goal 1.2 (of 2) *) + Q.EXISTS_TAC `E1' || G'P` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR1 >> art []) \\ + qabbrev_tac ‘y = [Qs/Xs] G''’ \\ + Q.EXISTS_TAC `y || G'Q` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ + qabbrev_tac ‘x = [Ps/Xs] G''’ \\ + Q.EXISTS_TAC `x || G'P` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_R >> art []) \\ + fs [IS_PROC_par, DISJOINT_UNION] \\ DISJ2_TAC >> Q.EXISTS_TAC `G'' || G'` \\ ASM_SIMP_TAC lset_ss [context_par_rewrite, - FV_def, CCS_SUBST_def, UNION_SUBSET], - (* goal 1.2 (of 3): + FV_def, CCS_SUBST_def, UNION_SUBSET] ], + (* goal 2 (of 3): G'Q --u-> E1 /\ (E2 = GQ || E1) GQ || G'Q --u-> (E2 = GQ || E1) - *) - Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` K_TAC \\ - Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` - (MP_TAC o (Q.SPEC `u`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `!E1. TRANS G'P u E1 => _` K_TAC \\ - Q.PAT_X_ASSUM `!E2. TRANS G'Q u E2 ==> _` - (MP_TAC o (Q.SPEC `E1`)) >> RW_TAC std_ss [] \\ - POP_ASSUM (STRIP_ASSUME_TAC o (SIMP_RULE std_ss [O_DEF])) - >- (fs [] >> Q.PAT_X_ASSUM `x' = y` K_TAC \\ - Q.EXISTS_TAC `GP || E1'` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR2 >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - (* stage work *) - Q.EXISTS_TAC `GQ || y` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ - Q.EXISTS_TAC `GP || y` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ - ASM_SIMP_TAC std_ss [IS_PROC_par, BV_def, DISJOINT_UNION] \\ - DISJ2_TAC >> Q.EXISTS_TAC `G || y` \\ - ASM_SIMP_TAC (srw_ss()) [context_par_rewrite, - FV_def, CCS_SUBST_def, UNION_SUBSET] \\ - STRONG_CONJ_TAC (* `context Xs y` *) - >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ - CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ - CONJ_TAC \\ (* s subgoals, same tactics *) - MATCH_MP_TAC EQ_SYM \\ - MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) \\ + *) + Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` K_TAC \\ + Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` + (MP_TAC o (Q.SPEC `u`)) >> RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM `!E1. TRANS G'P u E1 => _` K_TAC \\ + Q.PAT_X_ASSUM `!E2. TRANS G'Q u E2 ==> _` + (MP_TAC o (Q.SPEC `E1`)) >> RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) + [ (* goal 2.1 (of 2) *) + Q.EXISTS_TAC `GP || E1'` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR2 >> art []) \\ + rename1 ‘closed y’ \\ + Q.EXISTS_TAC `GQ || y` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ + Q.EXISTS_TAC `GP || y` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ + ASM_SIMP_TAC std_ss [IS_PROC_par, DISJOINT_UNION] \\ + DISJ2_TAC >> Q.EXISTS_TAC `G || y` \\ + ASM_SIMP_TAC (srw_ss()) [context_par_rewrite, + FV_def, CCS_SUBST_def, UNION_SUBSET] \\ + STRONG_CONJ_TAC (* `context Xs y` *) + >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ + ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ + CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ + CONJ_TAC \\ (* s subgoals, same tactics *) + MATCH_MP_TAC EQ_SYM \\ + MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ + ASM_SET_TAC [IS_PROC_def], + (* goal 2.2 (of 2) *) Q.EXISTS_TAC `GP || E1'` >> CONJ_TAC >- (MATCH_MP_TAC PAR2 >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ + qabbrev_tac ‘y = [Qs/Xs] G''’ \\ Q.EXISTS_TAC `GQ || y` \\ reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ - rename1 `STRONG_EQUIV E1' x'` \\ - Q.EXISTS_TAC `GP || x'` \\ + qabbrev_tac ‘x = [Ps/Xs] G''’ \\ + Q.EXISTS_TAC `GP || x` \\ CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_SUBST_PAR_L >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION] \\ + fs [IS_PROC_par, DISJOINT_UNION] \\ DISJ2_TAC >> Q.EXISTS_TAC `G || G''` \\ ASM_SIMP_TAC lset_ss [context_par_rewrite, - FV_def, CCS_SUBST_def, UNION_SUBSET], - (* goal 1.3 (of 3): + FV_def, CCS_SUBST_def, UNION_SUBSET] ], + (* goal 3 (of 3): GQ --label l-> E1 /\ G'Q --label (COMPL l)-> E2' GQ || G'Q --tau-> (E2 = E1 || E2') - *) - Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` - (MP_TAC o (Q.SPEC `label l`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` - (MP_TAC o (Q.SPEC `label (COMPL l)`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `!E1. TRANS GP (label l) E1 => _` K_TAC \\ - Q.PAT_X_ASSUM `!E2. TRANS GQ (label l) E2 ==> _` - (MP_TAC o (Q.SPEC `E1`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `!E1. TRANS G'P (label (COMPL l)) E1 => _` K_TAC \\ - Q.PAT_X_ASSUM `!E2. TRANS G'Q (label (COMPL l)) E2 ==> _` - (MP_TAC o (Q.SPEC `E2'`)) >> RW_TAC std_ss [] \\ - Q.PAT_X_ASSUM `_ E1' E1` (MP_TAC o (SIMP_RULE std_ss [O_DEF])) \\ - Q.PAT_X_ASSUM `_ E1'' E2'` (MP_TAC o (SIMP_RULE std_ss [O_DEF])) \\ - RW_TAC std_ss [] >| (* 4 subgoals *) - [ (* goal 1.3.1 (of 4) *) - Q.EXISTS_TAC `E1' || E1''` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - rename1 `STRONG_EQUIV y E2'` \\ - rename1 `STRONG_EQUIV E1' x` \\ - Q.EXISTS_TAC `x || y` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - Q.EXISTS_TAC `x || y` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION], - (* goal 1.3.2 (of 4) *) - Q.EXISTS_TAC `E1' || E1''` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - rename1 `STRONG_EQUIV E1'' y` \\ - Q.EXISTS_TAC `(CCS_SUBST (fromList Xs Qs) G'') || y` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - Q.EXISTS_TAC `(CCS_SUBST (fromList Xs Ps) G'') || y` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION] \\ - DISJ2_TAC >> Q.EXISTS_TAC `G'' || y` \\ - fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] \\ - STRONG_CONJ_TAC (* `context Xs y` *) - >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ - CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ - CONJ_TAC \\ (* s subgoals, same tactics *) - MATCH_MP_TAC EQ_SYM \\ - MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ - ASM_SET_TAC [IS_PROC_def], - (* goal 1.3.3 (of 4) *) - Q.EXISTS_TAC `E1' || E1''` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - rename1 `STRONG_EQUIV y E1` \\ - Q.EXISTS_TAC `y || (CCS_SUBST (fromList Xs Qs) G'')` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - Q.EXISTS_TAC `y || (CCS_SUBST (fromList Xs Ps) G'')` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION] \\ - DISJ2_TAC >> Q.EXISTS_TAC `y || G''` \\ - fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] \\ - STRONG_CONJ_TAC (* `context Xs y` *) - >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ - ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ - CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ - CONJ_TAC \\ (* s subgoals, same tactics *) - MATCH_MP_TAC EQ_SYM \\ - MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ - ASM_SET_TAC [IS_PROC_def], - (* goal 1.3.4 (of 4) *) - Q.EXISTS_TAC `E1' || E1''` \\ - CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ - SIMP_TAC std_ss [O_DEF] \\ - Q.EXISTS_TAC `par (CCS_SUBST (fromList Xs Qs) G''') - (CCS_SUBST (fromList Xs Qs) G'')` \\ - reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - Q.EXISTS_TAC `par (CCS_SUBST (fromList Xs Ps) G''') - (CCS_SUBST (fromList Xs Ps) G'')` \\ - CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ - fs [IS_PROC_par, BV_def, DISJOINT_UNION] \\ - DISJ2_TAC >> Q.EXISTS_TAC `G''' || G''` \\ - fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] ] ] ]) - (* Case 5: E = restr f G (not easy) *) - >- (GEN_TAC \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [context_restr_rewrite])) \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [FV_def])) \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [CCS_SUBST_def, BV_def])) \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [CCS_SUBST_def, BV_def])) \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [IS_PROC_restr, CCS_SUBST_def])) \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [IS_PROC_restr, CCS_SUBST_def])) \\ - Q.PAT_X_ASSUM `context Xs G ==> _` MP_TAC \\ - RW_TAC std_ss [CCS_SUBST_restr, TRANS_RESTR_EQ] >| (* 4 subgoals *) - [ (* goal 1 (of 4) *) + *) + Q.PAT_X_ASSUM `!u. (!E1. TRANS GP u E1 => _) /\ _` + (MP_TAC o (Q.SPEC `label l`)) >> RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM `!u. (!E1. TRANS G'P u E1 => _) /\ _` + (MP_TAC o (Q.SPEC `label (COMPL l)`)) >> RW_TAC std_ss [] \\ + Q.PAT_X_ASSUM `!E1. TRANS GP (label l) E1 => _` K_TAC \\ + Q.PAT_X_ASSUM `!E2. TRANS GQ (label l) E2 ==> _` + (MP_TAC o (Q.SPEC `E1`)) >> RW_TAC std_ss [O_DEF] \\ + Q.PAT_X_ASSUM `!E1. TRANS G'P (label (COMPL l)) E1 => _` K_TAC \\ + Q.PAT_X_ASSUM `!E2. TRANS G'Q (label (COMPL l)) E2 ==> _` + (MP_TAC o (Q.SPEC `E2'`)) >> RW_TAC std_ss [O_DEF] >| (* 4 subgoals *) + [ (* goal 3.1 (of 4) *) + Q.EXISTS_TAC `E1' || E1''` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ + rename1 `STRONG_EQUIV y E2'` \\ + rename1 `STRONG_EQUIV E1' x` \\ + Q.EXISTS_TAC `x || y` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + Q.EXISTS_TAC `x || y` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + fs [IS_PROC_par, DISJOINT_UNION], + (* goal 3.2 (of 4) *) + Q.EXISTS_TAC `E1' || E1''` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ + qabbrev_tac ‘x = [Ps/Xs] G''’ \\ + qabbrev_tac ‘y = [Qs/Xs] G''’ \\ + Q.EXISTS_TAC `x' || y` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + Q.EXISTS_TAC `x' || x` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + fs [IS_PROC_par, DISJOINT_UNION] \\ + DISJ2_TAC >> Q.EXISTS_TAC `x' || G''` \\ + fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] \\ + STRONG_CONJ_TAC (* `context Xs y` *) + >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ + ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ + CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ + CONJ_TAC \\ (* s subgoals, same tactics *) + MATCH_MP_TAC EQ_SYM \\ + MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ + ASM_SET_TAC [IS_PROC_def], + (* goal 3.3 (of 4) *) + Q.EXISTS_TAC `E1' || E1''` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ + qabbrev_tac ‘x = [Ps/Xs] G''’ \\ + qabbrev_tac ‘y = [Qs/Xs] G''’ \\ + Q.EXISTS_TAC `y || x'` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + Q.EXISTS_TAC `x || x'` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + fs [IS_PROC_par, DISJOINT_UNION] \\ + DISJ2_TAC >> Q.EXISTS_TAC `G'' || x'` \\ + fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] \\ + STRONG_CONJ_TAC (* `context Xs y` *) + >- (MATCH_MP_TAC disjoint_imp_context >> art [] \\ + ASM_SET_TAC [IS_PROC_def]) >> DISCH_TAC \\ + CONJ_TAC >- ASM_SET_TAC [IS_PROC_def] \\ + CONJ_TAC \\ (* s subgoals, same tactics *) + MATCH_MP_TAC EQ_SYM \\ + MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ + ASM_SET_TAC [IS_PROC_def], + (* goal 3.4 (of 4) *) + Q.EXISTS_TAC `E1' || E1''` \\ + CONJ_TAC >- (MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` >> art []) \\ + Q.EXISTS_TAC `par (CCS_SUBST (fromList Xs Qs) G'') + (CCS_SUBST (fromList Xs Qs) G''')` \\ + reverse CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + Q.EXISTS_TAC `par (CCS_SUBST (fromList Xs Ps) G'') + (CCS_SUBST (fromList Xs Ps) G''')` \\ + CONJ_TAC >- (MATCH_MP_TAC STRONG_EQUIV_PRESD_BY_PAR >> art []) \\ + fs [IS_PROC_par, DISJOINT_UNION] \\ + DISJ2_TAC >> Q.EXISTS_TAC `G'' || G'''` \\ + fs [context_par_rewrite, FV_def, CCS_SUBST_def, UNION_SUBSET] ] ]) + (* 6 subgoals: E = restr f G (not easy) *) + >- (fs [context_restr_rewrite, TRANS_RESTR_EQ] >| (* 2 subgoals *) + [ (* goal 1 (of 2) *) Q.PAT_X_ASSUM `!u. (!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u E1 ==> _) /\ _` (MP_TAC o (Q.SPEC `tau`)) >> RW_TAC bool_ss [] \\ Q.PAT_X_ASSUM `!E2. TRANS (CCS_SUBST (fromList Xs Qs) G) tau E2 ==> _` K_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| + Q.PAT_X_ASSUM `!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) tau E1 ==> _` + (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) [ (* goal 1.1 (of 2) *) - Q.EXISTS_TAC `restr f E2` \\ + Q.EXISTS_TAC `restr L E2` \\ CONJ_TAC >- (Q.EXISTS_TAC `E2` >> art []) \\ - Q.EXISTS_TAC `restr f E2` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ + Q.EXISTS_TAC `restr L E2` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ `STRONG_EQUIV E'' E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ - `STRONG_EQUIV (restr f E'') (restr f E2)` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f E2` >> art [] \\ - fs [IS_PROC_restr, BV_def] \\ - Know `IS_PROC E2` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`CCS_SUBST (fromList Xs Qs) G`, `tau`] >> art []) \\ - Know `DISJOINT (BV E2) (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (CCS_SUBST (fromList Xs Qs) G)` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `tau` >> art []) >> rw [], + `STRONG_EQUIV (restr L E'') (restr L E2)` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L E2` >> art [] \\ + fs [IS_PROC_restr] \\ + MATCH_MP_TAC TRANS_PROC \\ + take [`CCS_SUBST (fromList Xs Qs) G`, `tau`] >> art [], (* goal 1.2 (of 2) *) - Q.EXISTS_TAC `restr f E2` \\ + Q.EXISTS_TAC `restr L E2` \\ CONJ_TAC >- (Q.EXISTS_TAC `E2` >> art []) \\ - `STRONG_EQUIV (restr f (CCS_SUBST (fromList Xs Qs) G')) (restr f E2)` - by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f (CCS_SUBST (fromList Xs Qs) G')` >> art [] \\ - `STRONG_EQUIV (restr f E'') (restr f (CCS_SUBST (fromList Xs Ps) G'))` - by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f (CCS_SUBST (fromList Xs Ps) G')` >> art [] \\ - fs [IS_PROC_restr, BV_def] \\ - DISJ2_TAC >> Q.EXISTS_TAC `restr f G'` \\ + qabbrev_tac ‘y = [Qs/Xs] G'’ \\ + `STRONG_EQUIV (restr L y) (restr L E2)` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L y` >> art [] \\ + qabbrev_tac ‘x = [Ps/Xs] G'’ \\ + `STRONG_EQUIV (restr L E'') (restr L x)` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L x` >> art [] \\ + fs [IS_PROC_restr] \\ + DISJ2_TAC >> Q.EXISTS_TAC `restr L G'` \\ CONJ_TAC >- (MATCH_MP_TAC context_restr_rule >> art []) \\ - ASM_REWRITE_TAC [FV_def, CCS_SUBST_restr] ], - (* goal 2 (of 4) *) + rw [FV_def, ssub_thm] ], + (* goal 2 (of 2) *) Q.PAT_X_ASSUM `!u. (!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u E1 ==> _) /\ _` (MP_TAC o (Q.SPEC `label l`)) >> RW_TAC bool_ss [] \\ Q.PAT_X_ASSUM `!E2. TRANS (CCS_SUBST (fromList Xs Qs) G) (label l) E2 ==> _` K_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| + Q.PAT_X_ASSUM + `!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) (label l) E1 ==> _` + (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) [ (* goal 2.1 (of 2) *) - Q.EXISTS_TAC `restr f E2` \\ + Q.EXISTS_TAC `restr L E2` \\ CONJ_TAC >- (Q.EXISTS_TAC `E2` >> art []) \\ - Q.EXISTS_TAC `restr f E2` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ + Q.EXISTS_TAC `restr L E2` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ `STRONG_EQUIV E'' E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ - `STRONG_EQUIV (restr f E'') (restr f E2)` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f E2` >> art [] \\ - fs [IS_PROC_restr, BV_def] \\ - Know `IS_PROC E2` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`CCS_SUBST (fromList Xs Qs) G`, `label l`] >> art []) \\ - Know `DISJOINT (BV E2) (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (CCS_SUBST (fromList Xs Qs) G)` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `label l` >> art []) >> rw [], + `STRONG_EQUIV (restr L E'') (restr L E2)` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L E2` >> art [] \\ + fs [IS_PROC_restr] \\ + MATCH_MP_TAC TRANS_PROC \\ + take [`CCS_SUBST (fromList Xs Qs) G`, `label l`] >> art [], (* goal 2.2 (of 2) *) - Q.EXISTS_TAC `restr f E2` \\ + Q.EXISTS_TAC `restr L E2` \\ CONJ_TAC >- (Q.EXISTS_TAC `E2` >> art []) \\ - `STRONG_EQUIV (restr f (CCS_SUBST (fromList Xs Qs) G')) (restr f E2)` - by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f (CCS_SUBST (fromList Xs Qs) G')` >> art [] \\ - `STRONG_EQUIV (restr f E'') (restr f (CCS_SUBST (fromList Xs Ps) G'))` - by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f (CCS_SUBST (fromList Xs Ps) G')` >> art [] \\ - fs [IS_PROC_restr, BV_def] \\ - DISJ2_TAC >> Q.EXISTS_TAC `restr f G'` \\ + qabbrev_tac ‘y = [Qs/Xs] G'’ \\ + `STRONG_EQUIV (restr L y) (restr L E2)` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L y` >> art [] \\ + qabbrev_tac ‘x = [Ps/Xs] G'’ \\ + `STRONG_EQUIV (restr L E'') (restr L x)` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L x` >> art [] \\ + fs [IS_PROC_restr] \\ + DISJ2_TAC >> Q.EXISTS_TAC `restr L G'` \\ CONJ_TAC >- (MATCH_MP_TAC context_restr_rule >> art []) \\ - ASM_REWRITE_TAC [FV_def, CCS_SUBST_restr] ], - (* goal 3 (of 4) *) + rw [FV_def, ssub_thm] ] ]) + (* 5 subgoals: E = restr f G (not easy) *) + >- (fs [context_restr_rewrite, TRANS_RESTR_EQ] >| (* 2 subgoals *) + [ (* goal 1 (of 2) *) Q.PAT_X_ASSUM `!u. (!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u E1 ==> _) /\ _` (MP_TAC o (Q.SPEC `tau`)) >> RW_TAC bool_ss [] \\ Q.PAT_X_ASSUM `!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) tau E1 ==> _` K_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| + Q.PAT_X_ASSUM `!E2. TRANS (CCS_SUBST (fromList Xs Qs) G) tau E2 ==> _` + (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) [ (* goal 1.1 (of 2) *) - Q.EXISTS_TAC `restr f E1` \\ + Q.EXISTS_TAC `restr L E1` \\ CONJ_TAC >- (Q.EXISTS_TAC `E1` >> art []) \\ - Q.EXISTS_TAC `restr f E''` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ + Q.EXISTS_TAC `restr L E''` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ `STRONG_EQUIV E1 E''` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ - `STRONG_EQUIV (restr f E1) (restr f E'')` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f E''` >> art [] \\ - fs [IS_PROC_restr, BV_def] \\ - Know `IS_PROC E''` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`CCS_SUBST (fromList Xs Qs) G`, `tau`] >> art []) \\ - Know `DISJOINT (BV E'') (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (CCS_SUBST (fromList Xs Qs) G)` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `tau` >> art []) >> rw [], + `STRONG_EQUIV (restr L E1) (restr L E'')` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L E''` >> art [] \\ + fs [IS_PROC_restr] \\ + MATCH_MP_TAC TRANS_PROC \\ + take [`CCS_SUBST (fromList Xs Qs) G`, `tau`] >> art [], (* goal 1.2 (of 2) *) - Q.EXISTS_TAC `restr f E1` \\ + Q.EXISTS_TAC `restr L E1` \\ CONJ_TAC >- (Q.EXISTS_TAC `E1` >> art []) \\ - `STRONG_EQUIV (restr f (CCS_SUBST (fromList Xs Qs) G')) (restr f E'')` - by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f (CCS_SUBST (fromList Xs Qs) G')` >> art [] \\ - `STRONG_EQUIV (restr f E1) (restr f (CCS_SUBST (fromList Xs Ps) G'))` - by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f (CCS_SUBST (fromList Xs Ps) G')` >> art [] \\ - fs [IS_PROC_restr, BV_def] \\ - DISJ2_TAC >> Q.EXISTS_TAC `restr f G'` \\ + qabbrev_tac ‘y = [Qs/Xs] G'’ \\ + `STRONG_EQUIV (restr L y) (restr L E'')` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L y` >> art [] \\ + qabbrev_tac ‘x = [Ps/Xs] G'’ \\ + `STRONG_EQUIV (restr L E1) (restr L x)` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L x` >> art [] \\ + fs [IS_PROC_restr] \\ + DISJ2_TAC >> Q.EXISTS_TAC `restr L G'` \\ CONJ_TAC >- (MATCH_MP_TAC context_restr_rule >> art []) \\ - ASM_REWRITE_TAC [FV_def, CCS_SUBST_restr] ], - (* goal 4 (of 4) *) + rw [FV_def, ssub_thm] ], + (* goal 2 (of 2) *) Q.PAT_X_ASSUM `!u. (!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u E1 ==> _) /\ _` (MP_TAC o (Q.SPEC `label l`)) >> RW_TAC bool_ss [] \\ Q.PAT_X_ASSUM `!E2. TRANS (CCS_SUBST (fromList Xs Ps) G) (label l) E2 ==> _` K_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| - [ (* goal 1.1 (of 2) *) - Q.EXISTS_TAC `restr f E1` \\ + Q.PAT_X_ASSUM + `!E1. TRANS (CCS_SUBST (fromList Xs Qs) G) (label l) E1 ==> _` + (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) + [ (* goal 2.1 (of 2) *) + Q.EXISTS_TAC `restr L E1` \\ CONJ_TAC >- (Q.EXISTS_TAC `E1` >> art []) \\ - Q.EXISTS_TAC `restr f E''` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ + Q.EXISTS_TAC `restr L E''` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ `STRONG_EQUIV E1 E''` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ - `STRONG_EQUIV (restr f E1) (restr f E'')` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f E''` >> art [] \\ - fs [IS_PROC_restr, BV_def] \\ - Know `IS_PROC E''` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`CCS_SUBST (fromList Xs Qs) G`, `label l`] >> art []) \\ - Know `DISJOINT (BV E'') (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (CCS_SUBST (fromList Xs Qs) G)` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `label l` >> art []) >> rw [], - (* goal 1.2 (of 2) *) - Q.EXISTS_TAC `restr f E1` \\ + `STRONG_EQUIV (restr L E1) (restr L E'')` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L E''` >> art [] \\ + fs [IS_PROC_restr] \\ + MATCH_MP_TAC TRANS_PROC \\ + take [`CCS_SUBST (fromList Xs Qs) G`, `label l`] >> art [], + (* goal 2.2 (of 2) *) + Q.EXISTS_TAC `restr L E1` \\ CONJ_TAC >- (Q.EXISTS_TAC `E1` >> art []) \\ - `STRONG_EQUIV (restr f (CCS_SUBST (fromList Xs Qs) G')) (restr f E'')` - by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f (CCS_SUBST (fromList Xs Qs) G')` >> art [] \\ - `STRONG_EQUIV (restr f E1) (restr f (CCS_SUBST (fromList Xs Ps) G'))` - by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ - Q.EXISTS_TAC `restr f (CCS_SUBST (fromList Xs Ps) G')` >> art [] \\ - fs [IS_PROC_restr, BV_def] \\ - DISJ2_TAC >> Q.EXISTS_TAC `restr f G'` \\ + qabbrev_tac ‘y = [Qs/Xs] G'’ \\ + `STRONG_EQUIV (restr L y) (restr L E'')` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L y` >> art [] \\ + qabbrev_tac ‘x = [Ps/Xs] G'’ \\ + `STRONG_EQUIV (restr L E1) (restr L x)` by PROVE_TAC [STRONG_EQUIV_SUBST_RESTR] \\ + Q.EXISTS_TAC `restr L x` >> art [] \\ + fs [IS_PROC_restr] \\ + DISJ2_TAC >> Q.EXISTS_TAC `restr L G'` \\ CONJ_TAC >- (MATCH_MP_TAC context_restr_rule >> art []) \\ - ASM_REWRITE_TAC [FV_def, CCS_SUBST_restr] ] ]) - (* Case 6: E = relab f G (not hard) *) - >- (Q.X_GEN_TAC `rf` \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [context_relab_rewrite])) \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [FV_def])) \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [CCS_SUBST_def, BV_def])) \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [CCS_SUBST_def, BV_def])) \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [IS_PROC_relab, CCS_SUBST_def])) \\ - DISCH_THEN (ASSUME_TAC o (REWRITE_RULE [IS_PROC_relab, CCS_SUBST_def])) \\ - Q.PAT_X_ASSUM `context Xs G ==> _` MP_TAC \\ - RW_TAC std_ss [CCS_SUBST_relab, TRANS_RELAB_EQ] >| (* 2 subgoals *) + rw [FV_def, ssub_thm, Abbr ‘x’, Abbr ‘y’] ] ]) + (* 4 subgoals left: E = relab f G (not hard) *) + >- (fs [context_relab_rewrite, TRANS_RELAB_EQ] \\ + Q.PAT_X_ASSUM `!u. (!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u E1 ==> _) /\ _` + (MP_TAC o (Q.SPEC `u'`)) >> RW_TAC bool_ss [] \\ + Q.PAT_X_ASSUM `!E2. TRANS (CCS_SUBST (fromList Xs Qs) G) u' E2 ==> _` K_TAC \\ + Q.PAT_X_ASSUM `!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u' E2 ==> _` + (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) [ (* goal 1 (of 2) *) - Q.PAT_X_ASSUM `!u. (!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u E1 ==> _) /\ _` - (MP_TAC o (Q.SPEC `u'`)) >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM - `!E2. TRANS (CCS_SUBST (fromList Xs Qs) G) u' E2 ==> _` K_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| - [ (* goal 1.1 (of 2) *) - Q.EXISTS_TAC `relab E2 rf` \\ - CONJ_TAC >- (take [`u'`, `E2`] >> art []) \\ - Q.EXISTS_TAC `relab E2 rf` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ - `STRONG_EQUIV E'' E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ - `STRONG_EQUIV (relab E'' rf) (relab E2 rf)` - by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ - Q.EXISTS_TAC `relab E2 rf` >> art [] \\ - fs [IS_PROC_relab, BV_def] \\ - Know `IS_PROC E2` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`CCS_SUBST (fromList Xs Qs) G`, `u'`] >> art []) \\ - Know `DISJOINT (BV E2) (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (CCS_SUBST (fromList Xs Qs) G)` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `u'` >> art []) >> rw [], - (* goal 1.2 (of 2) *) - Q.EXISTS_TAC `relab E2 rf` \\ - CONJ_TAC >- (take [`u'`, `E2`] >> art []) \\ - `STRONG_EQUIV (relab (CCS_SUBST (fromList Xs Qs) G') rf) (relab E2 rf)` - by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ - Q.EXISTS_TAC `relab (CCS_SUBST (fromList Xs Qs) G') rf` >> art [] \\ - `STRONG_EQUIV (relab E'' rf) (relab (CCS_SUBST (fromList Xs Ps) G') rf)` - by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ - Q.EXISTS_TAC `relab (CCS_SUBST (fromList Xs Ps) G') rf` >> art [] \\ - fs [IS_PROC_relab, BV_def] \\ - DISJ2_TAC >> Q.EXISTS_TAC `relab G' rf` \\ - CONJ_TAC >- (MATCH_MP_TAC context_relab_rule >> art []) \\ - ASM_REWRITE_TAC [FV_def, CCS_SUBST_relab] ], + Q.EXISTS_TAC `relab E2 rf` \\ + CONJ_TAC >- (take [`u'`, `E2`] >> art []) \\ + Q.EXISTS_TAC `relab E2 rf` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ + `STRONG_EQUIV E'' E2` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ + `STRONG_EQUIV (relab E'' rf) (relab E2 rf)` by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ + Q.EXISTS_TAC `relab E2 rf` >> art [] \\ + fs [IS_PROC_relab] \\ + MATCH_MP_TAC TRANS_PROC \\ + take [`CCS_SUBST (fromList Xs Qs) G`, `u'`] >> art [], (* goal 2 (of 2) *) - Q.PAT_X_ASSUM `!u. (!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u E1 ==> _) /\ _` - (MP_TAC o (Q.SPEC `u'`)) >> RW_TAC bool_ss [] \\ - Q.PAT_X_ASSUM - `!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u' E1 ==> _` K_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| - [ (* goal 2.1 (of 2) *) - Q.EXISTS_TAC `relab E1 rf` \\ - CONJ_TAC >- (take [`u'`, `E1`] >> art []) \\ - Q.EXISTS_TAC `relab E'' rf` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ - `STRONG_EQUIV E1 E''` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ - `STRONG_EQUIV (relab E1 rf) (relab E'' rf)` - by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ - Q.EXISTS_TAC `relab E'' rf` >> art [] \\ - fs [IS_PROC_relab, BV_def] \\ - Know `IS_PROC E''` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`CCS_SUBST (fromList Xs Qs) G`, `u'`] >> art []) \\ - Know `DISJOINT (BV E'') (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (CCS_SUBST (fromList Xs Qs) G)` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `u'` >> art []) >> rw [], - (* goal 2.2 (of 2) *) - Q.EXISTS_TAC `relab E1 rf` \\ - CONJ_TAC >- (take [`u'`, `E1`] >> art []) \\ - `STRONG_EQUIV (relab (CCS_SUBST (fromList Xs Qs) G') rf) (relab E'' rf)` - by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ - Q.EXISTS_TAC `relab (CCS_SUBST (fromList Xs Qs) G') rf` >> art [] \\ - `STRONG_EQUIV (relab E1 rf) (relab (CCS_SUBST (fromList Xs Ps) G') rf)` - by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ - Q.EXISTS_TAC `relab (CCS_SUBST (fromList Xs Ps) G') rf` >> art [] \\ - fs [IS_PROC_relab, BV_def] \\ - DISJ2_TAC >> Q.EXISTS_TAC `relab G' rf` \\ - CONJ_TAC >- (MATCH_MP_TAC context_relab_rule >> art []) \\ - ASM_REWRITE_TAC [FV_def, CCS_SUBST_relab] ] ]) - (* Case 7: E = rec Y G (done, `context Xs` is essential here) *) - >> POP_ASSUM K_TAC (* IH is not used here, removed *) - >> Q.X_GEN_TAC `Y` >> DISCH_TAC - >> IMP_RES_TAC context_rec - >> `DISJOINT (FV (rec Y G)) (set Xs)` by ASM_SET_TAC [FV_def] - >> `(CCS_SUBST (fromList Xs Ps) (rec Y G) = rec Y G) /\ - (CCS_SUBST (fromList Xs Qs) (rec Y G) = rec Y G)` - by METIS_TAC [CCS_SUBST_elim] >> NTAC 2 POP_ORW - >> RW_TAC std_ss [] (* 2 subgoals *) - >| [ (* goal 1 (of 2) *) - Q.EXISTS_TAC `E1` >> art [O_DEF] \\ - Q.EXISTS_TAC `E1` >> art [STRONG_EQUIV_REFL] \\ - Q.EXISTS_TAC `E1` >> BETA_TAC >> art [STRONG_EQUIV_REFL] \\ - Know `IS_PROC E1` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`rec Y G`, `u`] >> art []) \\ - Know `DISJOINT (BV E1) (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (rec Y G)` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `u` >> art []) >> rw [], - (* goal 2 (of 2) *) - Q.EXISTS_TAC `E2` >> art [O_DEF] \\ - Q.EXISTS_TAC `E2` >> art [STRONG_EQUIV_REFL] \\ - Q.EXISTS_TAC `E2` >> BETA_TAC >> art [STRONG_EQUIV_REFL] \\ - Know `IS_PROC E2` - >- (MATCH_MP_TAC TRANS_PROC \\ - take [`rec Y G`, `u`] >> art []) \\ - Know `DISJOINT (BV E2) (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV (rec Y G)` >> art [] \\ - MATCH_MP_TAC TRANS_BV >> Q.EXISTS_TAC `u` >> art []) >> rw [] ] + Q.EXISTS_TAC `relab E2 rf` \\ + CONJ_TAC >- (take [`u'`, `E2`] >> art []) \\ + qabbrev_tac ‘y = [Qs/Xs] G'’ \\ + `STRONG_EQUIV (relab y rf) (relab E2 rf)` by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ + Q.EXISTS_TAC `relab y rf` >> art [] \\ + qabbrev_tac ‘x = [Ps/Xs] G'’ \\ + `STRONG_EQUIV (relab E'' rf) (relab x rf)` by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ + Q.EXISTS_TAC `relab x rf` >> art [] \\ + fs [IS_PROC_relab] \\ + DISJ2_TAC >> Q.EXISTS_TAC `relab G' rf` \\ + CONJ_TAC >- (MATCH_MP_TAC context_relab_rule >> art []) \\ + rw [FV_def, ssub_thm, Abbr ‘x’, Abbr ‘y’] ]) + (* 3 subgoals *) + >- (fs [context_relab_rewrite, TRANS_RELAB_EQ] \\ + Q.PAT_X_ASSUM `!u. (!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u E1 ==> _) /\ _` + (MP_TAC o (Q.SPEC `u'`)) >> RW_TAC bool_ss [] \\ + Q.PAT_X_ASSUM `!E1. TRANS (CCS_SUBST (fromList Xs Ps) G) u' E1 ==> _` K_TAC \\ + Q.PAT_X_ASSUM `!E2. TRANS (CCS_SUBST (fromList Xs Qs) G) u' E2 ==> _` + (MP_TAC o (Q.SPEC `E''`)) >> RW_TAC std_ss [O_DEF] >| (* 2 subgoals *) + [ (* goal 1 (of 2) *) + Q.EXISTS_TAC `relab E1 rf` \\ + CONJ_TAC >- (take [`u'`, `E1`] >> art []) \\ + Q.EXISTS_TAC `relab E'' rf` >> REWRITE_TAC [STRONG_EQUIV_REFL] \\ + `STRONG_EQUIV E1 E''` by PROVE_TAC [STRONG_EQUIV_TRANS] \\ + `STRONG_EQUIV (relab E1 rf) (relab E'' rf)` by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ + Q.EXISTS_TAC `relab E'' rf` >> art [] \\ + fs [IS_PROC_relab] \\ + MATCH_MP_TAC TRANS_PROC \\ + take [`CCS_SUBST (fromList Xs Qs) G`, `u'`] >> art [], + (* goal 2 (of 2) *) + Q.EXISTS_TAC `relab E1 rf` \\ + CONJ_TAC >- (take [`u'`, `E1`] >> art []) \\ + qabbrev_tac ‘y = [Qs/Xs] G'’ \\ + `STRONG_EQUIV (relab y rf) (relab E'' rf)` by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ + Q.EXISTS_TAC `relab y rf` >> art [] \\ + qabbrev_tac ‘x = [Ps/Xs] G'’ \\ + `STRONG_EQUIV (relab E1 rf) (relab x rf)` by PROVE_TAC [STRONG_EQUIV_SUBST_RELAB] \\ + Q.EXISTS_TAC `relab x rf` >> art [] \\ + fs [IS_PROC_relab] \\ + DISJ2_TAC >> Q.EXISTS_TAC `relab G' rf` \\ + CONJ_TAC >- (MATCH_MP_TAC context_relab_rule >> art []) \\ + rw [FV_def, ssub_thm, Abbr ‘x’, Abbr ‘y’] ]) + (* 2 subgoals *) + >- (Q.PAT_X_ASSUM ‘context Xs G ==> _’ K_TAC (* IH is not needed *) \\ + IMP_RES_TAC context_rec \\ + `DISJOINT (FV (rec y G)) (set Xs)` by ASM_SET_TAC [FV_def] \\ + `CCS_SUBST (fromList Xs Ps) (rec y G) = rec y G /\ + CCS_SUBST (fromList Xs Qs) (rec y G) = rec y G` by METIS_TAC [CCS_SUBST_elim] \\ + POP_ORW \\ + POP_ASSUM (fs o wrap) \\ + RW_TAC std_ss [O_DEF] \\ + Q.EXISTS_TAC `E1` >> art [] \\ + Q.EXISTS_TAC `E1` >> art [STRONG_EQUIV_REFL] \\ + Q.EXISTS_TAC `E1` >> art [STRONG_EQUIV_REFL] \\ + MATCH_MP_TAC TRANS_PROC >> take [`rec y G`, `u`] >> art []) + (* final goal *) + >> (Q.PAT_X_ASSUM ‘context Xs G ==> _’ K_TAC (* IH is not needed *) \\ + IMP_RES_TAC context_rec \\ + `DISJOINT (FV (rec y G)) (set Xs)` by ASM_SET_TAC [FV_def] \\ + `CCS_SUBST (fromList Xs Qs) (rec y G) = rec y G /\ + CCS_SUBST (fromList Xs Ps) (rec y G) = rec y G` by METIS_TAC [CCS_SUBST_elim] \\ + POP_ORW \\ + POP_ASSUM (fs o wrap) \\ + RW_TAC std_ss [O_DEF] \\ + Q.EXISTS_TAC `E2` >> art [] \\ + Q.EXISTS_TAC `E2` >> art [STRONG_EQUIV_REFL] \\ + Q.EXISTS_TAC `E2` >> art [STRONG_EQUIV_REFL] \\ + MATCH_MP_TAC TRANS_PROC >> take [`rec y G`, `u`] >> art []) QED (* ========================================================================== *) @@ -2703,7 +2432,7 @@ QED thus this lemma doesn't derive from LIST_REL_equivalence. *) Theorem OBS_contracts_transitive : - !(Ps :('a, 'b) CCS list) Qs Rs. + !(Ps :'a CCS list) Qs Rs. LIST_REL OBS_contracts Ps Qs /\ LIST_REL OBS_contracts Qs Rs ==> LIST_REL OBS_contracts Ps Rs Proof @@ -2715,7 +2444,7 @@ Proof QED Theorem OBS_contracts_reflexive : - !(Ps :('a, 'b) CCS list). LIST_REL OBS_contracts Ps Ps + !(Ps :'a CCS list). LIST_REL OBS_contracts Ps Ps Proof RW_TAC list_ss [LIST_REL_EL_EQN, OBS_contracts_REFL] QED @@ -2759,176 +2488,135 @@ Proof >> Q.EXISTS_TAC `E Ps` >> art [] QED -(* `ALL_PROC Ps` is added to handle the last difficulity; - `EVERY (\e. DISJOINT (BV e) (set Xs)) Ps` makes the proof easier. - *) +(* `ALL_PROC Ps` is added to handle the last difficulity *) Theorem USC_unfolding_lemma2 : !Xs. ALL_DISTINCT Xs ==> - !E. weakly_guarded Xs E /\ DISJOINT (BV E) (set Xs) ==> + !E. weakly_guarded Xs E ==> !Ps u P'. (LENGTH Ps = LENGTH Xs) /\ ALL_PROC Ps /\ - EVERY (\e. DISJOINT (BV e) (set Xs)) Ps /\ TRANS (CCS_SUBST (fromList Xs Ps) E) u P' ==> - ?C'. context Xs C' /\ DISJOINT (BV C') (set Xs) /\ + ?C'. context Xs C' /\ (P' = CCS_SUBST (fromList Xs Ps) C') /\ !Qs. (LENGTH Qs = LENGTH Xs) ==> TRANS (CCS_SUBST (fromList Xs Qs) E) u (CCS_SUBST (fromList Xs Qs) C') Proof NTAC 2 STRIP_TAC (* up to `!E` *) - >> Induct_on `E` (* 8 subgoals *) - >- RW_TAC std_ss [CCS_SUBST_nil, NIL_NO_TRANS] + >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> Q.EXISTS_TAC ‘set Xs’ >> rw [NIL_NO_TRANS, ssub_thm] + >> gs [FDOM_fromList] (* 7 subgoals left *) - >- (GEN_TAC >> RW_TAC std_ss [BV_def] \\ - IMP_RES_TAC weakly_guarded_var \\ - Suff `CCS_SUBST (fromList Xs Ps) (var a) = var a` - >- (DISCH_THEN (fs o wrap) >> fs [VAR_NO_TRANS]) \\ - MATCH_MP_TAC CCS_SUBST_elim >> art [] \\ - ASM_SET_TAC [FV_def]) + >- (IMP_RES_TAC weakly_guarded_var \\ + rename1 ‘~MEM a Xs’ >> fs [VAR_NO_TRANS]) (* 6 subgoals left *) - >- (RW_TAC std_ss [CCS_SUBST_prefix, TRANS_PREFIX_EQ] \\ + >- (fs [TRANS_PREFIX_EQ] \\ IMP_RES_TAC weakly_guarded_prefix \\ - Q.EXISTS_TAC `E` >> fs [BV_def]) + Q.EXISTS_TAC `E` >> rw []) (* 5 subgoals left *) - >- (RW_TAC std_ss [CCS_SUBST_sum, weakly_guarded_sum_rewrite] \\ + >- (fs [weakly_guarded_sum_rewrite] \\ IMP_RES_TAC TRANS_SUM >| (* 2 subgoals *) [ (* goal 1 (of 2) *) - Q.PAT_X_ASSUM `weakly_guarded Xs E /\ _ ==> _` MP_TAC \\ - FULL_SIMP_TAC std_ss [BV_def, DISJOINT_UNION] \\ - DISCH_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPECL [`Ps`, `u`, `P'`])) \\ + Q.PAT_X_ASSUM + ‘!Ps u P'. LENGTH Ps = LENGTH Xs /\ ALL_PROC Ps /\ [Ps/Xs] E --u-> P' ==> _’ + (MP_TAC o (Q.SPECL [`Ps`, `u`, `P'`])) \\ RW_TAC bool_ss [] \\ Q.EXISTS_TAC `C'` >> RW_TAC std_ss [] \\ MATCH_MP_TAC SUM1 \\ FIRST_X_ASSUM MATCH_MP_TAC >> art [], (* goal 2 (of 2) *) - Q.PAT_X_ASSUM `weakly_guarded Xs E' /\ _ ==> _` MP_TAC \\ - FULL_SIMP_TAC std_ss [BV_def, DISJOINT_UNION] \\ - DISCH_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPECL [`Ps`, `u`, `P'`])) \\ + Q.PAT_X_ASSUM + ‘!Ps u P'. LENGTH Ps = LENGTH Xs /\ ALL_PROC Ps /\ [Ps/Xs] E' --u-> P' ==> _’ + (MP_TAC o (Q.SPECL [`Ps`, `u`, `P'`])) \\ RW_TAC bool_ss [] \\ Q.EXISTS_TAC `C'` >> RW_TAC std_ss [] \\ MATCH_MP_TAC SUM2 \\ FIRST_X_ASSUM MATCH_MP_TAC >> art [] ]) (* 4 subgoals left *) - >- (RW_TAC std_ss [CCS_SUBST_par, weakly_guarded_par_rewrite] \\ + >- (fs [weakly_guarded_par_rewrite] \\ IMP_RES_TAC TRANS_PAR >| (* 3 subgoals *) [ (* goal 1 (of 3) *) - Q.PAT_X_ASSUM `weakly_guarded Xs E /\ _ ==> _` MP_TAC \\ - FULL_SIMP_TAC std_ss [BV_def, DISJOINT_UNION] \\ - DISCH_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPECL [`Ps`, `u`, `E1`])) \\ + Q.PAT_X_ASSUM + ‘!Ps u P'. LENGTH Ps = LENGTH Xs /\ ALL_PROC Ps /\ [Ps/Xs] E --u-> P' ==> _’ + (MP_TAC o (Q.SPECL [`Ps`, `u`, `E1`])) \\ RW_TAC bool_ss [] \\ Q.EXISTS_TAC `par C' E'` \\ CONJ_TAC >- (MATCH_MP_TAC context_par_rule >> art [] \\ MATCH_MP_TAC weakly_guarded_imp_context >> art []) \\ - RW_TAC std_ss [BV_def, CCS_SUBST_par, DISJOINT_UNION] \\ - MATCH_MP_TAC PAR1 \\ - FIRST_X_ASSUM MATCH_MP_TAC >> art [], + RW_TAC std_ss [ssub_thm] \\ + MATCH_MP_TAC PAR1 >> FIRST_X_ASSUM MATCH_MP_TAC >> art [], (* goal 2 (of 3) *) - Q.PAT_X_ASSUM `weakly_guarded Xs E' /\ _ ==> _` MP_TAC \\ - FULL_SIMP_TAC std_ss [BV_def, DISJOINT_UNION] \\ - DISCH_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPECL [`Ps`, `u`, `E1`])) \\ + Q.PAT_X_ASSUM + ‘!Ps u P'. LENGTH Ps = LENGTH Xs /\ ALL_PROC Ps /\ [Ps/Xs] E' --u-> P' ==> _’ + (MP_TAC o (Q.SPECL [`Ps`, `u`, `E1`])) \\ RW_TAC bool_ss [] \\ Q.EXISTS_TAC `par E C'` \\ CONJ_TAC >- (MATCH_MP_TAC context_par_rule >> art [] \\ MATCH_MP_TAC weakly_guarded_imp_context >> art []) \\ - RW_TAC std_ss [BV_def, CCS_SUBST_par, DISJOINT_UNION] \\ - MATCH_MP_TAC PAR2 \\ - FIRST_X_ASSUM MATCH_MP_TAC >> art [], + RW_TAC std_ss [ssub_thm] \\ + MATCH_MP_TAC PAR2 >> FIRST_X_ASSUM MATCH_MP_TAC >> art [], (* goal 3 (of 3) *) - Q.PAT_X_ASSUM `weakly_guarded Xs E' /\ _ ==> _` MP_TAC \\ - Q.PAT_X_ASSUM `weakly_guarded Xs E /\ _ ==> _` MP_TAC \\ - FULL_SIMP_TAC std_ss [BV_def, DISJOINT_UNION] \\ - NTAC 2 DISCH_TAC \\ - POP_ASSUM (MP_TAC o (Q.SPECL [`Ps`, `label (COMPL l)`, `E2`])) \\ - POP_ASSUM (MP_TAC o (Q.SPECL [`Ps`, `label l`, `E1`])) \\ + Q.PAT_X_ASSUM + ‘!Ps u P'. LENGTH Ps = LENGTH Xs /\ ALL_PROC Ps /\ [Ps/Xs] E --u-> P' ==> _’ + (MP_TAC o (Q.SPECL [`Ps`, `label l`, `E1`])) \\ + Q.PAT_X_ASSUM + ‘!Ps u P'. LENGTH Ps = LENGTH Xs /\ ALL_PROC Ps /\ [Ps/Xs] E' --u-> P' ==> _’ + (MP_TAC o (Q.SPECL [`Ps`, `label (COMPL l)`, `E2`])) \\ RW_TAC bool_ss [] \\ - Q.EXISTS_TAC `par C' C''` \\ + Q.EXISTS_TAC `par C'' C'` \\ CONJ_TAC >- (MATCH_MP_TAC context_par_rule >> art []) \\ - RW_TAC std_ss [BV_def, CCS_SUBST_par, DISJOINT_UNION] \\ + RW_TAC std_ss [ssub_thm] \\ MATCH_MP_TAC PAR3 >> Q.EXISTS_TAC `l` \\ CONJ_TAC >> FIRST_X_ASSUM MATCH_MP_TAC >> art [] ]) (* 3 subgoals left *) - >- (RW_TAC std_ss [CCS_SUBST_restr, weakly_guarded_restr_rewrite, - TRANS_RESTR_EQ, BV_def] >| - [ (* goal 1 (of 2) *) - Q.PAT_X_ASSUM `weakly_guarded Xs E /\ _ ==> _` MP_TAC \\ - RW_TAC bool_ss [] \\ - POP_ASSUM (MP_TAC o (Q.SPECL [`Ps`, `tau`, `E''`])) \\ + >- (fs [weakly_guarded_restr_rewrite, TRANS_RESTR_EQ] >| (* 2 subgoals *) + [ (* goal 3.1 (of 2) *) + Q.PAT_X_ASSUM ‘!Ps u P'. P’ (MP_TAC o (Q.SPECL [`Ps`, `tau`, `E''`])) \\ RW_TAC bool_ss [] \\ - Q.EXISTS_TAC `restr f C'` \\ - RW_TAC std_ss [CCS_SUBST_restr, BV_def] \\ - MATCH_MP_TAC context_restr_rule >> art [], + Q.EXISTS_TAC `restr L C'` \\ + RW_TAC std_ss [ssub_thm] + >- (MATCH_MP_TAC context_restr_rule >> art []) \\ + Q.EXISTS_TAC ‘[Qs/Xs] C'’ >> rw [], (* goal 2 (of 2) *) - Q.PAT_X_ASSUM `weakly_guarded Xs E /\ _ ==> _` MP_TAC \\ - RW_TAC bool_ss [] \\ - POP_ASSUM (MP_TAC o (Q.SPECL [`Ps`, `label l`, `E''`])) \\ + Q.PAT_X_ASSUM ‘!Ps u P'. P’ (MP_TAC o (Q.SPECL [`Ps`, `label l`, `E''`])) \\ RW_TAC bool_ss [] \\ - Q.EXISTS_TAC `restr f C'` \\ - RW_TAC std_ss [CCS_SUBST_restr, BV_def] \\ - MATCH_MP_TAC context_restr_rule >> art [] ]) + Q.EXISTS_TAC `restr L C'` \\ + RW_TAC std_ss [ssub_thm] + >- (MATCH_MP_TAC context_restr_rule >> art []) \\ + Q.EXISTS_TAC ‘[Qs/Xs] C'’ >> rw [] ]) (* 2 subgoals left *) - >- (RW_TAC std_ss [CCS_SUBST_relab, weakly_guarded_relab_rewrite, - TRANS_RELAB_EQ, BV_def] \\ - Q.PAT_X_ASSUM `weakly_guarded Xs E /\ _ ==> _` MP_TAC \\ - RW_TAC bool_ss [] \\ - POP_ASSUM (MP_TAC o (Q.SPECL [`Ps`, `u'`, `E''`])) \\ + >- (fs [weakly_guarded_relab_rewrite, TRANS_RELAB_EQ] \\ + Q.PAT_X_ASSUM ‘!Ps u P'. P’ (MP_TAC o (Q.SPECL [`Ps`, `u'`, `E''`])) \\ RW_TAC bool_ss [] \\ - Q.EXISTS_TAC `relab C' R` \\ - RW_TAC std_ss [CCS_SUBST_relab, BV_def] + Q.EXISTS_TAC `relab C' rf` \\ + RW_TAC std_ss [ssub_thm] >- (MATCH_MP_TAC context_relab_rule >> art []) \\ - Q.EXISTS_TAC `u'` >> art [] \\ - FIRST_X_ASSUM MATCH_MP_TAC >> art []) - (* the last goal (hard) *) - >> RW_TAC std_ss [BV_def, CCS_SUBST_rec, DISJOINT_INSERT] + qexistsl_tac [‘u'’, ‘[Qs/Xs] C'’] >> rw []) + (* final goal (hard) *) >> IMP_RES_TAC weakly_guarded_rec - >> Know `FDOM (fromList Xs Ps) = set Xs` - >- (MATCH_MP_TAC FDOM_fromList >> art []) - >> DISCH_THEN ((FULL_SIMP_TAC bool_ss) o wrap) - >> rfs [] + >> ‘DISJOINT (FV (rec y E)) (set Xs)’ by rw [FV_thm] >> Q.EXISTS_TAC `P'` - >> Suff `DISJOINT (FV P') (set Xs) /\ DISJOINT (BV P') (set Xs)` + >> Suff `DISJOINT (FV P') (set Xs)` >- (RW_TAC std_ss [] >- (MATCH_MP_TAC disjoint_imp_context >> art []) >- (MATCH_MP_TAC EQ_SYM >> irule CCS_SUBST_elim >> art []) \\ - fs [FDOM_fromList] \\ Know `CCS_SUBST (fromList Xs Qs) P' = P'` >- (irule CCS_SUBST_elim >> art []) >> Rewr' \\ - Know `CCS_SUBST (fromList Xs Ps) E = E` + Know `CCS_SUBST (fromList Xs Ps) (rec y E) = rec y E` >- (irule CCS_SUBST_elim >> art [] >> ASM_SET_TAC []) \\ DISCH_THEN ((FULL_SIMP_TAC bool_ss) o wrap) \\ - Know `CCS_SUBST (fromList Xs Qs) E = E` + Know `CCS_SUBST (fromList Xs Qs) (rec y E) = rec y E` >- (irule CCS_SUBST_elim >> art [] >> ASM_SET_TAC []) \\ DISCH_THEN ((FULL_SIMP_TAC bool_ss) o wrap)) (* cleanups and renames before the final battle *) - >> rename1 `~MEM Y Xs` >> Q.PAT_X_ASSUM `weakly_guarded Xs E ==> _` K_TAC (* hard left goal *) - >> Q.ABBREV_TAC `P = CCS_SUBST (fromList Xs Ps) E` + >> Q.ABBREV_TAC `P = CCS_SUBST (fromList Xs Ps) (rec y E)` >> IMP_RES_TAC TRANS_FV - >> IMP_RES_TAC TRANS_BV - >> FULL_SIMP_TAC bool_ss [FV_def, BV_def] - (* applying CCS_SUBST_[FV|BV]_SUBSET *) - >> Know `BV P SUBSET (BV E) UNION (BIGUNION (IMAGE BV (set Ps)))` - >- (Q.UNABBREV_TAC `P` \\ - MATCH_MP_TAC BV_SUBSET_BIGUNION >> art []) >> DISCH_TAC - >> Know `FV P SUBSET (FV E) UNION (BIGUNION (IMAGE FV (set Ps)))` + >> Know `FV P SUBSET (FV (rec y E)) UNION (BIGUNION (IMAGE FV (set Ps)))` >- (Q.UNABBREV_TAC `P` \\ MATCH_MP_TAC FV_SUBSET_BIGUNION >> art []) >> DISCH_TAC >> FULL_SIMP_TAC bool_ss [ALL_PROC_def, EVERY_MEM, IS_PROC_def] - (* more cleanups before the final magic *) - >> Q.PAT_X_ASSUM `weakly_guarded _ _` K_TAC (* used *) - >> Q.PAT_X_ASSUM `TRANS (rec Y P) u P'` K_TAC (* useless *) - >> Q.PAT_X_ASSUM `LENGTH Ps = LENGTH Xs` K_TAC (* useless *) - >> CONJ_TAC (* DISJOINT (FV P') (set Xs) *) - >- (Know `BIGUNION (IMAGE FV (set Ps)) = EMPTY` - >- rw [NOT_IN_EMPTY, IN_BIGUNION_IMAGE, IMAGE_EQ_SING] \\ - ASM_SET_TAC []) - >> Know `DISJOINT (BIGUNION (IMAGE BV (set Ps))) (set Xs)` - >- (rw [DISJOINT_BIGUNION] \\ - FIRST_X_ASSUM MATCH_MP_TAC >> art []) - (* the final magic *) + >> Know `BIGUNION (IMAGE FV (set Ps)) = EMPTY` + >- rw [NOT_IN_EMPTY, IN_BIGUNION_IMAGE, IMAGE_EQ_SING] >> ASM_SET_TAC [] QED @@ -2936,16 +2624,13 @@ QED the (celebrated) CCS_SUBST_nested. *) Theorem USC_unfolding_lemma3 : - !Xs Es C E. ALL_DISTINCT Xs /\ - context Xs C /\ DISJOINT (BV C) (set Xs) /\ + !Xs Es C E. ALL_DISTINCT Xs /\ context Xs C /\ (LENGTH Es = LENGTH Xs) /\ EVERY (weakly_guarded Xs) Es /\ - EVERY (\e. DISJOINT (BV e) (set Xs)) Es /\ (E = \Ys. MAP (CCS_SUBST (fromList Xs Ys)) Es) ==> !Ps x P'. (LENGTH Ps = LENGTH Xs) /\ ALL_PROC Ps /\ - EVERY (\e. DISJOINT (BV e) (set Xs)) Ps /\ TRANS (CCS_SUBST (fromList Xs (E Ps)) C) x P' ==> - ?C'. context Xs C' /\ DISJOINT (BV C') (set Xs) /\ + ?C'. context Xs C' /\ (P' = CCS_SUBST (fromList Xs Ps) C') /\ !Qs. (LENGTH Qs = LENGTH Xs) ==> TRANS (CCS_SUBST (fromList Xs (E Qs)) C) x @@ -2966,13 +2651,6 @@ Proof >> MP_TAC (Q.SPEC `Xs` USC_unfolding_lemma2) >> RW_TAC bool_ss [] >> POP_ASSUM (MP_TAC o (Q.SPEC `C'`)) - >> Know `DISJOINT (BV C') (set Xs)` - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV C UNION (BIGUNION (IMAGE BV (set Es)))` \\ - reverse CONJ_TAC - >- (Q.UNABBREV_TAC `C'` >> MATCH_MP_TAC BV_SUBSET_BIGUNION >> art []) \\ - RW_TAC std_ss [DISJOINT_UNION, DISJOINT_BIGUNION, IN_IMAGE] \\ - fs [EVERY_MEM]) >> RW_TAC bool_ss [] >> POP_ASSUM (MP_TAC o (Q.SPECL [`Ps`, `x`, `P'`])) >> RW_TAC std_ss [] @@ -2991,22 +2669,20 @@ QED Theorem USC_unfolding_lemma4 : !Xs Es C E C0. CCS_equation Xs Es /\ EVERY (weakly_guarded Xs) Es /\ - context Xs C /\ DISJOINT (BV C) (set Xs) /\ + context Xs C /\ (E = \Ys. MAP (CCS_SUBST (fromList Xs Ys)) Es) /\ (C0 = \Ys. (CCS_SUBST (fromList Xs Ys)) C) ==> !n xs Ps P'. (LENGTH Ps = LENGTH Xs) /\ ALL_PROC Ps /\ - EVERY (\e. DISJOINT (BV e) (set Xs)) Ps /\ TRACE ((C0 o FUNPOW E n) Ps) xs P' /\ LENGTH xs <= n ==> - ?C''. context Xs C'' /\ DISJOINT (BV C'') (set Xs) /\ + ?C''. context Xs C'' /\ (P' = CCS_SUBST (fromList Xs Ps) C'') /\ !Qs. (LENGTH Qs = LENGTH Xs) ==> TRACE ((C0 o FUNPOW E n) Qs) xs (CCS_SUBST (fromList Xs Qs) C'') Proof rpt GEN_TAC >> STRIP_TAC (* up to `!n` *) - >> `ALL_DISTINCT Xs /\ (LENGTH Es = LENGTH Xs)` - by PROVE_TAC [CCS_equation_def] + >> `ALL_DISTINCT Xs /\ (LENGTH Es = LENGTH Xs)` by PROVE_TAC [CCS_equation_def] (* re-define C' and E back to abbreviations *) >> Q.PAT_X_ASSUM `C0 = _` ((FULL_SIMP_TAC pure_ss) o wrap) >> Q.PAT_X_ASSUM `E = _` ((FULL_SIMP_TAC pure_ss) o wrap) @@ -3039,35 +2715,18 @@ Proof fs [CCS_equation_def, EVERY_MEM, weakly_guarded_def] \\ `MEM E Es` by METIS_TAC [MEM_EL] \\ PROVE_TAC []) >> DISCH_TAC - >> Know `EVERY (\e. DISJOINT (BV e) (set Xs)) (E Ps)` - >- (Q.UNABBREV_TAC `E` \\ - RW_TAC lset_ss [EVERY_MEM, MEM_MAP, MEM_EL] \\ - rename1 `i < LENGTH Xs` \\ - `i < LENGTH Es` by PROVE_TAC [] \\ - ASM_SIMP_TAC lset_ss [EL_MAP] \\ - Q.ABBREV_TAC `E = EL i Es` \\ - fs [CCS_equation_def, ALL_PROC_def, EVERY_MEM, IS_PROC_def, - weakly_guarded_def] \\ - `MEM E Es` by PROVE_TAC [MEM_EL] \\ - MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV E UNION (BIGUNION (IMAGE BV (set Ps)))` \\ - reverse CONJ_TAC - >- (MATCH_MP_TAC BV_SUBSET_BIGUNION >> art [] \\ - PROVE_TAC []) \\ - RW_TAC std_ss [DISJOINT_UNION, DISJOINT_BIGUNION, IN_IMAGE] \\ - PROVE_TAC []) >> DISCH_TAC (* stage work *) >> IMP_RES_TAC TRACE_cases2 >> Cases_on `xs` >- (FULL_SIMP_TAC bool_ss [NULL] \\ - `LENGTH (epsilon :'b Action list) <= n` by FULL_SIMP_TAC arith_ss [LENGTH] \\ + `LENGTH (epsilon :'a Action list) <= n` by FULL_SIMP_TAC arith_ss [LENGTH] \\ Know `!Ys. (LENGTH Ys = LENGTH Xs) ==> (LENGTH (E Ys) = LENGTH Xs)` >- (rpt STRIP_TAC \\ Q.UNABBREV_TAC `E` >> ASM_SIMP_TAC list_ss [LENGTH_MAP]) \\ DISCH_TAC \\ Q.PAT_X_ASSUM `!xs Ps P'. _ ==> _` - (MP_TAC o (Q.SPECL [`[] :'b Action list`, - `(E :('a, 'b) CCS list -> ('a, 'b) CCS list) Ps`, `P'`])) \\ + (MP_TAC o (Q.SPECL [`[] :'a Action list`, + `(E :'a CCS list -> 'a CCS list) Ps`, `P'`])) \\ Q.PAT_ASSUM `_ = P'` (ONCE_REWRITE_TAC o wrap) \\ RW_TAC bool_ss [] \\ Q.EXISTS_TAC `CCS_SUBST (fromList Xs Es) C''` \\ @@ -3075,13 +2734,6 @@ Proof >- (MATCH_MP_TAC context_combin >> fs [EVERY_MEM] \\ rpt STRIP_TAC >> MATCH_MP_TAC weakly_guarded_imp_context \\ FIRST_X_ASSUM MATCH_MP_TAC >> art []) \\ - CONJ_TAC (* DISJOINT ... *) - >- (MATCH_MP_TAC DISJOINT_SUBSET' \\ - Q.EXISTS_TAC `BV C'' UNION (BIGUNION (IMAGE BV (set Es)))` \\ - reverse CONJ_TAC - >- (MATCH_MP_TAC BV_SUBSET_BIGUNION >> art []) \\ - RW_TAC std_ss [DISJOINT_UNION, DISJOINT_BIGUNION, IN_IMAGE] \\ - fs [CCS_equation_def, EVERY_MEM]) \\ CONJ_TAC (* CCS_SUBST_nested *) >- (Q.PAT_X_ASSUM `_ = CCS_SUBST (fromList Xs (E Ps)) C''` (ONCE_REWRITE_TAC o wrap) \\ @@ -3090,7 +2742,7 @@ Proof fs [context_def]) \\ rpt STRIP_TAC \\ Q.PAT_X_ASSUM `!Qs. (LENGTH Qs = LENGTH Xs) ==> _` - (MP_TAC o (Q.SPEC `(E :('a, 'b) CCS list -> ('a, 'b) CCS list) Qs`)) \\ + (MP_TAC o (Q.SPEC `(E :'a CCS list -> 'a CCS list) Qs`)) \\ RW_TAC bool_ss [] \\ Suff `CCS_SUBST (fromList Xs Qs) (CCS_SUBST (fromList Xs Es) C'') = CCS_SUBST (fromList Xs (E Qs)) C''` >- (Rewr' >> art []) \\ @@ -3105,7 +2757,7 @@ Proof >> Q.ABBREV_TAC `u = LAST (h::t)` >> Q.PAT_X_ASSUM `!xs Ps' P''. _ ==> ?C''. _` (MP_TAC o - (Q.SPECL [`us`, `(E :('a, 'b) CCS list -> ('a, 'b) CCS list) Ps`, `P`])) + (Q.SPECL [`us`, `(E :'a CCS list -> 'a CCS list) Ps`, `P`])) >> RW_TAC std_ss [] >> MP_TAC (Q.SPECL [`Xs`, `Es`, `C''`, `E`] USC_unfolding_lemma3) >> FULL_SIMP_TAC bool_ss [CCS_equation_def] @@ -3123,19 +2775,18 @@ QED (* Lemma 3.9 of [2], the full (multivariate) version *) Theorem unique_solution_of_rooted_contractions_lemma : - !Xs Es Ps Qs. CCS_equation Xs Es /\ - EVERY (weakly_guarded Xs) Es /\ + !Xs Es Ps Qs. CCS_equation Xs Es /\ EVERY (weakly_guarded Xs) Es /\ CCS_solution OBS_contracts Xs Es Ps /\ CCS_solution OBS_contracts Xs Es Qs ==> - !C. context Xs C /\ DISJOINT (BV C) (set Xs) ==> + !C. context Xs C ==> (!l R. WEAK_TRANS (CCS_SUBST (fromList Xs Ps) C) (label l) R ==> - ?C'. context Xs C' /\ DISJOINT (BV C') (set Xs) /\ + ?C'. context Xs C' /\ R contracts (CCS_SUBST (fromList Xs Ps) C') /\ (WEAK_EQUIV O (\x y. WEAK_TRANS x (label l) y)) (CCS_SUBST (fromList Xs Qs) C) (CCS_SUBST (fromList Xs Qs) C')) /\ (!R. WEAK_TRANS (CCS_SUBST (fromList Xs Ps) C) tau R ==> - ?C'. context Xs C' /\ DISJOINT (BV C') (set Xs) /\ + ?C'. context Xs C' /\ R contracts (CCS_SUBST (fromList Xs Ps) C') /\ (WEAK_EQUIV O EPS) (CCS_SUBST (fromList Xs Qs) C) (CCS_SUBST (fromList Xs Qs) C')) @@ -3149,7 +2800,7 @@ Proof (* this turns Es into a chain-able function: E : Ys -> Ys *) >> Q.ABBREV_TAC `E = \Ys. MAP (CCS_SUBST (fromList Xs Ys)) Es` (* this turns C into a (toplevel) chain-able function: C0 : Ys -> Y *) - >> Q.ABBREV_TAC `C0 = \Ys. (CCS_SUBST (fromList Xs Ys)) C` + >> Q.ABBREV_TAC `C0 = \Ys. CCS_SUBST (fromList Xs Ys) C` >> Q.ABBREV_TAC `CE = \n. C0 o (FUNPOW E n)` >> Know `!n. OBS_contracts (C0 Ps) (CE n Ps)` >- (Q.UNABBREV_TAC `CE` >> BETA_TAC \\ @@ -3174,7 +2825,7 @@ Proof (MATCH_MP OBS_contracts_AND_TRACE_label)) \\ RW_TAC std_ss [] \\ Q.ABBREV_TAC `n = LENGTH us` \\ - Know `?C'. context Xs C' /\ DISJOINT (BV C') (set Xs) /\ + Know `?C'. context Xs C' /\ (E2 = CCS_SUBST (fromList Xs Ps) C') /\ !Qs. (LENGTH Qs = LENGTH Xs) ==> TRACE (CE n Qs) xs' (CCS_SUBST (fromList Xs Qs) C')` @@ -3202,7 +2853,7 @@ Proof (MATCH_MP OBS_contracts_AND_TRACE_tau)) \\ RW_TAC std_ss [] \\ Q.ABBREV_TAC `n = LENGTH us` \\ - Know `?C'. context Xs C' /\ DISJOINT (BV C') (set Xs) /\ + Know `?C'. context Xs C' /\ (E2 = CCS_SUBST (fromList Xs Ps) C') /\ !Qs. (LENGTH Qs = LENGTH Xs) ==> TRACE (CE n Qs) xs' (CCS_SUBST (fromList Xs Qs) C')` @@ -3223,19 +2874,19 @@ Proof Q.EXISTS_TAC `E1` >> art [] ] QED -(* Shared lemma for unique_solution_of_obs_contractions and - unique_solution_of_rooted_contractions. *) -Theorem shared_lemma[local]: +(* This is a shared lemma for unique_solution_of_obs_contractions and + unique_solution_of_rooted_contractions. + *) +Theorem shared_lemma[local] : CCS_equation Xs Es /\ EVERY (weakly_guarded Xs) Es /\ CCS_solution OBS_contracts Xs Es Ps /\ CCS_solution OBS_contracts Xs Es Qs ==> - WEAK_BISIM (\R S. ?C. context Xs C /\ DISJOINT (BV C) (set Xs) /\ + WEAK_BISIM (\R S. ?C. context Xs C /\ WEAK_EQUIV R (CCS_SUBST (fromList Xs Ps) C) /\ WEAK_EQUIV S (CCS_SUBST (fromList Xs Qs) C)) Proof - (* proof *) rpt STRIP_TAC >> REWRITE_TAC [WEAK_BISIM] >> BETA_TAC >> rpt STRIP_TAC (* 4 sub-goals here *) (* compatible with symbols in UniqueSolutionsTheory.shared_lemma *) @@ -3269,7 +2920,6 @@ Proof POP_ASSUM K_TAC (* !R. EPS _ R ==> _ *) \\ POP_ASSUM (MP_TAC o (Q.SPECL [`l`, `E2'`])) >> RW_TAC std_ss [] \\ POP_ASSUM MP_TAC >> REWRITE_TAC [O_DEF] >> BETA_TAC >> STRIP_TAC \\ - Q.PAT_X_ASSUM `WEAK_EQUIV E' (CCS_SUBST (fromList Xs Ps) C)` (MP_TAC o (Q.SPECL [`l`, `y`]) o (MATCH_MP WEAK_EQUIV_WEAK_TRANS_label')) \\ RW_TAC std_ss [] \\ @@ -3334,7 +2984,7 @@ Proof rpt GEN_TAC >> REWRITE_TAC [IN_APP] >> RW_TAC list_ss [CCS_solution_def, EVERY_MEM, LIST_REL_EL_EQN] >> REWRITE_TAC [WEAK_EQUIV] - >> Q.EXISTS_TAC `\R S. ?C. context Xs C /\ DISJOINT (BV C) (set Xs) /\ + >> Q.EXISTS_TAC `\R S. ?C. context Xs C /\ WEAK_EQUIV R (CCS_SUBST (fromList Xs Ps) C) /\ WEAK_EQUIV S (CCS_SUBST (fromList Xs Qs) C)` >> BETA_TAC >> CONJ_TAC @@ -3344,8 +2994,6 @@ Proof FIRST_X_ASSUM MATCH_MP_TAC \\ REWRITE_TAC [MEM_EL] \\ Q.EXISTS_TAC `n` >> art []) \\ - CONJ_TAC (* DISJOINT ... *) - >- (fs [CCS_equation_def, EVERY_MEM] >> METIS_TAC [MEM_EL]) \\ CONJ_TAC \\ (* 2 subgoals, same initial tactic *) MATCH_MP_TAC OBS_contracts_IMP_WEAK_EQUIV >| [ (* goal 1 (of 2) *) @@ -3377,7 +3025,7 @@ Proof [CCS_equation_def, CCS_solution_def, EVERY_MEM, LIST_REL_EL_EQN] (* here is the difference from unique_solution_of_obs_contractions *) >> irule OBS_CONGR_BY_WEAK_BISIM - >> Q.EXISTS_TAC `\R S. ?C. context Xs C /\ DISJOINT (BV C) (set Xs) /\ + >> Q.EXISTS_TAC `\R S. ?C. context Xs C /\ WEAK_EQUIV R (CCS_SUBST (fromList Xs Ps) C) /\ WEAK_EQUIV S (CCS_SUBST (fromList Xs Qs) C)` >> BETA_TAC >> CONJ_TAC @@ -3426,6 +3074,9 @@ Proof >> fs [CCS_equation_def, CCS_solution_def, EVERY_MEM, LIST_REL_EL_EQN] QED +val _ = export_theory (); +val _ = html_theory "Multivariate"; + (* Bibliography: [1] Milner, Robin. Communication and concurrency. Prentice hall, 1989. @@ -3440,48 +3091,7 @@ QED Workshop on Structural Operational Semantics (EXPRESS/SOS 2018). Vol. 276. No. 4. 2018. (DOI: 10.4204/EPTCS.276.10) - [4] Gorrieri, R., Versari, C.: Introduction to Concurrency Theory. Springer, Cham (2015). - *) - -(* Some unfinished work: *) - -(* Proposition 4.12 of [1], c.f. StrongLawsTheory.STRONG_UNFOLDING - - Let Es and Fs contain (free, equation) variable Es at most. Let - As = Es{As/Xs}, Bs = Es{Bs/Xs} and Es ~ Fs. Then As ~ Bs. - -Theorem strong_equiv_presd_by_rec : - !Xs Es Fs As Bs. - CCS_equation Xs Es /\ CCS_equation Xs Fs /\ - CCS_solution Xs Es (=) As /\ - CCS_solution Xs Fs (=) Bs /\ STRONG_EQUIV Es Fs ==> STRONG_EQUIV As Bs -Proof - ... -QED - *) - -(* Proposition 4.12 of [1], the univariate version (unconfirmed): - - Let P and Q contain (free, recursion) variable X at most. - Let A = P{A/X} (or `rec X P`), B = Q{B/X} (or `rec X Q`) and E ~ F. - Then A ~ B. - -Theorem STRONG_EQUIV_PRESD_BY_REC : - !X P Q. (FV P) SUBSET {X} /\ (FV Q) SUBSET {X} /\ - STRONG_EQUIV P Q ==> STRONG_EQUIV (rec X P) (rec X Q) -Proof - ... -QED + [4] Gorrieri, R., Versari, C.: Introduction to Concurrency Theory. + Springer, Cham (2015). -(* the name "observationally_guarded" is from [4, p.104] - TODO: instead of changing SEQ to GSEQ, we should change SG to OG *) -Definition observationally_guarded_def : - observationally_guarded Xs = - \E. DISJOINT (BV E) (set Xs) /\ - EVERY (\X. OG (\t. CCS_Subst E t X)) Xs -End *) - -val _ = export_theory (); -val _ = html_theory "Multivariate"; -val _ = print_theory_to_file "-" "MultivariateTheory.lst"; diff --git a/examples/CCS/ObsCongrLawsScript.sml b/examples/CCS/ObsCongrLawsScript.sml index d96b2e0e17..27984768fa 100644 --- a/examples/CCS/ObsCongrLawsScript.sml +++ b/examples/CCS/ObsCongrLawsScript.sml @@ -5,10 +5,8 @@ open HolKernel Parse boolLib bossLib; -open CCSLib CCSTheory; -open StrongEQTheory StrongEQLib StrongLawsTheory; -open WeakEQTheory WeakEQLib WeakLawsTheory; -open ObsCongrTheory ObsCongrLib; +open CCSLib CCSTheory StrongEQTheory StrongEQLib StrongLawsTheory + WeakEQTheory WeakEQLib WeakLawsTheory ObsCongrTheory ObsCongrLib; val _ = new_theory "ObsCongrLaws"; @@ -121,7 +119,7 @@ val OBS_PAR_TAU_TAU = save_thm ( *) val OBS_PAR_PREF_NO_SYNCR = save_thm ( "OBS_PAR_PREF_NO_SYNCR", - STRIP_FORALL_RULE ((DISCH ``~((l :'b Label) = COMPL l')``) o + STRIP_FORALL_RULE ((DISCH ``~((l :'a Label) = COMPL l')``) o (STRIP_FORALL_RULE (MATCH_MP STRONG_IMP_OBS_CONGR)) o UNDISCH) STRONG_PAR_PREF_NO_SYNCR); @@ -138,7 +136,7 @@ val OBS_PAR_PREF_NO_SYNCR = save_thm ( *) val OBS_PAR_PREF_SYNCR = save_thm ( "OBS_PAR_PREF_SYNCR", - STRIP_FORALL_RULE ((DISCH ``((l :'b Label) = COMPL l')``) o + STRIP_FORALL_RULE ((DISCH ``((l :'a Label) = COMPL l')``) o (STRIP_FORALL_RULE (MATCH_MP STRONG_IMP_OBS_CONGR)) o UNDISCH) STRONG_PAR_PREF_SYNCR); @@ -194,15 +192,15 @@ val OBS_RESTR_PREFIX_TAU = save_thm ( val OBS_RESTR_PR_LAB_NIL = save_thm ( "OBS_RESTR_PR_LAB_NIL", ((Q.GENL [`l`, `L`]) o - (DISCH ``(l :'b Label) IN L \/ (COMPL l) IN L``) o + (DISCH ``(l :'a Label) IN L \/ (COMPL l) IN L``) o (Q.GEN `E`) o UNDISCH) (IMP_TRANS - (DISCH ``(l :'b Label) IN L \/ (COMPL l) IN L`` + (DISCH ``(l :'a Label) IN L \/ (COMPL l) IN L`` (Q.SPEC `E` (UNDISCH (Q.SPECL [`l`, `L`] STRONG_RESTR_PR_LAB_NIL)))) - (SPECL [``restr (L :'b Label set) (prefix (label l) E)``, ``nil``] + (SPECL [``restr (L :'a Label set) (prefix (label l) E)``, ``nil``] STRONG_IMP_OBS_CONGR))); (* Prove OBS_RESTR_PREFIX_LABEL: @@ -213,16 +211,16 @@ val OBS_RESTR_PR_LAB_NIL = save_thm ( val OBS_RESTR_PREFIX_LABEL = save_thm ( "OBS_RESTR_PREFIX_LABEL", ((Q.GENL [`l`, `L`]) o - (DISCH ``~((l :'b Label) IN L) /\ ~((COMPL l) IN L)``) o + (DISCH ``~((l :'a Label) IN L) /\ ~((COMPL l) IN L)``) o (Q.GEN `E`) o UNDISCH) (IMP_TRANS - (DISCH ``~((l :'b Label) IN L) /\ ~((COMPL l) IN L)`` + (DISCH ``~((l :'a Label) IN L) /\ ~((COMPL l) IN L)`` (Q.SPEC `E` (UNDISCH (Q.SPECL [`l`, `L`] STRONG_RESTR_PREFIX_LABEL)))) - (SPECL [``restr (L :'b Label set) (prefix (label l) E)``, - ``prefix (label (l :'b Label)) (restr L E)``] + (SPECL [``restr (L :'a Label set) (prefix (label l) E)``, + ``prefix (label (l :'a Label)) (restr L E)``] STRONG_IMP_OBS_CONGR))); (******************************************************************************) @@ -288,7 +286,7 @@ val OBS_RELAB_PREFIX = save_thm ( |- !u E. OBS_CONGR (prefix u (prefix tau E)) (prefix u E) *) val TAU1 = store_thm ("TAU1", - ``!(u :'b Action) E. OBS_CONGR (prefix u (prefix tau E)) (prefix u E)``, + ``!(u :'a Action) E. OBS_CONGR (prefix u (prefix tau E)) (prefix u E)``, REPEAT GEN_TAC >> PURE_ONCE_REWRITE_TAC [OBS_CONGR] >> REPEAT STRIP_TAC (* 2 sub-goals here *) @@ -296,15 +294,15 @@ val TAU1 = store_thm ("TAU1", IMP_RES_TAC TRANS_PREFIX \\ Q.EXISTS_TAC `E` \\ ASM_REWRITE_TAC [WEAK_TRANS, TAU_WEAK] \\ - EXISTS_TAC ``prefix (u :'b Action) E`` \\ + EXISTS_TAC ``prefix (u :'a Action) E`` \\ Q.EXISTS_TAC `E` \\ ASM_REWRITE_TAC [EPS_REFL, PREFIX], (* goal 2 (of 2) *) IMP_RES_TAC TRANS_PREFIX \\ - EXISTS_TAC ``prefix (tau :'b Action) E2`` \\ + EXISTS_TAC ``prefix (tau :'a Action) E2`` \\ ASM_REWRITE_TAC [WEAK_TRANS, TAU_WEAK] \\ - EXISTS_TAC ``prefix (u :'b Action) (prefix tau E2)`` \\ - EXISTS_TAC ``prefix (tau :'b Action) E2`` \\ + EXISTS_TAC ``prefix (u :'a Action) (prefix tau E2)`` \\ + EXISTS_TAC ``prefix (tau :'a Action) E2`` \\ ASM_REWRITE_TAC [EPS_REFL, PREFIX] ]); (* Prove WEAK_TAU1: @@ -356,7 +354,7 @@ val WEAK_TAU2 = save_thm ("WEAK_TAU2", (prefix u (sum E (prefix tau E'))) *) val TAU3 = store_thm ("TAU3", - ``!(u :'b Action) E E'. + ``!(u :'a Action) E E'. OBS_CONGR (sum (prefix u (sum E (prefix tau E'))) (prefix u E')) (prefix u (sum E (prefix tau E')))``, REPEAT GEN_TAC @@ -373,7 +371,7 @@ val TAU3 = store_thm ("TAU3", IMP_RES_TAC TRANS_PREFIX \\ Q.EXISTS_TAC `E1` \\ ASM_REWRITE_TAC [WEAK_TRANS, WEAK_EQUIV_REFL] \\ - take [`prefix (u :'b Action) (sum E (prefix tau E'))`, + take [`prefix (u :'a Action) (sum E (prefix tau E'))`, `sum E (prefix tau E')`] \\ REWRITE_TAC [EPS_REFL, PREFIX] \\ MATCH_MP_TAC ONE_TAU \\ diff --git a/examples/CCS/ObsCongrScript.sml b/examples/CCS/ObsCongrScript.sml index 51436ce5a6..e8939b4571 100644 --- a/examples/CCS/ObsCongrScript.sml +++ b/examples/CCS/ObsCongrScript.sml @@ -6,9 +6,9 @@ open HolKernel Parse boolLib bossLib; open pred_setTheory relationTheory; -open CCSLib CCSTheory; -open StrongEQTheory StrongLawsTheory; -open WeakEQTheory WeakEQLib WeakLawsTheory; + +open CCSLib CCSTheory StrongEQTheory StrongLawsTheory + WeakEQTheory WeakEQLib WeakLawsTheory; val _ = new_theory "ObsCongr"; val _ = temp_loose_equality (); @@ -22,8 +22,8 @@ val _ = temp_loose_equality (); (* Define the observation congruence over CCS agents expressions. *) val OBS_CONGR = new_definition ("OBS_CONGR", - ``OBS_CONGR (E :('a, 'b) CCS) (E' :('a, 'b) CCS) = - (!(u :'b Action). + ``OBS_CONGR (E :'a CCS) (E' :'a CCS) = + (!(u :'a Action). (!E1. TRANS E u E1 ==> ?E2. WEAK_TRANS E' u E2 /\ WEAK_EQUIV E1 E2) /\ (!E2. TRANS E' u E2 ==> @@ -41,14 +41,14 @@ val _ = TeX_notation { hol = UTF8.chr 0x2248 ^ UTF8.chr 0x1D9C, val OBS_CONGR_TRANS_LEFT = store_thm ( "OBS_CONGR_TRANS_LEFT", - ``!E E'. OBS_CONGR (E :('a, 'b) CCS) (E' :('a, 'b) CCS) ==> + ``!E E'. OBS_CONGR (E :'a CCS) (E' :'a CCS) ==> !u E1. TRANS E u E1 ==> ?E2. WEAK_TRANS E' u E2 /\ WEAK_EQUIV E1 E2``, PROVE_TAC [OBS_CONGR]); val OBS_CONGR_TRANS_RIGHT = store_thm ( "OBS_CONGR_TRANS_RIGHT", - ``!E E'. OBS_CONGR (E :('a, 'b) CCS) (E' :('a, 'b) CCS) ==> + ``!E E'. OBS_CONGR (E :'a CCS) (E' :'a CCS) ==> !u E2. TRANS E' u E2 ==> ?E1. WEAK_TRANS E u E1 /\ WEAK_EQUIV E1 E2``, PROVE_TAC [OBS_CONGR]); @@ -75,7 +75,7 @@ val WEAK_EQUIV_STABLE_IMP_CONGR = store_thm ( >| [ (* goal 1 (of 2) *) RES_TAC \\ IMP_RES_TAC Action_no_tau_is_Label \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'b Action) = label x``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'a Action) = label x``] (ASSUME ``TRANS E u E1``)) \\ IMP_RES_TAC (CONJUNCT1 (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] @@ -83,7 +83,7 @@ val WEAK_EQUIV_STABLE_IMP_CONGR = store_thm ( Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [], (* goal 2 (of 2) *) RES_TAC THEN IMP_RES_TAC Action_no_tau_is_Label \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'b Action) = label x``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'a Action) = label x``] (ASSUME ``TRANS E' u E2``)) \\ IMP_RES_TAC (CONJUNCT1 (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] @@ -254,14 +254,14 @@ val PROP6 = store_thm ("PROP6", IMP_RES_TAC TRANS_PREFIX \\ Q.EXISTS_TAC `E'` \\ ASM_REWRITE_TAC [WEAK_TRANS] \\ - EXISTS_TAC ``prefix (u :'b Action) E'`` \\ + EXISTS_TAC ``prefix (u :'a Action) E'`` \\ Q.EXISTS_TAC `E'` \\ ASM_REWRITE_TAC [EPS_REFL, PREFIX], (* goal 2 (of 2) *) IMP_RES_TAC TRANS_PREFIX \\ Q.EXISTS_TAC `E` \\ ASM_REWRITE_TAC [WEAK_TRANS] \\ - EXISTS_TAC ``prefix (u :'b Action) E`` \\ + EXISTS_TAC ``prefix (u :'a Action) E`` \\ Q.EXISTS_TAC `E` \\ ASM_REWRITE_TAC [EPS_REFL, PREFIX] ]); @@ -395,7 +395,7 @@ val OBS_CONGR_PRESD_BY_PAR = store_thm ( (CONJ (ASSUME ``EPS E2''''' E2'''``) (ASSUME ``EPS E2'''''' E2''''``))] \\ MATCH_MP_TAC PAR3 \\ - EXISTS_TAC ``l: 'b Label`` >> ASM_REWRITE_TAC [] ], + EXISTS_TAC ``l :'a Label`` >> ASM_REWRITE_TAC [] ], (* goal 2 (of 2) *) IMP_RES_TAC TRANS_PAR >| (* 3 sub-goals here *) [ (* goal 2.1 (of 3) *) @@ -457,7 +457,7 @@ val OBS_CONGR_PRESD_BY_PAR = store_thm ( (CONJ (ASSUME ``EPS E2'''' E1'''``) (ASSUME ``EPS E2''''' E1''''``))] \\ MATCH_MP_TAC PAR3 \\ - EXISTS_TAC ``l: 'b Label`` >> ASM_REWRITE_TAC [] ] ]); + EXISTS_TAC ``l :'a Label`` >> ASM_REWRITE_TAC [] ] ]); (* Observation congruence is substitutive under parallel operator on the left: !E E'. OBS_CONGR E E' ==> (!E''. OBS_CONGR (par E'' E) (par E'' E')) @@ -496,19 +496,19 @@ val OBS_CONGR_SUBST_RESTR = store_thm ( RES_TAC \\ ASSUME_TAC (MATCH_MP WEAK_RESTR_tau - (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``] + (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``] (ASSUME ``WEAK_TRANS E' u E2``))) \\ - EXISTS_TAC ``restr (L :'b Label set) E2`` \\ + EXISTS_TAC ``restr (L :'a Label set) E2`` \\ IMP_RES_TAC WEAK_EQUIV_SUBST_RESTR >> ASM_REWRITE_TAC [], (* goal 1.2 (of 2) *) RES_TAC \\ ASSUME_TAC (MATCH_MP WEAK_RESTR_label - (LIST_CONJ [ASSUME ``~((l :'b Label) IN L)``, - ASSUME ``~((COMPL (l :'b Label)) IN L)``, - REWRITE_RULE [ASSUME ``(u :'b Action) = label l``] + (LIST_CONJ [ASSUME ``~((l :'a Label) IN L)``, + ASSUME ``~((COMPL (l :'a Label)) IN L)``, + REWRITE_RULE [ASSUME ``(u :'a Action) = label l``] (ASSUME ``WEAK_TRANS E' u E2``)])) \\ - EXISTS_TAC ``restr (L :'b Label set) E2`` \\ + EXISTS_TAC ``restr (L :'a Label set) E2`` \\ IMP_RES_TAC WEAK_EQUIV_SUBST_RESTR >> ASM_REWRITE_TAC [] ], (* goal 2 (of 2) *) IMP_RES_TAC TRANS_RESTR >| (* 2 sub-goals here *) @@ -516,19 +516,19 @@ val OBS_CONGR_SUBST_RESTR = store_thm ( RES_TAC \\ ASSUME_TAC (MATCH_MP WEAK_RESTR_tau - (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``] + (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``] (ASSUME ``WEAK_TRANS E u E1``))) \\ - EXISTS_TAC ``restr (L :'b Label set) E1`` \\ + EXISTS_TAC ``restr (L :'a Label set) E1`` \\ IMP_RES_TAC WEAK_EQUIV_SUBST_RESTR >> ASM_REWRITE_TAC [], (* goal 2.2 (of 2) *) RES_TAC \\ ASSUME_TAC (MATCH_MP WEAK_RESTR_label - (LIST_CONJ [ASSUME ``~((l: 'b Label) IN L)``, - ASSUME ``~((COMPL (l :'b Label)) IN L)``, - REWRITE_RULE [ASSUME ``(u :'b Action) = label l``] + (LIST_CONJ [ASSUME ``~((l :'a Label) IN L)``, + ASSUME ``~((COMPL (l :'a Label)) IN L)``, + REWRITE_RULE [ASSUME ``(u :'a Action) = label l``] (ASSUME ``WEAK_TRANS E u E1``)])) \\ - EXISTS_TAC ``restr (L :'b Label set) E1`` \\ + EXISTS_TAC ``restr (L :'a Label set) E1`` \\ IMP_RES_TAC WEAK_EQUIV_SUBST_RESTR >> ASM_REWRITE_TAC [] ] ]); (* Observation congruence is substitutive under the relabelling operator. *) diff --git a/examples/CCS/StrongEQScript.sml b/examples/CCS/StrongEQScript.sml index b3977f8900..9d116383f5 100644 --- a/examples/CCS/StrongEQScript.sml +++ b/examples/CCS/StrongEQScript.sml @@ -1,16 +1,22 @@ -(* - * Copyright 1991-1995 University of Cambridge (Author: Monica Nesi) - * Copyright 2016-2017 University of Bologna, Italy (Author: Chun Tian) - * Copyright 2018-2019 Fondazione Bruno Kessler, Italy (Author: Chun Tian) - *) +(* ========================================================================== *) +(* FILE : StrongEQScript.sml *) +(* DESCRIPTION : Strong bisimulation and strong bisimularity (STRONG_EQUIV) *) +(* *) +(* COPYRIGHTS : 1991-1995 University of Cambridge, UK (Monica Nesi) *) +(* 2016-2017 University of Bologna, Italy (Chun Tian) *) +(* 2018-2019 Fondazione Bruno Kessler, Italy (Chun Tian) *) +(******************************************************************************) open HolKernel Parse boolLib bossLib; -open pred_setTheory pairTheory relationTheory bisimulationTheory listTheory; +open pred_setTheory pairTheory relationTheory bisimulationTheory listTheory + finite_mapTheory; + open CCSLib CCSTheory; val _ = new_theory "StrongEQ"; -val _ = temp_loose_equality (); + +val _ = temp_delsimps ["lift_disj_eq", "lift_imp_disj"]; (******************************************************************************) (* *) @@ -19,15 +25,16 @@ val _ = temp_loose_equality (); (******************************************************************************) (* Type abbreviations *) -val _ = type_abbrev_pp ("simulation", ``:('a, 'b) CCS -> ('a, 'b) CCS -> bool``); +Type simulation = “:'a CCS -> 'a CCS -> bool” (* new definition based on relationTheory.BISIM *) -val STRONG_BISIM_def = Define - `STRONG_BISIM (R :('a, 'b) simulation) = BISIM TRANS R`; +Definition STRONG_BISIM_def : + STRONG_BISIM = BISIM TRANS +End (* original definition of STRONG_BISIM, now becomes a theorem *) Theorem STRONG_BISIM : - STRONG_BISIM (Bsm :('a, 'b) simulation) = + STRONG_BISIM (Bsm :'a simulation) = !E E'. Bsm E E' ==> !u. (!E1. TRANS E u E1 ==> @@ -69,8 +76,15 @@ Proof REWRITE_TAC [STRONG_BISIM_def, BISIM_RUNION] QED -(* The (strong) bisimilarity, now based on BISIM_REL *) -val STRONG_EQUIV_def = Define `STRONG_EQUIV = BISIM_REL TRANS`; +(* The strong bisimilarity is now based on bisimulationTheory.BISIM_REL + + NOTE: this definition only works for closed CCS terms (IS_PROC), or + arbitrary CCS terms in which open ‘var s’ has the same transition + behavior with ‘nil’ (cf. NIL_NO_TRANS and VAR_NO_TRANS.) + *) +Definition STRONG_EQUIV_def : + STRONG_EQUIV = BISIM_REL TRANS +End val _ = add_rule { block_style = (AroundEachPhrase, (PP.CONSISTENT, 0)), fixity = Infix (NONASSOC, 450), @@ -132,7 +146,7 @@ Proof REWRITE_TAC [STRONG_EQUIV_def, BISIM_REL_IS_EQUIV_REL] QED -Theorem STRONG_EQUIV_REFL : +Theorem STRONG_EQUIV_REFL[simp] : !E. STRONG_EQUIV E E Proof PROVE_TAC [REWRITE_RULE [equivalence_def, reflexive_def] @@ -146,6 +160,12 @@ Proof STRONG_EQUIV_equivalence] QED +Theorem STRONG_EQUIV_SYM_EQ : + !E E'. STRONG_EQUIV E E' <=> STRONG_EQUIV E' E +Proof + rpt GEN_TAC >> EQ_TAC >> rw [STRONG_EQUIV_SYM] +QED + Theorem STRONG_EQUIV_TRANS : !E E' E''. STRONG_EQUIV E E' /\ STRONG_EQUIV E' E'' ==> STRONG_EQUIV E E'' Proof @@ -193,10 +213,10 @@ val STRONG_EQUIV_SUBST_PREFIX = store_thm ( STRONG_EQUIV E E' ==> !u. STRONG_EQUIV (prefix u E) (prefix u E')``, REPEAT GEN_TAC >> PURE_ONCE_REWRITE_TAC - [SPECL [``prefix (u :'b Action) E``, ``prefix (u :'b Action) E'``] PROPERTY_STAR] + [SPECL [``prefix (u :'a Action) E``, ``prefix (u :'a Action) E'``] PROPERTY_STAR] >> REPEAT STRIP_TAC (* 2 sub-goals here *) - >| [ EXISTS_TAC ``E' :('a, 'b) CCS``, - EXISTS_TAC ``E :('a, 'b) CCS``] + >| [ EXISTS_TAC ``E' :'a CCS``, + EXISTS_TAC ``E :'a CCS``] >> IMP_RES_TAC TRANS_PREFIX >> ASM_REWRITE_TAC [PREFIX]); @@ -212,14 +232,14 @@ val STRONG_EQUIV_PRESD_BY_SUM = store_thm ( >| [ (* goal 1 *) IMP_RES_TAC TRANS_SUM \\ (* 2 sub-goals here *) RES_TAC \\ - EXISTS_TAC ``E2'' :('a, 'b) CCS`` \\ + EXISTS_TAC ``E2'' :'a CCS`` \\ ASM_REWRITE_TAC [] >| [ MATCH_MP_TAC SUM1, MATCH_MP_TAC SUM2 ] \\ ASM_REWRITE_TAC [], (* goal 2 *) IMP_RES_TAC TRANS_SUM \\ (* 2 sub-goals here *) RES_TAC \\ - EXISTS_TAC ``E1'' :('a, 'b) CCS`` \\ + EXISTS_TAC ``E1'' :'a CCS`` \\ ASM_REWRITE_TAC [] >| [ MATCH_MP_TAC SUM1, MATCH_MP_TAC SUM2] \\ ASM_REWRITE_TAC [] ]); @@ -313,7 +333,7 @@ val STRONG_EQUIV_PRESD_BY_PAR = store_thm ( CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.1.3.1 (of 2) *) MATCH_MP_TAC PAR3 \\ - EXISTS_TAC ``l: 'b Label`` \\ + EXISTS_TAC ``l: 'a Label`` \\ ASM_REWRITE_TAC [], (* goal 2.1.3.2 (of 2) *) take [`E1'''`, `E2'''`, `E2''`, `E2''''`] \\ @@ -357,7 +377,7 @@ val STRONG_EQUIV_PRESD_BY_PAR = store_thm ( CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.2.3.1 (of 2) *) MATCH_MP_TAC PAR3 \\ - EXISTS_TAC ``l: 'b Label`` \\ + EXISTS_TAC ``l: 'a Label`` \\ ASM_REWRITE_TAC [], (* goal 2.2.3.2 (of 2) *) take [`E1'''`, `E1''`, `E1''''`, `E2'''`] \\ @@ -419,12 +439,12 @@ val STRONG_EQUIV_SUBST_RESTR = store_thm ( [ (* goal 2.1.1 (of 2) *) IMP_RES_TAC (ONCE_REWRITE_RULE [PROPERTY_STAR] (ASSUME ``STRONG_EQUIV E1 E2``)) \\ - EXISTS_TAC ``restr (L' :'b Label set) E2'`` \\ + EXISTS_TAC ``restr (L' :'a Label set) E2'`` \\ CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.1.1.1 (of 2) *) ASM_REWRITE_TAC [] \\ MATCH_MP_TAC RESTR \\ - REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'b Action) = tau``] + REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'a Action) = tau``] (ASSUME ``TRANS E2 u E2'``)], (* goal 2.1.1.2 (of 2) *) take [`E''''`, `E2'`, `L'`] \\ @@ -432,13 +452,13 @@ val STRONG_EQUIV_SUBST_RESTR = store_thm ( (* goal 2.1.2 (of 2) *) IMP_RES_TAC (ONCE_REWRITE_RULE [PROPERTY_STAR] (ASSUME ``STRONG_EQUIV E1 E2``)) \\ - EXISTS_TAC ``restr (L' :'b Label set) E2'`` \\ + EXISTS_TAC ``restr (L' :'a Label set) E2'`` \\ CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.1.2.1 (of 2) *) ASM_REWRITE_TAC [] \\ MATCH_MP_TAC RESTR \\ - EXISTS_TAC ``l: 'b Label`` \\ - ASM_REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'b Action) = label l``] + EXISTS_TAC ``l: 'a Label`` \\ + ASM_REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'a Action) = label l``] (ASSUME ``TRANS E2 u E2'``)], (* goal 2.1.2.2 (of 2) *) take [`E''''`, `E2'`, `L'`] \\ @@ -450,12 +470,12 @@ val STRONG_EQUIV_SUBST_RESTR = store_thm ( [ (* goal 2.2.1 (of 2) *) IMP_RES_TAC (ONCE_REWRITE_RULE [PROPERTY_STAR] (ASSUME ``STRONG_EQUIV E1 E2``)) \\ - EXISTS_TAC ``restr (L' :'b Label set) E1'`` \\ + EXISTS_TAC ``restr (L' :'a Label set) E1'`` \\ CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.2.1.1 (of 2) *) ASM_REWRITE_TAC [] \\ MATCH_MP_TAC RESTR \\ - REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'b Action) = tau``] + REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'a Action) = tau``] (ASSUME ``TRANS E1 u E1'``)], (* goal 2.2.1.2 (of 2) *) take [`E1'`, `E''''`, `L'`] \\ @@ -463,13 +483,13 @@ val STRONG_EQUIV_SUBST_RESTR = store_thm ( (* goal 2.2.2 (of 2) *) IMP_RES_TAC (ONCE_REWRITE_RULE [PROPERTY_STAR] (ASSUME ``STRONG_EQUIV E1 E2``)) \\ - EXISTS_TAC ``restr (L' :'b Label set) E1'`` \\ + EXISTS_TAC ``restr (L' :'a Label set) E1'`` \\ CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.2.2.1 (of 2) *) ASM_REWRITE_TAC [] \\ MATCH_MP_TAC RESTR \\ - EXISTS_TAC ``l: 'b Label`` \\ - ASM_REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'b Action) = label l``] + EXISTS_TAC ``l: 'a Label`` \\ + ASM_REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'a Action) = label l``] (ASSUME ``TRANS E1 u E1'``)], (* goal 2.2.2.2 (of 2) *) take [`E1'`, `E''''`, `L'`] \\ @@ -525,5 +545,110 @@ val STRONG_EQUIV_SUBST_RELAB = store_thm ( take [`E1'`, `E''''`, `rf'`] \\ ASM_REWRITE_TAC [] ] ] ]); +(******************************************************************************) +(* *) +(* The clasic proof of PROPERTY_STAR [1, p.91] *) +(* *) +(******************************************************************************) + +(* Currently we define STRONG_EQUIV (strong bisimilarity) by HOL's co-inductive + relation package (Hol_coreln): + +CoInductive STRONG_EQUIV : + !(E :'a CCS) (E' :'a CCS). + (!u. + (!E1. TRANS E u E1 ==> + (?E2. TRANS E' u E2 /\ STRONG_EQUIV E1 E2)) /\ + (!E2. TRANS E' u E2 ==> + (?E1. TRANS E u E1 /\ STRONG_EQUIV E1 E2))) ==> STRONG_EQUIV E E' +End + + then the 3rd returned value (STRONG_EQUIV_cases) is just the PROPERTY_STAR: + +(* Prop. 4, page 91: strong equivalence satisfies property [*] *) +val PROPERTY_STAR = save_thm ((* NEW *) + "PROPERTY_STAR", STRONG_EQUIV_cases); + + However, if we started with the original definition of STRONG_EQUIV: + +Definition STRONG_EQUIV : + STRONG_EQUIV E E' = ?Bsm. Bsm E E' /\ STRONG_BISIM Bsm +End + + It's not easy to prove PROPERTY_STAR. Below is the proof of Robin Milner through + a temporarily definition STRONG_EQUIV', originally formalized by Monica Nesi. + *) + +(* Definition 3, page 91 in Milner's book. *) +val STRONG_EQUIV' = new_definition ( + "STRONG_EQUIV'", + ``STRONG_EQUIV' E E' = + (!u. + (!E1. TRANS E u E1 ==> + (?E2. TRANS E' u E2 /\ STRONG_EQUIV E1 E2)) /\ + (!E2. TRANS E' u E2 ==> + (?E1. TRANS E u E1 /\ STRONG_EQUIV E1 E2)))``); + +(* Strong equivalence implies the new relation. *) +val STRONG_EQUIV_IMP_STRONG_EQUIV' = store_thm ( + "STRONG_EQUIV_IMP_STRONG_EQUIV'", + ``!E E'. STRONG_EQUIV E E' ==> STRONG_EQUIV' E E'``, + rpt GEN_TAC + >> REWRITE_TAC [STRONG_EQUIV', STRONG_EQUIV] + >> rpt STRIP_TAC (* 2 sub-goals *) + >> IMP_RES_TAC + (MATCH_MP (EQ_MP STRONG_BISIM (ASSUME ``STRONG_BISIM Bsm``)) + (ASSUME ``(Bsm: 'a simulation) E E'``)) + >| [ Q.EXISTS_TAC `E2`, + Q.EXISTS_TAC `E1` ] + >> ASM_REWRITE_TAC [] + >> Q.EXISTS_TAC `Bsm` + >> ASM_REWRITE_TAC [] ); + +val STRONG_EQUIV'_IS_STRONG_BISIM = store_thm ( + "STRONG_EQUIV'_IS_STRONG_BISIM", + ``STRONG_BISIM STRONG_EQUIV'``, + PURE_ONCE_REWRITE_TAC [STRONG_BISIM] + >> rpt STRIP_TAC (* 2 sub-goals here *) + >> IMP_RES_TAC + (EQ_MP (Q.SPECL [`E`, `E'`] STRONG_EQUIV') + (ASSUME ``STRONG_EQUIV' E E'``)) + >| [ Q.EXISTS_TAC `E2`, + Q.EXISTS_TAC `E1` ] + >> IMP_RES_TAC STRONG_EQUIV_IMP_STRONG_EQUIV' + >> ASM_REWRITE_TAC []); + +(* The new relation implies strong equivalence. *) +val STRONG_EQUIV'_IMP_STRONG_EQUIV = store_thm ( + "STRONG_EQUIV'_IMP_STRONG_EQUIV", + ``!E E'. STRONG_EQUIV' E E' ==> STRONG_EQUIV E E'``, + rpt STRIP_TAC + >> PURE_ONCE_REWRITE_TAC [STRONG_EQUIV] + >> EXISTS_TAC ``STRONG_EQUIV'`` + >> ASM_REWRITE_TAC [STRONG_EQUIV'_IS_STRONG_BISIM]); + +(* Prop. 4, page 91: strong equivalence satisfies property [*] *) +val PROPERTY_STAR' = store_thm ( + "PROPERTY_STAR'", + ``!E E'. STRONG_EQUIV E E' = + (!u. + (!E1. TRANS E u E1 ==> + (?E2. TRANS E' u E2 /\ STRONG_EQUIV E1 E2)) /\ + (!E2. TRANS E' u E2 ==> + (?E1. TRANS E u E1 /\ STRONG_EQUIV E1 E2)))``, + rpt GEN_TAC + >> EQ_TAC (* 2 sub-goals here *) + >| [ PURE_ONCE_REWRITE_TAC + [ONCE_REWRITE_RULE [STRONG_EQUIV'] STRONG_EQUIV_IMP_STRONG_EQUIV'], + PURE_ONCE_REWRITE_TAC + [ONCE_REWRITE_RULE [STRONG_EQUIV'] STRONG_EQUIV'_IMP_STRONG_EQUIV] ]); + val _ = export_theory (); val _ = html_theory "StrongEQ"; + +(* Bibliography: + + [1] Milner, Robin. Communication and concurrency. Prentice hall, 1989. + [2] Gorrieri, R., Versari, C.: Introduction to Concurrency Theory. Springer (2015). + + *) diff --git a/examples/CCS/StrongLawsConv.sml b/examples/CCS/StrongLawsConv.sml index 92bbf19a8a..b03cb41982 100644 --- a/examples/CCS/StrongLawsConv.sml +++ b/examples/CCS/StrongLawsConv.sml @@ -9,6 +9,7 @@ struct open HolKernel Parse boolLib bossLib; open prim_recTheory arithmeticTheory numTheory numLib; open PFset_conv IndDefRules listSyntax stringLib; + open CCSLib CCSTheory CCSSyntax CCSConv; open StrongEQTheory StrongEQLib StrongLawsTheory; diff --git a/examples/CCS/StrongLawsScript.sml b/examples/CCS/StrongLawsScript.sml index cbe1082823..0fd54a4335 100644 --- a/examples/CCS/StrongLawsScript.sml +++ b/examples/CCS/StrongLawsScript.sml @@ -7,6 +7,7 @@ open HolKernel Parse boolLib bossLib; open pred_setTheory prim_recTheory arithmeticTheory relationTheory; + open CCSLib CCSTheory StrongEQTheory StrongEQLib; val _ = new_theory "StrongLaws"; @@ -29,7 +30,7 @@ val STRONG_SUM_IDENT_R = store_thm ( >| [ (* goal 1 (of 2) *) BETA_TAC \\ DISJ2_TAC \\ - EXISTS_TAC ``E :('a, 'b) CCS`` \\ + EXISTS_TAC ``E :'a CCS`` \\ REWRITE_TAC [], (* goal 2 (of 2) *) PURE_ONCE_REWRITE_TAC [STRONG_BISIM] \\ @@ -37,7 +38,7 @@ val STRONG_SUM_IDENT_R = store_thm ( rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 2.1 (of 4) *) Q.EXISTS_TAC `E1` \\ - art [REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + art [REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)], (* goal 2.2 (of 4) *) Q.EXISTS_TAC `E2` >> art [], @@ -47,7 +48,7 @@ val STRONG_SUM_IDENT_R = store_thm ( IMP_RES_TAC TRANS_SUM_NIL \\ Q.EXISTS_TAC `E1` >> art [], (* goal 2.4 (of 4) *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``E' :('a, 'b) CCS = E''``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E' :'a CCS = E''``] (ASSUME ``TRANS E' u E2``)) \\ Q.EXISTS_TAC `E2` >> art [] \\ MATCH_MP_TAC SUM1 \\ @@ -64,7 +65,7 @@ val STRONG_SUM_IDEMP = store_thm ( >| [ (* goal 1 (of 2) *) BETA_TAC \\ DISJ2_TAC \\ - EXISTS_TAC ``E :('a, 'b) CCS`` \\ + EXISTS_TAC ``E :'a CCS`` \\ REWRITE_TAC [], (* goal 2 (of 2) *) PURE_ONCE_REWRITE_TAC [STRONG_BISIM] \\ @@ -72,7 +73,7 @@ val STRONG_SUM_IDEMP = store_thm ( rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 2.1 (of 4) *) Q.EXISTS_TAC `E1` \\ - art [REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + art [REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)], (* goal 2.2 (of 4) *) Q.EXISTS_TAC `E2` >> art [], @@ -84,7 +85,7 @@ val STRONG_SUM_IDEMP = store_thm ( (* goal 2.4 (of 4) *) Q.EXISTS_TAC `E2` >> art [] \\ MATCH_MP_TAC SUM1 \\ - PURE_ONCE_REWRITE_TAC [REWRITE_RULE [ASSUME ``E' :('a, 'b) CCS = E''``] + PURE_ONCE_REWRITE_TAC [REWRITE_RULE [ASSUME ``E' :'a CCS = E''``] (ASSUME ``TRANS E' u E2``)] ] ]); (* Prove STRONG_SUM_COMM: |- !E E'. STRONG_EQUIV(sum E E') (sum E' E) *) @@ -98,8 +99,8 @@ val STRONG_SUM_COMM = store_thm ( >| [ (* goal 1 (of 2) *) BETA_TAC \\ DISJ2_TAC \\ - EXISTS_TAC ``E :('a, 'b) CCS`` \\ - EXISTS_TAC ``E' :('a, 'b) CCS`` \\ + EXISTS_TAC ``E :'a CCS`` \\ + EXISTS_TAC ``E' :'a CCS`` \\ REWRITE_TAC [], (* goal 2 (of 2) *) PURE_ONCE_REWRITE_TAC [STRONG_BISIM] \\ @@ -107,17 +108,17 @@ val STRONG_SUM_COMM = store_thm ( rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 2.1 (of 4) *) Q.EXISTS_TAC `E1` \\ - art [REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + art [REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)], (* goal 2.2 (of 4) *) Q.EXISTS_TAC `E2` >> art [], (* goal 2.3 (of 4) *) - EXISTS_TAC ``E1' :('a, 'b) CCS`` \\ + EXISTS_TAC ``E1' :'a CCS`` \\ art [REWRITE_RULE [ASSUME ``E = sum E1 E2``] (ASSUME ``TRANS E u E1'``), TRANS_COMM_EQ], (* goal 2.4 (of 4) *) - EXISTS_TAC ``E2' :('a, 'b) CCS`` \\ + EXISTS_TAC ``E2' :'a CCS`` \\ art [REWRITE_RULE [ASSUME ``E' = sum E2 E1``] (ASSUME ``TRANS E' u E2'``), TRANS_COMM_EQ] ] ]); @@ -125,9 +126,9 @@ val STRONG_SUM_COMM = store_thm ( (* Prove STRONG_SUM_IDENT_L: |- !E. STRONG_EQUIV (sum nil E) E *) val STRONG_SUM_IDENT_L = save_thm ( "STRONG_SUM_IDENT_L", - GEN ``E :('a, 'b) CCS`` - (S_TRANS (SPECL [``nil``, ``E :('a, 'b) CCS``] STRONG_SUM_COMM) - (SPEC ``E :('a, 'b) CCS`` STRONG_SUM_IDENT_R))); + GEN ``E :'a CCS`` + (S_TRANS (SPECL [``nil``, ``E :'a CCS``] STRONG_SUM_COMM) + (SPEC ``E :'a CCS`` STRONG_SUM_IDENT_R))); val STRONG_SUM_ASSOC_R = store_thm ( "STRONG_SUM_ASSOC_R", @@ -150,17 +151,17 @@ val STRONG_SUM_ASSOC_R = store_thm ( rpt STRIP_TAC >| (* 4 sub-goals *) [ (* goal 2.1 (of 4) *) Q.EXISTS_TAC `E1` \\ - art [REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + art [REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)], (* goal 2.2 (of 4) *) Q.EXISTS_TAC `E2` >> art [], (* goal 2.3 (of 4) *) - EXISTS_TAC ``E1' :('a, 'b) CCS`` >> art [] \\ + EXISTS_TAC ``E1' :'a CCS`` >> art [] \\ art [REWRITE_RULE [ASSUME ``E = sum (sum E1 E2) E3``] (ASSUME ``TRANS E u E1'``), SYM (SPEC_ALL TRANS_ASSOC_EQ)], (* goal 2.4 (of 4) *) - EXISTS_TAC ``E2' :('a, 'b) CCS`` \\ + EXISTS_TAC ``E2' :'a CCS`` \\ art [REWRITE_RULE [ASSUME ``E' = sum E1 (sum E2 E3)``] (ASSUME ``TRANS E' u E2'``), TRANS_ASSOC_EQ] ] ]); @@ -177,38 +178,38 @@ val STRONG_SUM_ASSOC_L = save_thm ( *) val STRONG_SUM_MID_IDEMP = save_thm ( "STRONG_SUM_MID_IDEMP", - GEN ``E :('a, 'b) CCS`` - (GEN ``E' :('a, 'b) CCS`` + GEN ``E :'a CCS`` + (GEN ``E' :'a CCS`` (S_TRANS - (SPEC ``E :('a, 'b) CCS`` + (SPEC ``E :'a CCS`` (MATCH_MP STRONG_EQUIV_SUBST_SUM_R (Q.SPECL [`E`, `E'`] STRONG_SUM_COMM))) (S_TRANS (Q.SPECL [`E'`, `E`, `E`] STRONG_SUM_ASSOC_R) - (SPEC ``E' :('a, 'b) CCS`` + (SPEC ``E' :'a CCS`` (MATCH_MP STRONG_EQUIV_SUBST_SUM_L - (SPEC ``E :('a, 'b) CCS`` STRONG_SUM_IDEMP))))))); + (SPEC ``E :'a CCS`` STRONG_SUM_IDEMP))))))); (* STRONG_LEFT_SUM_MID_IDEMP: |- !E E' E''. STRONG_EQUIV (sum (sum (sum E E') E'') E') (sum (sum E E'') E') *) val STRONG_LEFT_SUM_MID_IDEMP = save_thm ( "STRONG_LEFT_SUM_MID_IDEMP", - ((GEN ``E :('a, 'b) CCS``) o - (GEN ``E' :('a, 'b) CCS``) o - (GEN ``E'' :('a, 'b) CCS``)) + ((GEN ``E :'a CCS``) o + (GEN ``E' :'a CCS``) o + (GEN ``E'' :'a CCS``)) (S_TRANS (S_TRANS - (SPEC ``E' :('a, 'b) CCS`` + (SPEC ``E' :'a CCS`` (MATCH_MP STRONG_EQUIV_SUBST_SUM_R - (SPEC ``E'' :('a, 'b) CCS`` + (SPEC ``E'' :'a CCS`` (MATCH_MP STRONG_EQUIV_SUBST_SUM_R - (SPECL [``E :('a, 'b) CCS``, ``E' :('a, 'b) CCS``] STRONG_SUM_COMM))))) - (SPEC ``E' :('a, 'b) CCS`` + (SPECL [``E :'a CCS``, ``E' :'a CCS``] STRONG_SUM_COMM))))) + (SPEC ``E' :'a CCS`` (MATCH_MP STRONG_EQUIV_SUBST_SUM_R - (SPECL [``E' :('a, 'b) CCS``, ``E :('a, 'b) CCS``, ``E'' :('a, 'b) CCS``] + (SPECL [``E' :'a CCS``, ``E :'a CCS``, ``E'' :'a CCS``] STRONG_SUM_ASSOC_R)))) - (SPECL [``E' :('a, 'b) CCS``, ``sum E E''``] STRONG_SUM_MID_IDEMP))); + (SPECL [``E' :'a CCS``, ``sum E E''``] STRONG_SUM_MID_IDEMP))); (* Unused recursion variables have the same behavior as `nil` *) Theorem STRONG_EQUIV_NIL_VAR : @@ -234,7 +235,7 @@ val STRONG_PAR_IDENT_R = store_thm ( >> CONJ_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) BETA_TAC \\ - EXISTS_TAC ``E :('a, 'b) CCS`` \\ + EXISTS_TAC ``E :'a CCS`` \\ REWRITE_TAC [], (* goal 2 (of 2) *) PURE_ONCE_REWRITE_TAC [STRONG_BISIM] \\ @@ -244,15 +245,15 @@ val STRONG_PAR_IDENT_R = store_thm ( ASSUME_TAC (REWRITE_RULE [ASSUME ``E = par E'' nil``] (ASSUME ``TRANS E u E1``)) \\ IMP_RES_TAC TRANS_PAR_P_NIL \\ - EXISTS_TAC ``E''' :('a, 'b) CCS`` >> art [] \\ - EXISTS_TAC ``E''' :('a, 'b) CCS`` >> art [], + EXISTS_TAC ``E''' :'a CCS`` >> art [] \\ + EXISTS_TAC ``E''' :'a CCS`` >> art [], (* goal 2.2 (of 2) *) EXISTS_TAC ``par E2 nil`` \\ CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.2.1 (of 2) *) PURE_ONCE_ASM_REWRITE_TAC [] \\ MATCH_MP_TAC PAR1 \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``E' :('a, 'b) CCS = E''``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E' :'a CCS = E''``] (ASSUME ``TRANS E' u E2``)) \\ PURE_ONCE_ASM_REWRITE_TAC [], (* goal 2.2.2 (of 2) *) @@ -297,7 +298,7 @@ val STRONG_PAR_COMM = store_thm ( CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.1.3.1 (of 2) *) MATCH_MP_TAC PAR3 \\ - EXISTS_TAC ``COMPL (l :'b Label)`` >> art [COMPL_COMPL_LAB], + EXISTS_TAC ``COMPL (l :'a Label)`` >> art [COMPL_COMPL_LAB], (* goal 2.1.3.2 (of 2) *) take [`E1''`, `E2'`] >> REWRITE_TAC [] ] ], (* goal 2.2 (of 2) *) @@ -326,7 +327,7 @@ val STRONG_PAR_COMM = store_thm ( CONJ_TAC >| (* 2 sub-goals *) [ (* goal 2.2.3.1 (of 2) *) MATCH_MP_TAC PAR3 \\ - EXISTS_TAC ``COMPL (l :'b Label)`` \\ + EXISTS_TAC ``COMPL (l :'a Label)`` \\ art [COMPL_COMPL_LAB], (* goal 2.2.3.2 (of 2) *) take [`E2''`, `E1'`] >> REWRITE_TAC [] ] ] ] ]); @@ -335,8 +336,8 @@ val STRONG_PAR_COMM = store_thm ( val STRONG_PAR_IDENT_L = save_thm ( "STRONG_PAR_IDENT_L", GEN_ALL - (S_TRANS (SPECL [``nil``, ``E :('a, 'b) CCS``] STRONG_PAR_COMM) - (SPEC ``E :('a, 'b) CCS`` STRONG_PAR_IDENT_R))); + (S_TRANS (SPECL [``nil``, ``E :'a CCS``] STRONG_PAR_COMM) + (SPEC ``E :'a CCS`` STRONG_PAR_IDENT_R))); val STRONG_PAR_ASSOC = store_thm ( "STRONG_PAR_ASSOC", @@ -507,7 +508,7 @@ val STRONG_PAR_ASSOC = store_thm ( val STRONG_PAR_PREF_TAU = store_thm ( "STRONG_PAR_PREF_TAU", - ``!(u :'b Action) E E'. + ``!(u :'a Action) E E'. STRONG_EQUIV (par (prefix u E) (prefix tau E')) (sum (prefix u (par E (prefix tau E'))) (prefix tau (par (prefix u E) E')))``, @@ -515,7 +516,7 @@ val STRONG_PAR_PREF_TAU = store_thm ( >> PURE_ONCE_REWRITE_TAC [STRONG_EQUIV] >> EXISTS_TAC ``\x y. (x = y) \/ - (?(u' :'b Action) E1 E2. (x = par (prefix u' E1) (prefix tau E2)) /\ + (?(u' :'a Action) E1 E2. (x = par (prefix u' E1) (prefix tau E2)) /\ (y = sum (prefix u' (par E1 (prefix tau E2))) (prefix tau (par (prefix u' E1) E2))))`` >> CONJ_TAC (* 2 sub-goals *) @@ -529,13 +530,13 @@ val STRONG_PAR_PREF_TAU = store_thm ( BETA_TAC \\ rpt STRIP_TAC >| (* 4 sub-goals *) [ (* goal 2.1 (of 4) *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)) \\ Q.EXISTS_TAC `E1` >> art [], (* goal 2.2 (of 4) *) Q.EXISTS_TAC `E2` >> art [], (* goal 2.3 (of 4) *) - EXISTS_TAC ``E1' :('a, 'b) CCS`` >> art [] \\ + EXISTS_TAC ``E1' :'a CCS`` >> art [] \\ ASSUME_TAC (REWRITE_RULE [ASSUME ``E = par (prefix u' E1) (prefix tau E2)``] (ASSUME ``TRANS E u E1'``)) \\ IMP_RES_TAC TRANS_PAR >| (* 3 sub-goals *) @@ -549,7 +550,7 @@ val STRONG_PAR_PREF_TAU = store_thm ( IMP_RES_TAC TRANS_PREFIX \\ IMP_RES_TAC Action_distinct_label ], (* goal 2.4 (of 4) *) - EXISTS_TAC ``E2' :('a, 'b) CCS`` >> art [] \\ + EXISTS_TAC ``E2' :'a CCS`` >> art [] \\ ASSUME_TAC (REWRITE_RULE [ASSUME ``E' = sum (prefix u' (par E1 (prefix tau E2))) (prefix tau (par (prefix u' E1) E2))``] @@ -575,29 +576,29 @@ val STRONG_PAR_PREF_TAU = store_thm ( *) val STRONG_PAR_TAU_PREF = save_thm ( "STRONG_PAR_TAU_PREF", - ((GEN ``E :('a, 'b) CCS``) o - (GEN ``u: 'b Action``) o - (GEN ``E' :('a, 'b) CCS``)) + ((GEN ``E :'a CCS``) o + (GEN ``u :'a Action``) o + (GEN ``E' :'a CCS``)) (S_TRANS (S_TRANS (S_TRANS - (SPECL [``prefix (tau :'b Action) E``, ``prefix (u :'b Action) E'``] STRONG_PAR_COMM) - (SPECL [``u: 'b Action``, ``E' :('a, 'b) CCS``, ``E :('a, 'b) CCS``] STRONG_PAR_PREF_TAU)) - (SPECL [``prefix (u :'b Action) (par E' (prefix tau E))``, - ``prefix (tau :'b Action) (par (prefix u E') E)``] STRONG_SUM_COMM)) + (SPECL [``prefix (tau :'a Action) E``, ``prefix (u :'a Action) E'``] STRONG_PAR_COMM) + (SPECL [``u :'a Action``, ``E' :'a CCS``, ``E :'a CCS``] STRONG_PAR_PREF_TAU)) + (SPECL [``prefix (u :'a Action) (par E' (prefix tau E))``, + ``prefix (tau :'a Action) (par (prefix u E') E)``] STRONG_SUM_COMM)) (MATCH_MP STRONG_EQUIV_PRESD_BY_SUM - (CONJ (SPEC ``tau :'b Action`` + (CONJ (SPEC ``tau :'a Action`` (MATCH_MP STRONG_EQUIV_SUBST_PREFIX - (SPECL [``prefix (u :'b Action) E'``, ``E :('a, 'b) CCS``] STRONG_PAR_COMM))) - (SPEC ``u: 'b Action`` + (SPECL [``prefix (u :'a Action) E'``, ``E :'a CCS``] STRONG_PAR_COMM))) + (SPEC ``u :'a Action`` (MATCH_MP STRONG_EQUIV_SUBST_PREFIX - (SPECL [``E' :('a, 'b) CCS``, ``prefix (tau :'b Action) E``] STRONG_PAR_COMM))))))); + (SPECL [``E' :'a CCS``, ``prefix (tau :'a Action) E``] STRONG_PAR_COMM))))))); (* Prove STRONG_PAR_TAU_TAU: |- ∀E E'. τ..E || τ..E' ~ τ..(E || τ..E') + τ..(τ..E || E') *) val STRONG_PAR_TAU_TAU = save_thm ( - "STRONG_PAR_TAU_TAU", SPEC ``tau :'b Action`` STRONG_PAR_PREF_TAU); + "STRONG_PAR_TAU_TAU", SPEC ``tau :'a Action`` STRONG_PAR_PREF_TAU); (* Prove STRONG_PAR_PREF_NO_SYNCR: |- ∀l l'. @@ -608,7 +609,7 @@ val STRONG_PAR_TAU_TAU = save_thm ( *) val STRONG_PAR_PREF_NO_SYNCR = store_thm ( "STRONG_PAR_PREF_NO_SYNCR", - ``!(l :'b Label) l'. + ``!(l :'a Label) l'. ~(l = COMPL l') ==> (!E E'. STRONG_EQUIV @@ -619,7 +620,7 @@ val STRONG_PAR_PREF_NO_SYNCR = store_thm ( >> PURE_ONCE_REWRITE_TAC [STRONG_EQUIV] >> EXISTS_TAC ``\x y. (x = y) \/ - ?(l1 :'b Label) l2 E1 E2. ~(l1 = COMPL l2) /\ + ?(l1 :'a Label) l2 E1 E2. ~(l1 = COMPL l2) /\ (x = par (prefix (label l1) E1) (prefix (label l2) E2)) /\ (y = sum (prefix (label l1) (par E1 (prefix (label l2) E2))) (prefix (label l2) (par (prefix (label l1) E1) E2)))`` @@ -633,13 +634,13 @@ val STRONG_PAR_PREF_NO_SYNCR = store_thm ( BETA_TAC \\ rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 2.1 (of 4) *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)) \\ Q.EXISTS_TAC `E1` >> art [], (* goal 2.2 (of 4) *) Q.EXISTS_TAC `E2` >> art [], (* goal 2.3 (of 4) *) - EXISTS_TAC ``E1' :('a, 'b) CCS`` >> art [] \\ + EXISTS_TAC ``E1' :'a CCS`` >> art [] \\ ASSUME_TAC (REWRITE_RULE [ASSUME ``E = par (prefix (label l1) E1) (prefix (label l2) E2)``] (ASSUME ``TRANS E u E1'``)) \\ @@ -650,12 +651,12 @@ val STRONG_PAR_PREF_NO_SYNCR = store_thm ( MATCH_MP_TAC SUM2 >> IMP_RES_TAC TRANS_PREFIX >> art [PREFIX], (* goal 2.3.3 (of 3) *) IMP_RES_TAC TRANS_PAR_NO_SYNCR \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``] (ASSUME ``TRANS (par (prefix (label l1) E1) (prefix (label l2) E2)) u E1'``)) \\ RES_TAC ], (* goal 2.4 (of 4) *) - EXISTS_TAC ``E2' :('a, 'b) CCS`` >> art [] \\ + EXISTS_TAC ``E2' :'a CCS`` >> art [] \\ ASSUME_TAC (REWRITE_RULE [ASSUME ``E' = sum (prefix (label l1) (par E1 (prefix (label l2) E2))) @@ -677,7 +678,7 @@ val STRONG_PAR_PREF_NO_SYNCR = store_thm ( *) val STRONG_PAR_PREF_SYNCR = store_thm ( "STRONG_PAR_PREF_SYNCR", - ``!(l :'b Label) l'. (l = COMPL l') ==> + ``!(l :'a Label) l'. (l = COMPL l') ==> !E E'. STRONG_EQUIV (par (prefix (label l) E) (prefix (label l') E')) @@ -689,7 +690,7 @@ val STRONG_PAR_PREF_SYNCR = store_thm ( >> PURE_ONCE_REWRITE_TAC [STRONG_EQUIV] >> EXISTS_TAC ``\x y. (x = y) \/ - ?(l1 :'b Label) l2 E1 E2. + ?(l1 :'a Label) l2 E1 E2. (l1 = COMPL l2) /\ (x = par (prefix (label l1) E1) (prefix (label l2) E2)) /\ (y = sum @@ -706,13 +707,13 @@ val STRONG_PAR_PREF_SYNCR = store_thm ( BETA_TAC \\ rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 2.1 (of 4) *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)) \\ Q.EXISTS_TAC `E1` >> art [], (* goal 2.2 (of 4) *) Q.EXISTS_TAC `E2` >> art [], (* goal 2.3 (of 4) *) - EXISTS_TAC ``E1' :('a, 'b) CCS`` >> art [] \\ + EXISTS_TAC ``E1' :'a CCS`` >> art [] \\ ASSUME_TAC (REWRITE_RULE [ASSUME ``E = par (prefix (label l1) E1) (prefix (label l2) E2)``] (ASSUME ``TRANS E u E1'``)) \\ @@ -726,7 +727,7 @@ val STRONG_PAR_PREF_SYNCR = store_thm ( IMP_RES_TAC TRANS_PREFIX \\ art [PREFIX], (* goal 2.4 (of 4) *) - EXISTS_TAC ``E2' :('a, 'b) CCS`` >> art [] \\ + EXISTS_TAC ``E2' :'a CCS`` >> art [] \\ ASSUME_TAC (REWRITE_RULE [ASSUME ``E' = sum (sum (prefix (label l1) (par E1 (prefix (label l2) E2))) (prefix (label l2) (par (prefix (label l1) E1) E2))) @@ -740,19 +741,19 @@ val STRONG_PAR_PREF_SYNCR = store_thm ( MATCH_MP_TAC PAR1 >> REWRITE_TAC [PREFIX], (* goal 2.4.1.2 (of 4) *) IMP_RES_TAC TRANS_PREFIX \\ - CHECK_ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``, Action_distinct] - (ASSUME ``(u :'b Action) = label l1``)), + CHECK_ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``, Action_distinct] + (ASSUME ``(u :'a Action) = label l1``)), (* goal 2.4.1.3 (of 4) *) IMP_RES_TAC TRANS_PREFIX >> art [] \\ MATCH_MP_TAC PAR2 >> REWRITE_TAC [PREFIX], (* goal 2.4.1.4 (of 4) *) IMP_RES_TAC TRANS_PREFIX \\ - CHECK_ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``, Action_distinct] - (ASSUME ``(u :'b Action) = label l2``)) ], + CHECK_ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``, Action_distinct] + (ASSUME ``(u :'a Action) = label l2``)) ], (* goal 2.4.2 (of 2) *) IMP_RES_TAC TRANS_PREFIX >> art [] \\ MATCH_MP_TAC PAR3 \\ - EXISTS_TAC ``COMPL (l2 :'b Label)`` \\ + EXISTS_TAC ``COMPL (l2 :'a Label)`` \\ REWRITE_TAC [COMPL_COMPL_LAB, PREFIX] ] ] ]); (******************************************************************************) @@ -762,13 +763,13 @@ val STRONG_PAR_PREF_SYNCR = store_thm ( (******************************************************************************) val STRONG_RESTR_NIL = store_thm ( - "STRONG_RESTR_NIL", ``!L :'b Label set. STRONG_EQUIV (restr L nil) nil``, + "STRONG_RESTR_NIL", ``!L :'a Label set. STRONG_EQUIV (restr L nil) nil``, GEN_TAC >> PURE_ONCE_REWRITE_TAC [STRONG_EQUIV] - >> EXISTS_TAC ``\(x :('a, 'b) CCS) (y :('a, 'b) CCS). (?L'. (x = restr L' nil) /\ (y = nil))`` + >> EXISTS_TAC ``\(x :'a CCS) (y :'a CCS). (?L'. (x = restr L' nil) /\ (y = nil))`` >> CONJ_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) - BETA_TAC >> EXISTS_TAC ``L: 'b Label set`` >> REWRITE_TAC [], + BETA_TAC >> EXISTS_TAC ``L :'a Label set`` >> REWRITE_TAC [], (* goal 2 (of 2) *) PURE_ONCE_REWRITE_TAC [STRONG_BISIM] >> BETA_TAC \\ rpt STRIP_TAC >| (* 2 sub-goals here *) @@ -800,24 +801,24 @@ val STRONG_RESTR_SUM = store_thm ( [ (* goal 1.1.1 (of 2) *) art [] >> MATCH_MP_TAC SUM1 \\ MATCH_MP_TAC RESTR \\ - REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'b Action) = tau``] + REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'a Action) = tau``] (ASSUME ``TRANS E u E''``)], (* goal 1.1.2 (of 2) *) art [] >> MATCH_MP_TAC SUM2 \\ MATCH_MP_TAC RESTR \\ - REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'b Action) = tau``] + REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'a Action) = tau``] (ASSUME ``TRANS E' u E''``)] ], (* goal 1.2 (of 2) *) IMP_RES_TAC TRANS_SUM >| (* 2 sub-goals here *) [ (* goal 1.2.1 (of 2) *) art [] >> MATCH_MP_TAC SUM1 \\ MATCH_MP_TAC RESTR \\ - Q.EXISTS_TAC `l` >> art [REWRITE_RULE [ASSUME ``(u :'b Action) = label l``] + Q.EXISTS_TAC `l` >> art [REWRITE_RULE [ASSUME ``(u :'a Action) = label l``] (ASSUME ``TRANS E u E''``)], (* goal 1.2.2 (of 2) *) art [] >> MATCH_MP_TAC SUM2 \\ MATCH_MP_TAC RESTR \\ - Q.EXISTS_TAC `l` >> art [REWRITE_RULE [ASSUME ``(u :'b Action) = label l``] + Q.EXISTS_TAC `l` >> art [REWRITE_RULE [ASSUME ``(u :'a Action) = label l``] (ASSUME ``TRANS E' u E''``)] ] ], (* goal 2 (of 2) *) Q.EXISTS_TAC `E2` \\ @@ -829,14 +830,14 @@ val STRONG_RESTR_SUM = store_thm ( art [] \\ MATCH_MP_TAC RESTR >> REWRITE_TAC [] \\ MATCH_MP_TAC SUM1 \\ - REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'b Action) = tau``] + REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'a Action) = tau``] (ASSUME ``TRANS E u E''``)], (* goal 2.1.2 (of 2) *) art [] \\ MATCH_MP_TAC RESTR \\ Q.EXISTS_TAC `l` >> art [] \\ MATCH_MP_TAC SUM1 \\ - REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'b Action) = label l``] + REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'a Action) = label l``] (ASSUME ``TRANS E u E''``)] ], (* goal 2.2 (of 2) *) IMP_RES_TAC TRANS_RESTR >| (* 2 sub-goals here *) @@ -844,14 +845,14 @@ val STRONG_RESTR_SUM = store_thm ( art [] \\ MATCH_MP_TAC RESTR >> REWRITE_TAC [] \\ MATCH_MP_TAC SUM2 \\ - REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'b Action) = tau``] + REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'a Action) = tau``] (ASSUME ``TRANS E' u E''``)], (* goal 2.2.2 (of 2) *) art[] \\ MATCH_MP_TAC RESTR \\ Q.EXISTS_TAC `l` >> art [] \\ MATCH_MP_TAC SUM2 \\ - REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'b Action) = label l``] + REWRITE_TAC [REWRITE_RULE [ASSUME ``(u :'a Action) = label l``] (ASSUME ``TRANS E' u E''``)] ] ] ]); (* Prove STRONG_RESTR_PREFIX_TAU: @@ -869,14 +870,14 @@ val STRONG_RESTR_PREFIX_TAU = store_thm ( >> CONJ_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) BETA_TAC >> DISJ2_TAC \\ - EXISTS_TAC ``E :('a, 'b) CCS`` \\ - EXISTS_TAC ``L: 'b Label set`` >> REWRITE_TAC [], + EXISTS_TAC ``E :'a CCS`` \\ + EXISTS_TAC ``L :'a Label set`` >> REWRITE_TAC [], (* goal 2 (of 2) *) PURE_ONCE_REWRITE_TAC [STRONG_BISIM] >> BETA_TAC \\ rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 2.1 (of 4) *) Q.EXISTS_TAC `E1` \\ - REWRITE_TAC [REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + REWRITE_TAC [REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)], (* goal 2.2 (of 4) *) Q.EXISTS_TAC `E2` >> art [], @@ -890,8 +891,8 @@ val STRONG_RESTR_PREFIX_TAU = store_thm ( (* goal 2.3.2 (of 2) *) IMP_RES_TAC TRANS_PREFIX \\ CHECK_ASSUME_TAC - (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``, Action_distinct] - (ASSUME ``(u :'b Action) = label l``)) ], + (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``, Action_distinct] + (ASSUME ``(u :'a Action) = label l``)) ], (* goal 2.4 (of 4) *) ASSUME_TAC (REWRITE_RULE [ASSUME ``E' = prefix tau (restr L' E'')``] (ASSUME ``TRANS E' u E2``)) \\ @@ -904,14 +905,14 @@ val STRONG_RESTR_PREFIX_TAU = store_thm ( *) val STRONG_RESTR_PR_LAB_NIL = store_thm ( "STRONG_RESTR_PR_LAB_NIL", - ``!(l :'b Label) L. + ``!(l :'a Label) L. (l IN L) \/ ((COMPL l) IN L) ==> (!E. STRONG_EQUIV (restr L (prefix (label l) E)) nil)``, rpt GEN_TAC >> DISCH_TAC >> GEN_TAC >> PURE_ONCE_REWRITE_TAC [STRONG_EQUIV] - >> EXISTS_TAC ``\(x :('a, 'b) CCS) (y :('a, 'b) CCS). + >> EXISTS_TAC ``\(x :'a CCS) (y :'a CCS). ?l' L' E'. ((l' IN L') \/ ((COMPL l') IN L')) /\ (x = restr L' (prefix (label l') E')) /\ (y = nil)`` @@ -946,7 +947,7 @@ val STRONG_RESTR_PR_LAB_NIL = store_thm ( *) val STRONG_RESTR_PREFIX_LABEL = store_thm ( "STRONG_RESTR_PREFIX_LABEL", - ``!(l :'b Label) L. + ``!(l :'a Label) L. (~(l IN L) /\ ~((COMPL l) IN L)) ==> (!E. STRONG_EQUIV (restr L (prefix (label l) E)) (prefix (label l) (restr L E)))``, @@ -966,7 +967,7 @@ val STRONG_RESTR_PREFIX_LABEL = store_thm ( BETA_TAC \\ rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 2.1 (of 4) *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)) \\ Q.EXISTS_TAC `E1` >> art [], (* goal 2.2 (of 4) *) @@ -980,8 +981,8 @@ val STRONG_RESTR_PREFIX_LABEL = store_thm ( [ (* goal 2.3.1 (of 2) *) IMP_RES_TAC TRANS_PREFIX \\ CHECK_ASSUME_TAC - (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``, Action_distinct] - (ASSUME ``(u :'b Action) = label l'``)), + (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``, Action_distinct] + (ASSUME ``(u :'a Action) = label l'``)), (* goal 2.3.2 (of 2) *) IMP_RES_TAC TRANS_PREFIX >> art [PREFIX] ], (* goal 2.4 (of 4) *) @@ -990,7 +991,7 @@ val STRONG_RESTR_PREFIX_LABEL = store_thm ( (ASSUME ``TRANS E' u E2``)) \\ IMP_RES_TAC TRANS_PREFIX >> art [] \\ MATCH_MP_TAC RESTR \\ - EXISTS_TAC ``l': 'b Label`` \\ + EXISTS_TAC ``l' :'a Label`` \\ art [PREFIX] ] ]); (******************************************************************************) @@ -1003,14 +1004,14 @@ val STRONG_RESTR_PREFIX_LABEL = store_thm ( |- ∀rf. relab nil rf ~ nil *) val STRONG_RELAB_NIL = store_thm ( - "STRONG_RELAB_NIL", ``!(rf :'b Relabeling). STRONG_EQUIV (relab nil rf) nil``, + "STRONG_RELAB_NIL", ``!(rf :'a Relabeling). STRONG_EQUIV (relab nil rf) nil``, GEN_TAC >> PURE_ONCE_REWRITE_TAC [STRONG_EQUIV] - >> EXISTS_TAC ``\(x :('a, 'b) CCS) (y :('a, 'b) CCS). (?rf'. (x = relab nil rf') /\ (y = nil))`` + >> EXISTS_TAC ``\(x :'a CCS) (y :'a CCS). (?rf'. (x = relab nil rf') /\ (y = nil))`` >> CONJ_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) BETA_TAC \\ - EXISTS_TAC ``rf: 'b Relabeling`` \\ + EXISTS_TAC ``rf :'a Relabeling`` \\ REWRITE_TAC [], (* goal 2 (of 2) *) PURE_ONCE_REWRITE_TAC [STRONG_BISIM] \\ @@ -1055,7 +1056,7 @@ val STRONG_RELAB_SUM = store_thm ( *) val STRONG_RELAB_PREFIX = store_thm ( "STRONG_RELAB_PREFIX", - ``!(u :'b Action) E labl. + ``!(u :'a Action) E labl. STRONG_EQUIV (relab (prefix u E) (RELAB labl)) (prefix (relabel (RELAB labl) u) (relab E (RELAB labl)))``, rpt GEN_TAC @@ -1067,13 +1068,13 @@ val STRONG_RELAB_PREFIX = store_thm ( >> CONJ_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) BETA_TAC >> DISJ2_TAC \\ - EXISTS_TAC ``u: 'b Action`` \\ - EXISTS_TAC ``E :('a, 'b) CCS`` >> REWRITE_TAC [], + EXISTS_TAC ``u :'a Action`` \\ + EXISTS_TAC ``E :'a CCS`` >> REWRITE_TAC [], (* goal 2 (of 2) *) PURE_ONCE_REWRITE_TAC [STRONG_BISIM] >> BETA_TAC \\ rpt STRIP_TAC >| (* 4 sub-goals *) [ (* goal 2.1 (of 4) *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)) \\ Q.EXISTS_TAC `E1` >> art [], (* goal 2.2 (of 4) *) @@ -1083,8 +1084,7 @@ val STRONG_RELAB_PREFIX = store_thm ( ASSUME_TAC (REWRITE_RULE [ASSUME ``E = relab (prefix u' E'') (RELAB labl)``] (ASSUME ``TRANS E u E1``)) \\ IMP_RES_TAC TRANS_RELAB \\ - IMP_RES_TAC TRANS_PREFIX \\ - art [PREFIX], + IMP_RES_TAC TRANS_PREFIX >> art [PREFIX], (* goal 2.4 (of 4) *) Q.EXISTS_TAC `E2` >> REWRITE_TAC [] \\ ASSUME_TAC (REWRITE_RULE @@ -1100,8 +1100,11 @@ val STRONG_RELAB_PREFIX = store_thm ( (* *) (******************************************************************************) -(* The unfolding law R1 for strong equivalence: (Proposition 4.11 of [Mil89]) - |- ∀X E. rec X E ~ CCS_Subst E (rec X E) X: +(* The unfolding law R1 for strong equivalence: (Proposition 4.11 of [1, p.99]) + + If A := P, then A ~ P + + where A is ‘rec X E’, P is ‘CCS_Subst E (rec X E) X’ (instead of just E) *) Theorem STRONG_UNFOLDING : !X E. STRONG_EQUIV (rec X E) (CCS_Subst E (rec X E) X) @@ -1114,14 +1117,13 @@ Proof >> CONJ_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) BETA_TAC >> DISJ2_TAC \\ - EXISTS_TAC ``X: 'a`` \\ - EXISTS_TAC ``E :('a, 'b) CCS`` >> REWRITE_TAC [], + qexistsl_tac [‘X’, ‘E’] >> rw [], (* goal 2 (of 2) *) PURE_ONCE_REWRITE_TAC [STRONG_BISIM] >> BETA_TAC \\ rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 2.1 (of 4) *) Q.EXISTS_TAC `E1` \\ - REWRITE_TAC [REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + REWRITE_TAC [REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)], (* goal 2.2 (of 4) *) Q.EXISTS_TAC `E2` >> art [], @@ -1132,7 +1134,7 @@ Proof IMP_RES_TAC TRANS_REC >> art [], (* goal 2.4 (of 4) *) Q.EXISTS_TAC `E2` \\ - art + ASM_REWRITE_TAC [REWRITE_RULE [ASSUME ``E' = CCS_Subst E'' (rec Y E'') Y``] (ASSUME ``TRANS E' u E2``), TRANS_REC_EQ] ] ] QED @@ -1142,7 +1144,7 @@ QED *) val STRONG_PREF_REC_EQUIV = store_thm ( "STRONG_PREF_REC_EQUIV", - ``!(u :'b Action) s v. + ``!(u :'a Action) s v. STRONG_EQUIV (prefix u (rec s (prefix v (prefix u (var s))))) (rec s (prefix u (prefix v (var s))))``, rpt GEN_TAC @@ -1168,7 +1170,7 @@ val STRONG_PREF_REC_EQUIV = store_thm ( [ASSUME ``E = prefix u' (rec s' (prefix v' (prefix u' (var s'))))``] (ASSUME ``TRANS E u E1``)) \\ IMP_RES_TAC TRANS_PREFIX \\ - EXISTS_TAC ``prefix (v' :'b Action) (rec s' (prefix u' (prefix v' (var s'))))`` \\ + EXISTS_TAC ``prefix (v' :'a Action) (rec s' (prefix u' (prefix v' (var s'))))`` \\ CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.1.1 (of 2) *) art [] \\ @@ -1188,7 +1190,7 @@ val STRONG_PREF_REC_EQUIV = store_thm ( art [PREFIX], (* goal 2.2.2 (of 2) *) take [`u`, `v'`, `s'`] >> art - [REWRITE_RULE [ASSUME ``u': 'b Action = u``] + [REWRITE_RULE [ASSUME ``u' :'a Action = u``] (ASSUME ``E2 = prefix v' (rec s' (prefix u' (prefix v' (var s'))))``)] ], (* goal 2.3 (of 4) *) ASSUME_TAC (REWRITE_RULE @@ -1207,7 +1209,7 @@ val STRONG_PREF_REC_EQUIV = store_thm ( [ASSUME ``E' = prefix v' (rec s' (prefix u' (prefix v' (var s'))))``] (ASSUME ``TRANS E' u E2``)) \\ IMP_RES_TAC TRANS_PREFIX \\ - EXISTS_TAC ``prefix (u' :'b Action) + EXISTS_TAC ``prefix (u' :'a Action) (rec s' (prefix v' (prefix u' (var s'))))`` \\ CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.4.1 (of 2) *) @@ -1219,12 +1221,10 @@ val STRONG_PREF_REC_EQUIV = store_thm ( (* Prove the theorem STRONG_REC_ACT2: |- ∀s u. rec s (u..u..var s) ~ rec s (u..var s) *) -val STRONG_REC_ACT2 = store_thm ( - "STRONG_REC_ACT2", - ``!s u. - STRONG_EQUIV - (rec s (prefix u (prefix u (var s)))) - (rec s (prefix u (var s)))``, +Theorem STRONG_REC_ACT2 : + !s u. STRONG_EQUIV (rec s (prefix u (prefix u (var s)))) + (rec s (prefix u (var s))) +Proof rpt GEN_TAC >> PURE_ONCE_REWRITE_TAC [STRONG_EQUIV] >> EXISTS_TAC @@ -1237,51 +1237,47 @@ val STRONG_REC_ACT2 = store_thm ( >> CONJ_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) BETA_TAC \\ - EXISTS_TAC ``s: 'a`` \\ - EXISTS_TAC ``u: 'b Action`` >> REWRITE_TAC [], + qexistsl_tac [‘s’, ‘u’] >> rw [], (* goal 2 (of 2) *) PURE_ONCE_REWRITE_TAC [STRONG_BISIM] \\ - BETA_TAC \\ - rpt STRIP_TAC >| (* 4 sub-goals *) + BETA_TAC >> rpt STRIP_TAC >| (* 4 sub-goals *) [ (* goal 2.1 (of 4) *) ASSUME_TAC (REWRITE_RULE [ASSUME ``E = rec s' (prefix u' (prefix u' (var s')))``, TRANS_REC_EQ, CCS_Subst_def] (ASSUME ``TRANS E u E1``)) \\ - IMP_RES_TAC TRANS_PREFIX >> EXISTS_TAC ``E' :('a, 'b) CCS`` \\ + IMP_RES_TAC TRANS_PREFIX >> EXISTS_TAC ``E' :'a CCS`` \\ CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.1.1 (of 2) *) - art [] \\ + ASM_REWRITE_TAC [] \\ MATCH_MP_TAC REC >> REWRITE_TAC [CCS_Subst_def, PREFIX], (* goal 2.1.2 (of 2) *) - EXISTS_TAC ``s': 'a`` >> EXISTS_TAC ``u': 'b Action`` >> art [] ], + qexistsl_tac [‘s'’, ‘u'’] >> art [] ], (* goal 2.2 (of 4) *) ASSUME_TAC (REWRITE_RULE [ASSUME ``E' = rec s'(prefix u'(var s'))``, TRANS_REC_EQ, CCS_Subst_def] (ASSUME ``TRANS E' u E2``)) \\ IMP_RES_TAC TRANS_PREFIX \\ - EXISTS_TAC ``prefix (u' :'b Action) E`` \\ + EXISTS_TAC ``prefix (u' :'a Action) E`` \\ CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.2.1 (of 2) *) - art [] \\ + ASM_REWRITE_TAC [] \\ MATCH_MP_TAC REC >> REWRITE_TAC [CCS_Subst_def, PREFIX], (* goal 2.2.2 (of 2) *) - EXISTS_TAC ``s': 'a`` \\ - EXISTS_TAC ``u': 'b Action`` >> art [] ], + qexistsl_tac [‘s'’, ‘u'’] >> art [] ], (* goal 2.3 (of 4) *) ASSUME_TAC (REWRITE_RULE [ASSUME ``E = prefix u' (rec s' (prefix u' (prefix u' (var s'))))``] (ASSUME ``TRANS E u E1``)) \\ - IMP_RES_TAC TRANS_PREFIX >> EXISTS_TAC ``E' :('a, 'b) CCS`` \\ + IMP_RES_TAC TRANS_PREFIX >> EXISTS_TAC ``E' :'a CCS`` \\ CONJ_TAC >| (* 2 sub-goals here *) [ (* goal 2.3.1 (of 2) *) - art [] \\ + ASM_REWRITE_TAC [] \\ MATCH_MP_TAC REC \\ REWRITE_TAC [CCS_Subst_def, PREFIX], (* goal 2.3.2 (of 2) *) - EXISTS_TAC ``s': 'a`` \\ - EXISTS_TAC ``u': 'b Action`` >> art [] ], + qexistsl_tac [‘s'’, ‘u'’] >> art [] ], (* goal 2.4 (of 4) *) ASSUME_TAC (REWRITE_RULE [ASSUME ``E' = rec s' (prefix u' (var s'))``, TRANS_REC_EQ, CCS_Subst_def] @@ -1290,10 +1286,10 @@ val STRONG_REC_ACT2 = store_thm ( EXISTS_TAC ``rec s' (prefix u' (prefix u' (var s')))`` \\ CONJ_TAC >| (* 2 sub-goals here, first one is easy *) [ (* goal 2.4.1 (of 2) *) - art [PREFIX], + ASM_REWRITE_TAC [PREFIX], (* goal 2.4.2 (of 2) *) - EXISTS_TAC ``s': 'a`` \\ - EXISTS_TAC ``u': 'b Action`` >> art [] ] ] ]); + qexistsl_tac [‘s'’, ‘u'’] >> art [] ] ] ] +QED (******************************************************************************) (* *) @@ -1301,21 +1297,15 @@ val STRONG_REC_ACT2 = store_thm ( (* *) (******************************************************************************) -val PREF_ACT_def = Define ` - PREF_ACT (prefix (u :'b Action) E) = u `; - -val PREF_PROC_def = Define ` - PREF_PROC (prefix (u :'b Action) E) = E `; - val Is_Prefix_def = Define ` - Is_Prefix E = (?(u :'b Action) E'. (E = prefix u E')) `; + Is_Prefix E = (?(u :'a Action) E'. (E = prefix u E')) `; val PREF_IS_PREFIX = store_thm ( - "PREF_IS_PREFIX", ``!(u :'b Action) E. Is_Prefix (prefix u E)``, + "PREF_IS_PREFIX", ``!(u :'a Action) E. Is_Prefix (prefix u E)``, rpt GEN_TAC >> REWRITE_TAC [Is_Prefix_def] - >> EXISTS_TAC ``u: 'b Action`` - >> EXISTS_TAC ``E :('a, 'b) CCS`` + >> EXISTS_TAC ``u :'a Action`` + >> EXISTS_TAC ``E :'a CCS`` >> REWRITE_TAC []); (* --------------------------------------------------------------------------- *) @@ -1326,7 +1316,7 @@ val PREF_IS_PREFIX = store_thm ( (* --------------------------------------------------------------------------- *) val CCS_SIGMA_def = Define ` - (CCS_SIGMA (f :num -> ('a, 'b) CCS) 0 = f 0) /\ + (CCS_SIGMA (f :num -> 'a CCS) 0 = f 0) /\ (CCS_SIGMA f (SUC n) = sum (CCS_SIGMA f n) (f (SUC n))) `; val _ = overload_on ("SIGMA", ``CCS_SIGMA``); @@ -1349,7 +1339,7 @@ val [SIGMA_BASE, SIGMA_INDUCT] = (* --------------------------------------------------------------------------- *) val CCS_COMP_def = Define ` - (CCS_COMP (f :num -> ('a, 'b) CCS) 0 = f 0) /\ + (CCS_COMP (f :num -> 'a CCS) 0 = f 0) /\ (CCS_COMP f (SUC n) = par (CCS_COMP f n) (f (SUC n))) `; val _ = overload_on ("PI", ``CCS_COMP``); @@ -1368,11 +1358,11 @@ val [COMP_BASE, COMP_INDUCT] = (* Define the functions to compute the summation of the synchronizing summands *) (* of two summations of prefixed processes in parallel. *) (* SYNC computes the synchronizations between a summand u.P and the summation *) -(* f: num -> ('a, 'b) CCS representing the other process in parallel. *) +(* f: num -> 'a CCS representing the other process in parallel. *) (* --------------------------------------------------------------------------- *) val SYNC_def = Define ` - (SYNC (u :'b Action) P f 0 = + (SYNC (u :'a Action) P f 0 = (if ((u = tau) \/ (PREF_ACT (f 0) = tau)) then nil else (if (LABEL u = COMPL (LABEL (PREF_ACT (f 0)))) @@ -1432,7 +1422,7 @@ val LESS_EQ_LESS_EQ_SUC = Q.prove ( val SIGMA_TRANS_THM_EQ = store_thm ( "SIGMA_TRANS_THM_EQ", - ``!n f (u :'b Action) E. TRANS (SIGMA f n) u E = (?k. k <= n /\ TRANS (f k) u E)``, + ``!n f (u :'a Action) E. TRANS (SIGMA f n) u E = (?k. k <= n /\ TRANS (f k) u E)``, Induct (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) rpt GEN_TAC \\ @@ -1444,7 +1434,7 @@ val SIGMA_TRANS_THM_EQ = store_thm ( (* goal 1.2 (of 2) *) STRIP_TAC \\ REWRITE_TAC [REWRITE_RULE [ASSUME ``k = (0 :num)``] - (ASSUME ``TRANS ((f: num -> ('a, 'b) CCS) k) u E``)] ], + (ASSUME ``TRANS ((f: num -> 'a CCS) k) u E``)] ], (* goal 2 (of 2) *) rpt GEN_TAC \\ REWRITE_TAC [SIGMA_INDUCT, TRANS_SUM_EQ] \\ @@ -1471,7 +1461,7 @@ val SIGMA_TRANS_THM_EQ = store_thm ( (* goal 2.2.2 (of 2) *) DISJ2_TAC \\ REWRITE_TAC [REWRITE_RULE [ASSUME ``k = SUC n``] - (ASSUME ``TRANS ((f: num -> ('a, 'b) CCS) k) u E``)] ] ] ]); + (ASSUME ``TRANS ((f: num -> 'a CCS) k) u E``)] ] ] ]); (* SIGMA_TRANS_THM = |- ∀u n f E. SIGMA f n --u-> E ⇒ ∃k. k ≤ n ∧ f k --u-> E @@ -1481,7 +1471,7 @@ val SIGMA_TRANS_THM = save_thm ( val SYNC_TRANS_THM_EQ = store_thm ( "SYNC_TRANS_THM_EQ", - ``!m (u :'b Action) P f v Q. TRANS (SYNC u P f m) v Q = + ``!m (u :'a Action) P f v Q. TRANS (SYNC u P f m) v Q = (?j l. j <= m /\ (u = label l) /\ (PREF_ACT (f j) = label (COMPL l)) /\ (v = tau) /\ (Q = par P (PREF_PROC (f j))))``, @@ -1494,26 +1484,25 @@ val SYNC_TRANS_THM_EQ = store_thm ( REWRITE_TAC [NIL_NO_TRANS] \\ STRIP_TAC \\ DISJ_CASES_TAC - (ASSUME ``((u :'b Action) = tau) \/ - (PREF_ACT ((f: num -> ('a, 'b) CCS) 0) = tau)``) + (ASSUME ``((u :'a Action) = tau) \/ + (PREF_ACT ((f: num -> 'a CCS) 0) = tau)``) >| (* 2 sub-goals here *) [ (* goal 1.1.1 (of 2) *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``] - (ASSUME ``(u :'b Action) = label l``)) \\ + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``] + (ASSUME ``(u :'a Action) = label l``)) \\ IMP_RES_TAC Action_distinct, (* goal 1.1.2 (of 2) *) CHECK_ASSUME_TAC (REWRITE_RULE [ASSUME ``j = (0 :num)``, - ASSUME ``PREF_ACT ((f: num -> ('a, 'b) CCS) 0) = tau``, + ASSUME ``PREF_ACT ((f: num -> 'a CCS) 0) = tau``, Action_distinct] - (ASSUME ``PREF_ACT ((f: num -> ('a, 'b) CCS) j) = label (COMPL l)``)) ], + (ASSUME ``PREF_ACT ((f: num -> 'a CCS) j) = label (COMPL l)``)) ], (* goal 1.2 (of 2) *) STRIP_ASSUME_TAC (REWRITE_RULE [DE_MORGAN_THM] - (ASSUME ``~(((u :'b Action) = tau) \/ - (PREF_ACT ((f: num -> ('a, 'b) CCS) 0) = tau))``)) \\ - IMP_RES_TAC Action_no_tau_is_Label \\ - art [LABEL_def] \\ + (ASSUME ``~(((u :'a Action) = tau) \/ + (PREF_ACT ((f: num -> 'a CCS) 0) = tau))``)) \\ + IMP_RES_TAC Action_no_tau_is_Label >> art [LABEL_def] \\ COND_CASES_TAC >| (* 2 sub-goals here *) [ (* goal 1.2.1 (of 2) *) EQ_TAC >| (* 2 sub-goals here *) @@ -1521,23 +1510,21 @@ val SYNC_TRANS_THM_EQ = store_thm ( DISCH_TAC \\ IMP_RES_TAC TRANS_PREFIX \\ EXISTS_TAC ``0: num`` \\ - EXISTS_TAC ``x': 'b Label`` \\ - art [COMPL_COMPL_LAB], + EXISTS_TAC ``x' :'a Label`` >> art [COMPL_COMPL_LAB], (* goal 1.2.1.2 (of 2) *) - STRIP_TAC \\ - art [PREFIX] ], + STRIP_TAC >> art [PREFIX] ], (* goal 1.2.2 (of 2) *) REWRITE_TAC [NIL_NO_TRANS] \\ STRIP_TAC \\ ASSUME_TAC (REWRITE_RULE [ASSUME ``j = (0 :num)``, - ASSUME ``PREF_ACT ((f: num -> ('a, 'b) CCS) 0) = label x``] - (ASSUME ``PREF_ACT ((f: num -> ('a, 'b) CCS) j) = label (COMPL l)``)) \\ + ASSUME ``PREF_ACT ((f: num -> 'a CCS) 0) = label x``] + (ASSUME ``PREF_ACT ((f: num -> 'a CCS) j) = label (COMPL l)``)) \\ IMP_RES_TAC Action_11 \\ CHECK_ASSUME_TAC - (REWRITE_RULE [ ASSUME ``x = COMPL (l :'b Label)``, COMPL_COMPL_LAB, - ASSUME ``x': 'b Label = l`` ] - (ASSUME ``~(x' = COMPL (x: 'b Label))``)) ] ], + (REWRITE_RULE [ ASSUME ``x = COMPL (l :'a Label)``, COMPL_COMPL_LAB, + ASSUME ``x' :'a Label = l`` ] + (ASSUME ``~(x' = COMPL (x :'a Label))``)) ] ], (* goal 2 (of 2), inductive case *) rpt GEN_TAC \\ PURE_ONCE_REWRITE_TAC [SYNC_INDUCT] \\ @@ -1548,7 +1535,7 @@ val SYNC_TRANS_THM_EQ = store_thm ( DISCH_TAC \\ STRIP_ASSUME_TAC (MATCH_MP - (EQ_IMP_LR (ASSUME ``!(u :'b Action) P f v Q. + (EQ_IMP_LR (ASSUME ``!(u :'a Action) P f v Q. TRANS (SYNC u P f m) v Q = (?j l. j <= m /\ (u = label l) /\ @@ -1560,12 +1547,12 @@ val SYNC_TRANS_THM_EQ = store_thm ( Q.EXISTS_TAC `l` >> art [], (* goal 2.1.2 (of 2) *) STRIP_TAC \\ - DISJ_CASES_TAC (ASSUME ``((u :'b Action) = tau) \/ - (PREF_ACT ((f :num -> ('a,'b) CCS) (SUC m)) = tau)``) + DISJ_CASES_TAC (ASSUME ``((u :'a Action) = tau) \/ + (PREF_ACT ((f :num -> 'a CCS) (SUC m)) = tau)``) >| (* 2 sub-goals here *) [ (* goal 2.1.2.1 (of 2) *) - CHECK_ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'b Action) = tau``, Action_distinct] - (ASSUME ``(u :'b Action) = label l``)), + CHECK_ASSUME_TAC (REWRITE_RULE [ASSUME ``(u :'a Action) = tau``, Action_distinct] + (ASSUME ``(u :'a Action) = label l``)), (* goal 2.1.2.2 (of 2) *) art [] \\ IMP_RES_TAC LESS_OR_EQ >| (* 2 sub-goals here *) @@ -1578,14 +1565,14 @@ val SYNC_TRANS_THM_EQ = store_thm ( CHECK_ASSUME_TAC (REWRITE_RULE [ASSUME ``j = SUC m``, - ASSUME ``PREF_ACT ((f: num -> ('a, 'b) CCS) (SUC m)) = tau``, + ASSUME ``PREF_ACT ((f: num -> 'a CCS) (SUC m)) = tau``, Action_distinct] - (ASSUME ``PREF_ACT ((f: num -> ('a, 'b) CCS) j) = label (COMPL l)``)) ]]], + (ASSUME ``PREF_ACT ((f: num -> 'a CCS) j) = label (COMPL l)``)) ]]], (* goal 2.2 (of 2) *) STRIP_ASSUME_TAC (REWRITE_RULE [DE_MORGAN_THM] - (ASSUME ``~(((u :'b Action) = tau) \/ - (PREF_ACT ((f : num -> ('a, 'b) CCS) (SUC m)) = tau))``)) \\ + (ASSUME ``~(((u :'a Action) = tau) \/ + (PREF_ACT ((f : num -> 'a CCS) (SUC m)) = tau))``)) \\ IMP_RES_TAC Action_no_tau_is_Label \\ art [LABEL_def] \\ COND_CASES_TAC >| (* 2 sub-goals here *) @@ -1601,7 +1588,7 @@ val SYNC_TRANS_THM_EQ = store_thm ( (* goal 2.2.1.1.2 (of 2) *) STRIP_ASSUME_TAC (MATCH_MP - (EQ_IMP_LR (ASSUME ``!(u :'b Action) P f v Q. + (EQ_IMP_LR (ASSUME ``!(u :'a Action) P f v Q. TRANS (SYNC u P f m) v Q = (?j l. j <= m /\ (u = label l) /\ @@ -1624,7 +1611,7 @@ val SYNC_TRANS_THM_EQ = store_thm ( MATCH_MP_TAC SUM1 \\ art [REWRITE_RULE [ASSUME ``j = SUC m``] - (ASSUME ``Q = par P (PREF_PROC ((f: num -> ('a, 'b) CCS) j))``), + (ASSUME ``Q = par P (PREF_PROC ((f: num -> 'a CCS) j))``), PREFIX] ] ], (* goal 2.2.2 (of 2) *) art [] \\ @@ -1644,13 +1631,13 @@ val SYNC_TRANS_THM_EQ = store_thm ( ASSUME_TAC (REWRITE_RULE [ASSUME ``j = SUC m``, - ASSUME ``PREF_ACT ((f :num -> ('a, 'b) CCS) (SUC m)) = label x``] - (ASSUME ``PREF_ACT ((f: num -> ('a, 'b) CCS) j) = label (COMPL l)``)) \\ + ASSUME ``PREF_ACT ((f :num -> 'a CCS) (SUC m)) = label x``] + (ASSUME ``PREF_ACT ((f: num -> 'a CCS) j) = label (COMPL l)``)) \\ IMP_RES_TAC Action_11 \\ CHECK_ASSUME_TAC - (REWRITE_RULE [ASSUME ``x = COMPL (l :'b Label)``, COMPL_COMPL_LAB, - ASSUME ``x': 'b Label = l``] - (ASSUME ``~(x' = COMPL (x: 'b Label))``)) ] ] ] ] ] ); + (REWRITE_RULE [ASSUME ``x = COMPL (l :'a Label)``, COMPL_COMPL_LAB, + ASSUME ``x' :'a Label = l``] + (ASSUME ``~(x' = COMPL (x :'a Label))``)) ] ] ] ] ] ); (* SYNC_TRANS_THM = |- ∀v u m f Q P. @@ -1684,11 +1671,11 @@ val ALL_SYNC_TRANS_THM_EQ = store_thm ( STRIP_TAC \\ ASSUME_TAC (REWRITE_RULE [ASSUME ``k = (0 :num)``] - (ASSUME ``PREF_ACT ((f: num -> ('a, 'b) CCS) k) = label l``)) \\ + (ASSUME ``PREF_ACT ((f: num -> 'a CCS) k) = label l``)) \\ ASSUME_TAC (REWRITE_RULE [ASSUME ``k = (0 :num)``] - (ASSUME ``E = par (PREF_PROC ((f: num -> ('a, 'b) CCS) k)) - (PREF_PROC ((f': num -> ('a, 'b) CCS) k'))``)) \\ + (ASSUME ``E = par (PREF_PROC ((f: num -> 'a CCS) k)) + (PREF_PROC ((f': num -> 'a CCS) k'))``)) \\ take [`k'`, `l`] >> art [] ], (* goal 2 (of 2), inductive case *) rpt GEN_TAC \\ @@ -1726,11 +1713,11 @@ val ALL_SYNC_TRANS_THM_EQ = store_thm ( DISJ2_TAC >> art [SYNC_TRANS_THM_EQ] \\ ASSUME_TAC (REWRITE_RULE [ASSUME ``k = SUC n``] - (ASSUME ``PREF_ACT ((f: num -> ('a, 'b) CCS) k) = label l``)) \\ + (ASSUME ``PREF_ACT ((f: num -> 'a CCS) k) = label l``)) \\ ASSUME_TAC (REWRITE_RULE [ASSUME ``k = SUC n``] - (ASSUME ``E = par (PREF_PROC ((f: num -> ('a, 'b) CCS) k)) - (PREF_PROC ((f': num -> ('a, 'b) CCS) k'))``)) \\ + (ASSUME ``E = par (PREF_PROC ((f: num -> 'a CCS) k)) + (PREF_PROC ((f': num -> 'a CCS) k'))``)) \\ take [`k'`, `l`] >> art [] ] ] ]); (* ALL_SYNC_TRANS_THM = @@ -1791,7 +1778,7 @@ val STRONG_EXPANSION_LAW = store_thm ( PURE_ONCE_REWRITE_TAC [STRONG_BISIM] \\ BETA_TAC >> rpt STRIP_TAC >| (* 4 sub-goals here *) [ (* goal 1 (of 4) *) - ASSUME_TAC (REWRITE_RULE [ASSUME ``E :('a, 'b) CCS = E'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``E :'a CCS = E'``] (ASSUME ``TRANS E u E1``)) \\ Q.EXISTS_TAC `E1` >> art [], (* goal 2 (of 4) *) @@ -1814,8 +1801,8 @@ val STRONG_EXPANSION_LAW = store_thm ( (MATCH_MP (ASSUME ``!(i: num). i <= n1 ==> Is_Prefix (f1 i)``) (ASSUME ``(k: num) <= n1``))) \\ ASSUME_TAC - (REWRITE_RULE [ASSUME ``(f1: num -> ('a, 'b) CCS) k = prefix u' E''``] - (ASSUME ``TRANS ((f1: num -> ('a, 'b) CCS) k) u E1'``)) \\ + (REWRITE_RULE [ASSUME ``(f1: num -> 'a CCS) k = prefix u' E''``] + (ASSUME ``TRANS ((f1: num -> 'a CCS) k) u E1'``)) \\ IMP_RES_TAC TRANS_PREFIX >> art [PREF_ACT_def, PREF_PROC_def, PREFIX], (* goal 3.2 (of 3) *) MATCH_MP_TAC SUM1 \\ @@ -1829,8 +1816,8 @@ val STRONG_EXPANSION_LAW = store_thm ( (MATCH_MP (ASSUME ``!(j :num). j <= m2 ==> Is_Prefix (f2 j)``) (ASSUME ``(k :num) <= m2``))) \\ ASSUME_TAC - (REWRITE_RULE [ASSUME ``(f2: num -> ('a, 'b) CCS) k = prefix u' E''``] - (ASSUME ``TRANS ((f2: num -> ('a, 'b) CCS) k) u E1'``)) \\ + (REWRITE_RULE [ASSUME ``(f2: num -> 'a CCS) k = prefix u' E''``] + (ASSUME ``TRANS ((f2: num -> 'a CCS) k) u E1'``)) \\ IMP_RES_TAC TRANS_PREFIX >> art [PREF_ACT_def, PREF_PROC_def, PREFIX], (* goal 3.3 (of 3) *) MATCH_MP_TAC SUM2 >> art [ALL_SYNC_TRANS_THM_EQ] \\ @@ -1844,11 +1831,11 @@ val STRONG_EXPANSION_LAW = store_thm ( (MATCH_MP (ASSUME ``!(i :num). i <= n1 ==> Is_Prefix (f1 i)``) (ASSUME ``(k' :num) <= n1``))) \\ ASSUME_TAC - (REWRITE_RULE [ASSUME ``(f2: num -> ('a, 'b) CCS) k = prefix u' E''``] - (ASSUME ``TRANS ((f2: num -> ('a, 'b) CCS) k) (label (COMPL l)) E2``)) \\ + (REWRITE_RULE [ASSUME ``(f2: num -> 'a CCS) k = prefix u' E''``] + (ASSUME ``TRANS ((f2: num -> 'a CCS) k) (label (COMPL l)) E2``)) \\ ASSUME_TAC - (REWRITE_RULE [ASSUME ``(f1: num -> ('a, 'b) CCS) k' = prefix u'' E'''``] - (ASSUME ``TRANS ((f1: num -> ('a, 'b) CCS) k') (label l) E1'``)) \\ + (REWRITE_RULE [ASSUME ``(f1: num -> 'a CCS) k' = prefix u'' E'''``] + (ASSUME ``TRANS ((f1: num -> 'a CCS) k') (label l) E1'``)) \\ IMP_RES_TAC TRANS_PREFIX \\ take [`k'`, `k`, `l`] >> art [PREF_ACT_def, PREF_PROC_def] ], (* goal 4 (of 4) *) @@ -1870,8 +1857,8 @@ val STRONG_EXPANSION_LAW = store_thm ( (par (PREF_PROC (f1 i)) (SIGMA f2 m2))) n1``, ``SIGMA (\j:num. prefix (PREF_ACT (f2 j)) (par (SIGMA f1 n1) (PREF_PROC (f2 j)))) m2``, - ``u: 'b Action``, - ``E2 :('a, 'b) CCS``] TRANS_SUM) >| (* 2 subgoals *) + ``u :'a Action``, + ``E2 :'a CCS``] TRANS_SUM) >| (* 2 subgoals *) [ (* goal 4.1.1 (of 2) *) IMP_RES_TAC SIGMA_TRANS_THM \\ ASSUME_TAC @@ -1887,7 +1874,7 @@ val STRONG_EXPANSION_LAW = store_thm ( MATCH_MP_TAC PAR1 \\ REWRITE_TAC [SIGMA_TRANS_THM_EQ] \\ EXISTS_TAC ``k: num`` \\ - art [PREF_ACT_def, PREF_PROC_def, PREFIX], + ASM_REWRITE_TAC [PREF_ACT_def, PREF_PROC_def, PREFIX], (* goal 4.1.2 (of 2) *) IMP_RES_TAC SIGMA_TRANS_THM \\ ASSUME_TAC @@ -1903,7 +1890,7 @@ val STRONG_EXPANSION_LAW = store_thm ( MATCH_MP_TAC PAR2 \\ REWRITE_TAC [SIGMA_TRANS_THM_EQ] \\ EXISTS_TAC ``k: num`` \\ - art [PREF_ACT_def, PREF_PROC_def, PREFIX] ], + ASM_REWRITE_TAC [PREF_ACT_def, PREF_PROC_def, PREFIX] ], (* goal 4.2 (of 2) *) IMP_RES_TAC ALL_SYNC_TRANS_THM >> art [] \\ MATCH_MP_TAC PAR3 \\ @@ -1917,10 +1904,10 @@ val STRONG_EXPANSION_LAW = store_thm ( (MATCH_MP (ASSUME ``!(i: num). i <= n1 ==> Is_Prefix (f1 i)``) (ASSUME ``(k :num) <= n1``))) \\ ASSUME_TAC - (REWRITE_RULE [ASSUME ``(f1: num -> ('a, 'b) CCS) k = prefix u' E''``, + (REWRITE_RULE [ASSUME ``(f1: num -> 'a CCS) k = prefix u' E''``, PREF_ACT_def] - (ASSUME ``PREF_ACT ((f1: num -> ('a, 'b) CCS) k) = label l``)) \\ - art [PREF_PROC_def, PREFIX], + (ASSUME ``PREF_ACT ((f1: num -> 'a CCS) k) = label l``)) \\ + ASM_REWRITE_TAC [PREF_PROC_def, PREFIX], (* goal 4.2.2 (of 2) *) EXISTS_TAC ``k': num`` \\ STRIP_ASSUME_TAC @@ -1928,10 +1915,17 @@ val STRONG_EXPANSION_LAW = store_thm ( (MATCH_MP (ASSUME ``!(j :num). j <= m2 ==> Is_Prefix (f2 j)``) (ASSUME ``(k' :num) <= m2``))) \\ ASSUME_TAC - (REWRITE_RULE [ASSUME ``(f2: num -> ('a, 'b) CCS) k' = prefix u' E''``, + (REWRITE_RULE [ASSUME ``(f2: num -> 'a CCS) k' = prefix u' E''``, PREF_ACT_def] - (ASSUME ``PREF_ACT ((f2: num -> ('a, 'b) CCS) k') = label (COMPL l)``)) \\ - art [PREF_PROC_def, PREFIX] ] ] ] ]); + (ASSUME ``PREF_ACT ((f2: num -> 'a CCS) k') = label (COMPL l)``)) \\ + ASM_REWRITE_TAC [PREF_PROC_def, PREFIX] ] ] ] ]); val _ = export_theory (); val _ = html_theory "StrongLaws"; + +(* Bibliography: + + [1] Milner, Robin. Communication and concurrency. Prentice hall, 1989. + [2] Gorrieri, R., Versari, C.: Introduction to Concurrency Theory. Springer (2015). + + *) diff --git a/examples/CCS/TraceScript.sml b/examples/CCS/TraceScript.sml index a079b9a7a3..bed86f086c 100644 --- a/examples/CCS/TraceScript.sml +++ b/examples/CCS/TraceScript.sml @@ -64,11 +64,11 @@ end; (* Define the set of states reachable from any CCS process *) val NODES_def = Define ` - NODES (p :('a, 'b) CCS) = {(q :('a, 'b) CCS) | Reach p q}`; + NODES (p :'a CCS) = {(q :'a CCS) | Reach p q}`; (* Finite-state CCS *) val finite_state_def = Define ` - finite_state (p :('a, 'b) CCS) = FINITE (NODES p)`; + finite_state (p :'a CCS) = FINITE (NODES p)`; val Reach_NODES = store_thm ( "Reach_NODES", ``!p q. Reach p q ==> q IN (NODES p)``, @@ -323,7 +323,7 @@ val LRTC_APPEND_CASES = store_thm ( (* *) (******************************************************************************) -val _ = overload_on ("epsilon", ``[] :'b Action list``); +val _ = overload_on ("epsilon", ``[] :'a Action list``); val _ = Unicode.unicode_version { u = UTF8.chr 0x03B5, tmnm = "epsilon"}; val _ = TeX_notation { hol = "epsilon", @@ -332,7 +332,7 @@ val _ = TeX_notation { hol = "epsilon", val TRACE_def = Define `TRACE = LRTC TRANS`; val _ = type_abbrev_pp ("trace", - ``:('a, 'b) CCS -> 'b Action list -> ('a, 'b) CCS -> bool``); + ``:'a CCS -> 'a Action list -> 'a CCS -> bool``); local val trans = (REWRITE_RULE [SYM TRACE_def]) o (ISPEC ``TRANS``); @@ -437,18 +437,18 @@ val WEAK_TRANS_TRACE = store_thm ( >> Q.EXISTS_TAC `E1` >> ASM_REWRITE_TAC []); val NO_LABEL_def = Define ` - NO_LABEL (L :'b Action list) = ~?l. MEM (label l) L`; + NO_LABEL (L :'a Action list) = ~?l. MEM (label l) L`; val NO_LABEL_cases = store_thm ( "NO_LABEL_cases", - ``!(x :'b Action) xs. NO_LABEL (x :: xs) = (x = tau) /\ NO_LABEL xs``, + ``!(x :'a Action) xs. NO_LABEL (x :: xs) = (x = tau) /\ NO_LABEL xs``, REWRITE_TAC [NO_LABEL_def] >> rpt GEN_TAC >> EQ_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) REWRITE_TAC [MEM] \\ Cases_on `x` >> SIMP_TAC list_ss [Action_distinct_label, IS_LABEL_def] \\ Q.EXISTS_TAC `x'` >> DISJ1_TAC \\ - ACCEPT_TAC (REFL ``x' :'b Label``), + ACCEPT_TAC (REFL ``x' :'a Label``), (* goal 2 (of 2) *) REWRITE_TAC [MEM] \\ rpt STRIP_TAC >- rfs [Action_distinct_label] \\ @@ -498,14 +498,14 @@ val EPS_AND_TRACE = store_thm ( (* u is the unique Label in L, learnt from Robert Beers *) val UNIQUE_LABEL_def = Define ` - UNIQUE_LABEL u (L :'b Action list) = + UNIQUE_LABEL u (L :'a Action list) = ?L1 L2. (L1 ++ [u] ++ L2 = L) /\ NO_LABEL L1 /\ NO_LABEL L2`; (* old equivalent definition without using NO_LABEL *) val UNIQUE_LABEL_DEF = store_thm ( "UNIQUE_LABEL_DEF", - ``!u (L :'b Action list). - UNIQUE_LABEL u (L :'b Action list) = + ``!u (L :'a Action list). + UNIQUE_LABEL u (L :'a Action list) = ?L1 L2. (L1 ++ [u] ++ L2 = L) /\ ~?l. MEM (label l) L1 \/ MEM (label l) L2``, Know `!L1 L2. (?l. MEM (label l) L1 \/ MEM (label l) L2) = (?l. MEM (label l) L1) \/ (?l. MEM (label l) L2)` @@ -527,7 +527,7 @@ val UNIQUE_LABEL_DEF = store_thm ( val UNIQUE_LABEL_IMP_MEM = store_thm ( "UNIQUE_LABEL_IMP_MEM", - ``!u (L :'b Action list). UNIQUE_LABEL u L ==> MEM u L``, + ``!u (L :'a Action list). UNIQUE_LABEL u L ==> MEM u L``, rpt GEN_TAC >> REWRITE_TAC [UNIQUE_LABEL_DEF] >> rpt STRIP_TAC @@ -537,7 +537,7 @@ val UNIQUE_LABEL_IMP_MEM = store_thm ( val UNIQUE_LABEL_NOT_NULL = store_thm ( "UNIQUE_LABEL_NOT_NULL", - ``!u (L :'b Action list). UNIQUE_LABEL u L ==> ~NULL L``, + ``!u (L :'a Action list). UNIQUE_LABEL u L ==> ~NULL L``, rpt GEN_TAC >> STRIP_TAC >> IMP_RES_TAC UNIQUE_LABEL_IMP_MEM >> POP_ASSUM MP_TAC @@ -546,7 +546,7 @@ val UNIQUE_LABEL_NOT_NULL = store_thm ( val UNIQUE_LABEL_cases1 = store_thm ( "UNIQUE_LABEL_cases1", - ``!(l :'b Label) xs. UNIQUE_LABEL (label l) (tau :: xs) = UNIQUE_LABEL (label l) xs``, + ``!(l :'a Label) xs. UNIQUE_LABEL (label l) (tau :: xs) = UNIQUE_LABEL (label l) xs``, rpt GEN_TAC >> REWRITE_TAC [UNIQUE_LABEL_DEF] >> EQ_TAC >> rpt STRIP_TAC (* 2 sub-goals here *) @@ -560,7 +560,7 @@ val UNIQUE_LABEL_cases1 = store_thm ( val UNIQUE_LABEL_cases2 = store_thm ( "UNIQUE_LABEL_cases2", - ``!(l :'b Label) l' xs. UNIQUE_LABEL (label l) (label l' :: xs) = (l = l') /\ NO_LABEL xs``, + ``!(l :'a Label) l' xs. UNIQUE_LABEL (label l) (label l' :: xs) <=> (l = l') /\ NO_LABEL xs``, rpt GEN_TAC >> REWRITE_TAC [UNIQUE_LABEL_DEF] >> EQ_TAC >> rpt STRIP_TAC (* 3 sub-goals here *) diff --git a/examples/CCS/UniqueSolutionsScript.sml b/examples/CCS/UniqueSolutionsScript.sml index 8ea14907ee..644525402c 100644 --- a/examples/CCS/UniqueSolutionsScript.sml +++ b/examples/CCS/UniqueSolutionsScript.sml @@ -2,23 +2,20 @@ (* FILE : UniqueSolutionsScript.sml *) (* DESCRIPTION : Milner and Sangiorgi's "Unique Solutions of Equations" *) (* *) -(* THESIS : A Formalization of Unique Solutions of Equations in *) -(* Process Algebra *) -(* AUTHOR : (c) 2017 Chun Tian, University of Bologna, Italy *) -(* (c) 2018 Chun Tian, Fondazione Bruno Kessler (FBK) *) -(* DATE : 2017-2018 *) +(* COPYRIGHTS : 2016-2017 University of Bologna, Italy (Chun Tian) *) +(* 2018-2019 Fondazione Bruno Kessler, Italy (Chun Tian) *) +(* 2023-2024 The Australian National University (Chun Tian) *) (* ========================================================================== *) open HolKernel Parse boolLib bossLib; -open pred_setTheory relationTheory pairTheory sumTheory listTheory; -open prim_recTheory arithmeticTheory combinTheory; +open combinTheory pred_setTheory relationTheory pairTheory sumTheory listTheory + prim_recTheory arithmeticTheory; open CCSLib CCSTheory TraceTheory StrongEQTheory WeakEQTheory ObsCongrTheory BisimulationUptoTheory CongruenceTheory ExpansionTheory ContractionTheory; val _ = new_theory "UniqueSolutions"; -val _ = temp_loose_equality (); (******************************************************************************) (* *) @@ -30,15 +27,16 @@ val _ = temp_loose_equality (); If the variable X is weakly guarded in E, and E{P/X} --a-> P', then P' takes the form E'{P/X} (for some expression E'), and moreover, for any Q, E{Q/X} --a-> E'{Q/X}. *) -val STRONG_UNIQUE_SOLUTION_LEMMA = store_thm ( - "STRONG_UNIQUE_SOLUTION_LEMMA", - ``!E. WG E ==> +Theorem STRONG_UNIQUE_SOLUTION_LEMMA : + !E. WG E ==> !P a P'. TRANS (E P) a P' ==> - ?E'. CONTEXT E' /\ (P' = E' P) /\ !Q. TRANS (E Q) a (E' Q)``, + ?E'. CONTEXT E' /\ (P' = E' P) /\ !Q. TRANS (E Q) a (E' Q) +Proof Induct_on `WG` >> BETA_TAC >> COUNT_TAC (rpt STRIP_TAC) (* 6 sub-goals here *) >| [ (* goal 1 (of 6) *) - Q.EXISTS_TAC `\t. P'` >> SIMP_TAC std_ss [CONTEXT2] >> art [], + Q.EXISTS_TAC `\t. P'` >> rw [] \\ + rw [CONTEXT2], (* goal 2 (of 6) *) IMP_RES_TAC TRANS_PREFIX >> art [] \\ Q.EXISTS_TAC `e` >> art [PREFIX], @@ -105,7 +103,8 @@ val STRONG_UNIQUE_SOLUTION_LEMMA = store_thm ( RES_TAC >> FULL_SIMP_TAC std_ss [] \\ Q.EXISTS_TAC `\t. relab (E' t) rf` >> BETA_TAC >> REWRITE_TAC [] \\ CONJ_TAC >- ( MATCH_MP_TAC CONTEXT7 >> art [] ) \\ - GEN_TAC >> MATCH_MP_TAC RELABELING >> art [] ]); + GEN_TAC >> MATCH_MP_TAC RELABELING >> art [] ] +QED (* Proposition 4.14 in Milner's book [1] (uni-variate version): Let the expression E contains at most the variable X, and let X be @@ -119,8 +118,8 @@ Proof >> irule (REWRITE_RULE [RSUBSET] STRONG_BISIM_UPTO_THM) >> Q.EXISTS_TAC `\x y. (x = y) \/ (?G. CONTEXT G /\ (x = G P) /\ (y = G Q))` >> BETA_TAC >> reverse CONJ_TAC - >- ( DISJ2_TAC >> Q.EXISTS_TAC `\x. x` >> BETA_TAC \\ - KILL_TAC >> RW_TAC std_ss [CONTEXT1] ) + >- (DISJ2_TAC >> Q.EXISTS_TAC `\x. x` >> BETA_TAC \\ + KILL_TAC >> RW_TAC std_ss [CONTEXT1]) >> REWRITE_TAC [STRONG_BISIM_UPTO] >> fix [`P'`, `Q'`] >> BETA_TAC >> STRIP_TAC (* 2 sub-goals here *) @@ -138,7 +137,7 @@ Proof (* preparing for induction *) >> NTAC 2 POP_ORW >> POP_ASSUM MP_TAC - >> Q.SPEC_TAC (`G`, `G`) + >> Q.ID_SPEC_TAC ‘G’ >> Induct_on `CONTEXT` >> BETA_TAC >> CONJ_TAC (* case 1: "var" *) >- (rpt STRIP_TAC >| (* 2 subgoals *) @@ -231,6 +230,7 @@ Proof art [STRONG_EQUIV_REFL]) \\ DISJ2_TAC \\ Q.EXISTS_TAC `\t. y || G' t` >> BETA_TAC >> REWRITE_TAC [] \\ + `CONTEXT (\z. y)` by REWRITE_TAC [CONTEXT2] \\ Know `CONTEXT (\t. (\z. y) t || G' t)` >- (MATCH_MP_TAC CONTEXT5 >> art []) >> rw [], @@ -674,14 +674,14 @@ val GSEQ_EPS_lemma = Q.prove ( >> rpt STRIP_TAC (* 2 sub-goals here *) >| [ (* goal 1 (of 2) *) IMP_RES_TAC (Q.SPECL [`H P`, `(H o E) P`] WEAK_EQUIV_EPS) \\ - MP_TAC (Q.SPEC `(H :('a, 'b) context) o E` WEAK_UNIQUE_SOLUTION_LEMMA_EPS) \\ + MP_TAC (Q.SPEC `(H :'a context) o E` WEAK_UNIQUE_SOLUTION_LEMMA_EPS) \\ RW_TAC bool_ss [] >> POP_ASSUM (MP_TAC o (Q.SPECL [`P`, `E2`])) \\ RW_TAC bool_ss [] \\ POP_ASSUM (ASSUME_TAC o BETA_RULE o (Q.SPEC `Q`)) \\ - MP_TAC (Q.SPECL [`(H :('a, 'b) context) Q`, - `((H :('a, 'b) context) o (E :('a, 'b) context)) Q`] + MP_TAC (Q.SPECL [`(H :'a context) Q`, + `((H :'a context) o (E :'a context)) Q`] WEAK_EQUIV_EPS') >> RW_TAC bool_ss [] \\ - POP_ASSUM (MP_TAC o (Q.SPEC `(H' :('a, 'b) context) Q`)) \\ + POP_ASSUM (MP_TAC o (Q.SPEC `(H' :'a context) Q`)) \\ RW_TAC bool_ss [] \\ Q.EXISTS_TAC `E1` >> art [] \\ REWRITE_TAC [O_DEF] >> BETA_TAC \\ @@ -691,14 +691,14 @@ val GSEQ_EPS_lemma = Q.prove ( Q.EXISTS_TAC `H'` >> art [], (* goal 2 (of 2) *) IMP_RES_TAC (Q.SPECL [`H Q`, `(H o E) Q`] WEAK_EQUIV_EPS) \\ - MP_TAC (Q.SPEC `(H :('a, 'b) context) o E` WEAK_UNIQUE_SOLUTION_LEMMA_EPS) \\ + MP_TAC (Q.SPEC `(H :'a context) o E` WEAK_UNIQUE_SOLUTION_LEMMA_EPS) \\ RW_TAC bool_ss [] >> POP_ASSUM (MP_TAC o (Q.SPECL [`Q`, `E2`])) \\ RW_TAC bool_ss [] \\ POP_ASSUM (ASSUME_TAC o BETA_RULE o (Q.SPEC `P`)) \\ - MP_TAC (Q.SPECL [`(H :('a, 'b) context) P`, - `((H :('a, 'b) context) o (E :('a, 'b) context)) P`] + MP_TAC (Q.SPECL [`(H :'a context) P`, + `((H :'a context) o (E :'a context)) P`] WEAK_EQUIV_EPS') >> RW_TAC bool_ss [] \\ - POP_ASSUM (MP_TAC o (Q.SPEC `(H' :('a, 'b) context) P`)) \\ + POP_ASSUM (MP_TAC o (Q.SPEC `(H' :'a context) P`)) \\ RW_TAC bool_ss [] \\ Q.EXISTS_TAC `E1` >> art [] \\ REWRITE_TAC [O_DEF] >> BETA_TAC \\ @@ -1347,9 +1347,9 @@ val unfolding_lemma4 = store_thm ( >> IMP_RES_TAC TRACE_cases2 >> Cases_on `xs` >- (REV_FULL_SIMP_TAC std_ss [NULL] \\ - `LENGTH (epsilon :'b Action list) <= n` by FULL_SIMP_TAC arith_ss [LENGTH] \\ + `LENGTH (epsilon :'a Action list) <= n` by FULL_SIMP_TAC arith_ss [LENGTH] \\ Q.PAT_X_ASSUM `!xs P' P. X ==> X'` - (MP_TAC o (Q.SPECL [`[] :'b Action list`, `P'`, `(E :('a, 'b) context) P`])) \\ + (MP_TAC o (Q.SPECL [`[] :'a Action list`, `P'`, `(E :'a context) P`])) \\ RW_TAC std_ss [] \\ Q.EXISTS_TAC `C' o E` >> art [] \\ CONJ_TAC >- (IMP_RES_TAC WGS_IMP_GCONTEXT \\ @@ -1361,7 +1361,7 @@ val unfolding_lemma4 = store_thm ( >> Q.ABBREV_TAC `xs = FRONT (h::t)` >> Q.ABBREV_TAC `x = LAST (h::t)` >> Q.PAT_X_ASSUM `!xs P'' P'''. X ==> X'` - (MP_TAC o (Q.SPECL [`xs`, `u`, `(E :('a, 'b) context) P`])) + (MP_TAC o (Q.SPECL [`xs`, `u`, `(E :'a context) P`])) >> RW_TAC std_ss [] >> MP_TAC (Q.SPECL [`C'`, `E`] unfolding_lemma3) >> RW_TAC bool_ss [] @@ -1378,9 +1378,9 @@ val unfolding_lemma4 = store_thm ( (* Lemma 3.9 of [2] *) val UNIQUE_SOLUTION_OF_CONTRACTIONS_LEMMA = store_thm ( "UNIQUE_SOLUTION_OF_CONTRACTIONS_LEMMA", - ``!(P :('a, 'b) CCS) (Q :('a, 'b) CCS). + ``!(P :'a CCS) (Q :'a CCS). (?E. WGS E /\ P contracts (E P) /\ Q contracts (E Q)) ==> - !(C :('a, 'b) context). GCONTEXT C ==> + !(C :'a context). GCONTEXT C ==> (!l R. WEAK_TRANS (C P) (label l) R ==> ?C'. GCONTEXT C' /\ R contracts (C' P) /\ (WEAK_EQUIV O (\x y. WEAK_TRANS x (label l) y)) (C Q) (C' Q)) /\ @@ -1511,7 +1511,7 @@ Proof PROVE_TAC [WEAK_EQUIV_TRANS], (* goal 3 (of 4) *) IMP_RES_TAC (MATCH_MP WEAK_EQUIV_TRANS_tau - (ASSUME ``WEAK_EQUIV E' ((C :('a, 'b) context) P)``)) \\ + (ASSUME ``WEAK_EQUIV E' ((C :'a context) P)``)) \\ IMP_RES_TAC EPS_IMP_WEAK_TRANS (* 2 sub-goals here *) >- ( Q.EXISTS_TAC `E''` >> REWRITE_TAC [EPS_REFL] \\ Q.EXISTS_TAC `C` >> art [] ) \\ @@ -1534,7 +1534,7 @@ Proof PROVE_TAC [WEAK_EQUIV_TRANS], (* goal 4 (of 4) *) IMP_RES_TAC (MATCH_MP WEAK_EQUIV_TRANS_tau - (ASSUME ``WEAK_EQUIV E'' ((C :('a, 'b) context) Q)``)) \\ + (ASSUME ``WEAK_EQUIV E'' ((C :'a context) Q)``)) \\ IMP_RES_TAC EPS_IMP_WEAK_TRANS (* 2 sub-goals here *) >- ( Q.EXISTS_TAC `E'` >> REWRITE_TAC [EPS_REFL] \\ Q.EXISTS_TAC `C` >> art [] ) \\ @@ -1582,9 +1582,9 @@ val unfolding_lemma1' = store_thm ( (* The proof has only minor differences with UNIQUE_SOLUTION_OF_CONTRACTIONS_LEMMA *) val UNIQUE_SOLUTION_OF_EXPANSIONS_LEMMA = store_thm ( "UNIQUE_SOLUTION_OF_EXPANSIONS_LEMMA", - ``!(P :('a, 'b) CCS) (Q :('a, 'b) CCS). + ``!(P :'a CCS) (Q :'a CCS). (?E. WGS E /\ P expands (E P) /\ Q expands (E Q)) ==> - !(C :('a, 'b) context). GCONTEXT C ==> + !(C :'a context). GCONTEXT C ==> (!l R. WEAK_TRANS (C P) (label l) R ==> ?C'. GCONTEXT C' /\ R expands (C' P) /\ (WEAK_EQUIV O (\x y. WEAK_TRANS x (label l) y)) (C Q) (C' Q)) /\ @@ -1715,7 +1715,7 @@ Proof PROVE_TAC [WEAK_EQUIV_TRANS], (* goal 3 (of 4) *) IMP_RES_TAC (MATCH_MP WEAK_EQUIV_TRANS_tau - (ASSUME ``WEAK_EQUIV E' ((C :('a, 'b) context) P)``)) \\ + (ASSUME ``WEAK_EQUIV E' ((C :'a context) P)``)) \\ IMP_RES_TAC EPS_IMP_WEAK_TRANS (* 2 sub-goals here *) >- ( Q.EXISTS_TAC `E''` >> REWRITE_TAC [EPS_REFL] \\ Q.EXISTS_TAC `C` >> art [] ) \\ @@ -1738,7 +1738,7 @@ Proof PROVE_TAC [WEAK_EQUIV_TRANS], (* goal 4 (of 4) *) IMP_RES_TAC (MATCH_MP WEAK_EQUIV_TRANS_tau - (ASSUME ``WEAK_EQUIV E'' ((C :('a, 'b) context) Q)``)) \\ + (ASSUME ``WEAK_EQUIV E'' ((C :'a context) Q)``)) \\ IMP_RES_TAC EPS_IMP_WEAK_TRANS (* 2 sub-goals here *) >- ( Q.EXISTS_TAC `E'` >> REWRITE_TAC [EPS_REFL] \\ Q.EXISTS_TAC `C` >> art [] ) \\ @@ -1921,9 +1921,9 @@ Proof >> IMP_RES_TAC TRACE_cases2 >> Cases_on `xs` >- (REV_FULL_SIMP_TAC std_ss [NULL] \\ - `LENGTH (epsilon :'b Action list) <= n` by FULL_SIMP_TAC arith_ss [LENGTH] \\ + `LENGTH (epsilon :'a Action list) <= n` by FULL_SIMP_TAC arith_ss [LENGTH] \\ Q.PAT_X_ASSUM `!xs P' P. X ==> X'` - (MP_TAC o (Q.SPECL [`[] :'b Action list`, `P'`, `(E :('a, 'b) context) P`])) \\ + (MP_TAC o (Q.SPECL [`[] :'a Action list`, `P'`, `(E :'a context) P`])) \\ RW_TAC std_ss [] \\ Q.EXISTS_TAC `C' o E` >> art [] \\ CONJ_TAC >- (IMP_RES_TAC WG_IMP_CONTEXT \\ @@ -1935,7 +1935,7 @@ Proof >> Q.ABBREV_TAC `xs = FRONT (h::t)` >> Q.ABBREV_TAC `x = LAST (h::t)` >> Q.PAT_X_ASSUM `!xs P'' P'''. X ==> X'` - (MP_TAC o (Q.SPECL [`xs`, `u`, `(E :('a, 'b) context) P`])) + (MP_TAC o (Q.SPECL [`xs`, `u`, `(E :'a context) P`])) >> RW_TAC std_ss [] >> MP_TAC (Q.SPECL [`C'`, `E`] OBS_unfolding_lemma3) >> RW_TAC bool_ss [] @@ -1952,9 +1952,9 @@ QED (* Lemma 3.9 of [2] *) val UNIQUE_SOLUTION_OF_OBS_CONTRACTIONS_LEMMA = store_thm ( "UNIQUE_SOLUTION_OF_OBS_CONTRACTIONS_LEMMA", - ``!(P :('a, 'b) CCS) (Q :('a, 'b) CCS) E. + ``!(P :'a CCS) (Q :'a CCS) E. WG E /\ OBS_contracts P (E P) /\ OBS_contracts Q (E Q) ==> - !(C :('a, 'b) context). CONTEXT C ==> + !(C :'a context). CONTEXT C ==> (!l R. WEAK_TRANS (C P) (label l) R ==> ?C'. CONTEXT C' /\ R contracts (C' P) /\ (WEAK_EQUIV O (\x y. WEAK_TRANS x (label l) y)) (C Q) (C' Q)) /\ diff --git a/examples/CCS/WeakEQScript.sml b/examples/CCS/WeakEQScript.sml index 767fca74c2..b73ed75657 100644 --- a/examples/CCS/WeakEQScript.sml +++ b/examples/CCS/WeakEQScript.sml @@ -7,6 +7,7 @@ open HolKernel Parse boolLib bossLib; open pred_setTheory relationTheory bisimulationTheory listTheory IndDefRules; + open CCSLib CCSTheory StrongEQTheory; val _ = new_theory "WeakEQ"; @@ -400,10 +401,10 @@ val WEAK_SUM2 = store_thm ((* NEW *) (******************************************************************************) val WEAK_BISIM_def = Define - `WEAK_BISIM (R :('a, 'b) simulation) = WBISIM TRANS tau R`; + `WEAK_BISIM (R :'a simulation) = WBISIM TRANS tau R`; Theorem WEAK_BISIM : - WEAK_BISIM (Wbsm: ('a, 'b) simulation) = + WEAK_BISIM (Wbsm: 'a simulation) = !E E'. Wbsm E E' ==> (!l. (!E1. TRANS E (label l) E1 ==> @@ -455,7 +456,7 @@ val EPS_TRANS_AUX = store_thm ( IMP_RES_TAC (CONJUNCT2 (MATCH_MP (EQ_MP (SPEC_ALL WEAK_BISIM) (ASSUME ``WEAK_BISIM Wbsm``)) - (ASSUME ``(Wbsm: ('a, 'b) simulation) E E''``))) \\ + (ASSUME ``(Wbsm: 'a simulation) E E''``))) \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [], (* goal 2 (of 3) *) REPEAT STRIP_TAC \\ @@ -466,12 +467,12 @@ val EPS_TRANS_AUX = store_thm ( (MATCH_MP (ASSUME ``!Wbsm E'. WEAK_BISIM Wbsm /\ Wbsm E E' ==> (?E2. EPS E' E2 /\ Wbsm E1 E2)``) (CONJ (ASSUME ``WEAK_BISIM Wbsm``) - (ASSUME ``(Wbsm: ('a, 'b) simulation) E E''``))) \\ + (ASSUME ``(Wbsm: 'a simulation) E E''``))) \\ STRIP_ASSUME_TAC (MATCH_MP (ASSUME ``!Wbsm E''. WEAK_BISIM Wbsm /\ Wbsm E1 E'' ==> (?E2. EPS E'' E2 /\ Wbsm E' E2)``) (CONJ (ASSUME ``WEAK_BISIM Wbsm``) - (ASSUME ``(Wbsm: ('a, 'b) simulation) E1 E2``))) \\ + (ASSUME ``(Wbsm: 'a simulation) E1 E2``))) \\ Q.EXISTS_TAC `E2'` >> ASM_REWRITE_TAC [] \\ MATCH_MP_TAC EPS_TRANS \\ Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC [] ]); @@ -493,7 +494,7 @@ val EPS_TRANS_AUX_SYM = store_thm ( (Q.SPEC `inv Wbsm` (MATCH_MP EPS_TRANS_AUX (ASSUME ``EPS E' E1``))) >> ASSUME_TAC (REWRITE_RULE [INVERSE_REL] - (ASSUME ``(inv (Wbsm :('a, 'b) simulation)) E1 E2'``)) + (ASSUME ``(inv (Wbsm :'a simulation)) E1 E2'``)) >> Q.EXISTS_TAC `E2'` >> art []); (* Auxiliary result for WEAK_TRANS. *) @@ -508,20 +509,20 @@ val WEAK_TRANS_AUX = store_thm ( >> STRIP_ASSUME_TAC (MATCH_MP (MATCH_MP EPS_TRANS_AUX (ASSUME ``EPS E E1'``)) (CONJ (ASSUME ``WEAK_BISIM Wbsm``) - (ASSUME ``(Wbsm: ('a, 'b) simulation) E E'``))) + (ASSUME ``(Wbsm: 'a simulation) E E'``))) >> IMP_RES_TAC (MATCH_MP (EQ_MP (SPEC_ALL WEAK_BISIM) (ASSUME ``WEAK_BISIM Wbsm``)) - (ASSUME ``(Wbsm: ('a, 'b) simulation) E1' E2'``)) + (ASSUME ``(Wbsm: 'a simulation) E1' E2'``)) >> STRIP_ASSUME_TAC (MATCH_MP (MATCH_MP EPS_TRANS_AUX (ASSUME ``EPS E2 E1``)) (CONJ (ASSUME ``WEAK_BISIM Wbsm``) - (ASSUME ``(Wbsm: ('a, 'b) simulation) E2 E2''``))) + (ASSUME ``(Wbsm: 'a simulation) E2 E2''``))) >> ASSUME_TAC (MATCH_MP EPS_WEAK_EPS (LIST_CONJ [ASSUME ``EPS E' E2'``, ASSUME ``WEAK_TRANS E2' (label l) E2''``, ASSUME ``EPS E2'' E2'''``])) - >> EXISTS_TAC ``E2''' :('a, 'b) CCS`` + >> EXISTS_TAC ``E2''' :'a CCS`` >> ASM_REWRITE_TAC []); (* Symmetric auxiliary result for WEAK_TRANS. *) @@ -539,8 +540,8 @@ val WEAK_TRANS_AUX_SYM = store_thm ( (MATCH_MP WEAK_TRANS_AUX (ASSUME ``WEAK_TRANS E' (label l) E1``))) >> ASSUME_TAC (REWRITE_RULE [INVERSE_REL] - (ASSUME ``(inv (Wbsm: ('a, 'b) simulation)) E1 E2'``)) - >> EXISTS_TAC ``E2' :('a, 'b) CCS`` >> art []); + (ASSUME ``(inv (Wbsm: 'a simulation)) E1 E2'``)) + >> EXISTS_TAC ``E2' :'a CCS`` >> art []); (* The composition of two weak bisimulations is a weak bisimulation. *) Theorem COMP_WEAK_BISIM : @@ -565,7 +566,7 @@ QED 3. WEAK_EQUIV_coind is new (the co-inductive principle) *) CoInductive WEAK_EQUIV : - !(E :('a, 'b) CCS) (E' :('a, 'b) CCS). + !(E :'a CCS) (E' :'a CCS). (!l. (!E1. TRANS E (label l) E1 ==> ?E2. WEAK_TRANS E' (label l) E2 /\ WEAK_EQUIV E1 E2) /\ @@ -696,18 +697,18 @@ val WEAK_EQUIV_SUBST_PREFIX = store_thm ( "WEAK_EQUIV_SUBST_PREFIX", ``!E E'. WEAK_EQUIV E E' ==> !u. WEAK_EQUIV (prefix u E) (prefix u E')``, REPEAT GEN_TAC - >> PURE_ONCE_REWRITE_TAC [SPECL [``prefix (u :'b Action) E``, - ``prefix (u :'b Action) E'``] WEAK_PROPERTY_STAR] + >> PURE_ONCE_REWRITE_TAC [SPECL [``prefix (u :'a Action) E``, + ``prefix (u :'a Action) E'``] WEAK_PROPERTY_STAR] >> REPEAT STRIP_TAC (* 4 sub-goals here *) >| [ (* goal 1 (of 4) *) IMP_RES_TAC TRANS_PREFIX \\ Q.EXISTS_TAC `E'` >> ASM_REWRITE_TAC [WEAK_TRANS] \\ - EXISTS_TAC ``prefix (u :'b Action) E'`` \\ + EXISTS_TAC ``prefix (u :'a Action) E'`` \\ Q.EXISTS_TAC `E'` >> ASM_REWRITE_TAC [EPS_REFL, PREFIX], (* goal 2 (of 4) *) IMP_RES_TAC TRANS_PREFIX \\ Q.EXISTS_TAC `E` >> ASM_REWRITE_TAC [WEAK_TRANS] \\ - EXISTS_TAC ``prefix (u :'b Action) E`` \\ + EXISTS_TAC ``prefix (u :'a Action) E`` \\ Q.EXISTS_TAC `E` >> ASM_REWRITE_TAC [EPS_REFL, PREFIX], (* goal 3 (of 4) *) IMP_RES_TAC TRANS_PREFIX \\ @@ -722,7 +723,7 @@ val WEAK_EQUIV_SUBST_PREFIX = store_thm ( val _ = hide "STABLE"; (* conflicted with sortingTheory *) val STABLE = new_definition ("STABLE", - ``STABLE (E :('a, 'b) CCS) = (!u E'. TRANS E u E' ==> ~(u = tau))``); + ``STABLE (E :'a CCS) = (!u E'. TRANS E u E' ==> ~(u = tau))``); (* Alternative definition using P, Q, p, q as process variables *) val STABLE' = store_thm ( @@ -742,23 +743,25 @@ val STABLE_cases = store_thm ( (* Properties of stable agents with respect to the epsilon and weak transition relations. *) -val EPS_STABLE = store_thm ("EPS_STABLE", - ``!E E'. EPS E E' ==> (STABLE E ==> (E' = E))``, +Theorem EPS_STABLE : + !E E'. EPS E E' ==> (STABLE E ==> (E' = E)) +Proof EPS_INDUCT_TAC (* 3 sub-goals here *) >| [ (* goal 1 (of 3) *) REWRITE_TAC [STABLE] >> DISCH_TAC \\ CHECK_ASSUME_TAC (REWRITE_RULE [] - (MATCH_MP (ASSUME ``!(u: 'b Action) E'. TRANS E u E' ==> ~(u = tau)``) + (MATCH_MP (ASSUME ``!(u :'a Action) E'. TRANS E u E' ==> ~(u = tau)``) (ASSUME ``TRANS E tau E'``))), (* goal 2 (of 3) *) REWRITE_TAC [], (* goal 3 (of 3) *) DISCH_TAC >> RES_TAC \\ REWRITE_TAC - [MATCH_MP (REWRITE_RULE [ASSUME ``E1 = E: ('a, 'b) CCS``] + [MATCH_MP (REWRITE_RULE [ASSUME ``E1 = E: 'a CCS``] (ASSUME ``STABLE E1 ==> (E' = E1)``)) - (ASSUME ``STABLE E``)] ]); + (ASSUME ``STABLE E``)] ] +QED val EPS_STABLE' = store_thm ( "EPS_STABLE'", ``!E E'. EPS E E' /\ STABLE E ==> (E' = E)``, @@ -775,7 +778,7 @@ val WEAK_TRANS_STABLE = store_thm ( (MATCH_MP (MATCH_MP EPS_STABLE (ASSUME ``EPS E E1``)) (ASSUME ``STABLE E``)) - >> ASSUME_TAC (REWRITE_RULE [ASSUME ``E1 = E: ('a, 'b) CCS``] + >> ASSUME_TAC (REWRITE_RULE [ASSUME ``E1 = E: 'a CCS``] (ASSUME ``TRANS E1 (label l) E2``)) >> Q.EXISTS_TAC `E2` >> ASM_REWRITE_TAC []); @@ -1217,7 +1220,7 @@ val WEAK_EQUIV_PRESD_BY_PAR = store_thm ( (ASSUME ``EPS E2'''''' E2''''``))] \\ MATCH_MP_TAC ONE_TAU \\ MATCH_MP_TAC PAR3 \\ - EXISTS_TAC ``l: 'b Label`` \\ + EXISTS_TAC ``l :'a Label`` \\ ASM_REWRITE_TAC [], (* goal 3.3.2 (of 2) *) take [`E1'''`, `E2'''`, `E2''`, `E2''''`] \\ @@ -1273,7 +1276,7 @@ val WEAK_EQUIV_PRESD_BY_PAR = store_thm ( (ASSUME ``EPS E2''''' E1''''``))] \\ MATCH_MP_TAC ONE_TAU \\ MATCH_MP_TAC PAR3 \\ - EXISTS_TAC ``l: 'b Label`` \\ + EXISTS_TAC ``l :'a Label`` \\ ASM_REWRITE_TAC [], (* goal 4.3.2 (of 2) *) take [`E1'''`, `E1''`, `E1''''`, `E2'''`] \\ @@ -1313,7 +1316,7 @@ val EPS_RESTR = store_thm ( IMP_RES_TAC (REWRITE_RULE [] (Q.SPECL [`E`, `tau`, `E'`] RESTR)) \\ ASSUME_TAC - (Q.SPEC `L` (ASSUME ``!L :('b Label) set. + (Q.SPEC `L` (ASSUME ``!L :'a Label set. TRANS (restr L E) tau (restr L E')``)) \\ IMP_RES_TAC ONE_TAU, (* goal 2 (of 3) *) @@ -1321,26 +1324,26 @@ val EPS_RESTR = store_thm ( (* goal 3 (of 3) *) GEN_TAC \\ ASSUME_TAC - (Q.SPEC `L` (ASSUME ``!L :('b Label) set. EPS (restr L E) (restr L E1)``)) \\ + (Q.SPEC `L` (ASSUME ``!L :'a Label set. EPS (restr L E) (restr L E1)``)) \\ ASSUME_TAC - (Q.SPEC `L` (ASSUME ``!L :('b Label) set. EPS (restr L E1) (restr L E')``)) \\ + (Q.SPEC `L` (ASSUME ``!L :'a Label set. EPS (restr L E1) (restr L E')``)) \\ IMP_RES_TAC EPS_TRANS ]); (* The relation WEAK_TRANS is preserved by the restriction operator. *) val WEAK_RESTR_label = store_thm ( "WEAK_RESTR_label", - ``!(l :'b Label) L E E'. + ``!(l :'a Label) L E E'. ~(l IN L) /\ ~((COMPL l) IN L) /\ WEAK_TRANS E (label l) E' ==> WEAK_TRANS (restr L E) (label l) (restr L E')``, REPEAT GEN_TAC >> PURE_ONCE_REWRITE_TAC [WEAK_TRANS] >> STRIP_TAC - >> EXISTS_TAC ``restr (L :'b Label set) E1`` - >> EXISTS_TAC ``restr (L :'b Label set) E2`` + >> EXISTS_TAC ``restr (L :'a Label set) E1`` + >> EXISTS_TAC ``restr (L :'a Label set) E2`` >> IMP_RES_TAC EPS_RESTR >> ASM_REWRITE_TAC [] >> MATCH_MP_TAC RESTR - >> EXISTS_TAC ``l: 'b Label`` + >> EXISTS_TAC ``l :'a Label`` >> ASM_REWRITE_TAC []); val WEAK_RESTR_tau = store_thm ( @@ -1351,8 +1354,8 @@ val WEAK_RESTR_tau = store_thm ( >> PURE_ONCE_REWRITE_TAC [WEAK_TRANS] >> STRIP_TAC >> GEN_TAC - >> EXISTS_TAC ``restr (L :'b Label set) E1`` - >> EXISTS_TAC ``restr (L :'b Label set) E2`` + >> EXISTS_TAC ``restr (L :'a Label set) E1`` + >> EXISTS_TAC ``restr (L :'a Label set) E2`` >> IMP_RES_TAC EPS_RESTR >> ASM_REWRITE_TAC [] >> MATCH_MP_TAC RESTR @@ -1384,12 +1387,12 @@ val WEAK_EQUIV_SUBST_RESTR = store_thm ( IMP_RES_TAC (CONJUNCT1 (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] (ASSUME ``WEAK_EQUIV E1 E2``))) \\ - EXISTS_TAC ``restr (L' :'b Label set) E2'`` \\ + EXISTS_TAC ``restr (L' :'a Label set) E2'`` \\ ASM_REWRITE_TAC [MATCH_MP WEAK_RESTR_label - (LIST_CONJ [ASSUME ``~((l': 'b Label) IN L')``, - ASSUME ``~((COMPL (l': 'b Label)) IN L')``, - REWRITE_RULE [ASSUME ``label (l :'b Label) = label l'``] + (LIST_CONJ [ASSUME ``~((l' :'a Label) IN L')``, + ASSUME ``~((COMPL (l' :'a Label)) IN L')``, + REWRITE_RULE [ASSUME ``label (l :'a Label) = label l'``] (ASSUME ``WEAK_TRANS E2 (label l) E2'``)])] \\ take [`E''''`, `E2'`, `L'`] >> ASM_REWRITE_TAC [] ], (* goal 2.2 (of 4) *) @@ -1402,12 +1405,12 @@ val WEAK_EQUIV_SUBST_RESTR = store_thm ( IMP_RES_TAC (CONJUNCT1 (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] (ASSUME ``WEAK_EQUIV E1 E2``))) \\ - EXISTS_TAC ``restr (L' :'b Label set) E1'`` \\ + EXISTS_TAC ``restr (L' :'a Label set) E1'`` \\ ASM_REWRITE_TAC [MATCH_MP WEAK_RESTR_label - (LIST_CONJ [ASSUME ``~((l': 'b Label) IN L')``, - ASSUME ``~((COMPL (l': 'b Label)) IN L')``, - REWRITE_RULE [ASSUME ``label (l :'b Label) = label l'``] + (LIST_CONJ [ASSUME ``~((l' :'a Label) IN L')``, + ASSUME ``~((COMPL (l' :'a Label)) IN L')``, + REWRITE_RULE [ASSUME ``label (l :'a Label) = label l'``] (ASSUME ``WEAK_TRANS E1 (label l) E1'``)])] \\ take [`E1'`, `E''''`, `L'`] >> ASM_REWRITE_TAC [] ], (* goal 2.3 (of 4) *) @@ -1418,7 +1421,7 @@ val WEAK_EQUIV_SUBST_RESTR = store_thm ( IMP_RES_TAC (CONJUNCT2 (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] (ASSUME ``WEAK_EQUIV E1 E2``))) \\ - EXISTS_TAC ``restr (L' :'b Label set) E2'`` \\ + EXISTS_TAC ``restr (L' :'a Label set) E2'`` \\ IMP_RES_TAC EPS_RESTR >> ASM_REWRITE_TAC [] \\ take [`E''''`, `E2'`, `L'`] >> ASM_REWRITE_TAC [], (* goal 2.3.2 (of 2) *) @@ -1431,7 +1434,7 @@ val WEAK_EQUIV_SUBST_RESTR = store_thm ( IMP_RES_TAC (CONJUNCT2 (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] (ASSUME ``WEAK_EQUIV E1 E2``))) \\ - EXISTS_TAC ``restr (L' :'b Label set) E1'`` \\ + EXISTS_TAC ``restr (L' :'a Label set) E1'`` \\ IMP_RES_TAC EPS_RESTR >> ASM_REWRITE_TAC [] \\ take [`E1'`, `E''''`, `L'`] >> ASM_REWRITE_TAC [], (* goal 2.4.2 (of 2) *) @@ -1448,25 +1451,25 @@ val EPS_RELAB = store_thm ("EPS_RELAB", (REWRITE_RULE [relabel_def] (Q.SPECL [`E`, `tau`, `E'`] RELABELING)) \\ ASSUME_TAC - (SPEC ``RELAB (labl :('b Label # 'b Label) list)`` - (ASSUME ``!rf :'b Relabeling. + (SPEC ``RELAB (labl :('a Label # 'a Label) list)`` + (ASSUME ``!rf :'a Relabeling. TRANS (relab E rf) tau (relab E' rf)``)) \\ IMP_RES_TAC ONE_TAU, (* goal 2 (of 3) *) REWRITE_TAC [EPS_REFL], (* goal 3 (of 3) *) GEN_TAC \\ - PAT_X_ASSUM ``!labl :('b Label # 'b Label) list. + PAT_X_ASSUM ``!labl :('a Label # 'a Label) list. EPS (relab E (RELAB labl)) (relab E1 (RELAB labl))`` - (ASSUME_TAC o (SPEC ``labl :('b Label # 'b Label) list``)) \\ - PAT_X_ASSUM ``!labl :('b Label # 'b Label) list. + (ASSUME_TAC o (SPEC ``labl :('a Label # 'a Label) list``)) \\ + PAT_X_ASSUM ``!labl :('a Label # 'a Label) list. EPS (relab E1 (RELAB labl)) (relab E' (RELAB labl))`` - (ASSUME_TAC o (SPEC ``labl :('b Label # 'b Label) list``)) \\ + (ASSUME_TAC o (SPEC ``labl :('a Label # 'a Label) list``)) \\ IMP_RES_TAC EPS_TRANS ]); val EPS_RELAB_rf = store_thm ( "EPS_RELAB_rf", - ``!E E'. EPS E E' ==> !(rf :'b Relabeling). EPS (relab E rf) (relab E' rf)``, + ``!E E'. EPS E E' ==> !(rf :'a Relabeling). EPS (relab E rf) (relab E' rf)``, EPS_INDUCT_TAC (* 3 sub-goals here *) >| [ (* goal 1 (of 3) *) GEN_TAC \\ @@ -1475,16 +1478,16 @@ val EPS_RELAB_rf = store_thm ( (Q.SPECL [`E`, `tau`, `E'`] RELABELING)) \\ ASSUME_TAC (Q.SPEC `rf` - (ASSUME ``!rf :'b Relabeling. + (ASSUME ``!rf :'a Relabeling. TRANS (relab E rf) tau (relab E' rf)``)) \\ IMP_RES_TAC ONE_TAU, (* goal 2 (of 3) *) REWRITE_TAC [EPS_REFL], (* goal 3 (of 3) *) GEN_TAC \\ - PAT_X_ASSUM ``!rf :'b Relabeling. EPS (relab E rf) (relab E1 rf)`` + PAT_X_ASSUM ``!rf :'a Relabeling. EPS (relab E rf) (relab E1 rf)`` (ASSUME_TAC o (Q.SPEC `rf`)) \\ - PAT_X_ASSUM ``!rf :'b Relabeling. EPS (relab E1 rf) (relab E' rf)`` + PAT_X_ASSUM ``!rf :'a Relabeling. EPS (relab E1 rf) (relab E' rf)`` (ASSUME_TAC o (Q.SPEC `rf`)) \\ IMP_RES_TAC EPS_TRANS ]); @@ -1492,7 +1495,7 @@ val EPS_RELAB_rf = store_thm ( val WEAK_RELAB = store_thm ("WEAK_RELAB", ``!E u E'. WEAK_TRANS E u E' ==> - !(labl :('b Label # 'b Label) list). + !(labl :('a Label # 'a Label) list). WEAK_TRANS (relab E (RELAB labl)) (relabel (RELAB labl) u) (relab E' (RELAB labl))``, @@ -1510,7 +1513,7 @@ val WEAK_RELAB_rf = store_thm ( "WEAK_RELAB_rf", ``!E u E'. WEAK_TRANS E u E' ==> - !(rf :'b Relabeling). WEAK_TRANS (relab E rf) (relabel rf u) (relab E' rf)``, + !(rf :'a Relabeling). WEAK_TRANS (relab E rf) (relabel rf u) (relab E' rf)``, REPEAT GEN_TAC >> PURE_ONCE_REWRITE_TAC [WEAK_TRANS] >> REPEAT STRIP_TAC @@ -1541,9 +1544,9 @@ val WEAK_EQUIV_SUBST_RELAB = store_thm ( ASSUME_TAC (REWRITE_RULE [ASSUME ``E'' = relab E1 rf'``] (ASSUME ``TRANS E'' (label l) E1'``)) \\ IMP_RES_TAC TRANS_RELAB \\ - PAT_X_ASSUM ``label (l :'b Label) = relabel rf' u'`` (ASSUME_TAC o SYM) \\ + PAT_X_ASSUM ``label (l :'a Label) = relabel rf' u'`` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_label \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = label l'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = label l'``] (ASSUME ``TRANS E1 u' E''''``)) \\ IMP_RES_TAC (CONJUNCT1 (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] (ASSUME ``WEAK_EQUIV E1 E2``))) \\ @@ -1559,9 +1562,9 @@ val WEAK_EQUIV_SUBST_RELAB = store_thm ( ASSUME_TAC (REWRITE_RULE [ASSUME ``E''' = relab E2 rf'``] (ASSUME ``TRANS E''' (label l) E2'``)) \\ IMP_RES_TAC TRANS_RELAB \\ - PAT_X_ASSUM ``label (l :'b Label) = relabel rf' u'`` (ASSUME_TAC o SYM) \\ + PAT_X_ASSUM ``label (l :'a Label) = relabel rf' u'`` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_label \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = label l'``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = label l'``] (ASSUME ``TRANS E2 u' E''''``)) \\ IMP_RES_TAC (CONJUNCT1 (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] (ASSUME ``WEAK_EQUIV E1 E2``))) \\ @@ -1577,9 +1580,9 @@ val WEAK_EQUIV_SUBST_RELAB = store_thm ( ASSUME_TAC (REWRITE_RULE [ASSUME ``E'' = relab E1 rf'``] (ASSUME ``TRANS E'' tau E1'``)) \\ IMP_RES_TAC TRANS_RELAB \\ - PAT_X_ASSUM ``(tau :'b Action) = relabel rf' u'`` (ASSUME_TAC o SYM) \\ + PAT_X_ASSUM ``(tau :'a Action) = relabel rf' u'`` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_tau \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = tau``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = tau``] (ASSUME ``TRANS E1 u' E''''``)) \\ IMP_RES_TAC (CONJUNCT2 (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] (ASSUME ``WEAK_EQUIV E1 E2``))) \\ @@ -1595,9 +1598,9 @@ val WEAK_EQUIV_SUBST_RELAB = store_thm ( ASSUME_TAC (REWRITE_RULE [ASSUME ``E''' = relab E2 rf'``] (ASSUME ``TRANS E''' tau E2'``)) \\ IMP_RES_TAC TRANS_RELAB \\ - PAT_X_ASSUM ``(tau :'b Action) = relabel rf' u'`` (ASSUME_TAC o SYM) \\ + PAT_X_ASSUM ``(tau :'a Action) = relabel rf' u'`` (ASSUME_TAC o SYM) \\ IMP_RES_TAC Relab_tau \\ - ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'b Action) = tau``] + ASSUME_TAC (REWRITE_RULE [ASSUME ``(u' :'a Action) = tau``] (ASSUME ``TRANS E2 u' E''''``)) \\ IMP_RES_TAC (CONJUNCT2 (ONCE_REWRITE_RULE [WEAK_PROPERTY_STAR] (ASSUME ``WEAK_EQUIV E1 E2``))) \\ diff --git a/examples/CCS/WeakLawsScript.sml b/examples/CCS/WeakLawsScript.sml index 39a4a98004..828ccf15c2 100644 --- a/examples/CCS/WeakLawsScript.sml +++ b/examples/CCS/WeakLawsScript.sml @@ -6,8 +6,9 @@ open HolKernel Parse boolLib bossLib; open pred_setTheory prim_recTheory arithmeticTheory relationTheory; -open CCSLib CCSTheory StrongEQTheory StrongLawsTheory; -open WeakEQTheory WeakEQLib; + +open CCSLib CCSTheory StrongEQTheory StrongLawsTheory + WeakEQTheory WeakEQLib; val _ = new_theory "WeakLaws"; @@ -139,7 +140,7 @@ val WEAK_PAR_TAU_TAU = save_thm ( *) val WEAK_PAR_PREF_NO_SYNCR = save_thm ( "WEAK_PAR_PREF_NO_SYNCR", - STRIP_FORALL_RULE ((DISCH ``~((l :'b Label) = COMPL l')``) o + STRIP_FORALL_RULE ((DISCH ``~((l :'a Label) = COMPL l')``) o (STRONG_IMP_WEAK_EQUIV_RULE) o UNDISCH) STRONG_PAR_PREF_NO_SYNCR); @@ -156,7 +157,7 @@ val WEAK_PAR_PREF_NO_SYNCR = save_thm ( *) val WEAK_PAR_PREF_SYNCR = save_thm ( "WEAK_PAR_PREF_SYNCR", - STRIP_FORALL_RULE ((DISCH ``((l :'b Label) = COMPL l')``) o + STRIP_FORALL_RULE ((DISCH ``((l :'a Label) = COMPL l')``) o (STRONG_IMP_WEAK_EQUIV_RULE) o UNDISCH) STRONG_PAR_PREF_SYNCR); @@ -211,15 +212,15 @@ val WEAK_RESTR_PREFIX_TAU = save_thm ( val WEAK_RESTR_PR_LAB_NIL = save_thm ( "WEAK_RESTR_PR_LAB_NIL", GEN_ALL - (DISCH ``(l :'b Label) IN L \/ (COMPL l) IN L`` + (DISCH ``(l :'a Label) IN L \/ (COMPL l) IN L`` (Q.GEN `E` (UNDISCH (IMP_TRANS - (DISCH ``(l :'b Label) IN L \/ (COMPL l) IN L`` + (DISCH ``(l :'a Label) IN L \/ (COMPL l) IN L`` (Q.SPEC `E` (UNDISCH (Q.SPECL [`l`, `L`] STRONG_RESTR_PR_LAB_NIL)))) - (SPECL [``restr (L :'b Label set) (prefix (label l) E)``, ``nil``] + (SPECL [``restr (L :'a Label set) (prefix (label l) E)``, ``nil``] STRONG_IMP_WEAK_EQUIV)))))); (* Prove WEAK_RESTR_PREFIX_LABEL: @@ -230,16 +231,16 @@ val WEAK_RESTR_PR_LAB_NIL = save_thm ( val WEAK_RESTR_PREFIX_LABEL = save_thm ( "WEAK_RESTR_PREFIX_LABEL", GEN_ALL - (DISCH ``~((l :'b Label) IN L) /\ ~((COMPL l) IN L)`` + (DISCH ``~((l :'a Label) IN L) /\ ~((COMPL l) IN L)`` (Q.GEN `E` (UNDISCH (IMP_TRANS - (DISCH ``~((l :'b Label) IN L) /\ ~((COMPL l) IN L)`` + (DISCH ``~((l :'a Label) IN L) /\ ~((COMPL l) IN L)`` (Q.SPEC `E` (UNDISCH (Q.SPECL [`l`, `L`] STRONG_RESTR_PREFIX_LABEL)))) - (SPECL [``restr (L :'b Label set) (prefix (label l) E)``, - ``prefix (label (l :'b Label)) (restr L E)``] + (SPECL [``restr (L :'a Label set) (prefix (label l) E)``, + ``prefix (label (l :'a Label)) (restr L E)``] STRONG_IMP_WEAK_EQUIV)))))); (******************************************************************************) diff --git a/examples/CCS/selftest.sml b/examples/CCS/selftest.sml index 662249cb8f..b55e8d3b50 100644 --- a/examples/CCS/selftest.sml +++ b/examples/CCS/selftest.sml @@ -47,7 +47,7 @@ val CCS_TRANS_tests = (* test #3 *) (``par nil nil``, -“∀u (E :('a, 'b) CCS). ¬(nil || nil --u-> E)”), +“∀u (E :'a CCS). ¬(nil || nil --u-> E)”), (* test #4 *) (``restr { name "a" } (par nil nil)``, diff --git a/examples/lambda/barendregt/labelledTermsScript.sml b/examples/lambda/barendregt/labelledTermsScript.sml index cea020e3ac..b4af9a7d59 100644 --- a/examples/lambda/barendregt/labelledTermsScript.sml +++ b/examples/lambda/barendregt/labelledTermsScript.sml @@ -1,22 +1,21 @@ -open HolKernel boolLib Parse bossLib BasicProvers -open pred_setTheory +open HolKernel boolLib Parse bossLib; -open binderLib -open basic_swapTheory nomsetTheory generic_termsTheory -open nomdatatype -open boolSimps +open BasicProvers boolSimps pred_setTheory listTheory; +open binderLib basic_swapTheory nomsetTheory generic_termsTheory nomdatatype; val _ = new_theory "labelledTerms" val tyname = "lterm" -val vp = “(λn u: unit. n = 0)” +(* GVAR corresponds to VAR *) +val vp = “(λn u: unit. n = 0)”; +(* GLAM corresponds to APP, LAM and LAMi *) val lp = “(λn (d:unit + unit + num) tns uns. (n = 0) ∧ ISL d ∧ (tns = []) ∧ (uns = [0;0]) ∨ (n = 0) ∧ ISR d ∧ ISL (OUTR d) ∧ (tns = [0]) ∧ (uns = []) ∨ - (n = 0) ∧ ISR d ∧ ISR (OUTR d) ∧ (tns = [0]) ∧ (uns = [0]))” + (n = 0) ∧ ISR d ∧ ISR (OUTR d) ∧ (tns = [0]) ∧ (uns = [0]))”; val {term_ABS_pseudo11, term_REP_11, genind_term_REP, genind_exists, termP, absrep_id, repabs_pseudo_id, newty, term_REP_t, term_ABS_t,...} = @@ -38,6 +37,7 @@ val LAM_termP = prove( match_mp_tac glam >> srw_tac [][genind_term_REP]) val LAM_t = defined_const LAM_def +(* NOTE: in ‘(LAMi n v t1) t2’, only t1 is bounded (by v), t2 is not. *) val LAMi_t = mk_var("LAMi", “:num -> string -> ^newty -> ^newty -> ^newty”) val LAMi_def = new_definition( "LAMi_def", @@ -220,16 +220,6 @@ val termP0 = prove( Q.ISPEC_THEN ‘t’ STRUCT_CASES_TAC gterm_cases >> srw_tac [][genind_GVAR, genind_GLAM_eqn]); -val LENGTH_NIL' = - CONV_RULE (BINDER_CONV (LAND_CONV (REWR_CONV EQ_SYM_EQ))) - listTheory.LENGTH_NIL -val LENGTH1 = prove( - “(1 = LENGTH l) ⇔ ∃e. l = [e]”, - Cases_on ‘l’ >> srw_tac [][listTheory.LENGTH_NIL]); -val LENGTH2 = prove( - “(2 = LENGTH l) ⇔ ∃a b. l = [a;b]”, - Cases_on ‘l’ >> srw_tac [][LENGTH1]); - val termP_elim = prove( “(∀g. ^termP g ⇒ P g) ⇔ (∀t. P (^term_REP_t t))”, srw_tac [][EQ_IMP_THM] >- srw_tac [][genind_term_REP] >> @@ -258,10 +248,9 @@ val parameter_tm_recursion = save_thm( LIST_REL_CONS1, genind_GVAR, genind_GLAM_eqn, NEWFCB_def, sidecond_def, relsupp_def, - LENGTH_NIL', LENGTH1, LENGTH2] + LENGTH_NIL_SYM, LENGTH1, LENGTH2] |> ONCE_REWRITE_RULE [termP0] - |> SIMP_RULE (srw_ss() ++ DNF_ss) [LENGTH1, LENGTH2, - listTheory.LENGTH_NIL] + |> SIMP_RULE (srw_ss() ++ DNF_ss) [LENGTH1, LENGTH2, LENGTH_NIL] |> CONV_RULE (DEPTH_CONV termP_removal) |> SIMP_RULE (srw_ss()) [GSYM supp_tpm, SYM term_REP_tpm] |> UNDISCH @@ -279,25 +268,6 @@ val parameter_tm_recursion = save_thm( |> Q.INST [‘vr'’ |-> ‘vr’, ‘dpm’ |-> ‘apm’] |> CONV_RULE (REDEPTH_CONV sort_uvars)) -val FORALL_ONE = prove( - “(!u:one. P u) = P ()”, - SRW_TAC [][EQ_IMP_THM, oneTheory.one_induction]); -val FORALL_ONE_FN = prove( - “(!uf : one -> 'a. P uf) = !a. P (\u. a)”, - SRW_TAC [][EQ_IMP_THM] THEN - POP_ASSUM (Q.SPEC_THEN ‘uf ()’ MP_TAC) THEN - Q_TAC SUFF_TAC ‘(\y. uf()) = uf’ THEN1 SRW_TAC [][] THEN - SRW_TAC [][FUN_EQ_THM, oneTheory.one]); - -val EXISTS_ONE_FN = prove( - “(?f : 'a -> one -> 'b. P f) = (?f : 'a -> 'b. P (\x u. f x))”, - SRW_TAC [][EQ_IMP_THM] THENL [ - Q.EXISTS_TAC ‘\a. f a ()’ THEN SRW_TAC [][] THEN - Q_TAC SUFF_TAC ‘(\x u. f x ()) = f’ THEN1 SRW_TAC [][] THEN - SRW_TAC [][FUN_EQ_THM, oneTheory.one], - Q.EXISTS_TAC ‘\a u. f a’ THEN SRW_TAC [][] - ]); - val tm_recursion = save_thm( "tm_recursion", parameter_tm_recursion @@ -306,8 +276,8 @@ val tm_recursion = save_thm( ‘ap’ |-> ‘λr1 r2 t1 t2 u. apu (r1()) (r2()) t1 t2’, ‘lm’ |-> ‘λr v t u. lmu (r()) v t’, ‘li’ |-> ‘λr1 r2 n v t1 t2 u. liu (r1()) (r2()) n v t1 t2’] - |> SIMP_RULE (srw_ss()) [FORALL_ONE, FORALL_ONE_FN, EXISTS_ONE_FN, - fnpm_def] + |> SIMP_RULE (srw_ss()) [oneTheory.FORALL_ONE, oneTheory.FORALL_ONE_FN, + oneTheory.EXISTS_ONE_FN, fnpm_def] |> SIMP_RULE (srw_ss() ++ CONJ_ss) [supp_unitfn] |> Q.INST [‘apu’ |-> ‘ap’, ‘lmu’ |-> ‘lm’, ‘vru’ |-> ‘vr’, ‘liu’ |-> ‘li’]) diff --git a/examples/lambda/basics/ctermScript.sml b/examples/lambda/basics/ctermScript.sml index 670de060b3..3c14b4744c 100644 --- a/examples/lambda/basics/ctermScript.sml +++ b/examples/lambda/basics/ctermScript.sml @@ -1,6 +1,6 @@ open HolKernel Parse boolLib bossLib; -open boolSimps arithmeticTheory pred_setTheory finite_mapTheory hurdUtils; +open boolSimps arithmeticTheory pred_setTheory listTheory finite_mapTheory hurdUtils; open generic_termsTheory binderLib nomsetTheory nomdatatype; @@ -8,7 +8,9 @@ val _ = new_theory "cterm"; val tyname = "cterm" -val vp = ``(λn u:unit. n = 0)`` +val vp = “(λn u:unit. n = 0)”; + +(* GLAM corresponds to APP, LAM and CONST *) val lp = “(λn (d:unit + unit + 'a) tns uns. n = 0 ∧ ISL d ∧ tns = [] ∧ uns = [0;0] ∨ n = 0 ∧ ISR d ∧ ISL (OUTR d) ∧ tns = [0] ∧ uns = [] ∨ @@ -28,7 +30,6 @@ val LAM_termP = prove( match_mp_tac glam >> srw_tac [][genind_term_REP]); val LAM_t = defined_const LAM_def - val APP_t = mk_var("APP", ``:^newty -> ^newty -> ^newty``) val APP_def = new_definition( "APP_def", @@ -191,16 +192,6 @@ val tlf = (cterm_ABS (HD (TL ts2))) p: 'r`` val tvf = ``λ(s:string) (u:unit) (p:ρ). tvf s p : 'r`` -val LENGTH_NIL' = - CONV_RULE (BINDER_CONV (LAND_CONV (REWR_CONV EQ_SYM_EQ))) - listTheory.LENGTH_NIL -val LENGTH1 = prove( - ``(1 = LENGTH l) ⇔ ∃e. l = [e]``, - Cases_on `l` >> srw_tac [][listTheory.LENGTH_NIL]); -val LENGTH2 = prove( - ``(2 = LENGTH l) ⇔ ∃a b. l = [a;b]``, - Cases_on `l` >> srw_tac [][LENGTH1]); - val termP_elim = prove( ``(∀g. ^termP g ⇒ P g) ⇔ (∀t. P (^term_REP_t t))``, srw_tac [][EQ_IMP_THM] >- srw_tac [][genind_term_REP] >> @@ -236,10 +227,9 @@ val parameter_tm_recursion = save_thm( LIST_REL_CONS1, genind_GVAR, genind_GLAM_eqn, sidecond_def, NEWFCB_def, relsupp_def, - LENGTH_NIL', LENGTH1, LENGTH2] + LENGTH_NIL_SYM, LENGTH1, LENGTH2] |> ONCE_REWRITE_RULE [termP0] - |> SIMP_RULE (srw_ss() ++ DNF_ss) [LENGTH1, LENGTH2, - listTheory.LENGTH_NIL] + |> SIMP_RULE (srw_ss() ++ DNF_ss) [LENGTH1, LENGTH2, LENGTH_NIL] |> CONV_RULE (DEPTH_CONV termP_removal) |> SIMP_RULE (srw_ss()) [GSYM supp_tpm, SYM term_REP_tpm] |> UNDISCH @@ -258,25 +248,6 @@ val parameter_tm_recursion = save_thm( `dpm` |-> `apm`, ‘tcf’ |-> ‘cn’] |> CONV_RULE (REDEPTH_CONV sort_uvars)) -val FORALL_ONE = prove( - ``(!u:one. P u) = P ()``, - SRW_TAC [][EQ_IMP_THM, oneTheory.one_induction]); -val FORALL_ONE_FN = prove( - ``(!uf : one -> 'a. P uf) = !a. P (\u. a)``, - SRW_TAC [][EQ_IMP_THM] THEN - POP_ASSUM (Q.SPEC_THEN `uf ()` MP_TAC) THEN - Q_TAC SUFF_TAC `(\y. uf()) = uf` THEN1 SRW_TAC [][] THEN - SRW_TAC [][FUN_EQ_THM, oneTheory.one]); - -val EXISTS_ONE_FN = prove( - ``(?f : 'a -> one -> 'b. P f) = (?f : 'a -> 'b. P (\x u. f x))``, - SRW_TAC [][EQ_IMP_THM] THENL [ - Q.EXISTS_TAC `\a. f a ()` THEN SRW_TAC [][] THEN - Q_TAC SUFF_TAC `(\x u. f x ()) = f` THEN1 SRW_TAC [][] THEN - SRW_TAC [][FUN_EQ_THM, oneTheory.one], - Q.EXISTS_TAC `\a u. f a` THEN SRW_TAC [][] - ]); - val ctm_recursion = save_thm( "ctm_recursion", parameter_tm_recursion @@ -284,8 +255,8 @@ val ctm_recursion = save_thm( |> Q.INST [`ppm` |-> `discrete_pmact`, `vr` |-> `λs u. vru s`, `ap` |-> `λr1 r2 t1 t2 u. apu (r1()) (r2()) t1 t2`, `lm` |-> `λr v t u. lmu (r()) v t`] - |> SIMP_RULE (srw_ss()) [FORALL_ONE, FORALL_ONE_FN, EXISTS_ONE_FN, - fnpm_def] + |> SIMP_RULE (srw_ss()) [oneTheory.FORALL_ONE, oneTheory.FORALL_ONE_FN, + oneTheory.EXISTS_ONE_FN, fnpm_def] |> SIMP_RULE (srw_ss() ++ CONJ_ss) [supp_unitfn] |> Q.INST [`apu` |-> `ap`, `lmu` |-> `lm`, `vru` |-> `vr`]) @@ -1041,3 +1012,4 @@ val _ = adjoin_after_completion (fn _ => PP.add_string term_info_string) val _ = export_theory() +val _ = html_theory "cterm"; diff --git a/examples/lambda/basics/generic_termsScript.sml b/examples/lambda/basics/generic_termsScript.sml index 6f2349608e..ba9d08dc50 100644 --- a/examples/lambda/basics/generic_termsScript.sml +++ b/examples/lambda/basics/generic_termsScript.sml @@ -3,7 +3,7 @@ open HolKernel Parse boolLib open bossLib binderLib open basic_swapTheory nomsetTheory -open pred_setTheory +open pred_setTheory listTheory open BasicProvers open quotientLib open boolSimps @@ -567,7 +567,7 @@ val [GFV_thm0, gfvl_thm, GFV_raw_gtpm, simple_induction0, val simple_induction = save_thm( "simple_induction", - REWRITE_RULE [listTheory.EVERY_MEM] simple_induction0) + REWRITE_RULE [EVERY_MEM] simple_induction0) val _ = overload_on("gt_pmact",``mk_pmact raw_gtpm``); val _ = overload_on("gtpm",``pmact gt_pmact``); @@ -587,9 +587,6 @@ val MAP_EQ1 = prove( ``(MAP f l = l) ⇔ ∀x. MEM x l ⇒ (f x = x)``, Induct_on `l` >> srw_tac [][DISJ_IMP_THM, FORALL_AND_THM]); -val MEM_MAP = listTheory.MEM_MAP -val EL_MAP = listTheory.EL_MAP -val MEM_EL = listTheory.MEM_EL val IN_gfvl = prove( ``x ∈ gfvl ts ⇔ ∃t. MEM t ts ∧ x ∈ GFV t``, Induct_on `ts` >> srw_tac [][gfvl_thm] >> metis_tac []); @@ -597,7 +594,7 @@ val IN_gfvl = prove( val GFV_apart = prove( ``∀t x y. x ∈ GFV t ∧ y ∉ GFV t ⇒ gtpm [(x,y)] t ≠ t``, ho_match_mp_tac simple_induction >> - srw_tac [][GFV_thm0, gtpm_thm, gterm_11, listTheory.MEM_MAP, + srw_tac [][GFV_thm0, gtpm_thm, gterm_11, MEM_MAP, MAP_EQ1, GLAM_eq_thm0, IN_gfvl] >> srw_tac [][] >> metis_tac[swapstr_def]); @@ -668,10 +665,6 @@ val list_rel_split = prove( qid_spec_tac `l2` >> Induct_on `l1` >> Cases_on `l2` >> srw_tac [][] >> metis_tac []); -val LIST_REL_ind = listTheory.LIST_REL_ind -val LIST_REL_rules = listTheory.LIST_REL_rules -val LIST_REL_EL_EQN = listTheory.LIST_REL_EL_EQN - (* generic sub-type of a generic term, where one is only allowed to look at the data attached to the GLAM and the number of arguments in the lists *) val (genind_rules, genind_ind, genind_cases) = Hol_reln` @@ -1098,7 +1091,7 @@ qabbrev_tac `GGSIZE = gtmsize (GLAM s' bv ts' us)` >> (listpm (fn_pmact ppm dpm) [(a,b)] r2 = MAP (tmrec A ppm vf lf) (gtpml [(a,b)] us)))` by (asm_simp_tac (srw_ss() ++ DNF_ss) - [listpm_tMAP, listTheory.MAP_EQ_f, MEM_listpm_EXISTS, + [listpm_tMAP, MAP_EQ_f, MEM_listpm_EXISTS, Abbr`r1`, Abbr`r2`, fnpm_def, FUN_EQ_THM, pmact_sing_inv]) >> map_every qx_gen_tac [`s''`, `bv'`, `ts''`, `us'`] >> @@ -1149,7 +1142,7 @@ qabbrev_tac `xyus = gtpml [(x,y)] us` >> qmatch_abbrev_tac `LIST_REL RR TS (MAP f1 TS) ==> LIST_REL RR TS (MAP f2 TS)` >> qsuff_tac `MAP f1 TS = MAP f2 TS` >- srw_tac [][] >> - srw_tac [][listTheory.MAP_EQ_f] >> + srw_tac [][MAP_EQ_f] >> map_every qunabbrev_tac [`f1`, `f2`, `TS`] >> asm_simp_tac (srw_ss()) [FUN_EQ_THM, fnpm_def] >> gen_tac >> ih_commute_tac lhs >> asm_simp_tac (srw_ss()) [pmact_sing_inv] >> @@ -1181,7 +1174,7 @@ reverse conj_tac >- ( qsuff_tac `(X1 = X2) ∧ (Y1 = Y2)` >- srw_tac [][] >> map_every qunabbrev_tac [`X1`, `X2`, `Y1`, `Y2`] >> asm_simp_tac (srw_ss() ++ DNF_ss) - [listTheory.MAP_EQ_f, MEM_listpm_EXISTS, FUN_EQ_THM, fnpm_def] >> + [MAP_EQ_f, MEM_listpm_EXISTS, FUN_EQ_THM, fnpm_def] >> srw_tac [][] >> (* two similar goals here-on *) ih_commute_tac lhs >> asm_simp_tac (srw_ss()) [gtmsize_gtpm, pmact_sing_inv] >> @@ -1201,7 +1194,7 @@ qmatch_abbrev_tac `lf u bv X1 Y1 = lf u bv X2 Y2` >> qsuff_tac `(X1 = X2) ∧ (Y1 = Y2)` >- srw_tac [][] >> map_every qunabbrev_tac [`X1`,`X2`,`Y1`, `Y2`] >> conj_tac >> (* splits in two *) -srw_tac [][listTheory.MAP_EQ_f, FUN_EQ_THM, fnpm_def] >> +srw_tac [][MAP_EQ_f, FUN_EQ_THM, fnpm_def] >> ih_commute_tac rhs >> asm_simp_tac (srw_ss()) [pmact_sing_inv, gtmsize_gtpm] >> disch_then (match_mp_tac o GSYM) >> @@ -1321,7 +1314,7 @@ qx_gen_tac `u` >> strip_tac >> LIST_REL (relsupp A dpm ppm) us (MAP (tmrec A ppm vf lf) us)` by ( assume_tac fresh_I >> fsrw_tac [DNF_ss][MEM_EL] >> - srw_tac [][LIST_REL_EL_EQN,listTheory.EL_MAP, relsupp_def] >> + srw_tac [][LIST_REL_EL_EQN, EL_MAP, relsupp_def] >> fsrw_tac [][AND_IMP_INTRO] >> first_x_assum match_mp_tac >> fsrw_tac [][] >> @@ -1333,7 +1326,7 @@ qsuff_tac `MAP (tmrec A ppm vf lf) (gtpml [(u,v)] ts) = listpm (fn_pmact ppm dpm) [(u,v)] (MAP (tmrec A ppm vf lf) ts)` >- (disch_then SUBST1_TAC >> fsrw_tac [][NEWFCB_def] >> first_x_assum match_mp_tac >> fsrw_tac [][perm_supp] >> metis_tac []) >> -srw_tac [][listpm_tMAP, listTheory.MAP_EQ_f, MEM_listpm_EXISTS, FUN_EQ_THM, +srw_tac [][listpm_tMAP, MAP_EQ_f, MEM_listpm_EXISTS, FUN_EQ_THM, fnpm_def] >> srw_tac [][pmact_sing_inv] >> assume_tac (eqv_I |> Q.GEN `t` diff --git a/examples/lambda/basics/nomsetScript.sml b/examples/lambda/basics/nomsetScript.sml index 303ce92367..daa95a0e08 100644 --- a/examples/lambda/basics/nomsetScript.sml +++ b/examples/lambda/basics/nomsetScript.sml @@ -2,7 +2,7 @@ open HolKernel Parse boolLib bossLib BasicProvers boolSimps local open stringTheory in end; -open pred_setTheory +open pred_setTheory listTheory finite_mapTheory; open basic_swapTheory NEWLib @@ -75,14 +75,14 @@ val permof_inverse_lemma = prove( val permof_inverse = store_thm( "permof_inverse", ``(p ++ REVERSE p == []) /\ (REVERSE p ++ p == [])``, - METIS_TAC [permof_inverse_lemma, listTheory.REVERSE_REVERSE]); + METIS_TAC [permof_inverse_lemma, REVERSE_REVERSE]); val permof_inverse_append = store_thm ( "permof_inverse_append", ``(p ++ q) ++ REVERSE q == p ∧ (p ++ REVERSE q) ++ q == p``, - SIMP_TAC bool_ss [GSYM listTheory.APPEND_ASSOC] THEN + SIMP_TAC bool_ss [GSYM APPEND_ASSOC] THEN CONJ_TAC THEN - SIMP_TAC bool_ss [Once (GSYM listTheory.APPEND_NIL), SimpR ``(==)``] THEN + SIMP_TAC bool_ss [Once (GSYM APPEND_NIL), SimpR ``(==)``] THEN MATCH_MP_TAC app_permeq_monotone THEN SRW_TAC [][permof_inverse]); val permof_inverse_applied = raw_lswapstr_inverse @@ -112,9 +112,9 @@ val permof_REVERSE_monotone = store_thm( `REVERSE x ++ y == []` by METIS_TAC [permof_inverse, permeq_trans, permeq_sym] THEN `REVERSE x ++ (y ++ REVERSE y) == REVERSE y` - by METIS_TAC [listTheory.APPEND, listTheory.APPEND_ASSOC, + by METIS_TAC [APPEND, APPEND_ASSOC, app_permeq_monotone, permeq_refl] THEN - METIS_TAC [permof_inverse, listTheory.APPEND_NIL, + METIS_TAC [permof_inverse, APPEND_NIL, app_permeq_monotone, permeq_refl, permeq_trans, permeq_sym]); val permeq_cons_monotone = store_thm( @@ -138,11 +138,11 @@ val app_permeq_left_cancel = store_thm( REPEAT STRIP_TAC THEN `REVERSE p1 == REVERSE p1'` by METIS_TAC [permof_REVERSE_monotone] THEN `(REVERSE p1) ++ p1 ++ p2 == (REVERSE p1') ++ p1' ++ p2'` - by (METIS_TAC [app_permeq_monotone, listTheory.APPEND_ASSOC]) THEN + by (METIS_TAC [app_permeq_monotone, APPEND_ASSOC]) THEN `[] ++ p2 == (REVERSE p1) ++ p1 ++ p2 /\ [] ++ p2' == (REVERSE p1') ++ p1' ++ p2'` by (METIS_TAC [app_permeq_monotone, permeq_refl, permeq_sym, permof_inverse]) THEN - METIS_TAC [listTheory.APPEND, permeq_refl, permeq_sym, permeq_trans]); + METIS_TAC [APPEND, permeq_refl, permeq_sym, permeq_trans]); val app_permeq_right_cancel = store_thm( "app_permeq_right_cancel", @@ -150,11 +150,11 @@ val app_permeq_right_cancel = store_thm( REPEAT STRIP_TAC THEN `REVERSE p1 == REVERSE p1'` by METIS_TAC [permof_REVERSE_monotone] THEN `p2 ++ (p1 ++ (REVERSE p1)) == p2' ++ (p1' ++ (REVERSE p1'))` - by (METIS_TAC [app_permeq_monotone, listTheory.APPEND_ASSOC]) THEN + by (METIS_TAC [app_permeq_monotone, APPEND_ASSOC]) THEN `p2 ++ [] == p2 ++ (p1 ++ (REVERSE p1)) /\ p2' ++ [] == p2' ++ (p1' ++ (REVERSE p1'))` by (METIS_TAC [app_permeq_monotone, permeq_refl, permeq_sym, permof_inverse]) THEN - METIS_TAC [listTheory.APPEND_NIL, permeq_refl, permeq_trans, permeq_sym]); + METIS_TAC [APPEND_NIL, permeq_refl, permeq_trans, permeq_sym]); (* ---------------------------------------------------------------------- Define what it is to be a permutation action on a type @@ -235,7 +235,7 @@ val pmact_inverse = Store_thm( val pmact_sing_inv = Store_thm( "pmact_sing_inv", ``pmact pm [h] (pmact pm [h] x) = x``, - METIS_TAC [listTheory.REVERSE_DEF, listTheory.APPEND, pmact_inverse]); + METIS_TAC [REVERSE_DEF, APPEND, pmact_inverse]); val pmact_eql = store_thm( "pmact_eql", @@ -346,7 +346,7 @@ val fnpm_raw = store_thm( "fnpm_raw", ``fnpm dpm rpm = raw_fnpm dpm rpm``, srw_tac [][GSYM pmact_bijections] >> -SRW_TAC [][is_pmact_def, FUN_EQ_THM, listTheory.REVERSE_APPEND, pmact_decompose] THEN +SRW_TAC [][is_pmact_def, FUN_EQ_THM, REVERSE_APPEND, pmact_decompose] THEN METIS_TAC [permof_REVERSE_monotone,pmact_permeq]); val fnpm_def = save_thm( @@ -585,7 +585,7 @@ val pmact_support = store_thm( `pmact pm ([(stringpm π a, stringpm π b)] ++ π) x = pmact pm π x` by METIS_TAC [pmact_decompose] THEN `[(stringpm π a, stringpm π b)] ++ π == π ++ [(a,b)]` - by METIS_TAC [permeq_swap_ends, permeq_sym, listTheory.APPEND] THEN + by METIS_TAC [permeq_swap_ends, permeq_sym, APPEND] THEN `pmact pm (π ++ [(a,b)]) x = pmact pm π x` by METIS_TAC [pmact_permeq] THEN METIS_TAC [pmact_injective, pmact_decompose], @@ -623,7 +623,7 @@ val support_dwards_directed = store_thm( `pmact pm [(x,y)] e = pmact pm [(x,z); (y,z); (x,z)] e` by METIS_TAC [pmact_permeq] THEN ` _ = pmact pm [(x,z)] (pmact pm [(y,z)] (pmact pm [(x,z)] e))` - by METIS_TAC [pmact_decompose, listTheory.APPEND] THEN + by METIS_TAC [pmact_decompose, APPEND] THEN METIS_TAC [IN_INTER]); val supp_def = Define` @@ -670,7 +670,7 @@ val perm_supp = store_thm( `!e x y. pmact pm (REVERSE p) (pmact pm [(x,y)] e) = pmact pm [(stringpm (REVERSE p) x, stringpm (REVERSE p) y)] (pmact pm (REVERSE p) e)` - by METIS_TAC [stringpm_raw, pmact_decompose, pmact_permeq, permeq_swap_ends, listTheory.APPEND] THEN + by METIS_TAC [stringpm_raw, pmact_decompose, pmact_permeq, permeq_swap_ends, APPEND] THEN SRW_TAC [][pmact_inverse] THEN Q.MATCH_ABBREV_TAC `FINITE s1 = FINITE s2` THEN `s1 = { b | (\s. ~(x = pmact pm [(stringpm (REVERSE p) a, s)] x)) @@ -872,7 +872,7 @@ val pm_cpmpm_cancel = prove( POP_ASSUM (fn th => CONV_TAC (LAND_CONV (ONCE_REWRITE_CONV [th]))) THEN ONCE_REWRITE_TAC [GSYM pmact_sing_to_back] THEN fsrw_tac [][GSYM pmact_decompose] >> - metis_tac [pmact_decompose,listTheory.APPEND]); + metis_tac [pmact_decompose, APPEND]); val pmact_supp_empty = store_thm( "pmact_supp_empty", @@ -957,10 +957,9 @@ val supp_perm_of = store_thm( by (POP_ASSUM (ASSUME_TAC o SIMP_RULE (srw_ss()) [fnpm_def]) THEN SRW_TAC [][permeq_thm, pmact_decompose, GSYM swapstr_eq_left]) THEN `(x,y) :: p == (lswapstr p x, lswapstr p y) :: p` - by METIS_TAC [permeq_swap_ends, permeq_trans, permeq_sym, - listTheory.APPEND] THEN + by METIS_TAC [permeq_swap_ends, permeq_trans, permeq_sym, APPEND] THEN `(x,y) :: (p ++ p⁻¹) == (lswapstr p x, lswapstr p y) :: (p ++ p⁻¹)` - by METIS_TAC [app_permeq_monotone, listTheory.APPEND, permeq_refl] THEN + by METIS_TAC [app_permeq_monotone, APPEND, permeq_refl] THEN `!h. [h] == h :: (p ++ p⁻¹)` by METIS_TAC [permeq_cons_monotone, permof_inverse, permeq_sym] THEN `[(x,y)] == [(lswapstr p x, lswapstr p y)]` @@ -998,7 +997,6 @@ val notinsupp_fnapp = store_thm( v ∉ supp rpm (f x)``, prove_tac [supp_fnapp, SUBSET_DEF, IN_UNION]); -open finite_mapTheory val raw_fmpm_def = Define` raw_fmpm (dpm : 'd pmact) (rpm : 'r pmact) pi fmap = pmact rpm pi o_f fmap f_o pmact dpm (REVERSE pi) @@ -1030,7 +1028,7 @@ val fmpm_def = store_thm( (!r pi1 pi2. pmact rpm (pi1 ++ pi2) r = pmact rpm pi1 (pmact rpm pi2 r))` by METIS_TAC [pmact_decompose] THEN SRW_TAC [][fmap_EXT, FDOM_f_o, lemma, o_f_FAPPLY, - listTheory.REVERSE_APPEND, FAPPLY_f_o], + REVERSE_APPEND, FAPPLY_f_o], `REVERSE p1 == REVERSE p2` by METIS_TAC [permof_REVERSE_monotone] THEN `(pmact rpm p1 = pmact rpm p2) ∧ (pmact dpm (REVERSE p1) = pmact dpm (REVERSE p2))` diff --git a/examples/lambda/basics/termScript.sml b/examples/lambda/basics/termScript.sml index 90503dd5a8..cc54cf1e7e 100644 --- a/examples/lambda/basics/termScript.sml +++ b/examples/lambda/basics/termScript.sml @@ -1,6 +1,6 @@ open HolKernel Parse boolLib bossLib; -open boolSimps arithmeticTheory pred_setTheory finite_mapTheory hurdUtils; +open boolSimps arithmeticTheory pred_setTheory listTheory finite_mapTheory hurdUtils; open generic_termsTheory binderLib nomsetTheory nomdatatype; @@ -10,26 +10,27 @@ val _ = set_fixity "=" (Infix(NONASSOC, 450)) val tyname = "term" -val vp = ``(λn u:unit. n = 0)`` -val lp = ``(λn (d:unit + unit) tns uns. +val vp = “(λn u:unit. n = 0)” +val lp = “(λn (d:unit + unit) tns uns. (n = 0) ∧ ISL d ∧ (tns = []) ∧ (uns = [0;0]) ∨ - (n = 0) ∧ ISR d ∧ (tns = [0]) ∧ (uns = []))`` + (n = 0) ∧ ISR d ∧ (tns = [0]) ∧ (uns = []))” val {term_ABS_pseudo11, term_REP_11, genind_term_REP, genind_exists, termP, absrep_id, repabs_pseudo_id, term_REP_t, term_ABS_t, newty, ...} = - new_type_step1 tyname 0 {vp=vp, lp = lp} + new_type_step1 tyname 0 {vp = vp, lp = lp}; + val [gvar,glam] = genind_rules |> SPEC_ALL |> CONJUNCTS val LAM_t = mk_var("LAM", ``:string -> ^newty -> ^newty``) val LAM_def = new_definition( "LAM_def", - ``^LAM_t v t = ^term_ABS_t (GLAM v (INR ()) [^term_REP_t t] [])``) + ``^LAM_t v t = ^term_ABS_t (GLAM v (INR ()) [^term_REP_t t] [])``); + val LAM_termP = prove( mk_comb(termP, LAM_def |> SPEC_ALL |> concl |> rhs |> rand), match_mp_tac glam >> srw_tac [][genind_term_REP]); val LAM_t = defined_const LAM_def - val APP_t = mk_var("APP", ``:^newty -> ^newty -> ^newty``) val APP_def = new_definition( "APP_def", @@ -58,6 +59,7 @@ val cons_info = {con_termP = APP_termP, con_def = SYM APP_def'}, {con_termP = LAM_termP, con_def = LAM_def}] +(* tpm *) val tpm_name_pfx = "t" val {tpm_thm, term_REP_tpm, t_pmact_t, tpm_t} = define_permutation {name_pfx = "t", name = tyname, @@ -65,7 +67,7 @@ val {tpm_thm, term_REP_tpm, t_pmact_t, tpm_t} = term_ABS_t = term_ABS_t, absrep_id = absrep_id, repabs_pseudo_id = repabs_pseudo_id, cons_info = cons_info, newty = newty, - genind_term_REP = genind_term_REP} + genind_term_REP = genind_term_REP}; (* support *) val term_REP_eqv = prove( @@ -155,17 +157,19 @@ fun mkX_ind th = th |> Q.SPEC `λt x. Q t` |> Q.SPEC `λx. X` |> SIMP_RULE std_ss [] |> Q.GEN `X` |> Q.INST [`Q` |-> `P`] |> Q.GEN `P` +Theorem nc_INDUCTION[local] = mkX_ind term_ind + (* exactly mimic historical bound variable names etc for backwards compatibility *) -val nc_INDUCTION2 = store_thm( - "nc_INDUCTION2", - ``∀P X. +Theorem nc_INDUCTION2 : + ∀P X. (∀s. P (VAR s)) ∧ (∀t u. P t ∧ P u ==> P (APP t u)) ∧ (∀y u. y ∉ X ∧ P u ==> P (LAM y u)) ∧ FINITE X ==> - ∀u. P u``, - metis_tac [mkX_ind term_ind]); - + ∀u. P u +Proof + metis_tac [nc_INDUCTION] +QED val LAM_eq_thm = save_thm( "LAM_eq_thm", @@ -175,29 +179,16 @@ val LAM_eq_thm = save_thm( GSYM supp_tpm] |> GENL [``u:string``, ``v:string``, ``t1:term``, ``t2:term``]); - - - val (_, repty) = dom_rng (type_of term_REP_t) val repty' = ty_antiq repty val tlf = - ``λ(v:string) (u:unit + unit) (ds1:(ρ -> α) list) (ds2:(ρ -> α) list) - (ts1:^repty' list) (ts2:^repty' list) (p:ρ). - if ISR u then tlf (HD ds1) v (term_ABS (HD ts1)) p: α - else taf (HD ds2) (HD (TL ds2)) (term_ABS (HD ts2)) - (term_ABS (HD (TL ts2))) p: α`` -val tvf = ``λ(s:string) (u:unit) (p:ρ). tvf s p : α`` - -val LENGTH_NIL' = - CONV_RULE (BINDER_CONV (LAND_CONV (REWR_CONV EQ_SYM_EQ))) - listTheory.LENGTH_NIL -val LENGTH1 = prove( - ``(1 = LENGTH l) ⇔ ∃e. l = [e]``, - Cases_on `l` >> srw_tac [][listTheory.LENGTH_NIL]); -val LENGTH2 = prove( - ``(2 = LENGTH l) ⇔ ∃a b. l = [a;b]``, - Cases_on `l` >> srw_tac [][LENGTH1]); + “λ(v:string) (u:unit + unit) (ds1:(ρ -> α) list) (ds2:(ρ -> α) list) + (ts1:^repty' list) (ts2:^repty' list) (p :ρ). + if ISR u then tlf (HD ds1) v (^term_ABS_t (HD ts1)) p :α + else taf (HD ds2) (HD (TL ds2)) (^term_ABS_t (HD ts2)) + (^term_ABS_t (HD (TL ts2))) p :α” +val tvf = “λ(s:string) (u:unit) (p:ρ). tvf s p :α”; val termP_elim = prove( ``(∀g. ^termP g ⇒ P g) ⇔ (∀t. P (^term_REP_t t))``, @@ -219,8 +210,6 @@ val termP0 = prove( Q.ISPEC_THEN `t` STRUCT_CASES_TAC gterm_cases >> srw_tac [][genind_GVAR, genind_GLAM_eqn]); - - val parameter_tm_recursion = save_thm( "parameter_tm_recursion", parameter_gtm_recursion @@ -236,10 +225,9 @@ val parameter_tm_recursion = save_thm( LIST_REL_CONS1, genind_GVAR, genind_GLAM_eqn, sidecond_def, NEWFCB_def, relsupp_def, - LENGTH_NIL', LENGTH1, LENGTH2] + LENGTH_NIL_SYM, LENGTH1, LENGTH2] |> ONCE_REWRITE_RULE [termP0] - |> SIMP_RULE (srw_ss() ++ DNF_ss) [LENGTH1, LENGTH2, - listTheory.LENGTH_NIL] + |> SIMP_RULE (srw_ss() ++ DNF_ss) [LENGTH1, LENGTH2, LENGTH_NIL] |> CONV_RULE (DEPTH_CONV termP_removal) |> SIMP_RULE (srw_ss()) [GSYM supp_tpm, SYM term_REP_tpm] |> UNDISCH @@ -258,25 +246,6 @@ val parameter_tm_recursion = save_thm( `dpm` |-> `apm`] |> CONV_RULE (REDEPTH_CONV sort_uvars)) -val FORALL_ONE = prove( - ``(!u:one. P u) = P ()``, - SRW_TAC [][EQ_IMP_THM, oneTheory.one_induction]); -val FORALL_ONE_FN = prove( - ``(!uf : one -> 'a. P uf) = !a. P (\u. a)``, - SRW_TAC [][EQ_IMP_THM] THEN - POP_ASSUM (Q.SPEC_THEN `uf ()` MP_TAC) THEN - Q_TAC SUFF_TAC `(\y. uf()) = uf` THEN1 SRW_TAC [][] THEN - SRW_TAC [][FUN_EQ_THM, oneTheory.one]); - -val EXISTS_ONE_FN = prove( - ``(?f : 'a -> one -> 'b. P f) = (?f : 'a -> 'b. P (\x u. f x))``, - SRW_TAC [][EQ_IMP_THM] THENL [ - Q.EXISTS_TAC `\a. f a ()` THEN SRW_TAC [][] THEN - Q_TAC SUFF_TAC `(\x u. f x ()) = f` THEN1 SRW_TAC [][] THEN - SRW_TAC [][FUN_EQ_THM, oneTheory.one], - Q.EXISTS_TAC `\a u. f a` THEN SRW_TAC [][] - ]); - val tm_recursion = save_thm( "tm_recursion", parameter_tm_recursion @@ -284,8 +253,8 @@ val tm_recursion = save_thm( |> Q.INST [`ppm` |-> `discrete_pmact`, `vr` |-> `λs u. vru s`, `ap` |-> `λr1 r2 t1 t2 u. apu (r1()) (r2()) t1 t2`, `lm` |-> `λr v t u. lmu (r()) v t`] - |> SIMP_RULE (srw_ss()) [FORALL_ONE, FORALL_ONE_FN, EXISTS_ONE_FN, - fnpm_def] + |> SIMP_RULE (srw_ss()) [oneTheory.FORALL_ONE, oneTheory.FORALL_ONE_FN, + oneTheory.EXISTS_ONE_FN, fnpm_def] |> SIMP_RULE (srw_ss() ++ CONJ_ss) [supp_unitfn] |> Q.INST [`apu` |-> `ap`, `lmu` |-> `lm`, `vru` |-> `vr`]) @@ -371,8 +340,6 @@ Proof simp[tpm_eqr] QED - - val tpm_CONS = store_thm( "tpm_CONS", ``tpm ((x,y)::pi) t = tpm [(x,y)] (tpm pi t)``, @@ -503,18 +470,16 @@ val SUB_VAR = save_thm("SUB_VAR", hd (CONJUNCTS SUB_DEF)) Theorem fresh_tpm_subst: !t. ~(u IN FV t) ==> (tpm [(u,v)] t = [VAR u/v] t) Proof - HO_MATCH_MP_TAC nc_INDUCTION2 THEN Q.EXISTS_TAC `{u;v}` THEN + HO_MATCH_MP_TAC nc_INDUCTION THEN Q.EXISTS_TAC `{u;v}` THEN SRW_TAC [][SUB_THM, SUB_VAR] QED Theorem tpm_subst: !N. tpm pi ([M/v] N) = [tpm pi M/lswapstr pi v] (tpm pi N) Proof - HO_MATCH_MP_TAC nc_INDUCTION2 THEN + HO_MATCH_MP_TAC nc_INDUCTION THEN Q.EXISTS_TAC `v INSERT FV M` THEN - SRW_TAC [][SUB_THM, SUB_VAR] THEN - MATCH_MP_TAC (SUB_THM |> CONJUNCTS |> C (curry List.nth) 3 |> GSYM) THEN - SRW_TAC [][stringpm_raw] + SRW_TAC [][SUB_THM, SUB_VAR] QED Theorem tpm_subst_out: @@ -525,21 +490,76 @@ QED Theorem lemma14a[simp]: !t. [VAR v/v] t = t Proof - HO_MATCH_MP_TAC nc_INDUCTION2 THEN Q.EXISTS_TAC `{v}` THEN + HO_MATCH_MP_TAC nc_INDUCTION THEN Q.EXISTS_TAC `{v}` THEN SRW_TAC [][SUB_THM, SUB_VAR] QED Theorem lemma14b: !M. ~(v IN FV M) ==> ([N/v] M = M) Proof - HO_MATCH_MP_TAC nc_INDUCTION2 THEN Q.EXISTS_TAC `v INSERT FV N` THEN + HO_MATCH_MP_TAC nc_INDUCTION THEN Q.EXISTS_TAC `v INSERT FV N` THEN SRW_TAC [][SUB_THM, SUB_VAR] QED +(* Note: this is the opposite direction of lemma14b *) +Theorem SUB_FIX_IMP_NOTIN_FV : + !x t. (!u. [u/x] t = t) ==> x NOTIN FV t +Proof + rpt GEN_TAC + >> Suff ‘(?u. u # t /\ [VAR u/x] t = t) ==> x # t’ + >- (rw [] \\ + FIRST_X_ASSUM MATCH_MP_TAC \\ + Q_TAC (NEW_TAC "z") ‘FV t’ \\ + Q.EXISTS_TAC ‘z’ >> rw []) + >> simp [PULL_EXISTS] + >> Q.X_GEN_TAC ‘u’ + >> Q.ID_SPEC_TAC ‘t’ + >> HO_MATCH_MP_TAC nc_INDUCTION + >> Q.EXISTS_TAC ‘{x;u}’ >> rw [] + >> CCONTR_TAC >> fs [] +QED + +Theorem lemma14b_ext1 : + !v M. v # M <=> !N. ([N/v] M = M) +Proof + rpt GEN_TAC + >> EQ_TAC >- rw [lemma14b] + >> DISCH_TAC + >> rw [SUB_FIX_IMP_NOTIN_FV] +QED + +Theorem SUB_EQ_IMP_NOTIN_FV : + !x t. (!t1 t2. [t1/x] t = [t2/x] t) ==> x NOTIN FV t +Proof + rpt GEN_TAC + >> Suff ‘(?u u'. u <> u' /\ u # t /\ u' # t /\ + [VAR u/x] t = [VAR u'/x] t) ==> x # t’ + >- (rw [] \\ + FIRST_X_ASSUM MATCH_MP_TAC \\ + Q_TAC (NEW_TAC "z") ‘FV t’ \\ + Q.EXISTS_TAC ‘z’ >> rw [] \\ + Q_TAC (NEW_TAC "z'") ‘{z} UNION FV t’ \\ + Q.EXISTS_TAC ‘z'’ >> rw []) + >> simp [PULL_EXISTS] + >> rpt GEN_TAC + >> Q.ID_SPEC_TAC ‘t’ + >> HO_MATCH_MP_TAC nc_INDUCTION + >> Q.EXISTS_TAC ‘{x;u;u'}’ >> rw [] + >> CCONTR_TAC >> fs [] +QED + +Theorem lemma14b_ext2 : + !v M. v # M <=> !N1 N2. [N1/v] M = [N2/v] M +Proof + rpt GEN_TAC + >> EQ_TAC >- rw [lemma14b] + >> rw [SUB_EQ_IMP_NOTIN_FV] +QED + Theorem lemma14c: !t x u. x IN FV u ==> (FV ([t/x]u) = FV t UNION (FV u DELETE x)) Proof - NTAC 2 GEN_TAC THEN HO_MATCH_MP_TAC nc_INDUCTION2 THEN + NTAC 2 GEN_TAC THEN HO_MATCH_MP_TAC nc_INDUCTION THEN Q.EXISTS_TAC `x INSERT FV t` THEN SRW_TAC [][SUB_THM, SUB_VAR, EXTENSION] THEN METIS_TAC [lemma14b] @@ -553,7 +573,7 @@ QED Theorem lemma15a: !M. v ∉ FV M ==> [N/v]([VAR v/x]M) = [N/x]M Proof - HO_MATCH_MP_TAC nc_INDUCTION2 THEN Q.EXISTS_TAC `{x;v} UNION FV N` THEN + HO_MATCH_MP_TAC nc_INDUCTION THEN Q.EXISTS_TAC `{x;v} UNION FV N` THEN SRW_TAC [][SUB_THM, SUB_VAR] QED @@ -565,7 +585,7 @@ QED Theorem SUB_TWICE_ONE_VAR : !body. [x/v] ([y/v] body) = [[x/v]y / v] body Proof - HO_MATCH_MP_TAC nc_INDUCTION2 THEN SRW_TAC [][SUB_THM, SUB_VAR] THEN + HO_MATCH_MP_TAC nc_INDUCTION THEN SRW_TAC [][SUB_THM, SUB_VAR] THEN Q.EXISTS_TAC `v INSERT FV x UNION FV y` THEN SRW_TAC [][SUB_THM] THEN Cases_on `v IN FV y` THEN SRW_TAC [][SUB_THM, lemma14c, lemma14b] @@ -595,7 +615,6 @@ Proof SRW_TAC [boolSimps.CONJ_ss][LAM_eq_thm, pmact_flip_args] QED - (* ---------------------------------------------------------------------- size function ---------------------------------------------------------------------- *) @@ -636,7 +655,7 @@ QED Theorem size_vsubst[simp]: !M:term. size ([VAR v/u] M) = size M Proof - HO_MATCH_MP_TAC nc_INDUCTION2 THEN Q.EXISTS_TAC `{u;v}` THEN + HO_MATCH_MP_TAC nc_INDUCTION THEN Q.EXISTS_TAC `{u;v}` THEN SRW_TAC [][SUB_VAR, SUB_THM] QED @@ -913,7 +932,7 @@ val tpm_ssub = save_thm("tpm_ssub", CONJUNCT2 ssub_def) val single_ssub = store_thm( "single_ssub", ``∀N. (FEMPTY |+ (s,M)) ' N = [M/s]N``, - HO_MATCH_MP_TAC nc_INDUCTION2 THEN Q.EXISTS_TAC `s INSERT FV M` THEN + HO_MATCH_MP_TAC nc_INDUCTION THEN Q.EXISTS_TAC `s INSERT FV M` THEN SRW_TAC [][SUB_VAR, SUB_THM]); Theorem in_fmap_supp: @@ -932,7 +951,7 @@ QED Theorem ssub_14b: ∀t. (FV t ∩ FDOM phi = EMPTY) ==> ((phi : string |-> term) ' t = t) Proof - HO_MATCH_MP_TAC nc_INDUCTION2 THEN + HO_MATCH_MP_TAC nc_INDUCTION THEN Q.EXISTS_TAC `fmFV phi` THEN SRW_TAC [][SUB_THM, SUB_VAR, pred_setTheory.EXTENSION] THEN METIS_TAC [] QED @@ -954,7 +973,7 @@ Theorem FV_ssub : Proof rpt STRIP_TAC >> Q.ID_SPEC_TAC ‘N’ - >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> HO_MATCH_MP_TAC nc_INDUCTION >> Q.EXISTS_TAC ‘FDOM fm’ >> rw [SUB_VAR, SUB_THM, ssub_thm] >> SET_TAC [] @@ -963,7 +982,7 @@ QED Theorem fresh_ssub: ∀N. y ∉ FV N ∧ (∀k:string. k ∈ FDOM fm ⇒ y # fm ' k) ⇒ y # fm ' N Proof - ho_match_mp_tac nc_INDUCTION2 >> + ho_match_mp_tac nc_INDUCTION >> qexists ‘fmFV fm’ >> rw[] >> metis_tac[] QED @@ -973,10 +992,11 @@ Theorem ssub_SUBST: (∀k. k ∈ FDOM fm ⇒ v # fm ' k) ∧ v ∉ FDOM fm ⇒ fm ' ([N/v]M) = [fm ' N / v] (fm ' M) Proof - ho_match_mp_tac nc_INDUCTION2 >> + ho_match_mp_tac nc_INDUCTION >> qexists ‘fmFV fm ∪ {v} ∪ FV N’ >> rw[] >> rw[lemma14b, SUB_VAR] >> gvs[DECIDE “~p ∨ q ⇔ p ⇒ q”, PULL_FORALL] >> + rename1 ‘y # N’ >> ‘y # fm ' N’ suffices_by simp[SUB_THM] >> irule fresh_ssub >> simp[] QED @@ -993,12 +1013,13 @@ Theorem ssub_update_apply : Proof RW_TAC std_ss [closed_def] >> Q.ID_SPEC_TAC ‘M’ - >> HO_MATCH_MP_TAC nc_INDUCTION2 + >> HO_MATCH_MP_TAC nc_INDUCTION >> Q.EXISTS_TAC ‘v INSERT (FDOM fm UNION FV N)’ >> rw [SUB_VAR, SUB_THM, ssub_thm, FAPPLY_FUPDATE_THM] >> TRY (METIS_TAC []) >- (MATCH_MP_TAC (GSYM lemma14b) \\ METIS_TAC [NOT_IN_EMPTY]) + >> rename1 ‘y # N’ >> Suff ‘(fm |+ (v,N)) ' (LAM y M) = LAM y ((fm |+ (v,N)) ' M)’ >- rw [] >> MATCH_MP_TAC ssub_LAM >> rw [FAPPLY_FUPDATE_THM] @@ -1013,12 +1034,13 @@ Theorem ssub_update_apply_SUBST : DISJOINT (FDOM fm) (FV N) ==> (fm |+ (v,N)) ' M = fm ' ([N/v] M) Proof - HO_MATCH_MP_TAC nc_INDUCTION2 + HO_MATCH_MP_TAC nc_INDUCTION >> Q.EXISTS_TAC ‘v INSERT fmFV fm UNION FV M UNION FV N’ >> rw [SUB_VAR, SUB_THM, ssub_thm, FAPPLY_FUPDATE_THM] >> TRY (METIS_TAC []) >- (MATCH_MP_TAC (GSYM ssub_14b) \\ rw [GSYM DISJOINT_DEF, Once DISJOINT_SYM]) + >> rename1 ‘y # N’ >> Know ‘(fm |+ (v,N)) ' (LAM y M') = LAM y ((fm |+ (v,N)) ' M')’ >- (MATCH_MP_TAC ssub_LAM >> rw [FAPPLY_FUPDATE_THM]) >> Rewr' @@ -1026,6 +1048,30 @@ Proof >> rw [] QED +(* A combined version of ssub_update_apply_SUBST and ssub_SUBST *) +Theorem ssub_update_apply_SUBST' : + !M. (!k. k IN FDOM fm ==> v # fm ' k) /\ v NOTIN FDOM fm /\ + DISJOINT (FDOM fm) (FV N) ==> + (fm |+ (v,N)) ' M = [fm ' N/v] (fm ' M) +Proof + rpt STRIP_TAC + >> Know ‘[fm ' N/v] (fm ' M) = fm ' ([N/v] M)’ + >- (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\ + MATCH_MP_TAC ssub_SUBST >> art []) + >> Rewr' + >> MATCH_MP_TAC ssub_update_apply_SUBST >> art [] +QED + +Theorem FEMPTY_update_apply : + !M. (FEMPTY |+ (v,N)) ' M = [N/v] M +Proof + Q.X_GEN_TAC ‘M’ + >> ‘[N/v] M = FEMPTY ' ([N/v] M)’ by rw [] + >> POP_ORW + >> MATCH_MP_TAC ssub_update_apply_SUBST + >> rw [] +QED + Theorem ssub_update_apply_subst : !fm v N M. v NOTIN FDOM fm /\ (!k. k IN FDOM fm ==> closed (fm ' k)) /\ closed N ==> diff --git a/src/coretypes/oneScript.sml b/src/coretypes/oneScript.sml index a381395c6e..265b741486 100644 --- a/src/coretypes/oneScript.sml +++ b/src/coretypes/oneScript.sml @@ -144,6 +144,27 @@ val FORALL_ONE = store_thm( ``(!x:unit. P x) <=> P ()``, simpLib.SIMP_TAC boolSimps.bool_ss [EQ_IMP_THM, one_induction]); +(* This (and the next) was in examples/lambda/basics/termSceipt.sml, etc. *) +Theorem FORALL_ONE_FN : + (!uf : one -> 'a. P uf) = !a. P (\u. a) +Proof + SRW_TAC [][EQ_IMP_THM] THEN + POP_ASSUM (Q.SPEC_THEN `uf ()` MP_TAC) THEN + Q_TAC SUFF_TAC `(\y. uf()) = uf` THEN1 SRW_TAC [][] THEN + SRW_TAC [][FUN_EQ_THM, one] +QED + +Theorem EXISTS_ONE_FN : + (?f : 'a -> one -> 'b. P f) = (?f : 'a -> 'b. P (\x u. f x)) +Proof + SRW_TAC [][EQ_IMP_THM] THENL [ + Q.EXISTS_TAC `\a. f a ()` THEN SRW_TAC [][] THEN + Q_TAC SUFF_TAC `(\x u. f x ()) = f` THEN1 SRW_TAC [][] THEN + SRW_TAC [][FUN_EQ_THM, one], + Q.EXISTS_TAC `\a u. f a` THEN SRW_TAC [][] + ] +QED + (*--------------------------------------------------------------------------- Define the case constant ---------------------------------------------------------------------------*) diff --git a/src/list/src/listScript.sml b/src/list/src/listScript.sml index 1a2b941914..42da31fbf4 100644 --- a/src/list/src/listScript.sml +++ b/src/list/src/listScript.sml @@ -742,6 +742,18 @@ val LENGTH_NIL = store_thm("LENGTH_NIL[simp]", LIST_INDUCT_TAC THEN REWRITE_TAC [LENGTH, NOT_SUC, NOT_CONS_NIL]); +Theorem LENGTH1 : + (1 = LENGTH l) <=> ?e. l = [e] +Proof + Cases_on `l` >> srw_tac [][LENGTH_NIL] +QED + +Theorem LENGTH2 : + (2 = LENGTH l) <=> ?a b. l = [a;b] +Proof + Cases_on `l` >> srw_tac [][LENGTH1] +QED + val LENGTH_NIL_SYM = store_thm ( "LENGTH_NIL_SYM[simp]", “(0 = LENGTH l) = (l = [])”, diff --git a/src/list/src/rich_listScript.sml b/src/list/src/rich_listScript.sml index 62fcc23e6c..68afc77af9 100644 --- a/src/list/src/rich_listScript.sml +++ b/src/list/src/rich_listScript.sml @@ -3533,6 +3533,71 @@ in val _ = overload_on("MEM", mem_t) end +(* moved here from examples/CCS/CCSScript.sml, originally by Chun Tian *) +Definition DELETE_ELEMENT : + (DELETE_ELEMENT e [] = []) /\ + (DELETE_ELEMENT e (x :: l) = if (e = x) then DELETE_ELEMENT e l + else x :: DELETE_ELEMENT e l) +End + +Theorem NOT_IN_DELETE_ELEMENT : + !e L. ~MEM e (DELETE_ELEMENT e L) +Proof + GEN_TAC >> Induct_on `L` + >- REWRITE_TAC [DELETE_ELEMENT, MEM] + >> GEN_TAC >> REWRITE_TAC [DELETE_ELEMENT] + >> Cases_on `e = h` >> fs [] +QED + +Theorem DELETE_ELEMENT_FILTER : + !e L. DELETE_ELEMENT e L = FILTER ((<>) e) L +Proof + GEN_TAC >> Induct_on `L` + >- REWRITE_TAC [DELETE_ELEMENT, FILTER] + >> GEN_TAC >> REWRITE_TAC [DELETE_ELEMENT, FILTER] + >> Cases_on `e = h` >> fs [] +QED + +Theorem LENGTH_DELETE_ELEMENT_LEQ : + !e L. LENGTH (DELETE_ELEMENT e L) <= LENGTH L +Proof + rpt GEN_TAC + >> REWRITE_TAC [DELETE_ELEMENT_FILTER] + >> MP_TAC (Q.SPECL [`\y. e <> y`, `\y. T`] LENGTH_FILTER_LEQ_MONO) + >> BETA_TAC >> simp [] +QED + +fun K_TAC _ = ALL_TAC; +val KILL_TAC = POP_ASSUM_LIST K_TAC; + +Theorem LENGTH_DELETE_ELEMENT_LE : + !e L. MEM e L ==> LENGTH (DELETE_ELEMENT e L) < LENGTH L +Proof + rpt GEN_TAC >> Induct_on `L` + >- REWRITE_TAC [MEM] + >> GEN_TAC >> REWRITE_TAC [MEM, DELETE_ELEMENT] + >> Cases_on `e = h` >> fs [] + >> MP_TAC (Q.SPECL [`h`, `L`] LENGTH_DELETE_ELEMENT_LEQ) + >> KILL_TAC >> RW_TAC arith_ss [] +QED + +Theorem EVERY_DELETE_ELEMENT : + !e L P. P e /\ EVERY P (DELETE_ELEMENT e L) ==> EVERY P L +Proof + GEN_TAC >> Induct_on `L` + >- RW_TAC std_ss [DELETE_ELEMENT] + >> rpt GEN_TAC >> REWRITE_TAC [DELETE_ELEMENT] + >> Cases_on `e = h` >> fs [] +QED + +Theorem DELETE_ELEMENT_APPEND : + !a L L'. DELETE_ELEMENT a (L ++ L') = + DELETE_ELEMENT a L ++ DELETE_ELEMENT a L' +Proof + REWRITE_TAC [DELETE_ELEMENT_FILTER] + >> REWRITE_TAC [GSYM FILTER_APPEND_DISTRIB] +QED + (* ------------------------------------------------------------------------ *) local diff --git a/src/pred_set/src/pred_setScript.sml b/src/pred_set/src/pred_setScript.sml index a7af48c86e..28b75ecbac 100644 --- a/src/pred_set/src/pred_setScript.sml +++ b/src/pred_set/src/pred_setScript.sml @@ -870,21 +870,33 @@ Theorem DISJOINT_UNION_BOTH: Proof PROVE_TAC [DISJOINT_UNION, DISJOINT_SYM] QED -val DISJOINT_SUBSET = Q.store_thm -("DISJOINT_SUBSET", - `!s t u. DISJOINT s t /\ u SUBSET t ==> DISJOINT s u`, +Theorem DISJOINT_SUBSET : + !s t u. DISJOINT s t /\ u SUBSET t ==> DISJOINT s u +Proof REWRITE_TAC [DISJOINT_DEF, SUBSET_DEF, IN_INTER, NOT_IN_EMPTY, EXTENSION] THEN - PROVE_TAC []); + PROVE_TAC [] +QED -val SUBSET_DISJOINT = store_thm - ("SUBSET_DISJOINT", - ``!s t u v. DISJOINT s t /\ u SUBSET s /\ v SUBSET t ==> DISJOINT u v``, +Theorem SUBSET_DISJOINT : + !s t u v. DISJOINT s t /\ u SUBSET s /\ v SUBSET t ==> DISJOINT u v +Proof RW_TAC std_ss [DISJOINT_ALT] >> `x IN s` by PROVE_TAC [SUBSET_DEF] >> CCONTR_TAC >> fs [] >> `x IN t` by PROVE_TAC [SUBSET_DEF] - >> RES_TAC); + >> RES_TAC +QED + +Theorem DISJOINT_SUBSET' : + !s t u. DISJOINT s t /\ u SUBSET s ==> DISJOINT u t +Proof + rpt STRIP_TAC + >> MATCH_MP_TAC SUBSET_DISJOINT + >> Q.EXISTS_TAC ‘s’ + >> Q.EXISTS_TAC ‘t’ + >> ASM_REWRITE_TAC [SUBSET_REFL] +QED (* ===================================================================== *) (* Set difference *) @@ -5286,6 +5298,10 @@ val max_lemma = prove( ] ]) +(* |- !s. FINITE s ==> + (s <> {} ==> MAX_SET s IN s /\ !y. y IN s ==> y <= MAX_SET s) /\ + (s = {} ==> MAX_SET s = 0) + *) val MAX_SET_DEF = new_specification ( "MAX_SET_DEF", ["MAX_SET"], CONV_RULE (BINDER_CONV RIGHT_IMP_EXISTS_CONV THENC @@ -5335,6 +5351,7 @@ val MAX_SET_ELIM = store_thm( Q (MAX_SET P)``, PROVE_TAC [MAX_SET_DEF]); +(* NOTE: “MIN_SET {}” is undefined *) val MIN_SET_DEF = new_definition("MIN_SET_DEF", ``MIN_SET = $LEAST``); val MIN_SET_ELIM = store_thm( @@ -5376,6 +5393,18 @@ val MIN_SET_THM = store_thm( REPEAT STRIP_TAC THEN RES_TAC THEN ASM_SIMP_TAC arith_ss [MIN_DEF] ]); +(* This version of MIN_SET_THM may be more useful when doing induction on s *) +Theorem MIN_SET_THM' : + (!e. MIN_SET {e} = e) /\ + (!e s. s <> {} ==> MIN_SET (e INSERT s) = MIN e (MIN_SET s)) +Proof + CONJ_TAC >- REWRITE_TAC [MIN_SET_THM] + >> rpt GEN_TAC + >> DISCH_THEN (fn th => + ONCE_REWRITE_TAC [SYM (MATCH_MP CHOICE_INSERT_REST th)]) + >> REWRITE_TAC [MIN_SET_THM] +QED + val MIN_SET_LEM = Q.store_thm ("MIN_SET_LEM", `!s. ~(s={}) ==> (MIN_SET s IN s) /\ !x. x IN s ==> MIN_SET s <= x`,