diff --git a/thys/ROOTS b/thys/ROOTS --- a/thys/ROOTS +++ b/thys/ROOTS @@ -1,556 +1,557 @@ ADS_Functor AODV AVL-Trees AWN Abortable_Linearizable_Modules Abs_Int_ITP2012 Abstract-Hoare-Logics Abstract-Rewriting Abstract_Completeness Abstract_Soundness Adaptive_State_Counting Affine_Arithmetic Aggregation_Algebras Akra_Bazzi Algebraic_Numbers Algebraic_VCs Allen_Calculus Amicable_Numbers Amortized_Complexity AnselmGod Applicative_Lifting Approximation_Algorithms Architectural_Design_Patterns Aristotles_Assertoric_Syllogistic Arith_Prog_Rel_Primes ArrowImpossibilityGS Attack_Trees Auto2_HOL Auto2_Imperative_HOL AutoFocus-Stream Automated_Stateful_Protocol_Verification Automatic_Refinement AxiomaticCategoryTheory BDD BNF_CC BNF_Operations Banach_Steinhaus Bell_Numbers_Spivey Berlekamp_Zassenhaus Bernoulli Bertrands_Postulate Bicategory BinarySearchTree Binding_Syntax_Theory Binomial-Heaps Binomial-Queues BirdKMP Bondy Boolean_Expression_Checkers Bounded_Deducibility_Security Buchi_Complementation Budan_Fourier Buffons_Needle Buildings BytecodeLogicJmlTypes C2KA_DistributedSystems CAVA_Automata CAVA_LTL_Modelchecker CCS CISC-Kernel CRDT CYK CakeML CakeML_Codegen Call_Arity Card_Equiv_Relations Card_Multisets Card_Number_Partitions Card_Partitions Cartan_FP Case_Labeling Catalan_Numbers Category Category2 Category3 Cauchy Cayley_Hamilton Certification_Monads Chandy_Lamport Chord_Segments Circus Clean ClockSynchInst Closest_Pair_Points CofGroups Coinductive Coinductive_Languages Collections Comparison_Sort_Lower_Bound Compiling-Exceptions-Correctly Complete_Non_Orders Completeness Complex_Geometry Complx ComponentDependencies ConcurrentGC ConcurrentIMP Concurrent_Ref_Alg Concurrent_Revisions Consensus_Refined Constructive_Cryptography Constructor_Funs Containers CoreC++ Core_DOM Count_Complex_Roots CryptHOL CryptoBasedCompositionalProperties DFS_Framework DPT-SAT-Solver DataRefinementIBP Datatype_Order_Generator Decl_Sem_Fun_PL Decreasing-Diagrams Decreasing-Diagrams-II Deep_Learning Density_Compiler Dependent_SIFUM_Refinement Dependent_SIFUM_Type_Systems Depth-First-Search Derangements Deriving Descartes_Sign_Rule Dict_Construction Differential_Dynamic_Logic Differential_Game_Logic Dijkstra_Shortest_Path Diophantine_Eqns_Lin_Hom Dirichlet_L Dirichlet_Series DiscretePricing Discrete_Summation DiskPaxos DynamicArchitectures Dynamic_Tables EFSM_Inference E_Transcendental Echelon_Form EdmondsKarp_Maxflow Efficient-Mergesort Elliptic_Curves_Group_Law Encodability_Process_Calculi Epistemic_Logic Ergodic_Theory Error_Function Euler_MacLaurin Euler_Partition Example-Submission Extended_Finite_State_Machines FFT FLP FOL-Fitting FOL_Harrison FOL_Seq_Calc1 Factored_Transition_System_Bounding Falling_Factorial_Sum Farkas FeatherweightJava Featherweight_OCL Fermat3_4 FileRefinement FinFun Finger-Trees Finite_Automata_HF First_Order_Terms First_Welfare_Theorem Fishburn_Impossibility Fisher_Yates Flow_Networks Floyd_Warshall Flyspeck-Tame FocusStreamsCaseStudies Forcing Formal_SSA Formula_Derivatives Fourier Free-Boolean-Algebra Free-Groups FunWithFunctions FunWithTilings Functional-Automata Functional_Ordered_Resolution_Prover Furstenberg_Topology GPU_Kernel_PL Gabow_SCC Game_Based_Crypto Gauss-Jordan-Elim-Fun Gauss_Jordan Gauss_Sums Gaussian_Integers GenClock General-Triangle Generalized_Counting_Sort Generic_Deriving Generic_Join GewirthPGCProof Girth_Chromatic GoedelGod Goodstein_Lambda GraphMarkingIBP Graph_Saturation Graph_Theory Green Groebner_Bases Groebner_Macaulay Gromov_Hyperbolicity Group-Ring-Module HOL-CSP HOLCF-Prelude HRB-Slicing Heard_Of Hello_World HereditarilyFinite Hermite Hidden_Markov_Models Higher_Order_Terms Hoare_Time HotelKeyCards Huffman Hybrid_Logic Hybrid_Multi_Lane_Spatial_Logic Hybrid_Systems_VCs HyperCTL IEEE_Floating_Point IMAP-CRDT IMO2019 IMP2 IMP2_Binary_Heap IP_Addresses Imperative_Insertion_Sort Impossible_Geometry Incompleteness Incredible_Proof_Machine Inductive_Confidentiality Inductive_Inference InfPathElimination InformationFlowSlicing InformationFlowSlicing_Inter Integration Interval_Arithmetic_Word32 Iptables_Semantics Irrational_Series_Erdos_Straus Irrationality_J_Hancl Isabelle_C Isabelle_Meta_Model Jacobson_Basic_Algebra Jinja JinjaThreads JiveDataStoreModel Jordan_Hoelder Jordan_Normal_Form KAD KAT_and_DRA KBPs KD_Tree Key_Agreement_Strong_Adversaries Kleene_Algebra Knot_Theory Knuth_Bendix_Order Knuth_Morris_Pratt Koenigsberg_Friendship Kruskal Kuratowski_Closure_Complement LLL_Basis_Reduction LLL_Factorization LOFT LTL LTL_Master_Theorem LTL_Normal_Form LTL_to_DRA LTL_to_GBA Lam-ml-Normalization LambdaAuth LambdaMu Lambda_Free_EPO Lambda_Free_KBOs Lambda_Free_RPOs Lambert_W Landau_Symbols Laplace_Transform Latin_Square LatticeProperties Launchbury Lazy-Lists-II Lazy_Case Lehmer Lifting_Definition_Option LightweightJava LinearQuantifierElim Linear_Inequalities Linear_Programming Linear_Recurrences Liouville_Numbers List-Index List-Infinite List_Interleaving List_Inversions List_Update LocalLexing Localization_Ring Locally-Nameless-Sigma Lowe_Ontological_Argument Lower_Semicontinuous Lp Lucas_Theorem MFMC_Countable MFODL_Monitor_Optimized MFOTL_Monitor MSO_Regex_Equivalence Markov_Models Marriage Mason_Stothers Matrices_for_ODEs Matrix Matrix_Tensor Matroids Max-Card-Matching Median_Of_Medians_Selection Menger Mersenne_Primes MiniML Minimal_SSA Minkowskis_Theorem Minsky_Machines Modal_Logics_for_NTS Modular_Assembly_Kit_Security Monad_Memo_DP Monad_Normalisation MonoBoolTranAlgebra MonoidalCategory Monomorphic_Monad MuchAdoAboutTwo Multi_Party_Computation Multirelations Myhill-Nerode Name_Carrying_Type_Inference Nash_Williams Nat-Interval-Logic Native_Word Nested_Multisets_Ordinals Network_Security_Policy_Verification Neumann_Morgenstern_Utility No_FTL_observers Nominal2 Noninterference_CSP Noninterference_Concurrent_Composition Noninterference_Generic_Unwinding Noninterference_Inductive_Unwinding Noninterference_Ipurge_Unwinding Noninterference_Sequential_Composition NormByEval Nullstellensatz Octonions OpSets Open_Induction Optics Optimal_BST Orbit_Stabiliser Order_Lattice_Props Ordered_Resolution_Prover Ordinal Ordinal_Partitions Ordinals_and_Cardinals Ordinary_Differential_Equations PAC_Checker PCF PLM POPLmark-deBruijn PSemigroupsConvolution Pairing_Heap Paraconsistency Parity_Game Partial_Function_MR Partial_Order_Reduction Password_Authentication_Protocol Pell Perfect-Number-Thm Perron_Frobenius Pi_Calculus Pi_Transcendental Planarity_Certificates Poincare_Bendixson Poincare_Disc Polynomial_Factorization Polynomial_Interpolation Polynomials Pop_Refinement Posix-Lexing Possibilistic_Noninterference Power_Sum_Polynomials Pratt_Certificate Presburger-Automata Prim_Dijkstra_Simple Prime_Distribution_Elementary Prime_Harmonic_Series Prime_Number_Theorem Priority_Queue_Braun Priority_Search_Trees Probabilistic_Noninterference Probabilistic_Prime_Tests Probabilistic_System_Zoo Probabilistic_Timed_Automata Probabilistic_While Program-Conflict-Analysis Projective_Geometry Promela Proof_Strategy_Language PropResPI Propositional_Proof_Systems Prpu_Maxflow PseudoHoops Psi_Calculi Ptolemys_Theorem QHLProver QR_Decomposition Quantales Quaternions Quick_Sort_Cost RIPEMD-160-SPARK ROBDD RSAPSS Ramsey-Infinite Random_BSTs Random_Graph_Subgraph_Threshold Randomised_BSTs Randomised_Social_Choice Rank_Nullity_Theorem Real_Impl Recursion-Addition Recursion-Theory-I Refine_Imperative_HOL Refine_Monadic RefinementReactive Regex_Equivalence Regular-Sets Regular_Algebras Relation_Algebra Relational-Incorrectness-Logic Relational_Disjoint_Set_Forests Relational_Paths Rep_Fin_Groups Residuated_Lattices Resolution_FOL Rewriting_Z Ribbon_Proofs Robbins-Conjecture Root_Balanced_Tree Routing Roy_Floyd_Warshall SATSolverVerification SDS_Impossibility SIFPL SIFUM_Type_Systems SPARCv8 Safe_Distance Safe_OCL Saturation_Framework Secondary_Sylow Security_Protocol_Refinement Selection_Heap_Sort SenSocialChoice Separata Separation_Algebra Separation_Logic_Imperative_HOL SequentInvertibility Shivers-CFA ShortestPath Show Sigma_Commit_Crypto Signature_Groebner Simpl Simple_Firewall Simplex Skew_Heap Skip_Lists Slicing Sliding_Window_Algorithm Smith_Normal_Form Smooth_Manifolds Sort_Encodings Source_Coding_Theorem Special_Function_Bounds Splay_Tree Sqrt_Babylonian Stable_Matching Statecharts Stateful_Protocol_Composition_and_Typing Stellar_Quorums Stern_Brocot Stewart_Apollonius Stirling_Formula Stochastic_Matrices Stone_Algebras Stone_Kleene_Relation_Algebras Stone_Relation_Algebras Store_Buffer_Reduction Stream-Fusion Stream_Fusion_Code Strong_Security Sturm_Sequences Sturm_Tarski Stuttering_Equivalence Subresultants Subset_Boolean_Algebras SumSquares SuperCalc Surprise_Paradox Symmetric_Polynomials +Syntax_Independent_Logic Szpilrajn TESL_Language TLA Tail_Recursive_Functions Tarskis_Geometry Taylor_Models Timed_Automata Topology TortoiseHare Transcendence_Series_Hancl_Rucki Transformer_Semantics Transition_Systems_and_Automata Transitive-Closure Transitive-Closure-II Treaps Tree-Automata Tree_Decomposition Triangle Trie Twelvefold_Way Tycon Types_Tableaus_and_Goedels_God UPF UPF_Firewall UTP Universal_Turing_Machine UpDown_Scheme Valuation VectorSpace VeriComp Verified-Prover VerifyThis2018 VerifyThis2019 Vickrey_Clarke_Groves VolpanoSmith WHATandWHERE_Security WOOT_Strong_Eventual_Consistency WebAssembly Weight_Balanced_Trees Well_Quasi_Orders Winding_Number_Eval Word_Lib WorkerWrapper XML ZFC_in_HOL Zeta_3_Irrational Zeta_Function pGCL diff --git a/thys/Syntax_Independent_Logic/Deduction.thy b/thys/Syntax_Independent_Logic/Deduction.thy new file mode 100644 --- /dev/null +++ b/thys/Syntax_Independent_Logic/Deduction.thy @@ -0,0 +1,2136 @@ +chapter \Deduction\ + +(*<*) +theory Deduction imports Syntax +begin +(*>*) + + +text \We formalize deduction in a logical system that (shallowly) embeds +intuitionistic logic connectives and quantifiers over a signature containing +the numerals.\ + + +section \Positive Logic Deduction\ + +locale Deduct = +Syntax_with_Numerals_and_Connectives + var trm fmla Var FvarsT substT Fvars subst + num + eql cnj imp all exi +for +var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" +and Var FvarsT substT Fvars subst +and num +and eql cnj imp all exi ++ +fixes +\ \Provability of numeric formulas:\ +prv :: "'fmla \ bool" +\ \Hilbert-style system for intuitionistic logic over $\longrightarrow$,$\land$,$\forall$,$\exists$. +($\bot$, $\lnot$ and $\lor$ will be included later.) +Hilbert-style is preferred since it requires the least amount of infrastructure. +(Later, natural deduction rules will also be defined.)\ +assumes +\ \Propositional rules and axioms. There is a single propositional rule, modus ponens.\ +\ \The modus ponens rule:\ +prv_imp_mp: +"\ \ \. \ \ fmla \ \ \ fmla \ + prv (imp \ \) \ prv \ \ prv \" +and +\ \The propositional intuitionitic axioms:\ +prv_imp_imp_triv: +"\\ \. \ \ fmla \ \ \ fmla \ + prv (imp \ (imp \ \))" +and +prv_imp_trans: +"\ \ \ \. \ \ fmla \ \ \ fmla \ \ \ fmla \ + prv (imp (imp \ (imp \ \)) + (imp (imp \ \) (imp \ \)))" +and +prv_imp_cnjL: +"\ \ \. \ \ fmla \ \ \ fmla \ + prv (imp (cnj \ \) \)" +and +prv_imp_cnjR: +"\ \ \. \ \ fmla \ \ \ fmla \ + prv (imp (cnj \ \) \)" +and +prv_imp_cnjI: +"\ \ \. \ \ fmla \ \ \ fmla \ + prv (imp \ (imp \ (cnj \ \)))" +and +(* *) +\ \Predicate calculus (quantifier) rules and axioms\ +\ \The rules of universal and existential generalization:\ +prv_all_imp_gen: +"\ x \ \. x \ Fvars \ \ prv (imp \ \) \ prv (imp \ (all x \))" +and +prv_exi_imp_gen: +"\ x \ \. x \ var \ \ \ fmla \ \ \ fmla \ + x \ Fvars \ \ prv (imp \ \) \ prv (imp (exi x \) \)" +and +\ \Two quantifier instantiation axioms:\ +prv_all_inst: +"\ x \ t. + x \ var \ \ \ fmla \ t \ trm \ + prv (imp (all x \) (subst \ t x))" +and +prv_exi_inst: +"\ x \ t. + x \ var \ \ \ fmla \ t \ trm \ + prv (imp (subst \ t x) (exi x \))" +and +\ \The equality axioms:\ +prv_eql_refl: +"\ x. x \ var \ + prv (eql (Var x) (Var x))" +and +prv_eql_subst: +"\ \ x y. + x \ var \ y \ var \ \ \ fmla \ + prv ((imp (eql (Var x) (Var y)) + (imp \ (subst \ (Var y) x))))" +begin + + +subsection \Properties of the propositional fragment\ + +lemma prv_imp_triv: +assumes phi: "\ \ fmla" and psi: "\ \ fmla" +shows "prv \ \ prv (imp \ \)" + by (meson prv_imp_imp_triv prv_imp_mp imp phi psi) + +lemma prv_imp_refl: +assumes phi: "\ \ fmla" +shows "prv (imp \ \)" + by (metis prv_imp_imp_triv prv_imp_mp prv_imp_trans imp phi) + +lemma prv_imp_refl2: "\ \ fmla \ \ \ fmla \ \ = \ \ prv (imp \ \)" +using prv_imp_refl by auto + +lemma prv_cnjI: +assumes phi: "\ \ fmla" and chi: "\ \ fmla" +shows "prv \ \ prv \ \ prv (cnj \ \)" + by (meson cnj prv_imp_cnjI prv_imp_mp imp phi chi) + +lemma prv_cnjEL: +assumes phi: "\ \ fmla" and chi: "\ \ fmla" +shows "prv (cnj \ \) \ prv \" + using chi phi prv_imp_cnjL prv_imp_mp by blast + +lemma prv_cnjER: +assumes phi: "\ \ fmla" and chi: "\ \ fmla" +shows "prv (cnj \ \) \ prv \" + using chi phi prv_imp_cnjR prv_imp_mp by blast + +lemma prv_prv_imp_trans: +assumes phi: "\ \ fmla" and chi: "\ \ fmla" and psi: "\ \ fmla" +assumes 1: "prv (imp \ \)" and 2: "prv (imp \ \)" +shows "prv (imp \ \)" +proof- + have "prv (imp \ (imp \ \))" by (simp add: 2 chi prv_imp_triv phi psi) + thus ?thesis by (metis 1 chi prv_imp_mp prv_imp_trans imp phi psi) +qed + +lemma prv_imp_trans1: +assumes phi: "\ \ fmla" and chi: "\ \ fmla" and psi: "\ \ fmla" +shows "prv (imp (imp \ \) (imp (imp \ \) (imp \ \)))" + by (meson chi prv_prv_imp_trans prv_imp_imp_triv prv_imp_trans imp phi psi) + +lemma prv_imp_com: +assumes phi: "\ \ fmla" and chi: "\ \ fmla" and psi: "\ \ fmla" +assumes "prv (imp \ (imp \ \))" +shows "prv (imp \ (imp \ \))" + by (metis (no_types) assms prv_prv_imp_trans prv_imp_imp_triv prv_imp_mp prv_imp_trans imp) + +lemma prv_imp_trans2: +assumes phi: "\ \ fmla" and chi: "\ \ fmla" and psi: "\ \ fmla" +shows "prv (imp (imp \ \) (imp (imp \ \) (imp \ \)))" +using prv_imp_mp prv_imp_trans prv_imp_trans1 prv_imp_imp_triv + by (meson chi prv_imp_com imp phi psi) + +lemma prv_imp_cnj: +assumes "\ \ fmla" and "\ \ fmla" and "\ \ fmla" +shows "prv (imp \ \) \ prv (imp \ \) \ prv (imp \ (cnj \ \))" +proof - + assume "prv (imp \ \)" + moreover + assume "prv (imp \ \)" + then have "prv (imp \ (imp \ f))" if "prv (imp \ f)" "f \ fmla" for f + using that by (metis (no_types) assms imp prv_imp_imp_triv prv_prv_imp_trans) + moreover have "prv (imp \ (imp \ \)) \ prv (imp \ (imp \ \))" + using \prv (imp \ \)\ by (metis (no_types) assms(1,3) imp prv_imp_com prv_prv_imp_trans) + ultimately show ?thesis + by (metis (no_types) assms cnj imp prv_imp_cnjI prv_imp_com prv_imp_mp prv_imp_trans) +qed + +lemma prv_imp_imp_com: +assumes "\ \ fmla" and "\ \ fmla" and "\ \ fmla" +shows +"prv (imp (imp \ (imp \ \)) + (imp \ (imp \ \)))" + by (metis (no_types) assms + prv_prv_imp_trans prv_imp_com prv_imp_imp_triv prv_imp_trans imp) + +lemma prv_cnj_imp_monoR2: +assumes "\ \ fmla" and "\ \ fmla" and "\ \ fmla" +assumes "prv (imp \ (imp \ \))" +shows "prv (imp (cnj \ \) \)" +proof - + have "prv (imp (cnj \ \) (cnj \ \))" + using prv_imp_refl by (blast intro: assms(1-3)) + then have "prv (imp (imp (cnj \ \) (imp (cnj \ \) \)) (imp (cnj \ \) \))" + by (metis (no_types) cnj imp assms(1-3) prv_imp_com prv_imp_mp prv_imp_trans) + then show ?thesis + by (metis (no_types) imp cnj assms prv_imp_cnjL prv_imp_cnjR prv_imp_com prv_imp_mp prv_prv_imp_trans) +qed + +lemma prv_imp_imp_imp_cnj: +assumes "\ \ fmla" and "\ \ fmla" and "\ \ fmla" +shows +"prv (imp (imp \ (imp \ \)) + (imp (cnj \ \) \))" +proof- + have "prv (imp \ (imp (imp \ (imp \ \)) (imp \ \)))" + by (simp add: assms prv_imp_com prv_imp_refl) + hence "prv (imp \ (imp \ (imp (imp \ (imp \ \)) \)))" + by (metis (no_types, lifting) assms prv_prv_imp_trans prv_imp_imp_com imp) + hence "prv (imp (cnj \ \) + (imp (imp \ (imp \ \)) \))" + by (simp add: assms prv_cnj_imp_monoR2) + thus ?thesis using assms prv_imp_com prv_imp_mp by (meson cnj imp) +qed + +lemma prv_imp_cnj_imp: +assumes "\ \ fmla" and "\ \ fmla" and "\ \ fmla" +shows +"prv (imp (imp (cnj \ \) \) + (imp \ (imp \ \)))" + by (metis (no_types) assms cnj prv_prv_imp_trans prv_imp_cnjI prv_imp_com prv_imp_trans2 imp) + +lemma prv_cnj_imp: +assumes "\ \ fmla" and "\ \ fmla" and "\ \ fmla" +assumes "prv (imp (cnj \ \) \)" +shows "prv (imp \ (imp \ \))" + using assms prv_imp_cnj_imp prv_imp_mp by (meson cnj imp) + +text \Monotonicy of conjunction w.r.t. implication:\ + +lemma prv_cnj_imp_monoR: +assumes "\ \ fmla" and "\ \ fmla" and "\ \ fmla" +shows "prv (imp (imp \ \) (imp (imp \ \) (imp \ (cnj \ \))))" + by (meson assms cnj imp prv_cnj_imp prv_cnj_imp_monoR2 prv_imp_cnj prv_imp_cnjL prv_imp_cnjR) + +lemma prv_imp_cnj3L: +assumes "\1 \ fmla" and "\2 \ fmla" and "\ \ fmla" +shows "prv (imp (imp \1 \) (imp (cnj \1 \2) \))" + using assms prv_imp_cnjL prv_imp_mp prv_imp_trans2 + by (metis cnj imp) + +lemma prv_imp_cnj3R: +assumes "\1 \ fmla" and "\2 \ fmla" and "\ \ fmla" +shows "prv (imp (imp \2 \) (imp (cnj \1 \2) \))" + using prv_imp_cnjR prv_imp_mp prv_imp_trans2 + by (metis assms cnj imp) + +lemma prv_cnj_imp_mono: +assumes "\1 \ fmla" and "\2 \ fmla" and "\1 \ fmla" and "\2 \ fmla" +shows "prv (imp (imp \1 \1) (imp (imp \2 \2) (imp (cnj \1 \2) (cnj \1 \2))))" +proof- + have "prv (imp (imp (cnj \1 \2) \1) (imp (imp (cnj \1 \2) \2) (imp (cnj \1 \2) (cnj \1 \2))))" + using prv_cnj_imp_monoR[of "cnj \1 \2" \1 \2] assms by auto + hence "prv (imp (imp \1 \1) (imp (imp (cnj \1 \2) \2) (imp (cnj \1 \2) (cnj \1 \2))))" + by (metis (no_types) imp cnj assms prv_imp_cnj3L prv_prv_imp_trans) + hence "prv (imp (imp (cnj \1 \2) \2) (imp (imp \1 \1) (imp (cnj \1 \2) (cnj \1 \2))))" + using prv_imp_com assms by (meson cnj imp) + hence "prv (imp (imp \2 \2) (imp (imp \1 \1) (imp (cnj \1 \2) (cnj \1 \2))))" + using prv_imp_cnj3R prv_imp_mp prv_imp_trans1 + by (metis (no_types) assms cnj prv_prv_imp_trans imp) + thus ?thesis using prv_imp_com assms + by (meson cnj imp) +qed + +lemma prv_cnj_mono: +assumes "\1 \ fmla" and "\2 \ fmla" and "\1 \ fmla" and "\2 \ fmla" +assumes "prv (imp \1 \1)" and "prv (imp \2 \2)" +shows "prv (imp (cnj \1 \2) (cnj \1 \2))" + using assms prv_cnj_imp_mono prv_imp_mp + by (metis (mono_tags) cnj prv_prv_imp_trans prv_imp_cnj prv_imp_cnjL prv_imp_cnjR) + +lemma prv_cnj_imp_monoR4: +assumes "\ \ fmla" and "\ \ fmla" and "\1 \ fmla" and "\2 \ fmla" +shows +"prv (imp (imp \ (imp \ \1)) + (imp (imp \ (imp \ \2)) (imp \ (imp \ (cnj \1 \2)))))" + by (simp add: assms prv_cnj_imp prv_imp_cnj prv_imp_cnjL prv_imp_cnjR prv_cnj_imp_monoR2) + +lemma prv_imp_cnj4: +assumes "\ \ fmla" and "\ \ fmla" and "\1 \ fmla" and "\2 \ fmla" +shows "prv (imp \ (imp \ \1)) \ prv (imp \ (imp \ \2)) \ prv (imp \ (imp \ (cnj \1 \2)))" + by (simp add: assms prv_cnj_imp prv_imp_cnj prv_cnj_imp_monoR2) + +lemma prv_cnj_imp_monoR5: +assumes "\1 \ fmla" and "\2 \ fmla" and "\1 \ fmla" and "\2 \ fmla" +shows "prv (imp (imp \1 \1) (imp (imp \2 \2) (imp \1 (imp \2 (cnj \1 \2)))))" +proof- + have "prv (imp (imp \1 \1) (imp (imp \2 \2) (imp (cnj \1 \2) (cnj \1 \2))))" + using prv_cnj_imp_mono[of \1 \2 \1 \2] assms by auto + hence "prv (imp (imp \1 \1) (imp (cnj \1 \2) (imp (imp \2 \2) (cnj \1 \2))))" + by (metis (no_types, lifting) assms cnj imp prv_imp_imp_com prv_prv_imp_trans) + hence "prv (imp (imp \1 \1) (imp \1 (imp \2 (imp (imp \2 \2) (cnj \1 \2)))))" + using prv_imp_cnj_imp prv_imp_mp prv_imp_trans2 + by (metis (mono_tags) assms cnj prv_prv_imp_trans imp) + hence 1: "prv (imp (imp \1 \1) (imp \1 (imp (imp \2 \2) (imp \2 (cnj \1 \2)))))" + using prv_cnj_imp prv_imp_cnjR prv_imp_mp prv_imp_trans1 + by (metis (no_types) assms cnj prv_cnj_imp_monoR prv_prv_imp_trans prv_imp_imp_triv imp) + thus ?thesis + by (metis (no_types, lifting) assms cnj imp prv_prv_imp_trans prv_imp_imp_com) +qed + +lemma prv_imp_cnj5: +assumes "\1 \ fmla" and "\2 \ fmla" and "\1 \ fmla" and "\2 \ fmla" +assumes "prv (imp \1 \1)" and "prv (imp \2 \2)" +shows "prv (imp \1 (imp \2 (cnj \1 \2)))" + by (simp add: assms prv_cnj_imp prv_cnj_mono) + +text \Properties of formula equivalence:\ + +lemma prv_eqv_imp: +assumes "\ \ fmla" and "\ \ fmla" +shows "prv (imp (eqv \ \) (eqv \ \))" + by (simp add: assms prv_imp_cnj prv_imp_cnjL prv_imp_cnjR eqv_def) + +lemma prv_eqv_eqv: +assumes "\ \ fmla" and "\ \ fmla" +shows "prv (eqv (eqv \ \) (eqv \ \))" + using assms prv_cnjI prv_eqv_imp eqv_def by auto + +lemma prv_imp_eqvEL: +"\1 \ fmla \ \2 \ fmla \ prv (eqv \1 \2) \ prv (imp \1 \2)" + unfolding eqv_def by (meson cnj imp prv_imp_cnjL prv_imp_mp) + +lemma prv_imp_eqvER: +"\1 \ fmla \ \2 \ fmla \ prv (eqv \1 \2) \ prv (imp \2 \1)" +unfolding eqv_def by (meson cnj imp prv_imp_cnjR prv_imp_mp) + +lemma prv_eqv_imp_trans: +assumes "\ \ fmla" and "\ \ fmla" and "\ \ fmla" +shows "prv (imp (eqv \ \) (imp (eqv \ \) (eqv \ \)))" +proof- + have "prv (imp (eqv \ \) (imp (imp \ \) (imp \ \)))" + using assms prv_imp_cnjL prv_imp_mp prv_imp_trans2 eqv_def + by (metis prv_imp_cnj3L eqv imp) + hence "prv (imp (eqv \ \) (imp (eqv \ \) (imp \ \)))" + using prv_imp_cnjL prv_imp_mp prv_imp_trans2 eqv_def + by (metis (no_types) assms prv_imp_cnj3L prv_imp_com eqv imp) + hence 1: "prv (imp (cnj (eqv \ \) (eqv \ \)) (imp \ \))" + using prv_cnj_imp_monoR2 + by (simp add: assms(1) assms(2) assms(3)) + have "prv (imp (eqv \ \) (imp (imp \ \) (imp \ \)))" + using prv_imp_cnjR prv_imp_mp prv_imp_trans1 eqv_def + by (metis assms prv_cnj_imp_monoR2 prv_imp_triv imp) + hence "prv (imp (eqv \ \) (imp (eqv \ \) (imp \ \)))" + by (metis assms cnj eqv_def imp prv_imp_cnj3R prv_prv_imp_trans) + hence 2: "prv (imp (cnj (eqv \ \) (eqv \ \)) (imp \ \))" + using prv_cnj_imp_monoR2 + by (metis (no_types, lifting) assms eqv imp) + have "prv (imp (cnj (eqv \ \) (eqv \ \)) (eqv \ \))" + using 1 2 using assms prv_imp_cnj by (auto simp: eqv_def[of \ \]) + thus ?thesis + by (simp add: assms prv_cnj_imp) +qed + +lemma prv_eqv_cnj_trans: +assumes "\ \ fmla" and "\ \ fmla" and "\ \ fmla" +shows "prv (imp (cnj (eqv \ \) (eqv \ \)) (eqv \ \))" + by (simp add: assms prv_eqv_imp_trans prv_cnj_imp_monoR2) + +lemma prv_eqvI: + assumes "\ \ fmla" and "\ \ fmla" + assumes "prv (imp \ \)" and "prv (imp \ \)" + shows "prv (eqv \ \)" + by (simp add: assms eqv_def prv_cnjI) + +text \Formula equivalence is a congruence (i.e., an equivalence that +is compatible with the other connectives):\ + +lemma prv_eqv_refl: "\ \ fmla \ prv (eqv \ \)" + by (simp add: prv_cnjI prv_imp_refl eqv_def) + +lemma prv_eqv_sym: +assumes "\ \ fmla" and "\ \ fmla" +shows "prv (eqv \ \) \ prv (eqv \ \)" + using assms prv_cnjI prv_imp_cnjL prv_imp_cnjR prv_imp_mp eqv_def + by (meson prv_eqv_imp eqv) + +lemma prv_eqv_trans: +assumes "\ \ fmla" and "\ \ fmla" and "\ \ fmla" +shows "prv (eqv \ \) \ prv (eqv \ \) \ prv (eqv \ \)" + using assms prv_cnjI prv_cnj_imp_monoR2 prv_imp_mp prv_imp_trans1 prv_imp_imp_triv eqv_def + by (metis prv_prv_imp_trans prv_imp_cnjL prv_imp_cnjR eqv imp) + +lemma imp_imp_compat_eqvL: +assumes "\1 \ fmla" and "\2 \ fmla" and "\ \ fmla" +shows "prv (imp (eqv \1 \2) (eqv (imp \1 \) (imp \2 \)))" +proof - + have f: "prv (imp (eqv \1 \2) (eqv (imp \1 \) (imp \2 \)))" + if "prv (imp (eqv \1 \2) (imp (imp \2 \) (imp \1 \)))" "prv (imp (eqv \1 \2) (imp (imp \1 \) (imp \2 \)))" + using assms that prv_imp_cnj by (auto simp: eqv_def) + moreover have "(prv (imp (eqv \1 \2) (imp \1 \2)) \ prv (imp (eqv \1 \2) (imp \2 \1)))" + by (simp add: assms eqv_def prv_imp_cnjL prv_imp_cnjR) + ultimately show ?thesis + by (metis (no_types) assms eqv imp prv_imp_trans2 prv_prv_imp_trans) +qed + +lemma imp_imp_compat_eqvR: +assumes "\ \ fmla" and "\1 \ fmla" and "\2 \ fmla" +shows "prv (imp (eqv \1 \2) (eqv (imp \ \1) (imp \ \2)))" + by (simp add: assms prv_cnj_mono prv_imp_trans1 eqv_def) + +lemma imp_imp_compat_eqv: +assumes "\1 \ fmla" and "\2 \ fmla" and "\1 \ fmla" and "\2 \ fmla" +shows "prv (imp (eqv \1 \2) (imp (eqv \1 \2) (eqv (imp \1 \1) (imp \2 \2))))" +proof- + have "prv (imp (eqv \1 \2) (imp (eqv \1 \2) (cnj (eqv (imp \1 \1) (imp \2 \1)) + (eqv (imp \2 \1) (imp \2 \2)))))" + using prv_imp_cnj5 + [OF _ _ _ _ imp_imp_compat_eqvL[of \1 \2 \1] imp_imp_compat_eqvR[of \2 \1 \2]] assms by auto + hence "prv (imp (cnj (eqv \1 \2) (eqv \1 \2)) (cnj (eqv (imp \1 \1) (imp \2 \1)) + (eqv (imp \2 \1) (imp \2 \2))))" + by(simp add: assms prv_cnj_imp_monoR2) + hence "prv (imp (cnj (eqv \1 \2) (eqv \1 \2)) (eqv (imp \1 \1) (imp \2 \2)))" + using assms prv_eqv_cnj_trans[of "imp \1 \1" "imp \2 \1" "imp \2 \2"] + using prv_imp_mp prv_imp_trans2 + by (metis (no_types) cnj prv_prv_imp_trans eqv imp) + thus ?thesis using assms prv_cnj_imp by auto +qed + +lemma imp_compat_eqvL: +assumes "\1 \ fmla" and "\2 \ fmla" and "\ \ fmla" +assumes "prv (eqv \1 \2)" +shows "prv (eqv (imp \1 \) (imp \2 \))" + using assms prv_imp_mp imp_imp_compat_eqvL by (meson eqv imp) + +lemma imp_compat_eqvR: +assumes "\ \ fmla" and "\1 \ fmla" and "\2 \ fmla" +assumes "prv (eqv \1 \2)" +shows "prv (eqv (imp \ \1) (imp \ \2))" +using assms prv_imp_mp imp_imp_compat_eqvR by (meson eqv imp) + +lemma imp_compat_eqv: +assumes "\1 \ fmla" and "\2 \ fmla" and "\1 \ fmla" and "\2 \ fmla" +assumes "prv (eqv \1 \2)" and "prv (eqv \1 \2)" +shows "prv (eqv (imp \1 \1) (imp \2 \2))" + using assms prv_imp_mp imp_imp_compat_eqv by (metis eqv imp) + +(* *) + +lemma imp_cnj_compat_eqvL: +assumes "\1 \ fmla" and "\2 \ fmla" and "\ \ fmla" +shows "prv (imp (eqv \1 \2) (eqv (cnj \1 \) (cnj \2 \)))" +proof - + have "prv (imp (imp (imp \2 \1) (imp (cnj \2 \) (cnj \1 \))) + (imp (cnj (imp \1 \2) (imp \2 \1)) (cnj (imp (cnj \1 \) (cnj \2 \)) + (imp (cnj \2 \) (cnj \1 \)))))" + by (metis (no_types) imp cnj assms prv_imp_mp assms prv_cnj_imp_mono prv_imp_com prv_imp_refl) + then show ?thesis + by (metis (no_types) imp cnj assms prv_imp_mp assms eqv_def prv_cnj_imp_mono prv_imp_com prv_imp_refl) +qed + +lemma imp_cnj_compat_eqvR: +assumes "\ \ fmla" and "\1 \ fmla" and "\2 \ fmla" +shows "prv (imp (eqv \1 \2) (eqv (cnj \ \1) (cnj \ \2)))" + by (simp add: assms prv_cnj_mono prv_imp_cnj3R prv_imp_cnj4 prv_imp_cnjL prv_imp_triv eqv_def) + +lemma imp_cnj_compat_eqv: +assumes "\1 \ fmla" and "\2 \ fmla" and "\1 \ fmla" and "\2 \ fmla" +shows "prv (imp (eqv \1 \2) (imp (eqv \1 \2) (eqv (cnj \1 \1) (cnj \2 \2))))" +proof- + have "prv (imp (eqv \1 \2) (imp (eqv \1 \2) (cnj (eqv (cnj \1 \1) (cnj \2 \1)) + (eqv (cnj \2 \1) (cnj \2 \2)))))" + using prv_imp_cnj5 + [OF _ _ _ _ imp_cnj_compat_eqvL[of \1 \2 \1] imp_cnj_compat_eqvR[of \2 \1 \2]] assms by auto + hence "prv (imp (cnj (eqv \1 \2) (eqv \1 \2)) (cnj (eqv (cnj \1 \1) (cnj \2 \1)) + (eqv (cnj \2 \1) (cnj \2 \2))))" + by(simp add: assms prv_cnj_imp_monoR2) + hence "prv (imp (cnj (eqv \1 \2) (eqv \1 \2)) (eqv (cnj \1 \1) (cnj \2 \2)))" + using assms prv_eqv_cnj_trans[of "cnj \1 \1" "cnj \2 \1" "cnj \2 \2"] + using prv_imp_mp prv_imp_trans2 + by (metis (no_types) cnj prv_prv_imp_trans eqv) + thus ?thesis using assms prv_cnj_imp by auto +qed + +lemma cnj_compat_eqvL: +assumes "\1 \ fmla" and "\2 \ fmla" and "\ \ fmla" +assumes "prv (eqv \1 \2)" +shows "prv (eqv (cnj \1 \) (cnj \2 \))" + using assms prv_imp_mp imp_cnj_compat_eqvL by (meson eqv cnj) + +lemma cnj_compat_eqvR: +assumes "\ \ fmla" and "\1 \ fmla" and "\2 \ fmla" +assumes "prv (eqv \1 \2)" +shows "prv (eqv (cnj \ \1) (cnj \ \2))" +using assms prv_imp_mp imp_cnj_compat_eqvR by (meson eqv cnj) + +lemma cnj_compat_eqv: +assumes "\1 \ fmla" and "\2 \ fmla" and "\1 \ fmla" and "\2 \ fmla" +assumes "prv (eqv \1 \2)" and "prv (eqv \1 \2)" +shows "prv (eqv (cnj \1 \1) (cnj \2 \2))" + using assms prv_imp_mp imp_cnj_compat_eqv by (metis eqv imp cnj) + +lemma prv_eqv_prv: + assumes "\ \ fmla" and "\ \ fmla" + assumes "prv \" and "prv (eqv \ \)" + shows "prv \" + by (metis assms prv_imp_cnjL prv_imp_mp eqv eqv_def imp) + +lemma prv_eqv_prv_rev: + assumes "\ \ fmla" and "\ \ fmla" + assumes "prv \" and "prv (eqv \ \)" + shows "prv \" + using assms prv_eqv_prv prv_eqv_sym by blast + +lemma prv_imp_eqv_transi: +assumes "\ \ fmla" and "\1 \ fmla" and "\2 \ fmla" +assumes "prv (imp \ \1)" and "prv (eqv \1 \2)" +shows "prv (imp \ \2)" + by (meson assms imp imp_compat_eqvR prv_eqv_prv) + +lemma prv_imp_eqv_transi_rev: +assumes "\ \ fmla" and "\1 \ fmla" and "\2 \ fmla" +assumes "prv (imp \ \2)" and "prv (eqv \1 \2)" +shows "prv (imp \ \1)" + by (meson assms prv_eqv_sym prv_imp_eqv_transi) + +lemma prv_eqv_imp_transi: +assumes "\1 \ fmla" and "\2 \ fmla" and "\ \ fmla" +assumes "prv (eqv \1 \2)" and "prv (imp \2 \)" +shows "prv (imp \1 \)" + by (meson assms prv_imp_eqv_transi prv_imp_refl prv_prv_imp_trans) + +lemma prv_eqv_imp_transi_rev: +assumes "\1 \ fmla" and "\2 \ fmla" and "\ \ fmla" +assumes "prv (eqv \1 \2)" and "prv (imp \1 \)" +shows "prv (imp \2 \)" + by (meson assms prv_eqv_imp_transi prv_eqv_sym) + +lemma prv_imp_monoL: "\ \ fmla \ \ \ fmla \ \ \ fmla \ +prv (imp \ \) \ prv (imp (imp \ \) (imp \ \))" + by (meson imp prv_imp_mp prv_imp_trans1) + +lemma prv_imp_monoR: "\ \ fmla \ \ \ fmla \ \ \ fmla \ +prv (imp \ \) \ prv (imp (imp \ \) (imp \ \))" + by (meson imp prv_imp_mp prv_imp_trans2) + +text \More properties involving conjunction:\ + +lemma prv_cnj_com_imp: + assumes \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" + shows "prv (imp (cnj \ \) (cnj \ \))" + by (simp add: prv_imp_cnj prv_imp_cnjL prv_imp_cnjR) + +lemma prv_cnj_com: + assumes \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" + shows "prv (eqv (cnj \ \) (cnj \ \))" + by (simp add: prv_cnj_com_imp prv_eqvI) + +lemma prv_cnj_assoc_imp1: + assumes \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" + shows "prv (imp (cnj \ (cnj \ \)) (cnj (cnj \ \) \))" + by (simp add: prv_cnj_imp_monoR2 prv_imp_cnj prv_imp_cnjL prv_imp_cnjR prv_imp_triv) + +lemma prv_cnj_assoc_imp2: + assumes \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" + shows "prv (imp (cnj (cnj \ \) \) (cnj \ (cnj \ \)))" +proof - + have "prv (imp (cnj \ \) (imp \ \)) \ cnj \ \ \ fmla \ cnj \ \ \ fmla" + by (meson \ \ \ cnj imp prv_cnj_imp_monoR2 prv_imp_imp_triv prv_prv_imp_trans) + then show ?thesis + using \ \ \ cnj imp prv_cnj_imp_monoR2 prv_imp_cnj4 prv_imp_cnjI prv_imp_triv by presburger +qed + +lemma prv_cnj_assoc: + assumes \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" + shows "prv (eqv (cnj \ (cnj \ \)) (cnj (cnj \ \) \))" + by (simp add: prv_cnj_assoc_imp1 prv_cnj_assoc_imp2 prv_eqvI) + +lemma prv_cnj_com_imp3: + assumes "\1 \ fmla" "\2 \ fmla" "\3 \ fmla" + shows "prv (imp (cnj \1 (cnj \2 \3)) + (cnj \2 (cnj \1 \3)))" + by (simp add: assms prv_cnj_imp_monoR2 prv_imp_cnj prv_imp_cnjL prv_imp_refl prv_imp_triv) + + +subsection \Properties involving quantifiers\ + +text \Fundamental properties:\ + +lemma prv_allE: + assumes "x \ var" and "\ \ fmla" and "t \ trm" + shows "prv (all x \) \ prv (subst \ t x)" + using assms prv_all_inst prv_imp_mp by (meson subst all) + +lemma prv_exiI: + assumes "x \ var" and "\ \ fmla" and "t \ trm" + shows "prv (subst \ t x) \ prv (exi x \)" + using assms prv_exi_inst prv_imp_mp by (meson subst exi) + +lemma prv_imp_imp_exi: + assumes "x \ var" and "\ \ fmla" and "\ \ fmla" + assumes "x \ Fvars \" + shows "prv (imp (exi x (imp \ \)) (imp \ (exi x \)))" + using assms imp exi Fvars_exi Fvars_imp Un_iff assms prv_exi_imp_gen prv_exi_inst prv_imp_mp + prv_imp_trans1 member_remove remove_def subst_same_Var by (metis (full_types) Var) + +lemma prv_imp_exi: + assumes "x \ var" and "\ \ fmla" and "\ \ fmla" + shows "x \ Fvars \ \ prv (exi x (imp \ \)) \ prv (imp \ (exi x \))" + using assms prv_imp_imp_exi prv_imp_mp by (meson exi imp) + +lemma prv_exi_imp: + assumes x: "x \ var" and "\ \ fmla" and "\ \ fmla" + assumes "x \ Fvars \" and d: "prv (all x (imp \ \))" + shows "prv (imp (exi x \) \)" +proof- + have "prv (imp \ \)" using prv_allE[of x _ "Var x", of "imp \ \"] assms by simp + thus ?thesis using assms prv_exi_imp_gen by blast +qed + +lemma prv_all_imp: + assumes x: "x \ var" and "\ \ fmla" and "\ \ fmla" + assumes "x \ Fvars \" and "prv (all x (imp \ \))" + shows "prv (imp \ (all x \))" +proof- + have "prv (imp \ \)" using prv_allE[of x _ "Var x", of "imp \ \"] assms by simp + thus ?thesis using assms prv_all_imp_gen by blast +qed + +lemma prv_exi_inst_same: + assumes "\ \ fmla" "\ \ fmla" "x \ var" + shows "prv (imp \ (exi x \))" +proof- + have 0: "\ = subst \ (Var x) x" using assms by simp + show ?thesis + apply(subst 0) + using assms by (intro prv_exi_inst) auto +qed + +lemma prv_exi_cong: + assumes "\ \ fmla" "\ \ fmla" "x \ var" + and "prv (imp \ \)" + shows "prv (imp (exi x \) (exi x \))" +proof- + have 0: "prv (imp \ (exi x \))" using assms prv_exi_inst_same by auto + show ?thesis + using assms apply(intro prv_exi_imp_gen) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal using "0" exi prv_prv_imp_trans by blast . +qed + +lemma prv_exi_congW: + assumes "\ \ fmla" "\ \ fmla" "x \ var" + and "prv (imp \ \)" "prv (exi x \)" + shows "prv (exi x \)" + by (meson exi assms prv_exi_cong prv_imp_mp) + +lemma prv_all_cong: + assumes "\ \ fmla" "\ \ fmla" "x \ var" + and "prv (imp \ \)" + shows "prv (imp (all x \) (all x \))" +proof- + have 0: "prv (imp (all x \) \)" using assms + by (metis Var all prv_all_inst prv_prv_imp_trans subst_same_Var) + show ?thesis by (simp add: "0" assms prv_all_imp_gen) +qed + +lemma prv_all_congW: + assumes "\ \ fmla" "\ \ fmla" "x \ var" + and "prv (imp \ \)" "prv (all x \)" + shows "prv (all x \)" + by (meson all assms prv_all_cong prv_imp_mp) + + +text \Quantifiers versus free variables and substitution:\ + +lemma exists_no_Fvars: "\ \. \ \ fmla \ prv \ \ Fvars \ = {}" +proof- + obtain n where [simp]: "n \ num" using numNE by blast + show ?thesis + by (intro exI[of _ "imp (eql n n) (eql n n)"]) (simp add: prv_imp_refl) +qed + +lemma prv_all_gen: + assumes "x \ var" and "\ \ fmla" + assumes "prv \" shows "prv (all x \)" + using assms prv_all_imp_gen prv_imp_mp prv_imp_triv exists_no_Fvars by blast + +lemma all_subst_rename_prv: + "\ \ fmla \ x \ var \ y \ var \ + y \ Fvars \ \ prv (all x \) \ prv (all y (subst \ (Var y) x))" + by (simp add: prv_allE prv_all_gen) + +lemma allE_id: + assumes "y \ var" and "\ \ fmla" + assumes "prv (all y \)" + shows "prv \" + using assms prv_allE by (metis Var subst_same_Var) + +lemma prv_subst: + assumes "x \ var" and "\ \ fmla" and "t \ trm" + shows "prv \ \ prv (subst \ t x)" + by (simp add: assms prv_allE prv_all_gen) + +lemma prv_rawpsubst: + assumes "\ \ fmla" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + and "prv \" + shows "prv (rawpsubst \ txs)" + using assms apply (induct txs arbitrary: \) + subgoal by auto + subgoal for tx txs \ by (cases tx) (auto intro: prv_subst) . + +lemma prv_psubst: + assumes "\ \ fmla" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + and "prv \" + shows "prv (psubst \ txs)" +proof- + define us where us: "us \ getFrN (map snd txs) (map fst txs) [\] (length txs)" + have us_facts: "set us \ var" + "set us \ Fvars \ = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_FvarsT[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by auto + subgoal by (fastforce simp: image_iff) + by auto + show ?thesis using assms us_facts unfolding psubst_def + by (auto simp: Let_def us[symmetric] intro!: prv_rawpsubst rawpsubst dest!: set_zip_D) +qed + +lemma prv_eqv_rawpsubst: + "\ \ fmla \ \ \ fmla \ snd ` set txs \ var \ fst ` set txs \ trm \ prv (eqv \ \) \ + prv (eqv (rawpsubst \ txs) (rawpsubst \ txs))" + by (metis eqv prv_rawpsubst rawpsubst_eqv) + +lemma prv_eqv_psubst: + "\ \ fmla \ \ \ fmla \ snd ` set txs \ var \ fst ` set txs \ trm \ prv (eqv \ \) \ + distinct (map snd txs) \ + prv (eqv (psubst \ txs) (psubst \ txs))" + by (metis eqv prv_psubst psubst_eqv) + +lemma prv_all_imp_trans: + assumes "x \ var" and "\ \ fmla" and "\ \ fmla" and "\ \ fmla" + shows "prv (all x (imp \ \)) \ prv (all x (imp \ \)) \ prv (all x (imp \ \))" + by (metis Var assms prv_allE prv_all_gen prv_prv_imp_trans imp subst_same_Var) + +lemma prv_all_imp_cnj: + assumes "x \ var" and "\ \ fmla" and "\ \ fmla" and "\ \ fmla" + shows "prv (all x (imp \ (imp \ \))) \ prv (all x (imp (cnj \ \) \))" + by (metis Var assms cnj prv_allE prv_all_gen prv_imp_com prv_cnj_imp_monoR2 imp subst_same_Var) + +lemma prv_all_imp_cnj_rev: + assumes "x \ var" and "\ \ fmla" and "\ \ fmla" and "\ \ fmla" + shows "prv (all x (imp (cnj \ \) \)) \ prv (all x (imp \ (imp \ \)))" + by (metis (full_types) Var assms cnj prv_allE prv_all_gen prv_cnj_imp imp subst_same_Var) + + +subsection \Properties concerning equality\ + +lemma prv_eql_reflT: + assumes t: "t \ trm" + shows "prv (eql t t)" +proof- + obtain x where x: "x \ var" using var_NE by auto + show ?thesis using prv_subst[OF x _ t prv_eql_refl[OF x]] x t by simp +qed + +lemma prv_eql_subst_trm: + assumes xx: "x \ var" and \: "\ \ fmla" and "t1 \ trm" and "t2 \ trm" + shows "prv ((imp (eql t1 t2) + (imp (subst \ t1 x) (subst \ t2 x))))" +proof- + have "finite ({x} \ FvarsT t1 \ FvarsT t2 \ Fvars \)" (is "finite ?A") + by (simp add: assms finite_FvarsT finite_Fvars) + then obtain y where y: "y \ var" and "y \ ?A" + by (meson finite_subset infinite_var subset_iff) + hence xy: "x \ y" and yt1: "y \ FvarsT t1" and yt2: "y \ FvarsT t2" and y\: "y \ Fvars \" by auto + have x: "x \ Fvars (subst \ (Var y) x)" using xy y assms by simp + hence 1: "prv (imp (eql t1 (Var y)) (imp (subst \ t1 x) (subst \ (Var y) x)))" + using xy y assms prv_subst[OF xx _ _ prv_eql_subst[OF xx y \]] by simp + have yy: "y \ Fvars (subst \ t1 x)" using yt1 y\ assms by simp + from prv_subst[OF y _ _ 1, of t2] + show ?thesis using xy yt1 yt2 y\ x xx y yy assms by auto +qed + +lemma prv_eql_subst_trm2: + assumes "x \ var" and "\ \ fmla" and "t1 \ trm" and "t2 \ trm" + assumes "prv (eql t1 t2)" + shows "prv (imp (subst \ t1 x) (subst \ t2 x))" + by (meson assms eql imp local.subst prv_eql_subst_trm prv_imp_mp) + +lemma prv_eql_sym: + assumes [simp]: "t1 \ trm" "t2 \ trm" + shows "prv (imp (eql t1 t2) (eql t2 t1))" +proof- + obtain x where x[simp]: "x \ var" "x \ FvarsT t1" + by (meson assms finite_FvarsT finite_subset infinite_var subsetI) + thus ?thesis using prv_eql_subst_trm[of x "eql (Var x) t1" t1 t2, simplified] + by (meson assms eql imp prv_eql_reflT prv_imp_com prv_imp_mp) +qed + +lemma prv_prv_eql_sym: "t1 \ trm \ t2 \ trm \ prv (eql t1 t2) \ prv (eql t2 t1)" + by (meson eql prv_eql_sym prv_imp_mp) + +lemma prv_all_eql: + assumes "x \ var" and "y \ var" and "\ \ fmla" and "t1 \ trm" and "t2 \ trm" + shows "prv (all x ((imp (eql t1 t2) + (imp (subst \ t2 y) (subst \ t1 y)))))" + by (meson subst assms prv_all_gen prv_prv_imp_trans prv_eql_subst_trm prv_eql_sym eql imp) + +lemma prv_eql_subst_trm_rev: + assumes "t1 \ trm" and "t2 \ trm" and "\ \ fmla" and "y \ var" + shows + "prv ((imp (eql t1 t2) + (imp (subst \ t2 y) (subst \ t1 y))))" + using assms prv_all_eql prv_all_inst prv_imp_mp subst_same_Var + by (meson subst prv_prv_imp_trans prv_eql_subst_trm prv_eql_sym eql imp) + +lemma prv_eql_subst_trm_rev2: + assumes "x \ var" and "\ \ fmla" and "t1 \ trm" and "t2 \ trm" + assumes "prv (eql t1 t2)" + shows "prv (imp (subst \ t2 x) (subst \ t1 x))" + by (meson assms eql imp local.subst prv_eql_subst_trm_rev prv_imp_mp) + +lemma prv_eql_subst_trm_eqv: + assumes "x \ var" and "\ \ fmla" and "t1 \ trm" and "t2 \ trm" + assumes "prv (eql t1 t2)" + shows "prv (eqv (subst \ t1 x) (subst \ t2 x))" + using assms prv_eql_subst_trm2[OF assms] prv_eql_subst_trm_rev2[OF assms] + prv_eqvI by auto + +lemma prv_eql_subst_trm_id: + assumes "y \ var" "\ \ fmla" and "n \ num" + shows "prv (imp (eql (Var y) n) (imp \ (subst \ n y)))" + using assms prv_eql_subst_trm + by (metis Var in_num subst_same_Var) + +lemma prv_eql_subst_trm_id_back: + assumes "y \ var" "\ \ fmla" and "n \ num" + shows "prv (imp (eql (Var y) n) (imp (subst \ n y) \))" + by (metis Var assms in_num prv_eql_subst_trm_rev subst_same_Var) + +lemma prv_eql_subst_trm_id_rev: + assumes "y \ var" "\ \ fmla" and "n \ num" + shows "prv (imp (eql n (Var y)) (imp \ (subst \ n y)))" + using assms prv_eql_subst_trm_rev by (metis Var in_num subst_same_Var) + +lemma prv_eql_subst_trm_id_back_rev: + assumes "y \ var" "\ \ fmla" and "n \ num" + shows "prv (imp (eql n (Var y)) (imp (subst \ n y) \))" + by (metis (full_types) Var assms in_num prv_eql_subst_trm subst_same_Var) + +lemma prv_eql_imp_trans_rev: + assumes t1[simp]: "t1 \ trm" and t2[simp]: "t2 \ trm" and t3[simp]: "t3 \ trm" + shows "prv (imp (eql t1 t2) (imp (eql t1 t3) (eql t2 t3)))" +proof- + obtain y1 where y1[simp]: "y1 \ var" and "y1 \ FvarsT t1 \ FvarsT t2 \ FvarsT t3" + using finite_FvarsT finite_subset infinite_var subsetI t1 t2 t3 + by (metis (full_types) infinite_Un) + hence [simp]: "y1 \ FvarsT t1" "y1 \ FvarsT t2" "y1 \ FvarsT t3" by auto + obtain y2 where y2[simp]: "y2 \ var" and "y2 \ FvarsT t1 \ FvarsT t2 \ FvarsT t3 \ {y1}" + using finite_FvarsT finite_subset infinite_var subsetI t1 t2 t3 + by (metis (full_types) finite_insert infinite_Un insert_is_Un) + hence [simp]: "y2 \ FvarsT t1" "y2 \ FvarsT t2" "y2 \ FvarsT t3" "y1 \ y2" by auto + have 0: "prv (imp (eql (Var y1) (Var y2)) + (imp (eql (Var y1) t3) (eql (Var y2) t3)))" + using prv_eql_subst[OF y1 y2, of "eql (Var y1) t3"] by simp + note 1 = prv_subst[OF y1 _ t1 0, simplified] + show ?thesis using prv_subst[OF y2 _ t2 1, simplified] . +qed + +lemma prv_eql_imp_trans: + assumes t1[simp]: "t1 \ trm" and t2[simp]: "t2 \ trm" and t3[simp]: "t3 \ trm" + shows "prv (imp (eql t1 t2) (imp (eql t2 t3) (eql t1 t3)))" + by (meson eql imp prv_eql_sym prv_eql_imp_trans_rev prv_prv_imp_trans t1 t2 t3) + +lemma prv_eql_trans: + assumes t1[simp]: "t1 \ trm" and t2[simp]: "t2 \ trm" and t3[simp]: "t3 \ trm" + and "prv (eql t1 t2)" and "prv (eql t2 t3)" + shows "prv (eql t1 t3)" + by (meson assms cnj eql prv_cnjI prv_cnj_imp_monoR2 prv_eql_imp_trans prv_imp_mp) + + +subsection \The equivalence between soft substitution and substitution\ + +lemma prv_subst_imp_softSubst: + assumes [simp,intro!]: "x \ var" "t \ trm" "\ \ fmla" "x \ FvarsT t" + shows "prv (imp (subst \ t x) (softSubst \ t x))" + unfolding softSubst_def by (rule prv_imp_exi) + (auto simp: prv_eql_reflT prv_imp_cnj prv_imp_refl prv_imp_triv subst_compose_same + intro: prv_exiI[of _ _ t]) + +lemma prv_subst_implies_softSubst: + assumes "x \ var" "t \ trm" "\ \ fmla" + and "x \ FvarsT t" + and "prv (subst \ t x)" + shows "prv (softSubst \ t x)" + using assms prv_subst_imp_softSubst + by (metis Var cnj eql exi subst prv_imp_mp softSubst_def) + +lemma prv_softSubst_imp_subst: + assumes [simp,intro!]: "x \ var" "t \ trm" "\ \ fmla" "x \ FvarsT t" + shows "prv (imp (softSubst \ t x) (subst \ t x))" + unfolding softSubst_def apply(rule prv_exi_imp_gen) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by (metis Var assms(1-3) eql subst prv_cnj_imp_monoR2 prv_eql_subst_trm subst_same_Var) . + +lemma prv_softSubst_implies_subst: + assumes "x \ var" "t \ trm" "\ \ fmla" + and "x \ FvarsT t" + and "prv (softSubst \ t x)" + shows "prv (subst \ t x)" + by (metis Var assms cnj eql exi local.subst prv_imp_mp prv_softSubst_imp_subst softSubst_def) + +lemma prv_softSubst_eqv_subst: + assumes [simp,intro!]: "x \ var" "t \ trm" "\ \ fmla" "x \ FvarsT t" + shows "prv (eqv (softSubst \ t x) (subst \ t x))" + by (metis Var assms cnj eql exi local.subst prv_eqvI prv_softSubst_imp_subst prv_subst_imp_softSubst softSubst_def) + +end \ \context @{locale Deduct}\ + + +section \Deduction Considering False\ + +locale Deduct_with_False = + Syntax_with_Connectives_False + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + + + Deduct + var trm fmla Var FvarsT substT Fvars subst + num + eql cnj imp all exi + prv + for + var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" + and Var FvarsT substT Fvars subst + and eql cnj imp all exi + and fls + and num + and prv + + + assumes + prv_fls[simp,intro]: "\\. prv (imp fls \)" +begin + +subsection \Basic properties of False (fls)\ + +lemma prv_expl: + assumes "\ \ fmla" + assumes "prv fls" + shows "prv \" + using assms prv_imp_mp by blast + +lemma prv_cnjR_fls: "\ \ fmla \ prv (eqv (cnj fls \) fls)" + by (simp add: prv_eqvI prv_imp_cnjL) + +lemma prv_cnjL_fls: "\ \ fmla \ prv (eqv (cnj \ fls) fls)" + by (simp add: prv_eqvI prv_imp_cnjR) + + +subsection \Properties involving negation\ + +text \Recall that negation has been defined from implication and False.\ + +lemma prv_imp_neg_fls: + assumes "\ \ fmla" + shows "prv (imp \ (imp (neg \) fls))" + using assms prv_imp_com prv_imp_refl neg_def by auto + +lemma prv_neg_fls: + assumes "\ \ fmla" + assumes "prv \" and "prv (neg \)" + shows "prv fls" + by (metis assms prv_imp_mp fls neg_def) + +lemma prv_imp_neg_neg: + assumes "\ \ fmla" + shows "prv (imp \ (neg (neg \)))" + using assms prv_imp_neg_fls neg_def by auto + +lemma prv_neg_neg: + assumes "\ \ fmla" + assumes "prv \" + shows "prv (neg (neg \))" + by (metis assms prv_imp_mp prv_imp_neg_fls neg neg_def) + +lemma prv_imp_imp_neg_rev: + assumes "\ \ fmla" and "\ \ fmla" + shows "prv (imp (imp \ \) + (imp (neg \) (neg \)))" + unfolding neg_def using prv_imp_trans2[OF assms fls] . + +lemma prv_imp_neg_rev: + assumes "\ \ fmla" and "\ \ fmla" + assumes "prv (imp \ \)" + shows "prv (imp (neg \) (neg \))" + by (meson assms imp neg prv_imp_imp_neg_rev prv_imp_mp) + +lemma prv_eqv_neg_prv_fls: + "\ \ fmla \ +prv (eqv \ (neg \)) \ prv fls" + by (metis cnj fls neg neg_def prv_cnj_imp_monoR2 prv_eqv_imp_transi prv_imp_cnj prv_imp_eqvER prv_imp_mp prv_imp_neg_rev) + +lemma prv_eqv_eqv_neg_prv_fls: + "\ \ fmla \ \ \ fmla \ +prv (eqv \ \) \ prv (eqv \ (neg \))\ prv fls" + by (meson neg prv_eqv_neg_prv_fls prv_eqv_sym prv_eqv_trans) + +lemma prv_eqv_eqv_neg_prv_fls2: + "\ \ fmla \ \ \ fmla \ +prv (eqv \ \) \ prv (eqv \ (neg \))\ prv fls" + by (simp add: prv_eqv_eqv_neg_prv_fls prv_eqv_sym) + +lemma prv_neg_imp_imp_trans: + assumes "\ \ fmla" "\ \ fmla" "\ \ fmla" + and "prv (neg \)" + and "prv (imp \ (imp \ \))" + shows "prv (imp \ (neg \))" + unfolding neg_def + by (metis assms cnj fls neg_def prv_cnj_imp prv_cnj_imp_monoR2 prv_prv_imp_trans) + +lemma prv_imp_neg_imp_neg_imp: + assumes "\ \ fmla" "\ \ fmla" + and "prv (neg \)" + shows "prv ((imp \ (neg (imp \ \))))" + by (metis assms fls imp neg_def prv_imp_com prv_imp_monoL) + +lemma prv_prv_neg_imp_neg: + assumes "\ \ fmla" "\ \ fmla" + and "prv \" and "prv \" + shows "prv (neg (imp \ (neg \)))" + by (meson assms imp neg prv_imp_mp prv_imp_neg_imp_neg_imp prv_neg_neg) + +lemma prv_imp_neg_imp_cnjL: + assumes "\ \ fmla" "\1 \ fmla" "\2 \ fmla" + and "prv (imp \ (neg \1))" + shows "prv (imp \ (neg (cnj \1 \2)))" + unfolding neg_def by (metis assms cnj fls neg neg_def prv_imp_cnj3L prv_prv_imp_trans) + +lemma prv_imp_neg_imp_cnjR: + assumes "\ \ fmla" "\1 \ fmla" "\2 \ fmla" + and "prv (imp \ (neg \2))" + shows "prv (imp \ (neg (cnj \1 \2)))" + unfolding neg_def by (metis assms cnj fls neg neg_def prv_imp_cnj3R prv_prv_imp_trans) + +text \Negation versus quantifiers:\ + +lemma prv_all_neg_imp_neg_exi: + assumes x: "x \ var" and \: "\ \ fmla" + shows "prv (imp (all x (neg \)) (neg (exi x \)))" +proof- + have 0: "prv (imp (all x (neg \)) (imp \ fls))" + using prv_all_inst[OF x, of "neg \" "Var x",simplified] assms by (auto simp: neg_def) + have 1: "prv (imp \ (imp (all x (neg \)) fls))" + using 0 by (simp add: assms prv_imp_com) + have 2: "prv (imp (exi x \) (imp (all x (neg \)) fls))" + using 1 assms by (intro prv_exi_imp_gen) auto + thus ?thesis by (simp add: assms neg_def prv_imp_com) +qed + +lemma prv_neg_exi_imp_all_neg: + assumes x: "x \ var" and \: "\ \ fmla" + shows "prv (imp (neg (exi x \)) (all x (neg \)))" + using assms + by (intro prv_all_imp_gen[of x "neg (exi x \)"]) + (auto simp: prv_exi_inst_same prv_imp_neg_rev) + +lemma prv_neg_exi_eqv_all_neg: + assumes x: "x \ var" and \: "\ \ fmla" + shows "prv (eqv (neg (exi x \)) (all x (neg \)))" + by (simp add: \ prv_all_neg_imp_neg_exi prv_eqvI prv_neg_exi_imp_all_neg x) + +lemma prv_neg_exi_implies_all_neg: + assumes x: "x \ var" and \: "\ \ fmla" and "prv (neg (exi x \))" + shows "prv (all x (neg \))" + by (meson \ all assms(3) exi neg prv_imp_mp prv_neg_exi_imp_all_neg x) + +lemma prv_neg_neg_exi: + assumes "x \ var" "\ \ fmla" + and "prv (neg \)" + shows "prv (neg (exi x \))" + using assms neg_def prv_exi_imp_gen by auto + +lemma prv_exi_imp_exiI: + assumes [simp]: "x \ var" "y \ var" "\ \ fmla" and yx: "y = x \ y \ Fvars \" + shows "prv (imp (exi x \) (exi y (subst \ (Var y) x)))" +proof(cases "y = x") + case [simp]: False hence [simp]: "x \ y" by blast + show ?thesis apply(rule prv_exi_imp_gen) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + using yx + by (auto intro!: prv_imp_exi prv_exiI[of _ _ "Var x"] + simp: prv_imp_refl2) +qed(simp add: yx prv_imp_refl) + +lemma prv_imp_neg_allI: + assumes "\ \ fmla" "\ \ fmla" "t \ trm" "x \ var" + and "prv (imp \ (neg (subst \ t x)))" + shows "prv (imp \ (neg (all x \)))" + by (meson all assms subst neg prv_all_inst prv_imp_neg_rev prv_prv_imp_trans) + +lemma prv_imp_neg_allWI: + assumes "\ \ fmla" "t \ trm" "x \ var" + and "prv (neg (subst \ t x))" + shows "prv (neg (all x \))" + by (metis all assms fls subst neg_def prv_all_inst prv_prv_imp_trans) + + +subsection \Properties involving True (tru)\ + +lemma prv_imp_tru: "\ \ fmla \ prv (imp \ tru)" + by (simp add: neg_def prv_imp_triv tru_def) + +lemma prv_tru_imp: "\ \ fmla \ prv (eqv (imp tru \) \)" + by (metis imp neg_def prv_eqvI prv_fls prv_imp_com prv_imp_imp_triv prv_imp_mp prv_imp_refl tru tru_def) + +lemma prv_fls_neg_tru: "\ \ fmla \ prv (eqv fls (neg tru))" + using neg_def prv_eqvI prv_neg_neg tru_def by auto + +lemma prv_tru_neg_fls: "\ \ fmla \ prv (eqv tru (neg fls))" + by (simp add: prv_eqv_refl tru_def) + +lemma prv_cnjR_tru: "\ \ fmla \ prv (eqv (cnj tru \) \)" + by (simp add: prv_eqvI prv_imp_cnj prv_imp_cnjR prv_imp_refl prv_imp_tru) + +lemma prv_cnjL_tru: "\ \ fmla \ prv (eqv (cnj \ tru) \)" + by (simp add: prv_eqvI prv_imp_cnj prv_imp_cnjL prv_imp_refl prv_imp_tru) + + +subsection \Property of set-based conjunctions\ + +text \These are based on properties of the auxiliary list conjunctions.\ + +lemma prv_lcnj_imp_in: + assumes "set \s \ fmla" + and "\ \ set \s" + shows "prv (imp (lcnj \s) \)" +proof- + have "\ \ fmla" using assms by auto + thus ?thesis using assms + by (induct \s arbitrary: \) + (auto simp : prv_imp_cnjL prv_cnj_imp_monoR2 prv_imp_triv) +qed + +lemma prv_lcnj_imp: + assumes "\ \ fmla" and "set \s \ fmla" + and "\ \ set \s" and "prv (imp \ \)" + shows "prv (imp (lcnj \s) \)" + using assms lcnj prv_lcnj_imp_in prv_prv_imp_trans by blast + +lemma prv_imp_lcnj: + assumes "\ \ fmla" and "set \s \ fmla" + and "\\. \ \ set \s \ prv (imp \ \)" + shows "prv (imp \ (lcnj \s))" + using assms + by (induct \s arbitrary: \) (auto simp: prv_imp_tru prv_imp_com prv_imp_cnj) + +lemma prv_lcnj_imp_inner: + assumes "\ \ fmla" "set \1s \ fmla" "set \2s \ fmla" + shows "prv (imp (cnj \ (lcnj (\1s @ \2s))) (lcnj (\1s @ \ # \2s)))" + using assms proof(induction \1s) + case (Cons \1 \1s) + have [intro!]: "set (\1s @ \2s) \ fmla" "set (\1s @ \ # \2s) \ fmla" using Cons by auto + have 0: "prv (imp (cnj \ (cnj \1 (lcnj (\1s @ \2s)))) + (cnj \1 (cnj \ (lcnj (\1s @ \2s)))))" + using Cons by (intro prv_cnj_com_imp3) fastforce+ + have 1: "prv (imp (cnj \1 (cnj \ (lcnj (\1s @ \2s)))) + (cnj \1 (lcnj (\1s @ \ # \2s))))" + using Cons by (intro prv_cnj_mono) (auto simp add: prv_imp_refl) + show ?case using prv_prv_imp_trans[OF _ _ _ 0 1] Cons by auto +qed(simp add: prv_imp_refl) + +lemma prv_lcnj_imp_remdups: + assumes "set \s \ fmla" + shows "prv (imp (lcnj (remdups \s)) (lcnj \s))" + using assms apply(induct \s) + by (auto simp: prv_imp_cnj prv_lcnj_imp_in prv_cnj_mono prv_imp_refl) + +lemma prv_lcnj_mono: + assumes \1s: "set \1s \ fmla" and "set \2s \ set \1s" + shows "prv (imp (lcnj \1s) (lcnj \2s))" +proof- + define \2s' where \2s': "\2s' = remdups \2s" + have A: "set \2s' \ set \1s" "distinct \2s'" unfolding \2s' using assms by auto + have B: "prv (imp (lcnj \1s) (lcnj \2s'))" + using \1s A proof(induction \1s arbitrary: \2s') + case (Cons \1 \1s \2ss) + show ?case proof(cases "\1 \ set \2ss") + case True + then obtain \2ss1 \2ss2 where \2ss: "\2ss = \2ss1 @ \1 # \2ss2" + by (meson split_list) + define \2s where \2s: "\2s \ \2ss1 @ \2ss2" + have nin: "\1 \ set \2s" using \2ss `distinct \2ss` unfolding \2s by auto + have [intro!]: "set \2s \ fmla" unfolding \2s using \2ss Cons by auto + have 0: "prv (imp (cnj \1 (lcnj \2s)) (lcnj \2ss))" + unfolding \2s \2ss using Cons \2ss + by (intro prv_lcnj_imp_inner) auto + have 1: "prv (imp (lcnj \1s) (lcnj \2s))" + using nin Cons.prems True \2s \2ss by (intro Cons.IH) auto + have 2: "prv (imp (cnj \1 (lcnj \1s)) (cnj \1 (lcnj \2s)))" + using Cons \2ss \2s 1 by (intro prv_cnj_mono) (fastforce simp add: prv_imp_refl)+ + show ?thesis + using Cons by (auto intro!: prv_prv_imp_trans[OF _ _ _ 2 0]) + next + case False + then show ?thesis + by (meson Cons lcnj prv_imp_lcnj prv_lcnj_imp_in subset_iff) + qed + qed(simp add: prv_imp_refl) + have C: "prv (imp (lcnj \2s') (lcnj \2s))" + unfolding \2s' using assms by (intro prv_lcnj_imp_remdups) auto + show ?thesis using A assms by (intro prv_prv_imp_trans[OF _ _ _ B C]) auto +qed + +lemma prv_lcnj_eqv: + assumes "set \1s \ fmla" and "set \2s = set \1s" + shows "prv (eqv (lcnj \1s) (lcnj \2s))" + using assms prv_lcnj_mono by (intro prv_eqvI) auto + +lemma prv_lcnj_mono_imp: + assumes "set \1s \ fmla" "set \2s \ fmla" and "\ \2 \ set \2s. \ \1 \ set \1s. prv (imp \1 \2)" + shows "prv (imp (lcnj \1s) (lcnj \2s))" + using assms apply(intro prv_imp_lcnj) + subgoal by auto + subgoal by auto + subgoal using prv_lcnj_imp by blast . + +text \Set-based conjunction commutes with substitution only up to provably equivalence:\ +lemma prv_subst_scnj: + assumes "F \ fmla" "finite F" "t \ trm" "x \ var" + shows "prv (eqv (subst (scnj F) t x) (scnj ((\\. subst \ t x) ` F)))" + using assms unfolding scnj_def by (fastforce intro!: prv_lcnj_eqv) + +lemma prv_imp_subst_scnj: + assumes "F \ fmla" "finite F" "t \ trm" "x \ var" + shows "prv (imp (subst (scnj F) t x) (scnj ((\\. subst \ t x) ` F)))" + using prv_subst_scnj[OF assms] assms by (intro prv_imp_eqvEL) auto + +lemma prv_subst_scnj_imp: + assumes "F \ fmla" "finite F" "t \ trm" "x \ var" + shows "prv (imp (scnj ((\\. subst \ t x) ` F)) (subst (scnj F) t x))" + using prv_subst_scnj[OF assms] assms by (intro prv_imp_eqvER) auto + +lemma prv_scnj_imp_in: + assumes "F \ fmla" "finite F" + and "\ \ F" + shows "prv (imp (scnj F) \)" + unfolding scnj_def using assms by (intro prv_lcnj_imp_in) auto + +lemma prv_scnj_imp: + assumes "\ \ fmla" and "F \ fmla" "finite F" + and "\ \ F" and "prv (imp \ \)" + shows "prv (imp (scnj F) \)" + unfolding scnj_def using assms by (intro prv_lcnj_imp) auto + +lemma prv_imp_scnj: + assumes "\ \ fmla" and "F \ fmla" "finite F" + and "\\. \ \ F \ prv (imp \ \)" + shows "prv (imp \ (scnj F))" + unfolding scnj_def using assms by (intro prv_imp_lcnj) auto + +lemma prv_scnj_mono: + assumes "F1 \ fmla" and "F2 \ F1" and "finite F1" + shows "prv (imp (scnj F1) (scnj F2))" + unfolding scnj_def using assms apply (intro prv_lcnj_mono) + subgoal by auto + subgoal by (metis asList infinite_super) . + +lemma prv_scnj_mono_imp: + assumes "F1 \ fmla" "F2 \ fmla" "finite F1" "finite F2" + and "\ \2 \ F2. \ \1 \ F1. prv (imp \1 \2)" + shows "prv (imp (scnj F1) (scnj F2))" + unfolding scnj_def using assms by (intro prv_lcnj_mono_imp) auto + +text \Commutation with parallel substitution:\ + +lemma prv_imp_scnj_insert: + assumes "F \ fmla" and "finite F" and "\ \ fmla" + shows "prv (imp (scnj (insert \ F)) (cnj \ (scnj F)))" + using assms apply (intro prv_imp_cnj) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by (auto intro: prv_imp_refl prv_scnj_imp) + subgoal by (auto intro: prv_scnj_mono) . + +lemma prv_implies_scnj_insert: + assumes "F \ fmla" and "finite F" and "\ \ fmla" + and "prv (scnj (insert \ F))" + shows "prv (cnj \ (scnj F))" + by (meson assms cnj finite.insertI insert_subset prv_imp_mp prv_imp_scnj_insert scnj) + +lemma prv_imp_cnj_scnj: + assumes "F \ fmla" and "finite F" and "\ \ fmla" + shows "prv (imp (cnj \ (scnj F)) (scnj (insert \ F)))" + using assms + by (auto intro!: prv_imp_scnj prv_imp_cnjL + simp: prv_cnj_imp_monoR2 prv_imp_triv prv_scnj_imp_in subset_iff) + +lemma prv_implies_cnj_scnj: + assumes "F \ fmla" and "finite F" and "\ \ fmla" + and "prv (cnj \ (scnj F))" + shows "prv (scnj (insert \ F))" + by (meson assms cnj finite.insertI insert_subset prv_imp_cnj_scnj prv_imp_mp scnj) + +lemma prv_eqv_scnj_insert: + assumes "F \ fmla" and "finite F" and "\ \ fmla" + shows "prv (eqv (scnj (insert \ F)) (cnj \ (scnj F)))" + by (simp add: assms prv_eqvI prv_imp_cnj_scnj prv_imp_scnj_insert) + +lemma prv_scnj1_imp: + "\ \ fmla \ prv (imp (scnj {\}) \)" + using prv_scnj_imp_in by auto + +lemma prv_imp_scnj1: + "\ \ fmla \ prv (imp \ (scnj {\}))" + using prv_imp_refl prv_imp_scnj by fastforce + +lemma prv_scnj2_imp_cnj: + "\ \ fmla \ \ \ fmla \ prv (imp (scnj {\,\}) (cnj \ \))" + using prv_imp_cnj prv_scnj_imp_in by auto + +lemma prv_cnj_imp_scnj2: + "\ \ fmla \ \ \ fmla \ prv (imp (cnj \ \) (scnj {\,\}))" + using prv_imp_cnjL prv_imp_cnjR prv_imp_scnj by fastforce + +lemma prv_imp_imp_scnj2: + "\ \ fmla \ \ \ fmla \ prv (imp \ (imp \ (scnj {\,\})))" + using prv_cnj_imp_scnj2 prv_cnj_imp by auto + +(* *) + +lemma prv_rawpsubst_scnj: + assumes "F \ fmla" "finite F" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + shows "prv (eqv (rawpsubst (scnj F) txs) (scnj ((\\. rawpsubst \ txs) ` F)))" + using assms proof(induction txs arbitrary: F) + case (Cons tx txs) + then obtain t x where tx[simp]: "tx = (t,x)" by (cases tx) auto + hence [simp]: "t \ trm" "x \ var" using Cons.prems by auto + have 0: "(\\. rawpsubst (subst \ t x) txs) ` F = + (\\. rawpsubst \ txs) ` ((\\. subst \ t x) ` F)" + using Cons.prems by auto + have "prv (eqv (subst (scnj F) t x) + (scnj ((\\. subst \ t x) ` F)))" + using Cons.prems by (intro prv_subst_scnj) auto + hence "prv (eqv (rawpsubst (subst (scnj F) t x) txs) + (rawpsubst (scnj ((\\. subst \ t x) ` F)) txs))" + using Cons.prems by (intro prv_eqv_rawpsubst) auto + moreover + have "prv (eqv (rawpsubst (scnj ((\\. subst \ t x) ` F)) txs) + (scnj ((\\. rawpsubst (subst \ t x) txs) ` F)))" + unfolding 0 using Cons.prems by (intro Cons.IH) auto + ultimately show ?case + using Cons.prems apply - by (rule prv_eqv_trans) (auto intro!: rawpsubst) +qed(auto simp: image_def prv_eqv_refl)[] + +lemma prv_psubst_scnj: + assumes "F \ fmla" "finite F" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "distinct (map snd txs)" + shows "prv (eqv (psubst (scnj F) txs) (scnj ((\\. psubst \ txs) ` F)))" +proof- + define us where us: "us \ getFrN (map snd txs) (map fst txs) [scnj F] (length txs)" + have us_facts: "set us \ var" + "set us \ \ (Fvars ` F) = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_Fvars[of "map snd txs" "map fst txs" "[scnj F]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[scnj F]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[scnj F]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[scnj F]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + by auto + + define vs where vs: "vs \ \ \. getFrN (map snd txs) (map fst txs) [\] (length txs)" + hence vss: "\\. vs \ = getFrN (map snd txs) (map fst txs) [\] (length txs)" by auto + {fix \ assume "\ \ F" hence "\ \ fmla" using assms by auto + hence "set (vs \) \ var \ + set (vs \) \ Fvars \ = {} \ + set (vs \) \ \ (FvarsT ` (fst ` (set txs))) = {} \ + set (vs \) \ snd ` (set txs) = {} \ + length (vs \) = length txs \ + distinct (vs \)" + using assms unfolding vs + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + apply (intro conjI) + subgoal by auto + subgoal by auto + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + by auto + } note vs_facts = this + + have [simp]: "\ x f. f \ F \ x \ set (vs f) \ x \ var" + using vs_facts + by (meson subsetD) + + let ?tus = "zip (map fst txs) us" + let ?uxs = "zip (map Var us) (map snd txs)" + let ?tvs = "\ \. zip (map fst txs) (vs \)" + let ?vxs = "\ \. zip (map Var (vs \)) (map snd txs)" + + let ?c = "rawpsubst (scnj F) ?uxs" + have c: "prv (eqv ?c + (scnj ((\\. rawpsubst \ ?uxs) ` F)))" + using assms us_facts by (intro prv_rawpsubst_scnj) (auto intro!: rawpsubstT dest!: set_zip_D) + hence "prv (eqv (rawpsubst ?c ?tus) + (rawpsubst (scnj ((\\. rawpsubst \ ?uxs) ` F)) ?tus))" + using assms us_facts + by (intro prv_eqv_rawpsubst) (auto intro!: rawpsubst dest!: set_zip_D) + moreover + have "prv (eqv (rawpsubst (scnj ((\\. rawpsubst \ ?uxs) ` F)) ?tus) + (scnj ((\\. rawpsubst \ ?tus) ` ((\\. rawpsubst \ ?uxs) ` F))))" + using assms us_facts + by (intro prv_rawpsubst_scnj) (auto intro!: rawpsubst dest!: set_zip_D) + ultimately + have 0: "prv (eqv (rawpsubst ?c ?tus) + (scnj ((\\. rawpsubst \ ?tus) ` ((\\. rawpsubst \ ?uxs) ` F))))" + using assms us_facts apply - by (rule prv_eqv_trans) (auto intro!: rawpsubst dest!: set_zip_D) + moreover + have "prv (eqv (scnj ((\\. rawpsubst \ ?tus) ` ((\\. rawpsubst \ ?uxs) ` F))) + (scnj ((\\. rawpsubst (rawpsubst \ (?vxs \)) (?tvs \)) ` F)))" + using assms us_facts vs_facts apply(intro prv_eqvI) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal apply(rule prv_scnj_mono_imp) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by auto + subgoal by auto + subgoal apply clarsimp + subgoal for \ apply(rule bexI[of _ \]) apply(rule prv_imp_refl2) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (rule rawpsubst_compose_freshVar2) + (auto intro!: rawpsubst dest!: set_zip_D) . . . + subgoal apply(rule prv_scnj_mono_imp) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal apply clarsimp + subgoal for \ apply(rule bexI[of _ \]) apply(rule prv_imp_refl2) + apply (auto intro!: rawpsubst dest!: set_zip_D) + apply(rule rawpsubst_compose_freshVar2) + apply (auto intro!: rawpsubst dest!: set_zip_D) . . . . + ultimately + have "prv (eqv (rawpsubst (rawpsubst (scnj F) ?uxs) ?tus) + (scnj ((\\. rawpsubst (rawpsubst \ (?vxs \)) (?tvs \)) ` F)))" + using assms us_facts + apply - by (rule prv_eqv_trans) (auto intro!: rawpsubst dest!: set_zip_D) + thus ?thesis unfolding psubst_def by (simp add: Let_def us[symmetric] vss) +qed + +lemma prv_imp_psubst_scnj: + assumes "F \ fmla" "finite F" "snd ` set txs \ var" "fst ` set txs \ trm" + and "distinct (map snd txs)" + shows "prv (imp (psubst (scnj F) txs) (scnj ((\\. psubst \ txs) ` F)))" + using prv_psubst_scnj[OF assms] assms apply(intro prv_imp_eqvEL) by auto + +lemma prv_psubst_scnj_imp: + assumes "F \ fmla" "finite F" "snd ` set txs \ var" "fst ` set txs \ trm" + and "distinct (map snd txs)" + shows "prv (imp (scnj ((\\. psubst \ txs) ` F)) (psubst (scnj F) txs))" + using prv_psubst_scnj[OF assms] assms apply(intro prv_imp_eqvER) by auto + +subsection \Consistency and $\omega$-consistency\ + +definition consistent :: bool where + "consistent \ \ prv fls" + +lemma consistent_def2: "consistent \ (\\ \ fmla. \ prv \)" + unfolding consistent_def using prv_expl by blast + +lemma consistent_def3: "consistent \ (\\ \ fmla. \ (prv \ \ prv (neg \)))" + unfolding consistent_def using prv_neg_fls neg_def by auto + +(* Omega-consistency: *) +definition \consistent :: bool where + "\consistent \ + \ \ \ fmla. \ x \ var. Fvars \ = {x} \ + (\ n \ num. prv (neg (subst \ n x))) + \ + \ prv (neg (neg (exi x \)))" + +text \The above particularly strong version of @{term \consistent} is used for the sake of working without +assuming classical logic. It of course implies the more standard formulations for classical logic:\ + +definition \consistentStd1 :: bool where + "\consistentStd1 \ + \ \ \ fmla. \ x \ var. Fvars \ = {x} \ + (\ n \ num. prv (neg (subst \ n x))) \ \ prv (exi x \)" + +definition \consistentStd2 :: bool where + "\consistentStd2 \ + \ \ \ fmla. \ x \ var. Fvars \ = {x} \ + (\ n \ num. prv (subst \ n x)) \ \ prv (exi x (neg \))" + +lemma \consistent_impliesStd1: + "\consistent \ + \consistentStd1" + unfolding \consistent_def \consistentStd1_def using prv_neg_neg by blast + +lemma \consistent_impliesStd2: + "\consistent \ + \consistentStd2" + by (auto dest!: \consistent_impliesStd1 bspec[of _ _ "neg _"] + simp: \consistentStd1_def \consistentStd2_def prv_neg_neg) + +text \In the presence of classical logic deduction, the stronger condition is +equivalent to the standard ones:\ + +lemma \consistent_iffStd1: + assumes "\ \. \ \ fmla \ prv (imp (neg (neg \)) \)" + shows "\consistent \ \consistentStd1" + apply standard + subgoal using \consistent_impliesStd1 by auto + subgoal unfolding \consistentStd1_def \consistent_def + by (meson assms exi neg prv_imp_mp) . + +lemma \consistent_iffStd2: + assumes "\ \. \ \ fmla \ prv (imp (neg (neg \)) \)" + shows "\consistent \ \consistentStd2" + unfolding \consistent_iffStd1[OF assms, simplified] + \consistentStd1_def \consistentStd2_def apply safe + subgoal for \ x + by (auto simp: prv_neg_neg dest: bspec[of _ _ "neg _"]) + subgoal for \ x + using prv_exi_congW prv_imp_neg_fls + by (auto simp: neg_def prv_neg_neg dest!: bspec[of _ _ "neg _"]) . + +text \$\omega$-consistency implies consistency:\ + +lemma \consistentStd1_implies_consistent: + assumes "\consistentStd1" + shows "consistent" + unfolding consistent_def +proof safe + assume pf: "prv fls" + then obtain x where x: "x \ var" "x \ Fvars fls" + using finite_Fvars getFresh by auto + let ?fls = "cnj (fls) (eql (Var x) (Var x))" + have 0: "\ n \ num. prv (neg (subst ?fls n x))" and 1: "prv (exi x fls)" + using x fls by (auto simp: pf prv_expl) + have 2: "\ prv (exi x ?fls)" using 0 fls x assms + unfolding \consistentStd1_def by simp + show False using 1 2 consistent_def consistent_def2 pf x(1) by blast +qed + +lemma \consistentStd2_implies_consistent: + assumes "\consistentStd2" + shows "consistent" + unfolding consistent_def +proof safe + assume pf: "prv fls" + then obtain x where x: "x \ var" "x \ Fvars fls" + using finite_Fvars getFresh by auto + let ?fls = "cnj (fls) (eql (Var x) (Var x))" + have 0: "\ n \ num. prv (subst ?fls n x)" and 1: "prv (exi x (neg ?fls))" + using x fls by (auto simp: pf prv_expl) + have 2: "\ prv (exi x (neg ?fls))" using 0 fls x assms + unfolding \consistentStd2_def by auto + show False using 1 2 by simp +qed + +corollary \consistent_implies_consistent: + assumes "\consistent" + shows "consistent" + by (simp add: \consistentStd2_implies_consistent \consistent_impliesStd2 assms) + +end \ \context @{locale Deduct_with_False}\ + + +section \Deduction Considering False and Disjunction\ + +locale Deduct_with_False_Disj = + Syntax_with_Connectives_False_Disj + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + + + Deduct_with_False + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + num + prv + for + var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" + and Var FvarsT substT Fvars subst + and eql cnj imp all exi + and fls + and dsj + and num + and prv + + + assumes + prv_dsj_impL: + "\ \ \. \ \ fmla \ \ \ fmla \ + prv (imp \ (dsj \ \))" + and + prv_dsj_impR: + "\ \ \. \ \ fmla \ \ \ fmla \ + prv (imp \ (dsj \ \))" + and + prv_imp_dsjE: + "\ \ \ \. \ \ fmla \ \ \ fmla \ \ \ fmla \ + prv (imp (imp \ \) (imp (imp \ \) (imp (dsj \ \) \)))" +begin + +lemma prv_imp_dsjEE: + assumes \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" + assumes " prv (imp \ \)" and "prv (imp \ \)" + shows "prv (imp (dsj \ \) \)" + by (metis assms dsj imp prv_imp_dsjE prv_imp_mp) + +lemma prv_dsj_cases: + assumes "\1 \ fmla" "\2 \ fmla" "\ \ fmla" + and "prv (dsj \1 \2)" and "prv (imp \1 \)" and "prv (imp \2 \)" + shows "prv \" + by (meson assms dsj prv_imp_dsjEE prv_imp_mp) + + +subsection \Disjunction vs. disjunction\ + +lemma prv_dsj_com_imp: + assumes \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" + shows "prv (imp (dsj \ \) (dsj \ \))" + by (metis \ \ dsj imp prv_dsj_impL prv_dsj_impR prv_imp_dsjE prv_imp_mp) + +lemma prv_dsj_com: + assumes \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" + shows "prv (eqv (dsj \ \) (dsj \ \))" + by (simp add: prv_dsj_com_imp prv_eqvI) + +lemma prv_dsj_assoc_imp1: + assumes \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" + shows "prv (imp (dsj \ (dsj \ \)) (dsj (dsj \ \) \))" +proof - + have f1: "\f fa fb. f \ fmla \ \ prv (imp fa fb) \ fb \ fmla \ fa \ fmla \ prv (imp fa (dsj fb f))" + by (meson dsj prv_dsj_impL prv_prv_imp_trans) + have "prv (imp \ (dsj \ \))" + by (simp add: prv_dsj_impL) + then show ?thesis + using f1 \ \ \ dsj prv_dsj_impR prv_imp_dsjEE by presburger +qed + +lemma prv_dsj_assoc_imp2: + assumes \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" + shows "prv (imp (dsj (dsj \ \) \) (dsj \ (dsj \ \)))" +proof - + have f1: "\f fa fb. (((prv (imp f (dsj fa fb)) \ \ prv (imp f (dsj fb fa))) \ f \ fmla) \ fa \ fmla) \ fb \ fmla" + by (meson dsj prv_dsj_com_imp prv_prv_imp_trans) + have "\f fa fb. (((prv (imp f (dsj fa fb)) \ \ prv (imp f fa)) \ fa \ fmla) \ f \ fmla) \ fb \ fmla" + by (meson dsj prv_dsj_impL prv_prv_imp_trans) + then show ?thesis + using f1 by (metis \ \ \ dsj prv_dsj_impR prv_imp_dsjEE) +qed + +lemma prv_dsj_assoc: + assumes \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" and \[simp]: "\ \ fmla" + shows "prv (eqv (dsj \ (dsj \ \)) (dsj (dsj \ \) \))" + by (simp add: prv_dsj_assoc_imp1 prv_dsj_assoc_imp2 prv_eqvI) + +lemma prv_dsj_com_imp3: +assumes "\1 \ fmla" "\2 \ fmla" "\3 \ fmla" +shows "prv (imp (dsj \1 (dsj \2 \3)) + (dsj \2 (dsj \1 \3)))" +proof - + have "\f fa fb. (((prv (imp f (dsj fb fa)) \ \ prv (imp f fa)) \ fa \ fmla) \ f \ fmla) \ fb \ fmla" + by (meson dsj prv_dsj_impR prv_prv_imp_trans) + then show ?thesis + by (meson assms(1) assms(2) assms(3) dsj prv_dsj_impL prv_dsj_impR prv_imp_dsjEE) +qed + +lemma prv_dsj_mono: +"\1 \ fmla \ \2 \ fmla \ \1 \ fmla \ \2 \ fmla \ +prv (imp \1 \1) \ prv (imp \2 \2) \ prv (imp (dsj \1 \2) (dsj \1 \2))" + by (meson dsj prv_dsj_impL prv_dsj_impR prv_imp_dsjEE prv_prv_imp_trans) + + +subsection \Disjunction vs. conjunction\ + +lemma prv_cnj_dsj_distrib1: + assumes \[simp]: "\ \ fmla" and \1[simp]: "\1 \ fmla" and \2[simp]: "\2 \ fmla" + shows "prv (imp (cnj \ (dsj \1 \2)) (dsj (cnj \ \1) (cnj \ \2)))" + by (simp add: prv_cnj_imp prv_cnj_imp_monoR2 prv_dsj_impL prv_dsj_impR prv_imp_com prv_imp_dsjEE) + +lemma prv_cnj_dsj_distrib2: + assumes \[simp]: "\ \ fmla" and \1[simp]: "\1 \ fmla" and \2[simp]: "\2 \ fmla" + shows "prv (imp (dsj (cnj \ \1) (cnj \ \2)) (cnj \ (dsj \1 \2)))" + by (simp add: prv_cnj_mono prv_dsj_impL prv_dsj_impR prv_imp_dsjEE prv_imp_refl) + +lemma prv_cnj_dsj_distrib: + assumes \[simp]: "\ \ fmla" and \1[simp]: "\1 \ fmla" and \2[simp]: "\2 \ fmla" + shows "prv (eqv (cnj \ (dsj \1 \2)) (dsj (cnj \ \1) (cnj \ \2)))" + by (simp add: prv_cnj_dsj_distrib1 prv_cnj_dsj_distrib2 prv_eqvI) + +lemma prv_dsj_cnj_distrib1: + assumes \[simp]: "\ \ fmla" and \1[simp]: "\1 \ fmla" and \2[simp]: "\2 \ fmla" + shows "prv (imp (dsj \ (cnj \1 \2)) (cnj (dsj \ \1) (dsj \ \2)))" + by (simp add: prv_cnj_mono prv_dsj_impL prv_dsj_impR prv_imp_cnj prv_imp_dsjEE) + +lemma prv_dsj_cnj_distrib2: + assumes \[simp]: "\ \ fmla" and \1[simp]: "\1 \ fmla" and \2[simp]: "\2 \ fmla" + shows "prv (imp (cnj (dsj \ \1) (dsj \ \2)) (dsj \ (cnj \1 \2)))" +proof - + have "\f fa fb. (((prv (imp f (imp fb fa)) \ \ prv (imp f fa)) \ fa \ fmla) \ f \ fmla) \ fb \ fmla" + by (meson imp prv_imp_imp_triv prv_prv_imp_trans) + then show ?thesis + by (metis \1 \2 \ cnj dsj imp prv_cnj_imp prv_cnj_imp_monoR2 prv_dsj_impL prv_dsj_impR + prv_imp_com prv_imp_dsjEE) +qed + +lemma prv_dsj_cnj_distrib: + assumes \[simp]: "\ \ fmla" and \1[simp]: "\1 \ fmla" and \2[simp]: "\2 \ fmla" + shows "prv (eqv (dsj \ (cnj \1 \2)) (cnj (dsj \ \1) (dsj \ \2)))" + by (simp add: prv_dsj_cnj_distrib1 prv_dsj_cnj_distrib2 prv_eqvI) + + +subsection \Disjunction vs. True and False\ + +lemma prv_dsjR_fls: "\ \ fmla \ prv (eqv (dsj fls \) \)" + by (simp add: prv_dsj_impR prv_eqvI prv_imp_dsjEE prv_imp_refl) + +lemma prv_dsjL_fls: "\ \ fmla \ prv (eqv (dsj \ fls) \)" + by (simp add: prv_dsj_impL prv_eqvI prv_imp_dsjEE prv_imp_refl) + +lemma prv_dsjR_tru: "\ \ fmla \ prv (eqv (dsj tru \) tru)" + by (simp add: prv_dsj_impL prv_eqvI prv_imp_tru) + +lemma prv_dsjL_tru: "\ \ fmla \ prv (eqv (dsj \ tru) tru)" + by (simp add: prv_dsj_impR prv_eqvI prv_imp_tru) + + +subsection \Set-based disjunctions\ + +text \Just like for conjunctions, these are based on properties of the auxiliary +list disjunctions.\ + +lemma prv_imp_ldsj_in: + assumes "set \s \ fmla" + and "\ \ set \s" + shows "prv (imp \ (ldsj \s))" +proof- + have "\ \ fmla" using assms by auto + thus ?thesis + using assms apply(induct \s arbitrary: \) + subgoal by auto + subgoal by (simp add: prv_dsj_impL) + (meson dsj ldsj prv_dsj_impL prv_dsj_impR prv_prv_imp_trans) . +qed + +lemma prv_imp_ldsj: +assumes "\ \ fmla" and "set \s \ fmla" +and "\ \ set \s" and "prv (imp \ \)" +shows "prv (imp \ (ldsj \s))" + using assms ldsj prv_imp_ldsj_in prv_prv_imp_trans by blast + +lemma prv_ldsj_imp: + assumes "\ \ fmla" and "set \s \ fmla" + and "\\. \ \ set \s \ prv (imp \ \)" + shows "prv (imp (ldsj \s) \)" + using assms + by (induct \s arbitrary: \) + (auto simp add: prv_imp_tru prv_imp_com prv_imp_dsjEE) + +lemma prv_ldsj_imp_inner: +assumes "\ \ fmla" "set \1s \ fmla" "set \2s \ fmla" +shows "prv (imp (ldsj (\1s @ \ # \2s)) (dsj \ (ldsj (\1s @ \2s))))" +using assms proof(induction \1s) + case (Cons \1 \1s) + have [intro!]: "set (\1s @ \2s) \ fmla" "set (\1s @ \ # \2s) \ fmla" using Cons by auto + have 0: "prv (imp (dsj \1 (dsj \ (ldsj (\1s @ \2s)))) + (dsj \ (dsj \1 (ldsj (\1s @ \2s)))))" + using Cons by (intro prv_dsj_com_imp3) fastforce+ + have 1: "prv (imp (dsj \1 (ldsj (\1s @ \ # \2s))) + (dsj \1 (dsj \ (ldsj (\1s @ \2s)))))" + using Cons by (intro prv_dsj_mono) (auto simp add: prv_imp_refl) + show ?case using prv_prv_imp_trans[OF _ _ _ 1 0] Cons by auto +qed(simp add: prv_imp_refl) + +lemma prv_ldsj_imp_remdups: +assumes "set \s \ fmla" +shows "prv (imp (ldsj \s) (ldsj (remdups \s)))" + using assms apply(induct \s) + subgoal by auto + subgoal by (metis ldsj prv_imp_ldsj_in prv_ldsj_imp set_remdups) . + +lemma prv_ldsj_mono: +assumes \2s: "set \2s \ fmla" and "set \1s \ set \2s" +shows "prv (imp (ldsj \1s) (ldsj \2s))" +proof- + define \1s' where \1s': "\1s' = remdups \1s" + have A: "set \1s' \ set \2s" "distinct \1s'" unfolding \1s' using assms by auto + have B: "prv (imp (ldsj \1s') (ldsj \2s))" + using \2s A proof(induction \2s arbitrary: \1s') + case (Cons \2 \2s \1ss) + show ?case proof(cases "\2 \ set \1ss") + case True + then obtain \1ss1 \1ss2 where \1ss: "\1ss = \1ss1 @ \2 # \1ss2" + by (meson split_list) + define \1s where \1s: "\1s \ \1ss1 @ \1ss2" + have nin: "\2 \ set \1s" using \1ss `distinct \1ss` unfolding \1s by auto + have [intro!,simp]: "set \1s \ fmla" unfolding \1s using \1ss Cons by auto + have 0: "prv (imp (ldsj \1ss) (dsj \2 (ldsj \1s)))" + unfolding \1s \1ss + apply(rule prv_ldsj_imp_inner) using Cons \1ss by auto + have 1: "prv (imp (ldsj \1s) (ldsj \2s))" apply(rule Cons.IH) using nin Cons.prems True + using \1s \1ss by auto + have 2: "prv (imp (dsj \2 (ldsj \1s)) (dsj \2 (ldsj \2s)))" + using Cons \1ss \1s 1 apply(intro prv_dsj_mono) + using prv_imp_refl by auto blast+ + show ?thesis using Cons by (auto intro!: prv_prv_imp_trans[OF _ _ _ 0 2]) + next + case False + then show ?thesis using Cons + by (meson ldsj order.trans prv_imp_ldsj_in prv_ldsj_imp subset_code(1)) + qed + qed(simp add: prv_imp_refl) + have C: "prv (imp (ldsj \1s) (ldsj \1s'))" + unfolding \1s' using assms by (intro prv_ldsj_imp_remdups) auto + show ?thesis using A assms by (intro prv_prv_imp_trans[OF _ _ _ C B]) auto +qed + +lemma prv_ldsj_eqv: +assumes "set \1s \ fmla" and "set \2s = set \1s" +shows "prv (eqv (ldsj \1s) (ldsj \2s))" + using assms prv_ldsj_mono by (intro prv_eqvI) auto + +lemma prv_ldsj_mono_imp: + assumes "set \1s \ fmla" "set \2s \ fmla" and "\ \1 \ set \1s. \ \2 \ set \2s. prv (imp \1 \2)" + shows "prv (imp (ldsj \1s) (ldsj \2s))" + using assms apply(intro prv_ldsj_imp) + subgoal by auto + subgoal by auto + subgoal using prv_imp_ldsj by blast . + +text \Just like set-based conjunction, set-based disjunction commutes with substitution +only up to provably equivalence:\ + +lemma prv_subst_sdsj: +"F \ fmla \ finite F \ t \ trm \ x \ var \ + prv (eqv (subst (sdsj F) t x) (sdsj ((\\. subst \ t x) ` F)))" +unfolding sdsj_def by (fastforce intro!: prv_ldsj_eqv) + +lemma prv_imp_sdsj_in: + assumes "\ \ fmla" and "F \ fmla" "finite F" + and "\ \ F" + shows "prv (imp \ (sdsj F))" + unfolding sdsj_def using assms by (intro prv_imp_ldsj_in) auto + +lemma prv_imp_sdsj: +assumes "\ \ fmla" and "F \ fmla" "finite F" +and "\ \ F" and "prv (imp \ \)" +shows "prv (imp \ (sdsj F))" + unfolding sdsj_def using assms by (intro prv_imp_ldsj) auto + +lemma prv_sdsj_imp: + assumes "\ \ fmla" and "F \ fmla" "finite F" + and "\\. \ \ F \ prv (imp \ \)" + shows "prv (imp (sdsj F) \)" + unfolding sdsj_def using assms by (intro prv_ldsj_imp) auto + +lemma prv_sdsj_mono: +assumes "F2 \ fmla" and "F1 \ F2" and "finite F2" +shows "prv (imp (sdsj F1) (sdsj F2))" + unfolding sdsj_def using assms apply(intro prv_ldsj_mono) + subgoal by auto + subgoal by (metis asList infinite_super) . + +lemma prv_sdsj_mono_imp: + assumes "F1 \ fmla" "F2 \ fmla" "finite F1" "finite F2" + and "\ \1 \ F1. \ \2 \ F2. prv (imp \1 \2)" + shows "prv (imp (sdsj F1) (sdsj F2))" + unfolding sdsj_def using assms by (intro prv_ldsj_mono_imp) auto + +lemma prv_sdsj_cases: +assumes "F \ fmla" "finite F" "\ \ fmla" +and "prv (sdsj F)" and "\ \. \ \ F \ prv (imp \ \)" +shows "prv \" + by (meson assms prv_imp_mp prv_sdsj_imp sdsj) + +lemma prv_sdsj1_imp: +"\ \ fmla \ prv (imp (sdsj {\}) \)" + using prv_imp_refl prv_sdsj_imp by fastforce + +lemma prv_imp_sdsj1: +"\ \ fmla \ prv (imp \ (sdsj {\}))" +using prv_imp_refl prv_imp_sdsj by fastforce + +lemma prv_sdsj2_imp_dsj: +"\ \ fmla \ \ \ fmla \ prv (imp (sdsj {\,\}) (dsj \ \))" + using prv_dsj_impL prv_dsj_impR prv_sdsj_imp by fastforce + +lemma prv_dsj_imp_sdsj2: +"\ \ fmla \ \ \ fmla \ prv (imp (dsj \ \) (sdsj {\,\}))" + by (simp add: prv_imp_dsjEE prv_imp_sdsj_in) + +text \Commutation with parallel substitution:\ + +lemma prv_rawpsubst_sdsj: +assumes "F \ fmla" "finite F" +and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" +shows "prv (eqv (rawpsubst (sdsj F) txs) (sdsj ((\\. rawpsubst \ txs) ` F)))" +using assms proof(induction txs arbitrary: F) + case (Cons tx txs) + then obtain t x where tx[simp]: "tx = (t,x)" by (cases tx) auto + hence [simp]: "t \ trm" "x \ var" using Cons.prems by auto + have 0: "(\\. rawpsubst (subst \ t x) txs) ` F = + (\\. rawpsubst \ txs) ` ((\\. subst \ t x) ` F)" + using Cons.prems by auto + have "prv (eqv (subst (sdsj F) t x) + (sdsj ((\\. subst \ t x) ` F)))" + using Cons.prems by (intro prv_subst_sdsj) auto + hence "prv (eqv (rawpsubst (subst (sdsj F) t x) txs) + (rawpsubst (sdsj ((\\. subst \ t x) ` F)) txs))" + using Cons.prems by (intro prv_eqv_rawpsubst) auto + moreover + have "prv (eqv (rawpsubst (sdsj ((\\. subst \ t x) ` F)) txs) + (sdsj ((\\. rawpsubst (subst \ t x) txs) ` F)))" + unfolding 0 using Cons.prems by (intro Cons.IH) auto + ultimately show ?case + using Cons.prems apply - by (rule prv_eqv_trans) (auto intro!: rawpsubst) +qed(auto simp: image_def prv_eqv_refl)[] + +lemma prv_psubst_sdsj: +assumes "F \ fmla" "finite F" +and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" +and "distinct (map snd txs)" +shows "prv (eqv (psubst (sdsj F) txs) (sdsj ((\\. psubst \ txs) ` F)))" +proof- + define us where us: "us \ getFrN (map snd txs) (map fst txs) [sdsj F] (length txs)" + have us_facts: "set us \ var" + "set us \ \ (Fvars ` F) = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_Fvars[of "map snd txs" "map fst txs" "[sdsj F]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[sdsj F]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[sdsj F]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[sdsj F]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + by auto + + define vs where vs: "vs \ \ \. getFrN (map snd txs) (map fst txs) [\] (length txs)" + hence vss: "\\. vs \ = getFrN (map snd txs) (map fst txs) [\] (length txs)" by auto + {fix \ assume "\ \ F" hence "\ \ fmla" using assms by auto + hence "set (vs \) \ var \ + set (vs \) \ Fvars \ = {} \ + set (vs \) \ \ (FvarsT ` (fst ` (set txs))) = {} \ + set (vs \) \ snd ` (set txs) = {} \ + length (vs \) = length txs \ + distinct (vs \)" + using assms unfolding vs + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + apply(intro conjI) + subgoal by auto + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + by auto + } note vs_facts = this + + have [simp]: "\ x f. f \ F \ x \ set (vs f) \ x \ var" + using vs_facts by (meson subsetD) + + let ?tus = "zip (map fst txs) us" + let ?uxs = "zip (map Var us) (map snd txs)" + let ?tvs = "\ \. zip (map fst txs) (vs \)" + let ?vxs = "\ \. zip (map Var (vs \)) (map snd txs)" + + let ?c = "rawpsubst (sdsj F) ?uxs" + have c: "prv (eqv ?c + (sdsj ((\\. rawpsubst \ ?uxs) ` F)))" + using assms us_facts + by (intro prv_rawpsubst_sdsj) (auto intro!: rawpsubstT dest!: set_zip_D) + hence "prv (eqv (rawpsubst ?c ?tus) + (rawpsubst (sdsj ((\\. rawpsubst \ ?uxs) ` F)) ?tus))" + using assms us_facts by (intro prv_eqv_rawpsubst) (auto intro!: rawpsubst dest!: set_zip_D) + moreover + have "prv (eqv (rawpsubst (sdsj ((\\. rawpsubst \ ?uxs) ` F)) ?tus) + (sdsj ((\\. rawpsubst \ ?tus) ` ((\\. rawpsubst \ ?uxs) ` F))))" + using assms us_facts by (intro prv_rawpsubst_sdsj) (auto intro!: rawpsubst dest!: set_zip_D) + ultimately + have 0: "prv (eqv (rawpsubst ?c ?tus) + (sdsj ((\\. rawpsubst \ ?tus) ` ((\\. rawpsubst \ ?uxs) ` F))))" + using assms us_facts apply- by (rule prv_eqv_trans) (auto intro!: rawpsubst dest!: set_zip_D) + moreover + have "prv (eqv (sdsj ((\\. rawpsubst \ ?tus) ` ((\\. rawpsubst \ ?uxs) ` F))) + (sdsj ((\\. rawpsubst (rawpsubst \ (?vxs \)) (?tvs \)) ` F)))" + using assms us_facts vs_facts apply(intro prv_eqvI) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal apply(rule prv_sdsj_mono_imp) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by auto + subgoal by auto + subgoal apply clarsimp + subgoal for \ apply(rule bexI[of _ \]) apply(rule prv_imp_refl2) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (rule rawpsubst_compose_freshVar2) + (auto intro!: rawpsubst dest!: set_zip_D) . . . + subgoal apply(rule prv_sdsj_mono_imp) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal by (auto intro!: rawpsubst dest!: set_zip_D) + subgoal apply clarsimp + subgoal for \ apply(rule bexI[of _ \]) apply(rule prv_imp_refl2) + apply (auto intro!: rawpsubst dest!: set_zip_D) + apply(rule rawpsubst_compose_freshVar2) + apply (auto intro!: rawpsubst dest!: set_zip_D) . . . . + ultimately + have "prv (eqv (rawpsubst (rawpsubst (sdsj F) ?uxs) ?tus) + (sdsj ((\\. rawpsubst (rawpsubst \ (?vxs \)) (?tvs \)) ` F)))" + using assms us_facts + apply- by (rule prv_eqv_trans) (auto intro!: rawpsubst dest!: set_zip_D) + thus ?thesis unfolding psubst_def by (simp add: Let_def us[symmetric] vss) +qed + +end \ \context @{locale Deduct_with_False_Disj}\ + + +section \Deduction with Quantified Variable Renaming Included\ + +locale Deduct_with_False_Disj_Rename = +Deduct_with_False_Disj + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + num + prv ++ +Syntax_with_Connectives_Rename + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi +for +var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" +and Var FvarsT substT Fvars subst +and eql cnj imp all exi +and fls +and dsj +and num +and prv + + +section \Deduction with PseudoOrder Axioms Included\ + +text \We assume a two-variable formula Lq that satisfies two axioms +resembling the properties of the strict or nonstrict ordering on naturals. +The choice of these axioms is motivated by an abstract account of Rosser's trick +to improve on Gödel's First Incompleteness Theorem, reported in our +CADE 2019 paper~\cite{DBLP:conf/cade/0001T19}.\ + +locale Deduct_with_PseudoOrder = +Deduct_with_False_Disj + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + num + prv ++ +Syntax_PseudoOrder + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + num + Lq +for +var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" +and Var FvarsT substT Fvars subst +and eql cnj imp all exi +and fls +and dsj +and num +and prv +and Lq ++ +assumes +Lq_num: +"let LLq = (\ t1 t2. psubst Lq [(t1,zz), (t2,yy)]) in + \ \ \ fmla. \ q \ num. Fvars \ = {zz} \ (\ p \ num. prv (subst \ p zz)) + \ prv (all zz (imp (LLq (Var zz) q) \))" +and +Lq_num2: +"let LLq = (\ t1 t2. psubst Lq [(t1,zz), (t2,yy)]) in + \ p \ num. \ P \ num. finite P \ prv (dsj (sdsj {eql (Var yy) r | r. r \ P}) (LLq p (Var yy)))" +begin + +lemma LLq_num: +assumes "\ \ fmla" "q \ num" "Fvars \ = {zz}" "\ p \ num. prv (subst \ p zz)" +shows "prv (all zz (imp (LLq (Var zz) q) \))" +using assms Lq_num unfolding LLq_def by auto + +lemma LLq_num2: +assumes "p \ num" +shows "\ P \ num. finite P \ prv (dsj (sdsj {eql (Var yy) r | r. r \ P}) (LLq p (Var yy)))" +using assms Lq_num2 unfolding LLq_def by auto + +end \ \context @{locale Deduct_with_PseudoOrder}\ + + + +(*<*) +end +(*>*) \ No newline at end of file diff --git a/thys/Syntax_Independent_Logic/Deduction_Q.thy b/thys/Syntax_Independent_Logic/Deduction_Q.thy new file mode 100644 --- /dev/null +++ b/thys/Syntax_Independent_Logic/Deduction_Q.thy @@ -0,0 +1,1324 @@ +chapter \Deduction in a System Embedding the Intuitionistic Robinson Arithmetic\ + +(*<*) +theory Deduction_Q imports Syntax_Arith Natural_Deduction +begin +(*>*) + +text \NB: Robinson arithmetic, also know as system Q, is Peano arithmetic without the +induction axiom schema.\ + + +section \Natural Deduction with the Bounded Quantifiers\ + +text \We start by simply putting together deduction with the arithmetic syntax, +which allows us to reason about bounded quantifiers:\ + +locale Deduct_with_False_Disj_Arith = +Syntax_Arith + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + num + zer suc pls tms ++ +Deduct_with_False_Disj + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + num + prv +for +var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" +and Var FvarsT substT Fvars subst +and eql cnj imp all exi +and fls +and dsj +and num +and zer suc pls tms +and prv +begin + +lemma nprv_ballI: +"nprv (insert (LLq (Var x) t) F) \ \ + F \ fmla \ finite F \ \ \ fmla \ t \ trm \ x \ var \ + x \ (\\ \ F. Fvars \) \ x \ FvarsT t \ + nprv F (ball x t \)" +unfolding ball_def +by(nprover2 r1: nprv_allI r2: nprv_impI) + +lemma nprv_ballE_aux: +"nprv F (ball x t \) \ nprv F (LLq t1 t) \ + F \ fmla \ finite F \ \ \ fmla \ t \ atrm \ t1 \ atrm \ x \ var \ x \ FvarsT t \ + nprv F (subst \ t1 x)" +unfolding ball_def +by(nprover3 r1: nprv_allE[of _ x "imp (LLq (Var x) t) \" t1] + r2: nprv_impE0[of "LLq t1 t" "subst \ t1 x"] + r3: nprv_mono[of F]) + +lemma nprv_ballE: +"nprv F (ball x t \) \ nprv F (LLq t1 t) \ nprv (insert (subst \ t1 x) F) \ \ + F \ fmla \ finite F \ \ \ fmla \ t \ atrm \ t1 \ atrm \ x \ var \ \ \ fmla \ + x \ FvarsT t \ + nprv F \" +by (meson atrm_trm local.subst nprv_ballE_aux nprv_cut rev_subsetD) + +lemmas nprv_ballE0 = nprv_ballE[OF nprv_hyp _ _, simped] +lemmas nprv_ballE1 = nprv_ballE[OF _ nprv_hyp _, simped] +lemmas nprv_ballE2 = nprv_ballE[OF _ _ nprv_hyp, simped] +lemmas nprv_ballE01 = nprv_ballE[OF nprv_hyp nprv_hyp _, simped] +lemmas nprv_ballE02 = nprv_ballE[OF nprv_hyp _ nprv_hyp, simped] +lemmas nprv_ballE12 = nprv_ballE[OF _ nprv_hyp nprv_hyp, simped] +lemmas nprv_ballE012 = nprv_ballE[OF nprv_hyp nprv_hyp nprv_hyp, simped] + +lemma nprv_bexiI: +"nprv F (subst \ t1 x) \ nprv F (LLq t1 t) \ + F \ fmla \ finite F \ \ \ fmla \ t \ atrm \ t1 \ atrm \ x \ var \ + x \ FvarsT t \ + nprv F (bexi x t \)" +unfolding bexi_def +by (nprover2 r1: nprv_exiI[of _ _ t1] r2: nprv_cnjI) + +lemma nprv_bexiE: +"nprv F (bexi x t \) \ nprv (insert (LLq (Var x) t) (insert \ F)) \ \ + F \ fmla \ finite F \ \ \ fmla \ x \ var \ \ \ fmla \ t \ atrm \ + x \ (\\ \ F. Fvars \) \ x \ Fvars \ \ x \ FvarsT t \ + nprv F \" +unfolding bexi_def +by (nprover2 r1: nprv_exiE[of _ x "cnj (LLq (Var x) t) \"] r2: nprv_cnjH) + +lemmas nprv_bexiE0 = nprv_bexiE[OF nprv_hyp _, simped] +lemmas nprv_bexiE1 = nprv_bexiE[OF _ nprv_hyp, simped] +lemmas nprv_bexiE01 = nprv_bexiE[OF nprv_hyp nprv_hyp, simped] + +end \ \context @{locale Deduct_with_False_Disj}\ + + +section \Deduction with the Robinson Arithmetic Axioms\ + +locale Deduct_Q = +Deduct_with_False_Disj_Arith +var trm fmla +Var FvarsT substT Fvars subst +eql cnj imp all exi +fls +dsj +num +zer suc pls tms +prv +for +var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" +and Var FvarsT substT Fvars subst +and eql cnj imp all exi +and fls +and dsj +and num +and zer suc pls tms +and prv ++ +assumes +\ \The Q axioms are stated for some fixed variables; +we will prove more useful versions, for arbitrary terms substituting the variables.\ +prv_neg_zer_suc_var: +"prv (neg (eql zer (suc (Var xx))))" +and +prv_inj_suc_var: +"prv (imp (eql (suc (Var xx)) (suc (Var yy))) + (eql (Var xx) (Var yy)))" +and +prv_zer_dsj_suc_var: +"prv (dsj (eql (Var yy) zer) + (exi xx (eql (Var yy) (suc (Var xx)))))" +and +prv_pls_zer_var: +"prv (eql (pls (Var xx) zer) (Var xx))" +and +prv_pls_suc_var: +"prv (eql (pls (Var xx) (suc (Var yy))) + (suc (pls (Var xx) (Var yy))))" +and +prv_tms_zer_var: +"prv (eql (tms (Var xx) zer) zer)" +and +prv_tms_suc_var: +"prv (eql (tms (Var xx) (suc (Var yy))) + (pls (tms (Var xx) (Var yy)) (Var xx)))" +begin + +text \Rules for quantifiers that allow changing, on the fly, the bound variable with +one that is fresh for the proof context:\ + +lemma nprv_allI_var: +assumes n1[simp]: "nprv F (subst \ (Var y) x)" +and i[simp]: "F \ fmla" "finite F" "\ \ fmla" "x \ var" "y \ var" +and u: "y \ (\\ \ F. Fvars \)" and yx[simp]: "y = x \ y \ Fvars \" +shows "nprv F (all x \)" +proof- + have [simp]: "\\. \ \ F \ y \ Fvars \" using u by auto + show ?thesis + apply(subst all_rename2[of _ _ y]) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal using yx by auto + subgoal by (nrule r: nprv_allI) . +qed + +lemma nprv_exiE_var: +assumes n: "nprv F (exi x \)" +and nn: "nprv (insert (subst \ (Var y) x) F) \" +and 0: "F \ fmla" "finite F" "\ \ fmla" "x \ var" "y \ var" "\ \ fmla" +and yx: "y = x \ y \ Fvars \" "y \ \ (Fvars ` F)" "y \ Fvars \" +shows "nprv F \" +proof- + have e: "exi x \ = exi y (subst \ (Var y) x)" + using 0 yx n nn by (subst exi_rename2[of _ _ y]) (auto simp: 0) + show ?thesis + using assms unfolding e + by (auto intro: nprv_exiE[of _ y "subst \ (Var y) x"]) +qed + +(* The substitution closures of the variable-based axioms +(and the rulifications of the ones that are implications, negations or disjunctions). *) + +lemma prv_neg_zer_suc: +assumes [simp]: "t \ atrm" shows "prv (neg (eql zer (suc t)))" +using prv_psubst[OF _ _ _ prv_neg_zer_suc_var, of "[(t,xx)]"] +by simp + +lemma prv_neg_suc_zer: +assumes "t \ atrm" shows "prv (neg (eql (suc t) zer))" +by (metis assms atrm.simps atrm_imp_trm eql fls neg_def prv_eql_sym + prv_neg_zer_suc prv_prv_imp_trans zer_atrm) + + +(* Rulification: *) +lemmas nprv_zer_suc_contrE = + nprv_flsE[OF nprv_addImpLemmaE[OF prv_neg_zer_suc[unfolded neg_def]], OF _ _ nprv_hyp, simped, rotated] + +lemmas nprv_zer_suc_contrE0 = nprv_zer_suc_contrE[OF nprv_hyp, simped] + + +(* A variation of the above, taking advantage of transitivity and symmetry: *) +lemma nprv_zer_suc_2contrE: +"nprv F (eql t zer) \ nprv F (eql t (suc t1)) \ + finite F \ F \ fmla \ t \ atrm \ t1 \ atrm \ \ \ fmla \ + nprv F \" +using nprv_eql_transI[OF nprv_eql_symI] nprv_zer_suc_contrE +by (meson atrm_imp_trm suc zer_atrm) + +lemmas nprv_zer_suc_2contrE0 = nprv_zer_suc_2contrE[OF nprv_hyp _, simped] +lemmas nprv_zer_suc_2contrE1 = nprv_zer_suc_2contrE[OF _ nprv_hyp, simped] +lemmas nprv_zer_suc_2contrE01 = nprv_zer_suc_2contrE[OF nprv_hyp nprv_hyp, simped] +(* *) + +lemma prv_inj_suc: +"t \ atrm \ t' \ atrm \ + prv (imp (eql (suc t) (suc t')) + (eql t t'))" +using prv_psubst[OF _ _ _ prv_inj_suc_var, of "[(t,xx),(t',yy)]"] +by simp + +(* Rulification: *) +lemmas nprv_eql_sucI = nprv_addImpLemmaI[OF prv_inj_suc, simped, rotated 4] +lemmas nprv_eql_sucE = nprv_addImpLemmaE[OF prv_inj_suc, simped, rotated 2] + +lemmas nprv_eql_sucE0 = nprv_eql_sucE[OF nprv_hyp _, simped] +lemmas nprv_eql_sucE1 = nprv_eql_sucE[OF _ nprv_hyp, simped] +lemmas nprv_eql_sucE01 = nprv_eql_sucE[OF nprv_hyp nprv_hyp, simped] + +(* NB: Provable substitution closures of sentences in the presence of quantifiers do not go +very smoothly -- the main reason being that bound variable renaming is not assumed +to hold up to equality, but it (only follows that it) holds up to provability: *) +lemma prv_zer_dsj_suc: +assumes t[simp]: "t \ atrm" and x[simp]: "x \ var" "x \ FvarsT t" +shows "prv (dsj (eql t zer) + (exi x (eql t (suc (Var x)))))" +proof- + define x' where x': "x' \ getFr [x,yy] [t] []" + have x'_facts[simp]: "x' \ var" "x' \ x" "x' \ yy" "x' \ FvarsT t" unfolding x' + using getFr_FvarsT_Fvars[of "[x,yy]" "[t]" "[]"] by auto + + have "prv (imp (exi xx (eql (Var yy) (suc (Var xx)))) (exi x' (eql (Var yy) (suc (Var x')))))" + by (auto intro!: prv_exi_imp prv_all_gen + simp: prv_exi_inst[of x' "eql (Var yy) (suc (Var x'))" "Var xx", simplified]) + with prv_zer_dsj_suc_var + have 0: "prv (dsj (eql (Var yy) zer) (exi x' (eql (Var yy) (suc (Var x')))))" + by (elim prv_dsj_cases[rotated 3]) + (auto intro: prv_dsj_impL prv_dsj_impR elim!: prv_prv_imp_trans[rotated 3]) + + note 1 = prv_psubst[OF _ _ _ 0, of "[(t,yy)]", simplified] + moreover have "prv (imp (exi x' (eql t (suc (Var x')))) (exi x (eql t (suc (Var x)))))" + by (auto intro!: prv_exi_imp prv_all_gen simp: prv_exi_inst[of x "eql t (suc (Var x))" "Var x'", simplified]) + ultimately show ?thesis + by (elim prv_dsj_cases[rotated 3]) + (auto intro: prv_dsj_impL prv_dsj_impR elim!: prv_prv_imp_trans[rotated 3]) +qed + +(* The rulification of the above disjunction amounts to reasoning by zero-suc cases: *) +lemma nprv_zer_suc_casesE: +"nprv (insert (eql t zer) F) \ \ nprv (insert (eql t (suc (Var x))) F) \ \ + finite F \ F \ fmla \ \ \ fmla \ x \ var \ t \ atrm \ + x \ Fvars \ \ x \ FvarsT t \ x \ \ (Fvars ` F) \ + nprv F \" +by (nprover3 r1: nprv_addDsjLemmaE[OF prv_zer_dsj_suc] + r2: nprv_exiE0[of x "eql t (suc (Var x))"] + r3: nprv_mono[of "insert (eql _ (suc _)) _"]) + +lemmas nprv_zer_suc_casesE0 = nprv_zer_suc_casesE[OF nprv_hyp _, simped] +lemmas nprv_zer_suc_casesE1 = nprv_zer_suc_casesE[OF _ nprv_hyp, simped] +lemmas nprv_zer_suc_casesE01 = nprv_zer_suc_casesE[OF nprv_hyp nprv_hyp, simped] +(* *) + +lemma prv_pls_zer: +assumes [simp]: "t \ atrm" shows "prv (eql (pls t zer) t)" +using prv_psubst[OF _ _ _ prv_pls_zer_var, of "[(t,xx)]"] +by simp + +lemma prv_pls_suc: +"t \ atrm \ t' \ atrm \ + prv (eql (pls t (suc t')) + (suc (pls t t')))" +using prv_psubst[OF _ _ _ prv_pls_suc_var, of "[(t,xx),(t',yy)]"] +by simp + +lemma prv_tms_zer: +assumes [simp]: "t \ atrm" shows "prv (eql (tms t zer) zer)" +using prv_psubst[OF _ _ _ prv_tms_zer_var, of "[(t,xx)]"] +by simp + +lemma prv_tms_suc: +"t \ atrm \ t' \ atrm \ + prv (eql (tms t (suc t')) + (pls (tms t t') t))" +using prv_psubst[OF _ _ _ prv_tms_suc_var, of "[(t,xx),(t',yy)]"] +by simp + + +(* Congruence rules for the operators (follow from substitutivity of equality): *) + +lemma prv_suc_imp_cong: +assumes t1[simp]: "t1 \ atrm" and t2[simp]: "t2 \ atrm" +shows "prv (imp (eql t1 t2) + (eql (suc t1) (suc t2)))" +proof- + define z where "z \ getFr [xx,yy,zz] [t1,t2] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ zz" "zz \ z" "z \ FvarsT t1" "z \ FvarsT t2" + using getFr_FvarsT_Fvars[of "[xx,yy,zz]" "[t1,t2]" "[]"] unfolding z_def[symmetric] by auto + show ?thesis + by (nprover4 r1: nprv_prvI r2: nprv_impI + r3: nprv_eql_substE02[of t1 t2 _ "eql (suc (Var z)) (suc t2)" z] + r4: nprv_eq_eqlI) +qed + +(* Rulification: *) +lemmas nprv_suc_congI = nprv_addImpLemmaI[OF prv_suc_imp_cong, simped, rotated 4] +lemmas nprv_suc_congE = nprv_addImpLemmaE[OF prv_suc_imp_cong, simped, rotated 2] + +lemmas nprv_suc_congE0 = nprv_suc_congE[OF nprv_hyp _, simped] +lemmas nprv_suc_congE1 = nprv_suc_congE[OF _ nprv_hyp, simped] +lemmas nprv_suc_congE01 = nprv_suc_congE[OF nprv_hyp nprv_hyp, simped] + +lemma prv_suc_cong: +assumes t1[simp]: "t1 \ atrm" and t2[simp]: "t2 \ atrm" +assumes "prv (eql t1 t2)" +shows "prv (eql (suc t1) (suc t2))" +by (meson assms atrm_suc atrm_imp_trm eql prv_imp_mp prv_suc_imp_cong t1 t2) + +lemma prv_pls_imp_cong: +assumes t1[simp]: "t1 \ atrm" and t1'[simp]: "t1' \ atrm" +and t2[simp]: "t2 \ atrm" and t2'[simp]: "t2' \ atrm" +shows "prv (imp (eql t1 t1') + (imp (eql t2 t2') (eql (pls t1 t2) (pls t1' t2'))))" +proof- + define z where "z \ getFr [xx,yy,zz] [t1,t1',t2,t2'] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ zz" "zz \ z" + "z \ FvarsT t1" "z \ FvarsT t1'" "z \ FvarsT t2" "z \ FvarsT t2'" + using getFr_FvarsT_Fvars[of "[xx,yy,zz]" "[t1,t1',t2,t2']" "[]"] unfolding z_def[symmetric] by auto + show ?thesis + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_eql_substE02[of t1 t1' _ "eql (pls (Var z) t2) (pls t1' t2')" z]) + apply(nrule r: nprv_eql_substE02[of t2 t2' _ "eql (pls t1' (Var z)) (pls t1' t2')" z]) + apply(nrule r: nprv_eq_eqlI) . +qed + +(* Rulification: *) +lemmas nprv_pls_congI = nprv_addImp2LemmaI[OF prv_pls_imp_cong, simped, rotated 6] +lemmas nprv_pls_congE = nprv_addImp2LemmaE[OF prv_pls_imp_cong, simped, rotated 4] + +lemmas nprv_pls_congE0 = nprv_pls_congE[OF nprv_hyp _ _, simped] +lemmas nprv_pls_congE1 = nprv_pls_congE[OF _ nprv_hyp _, simped] +lemmas nprv_pls_congE2 = nprv_pls_congE[OF _ _ nprv_hyp, simped] +lemmas nprv_pls_congE01 = nprv_pls_congE[OF nprv_hyp nprv_hyp _, simped] +lemmas nprv_pls_congE02 = nprv_pls_congE[OF nprv_hyp _ nprv_hyp, simped] +lemmas nprv_pls_congE12 = nprv_pls_congE[OF _ nprv_hyp nprv_hyp, simped] +lemmas nprv_pls_congE012 = nprv_pls_congE[OF nprv_hyp nprv_hyp nprv_hyp, simped] + +lemma prv_pls_cong: +assumes "t1 \ atrm" "t1' \ atrm" "t2 \ atrm" "t2' \ atrm" +and "prv (eql t1 t1')" and "prv (eql t2 t2')" +shows "prv (eql (pls t1 t2) (pls t1' t2'))" +by (metis assms atrm_imp_trm cnj eql pls prv_cnjI prv_cnj_imp_monoR2 prv_imp_mp prv_pls_imp_cong) + +lemma prv_pls_congL: +"t1 \ atrm \ t1' \ atrm \ t2 \ atrm \ + prv (eql t1 t1') \ prv (eql (pls t1 t2) (pls t1' t2))" +by (rule prv_pls_cong[OF _ _ _ _ _ prv_eql_reflT]) auto + +lemma prv_pls_congR: +"t1 \ atrm \ t2 \ atrm \ t2' \ atrm \ + prv (eql t2 t2') \ prv (eql (pls t1 t2) (pls t1 t2'))" +by (rule prv_pls_cong[OF _ _ _ _ prv_eql_reflT]) auto + +lemma nprv_pls_cong: +assumes [simp]: "t1 \ atrm" "t1' \ atrm" "t2 \ atrm" "t2' \ atrm" +shows "nprv {eql t1 t1', eql t2 t2'} (eql (pls t1 t2) (pls t1' t2'))" + unfolding nprv_def +by (auto intro!: prv_prv_imp_trans[OF _ _ _ prv_scnj2_imp_cnj] prv_cnj_imp_monoR2 prv_pls_imp_cong) + +lemma prv_tms_imp_cong: +assumes t1[simp]: "t1 \ atrm" and t1'[simp]: "t1' \ atrm" +and t2[simp]: "t2 \ atrm" and t2'[simp]: "t2' \ atrm" +shows "prv (imp (eql t1 t1') + (imp (eql t2 t2') (eql (tms t1 t2) (tms t1' t2'))))" +proof- + define z where "z \ getFr [xx,yy,zz] [t1,t1',t2,t2'] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ zz" "zz \ z" + "z \ FvarsT t1" "z \ FvarsT t1'" "z \ FvarsT t2" "z \ FvarsT t2'" + using getFr_FvarsT_Fvars[of "[xx,yy,zz]" "[t1,t1',t2,t2']" "[]"] unfolding z_def[symmetric] by auto + show ?thesis + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_eql_substE02[of t1 t1' _ "eql (tms (Var z) t2) (tms t1' t2')" z]) + apply(nrule r: nprv_eql_substE02[of t2 t2' _ "eql (tms t1' (Var z)) (tms t1' t2')" z]) + apply(nrule r: nprv_eq_eqlI) . +qed + +(* Rulification: *) +lemmas nprv_tms_congI = nprv_addImp2LemmaI[OF prv_tms_imp_cong, simped, rotated 6] +lemmas nprv_tms_congE = nprv_addImp2LemmaE[OF prv_tms_imp_cong, simped, rotated 4] + +lemmas nprv_tms_congE0 = nprv_tms_congE[OF nprv_hyp _ _, simped] +lemmas nprv_tms_congE1 = nprv_tms_congE[OF _ nprv_hyp _, simped] +lemmas nprv_tms_congE2 = nprv_tms_congE[OF _ _ nprv_hyp, simped] +lemmas nprv_tms_congE01 = nprv_tms_congE[OF nprv_hyp nprv_hyp _, simped] +lemmas nprv_tms_congE02 = nprv_tms_congE[OF nprv_hyp _ nprv_hyp, simped] +lemmas nprv_tms_congE12 = nprv_tms_congE[OF _ nprv_hyp nprv_hyp, simped] +lemmas nprv_tms_congE012 = nprv_tms_congE[OF nprv_hyp nprv_hyp nprv_hyp, simped] + +lemma prv_tms_cong: +assumes "t1 \ atrm" "t1' \ atrm" "t2 \ atrm" "t2' \ atrm" +and "prv (eql t1 t1')" and "prv (eql t2 t2')" +shows "prv (eql (tms t1 t2) (tms t1' t2'))" +by (metis assms atrm_imp_trm cnj eql tms prv_cnjI prv_cnj_imp_monoR2 prv_imp_mp prv_tms_imp_cong) + +lemma nprv_tms_cong: +assumes [simp]: "t1 \ atrm" "t1' \ atrm" "t2 \ atrm" "t2' \ atrm" +shows "nprv {eql t1 t1', eql t2 t2'} (eql (tms t1 t2) (tms t1' t2'))" + unfolding nprv_def +by (auto intro!: prv_prv_imp_trans[OF _ _ _ prv_scnj2_imp_cnj] prv_cnj_imp_monoR2 prv_tms_imp_cong) + +lemma prv_tms_congL: +"t1 \ atrm \ t1' \ atrm \ t2 \ atrm \ + prv (eql t1 t1') \ prv (eql (tms t1 t2) (tms t1' t2))" +by (rule prv_tms_cong[OF _ _ _ _ _ prv_eql_reflT]) auto + +lemma prv_tms_congR: +"t1 \ atrm \ t2 \ atrm \ t2' \ atrm \ + prv (eql t2 t2') \ prv (eql (tms t1 t2) (tms t1 t2'))" +by (rule prv_tms_cong[OF _ _ _ _ prv_eql_reflT]) auto + + +section \Properties Provable in Q\ + +subsection \General properties, unconstrained by numerals\ + +lemma prv_pls_suc_zer: +"t \ atrm \ prv (eql (pls t (suc zer)) (suc t))" +by (metis (no_types, hide_lams) atrm.atrm_pls atrm_imp_trm + pls prv_eql_trans prv_pls_suc prv_pls_zer prv_suc_cong suc zer_atrm) + +lemma prv_LLq_suc_imp: +assumes [simp]: "t1 \ atrm" "t2 \ atrm" +shows "prv (imp (LLq (suc t1) (suc t2)) (LLq t1 t2))" +proof- define z where "z \ getFr [xx,yy,zz] [t1,t2] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ zz" "zz \ z" "z \ FvarsT t1" "z \ FvarsT t2" + using getFr_FvarsT_Fvars[of "[xx,yy,zz]" "[t1,t2]" "[]"] unfolding z_def[symmetric] by auto + note LLq_pls[of _ _ z,simp] + show ?thesis + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_exiE0) + apply(nrule r: nprv_addLemmaE[OF prv_pls_suc[of "Var z" t1]]) + apply(nrule r: nprv_clear3_3) + apply(nrule r: nprv_eql_transE01[of "suc t2" "pls (Var z) (suc t1)" _ "suc (pls (Var z) t1)"]) + apply(nrule r: nprv_eql_sucE0[of t2 "pls (Var z) t1"]) + apply(nrule r: nprv_exiI[of _ _ "Var z" z]) . +qed + +(* Rulification: *) +lemmas nprv_LLq_sucI = nprv_addImpLemmaI[OF prv_LLq_suc_imp, simped, rotated 4] +lemmas nprv_LLq_sucE = nprv_addImpLemmaE[OF prv_LLq_suc_imp, simped, rotated 2] + +lemmas nprv_LLq_sucE0 = nprv_LLq_sucE[OF nprv_hyp _, simped] +lemmas nprv_LLq_sucE1 = nprv_LLq_sucE[OF _ nprv_hyp, simped] +lemmas nprv_LLq_sucE01 = nprv_LLq_sucE[OF nprv_hyp nprv_hyp, simped] + + +lemma prv_LLs_imp_LLq: +assumes [simp]: "t1 \ atrm" "t2 \ atrm" +shows "prv (imp (LLs t1 t2) (LLq t1 t2))" +by (simp add: LLs_LLq prv_imp_cnjL) + +lemma prv_LLq_refl: +"prv (LLq zer zer)" +by (auto simp: LLq_pls_zz prv_pls_zer prv_prv_eql_sym intro!: prv_exiI[of zz _ zer]) + +text \NB: Monotonicity of pls and tms w.r.t. LLq cannot be proved in Q.\ + +lemma prv_suc_mono_LLq: +assumes "t1 \ atrm" "t2 \ atrm" +shows "prv (imp (LLq t1 t2) (LLq (suc t1) (suc t2)))" +proof- + have assms1: "t1 \ trm" "t2 \ trm" using assms by auto + define z where "z \ getFr [xx,yy,zz] [t1,t2] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ zz" "zz \ z" "z \ FvarsT t1" "z \ FvarsT t2" + using getFr_FvarsT_Fvars[of "[xx,yy,zz]" "[t1,t2]" "[]"] using assms1 unfolding z_def[symmetric] by auto + define x where "x \ getFr [xx,yy,zz,z] [t1,t2] []" + have x_facts[simp]: "x \ var" "x \ xx" "x \ yy" "x \ zz" "zz \ x" "x \ z" "z \ x" "x \ FvarsT t1""x \ FvarsT t2" + using getFr_FvarsT_Fvars[of "[xx,yy,zz,z]" "[t1,t2]" "[]"] using assms1 unfolding x_def[symmetric] by auto + note assms[simp] + note LLq_pls[of _ _ z, simp] + show ?thesis + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_exiE0[of z "eql t2 (pls (Var z) t1)"]) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_exiI[of _ _ "Var z"]) + apply(nrule r: nprv_addLemmaE[OF prv_pls_suc[of "Var z" t1]]) + apply(nrule r: nprv_eql_substE[of _ + "pls (Var z) (suc t1)" "suc (pls (Var z) t1)" + "eql (suc t2) (Var x)" x]) + apply(nrule r: nprv_clear2_1) + apply(nrule r: nprv_suc_congI) . +qed + +(* Rulification: *) +lemmas nprv_suc_mono_LLqI = nprv_addImpLemmaI[OF prv_suc_mono_LLq, simped, rotated 4] +lemmas nprv_suc_mono_LLqE = nprv_addImpLemmaE[OF prv_suc_mono_LLq, simped, rotated 2] + +lemmas nprv_suc_mono_LLqE0 = nprv_suc_mono_LLqE[OF nprv_hyp _, simped] +lemmas nprv_suc_mono_LLqE1 = nprv_suc_mono_LLqE[OF _ nprv_hyp, simped] +lemmas nprv_suc_mono_LLqE01 = nprv_suc_mono_LLqE[OF nprv_hyp nprv_hyp, simped] + + +subsection \Representability properties\ + +text \Representability of number inequality\ + +lemma prv_neg_eql_suc_Num_zer: +"prv (neg (eql (suc (Num n)) zer))" +apply(induct n) + apply (metis Num Num.simps(1) Num_atrm eql fls in_num neg_def prv_eql_sym prv_neg_zer_suc prv_prv_imp_trans suc) + by (metis Num_atrm atrm_imp_trm eql fls neg_def prv_eql_sym prv_neg_zer_suc prv_prv_imp_trans suc zer_atrm) + +lemma diff_prv_eql_Num: +assumes "m \ n" +shows "prv (neg (eql (Num m) (Num n)))" +using assms proof(induct m arbitrary: n) + case 0 + then obtain n' where n: "n = Suc n'" by (cases n) auto + thus ?case unfolding n by (simp add: prv_neg_zer_suc) +next + case (Suc m n) note s = Suc + show ?case + proof(cases n) + case 0 + thus ?thesis by (simp add: prv_neg_eql_suc_Num_zer) + next + case (Suc n') note n = Suc + thus ?thesis using s + by simp (meson Num Num_atrm eql in_num neg prv_imp_mp prv_imp_neg_rev prv_inj_suc suc) + qed +qed + +lemma consistent_prv_eql_Num_equal: +assumes consistent and "prv (eql (Num m) (Num n))" +shows "m = n" +using assms consistent_def3 diff_prv_eql_Num in_num by blast + + +text \Representability of addition\ + +lemma prv_pls_zer_zer: +"prv (eql (pls zer zer) zer)" + by (simp add: prv_pls_zer) + +lemma prv_eql_pls_plus: +"prv (eql (pls (Num m) (Num n)) + (Num (m+n)))" +proof(induct n) + case (Suc n) + note 0 = prv_pls_suc[of "Num m" "Num n", simplified] + show ?case + by (auto intro: prv_eql_trans[OF _ _ _ 0 prv_suc_cong[OF _ _ Suc]]) +qed(simp add: prv_pls_zer) + +lemma not_plus_prv_neg_eql_pls: +assumes "m + n \ k" +shows "prv (neg (eql (pls (Num m) (Num n)) (Num k)))" +using assms proof(induction n arbitrary: k) + case 0 hence m: "m \ k" by simp + note diff_prv_eql_Num[OF m, simp] + show ?case + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_addLemmaE[OF prv_pls_zer, of "Num m"]) + apply(nrule r: nprv_eql_substE + [of _ "pls (Num m) zer" "Num m" "neg (eql (Var xx) (Num k))" xx]) + apply(nrule r: prv_nprvI) . +next + case (Suc n) + have 0: "\k'. k = Suc k' \ + prv (neg (eql (pls (Num m) (Num n)) (Num k'))) \ m + n \ k'" + using Suc.IH Suc.prems by auto + show ?case + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_addLemmaE[OF prv_pls_suc, of "Num m" "Num n"]) + apply(nrule r: nprv_eql_substE[of _ "pls (Num m) (suc (Num n))" + "suc (pls (Num m) (Num n))" "neg (eql (Var xx) (Num k))" xx]) + apply(nrule r: nprv_clear) + apply(cases k) + subgoal by (nprover2 r1: prv_nprvI r2: prv_neg_suc_zer) + subgoal for k' apply(frule 0) + by (nprover4 r1: nprv_addLemmaE r2: nprv_negI + r3: nprv_negE0 r4: nprv_eql_sucI) . +qed + +lemma consistent_prv_eql_pls_plus_rev: +assumes "consistent" "prv (eql (pls (Num m) (Num n)) (Num k))" +shows "k = m + n" +by (metis Num assms consistent_def eql not_plus_prv_neg_eql_pls num pls prv_neg_fls subsetCE) + + +text \Representability of multiplication\ + +lemma prv_tms_Num_zer: +"prv (eql (tms (Num n) zer) zer)" +by(auto simp: prv_tms_zer) + +lemma prv_eql_tms_times: +"prv (eql (tms (Num m) (Num n)) (Num (m * n)))" +proof(induct n) + case (Suc n) + note 0 = prv_pls_congL[OF _ _ _ Suc, of "Num m", simplified] + thm prv_pls_cong[no_vars] + note add.commute[simp] + show ?case + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_addLemmaE[OF 0]) + apply(nrule r: nprv_addLemmaE[OF prv_tms_suc[of "Num m" "Num n", simplified]]) + apply(nrule r: nprv_eql_transE01[of + "tms (Num m) (suc (Num n))" + "pls (tms (Num m) (Num n)) (Num m)" _ + "pls (Num (m * n)) (Num m)"]) + apply(nrule r: nprv_clear3_2) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_addLemmaE[OF prv_eql_pls_plus[of "m * n" m]]) + apply(nrule r: nprv_eql_transE01[of + "tms (Num m) (suc (Num n))" + "pls (Num (m * n)) (Num m)" _ + "Num (m * n + m)"]) . +qed(auto simp: prv_tms_zer) + +lemma ge_prv_neg_eql_pls_Num_zer: +assumes [simp]: "t \ atrm" and m: "m > k" +shows "prv (neg (eql (pls t (Num m)) (Num k)))" +proof- + define z where "z \ getFr [xx,yy,zz] [t] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ zz" "zz \ z" "z \ FvarsT t" + using getFr_FvarsT_Fvars[of "[xx,yy,zz]" "[t]" "[]"] using assms unfolding z_def[symmetric] by auto + show ?thesis using m proof(induction k arbitrary: m) + case (0 m) + show ?case + apply(cases m) + subgoal using 0 by auto + subgoal for n + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_addLemmaE[OF prv_neg_suc_zer[of "pls t (Num n)"]]) + apply(nrule r: nprv_negI) + apply(nrule r: nprv_negE0) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_eql_symE0) + apply(nrule r: nprv_eql_substE[of _ zer "pls t (suc (Num n))" "eql (suc (pls t (Num n))) (Var z)" z]) + apply(nrule r: nprv_clear) + apply(nrule r: nprv_eql_symI) + apply(nrule r: prv_nprvI) + apply(nrule r: prv_pls_suc) . . + next + case (Suc k mm) + then obtain m where mm[simp]: "mm = Suc m" and k: "k < m" by (cases mm) auto + show ?case unfolding mm Num.simps + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_addLemmaE[OF Suc.IH[OF k]]) + apply(nrule r: nprv_negI) + apply(nrule r: nprv_negE0) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_impI_rev) + apply(nrule r: nprv_addLemmaE[OF prv_pls_suc[of t "Num m"]]) + apply(nrule r: nprv_eql_substE[of _ "pls t (suc (Num m))" "suc (pls t (Num m))" + "imp (eql (Var z) (suc (Num k))) (eql (pls t (Num m)) (Num k))" z]) + apply(nrule r: nprv_clear) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_eql_sucI) . + qed +qed + +lemma nprv_pls_Num_injectR: +assumes [simp]: "t1 \ atrm" "t2 \ atrm" +shows "prv (imp (eql (pls t1 (Num m)) (pls t2 (Num m))) + (eql t1 t2))" +proof- + define z where "z \ getFr [xx,yy] [t1,t2] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ FvarsT t1" "z \ FvarsT t2" + using getFr_FvarsT_Fvars[of "[xx,yy]" "[t1,t2]" "[]"] unfolding z_def[symmetric] by auto + show ?thesis proof(induction m) + case 0 + show ?case unfolding Num.simps + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_addLemmaE[OF prv_pls_zer[of t1]]) + apply(nrule r: nprv_eql_substE[of _ "pls t1 zer" "t1" "imp (eql (Var z) (pls t2 zer)) (eql t1 t2)" z]) + apply(nrule r: nprv_clear) + apply(nrule r: nprv_addLemmaE[OF prv_pls_zer[of t2]]) + apply(nrule r: nprv_eql_substE[of _ "pls t2 zer" "t2" "imp (eql t1 (Var z)) (eql t1 t2)" z]) + apply(nrule r: nprv_impI) . + next + case (Suc m) + note Suc.IH[simp] + show ?case + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_addLemmaE[OF prv_pls_suc[of t1 "Num m"]]) + apply(nrule r: nprv_eql_substE[of _ "pls t1 (suc (Num m))" "suc (pls t1 (Num m))" + "imp (eql (Var z) (pls t2 (suc (Num m)))) (eql t1 t2)" z]) + apply(nrule r: nprv_clear) + apply(nrule r: nprv_addLemmaE[OF prv_pls_suc[of t2 "Num m"]]) + apply(nrule r: nprv_eql_substE[of _ "pls t2 (suc (Num m))" "suc (pls t2 (Num m))" + "imp (eql (suc (pls t1 (Num m))) (Var z)) (eql t1 t2)" z]) + apply(nrule r: nprv_clear) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_eql_sucE0) + apply(nrule r: nprv_clear2_2) + apply(nrule r: prv_nprv1I) . + qed +qed + +(* Rulification: *) +lemmas nprv_pls_Num_injectI = nprv_addImpLemmaI[OF nprv_pls_Num_injectR, simped, rotated 4] +lemmas nprv_pls_Num_injectE = nprv_addImpLemmaE[OF nprv_pls_Num_injectR, simped, rotated 2] + +lemmas nprv_pls_Num_injectE0 = nprv_pls_Num_injectE[OF nprv_hyp _, simped] +lemmas nprv_pls_Num_injectE1 = nprv_pls_Num_injectE[OF _ nprv_hyp, simped] +lemmas nprv_pls_Num_injectE01 = nprv_pls_Num_injectE[OF nprv_hyp nprv_hyp, simped] + + +lemma not_times_prv_neg_eql_tms: +assumes "m * n \ k" +shows "prv (neg (eql (tms (Num m) (Num n)) (Num k)))" +using assms proof(induction n arbitrary: k) + case 0 hence m: "0 \ k" by simp have zer: "zer = Num 0" by simp + have [simp]: "prv (neg (eql zer (Num k)))" by (subst zer, rule diff_prv_eql_Num[OF m]) + show ?case + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_addLemmaE[OF prv_tms_zer, of "Num m"]) + apply(nrule r: nprv_eql_substE[of _ "tms (Num m) zer" zer "neg (eql (Var xx) (Num k))" xx]) + apply(nrule r: prv_nprvI) . +next + case (Suc n) + have [simp]: "nprv {} (neg (eql (pls (tms (Num m) (Num n)) (Num m)) (Num k)))" + proof(cases "k < m") + case [simp]: True + thus ?thesis apply- by (nprover2 r1: prv_nprvI r2: ge_prv_neg_eql_pls_Num_zer) + next + case False + define k' where "k' \ k - m" + with False have k: "k = k' + m" by auto + hence mm: "m * n \ k'" using False Suc.prems by auto + note IH = Suc.IH[OF mm] + show ?thesis unfolding k + apply(nrule r: nprv_negI) + apply(nrule r: nprv_addLemmaE[OF prv_prv_eql_sym[OF _ _ prv_eql_pls_plus[of k' m]]]) + apply(nrule r: nprv_eql_transE01[of _ "Num (k' + m)"]) + apply(nrule r: nprv_clear3_2) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_pls_Num_injectE0) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_addLemmaE[OF IH]) + apply(nrule r: nprv_negE0) . + qed + show ?case + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_addLemmaE[OF prv_tms_suc, of "Num m" "Num n"]) + apply(nrule r: nprv_eql_substE[of _ "tms (Num m) (suc (Num n))" "pls (tms (Num m) (Num n)) (Num m)" + "neg (eql (Var xx) (Num k))" xx]) + apply(nrule r: nprv_clear) . +qed + +lemma consistent_prv_eql_tms_times_rev: +assumes "consistent" "prv (eql (tms (Num m) (Num n)) (Num k))" +shows "k = m * n" +by (metis Num assms consistent_def eql not_times_prv_neg_eql_tms num tms prv_neg_fls subsetCE) + + +text \Representability of the order\ + +lemma leq_prv_LLq_Num: +assumes "m \ n" +shows "prv (LLq (Num m) (Num n))" +proof- + obtain i where n: "n = i + m" using assms add.commute le_Suc_ex by blast + note prv_eql_pls_plus[simp] + have "prv (exi zz (eql (Num (i + m)) (pls (Var zz) (Num m))))" + by(nprover2 r1: prv_exiI[of _ _ "Num i"] r2: prv_prv_eql_sym) + thus ?thesis unfolding n by (simp add: LLq_pls_zz) +qed + + +subsection \The "order-adequacy" properties\ + +text \These are properties Q1--O9 from +Peter Smith, An Introduction to Gödel's theorems, Second Edition, Page 73.\ + +lemma prv_LLq_zer: \ \O1\ +assumes [simp]: "t \ atrm" +shows "prv (LLq zer t)" +proof- + define z where "z \ getFr [xx,yy] [t] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ FvarsT t" + using getFr_FvarsT_Fvars[of "[xx,yy]" "[t]" "[]"] unfolding z_def[symmetric] by auto + have "prv (exi z (eql t (pls (Var z) zer)))" + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_exiI[of _ _ t]) + apply(nrule r: nprv_eql_symI) + apply(nrule r: prv_nprvI) + apply(nrule r: prv_pls_zer) . + thus ?thesis by (simp add: LLq_pls[of _ _ z]) +qed + +lemmas Q1 = prv_LLq_zer + +lemma prv_LLq_zer_imp_eql: +assumes [simp]: "t \ atrm" +shows "prv (imp (LLq t zer) (eql t zer))" +proof- + define y where "y \ getFr [] [t] []" + have y_facts[simp]: "y \ var" "y \ FvarsT t" + using getFr_FvarsT_Fvars[of "[]" "[t]" "[]"] unfolding y_def[symmetric] by auto + define z where "z \ getFr [y] [t] []" + have z_facts[simp]: "z \ var" "z \ y" "z \ FvarsT t" + using getFr_FvarsT_Fvars[of "[y]" "[t]" "[]"] unfolding z_def[symmetric] by auto + define x where "x \ getFr [y,z] [t] []" + have x_facts[simp]: "x \ var" "x \ y" "x \ z" "x \ FvarsT t" + using getFr_FvarsT_Fvars[of "[y,z]" "[t]" "[]"] unfolding x_def by auto + note LLq_pls[of _ _ z,simp] + show ?thesis + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_zer_suc_casesE[of t _ _ y]) + apply(nrule r: nprv_exiE0[of z "eql zer (pls (Var z) t)"]) + apply(nrule r: nprv_clear3_3) + apply(nrule r: nprv_eql_symE0[of t]) + apply(nrule r: nprv_eql_substE01[of "suc (Var y)" t _ "eql zer (pls (Var z) (Var x))" x]) + apply(nrule r: nprv_addLemmaE[OF prv_pls_suc[of "Var z" "Var y",simplified]]) + apply(nrule r: nprv_eql_transE01[of zer "pls (Var z) (suc (Var y))" _ "suc (pls (Var z) (Var y))"]) + apply(nrule r: nprv_zer_suc_contrE0[of "pls (Var z) (Var y)"]) . +qed + +(* Rulification: *) +lemmas nprv_LLq_zer_eqlI = nprv_addImpLemmaI[OF prv_LLq_zer_imp_eql, simped, rotated 3] +lemmas nprv_LLq_zer_eqlE = nprv_addImpLemmaE[OF prv_LLq_zer_imp_eql, simped, rotated 1] + +lemmas nprv_LLq_zer_eqlE0 = nprv_LLq_zer_eqlE[OF nprv_hyp _, simped] +lemmas nprv_LLq_zer_eqlE1 = nprv_LLq_zer_eqlE[OF _ nprv_hyp, simped] +lemmas nprv_LLq_zer_eqlE01 = nprv_LLq_zer_eqlE[OF nprv_hyp nprv_hyp, simped] + + +lemma prv_sdsj_eql_imp_LLq: \ \O2\ +assumes [simp]: "t \ atrm" +shows "prv (imp (ldsj (map (\i. eql t (Num i)) (toN n))) (LLq t (Num n)))" +proof- + define z where "z \ getFr [xx,yy] [t] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ FvarsT t" + using getFr_FvarsT_Fvars[of "[xx,yy]" "[t]" "[]"] unfolding z_def[symmetric] by auto + note imp[rule del, intro!] note dsj[intro!] + show ?thesis + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_ldsjE0) + subgoal for i + apply(nrule r: nprv_eql_substE[of _ t "Num i" "LLq (Var z) (Num n)" z]) + subgoal by (nrule r: nprv_hyp) + subgoal by (nprover3 r1: nprv_addLemmaE[OF leq_prv_LLq_Num]) + subgoal by (nrule r: nprv_hyp) . . +qed + +(* Rulification: *) +declare subset_eq[simp] +lemmas nprv_sdsj_eql_LLqI = nprv_addImpLemmaI[OF prv_sdsj_eql_imp_LLq, simped, rotated 3] +lemmas nprv_sdsj_eql_LLqE = nprv_addImpLemmaE[OF prv_sdsj_eql_imp_LLq, simped, rotated 1] +declare subset_eq[simp del] + +lemmas nprv_sdsj_eql_LLqE0 = nprv_sdsj_eql_LLqE[OF nprv_hyp _, simped] +lemmas nprv_sdsj_eql_LLqE1 = nprv_sdsj_eql_LLqE[OF _ nprv_hyp, simped] +lemmas nprv_sdsj_eql_LLqE01 = nprv_sdsj_eql_LLqE[OF nprv_hyp nprv_hyp, simped] + +lemmas O2I = nprv_sdsj_eql_LLqI +lemmas O2E = nprv_sdsj_eql_LLqE +lemmas O2E0 = nprv_sdsj_eql_LLqE0 +lemmas O2E1 = nprv_sdsj_eql_LLqE1 +lemmas O2E01 = nprv_sdsj_eql_LLqE01 +(* *) + +lemma prv_LLq_imp_sdsj_eql: \ \O3\ +assumes [simp]: "t \ atrm" +shows "prv (imp (LLq t (Num n)) (ldsj (map (\i. eql t (Num i)) (toN n))))" +using assms proof(induction n arbitrary: t) + case (0 t) note 0[simp] + note prv_LLq_zer_imp_eql[OF 0,simp] + show ?case + by (nprover4 r1: nprv_prvI r2: nprv_impI r3: nprv_ldsjI r4: prv_nprv1I) +next + case (Suc n) note t[simp] = `t \ atrm` + define z where "z \ getFr [xx,yy,zz] [t] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ zz" "zz \ z" "z \ FvarsT t" + using getFr_FvarsT_Fvars[of "[xx,yy,zz]" "[t]" "[]"] unfolding z_def[symmetric] by auto + note subset_eq[simp] + have [simp]: "eql t zer \ (\x. eql t (Num x)) ` {0..Suc n}" by (force simp: image_def) + have [simp]: "\i. i \ n \ + eql (suc (Var z)) (suc (Num i)) \ (\x. eql (suc (Var z)) (Num x)) ` {0..Suc n}" + by (auto simp: image_def intro!: bexI[of _ "Suc _"]) + show ?case + apply(nrule r: nprv_prvI) + apply(nrule2 r: nprv_zer_suc_casesE[of t _ _ z]) + subgoal by (nprover3 r1: nprv_impI r2: nprv_clear2_1 r3: nprv_ldsjI) + subgoal + apply(nrule r: nprv_eql_substE[of _ t "suc (Var z)" + "imp (LLq (Var xx) (suc (Num n))) (ldsj (map (\i. eql (Var xx) (Num i)) (toN (Suc n))))" xx]) + apply(nrule r: nprv_clear) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_LLq_sucE0) + apply(nrule r: nprv_addImpLemmaE[OF Suc.IH[of "Var z", simplified]]) + apply(nrule r: nprv_ldsjE0) + subgoal for i apply(nrule r: nprv_ldsjI[of _ "eql (suc (Var z)) (suc (Num i))"]) + apply(nrule r: nprv_suc_congI) . . . +qed + +(* Rulification: *) +declare subset_eq[simp] +lemmas prv_LLq_sdsj_eqlI = nprv_addImpLemmaI[OF prv_LLq_imp_sdsj_eql, simped, rotated 3] +lemmas prv_LLq_sdsj_eqlE = nprv_addImpLemmaE[OF prv_LLq_imp_sdsj_eql, simped, rotated 1] +declare subset_eq[simp del] + +lemmas prv_LLq_sdsj_eqlE0 = prv_LLq_sdsj_eqlE[OF nprv_hyp _, simped] +lemmas prv_LLq_sdsj_eqlE1 = prv_LLq_sdsj_eqlE[OF _ nprv_hyp, simped] +lemmas prv_LLq_sdsj_eqlE01 = prv_LLq_sdsj_eqlE[OF nprv_hyp nprv_hyp, simped] + +lemmas O3I = prv_LLq_sdsj_eqlI +lemmas O3E = prv_LLq_sdsj_eqlE +lemmas O3E0 = prv_LLq_sdsj_eqlE0 +lemmas O3E1 = prv_LLq_sdsj_eqlE1 +lemmas O3E01 = prv_LLq_sdsj_eqlE01 + +(* *) +lemma not_leq_prv_neg_LLq_Num: +assumes "\ m \ n" (* This is just m < n, of course. *) +shows "prv (neg (LLq (Num m) (Num n)))" +proof- + have [simp]: "\i. i \ n \ prv (imp (eql (Num m) (Num i)) fls)" + unfolding neg_def[symmetric] + using assms by (intro diff_prv_eql_Num) simp + show ?thesis + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_negI) + apply(nrule r: O3E0) + apply(nrule r: nprv_ldsjE0) + apply(nrule r: nprv_clear3_2) + apply(nrule r: nprv_clear2_2) + apply(nrule r: prv_nprv1I) . +qed + +lemma consistent_prv_LLq_Num_leq: +assumes consistent "prv (LLq (Num m) (Num n))" +shows "m \ n" +by (metis Num assms consistent_def LLq not_leq_prv_neg_LLq_Num num prv_neg_fls subsetCE) +(* *) + +lemma prv_ball_NumI: \ \O4\ +assumes [simp]: "x \ var" "\ \ fmla" +and [simp]: "\ i. i \ n \ prv (subst \ (Num i) x)" +shows "prv (ball x (Num n) \)" +apply(nrule r: nprv_prvI) +apply(nrule r: nprv_ballI) +apply(nrule r: O3E0) +apply(nrule r: nprv_clear2_2) +apply(nrule r: nprv_ldsjE0) +apply(nrule r: nprv_clear2_2) +apply(nrule r: nprv_eql_substE[of _ "Var x" "Num _" \ x]) +apply(nrule r: prv_nprvI) . + +lemmas O4 = prv_ball_NumI + +lemma prv_bexi_NumI: \ \O5\ +assumes [simp]: "x \ var" "\ \ fmla" +and [simp]: "i \ n" "prv (subst \ (Num i) x)" +shows "prv (bexi x (Num n) \)" +proof- + note leq_prv_LLq_Num[simp] + show ?thesis + by (nprover4 r1: nprv_prvI r2: nprv_bexiI[of _ _ "Num i"] r3: prv_nprvI r4: prv_nprvI) +qed + +lemmas O5 = prv_bexi_NumI + +lemma prv_LLq_Num_imp_Suc: \ \O6\ +assumes [simp]: "t \ atrm" +shows "prv (imp (LLq t (Num n)) (LLq t (suc (Num n))))" +proof- + have [simp]: "\i. i \ n \ prv (LLq (Num i) (suc (Num n)))" + apply(subst Num.simps(2)[symmetric]) + by (rule leq_prv_LLq_Num) simp + show ?thesis + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_impI) + apply(nrule r: O3E0) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_ldsjE0) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_eql_substE[of _ t "Num _" "LLq (Var xx) (suc (Num n))" xx]) + apply(nrule r: prv_nprvI) . +qed + +(* Rulification: *) +lemmas nprv_LLq_Num_SucI = nprv_addImpLemmaI[OF prv_LLq_Num_imp_Suc, simped, rotated 3] +lemmas nprv_LLq_Num_SucE = nprv_addImpLemmaE[OF prv_LLq_Num_imp_Suc, simped, rotated 1] + +lemmas nprv_LLq_Num_SucE0 = nprv_LLq_Num_SucE[OF nprv_hyp _, simped] +lemmas nprv_LLq_Num_SucE1 = nprv_LLq_Num_SucE[OF _ nprv_hyp, simped] +lemmas nprv_LLq_Num_SucE01 = nprv_LLq_Num_SucE[OF nprv_hyp nprv_hyp, simped] + +lemmas O6I = nprv_LLq_Num_SucI +lemmas O6E = nprv_LLq_Num_SucE +lemmas O6E0 = nprv_LLq_Num_SucE0 +lemmas O6E1 = nprv_LLq_Num_SucE1 +lemmas O6E01 = nprv_LLq_Num_SucE01 + +text \Crucial for proving O7:\ +lemma prv_LLq_suc_Num_pls_Num: +assumes [simp]: "t \ atrm" +shows "prv (LLq (suc (Num n)) (pls (suc t) (Num n)))" +proof- + define z where "z \ getFr [xx,yy,zz] [t] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ zz" "zz \ z" "z \ FvarsT t" + using getFr_FvarsT_Fvars[of "[xx,yy,zz]" "[t]" "[]"] unfolding z_def[symmetric] by auto + show ?thesis + proof(induction n) + case 0 + have "prv (exi z (eql (pls (suc t) zer) (pls (Var z) (suc zer))))" + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_exiI[of _ _ t]) + apply(nrule r: nprv_addLemmaE[OF prv_pls_zer[of "suc t"]]) + apply(nrule r: nprv_eql_substE[of _ "pls (suc t) zer" "suc t" "eql (Var z) (pls t (suc zer))" z]) + apply(nrule r: nprv_clear) + apply(nrule r: nprv_eql_symI) + apply(nrule r: prv_nprvI) + apply(nrule r: prv_pls_suc_zer) . + thus ?case by (simp add: LLq_pls[of _ _ z]) + next + case (Suc n) + have nn: "suc (Num n) = suc (Num n)" by simp + note Suc.IH[simp] + show ?case + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_addLemmaE[OF prv_pls_suc[of "suc t" "Num n"]]) + apply(nrule r: nprv_eql_substE[of _ "pls (suc t) (suc (Num n))" "suc (pls (suc t) (Num n))" + "LLq (suc (suc (Num n))) (Var z)" z]) + apply(nrule r: nprv_clear) + apply(nrule r: nprv_suc_mono_LLqI) + apply(nrule r: prv_nprvI) . + qed +qed + +lemma prv_Num_LLq_imp_eql_suc: \ \O7\ +assumes [simp]: "t \ atrm" +shows "prv (imp (LLq (Num n) t) + (dsj (eql (Num n) t) + (LLq (suc (Num n)) t)))" +proof- + define z where "z \ getFr [xx,yy,zz] [t] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ zz" "zz \ z" "z \ FvarsT t" + using getFr_FvarsT_Fvars[of "[xx,yy,zz]" "[t]" "[]"] unfolding z_def[symmetric] by auto + define x where "x \ getFr [xx,yy,zz,z] [t] []" + have x_facts[simp]: "x \ var" "x \ xx" "x \ yy" "x \ zz" "zz \ x" "x \ z" "z \ x" "x \ FvarsT t" + using getFr_FvarsT_Fvars[of "[xx,yy,zz,z]" "[t]" "[]"] unfolding x_def[symmetric] by auto + define y where "y \ getFr [x,z] [t] []" + have y_facts[simp]: "y \ var" "y \ FvarsT t" "x \ y" "y \ x" "z \ y" "y \ z" + using getFr_FvarsT_Fvars[of "[x,z]" "[t]" "[]"] unfolding y_def[symmetric] by auto + have [simp]: "prv (eql (pls zer (Num n)) (Num n))" + by (subst Num.simps(1)[symmetric]) (metis plus_nat.add_0 prv_eql_pls_plus) + have [simp]: "prv (LLq (suc (Num n)) (pls (suc (Var x)) (Num n)))" + by (simp add: prv_LLq_suc_Num_pls_Num) + + note LLq_pls[of "Num n" t z, simplified, simp] + show ?thesis + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_exiE0) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_zer_suc_casesE[of "Var z" _ _ x]) + subgoal + apply(nrule r: nprv_dsjIL) + apply(nrule r: nprv_impI_rev2[of "{eql (Var z) zer}" "eql t (pls (Var z) (Num n))"]) + apply(nrule r: nprv_eql_substE + [of _ "Var z" zer "imp (eql t (pls (Var y) (Num n))) (eql (Num n) t)" y]) + apply(nrule r: nprv_clear) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_eql_substE[of _ t "pls zer (Num n)" "eql (Num n) (Var y)" y]) + apply(nrule r: nprv_clear) + apply(nrule r: prv_nprvI) + apply(nrule r: prv_prv_eql_sym) . + subgoal + apply(nrule r: nprv_dsjIR) + apply(nrule r: nprv_impI_rev2[of "{eql (Var z) (suc (Var x))}" "eql t (pls (Var z) (Num n))"]) + apply(nrule r: nprv_eql_substE + [of _ "Var z" "suc (Var x)" "imp (eql t (pls (Var y) (Num n))) (LLq (suc (Num n)) t)" y]) + (* *) + apply(nrule r: nprv_clear) + apply(nrule r: nprv_impI) + apply(nrule r: nprv_eql_substE + [of _ t "pls (suc (Var x)) (Num n)" "LLq (suc (Num n)) (Var y)" y]) + apply(nrule r: prv_nprvI) . . +qed + +(* Rulification (this one is slightly more complex, as it puts together impE with dsjE): *) +lemma prv_Num_LLq_eql_sucE: +"nprv F (LLq (Num n) t) \ + nprv (insert (eql (Num n) t) F) \ \ + nprv (insert (LLq (suc (Num n)) t) F) \ \ + t \ atrm \ F \ fmla \ finite F \ \ \ fmla \ + nprv F \" +apply(nrule r: nprv_addImpLemmaE[OF prv_Num_LLq_imp_eql_suc]) +apply(nrule2 r: nprv_dsjE0[of "eql (Num n) t" "LLq (suc (Num n)) t"]) +subgoal by (nrule r: nprv_mono[of "insert (eql (Num n) t) F"]) +subgoal by (nrule r: nprv_mono[of "insert (LLq (suc (Num n)) t) F"]) . + +lemmas prv_Num_LLq_eql_sucE0 = prv_Num_LLq_eql_sucE[OF nprv_hyp _ _, simped] +lemmas prv_Num_LLq_eql_sucE1 = prv_Num_LLq_eql_sucE[OF _ nprv_hyp _, simped] +lemmas prv_Num_LLq_eql_sucE2 = prv_Num_LLq_eql_sucE[OF _ _ nprv_hyp, simped] +lemmas prv_Num_LLq_eql_sucE01 = prv_Num_LLq_eql_sucE[OF nprv_hyp nprv_hyp _, simped] +lemmas prv_Num_LLq_eql_sucE02 = prv_Num_LLq_eql_sucE[OF nprv_hyp _ nprv_hyp, simped] +lemmas prv_Num_LLq_eql_sucE12 = prv_Num_LLq_eql_sucE[OF _ nprv_hyp nprv_hyp, simped] +lemmas prv_Num_LLq_eql_sucE012 = prv_Num_LLq_eql_sucE[OF nprv_hyp nprv_hyp nprv_hyp, simped] +(* *) + +lemmas O7E = prv_Num_LLq_eql_sucE +lemmas O7E0 = prv_Num_LLq_eql_sucE0 +(**) + +(* Although we work in intuitionistic logic, +Q decides equality of arbitrary entities with numerals: *) +lemma prv_dsj_eql_Num_neg: +assumes "t \ atrm" +shows "prv (dsj (eql t (Num n)) (neg (eql t (Num n))))" +using assms proof(induction n arbitrary: t) + case [simp]:(0 t) + define z where "z \ getFr [xx,yy,zz] [t] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ zz" "zz \ z" "z \ FvarsT t" + using getFr_FvarsT_Fvars[of "[xx,yy,zz]" "[t]" "[]"] unfolding z_def[symmetric] by auto + show ?case + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_zer_suc_casesE[of t _ _ z]) + subgoal by (nrule r: nprv_dsjIL) + subgoal by (nprover3 r1: nprv_dsjIR r2: nprv_negI r3: nprv_zer_suc_2contrE01) . +next + case (Suc n) note `t \ atrm`[simp] + define z where "z \ getFr [xx,yy,zz] [t] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ zz" "zz \ z" "z \ FvarsT t" + using getFr_FvarsT_Fvars[of "[xx,yy,zz]" "[t]" "[]"] unfolding z_def[symmetric] by auto + show ?case + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_zer_suc_casesE[of t _ _ z]) + subgoal by (nprover3 r1: nprv_dsjIR r2: nprv_negI r3: nprv_zer_suc_2contrE01) + subgoal + apply(nrule r: nprv_eql_substE [of _ t "suc (Var z)" + "dsj (eql (Var z) (suc (Num n))) (neg (eql (Var z) (suc (Num n))))" z]) + apply(nrule r: nprv_clear) + apply(nrule r: nprv_addLemmaE[OF Suc.IH[of "Var z"]]) + apply(nrule r: nprv_dsjE0) + subgoal by (nprover2 r1: nprv_dsjIL r2: nprv_suc_congI) + subgoal by (nprover4 r1: nprv_dsjIR r2: nprv_negI r3: nprv_negE0 r4: nprv_eql_sucI) . . +qed + +(* Rulification: *) +lemmas nprv_eql_Num_casesE = nprv_addDsjLemmaE[OF prv_dsj_eql_Num_neg, simped, rotated] + +lemmas nprv_eql_Num_casesE0 = nprv_eql_Num_casesE[OF nprv_hyp _, simped] +lemmas nprv_eql_Num_casesE1 = nprv_eql_Num_casesE[OF _ nprv_hyp, simped] +lemmas nprv_eql_Num_casesE01 = nprv_eql_Num_casesE[OF nprv_hyp nprv_hyp, simped] +(* *) + +lemma prv_LLq_Num_dsj: \ \O8\ +assumes [simp]: "t \ atrm" +shows "prv (dsj (LLq t (Num n)) (LLq (Num n) t))" +proof(induction n) + case 0 + note prv_LLq_zer[simp] + show ?case by (nprover3 r1: nprv_prvI r2: nprv_dsjIR r3: prv_nprvI) +next + case (Suc n) + have nn: "suc (Num n) = Num (Suc n)" by simp + have [simp]: "prv (LLq (Num n) (suc (Num n)))" + apply(subst nn) by (rule leq_prv_LLq_Num) simp + show ?case + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_addLemmaE[OF Suc.IH]) + apply(nrule r: nprv_dsjE0) + subgoal by (nprover2 r1: nprv_dsjIL r2: O6I) + subgoal + apply(nrule r: nprv_clear2_2) + apply(nrule2 r: nprv_eql_Num_casesE[of t n]) + subgoal by (nprover3 r1: nprv_dsjIL + r2: nprv_eql_substE[of _ t "Num n" "LLq (Var xx) (suc (Num n))" xx] + r3: prv_nprvI) + subgoal + apply(nrule r: O7E0[of n t]) + subgoal by (nprover2 r1: nprv_eql_symE0 r2: nprv_negE01 ) + subgoal by (nrule r: nprv_dsjIR) . . . +qed + +(* Rulification: *) +lemma prv_LLq_Num_casesE: +"nprv (insert (LLq t (Num n)) F) \ \ + nprv (insert (LLq (Num n) t) F) \ \ + t \ atrm \ F \ fmla \ finite F \ \ \ fmla \ + nprv F \" +by (rule nprv_addDsjLemmaE[OF prv_LLq_Num_dsj]) auto + +lemmas prv_LLq_Num_casesE0 = prv_LLq_Num_casesE[OF nprv_hyp _, simped] +lemmas prv_LLq_Num_casesE1 = prv_LLq_Num_casesE[OF _ nprv_hyp, simped] +lemmas prv_LLq_Num_casesE01 = prv_LLq_Num_casesE[OF nprv_hyp nprv_hyp, simped] + +lemmas O8E = prv_LLq_Num_casesE +lemmas O8E0 = prv_LLq_Num_casesE0 +lemmas O8E1 = prv_LLq_Num_casesE1 +lemmas O8E01 = prv_LLq_Num_casesE01 +(* *) + +lemma prv_imp_LLq_neg_Num_suc: +assumes [simp]: "t \ atrm" +shows "prv (imp (LLq t (suc (Num n))) + (imp ((neg (eql t (suc (Num n))))) + (LLq t (Num n))))" +apply(nrule r: nprv_prvI) +apply(nrule r: nprv_impI) +apply(nrule r: nprv_impI) +apply(nrule r: O3E0[of t "Suc n"]) +apply(nrule r: nprv_clear3_3) +apply(nrule r: nprv_ldsjE0) +subgoal for i +apply(nrule r: nprv_clear3_2) +apply(nrule r: nprv_impI_rev2[of "{eql t (Num i)}" "neg (eql t (suc (Num n)))"]) +apply(nrule r: nprv_eql_substE[of _ t "Num i" + "imp (neg (eql (Var xx) (suc (Num n)))) (LLq (Var xx) (Num n))" xx]) +apply(nrule r: nprv_clear) +apply(nrule r: nprv_impI) +apply(cases "i = Suc n") +subgoal by (nprover2 r1: nprv_negE0 r2: nprv_eql_reflI) +subgoal by (nprover2 r1: prv_nprvI r2: leq_prv_LLq_Num) . . + +(* Rulification *) +lemmas nprv_LLq_neg_Num_sucI = nprv_addImp2LemmaI[OF prv_imp_LLq_neg_Num_suc, simped, rotated 3] +lemmas nprv_LLq_neg_Num_sucE = nprv_addImp2LemmaE[OF prv_imp_LLq_neg_Num_suc, simped, rotated 1] + +lemmas nprv_LLq_neg_Num_sucE0 = nprv_LLq_neg_Num_sucE[OF nprv_hyp _ _, simped] +lemmas nprv_LLq_neg_Num_sucE1 = nprv_LLq_neg_Num_sucE[OF _ nprv_hyp _, simped] +lemmas nprv_LLq_neg_Num_sucE2 = nprv_LLq_neg_Num_sucE[OF _ _ nprv_hyp, simped] +lemmas nprv_LLq_neg_Num_sucE01 = nprv_LLq_neg_Num_sucE[OF nprv_hyp nprv_hyp _, simped] +lemmas nprv_LLq_neg_Num_sucE02 = nprv_LLq_neg_Num_sucE[OF nprv_hyp _ nprv_hyp, simped] +lemmas nprv_LLq_neg_Num_sucE12 = nprv_LLq_neg_Num_sucE[OF _ nprv_hyp nprv_hyp, simped] +lemmas nprv_LLq_neg_Num_sucE012 = nprv_LLq_neg_Num_sucE[OF nprv_hyp nprv_hyp nprv_hyp, simped] +(* *) + + +lemma prv_ball_Num_imp_ball_suc: \ \O9\ +assumes [simp]: "x \ var" "\ \ fmla" +shows "prv (imp (ball x (Num n) \) + (ball x (suc (Num n)) (imp (neg (eql (Var x) (suc (Num n)))) \)))" +apply(nrule r: nprv_prvI) +apply(nrule r: nprv_impI) +apply(nrule r: nprv_ballI) +apply(nrule r: nprv_impI) +apply(nrule r: nprv_LLq_neg_Num_sucE01) +apply(nrule r: nprv_clear4_2) +apply(nrule r: nprv_clear3_2) +apply(nrule r: nprv_ballE0[of x "Num n" \ _ "Var x"]) . + +(* Rulification: *) +lemmas prv_ball_Num_ball_sucI = nprv_addImpLemmaI[OF prv_ball_Num_imp_ball_suc, simped, rotated 4] +lemmas prv_ball_Num_ball_sucE = nprv_addImpLemmaE[OF prv_ball_Num_imp_ball_suc, simped, rotated 2] + +lemmas prv_ball_Num_ball_sucE0 = prv_ball_Num_ball_sucE[OF nprv_hyp _, simped] +lemmas prv_ball_Num_ball_sucE1 = prv_ball_Num_ball_sucE[OF _ nprv_hyp, simped] +lemmas prv_ball_Num_ball_sucE01 = prv_ball_Num_ball_sucE[OF nprv_hyp nprv_hyp, simped] + +lemmas O9I = prv_ball_Num_ball_sucI +lemmas O9E = prv_ball_Num_ball_sucE +lemmas O9E0 = prv_ball_Num_ball_sucE0 +lemmas O9E1 = prv_ball_Num_ball_sucE1 +lemmas O9E01 = prv_ball_Num_ball_sucE01 + + +subsection \Verifying the abstract ordering assumptions\ + +lemma LLq_num: +assumes \[simp]: "\ \ fmla" "Fvars \ = {zz}" and q: "q \ num" and p: "\ p \ num. prv (subst \ p zz)" +shows "prv (all zz (imp (LLq (Var zz) q) \))" +proof- + obtain n where q: "q = Num n" using q num_Num by auto +\ \NB: We did not need the whole strength of the assumption p -- we only needed that to hold for +numerals smaller than n. However, the abstract framework allowed us to make this strong assumption, +and did not need to even assume an order on the numerals.\ + show ?thesis unfolding q ball_def[symmetric] using p p num_Num by (intro O4) auto +qed + +lemma LLq_num2: +assumes "p \ num" +shows "\P\num. finite P \ prv (dsj (sdsj {eql (Var yy) r |r. r \ P}) (LLq p (Var yy)))" +proof- + obtain n where q[simp]: "p = Num n" using assms num_Num by auto + have [simp]: "{eql (Var yy) r |r. \i. r = Num i \ i \ n} \ fmla" by auto + show ?thesis + apply(nrule r: exI[of _ "{Num i | i . i \ n}"]) + apply(nrule r: nprv_prvI) + apply(nrule r: O8E[of "Var yy" n]) + subgoal + apply(nrule r: nprv_dsjIL) + apply(nrule r: O3E0) + apply(nrule r: nprv_ldsjE0) + apply(nrule r: nprv_sdsjI[of _ "eql (Var yy) (Num _)"]) + apply(nrule r: nprv_hyp) . + subgoal by (nrule r: nprv_dsjIR) . +qed + +end \ \context @{locale Deduct_Q}\ + +sublocale Deduct_Q < lab: Deduct_with_PseudoOrder where Lq = "LLq (Var zz) (Var yy)" +apply standard apply auto[] using Fvars_Lq apply auto[] +using LLq_num LLq_num2 apply auto +done + +(*<*) +end +(*>*) diff --git a/thys/Syntax_Independent_Logic/Natural_Deduction.thy b/thys/Syntax_Independent_Logic/Natural_Deduction.thy new file mode 100644 --- /dev/null +++ b/thys/Syntax_Independent_Logic/Natural_Deduction.thy @@ -0,0 +1,866 @@ +chapter \Natural Deduction\ + +(*<*) +theory Natural_Deduction imports Deduction +begin +(*>*) + +text \We develop a natural deduction system based on the Hilbert system.\ + +context Deduct_with_False_Disj +begin + +section \Natural Deduction from the Hilbert System\ + +definition nprv :: "'fmla set \ 'fmla \ bool" where +"nprv F \ \ prv (imp (scnj F) \)" + +lemma nprv_hyp[simp,intro]: +"\ \ F \ F \ fmla \ finite F \ nprv F \" +unfolding nprv_def +by (simp add: prv_scnj_imp_in subset_iff) + + +section \Structural Rules for the Natural Deduction Relation\ + +lemma prv_nprv0I: "prv \ \ \ \ fmla \ nprv {} \" +unfolding nprv_def by (simp add: prv_imp_triv) + +lemma prv_nprv_emp: "\ \ fmla \ prv \ \ nprv {} \" +using prv_nprv0I unfolding nprv_def +by (metis asList eqv finite.simps insert_not_empty lcnj.simps(1) ldsj.cases + list.simps(15) prv_eqvI prv_imp_mp prv_imp_tru scnj_def tru) + +lemma nprv_mono: +assumes "nprv G \" +and "F \ fmla" "finite F" "G \ F" "\ \ fmla" +shows "nprv F \" +using assms unfolding nprv_def +by (meson order_trans prv_prv_imp_trans prv_scnj_mono rev_finite_subset scnj) + +lemma nprv_cut: +assumes "nprv F \" and "nprv (insert \ F) \" +and "F \ fmla" "finite F" "\ \ fmla" "\ \ fmla" +shows "nprv F \" +using assms unfolding nprv_def +by (metis (full_types) cnj finite.insertI + insert_subset prv_imp_cnj prv_imp_cnj_scnj prv_imp_refl prv_prv_imp_trans scnj) + +lemma nprv_strong_cut2: +"nprv F \1 \ nprv (insert \1 F) \2 \ nprv (insert \2 (insert \1 F)) \ \ + F \ fmla \ finite F \ \1 \ fmla \ \2 \ fmla \ \ \ fmla \ + nprv F \" +by (meson finite.insertI insert_subsetI nprv_cut) + +lemma nprv_cut2: +"nprv F \1 \ nprv F \2 \ + F \ fmla \ finite F \ \1 \ fmla \ \2 \ fmla \ \ \ fmla \ + nprv (insert \2 (insert \1 F)) \ \ nprv F \" +by (meson finite.insertI insert_subsetI nprv_mono nprv_strong_cut2 subset_insertI) + +text \Useful for fine control of the eigenformula:\ + +lemma nprv_insertShiftI: +"nprv (insert \1 (insert \2 F)) \ \ nprv (insert \2 (insert \1 F)) \" +by (simp add: insert_commute) + +lemma nprv_insertShift2I: +"nprv (insert \3 (insert \1 (insert \2 F))) \ \ nprv (insert \1 (insert \2 (insert \3 F))) \" +by (simp add: insert_commute) + + +section \Back and Forth between Hilbert and Natural Deduction\ + +text \This is now easy, thanks to the large number of facts we have +proved for Hilbert-style deduction\ + +lemma prv_nprvI: "prv \ \ \ \ fmla \ F \ fmla \ finite F \ nprv F \" +using prv_nprv0I +by (simp add: nprv_def prv_imp_triv) + +thm prv_nprv0I + +lemma prv_nprv1I: +assumes "\ \ fmla" "\ \ fmla" and "prv (imp \ \)" +shows "nprv {\} \" +using assms unfolding nprv_def by (simp add: prv_scnj_imp) + +lemma prv_nprv2I: +assumes "prv (imp \1 (imp \2 \))" "\1 \ fmla" "\2 \ fmla" "\ \ fmla" +shows "nprv {\1,\2} \" +using assms unfolding nprv_def +by (meson cnj empty_subsetI finite.simps insert_subsetI prv_cnj_imp_monoR2 prv_prv_imp_trans prv_scnj2_imp_cnj scnj) + +lemma nprv_prvI: "nprv {} \ \ \ \ fmla \ prv \" +using prv_nprv_emp by auto + + +section \More Structural Properties\ + +lemma nprv_clear: "nprv {} \ \ F \ fmla \ finite F \ \ \ fmla \ nprv F \" +by (rule nprv_mono) auto + +lemma nprv_cut_set: +assumes F: "finite F" "F \ fmla" and G: "finite G" "G \ fmla" "\ \ fmla" +and n1: "\ \. \ \ G \ nprv F \" and n2: "nprv (G \ F) \" +shows "nprv F \" +using G F n1 n2 proof(induction arbitrary: F \) + case (insert \ G F \) + hence 0: "nprv F \" by auto + have 1: "nprv (insert \ F) \" + using insert.prems apply- apply(rule insert.IH) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by (meson finite.simps insert_subset nprv_mono subsetD subset_insertI) + by auto + show ?case using insert.prems by (intro nprv_cut[OF 0 1]) auto +qed(insert nprv_clear, auto) + +lemma nprv_clear2_1: +"nprv {\2} \ \ \1 \ fmla \ \2 \ fmla \ \ \ fmla \ + nprv {\1,\2} \" +by (rule nprv_mono) auto + +lemma nprv_clear2_2: +"nprv {\1} \ \ \1 \ fmla \ \2 \ fmla \ \ \ fmla \ + nprv {\1,\2} \" +by (rule nprv_mono) auto + +lemma nprv_clear3_1: +"nprv {\2,\3} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \ \ fmla \ + nprv {\1,\2,\3} \" +by (rule nprv_mono) auto + +lemma nprv_clear3_2: +"nprv {\1,\3} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \ \ fmla \ + nprv {\1,\2,\3} \" +by (rule nprv_mono) auto + +lemma nprv_clear3_3: +"nprv {\1,\2} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \ \ fmla \ + nprv {\1,\2,\3} \" +by (rule nprv_mono) auto + +lemma nprv_clear4_1: +"nprv {\2,\3,\4} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \4 \ fmla \\ \ fmla \ + nprv {\1,\2,\3,\4} \" +by (rule nprv_mono) auto + +lemma nprv_clear4_2: +"nprv {\1,\3,\4} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \4 \ fmla \ \ \ fmla \ + nprv {\1,\2,\3,\4} \" +by (rule nprv_mono) auto + +lemma nprv_clear4_3: +"nprv {\1,\2,\4} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \4 \ fmla \\ \ fmla \ + nprv {\1,\2,\3,\4} \" +by (rule nprv_mono) auto + +lemma nprv_clear4_4: +"nprv {\1,\2,\3} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \4 \ fmla \\ \ fmla \ + nprv {\1,\2,\3,\4} \" +by (rule nprv_mono) auto + +lemma nprv_clear5_1: +"nprv {\2,\3,\4,\5} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \4 \ fmla \ \5 \ fmla \ \ \ fmla \ + nprv {\1,\2,\3,\4,\5} \" +by (rule nprv_mono) auto + +lemma nprv_clear5_2: +"nprv {\1,\3,\4,\5} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \4 \ fmla \ \5 \ fmla \ \ \ fmla \ + nprv {\1,\2,\3,\4,\5} \" +by (rule nprv_mono) auto + +lemma nprv_clear5_3: +"nprv {\1,\2,\4,\5} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \4 \ fmla \ \5 \ fmla \ \ \ fmla \ + nprv {\1,\2,\3,\4,\5} \" +by (rule nprv_mono) auto + +lemma nprv_clear5_4: +"nprv {\1,\2,\3,\5} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \4 \ fmla \ \5 \ fmla \ \ \ fmla \ + nprv {\1,\2,\3,\4,\5} \" +by (rule nprv_mono) auto + +lemma nprv_clear5_5: +"nprv {\1,\2,\3,\4} \ \ \1 \ fmla \ \2 \ fmla \ \3 \ fmla \ \4 \ fmla \ \5 \ fmla \ \ \ fmla \ + nprv {\1,\2,\3,\4,\5} \" +by (rule nprv_mono) auto + + +section \Properties Involving Substitution\ + +lemma nprv_subst: +assumes "x \ var" "t \ trm" "\ \ fmla" "finite F" "F \ fmla" +and 1: "nprv F \" +shows "nprv ((\\. subst \ t x) ` F) (subst \ t x)" +using assms using prv_subst[OF _ _ _ 1[unfolded nprv_def]] unfolding nprv_def +by (intro prv_prv_imp_trans[OF _ _ _ prv_subst_scnj_imp]) auto + +lemma nprv_subst_fresh: +assumes 0: "x \ var" "t \ trm" "\ \ fmla" "finite F" "F \ fmla" +"nprv F \" and 1: "x \ \ (Fvars ` F)" +shows "nprv F (subst \ t x)" +proof- + have 2: "(\\. subst \ t x) ` F = F" unfolding image_def using assms by force + show ?thesis using nprv_subst[OF 0] unfolding 2 . +qed + +lemma nprv_subst_rev: +assumes 0: "x \ var" "y \ var" "\ \ fmla" "finite F" "F \ fmla" +and f: "y = x \ (y \ Fvars \ \ y \ \ (Fvars ` F))" +and 1: "nprv ((\\. subst \ (Var y) x) ` F) (subst \ (Var y) x)" +shows "nprv F \" +proof- + have 0: "subst (subst \ (Var y) x) (Var x) y = \" + using assms by (auto simp: subst_compose_eq_or) + have "nprv ((\\. subst \ (Var x) y) ` (\\. subst \ (Var y) x) ` F) \" + using assms apply(subst 0[symmetric]) by (rule nprv_subst) auto + moreover + have "prv (imp (scnj F) + (scnj ((\\. subst \ (Var x) y) ` (\\. subst \ (Var y) x) ` F)))" + using assms apply(intro prv_scnj_mono_imp) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal apply clarify + subgoal for _ _ \ + by (auto simp: subst_compose_eq_or intro!: bexI[of _ \] prv_imp_refl2) . . + ultimately show ?thesis + unfolding nprv_def using assms + apply- by(rule prv_prv_imp_trans) auto +qed + +lemma nprv_psubst: +assumes 0: "snd ` set txs \ var" "fst ` set txs \ trm" "\ \ fmla" "finite F" "F \ fmla" +"distinct (map snd txs)" +and 1: "nprv F \" +shows "nprv ((\\. psubst \ txs) ` F) (psubst \ txs)" +using assms unfolding nprv_def +apply(intro prv_prv_imp_trans[OF _ _ _ prv_psubst_scnj_imp]) +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by auto +subgoal using prv_psubst[OF _ _ _ 1[unfolded nprv_def]] + by (metis imp psubst_imp scnj) . + +section \Introduction and Elimination Rules\ + +text \We systematically leave the side-conditions at the end, to simplify reasoning.\ + +lemma nprv_impI: +"nprv (insert \ F) \ \ + F \ fmla \ finite F \ \ \ fmla \ \ \ fmla \ + nprv F (imp \ \)" +unfolding nprv_def +by (metis cnj finite.insertI insert_subset prv_cnj_imp prv_imp_cnj_scnj prv_imp_com prv_prv_imp_trans scnj) + +lemma nprv_impI_rev: +assumes "nprv F (imp \ \)" +and "F \ fmla" and "finite F" and "\ \ fmla" and "\ \ fmla" +shows "nprv (insert \ F) \" +using assms unfolding nprv_def +by (metis cnj finite.insertI insert_subset prv_cnj_imp_monoR2 prv_eqv_imp_transi + prv_eqv_scnj_insert prv_imp_com scnj) + +lemma nprv_impI_rev2: +assumes "nprv F (imp \ \)" and G: "insert \ F \ G" +and "G \ fmla" and "finite G" and "\ \ fmla" and "\ \ fmla" +shows "nprv G \" +using assms apply- apply(rule nprv_mono[of "insert \ F"]) +subgoal by (meson nprv_impI_rev order_trans rev_finite_subset subset_insertI) +by auto + +lemma nprv_mp: +"nprv F (imp \ \) \ nprv F \ \ + F \ fmla \ finite F \ \ \ fmla \ \ \ fmla \ + nprv F \" +unfolding nprv_def +by (metis (full_types) cnj prv_cnj_imp_monoR2 prv_imp_cnj prv_imp_refl prv_prv_imp_trans scnj) + +lemma nprv_impE: +"nprv F (imp \ \) \ nprv F \ \ nprv (insert \ F) \ \ + F \ fmla \ finite F \ \ \ fmla \ \ \ fmla \ \ \ fmla \ + nprv F \" +using nprv_cut nprv_mp by blast + +lemmas nprv_impE0 = nprv_impE[OF nprv_hyp _ _, simped] +lemmas nprv_impE1 = nprv_impE[OF _ nprv_hyp _, simped] +lemmas nprv_impE2 = nprv_impE[OF _ _ nprv_hyp, simped] +lemmas nprv_impE01 = nprv_impE[OF nprv_hyp nprv_hyp _, simped] +lemmas nprv_impE02 = nprv_impE[OF nprv_hyp _ nprv_hyp, simped] +lemmas nprv_impE12 = nprv_impE[OF _ nprv_hyp nprv_hyp, simped] +lemmas nprv_impE012 = nprv_impE[OF nprv_hyp nprv_hyp nprv_hyp, simped] + +lemma nprv_cnjI: +"nprv F \ \ nprv F \ \ + F \ fmla \ finite F \ \ \ fmla \ \ \ fmla \ + nprv F (cnj \ \)" +unfolding nprv_def by (simp add: prv_imp_cnj) + +lemma nprv_cnjE: +"nprv F (cnj \1 \2) \ nprv (insert \1 (insert \2 F)) \ \ + F \ fmla \ finite F \ \1 \ fmla \ \2 \ fmla \ \ \ fmla \ + nprv F \" +unfolding nprv_def +by (metis cnj nprv_cut2 nprv_def prv_imp_cnjL prv_imp_cnjR prv_prv_imp_trans scnj) + +lemmas nprv_cnjE0 = nprv_cnjE[OF nprv_hyp _, simped] +lemmas nprv_cnjE1 = nprv_cnjE[OF _ nprv_hyp, simped] +lemmas nprv_cnjE01 = nprv_cnjE[OF nprv_hyp nprv_hyp, simped] + +lemma nprv_dsjIL: +"nprv F \ \ + F \ fmla \ finite F \ \ \ fmla \ \ \ fmla \ + nprv F (dsj \ \)" +unfolding nprv_def by (meson dsj prv_dsj_impL prv_prv_imp_trans scnj) + +lemma nprv_dsjIR: +"nprv F \ \ + F \ fmla \ finite F \ \ \ fmla \ \ \ fmla \ + nprv F (dsj \ \)" +unfolding nprv_def by (meson dsj prv_dsj_impR prv_prv_imp_trans scnj) + +lemma nprv_dsjE: +assumes "nprv F (dsj \ \)" +and "nprv (insert \ F) \" "nprv (insert \ F) \" +and "F \ fmla" "finite F" "\ \ fmla" "\ \ fmla" "\ \ fmla" +shows "nprv F \" +proof- + have "nprv F (imp (dsj \ \) \)" + by (meson assms dsj imp nprv_def nprv_impI prv_imp_com prv_imp_dsjEE scnj) + hence "nprv (insert (dsj \ \) F) \" using assms + by (simp add: nprv_impI_rev) + thus ?thesis using assms by (meson dsj nprv_cut) +qed + +lemmas nprv_dsjE0 = nprv_dsjE[OF nprv_hyp _ _, simped] +lemmas nprv_dsjE1 = nprv_dsjE[OF _ nprv_hyp _, simped] +lemmas nprv_dsjE2 = nprv_dsjE[OF _ _ nprv_hyp, simped] +lemmas nprv_dsjE01 = nprv_dsjE[OF nprv_hyp nprv_hyp _, simped] +lemmas nprv_dsjE02 = nprv_dsjE[OF nprv_hyp _ nprv_hyp, simped] +lemmas nprv_dsjE12 = nprv_dsjE[OF _ nprv_hyp nprv_hyp, simped] +lemmas nprv_dsjE012 = nprv_dsjE[OF nprv_hyp nprv_hyp nprv_hyp, simped] + +lemma nprv_flsE: "nprv F fls \ F \ fmla \ finite F \ \ \ fmla \ nprv F \" +unfolding nprv_def using prv_prv_imp_trans scnj by blast + +lemmas nprv_flsE0 = nprv_flsE[OF nprv_hyp, simped] + +lemma nprv_truI: "F \ fmla \ finite F \ nprv F tru" +unfolding nprv_def by (simp add: prv_imp_tru) + +lemma nprv_negI: +"nprv (insert \ F) fls \ + F \ fmla \ finite F \ \ \ fmla \ + nprv F (neg \)" +unfolding neg_def by (auto intro: nprv_impI) + +lemma nprv_neg_fls: +"nprv F (neg \) \ nprv F \ \ + F \ fmla \ finite F \ \ \ fmla \ \ \ fmla \ + nprv F fls" +unfolding neg_def using nprv_mp by blast + +lemma nprv_negE: +"nprv F (neg \) \ nprv F \ \ + F \ fmla \ finite F \ \ \ fmla \ \ \ fmla \ + nprv F \" +using nprv_flsE nprv_neg_fls by blast + +lemmas nprv_negE0 = nprv_negE[OF nprv_hyp _, simped] +lemmas nprv_negE1 = nprv_negE[OF _ nprv_hyp, simped] +lemmas nprv_negE01 = nprv_negE[OF nprv_hyp nprv_hyp, simped] + +lemma nprv_scnjI: +"(\ \. \ \ G \ nprv F \) \ + F \ fmla \ finite F \ G \ fmla \ finite G \ + nprv F (scnj G)" +unfolding nprv_def by (simp add: prv_imp_scnj) + +lemma nprv_scnjE: +"nprv F (scnj G) \ nprv (G \ F) \ \ + F \ fmla \ finite F \ G \ fmla \ finite G \ \ \ fmla \ + nprv F \" +apply(rule nprv_cut_set[of _ G]) +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by (meson in_mono nprv_def prv_prv_imp_trans prv_scnj_imp_in scnj) . + +lemmas nprv_scnjE0 = nprv_scnjE[OF nprv_hyp _, simped] +lemmas nprv_scnjE1 = nprv_scnjE[OF _ nprv_hyp, simped] +lemmas nprv_scnjE01 = nprv_scnjE[OF nprv_hyp nprv_hyp, simped] + +lemma nprv_lcnjI: +"(\ \. \ \ set \s \ nprv F \) \ + F \ fmla \ finite F \ set \s \ fmla \ + nprv F (lcnj \s)" +unfolding nprv_def by (simp add: prv_imp_lcnj) + +lemma nprv_lcnjE: +"nprv F (lcnj \s) \ nprv (set \s \ F) \ \ + F \ fmla \ finite F \ set \s \ fmla \ \ \ fmla \ + nprv F \" +apply(rule nprv_cut_set[of _ "set \s \ F"]) +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by auto +subgoal + apply (elim UnE) + apply (meson lcnj nprv_def prv_lcnj_imp_in prv_prv_imp_trans scnj subset_code(1)) + by auto +subgoal by auto . + +lemmas nprv_lcnjE0 = nprv_lcnjE[OF nprv_hyp _, simped] +lemmas nprv_lcnjE1 = nprv_lcnjE[OF _ nprv_hyp, simped] +lemmas nprv_lcnjE01 = nprv_lcnjE[OF nprv_hyp nprv_hyp, simped] + +lemma nprv_sdsjI: +"nprv F \ \ + F \ fmla \ finite F \ G \ fmla \ finite G \ \ \ G \ + nprv F (sdsj G)" +unfolding nprv_def by (simp add: prv_imp_sdsj) + +lemma nprv_sdsjE: +assumes "nprv F (sdsj G)" +and "\ \. \ \ G \ nprv (insert \ F) \" +and "F \ fmla" "finite F" "G \ fmla" "finite G" "\ \ fmla" +shows "nprv F \" +proof- + have 0: "prv (imp (sdsj G) (imp (scnj F) \))" + using assms apply(intro prv_sdsj_imp) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by (meson nprv_def nprv_impI prv_imp_com scnj set_rev_mp) . + hence "nprv F (imp (sdsj G) \)" + by (simp add: 0 assms nprv_def prv_imp_com) + thus ?thesis using assms nprv_mp by blast +qed + +lemmas nprv_sdsjE0 = nprv_sdsjE[OF nprv_hyp _, simped] +lemmas nprv_sdsjE1 = nprv_sdsjE[OF _ nprv_hyp, simped] +lemmas nprv_sdsjE01 = nprv_sdsjE[OF nprv_hyp nprv_hyp, simped] + +lemma nprv_ldsjI: +"nprv F \ \ + F \ fmla \ finite F \ set \s \ fmla \ \ \ set \s \ + nprv F (ldsj \s)" +unfolding nprv_def by(simp add: prv_imp_ldsj) + +lemma nprv_ldsjE: +assumes "nprv F (ldsj \s)" +and "\ \. \ \ set \s \ nprv (insert \ F) \" +and "F \ fmla" "finite F" "set \s \ fmla" "\ \ fmla" +shows "nprv F \" +proof- + have 0: "prv (imp (ldsj \s) (imp (scnj F) \))" + using assms apply(intro prv_ldsj_imp) + subgoal by auto + subgoal by auto + subgoal by (meson nprv_def nprv_impI prv_imp_com scnj set_rev_mp) . + hence "nprv F (imp (ldsj \s) \)" + by (simp add: 0 assms nprv_def prv_imp_com) + thus ?thesis using assms nprv_mp by blast +qed + +lemmas nprv_ldsjE0 = nprv_ldsjE[OF nprv_hyp _, simped] +lemmas nprv_ldsjE1 = nprv_ldsjE[OF _ nprv_hyp, simped] +lemmas nprv_ldsjE01 = nprv_ldsjE[OF nprv_hyp nprv_hyp, simped] + +lemma nprv_allI: +"nprv F \ \ + F \ fmla \ finite F \ \ \ fmla \ x \ var \ x \ \ (Fvars ` F) \ + nprv F (all x \)" +unfolding nprv_def by (rule prv_all_imp_gen) auto + +lemma nprv_allE: +assumes "nprv F (all x \)" "nprv (insert (subst \ t x) F) \" +"F \ fmla" "finite F" "\ \ fmla" "t \ trm" "x \ var" "\ \ fmla" +shows "nprv F \" +proof- + have "nprv F (subst \ t x)" + using assms unfolding nprv_def by (meson all subst prv_all_inst prv_prv_imp_trans scnj) + thus ?thesis by (meson assms local.subst nprv_cut) +qed + +lemmas nprv_allE0 = nprv_allE[OF nprv_hyp _, simped] +lemmas nprv_allE1 = nprv_allE[OF _ nprv_hyp, simped] +lemmas nprv_allE01 = nprv_allE[OF nprv_hyp nprv_hyp, simped] + +lemma nprv_exiI: +"nprv F (subst \ t x) \ + F \ fmla \ finite F \ \ \ fmla \ t \ trm \ x \ var \ + nprv F (exi x \)" +unfolding nprv_def by (meson exi local.subst prv_exi_inst prv_prv_imp_trans scnj) + +lemma nprv_exiE: +assumes n: "nprv F (exi x \)" +and nn: "nprv (insert \ F) \" +and 0[simp]: "F \ fmla" "finite F" "\ \ fmla" "x \ var" "\ \ fmla" +and x: "x \ \ (Fvars ` F)" "x \ Fvars \" +shows "nprv F \" +proof- + have "nprv F (imp (exi x \) \)" unfolding nprv_def apply(rule prv_imp_com) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal apply(rule prv_exi_imp_gen) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal using x by auto + subgoal apply(rule prv_imp_com) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal using assms(3-5) assms(7) nn nprv_def nprv_impI by blast . . . + thus ?thesis using n assms nprv_mp by blast +qed + +lemmas nprv_exiE0 = nprv_exiE[OF nprv_hyp _, simped] +lemmas nprv_exiE1 = nprv_exiE[OF _ nprv_hyp, simped] +lemmas nprv_exiE01 = nprv_exiE[OF nprv_hyp nprv_hyp, simped] + + +section \Adding Lemmas of Various Shapes into the Proof Context\ + +lemma nprv_addLemmaE: +assumes "prv \" "nprv (insert \ F) \" +and "\ \ fmla" "\ \ fmla" and "F \ fmla" and "finite F" +shows "nprv F \" +using assms nprv_cut prv_nprvI by blast + +lemmas nprv_addLemmaE1 = nprv_addLemmaE[OF _ nprv_hyp, simped] + +lemma nprv_addImpLemmaI: +assumes "prv (imp \1 \2)" +and "F \ fmla" "finite F" "\1 \ fmla" "\2 \ fmla" +and "nprv F \1" +shows "nprv F \2" +by (meson assms nprv_def prv_prv_imp_trans scnj) + +lemma nprv_addImpLemmaE: +assumes "prv (imp \1 \2)" and "nprv F \1" and "nprv ((insert \2) F) \" +and "F \ fmla" "finite F" "\1 \ fmla" "\2 \ fmla" "\ \ fmla" +shows "nprv F \" +using assms nprv_addImpLemmaI nprv_cut by blast + +lemmas nprv_addImpLemmaE1 = nprv_addImpLemmaE[OF _ nprv_hyp _, simped] +lemmas nprv_addImpLemmaE2 = nprv_addImpLemmaE[OF _ _ nprv_hyp, simped] +lemmas nprv_addImpLemmaE12 = nprv_addImpLemmaE[OF _ nprv_hyp nprv_hyp, simped] + +lemma nprv_addImp2LemmaI: +assumes "prv (imp \1 (imp \2 \3))" +and "F \ fmla" "finite F" "\1 \ fmla" "\2 \ fmla" "\3 \ fmla" +and "nprv F \1" "nprv F \2" +shows "nprv F \3" +by (meson assms imp nprv_addImpLemmaI nprv_mp) + +lemma nprv_addImp2LemmaE: +assumes "prv (imp \1 (imp \2 \3))" and "nprv F \1" and "nprv F \2" and "nprv ((insert \3) F) \" +and "F \ fmla" "finite F" "\1 \ fmla" "\2 \ fmla" "\3 \ fmla" "\ \ fmla" +shows "nprv F \" +by (meson assms nprv_addImp2LemmaI nprv_cut) + +lemmas nprv_addImp2LemmaE1 = nprv_addImp2LemmaE[OF _ nprv_hyp _ _, simped] +lemmas nprv_addImp2LemmaE2 = nprv_addImp2LemmaE[OF _ _ nprv_hyp _, simped] +lemmas nprv_addImp2LemmaE3 = nprv_addImp2LemmaE[OF _ _ _ nprv_hyp, simped] +lemmas nprv_addImp2LemmaE12 = nprv_addImp2LemmaE[OF _ nprv_hyp nprv_hyp _, simped] +lemmas nprv_addImp2LemmaE13 = nprv_addImp2LemmaE[OF _ nprv_hyp _ nprv_hyp, simped] +lemmas nprv_addImp2LemmaE23 = nprv_addImp2LemmaE[OF _ _ nprv_hyp nprv_hyp, simped] +lemmas nprv_addImp2LemmaE123 = nprv_addImp2LemmaE[OF _ nprv_hyp nprv_hyp nprv_hyp, simped] + +lemma nprv_addImp3LemmaI: +assumes "prv (imp \1 (imp \2 (imp \3 \4)))" +and "F \ fmla" "finite F" "\1 \ fmla" "\2 \ fmla" "\3 \ fmla" "\4 \ fmla" +and "nprv F \1" "nprv F \2" "nprv F \3" +shows "nprv F \4" +by (meson assms imp nprv_addImpLemmaI nprv_mp) + +lemma nprv_addImp3LemmaE: +assumes "prv (imp \1 (imp \2 (imp \3 \4)))" and "nprv F \1" and "nprv F \2" and "nprv F \3" +and "nprv ((insert \4) F) \" +and "F \ fmla" "finite F" "\1 \ fmla" "\2 \ fmla" "\3 \ fmla" "\4 \ fmla" "\ \ fmla" +shows "nprv F \" +by (meson assms nprv_addImp3LemmaI nprv_cut) + +lemmas nprv_addImp3LemmaE1 = nprv_addImp3LemmaE[OF _ nprv_hyp _ _ _, simped] +lemmas nprv_addImp3LemmaE2 = nprv_addImp3LemmaE[OF _ _ nprv_hyp _ _, simped] +lemmas nprv_addImp3LemmaE3 = nprv_addImp3LemmaE[OF _ _ _ nprv_hyp _, simped] +lemmas nprv_addImp3LemmaE4 = nprv_addImp3LemmaE[OF _ _ _ _ nprv_hyp, simped] +lemmas nprv_addImp3LemmaE12 = nprv_addImp3LemmaE[OF _ nprv_hyp nprv_hyp _ _, simped] +lemmas nprv_addImp3LemmaE13 = nprv_addImp3LemmaE[OF _ nprv_hyp _ nprv_hyp _, simped] +lemmas nprv_addImp3LemmaE14 = nprv_addImp3LemmaE[OF _ nprv_hyp _ _ nprv_hyp, simped] +lemmas nprv_addImp3LemmaE23 = nprv_addImp3LemmaE[OF _ _ nprv_hyp nprv_hyp _, simped] +lemmas nprv_addImp3LemmaE24 = nprv_addImp3LemmaE[OF _ _ nprv_hyp _ nprv_hyp, simped] +lemmas nprv_addImp3LemmaE34 = nprv_addImp3LemmaE[OF _ _ _ nprv_hyp nprv_hyp, simped] +lemmas nprv_addImp3LemmaE123 = nprv_addImp3LemmaE[OF _ nprv_hyp nprv_hyp nprv_hyp _, simped] +lemmas nprv_addImp3LemmaE124 = nprv_addImp3LemmaE[OF _ nprv_hyp nprv_hyp _ nprv_hyp, simped] +lemmas nprv_addImp3LemmaE134 = nprv_addImp3LemmaE[OF _ nprv_hyp _ nprv_hyp nprv_hyp, simped] +lemmas nprv_addImp3LemmaE234 = nprv_addImp3LemmaE[OF _ _ nprv_hyp nprv_hyp nprv_hyp, simped] +lemmas nprv_addImp3LemmaE1234 = nprv_addImp3LemmaE[OF _ nprv_hyp nprv_hyp nprv_hyp nprv_hyp, simped] + +lemma nprv_addDsjLemmaE: +assumes "prv (dsj \1 \2)" and "nprv (insert \1 F) \" and "nprv ((insert \2) F) \" +and "F \ fmla" "finite F" "\1 \ fmla" "\2 \ fmla" "\ \ fmla" +shows "nprv F \" +by (meson assms dsj nprv_clear nprv_dsjE prv_nprv0I) + +lemmas nprv_addDsjLemmaE1 = nprv_addDsjLemmaE[OF _ nprv_hyp _, simped] +lemmas nprv_addDsjLemmaE2 = nprv_addDsjLemmaE[OF _ _ nprv_hyp, simped] +lemmas nprv_addDsjLemmaE12 = nprv_addDsjLemmaE[OF _ nprv_hyp nprv_hyp, simped] + +section \Rules for Equality\ + +text \Reflexivity:\ +lemma nprv_eql_reflI: "F \ fmla \ finite F \ t \ trm \ nprv F (eql t t)" +by (simp add: prv_eql_reflT prv_nprvI) + +lemma nprv_eq_eqlI: "t1 = t2 \ F \ fmla \ finite F \ t1 \ trm \ nprv F (eql t1 t2)" +by (simp add: prv_eql_reflT prv_nprvI) + +text \Symmetry:\ +lemmas nprv_eql_symI = nprv_addImpLemmaI[OF prv_eql_sym, simped, rotated 4] +lemmas nprv_eql_symE = nprv_addImpLemmaE[OF prv_eql_sym, simped, rotated 2] + +lemmas nprv_eql_symE0 = nprv_eql_symE[OF nprv_hyp _, simped] +lemmas nprv_eql_symE1 = nprv_eql_symE[OF _ nprv_hyp, simped] +lemmas nprv_eql_symE01 = nprv_eql_symE[OF nprv_hyp nprv_hyp, simped] + +text \Transitivity:\ +lemmas nprv_eql_transI = nprv_addImp2LemmaI[OF prv_eql_imp_trans, simped, rotated 5] +lemmas nprv_eql_transE = nprv_addImp2LemmaE[OF prv_eql_imp_trans, simped, rotated 3] + +lemmas nprv_eql_transE0 = nprv_eql_transE[OF nprv_hyp _ _, simped] +lemmas nprv_eql_transE1 = nprv_eql_transE[OF _ nprv_hyp _, simped] +lemmas nprv_eql_transE2 = nprv_eql_transE[OF _ _ nprv_hyp, simped] +lemmas nprv_eql_transE01 = nprv_eql_transE[OF nprv_hyp nprv_hyp _, simped] +lemmas nprv_eql_transE02 = nprv_eql_transE[OF nprv_hyp _ nprv_hyp, simped] +lemmas nprv_eql_transE12 = nprv_eql_transE[OF _ nprv_hyp nprv_hyp, simped] +lemmas nprv_eql_transE012 = nprv_eql_transE[OF nprv_hyp nprv_hyp nprv_hyp, simped] + +text \Substitutivity:\ +lemmas nprv_eql_substI = +nprv_addImp2LemmaI[OF prv_eql_subst_trm_rev, simped, rotated 6] +lemmas nprv_eql_substE = nprv_addImp2LemmaE[OF prv_eql_subst_trm_rev, simped, rotated 4] + +lemmas nprv_eql_substE0 = nprv_eql_substE[OF nprv_hyp _ _, simped] +lemmas nprv_eql_substE1 = nprv_eql_substE[OF _ nprv_hyp _, simped] +lemmas nprv_eql_substE2 = nprv_eql_substE[OF _ _ nprv_hyp, simped] +lemmas nprv_eql_substE01 = nprv_eql_substE[OF nprv_hyp nprv_hyp _, simped] +lemmas nprv_eql_substE02 = nprv_eql_substE[OF nprv_hyp _ nprv_hyp, simped] +lemmas nprv_eql_substE12 = nprv_eql_substE[OF _ nprv_hyp nprv_hyp, simped] +lemmas nprv_eql_substE012 = nprv_eql_substE[OF nprv_hyp nprv_hyp nprv_hyp, simped] + + +section \Other Rules\ + +lemma nprv_cnjH: +"nprv (insert \1 (insert \2 F)) \ \ + F \ fmla \ finite F \ \1 \ fmla \ \2 \ fmla \ \ \ fmla \ + nprv (insert (cnj \1 \2) F) \" +apply(rule nprv_cut2[of _ \1 \2]) +subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI) +subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI) +subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI) +subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI) +subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI) +subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI) +subgoal by (auto simp: nprv_impI_rev prv_imp_cnjL prv_imp_cnjR prv_nprvI) +by (meson cnj finite.insertI insert_iff insert_subset nprv_mono subset_insertI) + +lemma nprv_exi_commute: +assumes [simp]: "x \ var" "y \ var" "\ \ fmla" +shows "nprv {exi x (exi y \)} (exi y (exi x \))" +apply(rule nprv_exiE0[of x "exi y \"], auto) +apply(rule nprv_clear2_2, auto) +apply(rule nprv_exiE0[of y \], auto) +apply(rule nprv_clear2_2, auto) +apply(rule nprv_exiI[of _ _ "Var y"], auto) +by (rule nprv_exiI[of _ _ "Var x"], auto) + +lemma prv_exi_commute: +assumes [simp]: "x \ var" "y \ var" "\ \ fmla" +shows "prv (imp (exi x (exi y \)) (exi y (exi x \)))" +apply(rule nprv_prvI, auto) +apply(rule nprv_impI, auto) +by (rule nprv_exi_commute, auto) + +end (* context Deduct_with_False_Disj *) + + +section \Natural Deduction for the Exists-Unique Quantifier\ + +context Deduct_with_False_Disj_Rename +begin + +lemma nprv_exuI: +assumes n1: "nprv F (subst \ t x)" and n2: "nprv (insert \ F) (eql (Var x) t)" +and i[simp]: "F \ fmla" "finite F" "\ \ fmla" "t \ trm" "x \ var" "x \ FvarsT t" +and u: "x \ (\\ \ F. Fvars \)" +shows "nprv F (exu x \)" +proof- + define z where "z \ getFr [x] [t] [\]" + have z_facts[simp]: "z \ var" "z \ x" "x \ z" "z \ FvarsT t" "z \ Fvars \" + using getFr_FvarsT_Fvars[of "[x]" "[t]" "[\]"] unfolding z_def[symmetric] by auto + have 0: "exu x \ = cnj (exi x \) (exi z (all x (imp \ (eql (Var x) (Var z)))))" + by (simp add: exu_def_var[of _ z]) + show ?thesis + unfolding 0 + apply(rule nprv_cnjI, auto) + apply(rule nprv_exiI[of _ _ t], auto) + apply(rule n1) + (**) + apply(rule nprv_exiI[of _ _ t], auto) + apply(rule nprv_allI, insert u, auto) + apply(rule nprv_impI, insert n2, auto) + done +qed + +lemma nprv_exuI_var: +assumes n1: "nprv F (subst \ t x)" and n2: "nprv (insert (subst \ (Var y) x) F) (eql (Var y) t)" +and i[simp]: "F \ fmla" "finite F" "\ \ fmla" "t \ trm" "x \ var" +"y \ var" "y \ FvarsT t" and u: "y \ (\\ \ F. Fvars \)" and yx: "y = x \ y \ Fvars \" +shows "nprv F (exu x \)" +apply(subst exu_rename2[of _ _ y]) +subgoal by auto +subgoal by auto +subgoal by auto +subgoal using yx by auto +subgoal apply(intro nprv_exuI[of _ _ t]) + subgoal by (metis i(3) i(4) i(5) i(6) n1 subst_same_Var subst_subst yx) + using n2 u by auto . + +text \This turned out to be the most useful introduction rule for arithmetic:\ +lemma nprv_exuI_exi: +assumes n1: "nprv F (exi x \)" and n2: "nprv (insert (subst \ (Var y) x) (insert \ F)) (eql (Var y) (Var x))" +and i[simp]: "F \ fmla" "finite F" "\ \ fmla" "x \ var" "y \ var" "y \ x" "y \ Fvars \" +and u: "x \ (\\ \ F. Fvars \)" "y \ (\\ \ F. Fvars \)" +shows "nprv F (exu x \)" +proof- + have e: "nprv (insert \ F) (exu x \)" + apply(rule nprv_exuI_var[of _ _ "Var x" _ y]) + using n2 u by auto + show ?thesis + apply(rule nprv_cut[OF n1], auto) + apply(rule nprv_exiE0, insert u, auto) + apply(rule nprv_mono[OF e], auto) . +qed + +lemma prv_exu_imp_exi: +assumes [simp]: "\ \ fmla" "x \ var" +shows "prv (imp (exu x \) (exi x \))" +proof- + define z where z: "z \ getFr [x] [] [\]" + have z_facts[simp]: "z \ var" "z \ x" "x \ z" "z \ Fvars \" + using getFr_FvarsT_Fvars[of "[x]" "[]" "[\]"] unfolding z by auto + show ?thesis unfolding exu_def + by (simp add: Let_def z[symmetric] prv_imp_cnjL) +qed + +lemma prv_exu_exi: + assumes "x \ var" "\ \ fmla" "prv (exu x \)" + shows "prv (exi x \)" + by (meson assms exi exu prv_exu_imp_exi prv_imp_mp) + +text \This is just exu behaving for elimination and forward like exi:\ +lemma nprv_exuE_exi: +assumes n1: "nprv F (exu x \)" and n2: "nprv (insert \ F) \" +and i[simp]: "F \ fmla" "finite F" "\ \ fmla" "x \ var" "\ \ fmla" "x \ Fvars \" +and u: "x \ (\\ \ F. Fvars \)" +shows "nprv F \" +using assms apply- apply(rule nprv_exiE[of _ x \]) +subgoal by (rule nprv_addImpLemmaI[OF prv_exu_imp_exi[of \ x]]) auto +by auto + +lemma nprv_exuF_exi: +assumes n1: "exu x \ \ F" and n2: "nprv (insert \ F) \" +and i[simp]: "F \ fmla" "finite F" "\ \ fmla" "x \ var" "\ \ fmla" "x \ Fvars \" +and u: "x \ (\\ \ F. Fvars \)" +shows "nprv F \" +using assms nprv_exuE_exi nprv_hyp by metis + +lemma prv_exu_uni: +assumes [simp]: "\ \ fmla" "x \ var" "t1 \ trm" "t2 \ trm" +shows "prv (imp (exu x \) (imp (subst \ t1 x) (imp (subst \ t2 x) (eql t1 t2))))" +proof- + define z where z: "z \ getFr [x] [t1,t2] [\]" + have z_facts[simp]: "z \ var" "z \ x" "x \ z" "z \ Fvars \" "z \ FvarsT t1" "z \ FvarsT t2" + using getFr_FvarsT_Fvars[of "[x]" "[t1,t2]" "[\]"] unfolding z by auto + show ?thesis + apply(rule nprv_prvI, auto) + apply(rule nprv_impI, auto) + apply(simp add: exu_def_var[of _ z]) + apply(rule nprv_cnjE0, auto) + apply(rule nprv_clear3_1, auto) + apply(rule nprv_clear2_2, auto) + apply(rule nprv_exiE0, auto) + apply(rule nprv_clear2_2, auto) + apply(rule nprv_allE0[of _ _ _ t1], auto) + apply(rule nprv_allE0[of _ _ _ t2], auto) + apply(rule nprv_clear3_3, auto) + apply(rule nprv_impI, auto) + apply(rule nprv_impI, auto) + apply(rule nprv_impE01, auto) + apply(rule nprv_clear5_2, auto) + apply(rule nprv_clear4_3, auto) + apply(rule nprv_impE01, auto) + apply(rule nprv_clear4_3, auto) + apply(rule nprv_clear3_3, auto) + apply(rule nprv_eql_symE0[of t2 "Var z"], auto) + apply(rule nprv_eql_transE012, auto) . +qed + +lemmas nprv_exuE_uni = nprv_addImp3LemmaE[OF prv_exu_uni,simped,rotated 4] +lemmas nprv_exuF_uni = nprv_exuE_uni[OF nprv_hyp,simped] + + +end \ \context @{locale Deduct_with_False_Disj}\ + + +section \Eisbach Notation for Natural Deduction Proofs\ + + +text \The proof pattern will be: On a goal of the form @{term "nprv F \"}, +we apply a rule (usually an introduction, elimination, or cut/lemma-addition +rule), then discharge the side-conditions with @{method auto}, ending up with zero, +one or two goals of the same nprv-shape. This process is abstracted away in the +Eisbach nrule method:\ + +method nrule uses r = (rule r, auto?) +(* For future developments, in case we refine what we do +(and also for documentation): This is supposed to create two main nprv-subgoals: *) +method nrule2 uses r = (rule r, auto?) + + +text \Methods for chaining several nrule applications:\ + +method nprover2 uses r1 r2 = + (-,(((nrule r: r1)?, (nrule r: r2)?) ; fail)) +method nprover3 uses r1 r2 r3 = + (-,(((nrule r: r1)?, (nrule r: r2)?, (nrule r: r3)?) ; fail)) +method nprover4 uses r1 r2 r3 r4 = + (-,(((nrule r: r1)?, (nrule r: r2)?, (nrule r: r3)?, (nrule r: r4)?) ; fail)) +method nprover5 uses r1 r2 r3 r4 r5 = + (-,((nrule r: r1)?, (nrule r: r2)?, (nrule r: r3)?, + (nrule r: r4)?, (nrule r: r5)?) ; fail) +method nprover6 uses r1 r2 r3 r4 r5 r6 = + (-,((nrule r: r1)?, (nrule r: r2)?, (nrule r: r3)?, + (nrule r: r4)?, (nrule r: r5)?, (nrule r: r6)?) ; fail) + +(*<*) +end +(*>*) \ No newline at end of file diff --git a/thys/Syntax_Independent_Logic/Prelim.thy b/thys/Syntax_Independent_Logic/Prelim.thy new file mode 100644 --- /dev/null +++ b/thys/Syntax_Independent_Logic/Prelim.thy @@ -0,0 +1,143 @@ +chapter \Preliminaries\ + +(*<*) +theory Prelim + imports Main "HOL-Eisbach.Eisbach" +begin +(*>*) + +section \Trivia\ + +abbreviation (input) any where "any \ undefined" + +lemma Un_Diff2: "B \ C = {} \ A \ B - C = A - C \ B" by auto + +lemma Diff_Diff_Un: "A - B - C = A - (B \ C)" by auto + +fun first :: "nat \ nat list" where + "first 0 = []" +| "first (Suc n) = n # first n" + + +text \Facts about zipping lists:\ + +lemma fst_set_zip_map_fst: + "length xs = length ys \ fst ` (set (zip (map fst xs) ys)) = fst ` (set xs)" + by (induct xs ys rule: list_induct2) auto + +lemma snd_set_zip_map_snd: + "length xs = length ys \ snd ` (set (zip xs (map snd ys))) = snd ` (set ys)" + by (induct xs ys rule: list_induct2) auto + +lemma snd_set_zip: + "length xs = length ys \ snd ` (set (zip xs ys)) = set ys" + by (induct xs ys rule: list_induct2) auto + +lemma set_zip_D: "(x, y) \ set (zip xs ys) \ x \ set xs \ y \ set ys" + using set_zip_leftD set_zip_rightD by auto + +lemma inj_on_set_zip_map: + assumes i: "inj_on f X" + and a: "(f x1, y1) \ set (zip (map f xs) ys)" "set xs \ X" "x1 \ X" "length xs = length ys" + shows "(x1, y1) \ set (zip xs ys)" +using a proof (induct xs arbitrary: ys x1 y1) + case (Cons x xs yys) + thus ?case using i unfolding inj_on_def by (cases yys) auto +qed (insert i, auto) + +lemma set_zip_map_fst_snd: + assumes "(u,x) \ set (zip us (map snd txs))" + and "(t,u) \ set (zip (map fst txs) us)" + and "distinct (map snd txs)" + and "distinct us" and "length us = length txs" + shows "(t, x) \ set txs" + using assms(5,1-4) + by (induct us txs arbitrary: u x t rule: list_induct2) + (auto dest: set_zip_leftD set_zip_rightD) + +lemma set_zip_map_fst_snd2: + assumes "(u, x) \ set (zip us (map snd txs))" + and "(t, x) \ set txs" + and "distinct (map snd txs)" + and "distinct us" and "length us = length txs" + shows "(t, u) \ set (zip (map fst txs) us)" + using assms(5,1-4) + by (induct us txs arbitrary: u x t rule: list_induct2) + (auto dest: set_zip_rightD simp: image_iff) + +lemma set_zip_length_map: + assumes "(x1, y1) \ set (zip xs ys)" and "length xs = length ys" + shows "(f x1, y1) \ set (zip (map f xs) ys)" + using assms(2,1) by (induct xs ys arbitrary: x1 y1 rule: list_induct2) auto + +definition asList :: "'a set \ 'a list" where + "asList A \ SOME as. set as = A" + +lemma asList[simp,intro!]: "finite A \ set (asList A) = A" + unfolding asList_def by (meson finite_list tfl_some) + +lemma triv_Un_imp_aux: + "(\a. \ \ a \ A \ a \ B \ a \ C) \ \ \ A \ B = A \ C" + by auto + +definition toN where "toN n \ [0..<(Suc n)]" + +lemma set_toN[simp]: "set (toN n) = {0..n}" + unfolding toN_def by auto + +declare list.map_cong[cong] + + +section \Some Proof Infrastructure\ + +ML \ +exception TAC of term + +val simped = Thm.rule_attribute [] (fn context => fn thm => + let + val ctxt = Context.proof_of context; + val (thm', ctxt') = yield_singleton (apfst snd oo Variable.import false) thm ctxt; + val full_goal = Thm.prop_of thm'; + val goal = Goal.prove ctxt' [] [] full_goal (fn {context = ctxt, prems = _} => + HEADGOAL (asm_full_simp_tac ctxt THEN' TRY o SUBGOAL (fn (goal, _) => raise (TAC goal)))) + |> K (HOLogic.mk_Trueprop @{term True}) + handle TAC goal => goal; + val thm = Goal.prove ctxt' [] [] goal (fn {context = ctxt, prems = _} => + HEADGOAL (Method.insert_tac ctxt [thm'] THEN' asm_full_simp_tac ctxt)) + |> singleton (Variable.export ctxt' ctxt); + in thm end) + +val _ = Theory.setup + (Attrib.setup \<^binding>\simped\ (pair simped) "simped rule"); +\ + +method RULE methods meth uses rule = + (rule rule; (solves meth)?) + +text \TryUntilFail:\ +(* This is non-hazardous, since it does not touch the goal on which it fails. *) +method TUF methods meth = + ((meth;fail)+)? + +text \Helping a method, usually simp or auto, with specific substitutions inserted. +For auto, this is a bit like a "simp!" analogue of "intro!" and "dest!": It forces +the application of an indicated simplification rule, if this is possible.\ + +method variousSubsts1 methods meth uses s1 = + (meth?,(subst s1)?, meth?) +method variousSubsts2 methods meth uses s1 s2 = + (meth?,(subst s1)?, meth?, subst s2, meth?) +method variousSubsts3 methods meth uses s1 s2 s3 = + (meth?,(subst s1)?, meth?, (subst s2)?, meth?, (subst s3)?, meth?) +method variousSubsts4 methods meth uses s1 s2 s3 s4 = + (meth?,(subst s1)?, meth?, (subst s2)?, meth?, (subst s3)?, meth?, (subst s4)?, meth?) +method variousSubsts5 methods meth uses s1 s2 s3 s4 s5 = + (meth?,(subst s1)?, meth?, (subst s2)?, meth?, (subst s3)?, meth?, (subst s4)?, meth?, (subst s5)?, meth?) +method variousSubsts6 methods meth uses s1 s2 s3 s4 s5 s6 = + (meth?,(subst s1)?, meth?, (subst s2)?, meth?, (subst s3)?, meth?, + (subst s4)?, meth?, (subst s5)?, meth?, (subst s6)?, meth?) + +(*<*) +end +(*>*) + diff --git a/thys/Syntax_Independent_Logic/Pseudo_Term.thy b/thys/Syntax_Independent_Logic/Pseudo_Term.thy new file mode 100644 --- /dev/null +++ b/thys/Syntax_Independent_Logic/Pseudo_Term.thy @@ -0,0 +1,600 @@ +chapter \Pseudo-Terms\ + +(*<*) +theory Pseudo_Term + imports Natural_Deduction +begin +(*>*) + +text \Pseudo-terms are formulas that satisfy the exists-unique property +on one of their variables.\ + +section \Basic Setting\ + +context Generic_Syntax +begin + +text \We choose a specific variable, out, that will represent the +"output" of pseudo-terms, i.e., the variable on which the exists-unique property holds:\ +abbreviation "out \ Variable 0" +text \Many facts will involve pseudo-terms with only one additional "input" variable, inp:\ +abbreviation "inp \ Variable (Suc 0)" + +(* These facts can speed up simplification: *) +lemma out_inp_distinct[simp]: +"out \ inp" "inp \ out" +"out \ xx" "out \ yy" "yy \ out" "out \ zz" "zz \ out" "out \ xx'" "xx' \ out" + "out \ yy'" "yy' \ out" "out \ zz'" "zz' \ out" +"inp \ xx" "inp \ yy" "yy \ inp" "inp \ zz" "zz \ inp" "inp \ xx'" "xx' \ inp" + "inp \ yy'" "yy' \ inp" "inp \ zz'" "zz' \ inp" +by auto + +end (* context Generic_Syntax *) + + +context Deduct_with_False_Disj_Rename +begin + +text \Pseudo-terms over the first $n+1$ variables, i.e., +having $n$ input variables (Variable $1$ to Variable $n$), and an output variable, out (which is +an abbreviation for Variable $0$).\ +definition ptrm :: "nat \ 'fmla set" where +"ptrm n \ {\ \ fmla . Fvars \ = Variable ` {0..n} \ prv (exu out \)}" + +lemma ptrm[intro,simp]: "\ \ ptrm n \ \ \ fmla" + unfolding ptrm_def by auto + +lemma ptrm_1_Fvars[simp]: "\ \ ptrm (Suc 0) \ Fvars \ = {out,inp}" + unfolding ptrm_def by auto + +lemma ptrm_prv_exu: "\ \ ptrm n \ prv (exu out \)" + unfolding ptrm_def by auto + +lemma ptrm_prv_exi: "\ \ ptrm n \ prv (exi out \)" + by (simp add: ptrm_prv_exu prv_exu_exi) + +lemma nprv_ptrmE_exi: +"\ \ ptrm n \ nprv (insert \ F) \ \ + F \ fmla \ finite F \ + \ \ fmla \ out \ Fvars \ \ out \ \ (Fvars ` F) \ nprv F \" + apply (frule ptrm_prv_exu, drule ptrm) + apply(rule nprv_exuE_exi[of _ out \]) + by (auto intro!: prv_nprvI) + +lemma nprv_ptrmE_uni: +"\ \ ptrm n \ nprv F (subst \ t1 out) \ nprv F (subst \ t2 out) \ + nprv (insert (eql t1 t2) F) \ \ + F \ fmla \ finite F \ \ \ fmla \ t1 \ trm \ t2 \ trm + \ nprv F \" + apply (frule ptrm_prv_exu, drule ptrm) + apply(rule nprv_exuE_uni[of _ out \ t1 t2]) + by (auto intro!: prv_nprvI) + +lemma nprv_ptrmE_uni0: +"\ \ ptrm n \ nprv F \ \ nprv F (subst \ t out) \ + nprv (insert (eql (Var out) t) F) \ \ + F \ fmla \ finite F \ \ \ fmla \ t \ trm + \ nprv F \" + by (rule nprv_ptrmE_uni[of \ _ _ "Var out" t]) auto + +lemma nprv_ptrmE0_uni0: +"\ \ ptrm n \ \ \ F \ nprv F (subst \ t out) \ + nprv (insert (eql (Var out) t) F) \ \ + F \ fmla \ finite F \ \ \ fmla \ t \ trm + \ nprv F \" +by (rule nprv_ptrmE_uni0[of \ n _ t]) auto + + +section \The $\forall$-$\exists$ Equivalence\ + +text \There are two natural ways to state that (unique) "output" of a pseudo-term @{term \} +satisfies a property @{term \}: +(1) using $\exists$: there exists an "out" such that @{term \} and @{term \} hold for it; +(2) using $\forall$: for all "out" such that @{term \} holds for it, @{term \} holds for it as well. + +We prove the well-known fact that these two ways are equivalent. (Intuitionistic +logic suffice to prove that.)\ + +lemma ptrm_nprv_exi: +assumes \: "\ \ ptrm n" and [simp]: "\ \ fmla" +shows "nprv {\, exi out (cnj \ \)} \" +proof- + have [simp]: "\ \ fmla" using \ by simp + define z where "z \ getFr [out] [] [\,\]" + have z_facts[simp]: "z \ var" "z \ out" "z \ Fvars \" "z \ Fvars \" + using getFr_FvarsT_Fvars[of "[out]" "[]" "[\,\]"] unfolding z_def[symmetric] by auto + have 0: "exi out (cnj \ \) = exi z (subst (cnj \ \) (Var z) out)" + by(rule exi_rename, auto) + show ?thesis + unfolding 0 + apply(nrule r: nprv_exiE0[of z "subst (cnj \ \) (Var z) out"]) + apply(nrule2 r: nprv_ptrmE0_uni0[OF \, of _ "Var z"]) + subgoal by (nrule r: nprv_cnjE0) + subgoal + apply(nrule r: nprv_clear4_4) + apply(nrule r: nprv_clear3_3) + apply (nrule r: nprv_cnjE0) + apply(nrule r: nprv_clear4_4) + apply(nrule r: nprv_clear3_1) + apply(nrule r: nprv_eql_substE012[of "Var out" "Var z" _ \ out \]) . . +qed + +lemma ptrm_nprv_exi_all: + assumes \: "\ \ ptrm n" and [simp]: "\ \ fmla" + shows "nprv {exi out (cnj \ \)} (all out (imp \ \))" +proof- + have [simp]: "\ \ fmla" using \ by simp + show ?thesis + apply(nrule r: nprv_allI) + apply(nrule r: nprv_impI) + apply(nrule r: ptrm_nprv_exi[OF \]) . +qed + +lemma ptrm_prv_exi_imp_all: + assumes \: "\ \ ptrm n" and [simp]: "\ \ fmla" + shows "prv (imp (exi out (cnj \ \)) (all out (imp \ \)))" +proof- + have [simp]: "\ \ fmla" using \ by simp + show ?thesis + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_impI) + apply(nrule r: ptrm_nprv_exi_all[OF \]) . +qed + +lemma ptrm_nprv_all_imp_exi: + assumes \: "\ \ ptrm n" and [simp]: "\ \ fmla" + shows "nprv {all out (imp \ \)} (exi out (cnj \ \))" +proof- + have [simp]: "\ \ fmla" using \ by simp + define z where "z \ getFr [out] [] [\,\]" + have z_facts[simp]: "z \ var" "z \ out" "z \ Fvars \" "z \ Fvars \" + using getFr_FvarsT_Fvars[of "[out]" "[]" "[\,\]"] unfolding z_def[symmetric] by auto + show ?thesis + apply(nrule r: nprv_ptrmE_exi[OF \]) + apply(nrule r: nprv_exiI[of _ "cnj \ \" "Var out" out]) + apply(nrule r: nprv_allE0[of out "imp \ \" _ "Var out"]) + apply(nrule r: nprv_clear3_3) + apply(nrule r: nprv_cnjI) + apply(nrule r: nprv_impE01) . +qed + +lemma ptrm_prv_all_imp_exi: + assumes \: "\ \ ptrm n" and [simp]: "\ \ fmla" + shows "prv (imp (all out (imp \ \)) (exi out (cnj \ \)))" +proof- + have [simp]: "\ \ fmla" using \ by simp + define z where "z \ getFr [out] [] [\,\]" + have z_facts[simp]: "z \ var" "z \ out" "z \ Fvars \" "z \ Fvars \" + using getFr_FvarsT_Fvars[of "[out]" "[]" "[\,\]"] unfolding z_def[symmetric] by auto + show ?thesis + apply(nrule r: nprv_prvI) + apply(nrule r: nprv_impI) + apply(nrule r: ptrm_nprv_all_imp_exi[OF \]) . +qed + +end \ \context @{locale Deduct_with_False_Disj_Rename }\ + +section \Instantiation\ + +text \We define the notion of instantiating the "inp" variable of a formula +(in particular, of a pseudo-term): +-- first with a term); +-- then with a pseudo-term. +\ + +subsection \Instantiation with terms\ + +text \Instantiation with terms is straightforward using substitution. +In the name of the operator, the suffix "Inp" is a reminder that we instantiate @{term \} +on its variable "inp".\ + + +context Generic_Syntax +begin + +definition instInp :: "'fmla \ 'trm \ 'fmla" where +"instInp \ t \ subst \ t inp" + +lemma instInp_fmla[simp,intro]: +assumes "\ \ fmla" and "t \ trm" +shows "instInp \ t \ fmla" +using assms instInp_def by auto + +lemma Fvars_instInp[simp,intro]: +assumes "\ \ fmla" and "t \ trm" "Fvars \ = {inp}" +shows "Fvars (instInp \ t) = FvarsT t" +using assms instInp_def by auto + +end \ \context @{locale Generic_Syntax }\ + + +context Deduct_with_False_Disj_Rename +begin + +lemma Fvars_instInp_ptrm_1[simp,intro]: +assumes \: "\ \ ptrm (Suc 0)" and "t \ trm" +shows "Fvars (instInp \ t) = insert out (FvarsT t)" +using assms instInp_def by auto + +lemma instInp: +assumes \: "\ \ ptrm (Suc 0)" and [simp]: "t \ trm" +and [simp]: "FvarsT t = Variable ` {(Suc 0)..n}" +shows "instInp \ t \ ptrm n" +proof- + note Let_def[simp] + have [simp]: "\ \ fmla" "Fvars \ = {out,inp}" + using assms unfolding ptrm_def by auto + have [simp]: "Fvars (instInp \ t) = insert out (FvarsT t)" + using \ by (subst Fvars_instInp_ptrm_1) auto + have 0: "exu out (instInp \ t) = subst (exu out \) t inp" + unfolding instInp_def by (subst subst_exu) auto + have 1: "prv (exu out \)" using \ unfolding ptrm_def by auto + have "prv (exu out (instInp \ t))" + unfolding 0 by (rule prv_subst[OF _ _ _ 1], auto) + thus ?thesis using assms unfolding ptrm_def[of n] by auto +qed + +lemma instInp_0: +assumes \: "\ \ ptrm (Suc 0)" and "t \ trm" and "FvarsT t = {}" +shows "instInp \ t \ ptrm 0" +using assms by (intro instInp) auto + +lemma instInp_1: +assumes \: "\ \ ptrm (Suc 0)" and "t \ trm" and "FvarsT t = {inp}" +shows "instInp \ t \ ptrm (Suc 0)" +using assms by (intro instInp) auto + + +subsection \Instantiation with pseudo-terms\ + +text \Instantiation of a formula @{term \} with a pseudo-term @{term \} yields a formula that +could be casually written @{term [source] "\(\)"}. It states the existence of an output @{term zz} of @{term \} on which @{term \} holds. +Instead of @{term [source] "\(\)"}, we write @{term "instInpP \ n \"} where @{term n} is the number of input variables of @{term \}. +In the name @{term "instInpP"}, @{term "Inp"} is as before a reminder that we instantiate @{term \} on its variable +"inp" and the suffix "P" stands for "Pseudo".\ + +definition instInpP :: "'fmla \ nat \ 'fmla \ 'fmla" where +"instInpP \ n \ \ let zz = Variable (Suc (Suc n)) in + exi zz (cnj (subst \ (Var zz) out) (subst \ (Var zz) inp))" + +lemma instInpP_fmla[simp, intro]: + assumes "\ \ fmla" and "\ \ fmla" + shows "instInpP \ n \ \ fmla" + using assms unfolding instInpP_def by (auto simp: Let_def) + +lemma Fvars_instInpP[simp]: +assumes "\ \ fmla" and \: "\ \ ptrm n" "Variable (Suc (Suc n)) \ Fvars \" +shows "Fvars (instInpP \ n \) = Fvars \ - {inp} \ Variable ` {(Suc 0)..n}" +using assms unfolding instInpP_def Let_def ptrm_def by auto + +lemma Fvars_instInpP2[simp]: +assumes "\ \ fmla" and \: "\ \ ptrm n" and "Fvars \ \ {inp}" +shows "Fvars (instInpP \ n \) = Fvars \ - {inp} \ Variable ` {(Suc 0)..n}" +using assms by (subst Fvars_instInpP) auto + + +subsection \Closure and compositionality properties of instantiation\ + +text \Instantiating a 1-pseudo-term with an n-pseudo-term yields an n pseudo-term:\ +(* This could be generalized, of course. *) +lemma instInpP1[simp,intro]: +assumes \: "\ \ ptrm (Suc 0)" and \: "\ \ ptrm n" +shows "instInpP \ n \ \ ptrm n" +proof- + note Let_def[simp] + have [simp]: "\ \ fmla" "\ \ fmla" "Fvars \ = {out,inp}" + "Fvars \ = Variable ` {0..n}" + using assms unfolding ptrm_def by auto + define zz where "zz \ Variable (Suc (Suc n))" + have zz_facts[simp]: "zz \ var" "\i. i \ n \ Variable i \ zz \ zz \ Variable i" + "out \ zz" "zz \ out" "inp \ zz" "zz \ inp" + unfolding zz_def by auto + + define x where "x \ getFr [out,inp,zz] [] [\,\]" + have x_facts[simp]: "x \ var" "x \ out" "x \ inp" + "x \ zz" "zz \ x" "x \ Fvars \" "x \ Fvars \" + using getFr_FvarsT_Fvars[of "[out,inp,zz]" "[]" "[\,\]"] unfolding x_def[symmetric] by auto + have [simp]: "x \ Variable (Suc (Suc n))" + using x_facts(4) zz_def by auto + define z where "z \ getFr [out,inp,zz,x] [] [\,\]" + have z_facts[simp]: "z \ var" "z \ out" "z \ inp" "z \ x" "z \ zz" "z \ Fvars \" "z \ Fvars \" + using getFr_FvarsT_Fvars[of "[out,inp,zz,x]" "[]" "[\,\]"] unfolding z_def[symmetric] by auto + + have [simp]: "\i. z = Variable i \ \ i \ n" + and [simp]: "\i. x = Variable i \ \ i \ n" + using \Fvars \ = Variable ` {0..n}\ atLeastAtMost_iff z_facts(7) x_facts(7) + by blast+ + + have [simp]: "Fvars (instInpP \ n \) = Variable ` {0..n}" + unfolding instInpP_def by auto + have tt: "exi out \ = exi zz (subst \ (Var zz) out)" + by (rule exi_rename) auto + + have exi_\: "prv (exi out \)" and exi_\: "prv (exi zz (subst \ (Var zz) out))" + using \ \ ptrm_prv_exi tt by fastforce+ + have exi_\: "prv (exi out (subst \ (Var zz) inp))" + using prv_subst[OF _ _ _ exi_\, of inp "Var zz"] by auto + + have exu_\: "prv (exu out \)" + using \ ptrm_prv_exu by blast + have exu_\: "prv (exu out (subst \ (Var zz) inp))" + using prv_subst[OF _ _ _ exu_\, of inp "Var zz"] by auto + + have zz_z: "exi zz (cnj (subst \ (Var zz) out) (subst \ (Var zz) inp)) = + exi z (cnj (subst \ (Var z) out) (subst \ (Var z) inp))" + by (variousSubsts2 auto s1: exi_rename[of _ zz z] s2: subst_subst) + + have 0: "prv (exu out (instInpP \ n \))" + apply(nrule r: nprv_prvI) + apply(nrule2 r: nprv_exuI_exi[of _ _ _ x]) + subgoal unfolding instInpP_def Let_def + apply(nrule r: nprv_addImpLemmaI[OF prv_exi_commute]) + apply(nrule r: nprv_addLemmaE[OF exi_\]) + apply(nrule r: nprv_exiE[of _ zz "subst \ (Var zz) out"]) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_exiI[of _ _ "Var zz"]) + apply(nrule r: nprv_addLemmaE[OF exi_\]) + apply(nrule r: nprv_exiE[of _ out "subst \ (Var zz) inp"]) + apply(nrule r: nprv_clear3_2) + apply(nrule r: nprv_exiI[of _ _ "Var out"]) + apply(variousSubsts1 auto s1: subst_subst) + apply(nrule r: nprv_cnjI) . + subgoal + unfolding instInpP_def Let_def zz_def[symmetric] + apply(nrule r: nprv_exiE0[of zz]) + apply(nrule r: nprv_clear3_2) + apply(nrule r: nprv_cnjE0) + apply(nrule r: nprv_clear4_3) + unfolding zz_z + apply(nrule r: nprv_exiE0[of z]) + apply(nrule r: nprv_clear4_4) + apply(nrule r: nprv_cnjE0) + apply(nrule r: nprv_clear5_3) + apply(nrule r: nprv_cut[of _ "eql (Var z) (Var zz)"]) + subgoal by (nprover3 r1: nprv_clear4_2 r2: nprv_clear3_3 + r3: nprv_ptrmE_uni[OF \, of _ "Var z" "Var zz"]) + subgoal + apply(nrule r: nprv_clear5_2) + apply(nrule r: nprv_clear4_3) + apply(nrule2 r: nprv_eql_substE[of _ "Var zz" "Var z" \ inp]) + subgoal by (nrule r: nprv_eql_symE01) + subgoal + apply(nrule r: nprv_clear4_2) + apply(nrule r: nprv_clear3_2) + apply(nrule r: nprv_addLemmaE[OF exu_\]) + apply(nrule r: nprv_exuE_uni[of _ out "subst \ (Var zz) inp" "Var out" "Var x"]) + apply(nrule r: nprv_eql_symE01) . . . . + show ?thesis using 0 unfolding ptrm_def instInpP_def Let_def by auto +qed + +text \Term and pseudo-term instantiation compose smoothly:\ +lemma instInp_instInpP: +assumes \: "\ \ fmla" "Fvars \ \ {inp}" and \: "\ \ ptrm (Suc 0)" +and "t \ trm" and "FvarsT t = {}" +shows "instInp (instInpP \ (Suc 0) \) t = instInpP \ 0 (instInp \ t)" +proof- + define x1 and x2 where + x12: "x1 \ Variable (Suc (Suc 0))" + "x2 \ Variable (Suc (Suc (Suc 0)))" + have x_facts[simp]: "x1 \ var" "x2 \ var" "x1 \ inp" "x2 \ inp" + "x1 \ out" "out \ x1" "x2 \ out" "out \ x2" "x1 \ x2" "x2 \ x1" + unfolding x12 by auto + show ?thesis + using assms unfolding instInp_def instInpP_def Let_def x12[symmetric] + + apply(subst subst_exi) + apply(TUF simp) + + apply(variousSubsts5 auto + s1: subst_compose_same + s2: subst_compose_diff + s3: exi_rename[of _ x1 x2] + s4: subst_comp + s5: subst_notIn[of \ _ x1] + ) . +qed + +text \Pseudo-term instantiation also composes smoothly with itself:\ +lemma nprv_instInpP_compose: +assumes [simp]: "\ \ fmla" "Fvars \ = {inp}" +and \[simp]: "\ \ ptrm (Suc 0)" and \[simp]: "\ \ ptrm 0" +shows "nprv {instInpP (instInpP \ (Suc 0) \) 0 \} + (instInpP \ 0 (instInpP \ 0 \))" (is ?A) +and + "nprv {instInpP \ 0 (instInpP \ 0 \)} + (instInpP (instInpP \ (Suc 0) \) 0 \)" (is ?B) +proof- + define \\ and \\ where \\_def: "\\ \ instInpP \ (Suc 0) \" and \\_def: "\\ \ instInpP \ 0 \" + + have [simp]: "\ \ fmla" "Fvars \ = {out,inp}" "\ \ fmla" "Fvars \ = {out}" + using \ \ unfolding ptrm_def by auto + have \\[simp]: "\\ \ fmla" "Fvars \\ = {inp}" + unfolding \\_def by auto + have \\[simp]: "\\ \ ptrm 0" "\\ \ fmla" "Fvars \\ = {out}" unfolding \\_def + by auto + define z where "z \ Variable (Suc (Suc 0))" + have z_facts[simp]: "z \ var" + "out \ z \ z \ out" "inp \ z \ z \ inp" "z \ Fvars \" "z \ Fvars \" "z \ Fvars \" + unfolding z_def by auto + define zz where "zz \ Variable (Suc (Suc (Suc 0)))" + have zz_facts[simp]: "zz \ var" + "out \ zz \ zz \ out" "inp \ zz \ zz \ inp" "z \ zz \ zz \ z" + "zz \ Fvars \" "zz \ Fvars \" "zz \ Fvars \" + unfolding zz_def z_def by auto + define z' where "z' \ getFr [out,inp,z,zz] [] [\,\,\]" + have z'_facts[simp]: "z' \ var" "z' \ out" "z' \ inp" "z' \ z" "z \ z'" "z' \ zz" "zz \ z'" + "z' \ Fvars \""z' \ Fvars \" "z' \ Fvars \" + using getFr_FvarsT_Fvars[of "[out,inp,z,zz]" "[]" "[\,\,\]"] unfolding z'_def[symmetric] by auto + + have \\': "instInpP \\ 0 \ = exi z' (cnj (subst \ (Var z') out) (subst \\ (Var z') inp))" + unfolding instInpP_def Let_def z_def[symmetric] + by (auto simp: exi_rename[of _ z z']) + have \\z': "subst \\ (Var z') inp = + exi zz (cnj (subst (subst \ (Var zz) out) (Var z') inp) (subst \ (Var zz) inp))" + unfolding \\_def instInpP_def Let_def zz_def[symmetric] + by (auto simp: subst_compose_same) + have \\zz: "subst \\ (Var zz) out = + exi z (cnj (subst \ (Var z) out) (subst (subst \ (Var zz) out) (Var z) inp))" + unfolding \\_def instInpP_def Let_def z_def[symmetric] + by (variousSubsts2 auto s1: subst_compose_same s2: subst_compose_diff) + + have "nprv {instInpP \\ 0 \} (instInpP \ 0 \\)" + unfolding \\' + apply(nrule r: nprv_exiE0) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_cnjE0) + apply(nrule r: nprv_clear3_3) + unfolding \\z' + apply(nrule r: nprv_exiE0) + apply(nrule r: nprv_clear3_3) + apply(nrule r: nprv_cnjE0) + apply(nrule r: nprv_clear4_3) + unfolding instInpP_def Let_def z_def[symmetric] + apply(nrule r: nprv_exiI[of _ _ "Var zz"]) + apply(nrule r: nprv_cnjI) + apply(nrule r: nprv_clear3_2) + unfolding \\zz + apply(nrule r: nprv_exiI[of _ _ "Var z'"]) + apply(nrule r: nprv_cnjI) . + thus ?A unfolding \\_def \\_def . + + have \\\: "instInpP \ 0 \\ = exi z' (cnj (subst \\ (Var z') out) (subst \ (Var z') inp))" + unfolding instInpP_def Let_def z_def[symmetric] + by (auto simp: exi_rename[of _ z z']) + + have \\z': "subst \\ (Var z') out = + exi z (cnj (subst \ (Var z) out) (subst (subst \ (Var z) inp) (Var z') out))" + unfolding \\_def instInpP_def Let_def z_def[symmetric] + by (auto simp: subst_compose_same) + + have \\z: "subst \\ (Var z) inp = + exi zz (cnj (subst (subst \ (Var z) inp) (Var zz) out) (subst \ (Var zz) inp))" + unfolding \\_def instInpP_def Let_def zz_def[symmetric] + by (variousSubsts2 auto s1: subst_compose_same s2: subst_compose_diff) + + have "nprv {instInpP \ 0 \\} (instInpP \\ 0 \)" + unfolding \\\ + apply(nrule r: nprv_exiE0) + apply(nrule r: nprv_clear2_2) + apply(nrule r: nprv_cnjE0) + apply(nrule r: nprv_clear3_3) + unfolding \\z' + apply(nrule r: nprv_exiE0) + apply(nrule r: nprv_clear3_2) + apply(nrule r: nprv_cnjE0) + apply(nrule r: nprv_clear4_3) + unfolding instInpP_def Let_def z_def[symmetric] + apply(nrule r: nprv_exiI[of _ _ "Var z"]) + apply(nrule r: nprv_cnjI) + unfolding \\z + apply(nrule r: nprv_exiI[of _ _ "Var z'"]) + apply(nrule r: nprv_cnjI) . + thus ?B unfolding \\_def \\_def . +qed + +lemma prv_instInpP_compose: +assumes [simp]: "\ \ fmla" "Fvars \ = {inp}" +and \[simp]: "\ \ ptrm (Suc 0)" and \[simp]: "\ \ ptrm 0" +shows "prv (imp (instInpP (instInpP \ (Suc 0) \) 0 \) + (instInpP \ 0 (instInpP \ 0 \)))" (is ?A) +and + "prv (imp (instInpP \ 0 (instInpP \ 0 \)) + (instInpP (instInpP \ (Suc 0) \) 0 \))" (is ?B) +and + "prv (eqv (instInpP (instInpP \ (Suc 0) \) 0 \) + (instInpP \ 0 (instInpP \ 0 \)))" (is ?C) +proof- + have [simp]: "\ \ fmla" "Fvars \ = {out,inp}" "\ \ fmla" "Fvars \ = {out}" + using \ \ unfolding ptrm_def by auto + show ?A ?B by (intro nprv_prvI nprv_impI nprv_instInpP_compose, auto)+ + thus ?C by (intro prv_eqvI) auto +qed + + +section \Equality between Pseudo-Terms and Terms\ + +text \Casually, the equality between a pseudo-term @{term \} and a term @{term t} can +be written as $\vdash\tau = t$. This is in fact the (provability of) +the instantiation of @{term \} with @{term t} on @{term \}'s output variable out. Indeed, this +formula says that the unique entity denoted by @{term \} is exactly @{term t}.\ + +definition prveqlPT :: "'fmla \ 'trm \ bool" where +"prveqlPT \ t \ prv (subst \ t out)" + + +text \We prove that term--pseudo-term equality indeed acts like an equality, +in that it satisfies the substitutivity principle (shown only in the +particular case of formula-input instantiation).\ + +lemma prveqlPT_nprv_instInp_instInpP: +assumes[simp]: "\ \ fmla" and f: "Fvars \ \ {inp}" and \: "\ \ ptrm 0" +and [simp]: "t \ trm" "FvarsT t = {}" +and \t: "prveqlPT \ t" +shows "nprv {instInpP \ 0 \} (instInp \ t)" +proof- + have [simp]: "\ \ fmla" "Fvars \ = {out}" using \ unfolding ptrm_def by auto + define zz where "zz \ Variable (Suc (Suc 0))" + have zz_facts[simp]: "zz \ var" + "out \ zz \ zz \ out" "inp \ zz \ zz \ inp" "zz \ Fvars \" "zz \ Fvars \" + unfolding zz_def using f by auto + + note lemma1 = nprv_addLemmaE[OF \t[unfolded prveqlPT_def]] + + show ?thesis unfolding instInpP_def Let_def zz_def[symmetric] instInp_def + apply(nrule r: lemma1) + apply(nrule r: nprv_exiE0[of zz]) + apply(nrule r: nprv_clear3_3) + apply(nrule r: nprv_cnjE0) + apply(nrule r: nprv_clear4_3) + apply(nrule r: nprv_ptrmE_uni[OF \, of _ t "Var zz"]) + apply(nrule r: nprv_clear4_2) + apply(nrule r: nprv_clear3_3) + apply(nrule r: nprv_eql_substE012[of t "Var zz" _ \ inp]) . +qed + +lemma prveqlPT_prv_instInp_instInpP: +assumes"\ \ fmla" and f: "Fvars \ \ {inp}" and \: "\ \ ptrm 0" +and "t \ trm" "FvarsT t = {}" +and \t: "prveqlPT \ t" +shows "prv (imp (instInpP \ 0 \) (instInp \ t))" +using assms by (intro nprv_prvI nprv_impI prveqlPT_nprv_instInp_instInpP) auto + +lemma prveqlPT_nprv_instInpP_instInp: +assumes[simp]: "\ \ fmla" and f: "Fvars \ \ {inp}" and \: "\ \ ptrm 0" +and [simp]: "t \ trm" "FvarsT t = {}" +and \t: "prveqlPT \ t" +shows "nprv {instInp \ t} (instInpP \ 0 \)" +proof- + have [simp]: "\ \ fmla" "Fvars \ = {out}" using \ unfolding ptrm_def by auto + define zz where "zz \ Variable (Suc (Suc 0))" + have zz_facts[simp]: "zz \ var" + "out \ zz \ zz \ out" "inp \ zz \ zz \ inp" "zz \ Fvars \" "zz \ Fvars \" + unfolding zz_def using f by auto + + note lemma1 = nprv_addLemmaE[OF \t[unfolded prveqlPT_def]] + + show ?thesis unfolding instInpP_def Let_def zz_def[symmetric] instInp_def + by (nprover3 r1: lemma1 r2: nprv_exiI[of _ _ t] r3: nprv_cnjI) +qed + +lemma prveqlPT_prv_instInpP_instInp: +assumes"\ \ fmla" and f: "Fvars \ \ {inp}" and \: "\ \ ptrm 0" +and "t \ trm" "FvarsT t = {}" +and \t: "prveqlPT \ t" +shows "prv (imp (instInp \ t) (instInpP \ 0 \))" +using assms by (intro nprv_prvI nprv_impI prveqlPT_nprv_instInpP_instInp) auto + +lemma prveqlPT_prv_instInp_eqv_instInpP: +assumes"\ \ fmla" and f: "Fvars \ \ {inp}" and \: "\ \ ptrm 0" +and "t \ trm" "FvarsT t = {}" +and \t: "prveqlPT \ t" +shows "prv (eqv (instInpP \ 0 \) (instInp \ t))" +using assms prveqlPT_prv_instInp_instInpP prveqlPT_prv_instInpP_instInp +by (intro prv_eqvI) auto + + +end \ \context @{locale Deduct_with_False_Disj_Rename}\ + +(*<*) +end +(*>*) \ No newline at end of file diff --git a/thys/Syntax_Independent_Logic/ROOT b/thys/Syntax_Independent_Logic/ROOT new file mode 100644 --- /dev/null +++ b/thys/Syntax_Independent_Logic/ROOT @@ -0,0 +1,14 @@ +chapter AFP + +session Syntax_Independent_Logic (AFP) = HOL + + description \Syntax-Independent Logic Infrastructure\ + options [timeout = 2400] + sessions + "HOL-Eisbach" + theories + Pseudo_Term + Standard_Model + Deduction_Q + document_files + "root.tex" + "root.bib" \ No newline at end of file diff --git a/thys/Syntax_Independent_Logic/Standard_Model.thy b/thys/Syntax_Independent_Logic/Standard_Model.thy new file mode 100644 --- /dev/null +++ b/thys/Syntax_Independent_Logic/Standard_Model.thy @@ -0,0 +1,147 @@ +chapter \Truth in a Standard Model\ + +text \Abstract notion of standard model and truth.\ + +(*<*) +theory Standard_Model imports Deduction +begin +(*>*) + +text \First some minimal assumptions, involving +implication, negation and (universal and existential) quantification:\ + +locale Minimal_Truth = +Syntax_with_Numerals_and_Connectives_False_Disj + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + num +for +var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" +and Var FvarsT substT Fvars subst +and eql cnj imp all exi +and fls +and dsj +and num ++ +\ \The notion of truth for sentences:\ +fixes isTrue :: "'fmla \ bool" +assumes +not_isTrue_fls: "\ isTrue fls" +and +isTrue_imp: +"\\ \. \ \ fmla \ \ \ fmla \ Fvars \ = {} \ Fvars \ = {} \ + isTrue \ \ isTrue (imp \ \) \ isTrue \" +and +isTrue_all: +"\x \. x \ var \ \ \ fmla \ Fvars \ = {x} \ + (\ n \ num. isTrue (subst \ n x)) \ isTrue (all x \)" +and +isTrue_exi: +"\x \. x \ var \ \ \ fmla \ Fvars \ = {x} \ + isTrue (exi x \) \ (\ n \ num. isTrue (subst \ n x))" +and +isTrue_neg: +"\\. \ \ fmla \ Fvars \ = {} \ + isTrue \ \ isTrue (neg \)" +begin + +lemma isTrue_neg_excl: +"\ \ fmla \ Fvars \ = {} \ + isTrue \ \ isTrue (neg \) \ False" + using isTrue_imp not_isTrue_fls unfolding neg_def by auto + +lemma isTrue_neg_neg: +assumes "\ \ fmla" "Fvars \ = {}" +and "isTrue (neg (neg \))" +shows "isTrue \" +using assms isTrue_neg isTrue_neg_excl by fastforce + +end \ \context @{locale Minimal_Truth}\ + + +locale Minimal_Truth_Soundness = +Minimal_Truth + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + num + isTrue ++ +Deduct_with_False_Disj + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + num + prv +for +var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" +and Var FvarsT substT Fvars subst +and eql cnj imp all exi +and fls +and dsj +and num +and prv +and isTrue ++ +assumes +\ \We assume soundness of the provability for sentences (w.r.t. truth):\ +sound_isTrue: "\\. \ \ fmla \ Fvars \ = {} \ prv \ \ isTrue \" +begin + +text \For sound theories, consistency is a fact rather than a hypothesis:\ +lemma consistent: consistent + unfolding consistent_def using not_isTrue_fls sound_isTrue by blast + +lemma prv_neg_excl: +"\ \ fmla \ Fvars \ = {} \ prv \ \ prv (neg \) \ False" +using isTrue_neg_excl[of \] sound_isTrue by auto + +lemma prv_imp_implies_isTrue: +assumes [simp]: "\ \ fmla" "\ \ fmla" "Fvars \ = {}" "Fvars \ = {}" +and p: "prv (imp \ \)" and i: "isTrue \" +shows "isTrue \" +proof- + have "isTrue (imp \ \)" using p by (intro sound_isTrue) auto + thus ?thesis using assms isTrue_imp by blast +qed + +text \Sound theories are not only consistent, but also $\omega$-consistent +(in the strong, intuitionistic sense):\ + +lemma \consistent: \consistent +unfolding \consistent_def proof (safe del: notI) + fix \ x assume 0[simp,intro]: "\ \ fmla" "x \ var" and 1: "Fvars \ = {x}" + and 00: "\n\num. prv (neg (subst \ n x))" + hence "\n\num. isTrue (neg (subst \ n x))" + using 00 1 by (auto intro!: sound_isTrue) + hence "isTrue (all x (neg \))" by (simp add: "1" isTrue_all) + moreover + {have "prv (imp (all x (neg \)) (neg (exi x \)))" + using prv_all_neg_imp_neg_exi by blast + hence "isTrue (imp (all x (neg \)) (neg (exi x \)))" + by (simp add: "1" sound_isTrue) + } + ultimately have "isTrue (neg (exi x \))" + by (metis 0 1 Diff_insert_absorb Fvars_all Fvars_exi Fvars_neg all + exi insert_absorb insert_not_empty isTrue_imp neg) + hence "\ isTrue (neg (neg (exi x \)))" + using 1 isTrue_neg_excl by force + thus "\ prv (neg (neg (exi x \)))" + using "1" sound_isTrue by auto +qed + +lemma \consistentStd1: \consistentStd1 + using \consistent \consistent_impliesStd1 by blast + +lemma \consistentStd2: \consistentStd2 + using \consistent \consistent_impliesStd2 by blast + +end \ \context @{locale Minimal_Truth_Soundness}\ + +(*<*) +end +(*>*) diff --git a/thys/Syntax_Independent_Logic/Syntax.thy b/thys/Syntax_Independent_Logic/Syntax.thy new file mode 100644 --- /dev/null +++ b/thys/Syntax_Independent_Logic/Syntax.thy @@ -0,0 +1,2374 @@ +chapter \Syntax\ + +(*<*) +theory Syntax + imports Prelim +begin +(*>*) + + +section \Generic Syntax\ + +text \We develop some generic (meta-)axioms for syntax and substitution. +We only assume that the syntax of our logic has notions of variable, term and formula, +which \emph{include} subsets of "numeric" variables, terms and formulas, +the latter being endowed with notions of free variables and substitution subject to +some natural properties.\ + +locale Generic_Syntax = + fixes + var :: "'var set" \ \numeric variables (i.e., variables ranging over numbers)\ + and trm :: "'trm set" \ \numeric trms, which include the numeric variables\ + and fmla :: "'fmla set" \ \numeric formulas\ + and Var :: "'var \ 'trm" \ \trms include at least the variables\ + and FvarsT :: "'trm \ 'var set" \ \free variables for trms\ + and substT :: "'trm \ 'trm \ 'var \ 'trm" \ \substitution for trms\ + and Fvars :: "'fmla \ 'var set" \ \free variables for formulas\ + and subst :: "'fmla \ 'trm \ 'var \ 'fmla" \ \substitution for formulas\ + assumes + infinite_var: "infinite var" \ \the variables are assumed infinite\ + and \ \Assumptions about the infrastructure (free vars, substitution and the embedding of variables into trms. + NB: We need fewer assumptions for trm substitution than for formula substitution!\ + Var[simp,intro!]: "\x. x \ var \ Var x \ trm" + and + inj_Var[simp]: "\ x y. x \ var \ y \ var \ (Var x = Var y \ x = y)" + and + finite_FvarsT: "\ t. t \ trm \ finite (FvarsT t)" + and + FvarsT: "\t. t \ trm \ FvarsT t \ var" + and + substT[simp,intro]: "\t1 t x. t1 \ trm \ t \ trm \ x \ var \ substT t1 t x \ trm" + and + FvarsT_Var[simp]: "\ x. x \ var \ FvarsT (Var x) = {x}" + and + substT_Var[simp]: "\ x t y. x \ var \ y \ var \ t \ trm \ + substT (Var x) t y = (if x = y then t else Var x)" + and + substT_notIn[simp]: + "\t1 t2 x. x \ var \ t1 \ trm \ t2 \ trm \ x \ FvarsT t1 \ substT t1 t2 x = t1" + and + \ \Assumptions about the infrastructure (free vars and substitution) on formulas\ + finite_Fvars: "\ \. \ \ fmla \ finite (Fvars \)" + and + Fvars: "\\. \ \ fmla \ Fvars \ \ var" + and + subst[simp,intro]: "\\ t x. \ \ fmla \ t \ trm \ x \ var \ subst \ t x \ fmla" + and + Fvars_subst_in: + "\ \ t x. \ \ fmla \ t \ trm \ x \ var \ x \ Fvars \ \ + Fvars (subst \ t x) = Fvars \ - {x} \ FvarsT t" + and + subst_compose_eq_or: + "\ \ t1 t2 x1 x2. \ \ fmla \ t1 \ trm \ t2 \ trm \ x1 \ var \ x2 \ var \ + x1 = x2 \ x2 \ Fvars \ \ subst (subst \ t1 x1) t2 x2 = subst \ (substT t1 t2 x2) x1" + and + subst_compose_diff: + "\ \ t1 t2 x1 x2. \ \ fmla \ t1 \ trm \ t2 \ trm \ x1 \ var \ x2 \ var \ + x1 \ x2 \ x1 \ FvarsT t2 \ + subst (subst \ t1 x1) t2 x2 = subst (subst \ t2 x2) (substT t1 t2 x2) x1" + and + subst_same_Var[simp]: + "\ \ x. \ \ fmla \ x \ var \ subst \ (Var x) x = \" + and + subst_notIn[simp]: + "\ x \ t. \ \ fmla \ t \ trm \ x \ var \ x \ Fvars \ \ subst \ t x = \" +begin + +lemma var_NE: "var \ {}" +using infinite_var by auto + +lemma Var_injD: "Var x = Var y \ x \ var \ y \ var \ x = y" +by auto + +lemma FvarsT_VarD: "x \ FvarsT (Var y) \ y \ var \ x = y" +by auto + +lemma FvarsT': "t \ trm \ x \ FvarsT t \ x \ var" +using FvarsT by auto + +lemma Fvars': "\ \ fmla \ x \ Fvars \ \ x \ var" +using Fvars by auto + +lemma Fvars_subst[simp]: + "\ \ fmla \ t \ trm \ x \ var \ + Fvars (subst \ t x) = (Fvars \ - {x}) \ (if x \ Fvars \ then FvarsT t else {})" + by (simp add: Fvars_subst_in) + +lemma in_Fvars_substD: + "y \ Fvars (subst \ t x) \ \ \ fmla \ t \ trm \ x \ var + \ y \ (Fvars \ - {x}) \ (if x \ Fvars \ then FvarsT t else {})" + using Fvars_subst by auto + +lemma inj_on_Var: "inj_on Var var" + using inj_Var unfolding inj_on_def by auto + +lemma subst_compose_same: + "\ \ t1 t2 x. \ \ fmla \ t1 \ trm \ t2 \ trm \ x \ var \ + subst (subst \ t1 x) t2 x = subst \ (substT t1 t2 x) x" + using subst_compose_eq_or by blast + +lemma subst_subst[simp]: + assumes \[simp]: "\ \ fmla" and t[simp]:"t \ trm" and x[simp]:"x \ var" and y[simp]:"y \ var" + assumes yy: "x \ y" "y \ Fvars \" + shows "subst (subst \ (Var y) x) t y = subst \ t x" + using subst_compose_eq_or[OF \ _ t x y, of "Var y"] using subst_notIn yy by simp + +lemma subst_comp: + "\ x y \ t. \ \ fmla \ t \ trm \ x \ var \ y \ var \ + x \ y \ y \ FvarsT t \ + subst (subst \ (Var x) y) t x = subst (subst \ t x) t y" + by (simp add: subst_compose_diff) + +lemma exists_nat_var: + "\ f::nat\'var. inj f \ range f \ var" + by (simp add: infinite_countable_subset infinite_var) + +definition Variable :: "nat \ 'var" where + "Variable = (SOME f. inj f \ range f \ var)" + +lemma Variable_inj_var: + "inj Variable \ range Variable \ var" + unfolding Variable_def using someI_ex[OF exists_nat_var] . + +lemma inj_Variable[simp]: "\ i j. Variable i = Variable j \ i = j" + and Variable[simp,intro!]: "\i. Variable i \ var" + using Variable_inj_var image_def unfolding inj_def by auto + +text \Convenient notations for some variables +We reserve the first 10 indexes for any special variables we +may wish to consider later.\ +abbreviation xx where "xx \ Variable 10" +abbreviation yy where "yy \ Variable 11" +abbreviation zz where "zz \ Variable 12" + +abbreviation xx' where "xx' \ Variable 13" +abbreviation yy' where "yy' \ Variable 14" +abbreviation zz' where "zz' \ Variable 15" + +lemma xx: "xx \ var" + and yy: "yy \ var" + and zz: "zz \ var" + and xx': "xx' \ var" + and yy': "yy' \ var" + and zz': "zz' \ var" + by auto + +lemma vars_distinct[simp]: + "xx \ yy" "yy \ xx" "xx \ zz" "zz \ xx" "xx \ xx'" "xx' \ xx" "xx \ yy'" "yy' \ xx" "xx \ zz'" "zz' \ xx" + "yy \ zz" "zz \ yy" "yy \ xx'" "xx' \ yy" "yy \ yy'" "yy' \ yy" "yy \ zz'" "zz' \ yy" + "zz \ xx'" "xx' \ zz" "zz \ yy'" "yy' \ zz" "zz \ zz'" "zz' \ zz" + "xx' \ yy'" "yy' \ xx'" "xx' \ zz'" "zz' \ xx'" + "yy' \ zz'" "zz' \ yy'" + by auto + + +subsection \Instance Operator\ + +definition inst :: "'fmla \ 'trm \ 'fmla" where + "inst \ t = subst \ t xx" + +lemma inst[simp]: "\ \ fmla \ t \ trm \ inst \ t \ fmla" + unfolding inst_def by auto + +definition getFresh :: "'var set \ 'var" where + "getFresh V = (SOME x. x \ var \ x \ V)" + +lemma getFresh: "finite V \ getFresh V \ var \ getFresh V \ V" + by (metis (no_types, lifting) finite_subset getFresh_def infinite_var someI_ex subsetI) + +definition getFr :: "'var list \ 'trm list \ 'fmla list \ 'var" where + "getFr xs ts \s = + getFresh (set xs \ (\(FvarsT ` set ts)) \ (\(Fvars ` set \s)))" + +lemma getFr_FvarsT_Fvars: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" + shows "getFr xs ts \s \ var \ + getFr xs ts \s \ set xs \ + (t \ set ts \ getFr xs ts \s \ FvarsT t) \ + (\ \ set \s \ getFr xs ts \s \ Fvars \)" +proof- + have "finite (set xs \ (\(FvarsT ` set ts)) \ (\(Fvars ` set \s)))" + using assms finite_FvarsT finite_Fvars by auto + from getFresh[OF this] show ?thesis using assms unfolding getFr_def by auto +qed + +lemma getFr[simp,intro]: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" + shows "getFr xs ts \s \ var" + using assms getFr_FvarsT_Fvars by auto + +lemma getFr_var: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" and "t \ set ts" + shows "getFr xs ts \s \ set xs" + using assms getFr_FvarsT_Fvars by auto + +lemma getFr_FvarsT: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" and "t \ set ts" + shows "getFr xs ts \s \ FvarsT t" + using assms getFr_FvarsT_Fvars by auto + +lemma getFr_Fvars: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" and "\ \ set \s" + shows "getFr xs ts \s \ Fvars \" + using assms getFr_FvarsT_Fvars by auto + + +subsection \Fresh Variables\ + +fun getFreshN :: "'var set \ nat \ 'var list" where + "getFreshN V 0 = []" +| "getFreshN V (Suc n) = (let u = getFresh V in u # getFreshN (insert u V) n)" + +lemma getFreshN: "finite V \ + set (getFreshN V n) \ var \ set (getFreshN V n) \ V = {} \ length (getFreshN V n) = n \ distinct (getFreshN V n)" + by (induct n arbitrary: V) (auto simp: getFresh Let_def) + +definition getFrN :: "'var list \ 'trm list \ 'fmla list \ nat \ 'var list" where + "getFrN xs ts \s n = + getFreshN (set xs \ (\(FvarsT ` set ts)) \ (\(Fvars ` set \s))) n" + +lemma getFrN_FvarsT_Fvars: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" + shows "set (getFrN xs ts \s n) \ var \ + set (getFrN xs ts \s n) \ set xs = {} \ + (t \ set ts \ set (getFrN xs ts \s n) \ FvarsT t = {}) \ + (\ \ set \s \ set (getFrN xs ts \s n) \ Fvars \ = {}) \ + length (getFrN xs ts \s n) = n \ + distinct (getFrN xs ts \s n)" +proof- + have "finite (set xs \ (\(FvarsT ` set ts)) \ (\(Fvars ` set \s)))" + using assms finite_FvarsT finite_Fvars by auto + from getFreshN[OF this] show ?thesis using assms unfolding getFrN_def by auto +qed + +lemma getFrN[simp,intro]: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" + shows "set (getFrN xs ts \s n) \ var" + using assms getFrN_FvarsT_Fvars by auto + +lemma getFrN_var: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" and "t \ set ts" + shows "set (getFrN xs ts \s n) \ set xs = {}" + using assms getFrN_FvarsT_Fvars by auto + +lemma getFrN_FvarsT: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" and "t \ set ts" + shows "set (getFrN xs ts \s n) \ FvarsT t = {}" + using assms getFrN_FvarsT_Fvars by auto + +lemma getFrN_Fvars: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" and "\ \ set \s" + shows "set (getFrN xs ts \s n) \ Fvars \ = {}" + using assms getFrN_FvarsT_Fvars by auto + +lemma getFrN_length: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" + shows "length (getFrN xs ts \s n) = n" + using assms getFrN_FvarsT_Fvars by auto + +lemma getFrN_distinct[simp,intro]: + assumes "set xs \ var" "set ts \ trm" and "set \s \ fmla" + shows "distinct (getFrN xs ts \s n)" + using assms getFrN_FvarsT_Fvars by auto + + +subsection \Parallel Term Substitution\ + +fun rawpsubstT :: "'trm \ ('trm \ 'var) list \ 'trm" where + "rawpsubstT t [] = t" +| "rawpsubstT t ((t1,x1) # txs) = rawpsubstT (substT t t1 x1) txs" + +lemma rawpsubstT[simp]: + assumes "t \ trm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + shows "rawpsubstT t txs \ trm" + using assms by (induct txs arbitrary: t) fastforce+ + +definition psubstT :: "'trm \ ('trm \ 'var) list \ 'trm" where + "psubstT t txs = + (let xs = map snd txs; ts = map fst txs; us = getFrN xs (t # ts) [] (length xs) in + rawpsubstT (rawpsubstT t (zip (map Var us) xs)) (zip ts us))" + +text \The psubstT versions of the subst axioms.\ + +lemma psubstT[simp,intro]: + assumes "t \ trm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + shows "psubstT t txs \ trm" +proof- + define us where us: "us = getFrN (map snd txs) (t # map fst txs) [] (length txs)" + have us_facts: "set us \ var" + "set us \ FvarsT t = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_FvarsT[of "map snd txs" "t # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "t # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "t # map fst txs" "[]" "length txs"] + getFrN_distinct[of "map snd txs" "t # map fst txs" "[]" "length txs"] + by auto (metis (no_types, hide_lams) IntI empty_iff image_iff old.prod.inject surjective_pairing) + show ?thesis using assms us_facts unfolding psubstT_def + by (force simp: Let_def us[symmetric] dest: set_zip_leftD set_zip_rightD intro!: rawpsubstT) +qed + +lemma rawpsubstT_Var_not[simp]: + assumes "x \ var" "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "x \ snd ` (set txs)" + shows "rawpsubstT (Var x) txs = Var x" + using assms by (induct txs) auto + +lemma psubstT_Var_not[simp]: + assumes "x \ var" "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "x \ snd ` (set txs)" + shows "psubstT (Var x) txs = Var x" +proof- + define us where us: "us = getFrN (map snd txs) (Var x # map fst txs) [] (length txs)" + have us_facts: "set us \ var" + "x \ set us" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + using assms unfolding us + using getFrN_FvarsT[of "map snd txs" "Var x # map fst txs" "[]" "Var x" "length txs"] + getFrN_FvarsT[of "map snd txs" "Var x # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "Var x # map fst txs" "[]" "Var x" "length txs"] + getFrN_length[of "map snd txs" "Var x # map fst txs" "[]" "length txs"] + by (auto simp: set_eq_iff) + have [simp]: "rawpsubstT (Var x) (zip (map Var us) (map snd txs)) = Var x" + using assms us_facts + by(intro rawpsubstT_Var_not) (force dest: set_zip_rightD set_zip_leftD)+ + have [simp]: "rawpsubstT (Var x) (zip (map fst txs) us) = Var x" + using assms us_facts + by(intro rawpsubstT_Var_not) (force dest: set_zip_rightD set_zip_leftD)+ + show ?thesis using assms us_facts unfolding psubstT_def + by (auto simp: Let_def us[symmetric]) +qed + +lemma rawpsubstT_notIn[simp]: + assumes "x \ var" "snd ` (set txs) \ var" "fst ` (set txs) \ trm" "t \ trm" + and "FvarsT t \ snd ` (set txs) = {}" + shows "rawpsubstT t txs = t" + using assms by (induct txs) auto + +lemma psubstT_notIn[simp]: + assumes "x \ var" "snd ` (set txs) \ var" "fst ` (set txs) \ trm" "t \ trm" + and "FvarsT t \ snd ` (set txs) = {}" + shows "psubstT t txs = t" +proof- + define us where us: "us = getFrN (map snd txs) (t # map fst txs) [] (length txs)" + have us_facts: "set us \ var" + "set us \ FvarsT t = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + using assms unfolding us + using getFrN_FvarsT[of "map snd txs" "t # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "t # map fst txs" "[]" t "length txs"] + getFrN_length[of "map snd txs" "t # map fst txs" "[]" "length txs"] + by (auto simp: set_eq_iff) + have [simp]: "rawpsubstT t (zip (map Var us) (map snd txs)) = t" + using assms us_facts + by(intro rawpsubstT_notIn) (auto 0 3 dest: set_zip_rightD set_zip_leftD) + have [simp]: "rawpsubstT t (zip (map fst txs) us) = t" + using assms us_facts + by(intro rawpsubstT_notIn) (auto 0 3 dest: set_zip_rightD set_zip_leftD) + show ?thesis using assms us_facts unfolding psubstT_def + by (auto simp: Let_def us[symmetric]) +qed + + +subsection \Parallel Formula Substitution\ + +fun rawpsubst :: "'fmla \ ('trm \ 'var) list \ 'fmla" where + "rawpsubst \ [] = \" +| "rawpsubst \ ((t1,x1) # txs) = rawpsubst (subst \ t1 x1) txs" + +lemma rawpsubst[simp]: + assumes "\ \ fmla" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + shows "rawpsubst \ txs \ fmla" + using assms by (induct txs arbitrary: \) fastforce+ + +definition psubst :: "'fmla \ ('trm \ 'var) list \ 'fmla" where + "psubst \ txs = + (let xs = map snd txs; ts = map fst txs; us = getFrN xs ts [\] (length xs) in + rawpsubst (rawpsubst \ (zip (map Var us) xs)) (zip ts us))" + +text \The psubst versions of the subst axioms.\ + +lemma psubst[simp,intro]: + assumes "\ \ fmla" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + shows "psubst \ txs \ fmla" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [\] (length txs)" + have us_facts: "set us \ var" + "set us \ Fvars \ = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_FvarsT[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "map fst txs" "[\]" \ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + getFrN_distinct[of "map snd txs" "map fst txs" "[\]" "length txs"] + by (auto 8 0 simp: set_eq_iff image_iff Bex_def Ball_def) + show ?thesis using assms us_facts unfolding psubst_def + by (auto 0 3 simp: Let_def us[symmetric] dest: set_zip_rightD set_zip_leftD intro!: rawpsubst) +qed + +lemma Fvars_rawpsubst_su: + assumes "\ \ fmla" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + shows "Fvars (rawpsubst \ txs) \ + (Fvars \ - snd ` (set txs)) \ (\ {FvarsT t | t x . (t,x) \ set txs})" + using assms proof(induction txs arbitrary: \) + case (Cons tx txs \) + then obtain t x where tx: "tx = (t,x)" by force + have t: "t \ trm" and x: "x \ var" using Cons.prems unfolding tx by auto + define \ where "\ = subst \ t x" + have 0: "Fvars \ = Fvars \ - {x} \ (if x \ Fvars \ then FvarsT t else {})" + using Cons.prems unfolding \_def by (auto simp: tx t) + have \: "\ \ fmla" unfolding \_def using Cons.prems t x by auto + have "Fvars (rawpsubst \ txs) \ + (Fvars \ - snd ` (set txs)) \ + (\ {FvarsT t | t x . (t,x) \ set txs})" + using Cons.prems \ by (intro Cons.IH) auto + also have "\ \ Fvars \ - insert x (snd ` set txs) \ \{FvarsT ta |ta. \xa. ta = t \ xa = x \ (ta, xa) \ set txs}" + (is "_ \ ?R") by(auto simp: 0 tx Cons.prems) + finally have 1: "Fvars (rawpsubst \ txs) \ ?R" . + have 2: "Fvars \ = Fvars \ - {x} \ (if x \ Fvars \ then FvarsT t else {})" + using Cons.prems t x unfolding \_def using Fvars_subst by auto + show ?case using 1 by (simp add: tx \_def[symmetric] 2) +qed auto + +lemma in_Fvars_rawpsubst_imp: + assumes "y \ Fvars (rawpsubst \ txs)" + and "\ \ fmla" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + shows "(y \ Fvars \ - snd ` (set txs)) \ + (y \ \ { FvarsT t | t x . (t,x) \ set txs})" + using Fvars_rawpsubst_su[OF assms(2-4)] + using assms(1) by blast + +lemma Fvars_rawpsubst: + assumes "\ \ fmla" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + and "distinct (map snd txs)" and "\ x \ snd ` (set txs). \ t \ fst ` (set txs). x \ FvarsT t" + shows "Fvars (rawpsubst \ txs) = + (Fvars \ - snd ` (set txs)) \ + (\ {if x \ Fvars \ then FvarsT t else {} | t x . (t,x) \ set txs})" + using assms proof(induction txs arbitrary: \) + case (Cons a txs \) + then obtain t x where a: "a = (t,x)" by force + have t: "t \ trm" and x: "x \ var" using Cons.prems unfolding a by auto + have x_txs: "\ta xa. (ta, xa) \ set txs \ x \ xa" using `distinct (map snd (a # txs))` + unfolding a by (auto simp: rev_image_eqI) + have xt: "x \ FvarsT t \ snd ` set txs \ FvarsT t = {}" using Cons.prems unfolding a by auto + hence 0: "Fvars \ - {x} \ FvarsT t - snd ` set txs = + Fvars \ - insert x (snd ` set txs) \ FvarsT t" + by auto + define \ where \_def: "\ = subst \ t x" + have \: "\ \ fmla" unfolding \_def using Cons.prems t x by auto + have 1: "Fvars (rawpsubst \ txs) = + (Fvars \ - snd ` (set txs)) \ + (\ {if x \ Fvars \ then FvarsT t else {} | t x . (t,x) \ set txs})" + using Cons.prems \ by (intro Cons.IH) auto + have 2: "Fvars \ = Fvars \ - {x} \ (if x \ Fvars \ then FvarsT t else {})" + using Cons.prems t x unfolding \_def using Fvars_subst by auto + + define f where "f \ \ta xa. if xa \ Fvars \ then FvarsT ta else {}" + + have 3: "\ {f ta xa |ta xa. (ta, xa) \ set ((t, x) # txs)} = + f t x \ (\ {f ta xa |ta xa. (ta, xa) \ set txs})" by auto + have 4: "snd ` set ((t, x) # txs) = {x} \ snd ` set txs" by auto + have 5: "f t x \ snd ` set txs = {}" unfolding f_def using xt by auto + have 6: "\ {if xa \ Fvars \ - {x} \ f t x then FvarsT ta else {} | ta xa. (ta, xa) \ set txs} + = (\ {f ta xa | ta xa. (ta, xa) \ set txs})" + unfolding f_def using xt x_txs by (fastforce split: if_splits) + + have "Fvars \ - {x} \ f t x - snd ` set txs \ + \ {if xa \ Fvars \ - {x} \ f t x then FvarsT ta else {} + | ta xa. (ta, xa) \ set txs} = + Fvars \ - snd ` set ((t, x) # txs) \ + \ {f ta xa |ta xa. (ta, xa) \ set ((t, x) # txs)}" + unfolding 3 4 6 unfolding Un_Diff2[OF 5] Un_assoc unfolding Diff_Diff_Un .. + + thus ?case unfolding a rawpsubst.simps 1 2 \_def[symmetric] f_def by simp +qed auto + +lemma in_Fvars_rawpsubstD: + assumes "y \ Fvars (rawpsubst \ txs)" + and "\ \ fmla" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + and "distinct (map snd txs)" and "\ x \ snd ` (set txs). \ t \ fst ` (set txs). x \ FvarsT t" + shows "(y \ Fvars \ - snd ` (set txs)) \ + (y \ \ {if x \ Fvars \ then FvarsT t else {} | t x . (t,x) \ set txs})" + using Fvars_rawpsubst assms by auto + +lemma Fvars_psubst: + assumes "\ \ fmla" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + and "distinct (map snd txs)" + shows "Fvars (psubst \ txs) = + (Fvars \ - snd ` (set txs)) \ + (\ {if x \ Fvars \ then FvarsT t else {} | t x . (t,x) \ set txs})" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [\] (length txs)" + have us_facts: "set us \ var" + "set us \ Fvars \ = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_FvarsT[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + by (auto 9 0 simp: set_eq_iff image_iff) + define \ where \_def: "\ = rawpsubst \ (zip (map Var us) (map snd txs))" + have \: "\ \ fmla" unfolding \_def using assms us_facts + by (intro rawpsubst) (auto dest!: set_zip_D) + have set_us: "set us = snd ` (set (zip (map fst txs) us))" + using us_facts by (intro snd_set_zip[symmetric]) auto + have set_txs: "snd ` set txs = snd ` (set (zip (map Var us) (map snd txs)))" + using us_facts by (intro snd_set_zip_map_snd[symmetric]) auto + have "\ t x. (t, x) \ set (zip (map Var us) (map snd txs)) \ \ u. t = Var u" + using us_facts set_zip_leftD by fastforce + hence 00: "\ t x. (t, x) \ set (zip (map Var us) (map snd txs)) + \ (\ u \ var. t = Var u \ (Var u, x) \ set (zip (map Var us) (map snd txs)))" + using us_facts set_zip_leftD by fastforce + have "Fvars \ = + Fvars \ - snd ` set txs \ + \{if x \ Fvars \ then FvarsT t else {} |t x. + (t, x) \ set (zip (map Var us) (map snd txs))}" + unfolding \_def set_txs using assms us_facts + apply(intro Fvars_rawpsubst) + subgoal by auto + subgoal by (auto dest!: set_zip_rightD) + subgoal by (auto dest!: set_zip_leftD) + subgoal by auto + subgoal by (auto 0 6 simp: set_txs[symmetric] set_eq_iff subset_eq image_iff in_set_zip + dest: spec[where P="\x. x \ set us \ (\y \ set txs. x \ snd y)", THEN mp[OF _ nth_mem]]) . + also have "\ = + Fvars \ - snd ` set txs \ + \{if x \ Fvars \ then {u} else {} |u x. u \ var \ (Var u, x) \ set (zip (map Var us) (map snd txs))}" + (is "\ = ?R") + using FvarsT_Var by (metis (no_types, hide_lams) 00) + finally have 0: "Fvars \ = ?R" . + have 1: "Fvars (rawpsubst \ (zip (map fst txs) us)) = + (Fvars \ - set us) \ + (\ {if u \ Fvars \ then FvarsT t else {} | t u . (t,u) \ set (zip (map fst txs) us)})" + unfolding set_us using us_facts assms \ + apply (intro Fvars_rawpsubst) + subgoal by (auto dest: set_zip_rightD) + subgoal by (auto dest: set_zip_rightD) + subgoal by (auto dest!: set_zip_leftD) + subgoal by (auto dest!: set_zip_leftD) + subgoal by (metis IntI Union_iff empty_iff fst_set_zip_map_fst image_eqI set_us) . + have 2: "Fvars \ - set us = Fvars \ - snd ` set txs" + unfolding 0 using us_facts(1,2) + by (fastforce dest!: set_zip_leftD split: if_splits) + have 3: + "(\ {if u \ Fvars \ then FvarsT t else {} | t u . (t,u) \ set (zip (map fst txs) us)}) = + (\ {if x \ Fvars \ then FvarsT t else {} | t x . (t,x) \ set txs})" + proof safe + fix xx tt y + assume xx: "xx \ (if y \ Fvars \ then FvarsT tt else {})" + and ty: "(tt, y) \ set (zip (map fst txs) us)" + have ttin: "tt \ fst ` set txs" using ty using set_zip_leftD by fastforce + have yin: "y \ set us" using ty by (meson set_zip_D) + have yvar: "y \ var" using us_facts yin by auto + have ynotin: "y \ snd ` set txs" "y \ Fvars \" using yin us_facts by auto + show "xx \ \{if x \ Fvars \ then FvarsT t else {} |t x. (t, x) \ set txs}" + proof(cases "y \ Fvars \") + case True note y = True + hence xx: "xx \ FvarsT tt" using xx by simp + obtain x where x\: "x \ Fvars \" + and yx: "(Var y, x) \ set (zip (map Var us) (map snd txs))" + using y ynotin unfolding 0 by auto (metis empty_iff insert_iff) + have yx: "(y, x) \ set (zip us (map snd txs))" + using yvar us_facts by (intro inj_on_set_zip_map[OF inj_on_Var yx]) auto + have "(tt, x) \ set txs" apply(rule set_zip_map_fst_snd[OF yx ty]) + using `distinct (map snd txs)` us_facts by auto + thus ?thesis using xx x\ by auto + qed(insert xx, auto) + next + fix y tt xx + assume y: "y \ (if xx \ Fvars \ then FvarsT tt else {})" + and tx: "(tt, xx) \ set txs" + hence xxsnd: "xx \ snd ` set txs" by force + obtain u where uin: "u \ set us" and uxx: "(u, xx) \ set (zip us (map snd txs))" + by (metis xxsnd in_set_impl_in_set_zip2 length_map set_map set_zip_leftD us_facts(5)) + hence uvar: "u \ var" using us_facts by auto + show "y \ \{if u \ Fvars \ then FvarsT t else {} |t u. (t, u) \ set (zip (map fst txs) us)}" + proof(cases "xx \ Fvars \") + case True note xx = True + hence y: "y \ FvarsT tt" using y by auto + have "(Var u, xx) \ set (zip (map Var us) (map snd txs))" + using us_facts by (intro set_zip_length_map[OF uxx]) auto + hence u\: "u \ Fvars \" using uin xx uvar unfolding 0 by auto + have ttu: "(tt, u) \ set (zip (map fst txs) us)" + using assms us_facts by (intro set_zip_map_fst_snd2[OF uxx tx]) auto + show ?thesis using u\ ttu y by auto + qed(insert y, auto) + qed + show ?thesis + by (simp add: psubst_def Let_def us[symmetric] \_def[symmetric] 1 2 3) +qed + +lemma in_Fvars_psubstD: + assumes "y \ Fvars (psubst \ txs)" + and "\ \ fmla" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + and "distinct (map snd txs)" + shows "y \ (Fvars \ - snd ` (set txs)) \ + (\ {if x \ Fvars \ then FvarsT t else {} | t x . (t,x) \ set txs})" + using assms Fvars_psubst by auto + +lemma subst2_fresh_switch: + assumes "\ \ fmla" "t \ trm" "s \ trm" "x \ var" "y \ var" + and "x \ y" "x \ FvarsT s" "y \ FvarsT t" + shows "subst (subst \ s y) t x = subst (subst \ t x) s y" (is "?L = ?R") + using assms by (simp add: subst_compose_diff[of \ s t y x]) + +lemma rawpsubst2_fresh_switch: + assumes "\ \ fmla" "t \ trm" "s \ trm" "x \ var" "y \ var" + and "x \ y" "x \ FvarsT s" "y \ FvarsT t" + shows "rawpsubst \ ([(s,y),(t,x)]) = rawpsubst \ ([(t,x),(s,y)])" + using assms by (simp add: subst2_fresh_switch) + +lemma rawpsubst_compose: + assumes "\ \ fmla" and "snd ` (set txs1) \ var" and "fst ` (set txs1) \ trm" + and "snd ` (set txs2) \ var" and "fst ` (set txs2) \ trm" + shows "rawpsubst (rawpsubst \ txs1) txs2 = rawpsubst \ (txs1 @ txs2)" + using assms by (induct txs1 arbitrary: txs2 \) auto + +lemma rawpsubst_subst_fresh_switch: + assumes "\ \ fmla" "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + and "\ x \ snd ` (set txs). x \ FvarsT s" + and "\ t \ fst ` (set txs). y \ FvarsT t" + and "distinct (map snd txs)" + and "s \ trm" and "y \ var" "y \ snd ` (set txs)" + shows "rawpsubst (subst \ s y) txs = rawpsubst \ (txs @ [(s,y)])" + using assms proof(induction txs arbitrary: \ s y) + case (Cons tx txs) + obtain t x where tx[simp]: "tx = (t,x)" by force + have x: "x \ var" and t: "t \ trm" using Cons unfolding tx by auto + have "rawpsubst \ ((s, y) # (t, x) # txs) = rawpsubst \ ([(s, y),(t, x)] @ txs)" by simp + also have "\ = rawpsubst (rawpsubst \ [(s, y),(t, x)]) txs" + using Cons by auto + also have "rawpsubst \ [(s, y),(t, x)] = rawpsubst \ [(t, x),(s, y)]" + using Cons by (intro rawpsubst2_fresh_switch) auto + also have "rawpsubst (rawpsubst \ [(t, x),(s, y)]) txs = rawpsubst \ ([(t, x),(s, y)] @ txs)" + using Cons by auto + also have "\ = rawpsubst (subst \ t x) (txs @ [(s,y)])" using Cons by auto + also have "\ = rawpsubst \ (((t, x) # txs) @ [(s, y)])" by simp + finally show ?case unfolding tx by auto +qed auto + +lemma subst_rawpsubst_fresh_switch: + assumes "\ \ fmla" "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + and "\ x \ snd ` (set txs). x \ FvarsT s" + and "\ t \ fst ` (set txs). y \ FvarsT t" + and "distinct (map snd txs)" + and "s \ trm" and "y \ var" "y \ snd ` (set txs)" + shows "subst (rawpsubst \ txs) s y = rawpsubst \ ((s,y) # txs)" + using assms proof(induction txs arbitrary: \ s y) + case (Cons tx txs) + obtain t x where tx[simp]: "tx = (t,x)" by force + have x: "x \ var" and t: "t \ trm" using Cons unfolding tx by auto + have "subst (rawpsubst (subst \ t x) txs) s y = rawpsubst (subst \ t x) ((s,y) # txs)" + using Cons.prems by (intro Cons.IH) auto + also have "\ = rawpsubst (rawpsubst \ [(t,x)]) ((s,y) # txs)" by simp + also have "\ = rawpsubst \ ([(t,x)] @ ((s,y) # txs))" + using Cons.prems by auto + also have "\ = rawpsubst \ ([(t,x),(s,y)] @ txs)" by simp + also have "\ = rawpsubst (rawpsubst \ [(t,x),(s,y)]) txs" + using Cons.prems by auto + also have "rawpsubst \ [(t,x),(s,y)] = rawpsubst \ [(s,y),(t,x)]" + using Cons.prems by (intro rawpsubst2_fresh_switch) auto + also have "rawpsubst (rawpsubst \ [(s,y),(t,x)]) txs = rawpsubst \ ([(s,y),(t,x)] @ txs)" + using Cons.prems by auto + finally show ?case by simp +qed auto + +lemma rawpsubst_compose_freshVar: + assumes "\ \ fmla" "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + and "distinct (map snd txs)" + and "\ i j. i < j \ j < length txs \ snd (txs!j) \ FvarsT (fst (txs!i))" + and us_facts: "set us \ var" + "set us \ Fvars \ = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + shows "rawpsubst (rawpsubst \ (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = rawpsubst \ txs" + using assms proof(induction txs arbitrary: us \) + case (Cons tx txs uus \) + obtain t x where tx[simp]: "tx = (t,x)" by force + obtain u us where uus[simp]: "uus = u # us" using Cons by (cases uus) auto + have us_facts: "set us \ var" + "set us \ Fvars \ = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" and u_facts: "u \ var" "u \ Fvars \" + "u \ \ (FvarsT ` (fst ` (set txs)))" + "u \ snd ` (set txs)" "u \ set us" + using Cons by auto + let ?uxs = "zip (map Var us) (map snd txs)" + have 1: "rawpsubst (subst \ (Var u) x) ?uxs = rawpsubst \ (?uxs @ [(Var u,x)])" + using u_facts Cons.prems + by (intro rawpsubst_subst_fresh_switch) (auto simp: subsetD dest!: set_zip_D) + let ?uuxs = "zip (map Var uus) (map snd (tx # txs))" + let ?tus = "zip (map fst txs) us" let ?ttxs = "zip (map fst (tx # txs)) uus" + have 2: "u \ Fvars (rawpsubst \ (zip (map Var us) (map snd txs))) \ False" + using Cons.prems apply- apply(drule in_Fvars_rawpsubstD) + subgoal by auto + subgoal by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal by auto + subgoal premises prems using us_facts(1,4,5) + by (auto 0 3 simp: in_set_zip subset_eq set_eq_iff image_iff + dest: spec[where P="\x. x \ set us \ (\y \ set txs. x \ snd y)", + THEN mp[OF _ nth_mem], THEN bspec[OF _ nth_mem]]) + subgoal + by (auto simp: in_set_zip subset_eq split: if_splits) . + + have 3: "\ xx tt. xx \ FvarsT t \ (tt, xx) \ set txs" + using Cons.prems(4,5) tx unfolding set_conv_nth + by simp (metis One_nat_def Suc_leI diff_Suc_1 fst_conv le_imp_less_Suc + nth_Cons_0 snd_conv zero_less_Suc) + + have 00: "rawpsubst (rawpsubst \ ?uuxs) ?ttxs = rawpsubst (subst (rawpsubst \ (?uxs @ [(Var u, x)])) t u) ?tus" + by (simp add: 1) + + have "rawpsubst \ (?uxs @ [(Var u, x)]) = rawpsubst (rawpsubst \ ?uxs) [(Var u, x)]" + using Cons.prems by (intro rawpsubst_compose[symmetric]) (auto intro!: rawpsubst dest!: set_zip_D) + also have "rawpsubst (rawpsubst \ ?uxs) [(Var u, x)] = subst (rawpsubst \ ?uxs) (Var u) x" by simp + finally have "subst (rawpsubst \ (?uxs @ [(Var u, x)])) t u = + subst (subst (rawpsubst \ ?uxs) (Var u) x) t u" by simp + also have "\ = subst (rawpsubst \ ?uxs) t x" + using Cons 2 by (intro subst_subst) (auto intro!: rawpsubst dest!: set_zip_D) + also have "\ = rawpsubst \ ((t,x) # ?uxs)" + using Cons.prems 3 apply(intro subst_rawpsubst_fresh_switch) + subgoal by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal by (fastforce dest!: set_zip_D) + by (auto dest!: set_zip_D) + also have "\ = rawpsubst \ ([(t,x)] @ ?uxs)" by simp + also have "\ = rawpsubst (rawpsubst \ [(t,x)]) ?uxs" + using Cons.prems by (intro rawpsubst_compose[symmetric]) (auto dest!: set_zip_D) + finally have "rawpsubst (subst (rawpsubst \ (?uxs @ [(Var u, x)])) t u) ?tus = + rawpsubst (rawpsubst (rawpsubst \ [(t,x)]) ?uxs) ?tus" by auto + hence "rawpsubst (rawpsubst \ ?uuxs) ?ttxs = rawpsubst (rawpsubst (rawpsubst \ [(t,x)]) ?uxs) ?tus" + using 00 by auto + also have "\ = rawpsubst (rawpsubst \ [(t,x)]) txs" + using Cons.prems apply (intro Cons.IH rawpsubst) + subgoal by (auto dest!: set_zip_D in_Fvars_substD) + subgoal by (auto dest!: set_zip_D in_Fvars_substD) + subgoal by (auto dest!: set_zip_D in_Fvars_substD) + subgoal by (auto dest!: set_zip_D in_Fvars_substD) + subgoal by (auto dest!: set_zip_D in_Fvars_substD) + subgoal by (auto dest!: set_zip_D in_Fvars_substD) + subgoal by (metis Suc_mono diff_Suc_1 length_Cons nat.simps(3) nth_Cons') + by (auto dest!: set_zip_D in_Fvars_substD) + also have "\ = rawpsubst \ ([(t,x)] @ txs)" + using Cons.prems by (intro rawpsubst_compose) (auto dest!: set_zip_D) + finally show ?case by simp +qed auto + +lemma rawpsubst_compose_freshVar2_aux: + assumes \[simp]: "\ \ fmla" + and ts: "set ts \ trm" + and xs: "set xs \ var" "distinct xs" + and us_facts: "set us \ var" "distinct us" + "set us \ Fvars \ = {}" + "set us \ \ (FvarsT ` (set ts)) = {}" + "set us \ set xs = {}" + and vs_facts: "set vs \ var" "distinct vs" + "set vs \ Fvars \ = {}" + "set vs \ \ (FvarsT ` (set ts)) = {}" + "set vs \ set xs = {}" + and l: "length us = length xs" "length vs = length xs" "length ts = length xs" + and (* Extra hypothesis, only to get induction through: *) d: "set us \ set vs = {}" + shows "rawpsubst (rawpsubst \ (zip (map Var us) xs)) (zip ts us) = + rawpsubst (rawpsubst \ (zip (map Var vs) xs)) (zip ts vs)" + using assms proof(induction xs arbitrary: \ ts us vs) + case (Cons x xs \ tts uus vvs) + obtain t ts u us v vs where tts[simp]: "tts = t # ts" and lts[simp]: "length ts = length xs" + and uus[simp]: "uus = u # us" and lus[simp]: "length us = length xs" + and vvs[simp]: "vvs = v # vs" and lvs[simp]: "length vs = length xs" + using `length uus = length (x # xs)` `length vvs = length (x # xs)` `length tts = length (x # xs)` + apply(cases tts) + subgoal by auto + subgoal apply(cases uus) + subgoal by auto + subgoal by (cases vvs) auto . . + + let ?\ux = "subst \ (Var u) x" let ?\vx = "subst \ (Var v) x" + + have 0: "rawpsubst (rawpsubst ?\ux (zip (map Var us) xs)) (zip ts us) = + rawpsubst (rawpsubst ?\ux (zip (map Var vs) xs)) (zip ts vs)" + apply(rule Cons.IH) using Cons.prems by (auto intro!: rawpsubst dest!: set_zip_D) + + have 1: "rawpsubst ?\ux (zip (map Var vs) xs) = + subst (rawpsubst \ (zip (map Var vs) xs)) (Var u) x" + using Cons.prems + by (intro subst_rawpsubst_fresh_switch[simplified,symmetric]) + (force intro!: rawpsubst dest!: set_zip_D simp: subset_eq)+ + + have 11: "rawpsubst ?\vx (zip (map Var vs) xs) = + subst (rawpsubst \ (zip (map Var vs) xs)) (Var v) x" + using Cons.prems + by (intro subst_rawpsubst_fresh_switch[simplified,symmetric]) + (auto intro!: rawpsubst dest!: set_zip_D simp: subset_eq) + + have "subst (subst (rawpsubst \ (zip (map Var vs) xs)) (Var u) x) t u = + subst (rawpsubst \ (zip (map Var vs) xs)) t x" + using Cons.prems + by (intro subst_subst) (force intro!: rawpsubst dest!: set_zip_D in_Fvars_rawpsubst_imp simp: Fvars_rawpsubst)+ + also have "\ = subst (subst (rawpsubst \ (zip (map Var vs) xs)) (Var v) x) t v" + using Cons.prems + by (intro subst_subst[symmetric]) + (force intro!: rawpsubst dest!: set_zip_D in_Fvars_rawpsubst_imp simp: Fvars_rawpsubst)+ + + finally have + 2: "subst (subst (rawpsubst \ (zip (map Var vs) xs)) (Var u) x) t u = + subst (subst (rawpsubst \ (zip (map Var vs) xs)) (Var v) x) t v" . + + have "rawpsubst (subst (rawpsubst ?\ux (zip (map Var us) xs)) t u) (zip ts us) = + subst (rawpsubst (rawpsubst ?\ux (zip (map Var us) xs)) (zip ts us)) t u" + using Cons.prems + by (intro subst_rawpsubst_fresh_switch[simplified,symmetric]) (auto intro!: rawpsubst dest!: set_zip_D) + also have "\ = subst (rawpsubst (rawpsubst ?\ux (zip (map Var vs) xs)) (zip ts vs)) t u" + unfolding 0 .. + also have "\ = rawpsubst (subst (rawpsubst ?\ux (zip (map Var vs) xs)) t u) (zip ts vs)" + using Cons.prems + by (intro subst_rawpsubst_fresh_switch[simplified]) (auto intro!: rawpsubst dest!: set_zip_D) + also have "\ = rawpsubst (subst (subst (rawpsubst \ (zip (map Var vs) xs)) (Var u) x) t u) (zip ts vs)" + unfolding 1 .. + also have "\ = rawpsubst (subst (subst (rawpsubst \ (zip (map Var vs) xs)) (Var v) x) t v) (zip ts vs)" + unfolding 2 .. + also have "\ = rawpsubst (subst (rawpsubst ?\vx (zip (map Var vs) xs)) t v) (zip ts vs)" + unfolding 11 .. + finally have "rawpsubst (subst (rawpsubst ?\ux (zip (map Var us) xs)) t u) (zip ts us) = + rawpsubst (subst (rawpsubst ?\vx (zip (map Var vs) xs)) t v) (zip ts vs)" . + thus ?case by simp +qed auto + +text \... now getting rid of the disjointness hypothesis:\ + +lemma rawpsubst_compose_freshVar2: + assumes \[simp]: "\ \ fmla" + and ts: "set ts \ trm" + and xs: "set xs \ var" "distinct xs" + and us_facts: "set us \ var" "distinct us" + "set us \ Fvars \ = {}" + "set us \ \ (FvarsT ` (set ts)) = {}" + "set us \ set xs = {}" + and vs_facts: "set vs \ var" "distinct vs" + "set vs \ Fvars \ = {}" + "set vs \ \ (FvarsT ` (set ts)) = {}" + "set vs \ set xs = {}" + and l: "length us = length xs" "length vs = length xs" "length ts = length xs" + shows "rawpsubst (rawpsubst \ (zip (map Var us) xs)) (zip ts us) = + rawpsubst (rawpsubst \ (zip (map Var vs) xs)) (zip ts vs)" (is "?L = ?R") +proof- + define ws where "ws = getFrN (xs @ us @ vs) ts [\] (length xs)" + note fv = getFrN_Fvars[of "xs @ us @ vs" "ts" "[\]" _ "length xs"] + and fvt = getFrN_FvarsT[of "xs @ us @ vs" "ts" "[\]" _ "length xs"] + and var = getFrN_var[of "xs @ us @ vs" "ts" "[\]" _ "length xs"] + and l = getFrN_length[of "xs @ us @ vs" "ts" "[\]" "length xs"] + have ws_facts: "set ws \ var" "distinct ws" + "set ws \ Fvars \ = {}" + "set ws \ \ (FvarsT ` (set ts)) = {}" + "set ws \ set xs = {}" "set ws \ set us = {}" "set ws \ set vs = {}" + "length ws = length xs" using assms unfolding ws_def + apply - + subgoal by auto + subgoal by auto + subgoal using fv by auto + subgoal using fvt IntI empty_iff by fastforce + subgoal using var IntI empty_iff by fastforce + subgoal using var IntI empty_iff by fastforce + subgoal using var IntI empty_iff by fastforce + subgoal using l by auto . + have "?L = rawpsubst (rawpsubst \ (zip (map Var ws) xs)) (zip ts ws)" + apply(rule rawpsubst_compose_freshVar2_aux) using assms ws_facts by auto + also have "\ = ?R" + apply(rule rawpsubst_compose_freshVar2_aux) using assms ws_facts by auto + finally show ?thesis . +qed + +lemma psubst_subst_fresh_switch: + assumes "\ \ fmla" "snd ` set txs \ var" "fst ` set txs \ trm" + and "\x\snd ` set txs. x \ FvarsT s" "\t\fst ` set txs. y \ FvarsT t" + and "distinct (map snd txs)" + and "s \ trm" "y \ var" "y \ snd ` set txs" + shows "psubst (subst \ s y) txs = subst (psubst \ txs) s y" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [\] (length txs)" + note fvt = getFrN_FvarsT[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + and fv = getFrN_Fvars[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + and var = getFrN_var[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + and l = getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + + have us_facts: "set us \ var" + "set us \ Fvars \ = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us apply - + subgoal by auto + subgoal using fv by (cases txs, auto) + subgoal using fvt by (cases txs, auto) + subgoal using var by (cases txs, auto) + subgoal using l by auto + subgoal by auto . + + define vs where vs: "vs = getFrN (map snd txs) (map fst txs) [subst \ s y] (length txs)" + note fvt = getFrN_FvarsT[of "map snd txs" "map fst txs" "[subst \ s y]" _ "length txs"] + and fv = getFrN_Fvars[of "map snd txs" "map fst txs" "[subst \ s y]" _ "length txs"] + and var = getFrN_var[of "map snd txs" "map fst txs" "[subst \ s y]" _ "length txs"] + and l = getFrN_length[of "map snd txs" "map fst txs" "[subst \ s y]" "length txs"] + + have vs_facts: "set vs \ var" + "set vs \ Fvars (subst \ s y) = {}" + "set vs \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs \ snd ` (set txs) = {}" + "length vs = length txs" + "distinct vs" + using assms unfolding vs apply - + subgoal by auto + subgoal using fv by (cases txs, auto) + subgoal using fvt by (cases txs, auto) + subgoal using var by (cases txs, auto) + subgoal using l by auto + subgoal by auto . + + define ws where ws: "ws = getFrN (y # map snd txs) (s # map fst txs) [\] (length txs)" + note fvt = getFrN_FvarsT[of "y # map snd txs" "s # map fst txs" "[\]" _ "length txs"] + and fv = getFrN_Fvars[of "y # map snd txs" "s # map fst txs" "[\]" _ "length txs"] + and var = getFrN_var[of "y # map snd txs" "s # map fst txs" "[\]" _ "length txs"] + and l = getFrN_length[of "y # map snd txs" "s # map fst txs" "[\]" "length txs"] + + have ws_facts: "set ws \ var" + "set ws \ Fvars \ = {}" "y \ set ws" "set ws \ FvarsT s = {}" + "set ws \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set ws \ snd ` (set txs) = {}" + "length ws = length txs" + "distinct ws" + using assms unfolding ws apply - + subgoal by auto + subgoal using fv by (cases txs, auto) + subgoal using var by (cases txs, auto) + subgoal using fvt by (cases txs, auto) + subgoal using fvt by (cases txs, auto) + subgoal using var by (cases txs, auto) + subgoal using l by (cases txs, auto) + by auto + + let ?vxs = "zip (map Var vs) (map snd txs)" + let ?tvs = "(zip (map fst txs) vs)" + let ?uxs = "zip (map Var us) (map snd txs)" + let ?tus = "(zip (map fst txs) us)" + let ?wxs = "zip (map Var ws) (map snd txs)" + let ?tws = "(zip (map fst txs) ws)" + + have 0: "rawpsubst (subst \ s y) ?wxs = subst (rawpsubst \ ?wxs) s y" + apply(subst rawpsubst_compose[of \ ?wxs "[(s,y)]",simplified]) + using assms ws_facts apply - + subgoal by auto + subgoal by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal by auto + subgoal by auto + subgoal apply(subst rawpsubst_subst_fresh_switch) + by (auto dest!: set_zip_D simp: subset_eq rawpsubst_subst_fresh_switch) . + + have 1: "rawpsubst (rawpsubst \ ?wxs) ?tws = rawpsubst (rawpsubst \ ?uxs) ?tus" + using assms ws_facts us_facts by (intro rawpsubst_compose_freshVar2) (auto simp: subset_eq) + + have "rawpsubst (rawpsubst (subst \ s y) ?vxs) ?tvs = + rawpsubst (rawpsubst (subst \ s y) ?wxs) ?tws" + using assms ws_facts vs_facts + by (intro rawpsubst_compose_freshVar2) (auto simp: subset_eq) + also have "\ = rawpsubst (subst (rawpsubst \ ?wxs) s y) ?tws" unfolding 0 .. + also have "\ = subst (rawpsubst (rawpsubst \ ?wxs) ?tws) s y" + apply(subst rawpsubst_compose[of "rawpsubst \ ?wxs" ?tws "[(s,y)]",simplified]) + using assms ws_facts apply - + subgoal by (auto dest!: set_zip_D simp: subset_eq intro!: rawpsubst) + subgoal by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal by auto + subgoal by auto + subgoal by (subst rawpsubst_subst_fresh_switch) + (auto dest!: set_zip_D simp: subset_eq rawpsubst_subst_fresh_switch + intro!: rawpsubst) . + also have "\ = subst (rawpsubst (rawpsubst \ ?uxs) ?tus) s y" unfolding 1 .. + finally show ?thesis unfolding psubst_def by (simp add: Let_def vs[symmetric] us[symmetric]) +qed + +text \For many cases, the simpler rawpsubst can replace psubst:\ + +lemma psubst_eq_rawpsubst: + assumes "\ \ fmla" "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + and "distinct (map snd txs)" + (* ... namely, when the substituted variables do not belong to trms substituted for previous variables: *) + and "\ i j. i < j \ j < length txs \ snd (txs!j) \ FvarsT (fst (txs!i))" + shows "psubst \ txs = rawpsubst \ txs" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [\] (length txs)" + note fvt = getFrN_FvarsT[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + and fv = getFrN_Fvars[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + and var = getFrN_var[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + and l = getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + have us_facts: "set us \ var" + "set us \ Fvars \ = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + apply - + subgoal by auto + subgoal using fv by auto + subgoal using fvt by force + subgoal using var by (force simp: image_iff) + using l by auto + show ?thesis + using rawpsubst_compose_freshVar assms us_facts + by (simp add: psubst_def Let_def us[symmetric]) +qed + +text \Some particular cases:\ + +lemma psubst_eq_subst: + assumes "\ \ fmla" "x \ var" and "t \ trm" + shows "psubst \ [(t,x)] = subst \ t x" +proof- + have "psubst \ [(t,x)] = rawpsubst \ [(t,x)]" apply(rule psubst_eq_rawpsubst) + using assms by auto + thus ?thesis by auto +qed + +lemma psubst_eq_rawpsubst2: + assumes "\ \ fmla" "x1 \ var" "x2 \ var" "t1 \ trm" "t2 \ trm" + and "x1 \ x2" "x2 \ FvarsT t1" + shows "psubst \ [(t1,x1),(t2,x2)] = rawpsubst \ [(t1,x1),(t2,x2)]" + apply(rule psubst_eq_rawpsubst) + using assms using less_SucE by force+ + +lemma psubst_eq_rawpsubst3: + assumes "\ \ fmla" "x1 \ var" "x2 \ var" "x3 \ var" "t1 \ trm" "t2 \ trm" "t3 \ trm" + and "x1 \ x2" "x1 \ x3" "x2 \ x3" + "x2 \ FvarsT t1" "x3 \ FvarsT t1" "x3 \ FvarsT t2" + shows "psubst \ [(t1,x1),(t2,x2),(t3,x3)] = rawpsubst \ [(t1,x1),(t2,x2),(t3,x3)]" + using assms using less_SucE apply(intro psubst_eq_rawpsubst) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal for i j + apply(cases j) + subgoal by auto + subgoal by (simp add: nth_Cons') . . + +lemma psubst_eq_rawpsubst4: + assumes "\ \ fmla" "x1 \ var" "x2 \ var" "x3 \ var" "x4 \ var" + "t1 \ trm" "t2 \ trm" "t3 \ trm" "t4 \ trm" + and "x1 \ x2" "x1 \ x3" "x2 \ x3" "x1 \ x4" "x2 \ x4" "x3 \ x4" + "x2 \ FvarsT t1" "x3 \ FvarsT t1" "x3 \ FvarsT t2" "x4 \ FvarsT t1" "x4 \ FvarsT t2" "x4 \ FvarsT t3" + shows "psubst \ [(t1,x1),(t2,x2),(t3,x3),(t4,x4)] = rawpsubst \ [(t1,x1),(t2,x2),(t3,x3),(t4,x4)]" + using assms using less_SucE apply(intro psubst_eq_rawpsubst) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal for i j + apply(cases j) + subgoal by auto + subgoal by (simp add: nth_Cons') . . + +lemma rawpsubst_same_Var[simp]: + assumes "\ \ fmla" "set xs \ var" + shows "rawpsubst \ (map (\x. (Var x,x)) xs) = \" + using assms by (induct xs) auto + +lemma psubst_same_Var[simp]: + assumes "\ \ fmla" "set xs \ var" and "distinct xs" + shows "psubst \ (map (\x. (Var x,x)) xs) = \" +proof- + have "psubst \ (map (\x. (Var x,x)) xs) = rawpsubst \ (map (\x. (Var x,x)) xs)" + using assms by (intro psubst_eq_rawpsubst) (auto simp: nth_eq_iff_index_eq subsetD) + thus ?thesis using assms by auto +qed + +lemma rawpsubst_notIn[simp]: + assumes "snd ` (set txs) \ var" "fst ` (set txs) \ trm" "\ \ fmla" + and "Fvars \ \ snd ` (set txs) = {}" + shows "rawpsubst \ txs = \" + using assms by (induct txs) auto + +lemma psubst_notIn[simp]: + assumes "x \ var" "snd ` (set txs) \ var" "fst ` (set txs) \ trm" "\ \ fmla" + and "Fvars \ \ snd ` (set txs) = {}" + shows "psubst \ txs = \" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [\] (length txs)" + have us_facts: "set us \ var" + "set us \ Fvars \ = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + using assms unfolding us apply - + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by (fastforce simp: image_iff) + subgoal by auto . + (* *) + have [simp]: "rawpsubst \ (zip (map Var us) (map snd txs)) = \" + using assms us_facts apply(intro rawpsubst_notIn) + subgoal by (auto dest!: set_zip_rightD) + subgoal by (auto dest!: set_zip_leftD) + subgoal by auto + subgoal by (auto dest!: set_zip_rightD) . + have [simp]: "rawpsubst \ (zip (map fst txs) us) = \" + using assms us_facts apply(intro rawpsubst_notIn) + subgoal by (auto dest!: set_zip_rightD) + subgoal by (auto dest!: set_zip_leftD) + subgoal by auto + subgoal by (auto dest!: set_zip_rightD) . + show ?thesis using assms us_facts unfolding psubst_def + by(auto simp: Let_def us[symmetric]) +qed + +end \ \context @{locale Generic_Syntax}\ + + +section \Adding Numerals to the Generic Syntax\ + +locale Syntax_with_Numerals = + Generic_Syntax var trm fmla Var FvarsT substT Fvars subst + for var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" + and Var FvarsT substT Fvars subst + + + fixes + \ \Abstract notion of numerals, as a subset of the ground terms:\ + num :: "'trm set" + assumes + numNE: "num \ {}" + and + num: "num \ trm" + and + FvarsT_num[simp, intro!]: "\n. n \ num \ FvarsT n = {}" +begin + +lemma substT_num1[simp]: "t \ trm \ y \ var \ n \ num \ substT n t y = n" + using num by auto + +lemma in_num[simp]: "n \ num \ n \ trm" using num by auto + +lemma subst_comp_num: + assumes "\ \ fmla" "x \ var" "y \ var" "n \ num" + shows "x \ y \ subst (subst \ (Var x) y) n x = subst (subst \ n x) n y" + using assms by (simp add: subst_comp) + +lemma rawpsubstT_num: + assumes "snd ` (set txs) \ var" "fst ` (set txs) \ trm" "n \ num" + shows "rawpsubstT n txs = n" + using assms by (induct txs) auto + +lemma psubstT_num[simp]: + assumes "snd ` (set txs) \ var" "fst ` (set txs) \ trm" "n \ num" + shows "psubstT n txs = n" +proof- + define us where us: "us = getFrN (map snd txs) (n # map fst txs) [] (length txs)" + have us_facts: "set us \ var" + "set us \ FvarsT n = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + using assms unfolding us + using getFrN_Fvars[of "map snd txs" "n # map fst txs" "[]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "n # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "n # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "n # map fst txs" "[]" "length txs"] + by (auto 7 0 simp: set_eq_iff image_iff) + let ?t = "rawpsubstT n (zip (map Var us) (map snd txs))" + have t: "?t = n" + using assms us_facts apply(intro rawpsubstT_num) + subgoal by (auto dest!: set_zip_rightD) + subgoal by (auto dest!: set_zip_leftD) + subgoal by auto . + have "rawpsubstT ?t (zip (map fst txs) us) = n" + unfolding t using assms us_facts apply(intro rawpsubstT_num) + subgoal by (auto dest!: set_zip_rightD) + subgoal by (auto dest!: set_zip_leftD) + subgoal by auto . + thus ?thesis unfolding psubstT_def by(simp add: Let_def us[symmetric]) +qed + +end \ \context @{locale Syntax_with_Numerals}\ + + +section \Adding Connectives and Quantifiers\ + +locale Syntax_with_Connectives = + Generic_Syntax var trm fmla Var FvarsT substT Fvars subst + for + var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" + and Var FvarsT substT Fvars subst + + + fixes + \ \Logical connectives\ + eql :: "'trm \ 'trm \ 'fmla" + and + cnj :: "'fmla \ 'fmla \ 'fmla" + and + imp :: "'fmla \ 'fmla \ 'fmla" + and + all :: "'var \ 'fmla \ 'fmla" + and + exi :: "'var \ 'fmla \ 'fmla" + assumes + eql[simp,intro]: "\ t1 t2. t1 \ trm \ t2 \ trm \ eql t1 t2 \ fmla" + and + cnj[simp,intro]: "\ \1 \2. \1 \ fmla \ \2 \ fmla \ cnj \1 \2 \ fmla" + and + imp[simp,intro]: "\ \1 \2. \1 \ fmla \ \2 \ fmla \ imp \1 \2 \ fmla" + and + all[simp,intro]: "\ x \. x \ var \ \ \ fmla \ all x \ \ fmla" + and + exi[simp,intro]: "\ x \. x \ var \ \ \ fmla \ exi x \ \ fmla" + and + Fvars_eql[simp]: + "\ t1 t2. t1 \ trm \ t2 \ trm \ Fvars (eql t1 t2) = FvarsT t1 \ FvarsT t2" + and + Fvars_cnj[simp]: + "\ \ \. \ \ fmla \ \ \ fmla \ Fvars (cnj \ \) = Fvars \ \ Fvars \" + and + Fvars_imp[simp]: + "\ \ \. \ \ fmla \ \ \ fmla \ Fvars (imp \ \) = Fvars \ \ Fvars \" + and + Fvars_all[simp]: + "\ x \. x \ var \ \ \ fmla \ Fvars (all x \) = Fvars \ - {x}" + and + Fvars_exi[simp]: + "\ x \. x \ var \ \ \ fmla \ Fvars (exi x \) = Fvars \ - {x}" + and + \ \Assumed properties of substitution\ + subst_cnj[simp]: + "\ x \ \ t. \ \ fmla \ \ \ fmla \ t \ trm \ x \ var \ + subst (cnj \ \) t x = cnj (subst \ t x) (subst \ t x)" + and + subst_imp[simp]: + "\ x \ \ t. \ \ fmla \ \ \ fmla \ t \ trm \ x \ var \ + subst (imp \ \) t x = imp (subst \ t x) (subst \ t x)" + and + subst_all[simp]: + "\ x y \ t. \ \ fmla \ t \ trm \ x \ var \ y \ var \ + x \ y \ x \ FvarsT t \ subst (all x \) t y = all x (subst \ t y)" + and + subst_exi[simp]: + "\ x y \ t. \ \ fmla \ t \ trm \ x \ var \ y \ var \ + x \ y \ x \ FvarsT t \ subst (exi x \) t y = exi x (subst \ t y)" + and + subst_eql[simp]: + "\ t1 t2 t x. t \ trm \ t1 \ trm \ t2 \ trm \ x \ var \ + subst (eql t1 t2) t x = eql (substT t1 t x) (substT t2 t x)" +begin + +(* +(* "is the unique": isTU t x \ is the formula "t is the unique x such that phi(x)" + *) +definition isTU :: "'trm \ 'var \ 'fmla \ 'fmla" where +"isTU t x \ \ + cnj (subst \ t x) + (all x (imp \ (subst \ t x)))" + +(* TODO: properties: works well when x is not free in t, +in particular, when t is num n *) +*) + +text \Formula equivalence, $\longleftrightarrow$, a derived connective\ + +definition eqv :: "'fmla \ 'fmla \ 'fmla" where + "eqv \ \ = cnj (imp \ \) (imp \ \)" + +lemma + eqv[simp]: "\\ \. \ \ fmla \ \ \ fmla \ eqv \ \ \ fmla" + and + Fvars_eqv[simp]: "\\ \. \ \ fmla \ \ \ fmla \ + Fvars (eqv \ \) = Fvars \ \ Fvars \" + and + subst_eqv[simp]: + "\\ \ t x. \ \ fmla \ \ \ fmla \ t \ trm \ x \ var \ + subst (eqv \ \) t x = eqv (subst \ t x) (subst \ t x)" + unfolding eqv_def by auto + +lemma subst_all_idle[simp]: +assumes [simp]: "x \ var" "\ \ fmla" "t \ trm" +shows "subst (all x \) t x = all x \" +by (intro subst_notIn) auto + +lemma subst_exi_idle[simp]: +assumes [simp]: "x \ var" "\ \ fmla" "t \ trm" +shows "subst (exi x \) t x = exi x \" +by (rule subst_notIn) auto + + +text \Parallel substitution versus connectives and quantifiers.\ + +lemma rawpsubst_cnj: + assumes "\1 \ fmla" "\2 \ fmla" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + shows "rawpsubst (cnj \1 \2) txs = cnj (rawpsubst \1 txs) (rawpsubst \2 txs)" + using assms by (induct txs arbitrary: \1 \2) auto + +lemma psubst_cnj[simp]: + assumes "\1 \ fmla" "\2 \ fmla" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "distinct (map snd txs)" + shows "psubst (cnj \1 \2) txs = cnj (psubst \1 txs) (psubst \2 txs)" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [cnj \1 \2] (length txs)" + have us_facts: "set us \ var" + "set us \ Fvars \1 = {}" + "set us \ Fvars \2 = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_Fvars[of "map snd txs" "map fst txs" "[cnj \1 \2]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[cnj \1 \2]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[cnj \1 \2]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[cnj \1 \2]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by fastforce + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + subgoal by auto + subgoal by auto . + define vs1 where vs1: "vs1 = getFrN (map snd txs) (map fst txs) [\1] (length txs)" + have vs1_facts: "set vs1 \ var" + "set vs1 \ Fvars \1 = {}" + "set vs1 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs1 \ snd ` (set txs) = {}" + "length vs1 = length txs" + "distinct vs1" + using assms unfolding vs1 + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\1]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by fastforce + subgoal by force + subgoal by auto + subgoal by auto . + + define vs2 where vs2: "vs2 = getFrN (map snd txs) (map fst txs) [\2] (length txs)" + have vs2_facts: "set vs2 \ var" + "set vs2 \ Fvars \2 = {}" + "set vs2 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs2 \ snd ` (set txs) = {}" + "length vs2 = length txs" + "distinct vs2" + using assms unfolding vs2 + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\2]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by fastforce + subgoal by force + subgoal by auto + subgoal by auto . + + let ?tus = "zip (map fst txs) us" + let ?uxs = "zip (map Var us) (map snd txs)" + let ?tvs1 = "zip (map fst txs) vs1" + let ?vxs1 = "zip (map Var vs1) (map snd txs)" + let ?tvs2 = "zip (map fst txs) vs2" + let ?vxs2 = "zip (map Var vs2) (map snd txs)" + + let ?c = "rawpsubst (cnj \1 \2) ?uxs" + have c: "?c = cnj (rawpsubst \1 ?uxs) (rawpsubst \2 ?uxs)" + using assms us_facts + by (intro rawpsubst_cnj) (auto intro!: rawpsubstT dest!: set_zip_D) + have 0: "rawpsubst ?c ?tus = + cnj (rawpsubst (rawpsubst \1 ?uxs) ?tus) (rawpsubst (rawpsubst \2 ?uxs) ?tus)" + unfolding c using assms us_facts + by (intro rawpsubst_cnj) (auto dest!: set_zip_D intro!: rawpsubst) + + have 1: "rawpsubst (rawpsubst \1 ?uxs) ?tus = rawpsubst (rawpsubst \1 ?vxs1) ?tvs1" + using assms vs1_facts us_facts + by (intro rawpsubst_compose_freshVar2) (auto intro!: rawpsubst) + have 2: "rawpsubst (rawpsubst \2 ?uxs) ?tus = rawpsubst (rawpsubst \2 ?vxs2) ?tvs2" + using assms vs2_facts us_facts + by (intro rawpsubst_compose_freshVar2)(auto intro!: rawpsubst) + show ?thesis unfolding psubst_def by (simp add: Let_def us[symmetric] vs1[symmetric] vs2[symmetric] 0 1 2) +qed + +lemma rawpsubst_imp: + assumes "\1 \ fmla" "\2 \ fmla" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + shows "rawpsubst (imp \1 \2) txs = imp (rawpsubst \1 txs) (rawpsubst \2 txs)" + using assms apply (induct txs arbitrary: \1 \2) + subgoal by auto + subgoal for tx txs \1 \2 by (cases tx) auto . + +lemma psubst_imp[simp]: + assumes "\1 \ fmla" "\2 \ fmla" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "distinct (map snd txs)" + shows "psubst (imp \1 \2) txs = imp (psubst \1 txs) (psubst \2 txs)" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [imp \1 \2] (length txs)" + have us_facts: "set us \ var" + "set us \ Fvars \1 = {}" + "set us \ Fvars \2 = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_Fvars[of "map snd txs" "map fst txs" "[imp \1 \2]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[imp \1 \2]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[imp \1 \2]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[imp \1 \2]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by fastforce + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + by auto + + define vs1 where vs1: "vs1 = getFrN (map snd txs) (map fst txs) [\1] (length txs)" + have vs1_facts: "set vs1 \ var" + "set vs1 \ Fvars \1 = {}" + "set vs1 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs1 \ snd ` (set txs) = {}" + "length vs1 = length txs" + "distinct vs1" + using assms unfolding vs1 + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\1]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by fastforce + subgoal by force + by auto + + define vs2 where vs2: "vs2 = getFrN (map snd txs) (map fst txs) [\2] (length txs)" + have vs2_facts: "set vs2 \ var" + "set vs2 \ Fvars \2 = {}" + "set vs2 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs2 \ snd ` (set txs) = {}" + "length vs2 = length txs" + "distinct vs2" + using assms unfolding vs2 + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\2]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by fastforce + subgoal by force + by auto + + let ?tus = "zip (map fst txs) us" + let ?uxs = "zip (map Var us) (map snd txs)" + let ?tvs1 = "zip (map fst txs) vs1" + let ?vxs1 = "zip (map Var vs1) (map snd txs)" + let ?tvs2 = "zip (map fst txs) vs2" + let ?vxs2 = "zip (map Var vs2) (map snd txs)" + + let ?c = "rawpsubst (imp \1 \2) ?uxs" + have c: "?c = imp (rawpsubst \1 ?uxs) (rawpsubst \2 ?uxs)" + apply(rule rawpsubst_imp) using assms us_facts apply (auto intro!: rawpsubstT) + apply(drule set_zip_rightD) apply simp apply blast + apply(drule set_zip_leftD) apply simp apply blast . + have 0: "rawpsubst ?c ?tus = + imp (rawpsubst (rawpsubst \1 ?uxs) ?tus) (rawpsubst (rawpsubst \2 ?uxs) ?tus)" + unfolding c + using assms us_facts + by (intro rawpsubst_imp) (auto intro!: rawpsubst dest!: set_zip_D) + have 1: "rawpsubst (rawpsubst \1 ?uxs) ?tus = rawpsubst (rawpsubst \1 ?vxs1) ?tvs1" + using assms vs1_facts us_facts + by (intro rawpsubst_compose_freshVar2) (auto intro!: rawpsubst) + have 2: "rawpsubst (rawpsubst \2 ?uxs) ?tus = rawpsubst (rawpsubst \2 ?vxs2) ?tvs2" + using assms vs2_facts us_facts + by (intro rawpsubst_compose_freshVar2) (auto intro!: rawpsubst) + show ?thesis unfolding psubst_def by (simp add: Let_def us[symmetric] vs1[symmetric] vs2[symmetric] 0 1 2) +qed + +lemma rawpsubst_eqv: + assumes "\1 \ fmla" "\2 \ fmla" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + shows "rawpsubst (eqv \1 \2) txs = eqv (rawpsubst \1 txs) (rawpsubst \2 txs)" + using assms apply (induct txs arbitrary: \1 \2) + subgoal by auto + subgoal for tx txs \1 \2 by (cases tx) auto . + +lemma psubst_eqv[simp]: + assumes "\1 \ fmla" "\2 \ fmla" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "distinct (map snd txs)" + shows "psubst (eqv \1 \2) txs = eqv (psubst \1 txs) (psubst \2 txs)" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [eqv \1 \2] (length txs)" + have us_facts: "set us \ var" + "set us \ Fvars \1 = {}" + "set us \ Fvars \2 = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_Fvars[of "map snd txs" "map fst txs" "[eqv \1 \2]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[eqv \1 \2]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[eqv \1 \2]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[eqv \1 \2]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by fastforce + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + by auto + + define vs1 where vs1: "vs1 = getFrN (map snd txs) (map fst txs) [\1] (length txs)" + have vs1_facts: "set vs1 \ var" + "set vs1 \ Fvars \1 = {}" + "set vs1 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs1 \ snd ` (set txs) = {}" + "length vs1 = length txs" + "distinct vs1" + using assms unfolding vs1 + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\1]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by fastforce + subgoal by force + by auto + + define vs2 where vs2: "vs2 = getFrN (map snd txs) (map fst txs) [\2] (length txs)" + have vs2_facts: "set vs2 \ var" + "set vs2 \ Fvars \2 = {}" + "set vs2 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs2 \ snd ` (set txs) = {}" + "length vs2 = length txs" + "distinct vs2" + using assms unfolding vs2 + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\2]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by fastforce + subgoal by force + by auto + + let ?tus = "zip (map fst txs) us" + let ?uxs = "zip (map Var us) (map snd txs)" + let ?tvs1 = "zip (map fst txs) vs1" + let ?vxs1 = "zip (map Var vs1) (map snd txs)" + let ?tvs2 = "zip (map fst txs) vs2" + let ?vxs2 = "zip (map Var vs2) (map snd txs)" + + let ?c = "rawpsubst (eqv \1 \2) ?uxs" + have c: "?c = eqv (rawpsubst \1 ?uxs) (rawpsubst \2 ?uxs)" + using assms us_facts + by (intro rawpsubst_eqv) (auto intro!: rawpsubstT dest!: set_zip_D) + have 0: "rawpsubst ?c ?tus = + eqv (rawpsubst (rawpsubst \1 ?uxs) ?tus) (rawpsubst (rawpsubst \2 ?uxs) ?tus)" + unfolding c using assms us_facts + by (intro rawpsubst_eqv) (auto intro!: rawpsubst dest!: set_zip_D) + have 1: "rawpsubst (rawpsubst \1 ?uxs) ?tus = rawpsubst (rawpsubst \1 ?vxs1) ?tvs1" + using assms vs1_facts us_facts + by (intro rawpsubst_compose_freshVar2) (auto intro!: rawpsubst) + have 2: "rawpsubst (rawpsubst \2 ?uxs) ?tus = rawpsubst (rawpsubst \2 ?vxs2) ?tvs2" + using assms vs2_facts us_facts + by (intro rawpsubst_compose_freshVar2) (auto intro!: rawpsubst) + show ?thesis unfolding psubst_def by (simp add: Let_def us[symmetric] vs1[symmetric] vs2[symmetric] 0 1 2) +qed + +lemma rawpsubst_all: + assumes "\ \ fmla" "y \ var" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "y \ snd ` (set txs)" "y \ \ (FvarsT ` fst ` (set txs))" + shows "rawpsubst (all y \) txs = all y (rawpsubst \ txs)" + using assms apply (induct txs arbitrary: \) + subgoal by auto + subgoal for tx txs \ by (cases tx) auto . + +lemma psubst_all[simp]: + assumes "\ \ fmla" "y \ var" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "y \ snd ` (set txs)" "y \ \ (FvarsT ` fst ` (set txs))" + and "distinct (map snd txs)" + shows "psubst (all y \) txs = all y (psubst \ txs)" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [all y \] (length txs)" + have us_facts: "set us \ var" + "set us \ (Fvars \ - {y}) = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_Fvars[of "map snd txs" "map fst txs" "[all y \]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[all y \]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[all y \]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[all y \]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + by auto + + define vs where vs: "vs = getFrN (map snd txs) (map fst txs) [\] (length txs)" + have vs_facts: "set vs \ var" + "set vs \ Fvars \ = {}" + "set vs \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs \ snd ` (set txs) = {}" + "length vs = length txs" + "distinct vs" + using assms unfolding vs + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + by auto + + define ws where ws: "ws = getFrN (y # map snd txs) (map fst txs) [\] (length txs)" + have ws_facts: "set ws \ var" + "set ws \ Fvars \ = {}" "y \ set ws" + "set ws \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set ws \ snd ` (set txs) = {}" + "length ws = length txs" + "distinct ws" + using assms unfolding ws + using getFrN_Fvars[of "y # map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_FvarsT[of "y # map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_var[of "y # map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_length[of "y # map snd txs" "map fst txs" "[\]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + by auto + + have 0: "rawpsubst (all y \) (zip (map Var ws) (map snd txs)) = + all y (rawpsubst \ (zip (map Var ws) (map snd txs)))" + using assms ws_facts apply(intro rawpsubst_all) + subgoal by auto + subgoal by auto + subgoal by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal by (fastforce dest: set_zip_D) . + + have 1: "rawpsubst ((rawpsubst \ (zip (map Var ws) (map snd txs)))) (zip (map fst txs) ws) = + rawpsubst ((rawpsubst \ (zip (map Var vs) (map snd txs)))) (zip (map fst txs) vs)" + apply(rule rawpsubst_compose_freshVar2) + using assms ws_facts vs_facts by (auto intro!: rawpsubst) + have "rawpsubst (rawpsubst (all y \) (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = + rawpsubst (rawpsubst (all y \) (zip (map Var ws) (map snd txs))) (zip (map fst txs) ws)" + using assms ws_facts us_facts + by (intro rawpsubst_compose_freshVar2) (auto intro!: rawpsubst) + also have + "\ = all y (rawpsubst ((rawpsubst \ (zip (map Var ws) (map snd txs)))) (zip (map fst txs) ws))" + unfolding 0 using assms ws_facts + by (intro rawpsubst_all) (auto dest!: set_zip_D intro!: rawpsubst) + also have + "\ = all y (rawpsubst (rawpsubst \ (zip (map Var vs) (map snd txs))) (zip (map fst txs) vs))" + unfolding 1 .. + finally show ?thesis unfolding psubst_def by (simp add: Let_def us[symmetric] vs[symmetric]) +qed + +lemma rawpsubst_exi: + assumes "\ \ fmla" "y \ var" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "y \ snd ` (set txs)" "y \ \ (FvarsT ` fst ` (set txs))" + shows "rawpsubst (exi y \) txs = exi y (rawpsubst \ txs)" + using assms apply (induct txs arbitrary: \) + subgoal by auto + subgoal for tx txs \ by (cases tx) auto . + +lemma psubst_exi[simp]: + assumes "\ \ fmla" "y \ var" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "y \ snd ` (set txs)" "y \ \ (FvarsT ` fst ` (set txs))" + and "distinct (map snd txs)" + shows "psubst (exi y \) txs = exi y (psubst \ txs)" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [exi y \] (length txs)" + have us_facts: "set us \ var" + "set us \ (Fvars \ - {y}) = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_Fvars[of "map snd txs" "map fst txs" "[exi y \]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[exi y \]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[exi y \]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[exi y \]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + by auto + + define vs where vs: "vs = getFrN (map snd txs) (map fst txs) [\] (length txs)" + have vs_facts: "set vs \ var" + "set vs \ Fvars \ = {}" + "set vs \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs \ snd ` (set txs) = {}" + "length vs = length txs" + "distinct vs" + using assms unfolding vs + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + by auto + + define ws where ws: "ws = getFrN (y # map snd txs) (map fst txs) [\] (length txs)" + have ws_facts: "set ws \ var" + "set ws \ Fvars \ = {}" "y \ set ws" + "set ws \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set ws \ snd ` (set txs) = {}" + "length ws = length txs" + "distinct ws" + using assms unfolding ws + using getFrN_Fvars[of "y # map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_FvarsT[of "y # map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_var[of "y # map snd txs" "map fst txs" "[\]" _ "length txs"] + getFrN_length[of "y # map snd txs" "map fst txs" "[\]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + by auto + + have 0: "rawpsubst (exi y \) (zip (map Var ws) (map snd txs)) = + exi y (rawpsubst \ (zip (map Var ws) (map snd txs)))" + using assms ws_facts apply(intro rawpsubst_exi) + subgoal by auto + subgoal by auto + subgoal by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal by (fastforce dest: set_zip_D) . + + have 1: "rawpsubst ((rawpsubst \ (zip (map Var ws) (map snd txs)))) (zip (map fst txs) ws) = + rawpsubst ((rawpsubst \ (zip (map Var vs) (map snd txs)))) (zip (map fst txs) vs)" + using assms ws_facts vs_facts + by (intro rawpsubst_compose_freshVar2) (auto intro!: rawpsubst) + have "rawpsubst (rawpsubst (exi y \) (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = + rawpsubst (rawpsubst (exi y \) (zip (map Var ws) (map snd txs))) (zip (map fst txs) ws)" + using assms ws_facts us_facts + by (intro rawpsubst_compose_freshVar2) (auto intro!: rawpsubst) + also have + "\ = exi y (rawpsubst ((rawpsubst \ (zip (map Var ws) (map snd txs)))) (zip (map fst txs) ws))" + using assms ws_facts unfolding 0 + by (intro rawpsubst_exi) (auto dest!: set_zip_D intro!: rawpsubst) + also have + "\ = exi y (rawpsubst (rawpsubst \ (zip (map Var vs) (map snd txs))) (zip (map fst txs) vs))" + unfolding 1 .. + finally show ?thesis unfolding psubst_def by (simp add: Let_def us[symmetric] vs[symmetric]) +qed + +end \ \context @{locale Syntax_with_Connectives}\ + + +locale Syntax_with_Numerals_and_Connectives = + Syntax_with_Numerals + var trm fmla Var FvarsT substT Fvars subst + num + + + Syntax_with_Connectives + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + for + var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" + and Var FvarsT substT Fvars subst + and num + and eql cnj imp all exi +begin + +lemma subst_all_num[simp]: + assumes "\ \ fmla" "x \ var" "y \ var" "n \ num" + shows "x \ y \ subst (all x \) n y = all x (subst \ n y)" + using assms by simp + +lemma subst_exi_num[simp]: + assumes "\ \ fmla" "x \ var" "y \ var" "n \ num" + shows "x \ y \ subst (exi x \) n y = exi x (subst \ n y)" + using assms by simp + + +text \The "soft substitution" function:\ +definition softSubst :: "'fmla \ 'trm \ 'var \ 'fmla" where + "softSubst \ t x = exi x (cnj (eql (Var x) t) \)" + +lemma softSubst[simp,intro]: "\ \ fmla \ t \ trm \ x \ var \ softSubst \ t x \ fmla" + unfolding softSubst_def by auto + +lemma Fvars_softSubst[simp]: + "\ \ fmla \ t \ trm \ x \ var \ + Fvars (softSubst \ t x) = (Fvars \ \ FvarsT t - {x})" + unfolding softSubst_def by auto + +lemma Fvars_softSubst_subst_in: + "\ \ fmla \ t \ trm \ x \ var \ x \ FvarsT t \ x \ Fvars \ \ + Fvars (softSubst \ t x) = Fvars (subst \ t x)" + by auto + +lemma Fvars_softSubst_subst_notIn: + "\ \ fmla \ t \ trm \ x \ var \ x \ FvarsT t \ x \ Fvars \ \ + Fvars (softSubst \ t x) = Fvars (subst \ t x) \ FvarsT t" + by auto + +end \ \context @{locale Syntax_with_Connectives}\ + +text \The addition of False among logical connectives\ + +locale Syntax_with_Connectives_False = + Syntax_with_Connectives + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + for + var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" + and Var FvarsT substT Fvars subst + and eql cnj imp all exi + + + fixes fls::'fmla + assumes + fls[simp,intro!]: "fls \ fmla" + and + Fvars_fls[simp,intro!]: "Fvars fls = {}" + and + subst_fls[simp]: + "\t x. t \ trm \ x \ var \ subst fls t x = fls" +begin + +text \Negation as a derrived connective:\ +definition neg :: "'fmla \ 'fmla" where + "neg \ = imp \ fls" + +lemma + neg[simp]: "\\. \ \ fmla \ neg \ \ fmla" + and + Fvars_neg[simp]: "\\. \ \ fmla \ Fvars (neg \) = Fvars \" + and + subst_neg[simp]: + "\\ t x. \ \ fmla \ t \ trm \ x \ var \ + subst (neg \) t x = neg (subst \ t x)" + unfolding neg_def by auto + +text \True as a derived connective:\ +definition tru where "tru = neg fls" + +lemma + tru[simp,intro!]: "tru \ fmla" + and + Fvars_tru[simp]: "Fvars tru = {}" + and + subst_tru[simp]: "\ t x. t \ trm \ x \ var \ subst tru t x = tru" + unfolding tru_def by auto + + +subsection \Iterated conjunction\ + +text \First we define list-based conjunction:\ +fun lcnj :: "'fmla list \ 'fmla" where + "lcnj [] = tru" +| "lcnj (\ # \s) = cnj \ (lcnj \s)" + +lemma lcnj[simp,intro!]: "set \s \ fmla \ lcnj \s \ fmla" + by (induct \s) auto + +lemma Fvars_lcnj[simp]: + "set \s \ fmla \ finite F \ Fvars (lcnj \s) = \ (set (map Fvars \s))" + by(induct \s) auto + +lemma subst_lcnj[simp]: + "set \s \ fmla \ t \ trm \ x \ var \ + subst (lcnj \s) t x = lcnj (map (\\. subst \ t x) \s)" + by(induct \s) auto + +text \Then we define (finite-)set-based conjunction:\ +definition scnj :: "'fmla set \ 'fmla" where + "scnj F = lcnj (asList F)" + +lemma scnj[simp,intro!]: "F \ fmla \ finite F \ scnj F \ fmla" + unfolding scnj_def by auto + +lemma Fvars_scnj[simp]: + "F \ fmla \ finite F \Fvars (scnj F) = \ (Fvars ` F)" + unfolding scnj_def by auto + +subsection \Parallel substitution versus the new connectives\ + +lemma rawpsubst_fls: + "snd ` (set txs) \ var \ fst ` (set txs) \ trm \ rawpsubst fls txs = fls" + by (induct txs) auto + +lemma psubst_fls[simp]: + assumes "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + shows "psubst fls txs = fls" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [fls] (length txs)" + have us_facts: "set us \ var" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_Fvars[of "map snd txs" "map fst txs" "[fls]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[fls]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[fls]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[fls]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + by auto + have [simp]: "rawpsubst fls (zip (map Var us) (map snd txs)) = fls" + using us_facts assms by (intro rawpsubst_fls) (auto dest!: set_zip_D) + show ?thesis using assms us_facts + unfolding psubst_def by (auto simp add: Let_def us[symmetric] intro!: rawpsubst_fls dest!: set_zip_D) +qed + +lemma psubst_neg[simp]: + assumes "\ \ fmla" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "distinct (map snd txs)" + shows "psubst (neg \) txs = neg (psubst \ txs)" + unfolding neg_def using assms psubst_imp psubst_fls by auto + +lemma psubst_tru[simp]: + assumes "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" + and "distinct (map snd txs)" + shows "psubst tru txs = tru" + unfolding tru_def using assms psubst_neg[of fls txs] psubst_fls by auto + +lemma psubst_lcnj[simp]: + "set \s \ fmla \ snd ` (set txs) \ var \ fst ` (set txs) \ trm \ + distinct (map snd txs) \ + psubst (lcnj \s) txs = lcnj (map (\\. psubst \ txs) \s)" + by (induct \s) auto + +end \ \context @{locale Syntax_with_Connectives_False}\ + + +section \Adding Disjunction\ + +text \NB: In intuitionistic logic, disjunction is not definable from the other connectives.\ + +locale Syntax_with_Connectives_False_Disj = + Syntax_with_Connectives_False + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + for + var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" + and Var FvarsT substT Fvars subst + and eql cnj imp all exi + and fls + + + fixes dsj :: "'fmla \ 'fmla \ 'fmla" + assumes + dsj[simp]: "\\ \. \ \ fmla \ \ \ fmla \ dsj \ \ \ fmla" + and + Fvars_dsj[simp]: "\\ \. \ \ fmla \ \ \ fmla \ + Fvars (dsj \ \) = Fvars \ \ Fvars \" + and + subst_dsj[simp]: + "\ x \ \ t. \ \ fmla \ \ \ fmla \ t \ trm \ x \ var \ + subst (dsj \ \) t x = dsj (subst \ t x) (subst \ t x)" +begin + +subsection \Iterated disjunction\ + +text \First we define list-based disjunction:\ +fun ldsj :: "'fmla list \ 'fmla" where + "ldsj [] = fls" +| "ldsj (\ # \s) = dsj \ (ldsj \s)" + +lemma ldsj[simp,intro!]: "set \s \ fmla \ ldsj \s \ fmla" + by (induct \s) auto + +lemma Fvars_ldsj[simp]: + "set \s \ fmla \ Fvars (ldsj \s) = \ (set (map Fvars \s))" + by(induct \s) auto + +lemma subst_ldsj[simp]: + "set \s \ fmla \ t \ trm \ x \ var \ + subst (ldsj \s) t x = ldsj (map (\\. subst \ t x) \s)" + by(induct \s) auto + +text \Then we define (finite-)set-based disjunction:\ +definition sdsj :: "'fmla set \ 'fmla" where + "sdsj F = ldsj (asList F)" + +lemma sdsj[simp,intro!]: "F \ fmla \ finite F \ sdsj F \ fmla" + unfolding sdsj_def by auto + +lemma Fvars_sdsj[simp]: + "F \ fmla \ finite F \ Fvars (sdsj F) = \ (Fvars ` F)" + unfolding sdsj_def by auto + + +subsection \Parallel substitution versus the new connectives\ + +lemma rawpsubst_dsj: + assumes "\1 \ fmla" "\2 \ fmla" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + shows "rawpsubst (dsj \1 \2) txs = dsj (rawpsubst \1 txs) (rawpsubst \2 txs)" + using assms apply (induct txs arbitrary: \1 \2) + subgoal by auto + subgoal for tx txs \1 \2 apply (cases tx) by auto . + +lemma psubst_dsj[simp]: + assumes "\1 \ fmla" "\2 \ fmla" + and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" + and "distinct (map snd txs)" + shows "psubst (dsj \1 \2) txs = dsj (psubst \1 txs) (psubst \2 txs)" +proof- + define us where us: "us = getFrN (map snd txs) (map fst txs) [dsj \1 \2] (length txs)" + have us_facts: "set us \ var" + "set us \ Fvars \1 = {}" + "set us \ Fvars \2 = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_Fvars[of "map snd txs" "map fst txs" "[dsj \1 \2]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[dsj \1 \2]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[dsj \1 \2]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[dsj \1 \2]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + subgoal by (fastforce simp: image_iff) + by auto + + define vs1 where vs1: "vs1 = getFrN (map snd txs) (map fst txs) [\1] (length txs)" + have vs1_facts: "set vs1 \ var" + "set vs1 \ Fvars \1 = {}" + "set vs1 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs1 \ snd ` (set txs) = {}" + "length vs1 = length txs" + "distinct vs1" + using assms unfolding vs1 + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\1]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\1]" "length txs"] + apply - + subgoal by auto + subgoal by fastforce + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + by auto + + define vs2 where vs2: "vs2 = getFrN (map snd txs) (map fst txs) [\2] (length txs)" + have vs2_facts: "set vs2 \ var" + "set vs2 \ Fvars \2 = {}" + "set vs2 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs2 \ snd ` (set txs) = {}" + "length vs2 = length txs" + "distinct vs2" + using assms unfolding vs2 + using getFrN_Fvars[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[\2]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[\2]" "length txs"] + apply - + apply - + subgoal by auto + subgoal by fastforce + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + by auto + + let ?tus = "zip (map fst txs) us" + let ?uxs = "zip (map Var us) (map snd txs)" + let ?tvs1 = "zip (map fst txs) vs1" + let ?vxs1 = "zip (map Var vs1) (map snd txs)" + let ?tvs2 = "zip (map fst txs) vs2" + let ?vxs2 = "zip (map Var vs2) (map snd txs)" + + let ?c = "rawpsubst (dsj \1 \2) ?uxs" + have c: "?c = dsj (rawpsubst \1 ?uxs) (rawpsubst \2 ?uxs)" + apply(rule rawpsubst_dsj) using assms us_facts apply (auto intro!: rawpsubstT) + apply(drule set_zip_rightD) apply simp apply blast + apply(drule set_zip_leftD) apply simp apply blast . + have 0: "rawpsubst ?c ?tus = + dsj (rawpsubst (rawpsubst \1 ?uxs) ?tus) (rawpsubst (rawpsubst \2 ?uxs) ?tus)" + unfolding c using assms us_facts + by (intro rawpsubst_dsj) (auto intro!: rawpsubst dest!: set_zip_D) + have 1: "rawpsubst (rawpsubst \1 ?uxs) ?tus = rawpsubst (rawpsubst \1 ?vxs1) ?tvs1" + using assms vs1_facts us_facts + by (intro rawpsubst_compose_freshVar2) (auto intro!: rawpsubst) + have 2: "rawpsubst (rawpsubst \2 ?uxs) ?tus = rawpsubst (rawpsubst \2 ?vxs2) ?tvs2" + using assms vs2_facts us_facts + by (intro rawpsubst_compose_freshVar2) (auto intro!: rawpsubst) + show ?thesis unfolding psubst_def by (simp add: Let_def us[symmetric] vs1[symmetric] vs2[symmetric] 0 1 2) +qed + +lemma psubst_ldsj[simp]: + "set \s \ fmla \ snd ` (set txs) \ var \ fst ` (set txs) \ trm \ + distinct (map snd txs) \ + psubst (ldsj \s) txs = ldsj (map (\\. psubst \ txs) \s)" + by (induct \s) auto + +end \ \context @{locale Syntax_with_Connectives_False_Disj}\ + + +section \Adding an Ordering-Like Formula\ + +locale Syntax_with_Numerals_and_Connectives_False_Disj = + Syntax_with_Connectives_False_Disj + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + + + Syntax_with_Numerals_and_Connectives + var trm fmla Var FvarsT substT Fvars subst + num + eql cnj imp all exi + for + var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" + and Var FvarsT substT Fvars subst + and eql cnj imp all exi + and fls + and dsj + and num + +text \... and in addition a formula expressing order (think: less than or equal to)\ +locale Syntax_PseudoOrder = + Syntax_with_Numerals_and_Connectives_False_Disj + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + num + for + var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" + and Var FvarsT substT Fvars subst + and eql cnj imp all exi + and fls + and dsj + and num + + + fixes + \ \Lq is a formula with free variables xx yy:\ + Lq :: 'fmla + assumes + Lq[simp,intro!]: "Lq \ fmla" + and + Fvars_Lq[simp]: "Fvars Lq = {zz,yy}" +begin + +definition LLq where "LLq t1 t2 = psubst Lq [(t1,zz), (t2,yy)]" + +lemma LLq_def2: "t1 \ trm \ t2 \ trm \ yy \ FvarsT t1 \ + LLq t1 t2 = subst (subst Lq t1 zz) t2 yy" + unfolding LLq_def by (rule psubst_eq_rawpsubst2[simplified]) auto + +lemma LLq[simp,intro]: + assumes "t1 \ trm" "t2 \ trm" + shows "LLq t1 t2 \ fmla" + using assms unfolding LLq_def by auto + +lemma LLq2[simp,intro!]: + "n \ num \ LLq n (Var yy') \ fmla" + by auto + +lemma Fvars_LLq[simp]: "t1 \ trm \ t2 \ trm \ yy \ FvarsT t1 \ +Fvars (LLq t1 t2) = FvarsT t1 \ FvarsT t2" + by (auto simp add: LLq_def2 subst2_fresh_switch) + +lemma LLq_simps[simp]: + "m \ num \ n \ num \ subst (LLq m (Var yy)) n yy = LLq m n" + "m \ num \ n \ num \ subst (LLq m (Var yy')) n yy = LLq m (Var yy')" + "m \ num \ subst (LLq m (Var yy')) (Var yy) yy' = LLq m (Var yy)" + "n \ num \ subst (LLq (Var xx) (Var yy)) n xx = LLq n (Var yy)" + "n \ num \ subst (LLq (Var zz) (Var yy)) n yy = LLq (Var zz) n" + "m \ num \ subst (LLq (Var zz) (Var yy)) m zz = LLq m (Var yy)" + "m \ num \ n \ num \ subst (LLq (Var zz) n) m xx = LLq (Var zz) n" + by (auto simp: LLq_def2 subst2_fresh_switch) + +end \ \context @{locale Syntax_PseudoOrder}\ + + +section \Allowing the Renaming of Quantified Variables\ + +text \So far, we did not need any renaming axiom for the quantifiers. However, +our axioms for substitution implicitly assume the irrelevance of the bound names; +in other words, their usual instances would have this property; and since this assumption +greatly simplifies the formal development, we make it at this point.\ + +locale Syntax_with_Connectives_Rename = +Syntax_with_Connectives + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi +for +var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" +and Var FvarsT substT Fvars subst +and eql cnj imp all exi ++ +assumes all_rename: +"\\ x y. \ \ fmla \ x \ var \ y \ var \ y \ Fvars \ \ + all x \ = all y (subst \ (Var y) x)" +and exi_rename: +"\\ x y. \ \ fmla \ x \ var \ y \ var \ y \ Fvars \ \ + exi x \ = exi y (subst \ (Var y) x)" +begin + +lemma all_rename2: +"\ \ fmla \ x \ var \ y \ var \ (y = x \ y \ Fvars \) \ + all x \ = all y (subst \ (Var y) x)" +using all_rename by (cases "y = x") (auto simp del: Fvars_subst) + +lemma exi_rename2: +"\ \ fmla \ x \ var \ y \ var \ (y = x \ y \ Fvars \) \ + exi x \ = exi y (subst \ (Var y) x)" +using exi_rename by (cases "y = x") (auto simp del: Fvars_subst) + + +section \The Exists-Unique Quantifier\ + +text \It is phrased in such a way as to avoid substitution:\ + +definition exu :: "'var \ 'fmla \ 'fmla" where +"exu x \ \ let y = getFr [x] [] [\] in + cnj (exi x \) (exi y (all x (imp \ (eql (Var x) (Var y)))))" + +lemma exu[simp,intro]: +"x \ var \ \ \ fmla \ exu x \ \ fmla" +unfolding exu_def by (simp add: Let_def) + +lemma Fvars_exu[simp]: +"x \ var \ \ \ fmla \ Fvars (exu x \) = Fvars \ - {x}" +unfolding exu_def by (auto simp: Let_def getFr_Fvars) + +lemma exu_def_var: +assumes [simp]: "x \ var" "y \ var" "y \ x" "y \ Fvars \" "\ \ fmla" +shows +"exu x \ = cnj (exi x \) (exi y (all x (imp \ (eql (Var x) (Var y)))))" +proof- + have [simp]: "x \ y" using assms by blast + define z where z: "z \ getFr [x] [] [\]" + have z_facts[simp]: "z \ var" "z \ x" "x \ z" "z \ Fvars \" + unfolding z using getFr_FvarsT_Fvars[of "[x]" "[]" "[\]"] by auto + define u where u: "u \ getFr [x,y,z] [] [\]" + have u_facts[simp]: "u \ var" "u \ x" "u \ z" "y \ u" "u \ y" "x \ u" "z \ u" "u \ Fvars \" + unfolding u using getFr_FvarsT_Fvars[of "[x,y,z]" "[]" "[\]"] by auto + + have "exu x \ = cnj (exi x \) (exi u (all x (imp \ (eql (Var x) (Var u)))))" + by (auto simp: exu_def Let_def z[symmetric] exi_rename[of "all x (imp \ (eql (Var x) (Var z)))" z u]) + also have "\ = cnj (exi x \) (exi y (all x (imp \ (eql (Var x) (Var y)))))" + by (auto simp: exi_rename[of "all x (imp \ (eql (Var x) (Var u)))" u y] + split: if_splits) + finally show ?thesis . +qed + +lemma subst_exu[simp]: +assumes [simp]: "\ \ fmla" "t \ trm" "x \ var" "y \ var" "x \ y" "x \ FvarsT t" +shows "subst (exu x \) t y = exu x (subst \ t y)" +proof- + define u where u: "u \ getFr [x,y] [t] [\]" + have u_facts[simp]: "u \ var" "u \ x" "u \ y" "y \ u" "x \ u" + "u \ FvarsT t" "u \ Fvars \" + unfolding u using getFr_FvarsT_Fvars[of "[x,y]" "[t]" "[\]"] by auto + show ?thesis + by (auto simp: Let_def exu_def_var[of _ u] subst_compose_diff) +qed + +lemma subst_exu_idle[simp]: +assumes [simp]: "x \ var" "\ \ fmla" "t \ trm" +shows "subst (exu x \) t x = exu x \" +by (intro subst_notIn) auto + +lemma exu_rename: +assumes [simp]: "\ \ fmla" "x \ var" "y \ var" "y \ Fvars \" +shows "exu x \ = exu y (subst \ (Var y) x)" +proof(cases "y = x") + case [simp]: False + define z where z: "z = getFr [x] [] [\]" + have z_facts[simp]: "z \ var" "z \ x" "x \ z" "z \ Fvars \" + unfolding z using getFr_FvarsT_Fvars[of "[x]" "[]" "[\]"] by auto + define u where u: "u \ getFr [x,y,z] [] [\]" + have u_facts[simp]: "u \ var" "u \ x" "x \ u" "u \ y" "y \ u" "u \ z" "z \ u" + "u \ Fvars \" + unfolding u using getFr_FvarsT_Fvars[of "[x,y,z]" "[]" "[\]"] by auto + show ?thesis + by (auto simp: exu_def_var[of _ u] exi_rename[of _ _ y] all_rename[of _ _ y]) +qed auto + +lemma exu_rename2: +"\ \ fmla \ x \ var \ y \ var \ (y = x \ y \ Fvars \) \ + exu x \ = exu y (subst \ (Var y) x)" +using exu_rename by (cases "y = x") (auto simp del: Fvars_subst) + +end \ \context @{locale Syntax_with_Connectives_Rename}\ + +(*<*) +end +(*>*) \ No newline at end of file diff --git a/thys/Syntax_Independent_Logic/Syntax_Arith.thy b/thys/Syntax_Independent_Logic/Syntax_Arith.thy new file mode 100644 --- /dev/null +++ b/thys/Syntax_Independent_Logic/Syntax_Arith.thy @@ -0,0 +1,1669 @@ +chapter \Arithmetic Constructs\ + +text \Less genereric syntax, more committed towards embedding arithmetics\ + +(*<*) +theory Syntax_Arith imports Syntax +begin +(*>*) + +text \(An embedding of) the syntax of arithmetic, obtained by adding plus and times\ + +locale Syntax_Arith_aux = +Syntax_with_Connectives_Rename + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi ++ +Syntax_with_Numerals_and_Connectives_False_Disj + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + num +for +var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" +and Var FvarsT substT Fvars subst +and eql cnj imp all exi +and fls +and dsj +and num ++ +fixes +zer :: "'trm" +and +suc :: "'trm \ 'trm" +and +pls :: "'trm \ 'trm \ 'trm" +and +tms :: "'trm \ 'trm \ 'trm" +assumes +Fvars_zero[simp,intro!]: "FvarsT zer = {}" +and +substT_zer[simp]: "\ t x. t \ trm \ x \ var \ + substT zer t x = zer" +and +suc[simp]: "\t. t \ trm \ suc t \ trm" +and +FvarsT_suc[simp]: "\ t. t \ trm \ + FvarsT (suc t) = FvarsT t" +and +substT_suc[simp]: "\ t1 t x. t1 \ trm \ t \ trm \ x \ var \ + substT (suc t1) t x = suc (substT t1 t x)" +and +pls[simp]: "\ t1 t2. t1 \ trm \ t2 \ trm \ pls t1 t2 \ trm" +and +Fvars_pls[simp]: "\ t1 t2. t1 \ trm \ t2 \ trm \ + FvarsT (pls t1 t2) = FvarsT t1 \ FvarsT t2" +and +substT_pls[simp]: "\ t1 t2 t x. t1 \ trm \ t2 \ trm \ t \ trm \ x \ var \ + substT (pls t1 t2) t x = pls (substT t1 t x) (substT t2 t x)" +and +tms[simp]: "\ t1 t2. t1 \ trm \ t2 \ trm \ tms t1 t2 \ trm" +and +Fvars_tms[simp]: "\ t1 t2. t1 \ trm \ t2 \ trm \ + FvarsT (tms t1 t2) = FvarsT t1 \ FvarsT t2" +and +substT_tms[simp]: "\ t1 t2 t x. t1 \ trm \ t2 \ trm \ t \ trm \ x \ var \ + substT (tms t1 t2) t x = tms (substT t1 t x) (substT t2 t x)" +begin + +text \The embedding of numbers into our abstract notion of numerals +(not required to be surjective)\ +fun Num :: "nat \ 'trm" where + "Num 0 = zer" +|"Num (Suc n) = suc (Num n)" + +end \ \context @{locale Syntax_Arith_aux}\ + + +locale Syntax_Arith = +Syntax_Arith_aux + var trm fmla Var FvarsT substT Fvars subst + eql cnj imp all exi + fls + dsj + num + zer suc pls tms +for +var :: "'var set" and trm :: "'trm set" and fmla :: "'fmla set" +and Var FvarsT substT Fvars subst +and eql cnj imp all exi +and fls +and dsj +and num +zer suc pls tms ++ +assumes +\ \We assume that numbers are the only numerals:\ +num_Num: "num = range Num" +begin + +lemma Num[simp,intro!]: "Num n \ num" + using num_Num by auto + +lemma FvarsT_Num[simp]: "FvarsT (Num n) = {}" + by auto + +lemma substT_Num[simp]: "x \ var \ t \ trm \ substT (Num n) t x = Num n" + by auto + +lemma zer[simp,intro!]: "zer \ num" +and suc_num[simp]: "\n. n \ num \ suc n \ num" +by (metis Num Num.simps(1), metis Num Num.simps(2) imageE num_Num) + + +section \Arithmetic Terms\ + +text \Arithmetic terms are inductively defined to contain the numerals and the variables +and be closed under the arithmetic operators:\ + +inductive_set atrm :: "'trm set" where + atrm_num[simp]: "n \ num \ n \ atrm" +|atrm_Var[simp,intro]: "x \ var \ Var x \ atrm" +|atrm_suc[simp,intro]: "t \ atrm \ suc t \ atrm" +|atrm_pls[simp,intro]: "t \ atrm \ t' \ atrm \ pls t t' \ atrm" +|atrm_tms[simp,intro]: "t \ atrm \ t' \ atrm \ tms t t' \ atrm" + +lemma atrm_imp_trm[simp]: assumes "t \ atrm" shows "t \ trm" +using assms by induct auto + +lemma atrm_trm: "atrm \ trm" +using atrm_imp_trm by auto + +lemma zer_atrm[simp]: "zer \ atrm" by auto + +lemma Num_atrm[simp]: "Num n \ atrm" +by auto + +lemma substT_atrm[simp]: +assumes "r \ atrm" and "x \ var" and "t \ atrm" +shows "substT r t x \ atrm" +using assms by (induct) auto + +text \Whereas we did not assume the rich set of formula-substitution properties to hold +for all terms, we can prove that these properties hold for arithmetic terms.\ + +text \Properties for arithmetic terms corresponding to the axioms for formulas:\ + +lemma FvarsT_substT: +assumes "s \ atrm" "t \ trm" "x \ var" +shows "FvarsT (substT s t x) = (FvarsT s - {x}) \ (if x \ FvarsT s then FvarsT t else {})" +using assms by induct auto + +lemma substT_compose_eq_or: +assumes "s \ atrm" "t1 \ trm" "t2 \ trm" "x1 \ var" "x2 \ var" +and "x1 = x2 \ x2 \ FvarsT s" +shows "substT (substT s t1 x1) t2 x2 = substT s (substT t1 t2 x2) x1" +using assms apply induct +subgoal by auto +subgoal by auto +subgoal by (metis FvarsT_suc atrm_imp_trm substT substT_suc) +subgoal by (metis Fvars_pls UnCI atrm_imp_trm substT substT_pls) +subgoal by (metis Fvars_tms UnCI atrm_imp_trm substT substT_tms) . + +lemma substT_compose_diff: +assumes "s \ atrm" "t1 \ trm" "t2 \ trm" "x1 \ var" "x2 \ var" +and "x1 \ x2" "x1 \ FvarsT t2" +shows "substT (substT s t1 x1) t2 x2 = substT (substT s t2 x2) (substT t1 t2 x2) x1" +using assms apply induct +subgoal by auto +subgoal by auto +subgoal by (metis atrm_imp_trm substT substT_suc) +subgoal by (metis atrm_imp_trm substT substT_pls) +subgoal by (metis atrm_imp_trm substT substT_tms) . + +lemma substT_same_Var[simp]: +assumes "s \ atrm" "x \ var" +shows "substT s (Var x) x = s" +using assms by induct auto + +text \... and corresponding to some corollaries we proved for formulas +(with essentially the same proofs):\ + +lemma in_FvarsT_substTD: +"y \ FvarsT (substT r t x) \ r \ atrm \ t \ trm \ x \ var + \ y \ (FvarsT r - {x}) \ (if x \ FvarsT r then FvarsT t else {})" +using FvarsT_substT by auto + +lemma substT_compose_same: +"\ s t1 t2 x. s \ atrm \ t1 \ trm \ t2 \ trm \ x \ var \ + substT (substT s t1 x) t2 x = substT s (substT t1 t2 x) x" + using substT_compose_eq_or by blast + +lemma substT_substT[simp]: +assumes s[simp]: "s \ atrm" and t[simp]:"t \ trm" and x[simp]:"x \ var" and y[simp]:"y \ var" +assumes yy: "x \ y" "y \ FvarsT s" +shows "substT (substT s (Var y) x) t y = substT s t x" + using substT_compose_eq_or[OF s _ t x y, of "Var y"] using subst_notIn yy by simp + +lemma substT_comp: +"\ x y s t. s \ atrm \ t \ trm \ x \ var \ y \ var \ + x \ y \ y \ FvarsT t \ + substT (substT s (Var x) y) t x = substT (substT s t x) t y" + by (simp add: substT_compose_diff) + +text \Now the corresponding development of parallel substitution for arithmetic terms:\ + +lemma rawpsubstT_atrm[simp,intro]: +assumes "r \ atrm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +shows "rawpsubstT r txs \ atrm" +using assms by (induct txs arbitrary: r) auto + +lemma psubstT_atrm[simp,intro]: +assumes "r \ atrm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +shows "psubstT r txs \ atrm" +proof- + have txs_trm: "fst ` (set txs) \ trm" using assms atrm_trm by auto + define us where us: "us \ getFrN (map snd txs) (r # map fst txs) [] (length txs)" + have us_facts: "set us \ var" + "set us \ FvarsT r = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms(1,2) txs_trm unfolding us + using getFrN_FvarsT[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "r # map fst txs" "[]" "length txs"] + getFrN_distinct[of "map snd txs" "r # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by force + by auto + (* *) + show ?thesis using assms us_facts unfolding psubstT_def + by (force simp: Let_def us[symmetric] + intro!: rawpsubstT_atrm[of _ "zip (map fst txs) us"] dest!: set_zip_D) +qed + +lemma Fvars_rawpsubst_su: +assumes "r \ atrm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +shows "FvarsT (rawpsubstT r txs) \ + (FvarsT r - snd ` (set txs)) \ (\ {FvarsT t | t x . (t,x) \ set txs})" +using assms proof(induction txs arbitrary: r) + case (Cons tx txs r) + then obtain t x where tx: "tx = (t,x)" by force + have t: "t \ trm" and x: "x \ var" using Cons.prems unfolding tx by auto + define \ where "\ \ substT r t x" + have 0: "FvarsT \ = FvarsT r - {x} \ (if x \ FvarsT r then FvarsT t else {})" + using Cons.prems unfolding \_def by (auto simp: tx t FvarsT_substT) + have \: "\ \ trm" "\ \ atrm" unfolding \_def using Cons.prems t x by (auto simp add: tx) + have "FvarsT (rawpsubstT \ txs) \ + (FvarsT \ - snd ` (set txs)) \ + (\ {FvarsT t | t x . (t,x) \ set txs})" + using Cons.prems \ by (intro Cons.IH) auto + also have "\ \ FvarsT r - insert x (snd ` set txs) \ \{FvarsT ta |ta. \xa. ta = t \ xa = x \ (ta, xa) \ set txs}" + (is "_ \ ?R") by(auto simp: 0 tx Cons.prems) + finally have 1: "FvarsT (rawpsubstT \ txs) \ ?R" . + have 2: "FvarsT \ = FvarsT r - {x} \ (if x \ FvarsT r then FvarsT t else {})" + using Cons.prems t x unfolding \_def using FvarsT_substT by auto + show ?case using 1 by (simp add: tx \_def[symmetric] 2) +qed auto + +lemma in_FvarsT_rawpsubstT_imp: + assumes "y \ FvarsT (rawpsubstT r txs)" +and "r \ atrm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +shows "(y \ FvarsT r - snd ` (set txs)) \ + (y \ \ { FvarsT t | t x . (t,x) \ set txs})" +using Fvars_rawpsubst_su[OF assms(2-4)] +using assms(1) by blast + +lemma FvarsT_rawpsubstT: +assumes "r \ atrm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +and "distinct (map snd txs)" and "\ x \ snd ` (set txs). \ t \ fst ` (set txs). x \ FvarsT t" +shows "FvarsT (rawpsubstT r txs) = + (FvarsT r - snd ` (set txs)) \ + (\ {if x \ FvarsT r then FvarsT t else {} | t x . (t,x) \ set txs})" +using assms proof(induction txs arbitrary: r) + case (Cons a txs r) + then obtain t x where a: "a = (t,x)" by force + have t: "t \ trm" and x: "x \ var" using Cons.prems unfolding a by auto + have xt: "x \ FvarsT t \ snd ` set txs \ FvarsT t = {}" using Cons.prems unfolding a by auto + hence 0: "FvarsT r - {x} \ FvarsT t - snd ` set txs = FvarsT r - insert x (snd ` set txs) \ FvarsT t" + by auto + have x_txs: "\ta xa. (ta, xa) \ set txs \ x \ xa" using `distinct (map snd (a # txs))` + unfolding a by (auto simp: rev_image_eqI) + + define \ where \_def: "\ \ substT r t x" + have \: "\ \ trm" "\ \ atrm" unfolding \_def using Cons.prems t x by (auto simp: a) + have 1: "FvarsT (rawpsubstT \ txs) = + (FvarsT \ - snd ` (set txs)) \ + (\ {if x \ FvarsT \ then FvarsT t else {} | t x . (t,x) \ set txs})" + using Cons.prems \ by (intro Cons.IH) auto + have 2: "FvarsT \ = FvarsT r - {x} \ (if x \ FvarsT r then FvarsT t else {})" + using Cons.prems t x unfolding \_def using FvarsT_substT by auto + + define f where "f \ \ta xa. if xa \ FvarsT r then FvarsT ta else {}" + + have 3: "\ {f ta xa |ta xa. (ta, xa) \ set ((t, x) # txs)} = + f t x \ (\ {f ta xa |ta xa. (ta, xa) \ set txs})" by auto + have 4: "snd ` set ((t, x) # txs) = {x} \ snd ` set txs" by auto + have 5: "f t x \ snd ` set txs = {}" unfolding f_def using xt by auto + have 6: "\ {if xa \ FvarsT r - {x} \ f t x then FvarsT ta else {} | ta xa. (ta, xa) \ set txs} + = (\ {f ta xa | ta xa. (ta, xa) \ set txs})" + unfolding f_def using xt x_txs by (fastforce split: if_splits) + + have "FvarsT r - {x} \ f t x - snd ` set txs \ + \ {if xa \ FvarsT r - {x} \ f t x then FvarsT ta else {} + | ta xa. (ta, xa) \ set txs} = + FvarsT r - snd ` set ((t, x) # txs) \ + \ {f ta xa |ta xa. (ta, xa) \ set ((t, x) # txs)}" + unfolding 3 4 6 unfolding Un_Diff2[OF 5] Un_assoc unfolding Diff_Diff_Un .. + + thus ?case unfolding a rawpsubstT.simps 1 2 \_def[symmetric] f_def by simp +qed auto + +lemma in_FvarsT_rawpsubstTD: +assumes "y \ FvarsT (rawpsubstT r txs)" +and "r \ atrm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +and "distinct (map snd txs)" and "\ x \ snd ` (set txs). \ t \ fst ` (set txs). x \ FvarsT t" +shows "(y \ FvarsT r - snd ` (set txs)) \ + (y \ \ {if x \ FvarsT r then FvarsT t else {} | t x . (t,x) \ set txs})" + using FvarsT_rawpsubstT assms by auto + +lemma FvarsT_psubstT: +assumes "r \ atrm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +and "distinct (map snd txs)" +shows "FvarsT (psubstT r txs) = + (FvarsT r - snd ` (set txs)) \ + (\ {if x \ FvarsT r then FvarsT t else {} | t x . (t,x) \ set txs})" +proof- + have txs_trm: "fst ` (set txs) \ trm" using assms by auto + define us where us: "us \ getFrN (map snd txs) (r # map fst txs) [] (length txs)" + have us_facts: "set us \ var" + "set us \ FvarsT r = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms(1,2) txs_trm unfolding us + using getFrN_FvarsT[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "r # map fst txs" "[]" "length txs"] + getFrN_length[of "map snd txs" "r # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by force + by auto + have [simp]: "\ aa b. b \ set (map snd txs) \ + aa \ set (map Var us) \ b \ FvarsT aa" + using us_facts by (fastforce simp: image_def Int_def) + have [simp]: + "\b ac bc. b \ set us \ b \ FvarsT ac \ (ac, bc) \ set txs" + using us_facts(3) by (fastforce simp: image_def Int_def) + + define \ where \_def: "\ \ rawpsubstT r (zip (map Var us) (map snd txs))" + have \: "\ \ atrm" unfolding \_def + using assms using us_facts by (intro rawpsubstT_atrm) (force dest!: set_zip_D)+ + + hence "\ \ trm" by auto + note \ = \ this + have set_us: "set us = snd ` (set (zip (map fst txs) us))" + using us_facts by (intro snd_set_zip[symmetric]) auto + have set_txs: "snd ` set txs = snd ` (set (zip (map Var us) (map snd txs)))" + using us_facts by (intro snd_set_zip_map_snd[symmetric]) auto + have "\ t x. (t, x) \ set (zip (map Var us) (map snd txs)) \ \ u. t = Var u" + using us_facts set_zip_leftD by fastforce + hence 00: "\ t x. (t, x) \ set (zip (map Var us) (map snd txs)) + \ (\ u \ var. t = Var u \ (Var u, x) \ set (zip (map Var us) (map snd txs)))" + using us_facts set_zip_leftD by fastforce + have "FvarsT \ = + FvarsT r - snd ` set txs \ + \{if x \ FvarsT r then FvarsT t else {} |t x. + (t, x) \ set (zip (map Var us) (map snd txs))}" + unfolding \_def set_txs using assms us_facts set_txs + by (intro FvarsT_rawpsubstT) (force dest!: set_zip_D)+ + also have "\ = + FvarsT r - snd ` set txs \ + \{if x \ FvarsT r then {u} else {} |u x. u \ var \ (Var u, x) \ set (zip (map Var us) (map snd txs))}" + (is "\ = ?R") + apply(subst 00) + by (metis (no_types, hide_lams) FvarsT_Var) + finally have 0: "FvarsT \ = ?R" . + have 1: "FvarsT (rawpsubstT \ (zip (map fst txs) us)) = + (FvarsT \ - set us) \ + (\ {if u \ FvarsT \ then FvarsT t else {} | t u . (t,u) \ set (zip (map fst txs) us)})" + unfolding us_facts set_us using assms \ apply (intro FvarsT_rawpsubstT) + subgoal by auto + subgoal using us_facts by (auto dest!: set_zip_D) + subgoal using us_facts by (auto dest!: set_zip_D) + subgoal using us_facts by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) . + + have 2: "FvarsT \ - set us = FvarsT r - snd ` set txs" + unfolding 0 apply auto + using set_zip_leftD us_facts(1) apply fastforce + using set_zip_leftD us_facts(1) apply fastforce + using us_facts(2) by auto + have 3: + "(\ {if u \ FvarsT \ then FvarsT t else {} | t u . (t,u) \ set (zip (map fst txs) us)}) = + (\ {if x \ FvarsT r then FvarsT t else {} | t x . (t,x) \ set txs})" + proof safe + fix xx tt y + assume xx: "xx \ (if y \ FvarsT \ then FvarsT tt else {})" + and ty: "(tt, y) \ set (zip (map fst txs) us)" + have ttin: "tt \ fst ` set txs" using ty using set_zip_leftD by fastforce + have yin: "y \ set us" using ty by (meson set_zip_D) + have yvar: "y \ var" using us_facts yin by auto + have ynotin: "y \ snd ` set txs" "y \ FvarsT r" using yin us_facts by auto + show "xx \ \{if x \ FvarsT r then FvarsT t else {} |t x. (t, x) \ set txs}" + proof(cases "y \ FvarsT \") + case True note y = True + hence xx: "xx \ FvarsT tt" using xx by simp + obtain x where xr: "x \ FvarsT r" + and yx: "(Var y, x) \ set (zip (map Var us) (map snd txs))" + using y ynotin unfolding 0 by (auto split: if_splits) + have yx: "(y, x) \ set (zip us (map snd txs))" + using yvar us_facts by (intro inj_on_set_zip_map[OF inj_on_Var yx]) auto + have "(tt, x) \ set txs" apply(rule set_zip_map_fst_snd[OF yx ty]) + using `distinct (map snd txs)` us_facts by auto + thus ?thesis using xx xr by auto + qed(insert xx, auto) + next + fix y tt xx + assume y: "y \ (if xx \ FvarsT r then FvarsT tt else {})" + and tx: "(tt, xx) \ set txs" + hence xxsnd: "xx \ snd ` set txs" by force + obtain u where uin: "u \ set us" and uxx: "(u, xx) \ set (zip us (map snd txs))" + by (metis xxsnd in_set_impl_in_set_zip2 length_map set_map set_zip_leftD us_facts(5)) + hence uvar: "u \ var" using us_facts by auto + show "y \ \{if u \ FvarsT \ then FvarsT t else {} |t u. (t, u) \ set (zip (map fst txs) us)}" + proof(cases "xx \ FvarsT r") + case True note xx = True + hence y: "y \ FvarsT tt" using y by auto + have "(Var u, xx) \ set (zip (map Var us) (map snd txs))" + apply(rule set_zip_length_map[OF uxx]) using us_facts by auto + hence u\: "u \ FvarsT \" using uin xx uvar unfolding 0 by auto + have ttu: "(tt, u) \ set (zip (map fst txs) us)" + apply(rule set_zip_map_fst_snd2[OF uxx tx]) using assms us_facts by auto + show ?thesis using u\ ttu y by auto + qed(insert y, auto) + qed + show ?thesis + by (simp add: psubstT_def Let_def us[symmetric] \_def[symmetric] 1 2 3) +qed + + +lemma in_FvarsT_psubstTD: +assumes "y \ FvarsT (psubstT r txs)" +and "r \ atrm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +and "distinct (map snd txs)" +shows "y \ (FvarsT r - snd ` (set txs)) \ + (\ {if x \ FvarsT r then FvarsT t else {} | t x . (t,x) \ set txs})" +using assms FvarsT_psubstT by auto + +lemma substT2_fresh_switch: + assumes "r \ atrm" "t \ trm" "s \ trm" "x \ var" "y \ var" +and "x \ y" "x \ FvarsT s" "y \ FvarsT t" +shows "substT (substT r s y) t x = substT (substT r t x) s y" (is "?L = ?R") + using assms by (simp add: substT_compose_diff[of r s t y x]) + +lemma rawpsubst2_fresh_switch: + assumes "r \ atrm" "t \ trm" "s \ trm" "x \ var" "y \ var" +and "x \ y" "x \ FvarsT s" "y \ FvarsT t" +shows "rawpsubstT r ([(s,y),(t,x)]) = rawpsubstT r ([(t,x),(s,y)])" + using assms by (simp add: substT2_fresh_switch) + +(* this actually works for any trms, does not need atrms: *) +lemma rawpsubstT_compose: + assumes "t \ trm" and "snd ` (set txs1) \ var" and "fst ` (set txs1) \ atrm" +and "snd ` (set txs2) \ var" and "fst ` (set txs2) \ atrm" +shows "rawpsubstT (rawpsubstT t txs1) txs2 = rawpsubstT t (txs1 @ txs2)" + using assms apply (induct txs1 arbitrary: txs2 t) + subgoal by simp + subgoal for tx1 txs1 txs2 t apply (cases tx1) by auto . + +lemma rawpsubstT_subst_fresh_switch: +assumes "r \ atrm" "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +and "\ x \ snd ` (set txs). x \ FvarsT s" +and "\ t \ fst ` (set txs). y \ FvarsT t" +and "distinct (map snd txs)" +and "s \ atrm" and "y \ var" "y \ snd ` (set txs)" +shows "rawpsubstT (substT r s y) txs = rawpsubstT r (txs @ [(s,y)])" +using assms proof(induction txs arbitrary: r s y) + case (Cons tx txs) + obtain t x where tx[simp]: "tx = (t,x)" by force + have x: "x \ var" and t: "t \ trm" using Cons unfolding tx by auto + have "rawpsubstT r ((s, y) # (t, x) # txs) = rawpsubstT r ([(s, y),(t, x)] @ txs)" by simp + also have "\ = rawpsubstT (rawpsubstT r [(s, y),(t, x)]) txs" + using Cons by auto + also have "rawpsubstT r [(s, y),(t, x)] = rawpsubstT r [(t, x),(s, y)]" + using Cons by (intro rawpsubst2_fresh_switch) auto + also have "rawpsubstT (rawpsubstT r [(t, x),(s, y)]) txs = rawpsubstT r ([(t, x),(s, y)] @ txs)" + using Cons by (intro rawpsubstT_compose) auto + also have "\ = rawpsubstT (substT r t x) (txs @ [(s,y)])" using Cons by auto + also have "\ = rawpsubstT r (((t, x) # txs) @ [(s, y)])" by simp + finally show ?case unfolding tx by auto +qed auto + +lemma substT_rawpsubstT_fresh_switch: +assumes "r \ atrm" "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +and "\ x \ snd ` (set txs). x \ FvarsT s" +and "\ t \ fst ` (set txs). y \ FvarsT t" +and "distinct (map snd txs)" +and "s \ atrm" and "y \ var" "y \ snd ` (set txs)" +shows "substT (rawpsubstT r txs) s y = rawpsubstT r ((s,y) # txs)" +using assms proof(induction txs arbitrary: r s y) + case (Cons tx txs) + obtain t x where tx[simp]: "tx = (t,x)" by force + have x: "x \ var" and t: "t \ trm" using Cons unfolding tx by auto + have "substT (rawpsubstT (substT r t x) txs) s y = rawpsubstT (substT r t x) ((s,y) # txs)" + using Cons.prems by (intro Cons.IH) auto + also have "\ = rawpsubstT (rawpsubstT r [(t,x)]) ((s,y) # txs)" by simp + also have "\ = rawpsubstT r ([(t,x)] @ ((s,y) # txs))" + using Cons.prems by (intro rawpsubstT_compose) auto + also have "\ = rawpsubstT r ([(t,x),(s,y)] @ txs)" by simp + also have "\ = rawpsubstT (rawpsubstT r [(t,x),(s,y)]) txs" + using Cons.prems by (intro rawpsubstT_compose[symmetric]) auto + also have "rawpsubstT r [(t,x),(s,y)] = rawpsubstT r [(s,y),(t,x)]" + using Cons.prems by (intro rawpsubst2_fresh_switch) auto + also have "rawpsubstT (rawpsubstT r [(s,y),(t,x)]) txs = rawpsubstT r ([(s,y),(t,x)] @ txs)" + using Cons.prems by (intro rawpsubstT_compose) auto + finally show ?case by simp +qed auto + +lemma rawpsubstT_compose_freshVar: +assumes "r \ atrm" "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +and "distinct (map snd txs)" +and "\ i j. i < j \ j < length txs \ snd (txs!j) \ FvarsT (fst (txs!i))" +and us_facts: "set us \ var" + "set us \ FvarsT r = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" +shows "rawpsubstT (rawpsubstT r (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = rawpsubstT r txs" +using assms proof(induction txs arbitrary: us r) + case (Cons tx txs uus r) + obtain t x where tx[simp]: "tx = (t,x)" by force + obtain u us where uus[simp]: "uus = u # us" using Cons by (cases uus) auto + have us_facts: "set us \ var" + "set us \ FvarsT r = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" and u_facts: "u \ var" "u \ FvarsT r" + "u \ \ (FvarsT ` (fst ` (set txs)))" + "u \ snd ` (set txs)" "u \ set us" + using Cons by auto + have [simp]: "\ bb xaa ab. bb \ FvarsT (Var xaa) \ + (ab, bb) \ set txs \ xaa \ set us" + using us_facts(1,4) by force + + let ?uxs = "zip (map Var us) (map snd txs)" + have 1: "rawpsubstT (substT r (Var u) x) ?uxs = rawpsubstT r (?uxs @ [(Var u,x)])" + using Cons.prems u_facts apply(intro rawpsubstT_subst_fresh_switch) + subgoal by auto + subgoal by (auto dest!: set_zip_D) + subgoal by (fastforce dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal by (fastforce dest!: set_zip_D) + by (auto dest!: set_zip_D) + + let ?uuxs = "zip (map Var uus) (map snd (tx # txs))" + let ?tus = "zip (map fst txs) us" let ?ttxs = "zip (map fst (tx # txs)) uus" + have 2: "u \ FvarsT (rawpsubstT r (zip (map Var us) (map snd txs))) \ False" + apply(drule in_FvarsT_rawpsubstTD) apply- + subgoal using Cons.prems by auto + subgoal using Cons.prems by (auto dest!: set_zip_D) + subgoal using Cons.prems by (force dest!: set_zip_D) + subgoal using Cons.prems by (auto dest!: set_zip_D) + subgoal by (auto dest!: set_zip_D) + subgoal using us_facts(1,4,5) Cons.prems(7) + by(fastforce dest!: set_zip_D split: if_splits simp: u_facts(5)) . + + have 3: "(tt, xx) \ set txs" if "xx \ FvarsT t" for tt xx + unfolding set_conv_nth mem_Collect_eq + proof safe + fix i + assume "(tt, xx) = txs ! i" "i < length txs" + then show False + using that Cons.prems(4) Cons.prems(5)[of 0 "Suc i"] tx + by (auto simp: nth_Cons' split: if_splits dest: sym) + qed + + have 00: "rawpsubstT (rawpsubstT r ?uuxs) ?ttxs = rawpsubstT (substT (rawpsubstT r (?uxs @ [(Var u, x)])) t u) ?tus" + by (simp add: 1) + + have "rawpsubstT r (?uxs @ [(Var u, x)]) = rawpsubstT (rawpsubstT r ?uxs) [(Var u, x)]" + using Cons.prems + by (intro rawpsubstT_compose[symmetric]) (auto 0 3 dest!: set_zip_D) + also have "rawpsubstT (rawpsubstT r ?uxs) [(Var u, x)] = substT (rawpsubstT r ?uxs) (Var u) x" by simp + finally have "substT (rawpsubstT r (?uxs @ [(Var u, x)])) t u = + substT (substT (rawpsubstT r ?uxs) (Var u) x) t u" by simp + also have "\ = substT (rawpsubstT r ?uxs) t x" + using Cons 2 by (intro substT_substT) (auto 0 3 intro!: rawpsubstT_atrm[of r] dest!: set_zip_D) + also have "\ = rawpsubstT r ((t,x) # ?uxs)" + using Cons.prems 3 + by (intro substT_rawpsubstT_fresh_switch) (auto 0 3 dest!: set_zip_D FvarsT_VarD) + also have "\ = rawpsubstT r ([(t,x)] @ ?uxs)" by simp + also have "\ = rawpsubstT (rawpsubstT r [(t,x)]) ?uxs" + using Cons.prems by (intro rawpsubstT_compose[symmetric]) (auto 0 3 dest!: set_zip_D) + finally have "rawpsubstT (substT (rawpsubstT r (?uxs @ [(Var u, x)])) t u) ?tus = + rawpsubstT (rawpsubstT (rawpsubstT r [(t,x)]) ?uxs) ?tus" by auto + hence "rawpsubstT (rawpsubstT r ?uuxs) ?ttxs = rawpsubstT (rawpsubstT (rawpsubstT r [(t,x)]) ?uxs) ?tus" + using 00 by auto + also have "\ = rawpsubstT (rawpsubstT r [(t,x)]) txs" + using Cons.prems apply(intro Cons.IH) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by (metis Suc_leI le_imp_less_Suc length_Cons nth_Cons_Suc) + subgoal by auto + subgoal by (auto intro!: rawpsubstT dest!: set_zip_D in_FvarsT_substTD + split: if_splits) + by auto + finally show ?case by simp +qed auto + +lemma rawpsubstT_compose_freshVar2_aux: +assumes r[simp]: "r \ atrm" +and ts: "set ts \ atrm" +and xs: "set xs \ var" "distinct xs" +and us_facts: "set us \ var" "distinct us" + "set us \ FvarsT r = {}" + "set us \ \ (FvarsT ` (set ts)) = {}" + "set us \ set xs = {}" +and vs_facts: "set vs \ var" "distinct vs" + "set vs \ FvarsT r = {}" + "set vs \ \ (FvarsT ` (set ts)) = {}" + "set vs \ set xs = {}" +and l: "length us = length xs" "length vs = length xs" "length ts = length xs" +and (* Extra hypothesis, only to get induction through: *) d: "set us \ set vs = {}" +shows "rawpsubstT (rawpsubstT r (zip (map Var us) xs)) (zip ts us) = + rawpsubstT (rawpsubstT r (zip (map Var vs) xs)) (zip ts vs)" +using assms proof(induction xs arbitrary: r ts us vs) + case (Cons x xs r tts uus vvs) + obtain t ts u us v vs where tts[simp]: "tts = t # ts" and lts[simp]: "length ts = length xs" + and uus[simp]: "uus = u # us" and lus[simp]: "length us = length xs" + and vvs[simp]: "vvs = v # vs" and lvs[simp]: "length vs = length xs" + using `length uus = length (x # xs)` `length vvs = length (x # xs)` `length tts = length (x # xs)` + apply(cases tts) + subgoal by auto + subgoal apply(cases uus) + subgoal by auto + subgoal by (cases vvs) auto . . + + let ?rux = "substT r (Var u) x" let ?rvx = "substT r (Var v) x" + + have 0: "rawpsubstT (rawpsubstT ?rux (zip (map Var us) xs)) (zip ts us) = + rawpsubstT (rawpsubstT ?rux (zip (map Var vs) xs)) (zip ts vs)" + using Cons.prems by (intro Cons.IH) (auto intro!: rawpsubstT dest!: set_zip_D simp: FvarsT_substT) + + have 1: "rawpsubstT ?rux (zip (map Var vs) xs) = + substT (rawpsubstT r (zip (map Var vs) xs)) (Var u) x" + using Cons.prems + by (intro substT_rawpsubstT_fresh_switch[simplified,symmetric]) + (auto intro!: rawpsubstT dest!: set_zip_D simp: subset_eq) + + have 11: "rawpsubstT ?rvx (zip (map Var vs) xs) = + substT (rawpsubstT r (zip (map Var vs) xs)) (Var v) x" + using Cons.prems + by (intro substT_rawpsubstT_fresh_switch[simplified,symmetric]) + (auto intro!: rawpsubstT dest!: set_zip_D simp: subset_eq) + + have "substT (substT (rawpsubstT r (zip (map Var vs) xs)) (Var u) x) t u = + substT (rawpsubstT r (zip (map Var vs) xs)) t x" + using Cons.prems + by (intro substT_substT) + (auto 0 3 intro!: rawpsubstT_atrm[of r] + dest!: set_zip_D in_FvarsT_rawpsubstT_imp FvarsT_VarD simp: FvarsT_rawpsubstT) + also have "\ = substT (substT (rawpsubstT r (zip (map Var vs) xs)) (Var v) x) t v" + using Cons.prems + by (intro substT_substT[symmetric]) + (auto 0 3 intro!: rawpsubstT_atrm[of r] dest!: set_zip_D in_FvarsT_rawpsubstT_imp FvarsT_VarD + simp: FvarsT_rawpsubstT) + finally have + 2: "substT (substT (rawpsubstT r (zip (map Var vs) xs)) (Var u) x) t u = + substT (substT (rawpsubstT r (zip (map Var vs) xs)) (Var v) x) t v" . + + have "rawpsubstT (substT (rawpsubstT ?rux (zip (map Var us) xs)) t u) (zip ts us) = + substT (rawpsubstT (rawpsubstT ?rux (zip (map Var us) xs)) (zip ts us)) t u" + using Cons.prems + by (intro substT_rawpsubstT_fresh_switch[simplified,symmetric]) + (auto 0 3 intro!: rawpsubstT_atrm[of ?rux] substT_atrm dest!: set_zip_D) + also have "\ = substT (rawpsubstT (rawpsubstT ?rux (zip (map Var vs) xs)) (zip ts vs)) t u" + unfolding 0 .. + also have "\ = rawpsubstT (substT (rawpsubstT ?rux (zip (map Var vs) xs)) t u) (zip ts vs)" + using Cons.prems + by (intro substT_rawpsubstT_fresh_switch[simplified]) + (auto 0 3 intro!: rawpsubstT_atrm[of ?rux] dest!: set_zip_D) + also have "\ = rawpsubstT (substT (substT (rawpsubstT r (zip (map Var vs) xs)) (Var u) x) t u) (zip ts vs)" + unfolding 1 .. + also have "\ = rawpsubstT (substT (substT (rawpsubstT r (zip (map Var vs) xs)) (Var v) x) t v) (zip ts vs)" + unfolding 2 .. + also have "\ = rawpsubstT (substT (rawpsubstT ?rvx (zip (map Var vs) xs)) t v) (zip ts vs)" + unfolding 11 .. + finally have "rawpsubstT (substT (rawpsubstT ?rux (zip (map Var us) xs)) t u) (zip ts us) = + rawpsubstT (substT (rawpsubstT ?rvx (zip (map Var vs) xs)) t v) (zip ts vs)" . + thus ?case by simp +qed auto + +(* ... now getting rid of the disjointness hypothesis: *) +lemma rawpsubstT_compose_freshVar2: +assumes r[simp]: "r \ atrm" +and ts: "set ts \ atrm" +and xs: "set xs \ var" "distinct xs" +and us_facts: "set us \ var" "distinct us" + "set us \ FvarsT r = {}" + "set us \ \ (FvarsT ` (set ts)) = {}" + "set us \ set xs = {}" +and vs_facts: "set vs \ var" "distinct vs" + "set vs \ FvarsT r = {}" + "set vs \ \ (FvarsT ` (set ts)) = {}" + "set vs \ set xs = {}" +and l: "length us = length xs" "length vs = length xs" "length ts = length xs" +shows "rawpsubstT (rawpsubstT r (zip (map Var us) xs)) (zip ts us) = + rawpsubstT (rawpsubstT r (zip (map Var vs) xs)) (zip ts vs)" (is "?L = ?R") +proof- + have ts_trm: "set ts \ trm" using ts by auto + define ws where "ws = getFrN (xs @ us @ vs) (r # ts) [] (length xs)" + have ws_facts: "set ws \ var" "distinct ws" + "set ws \ FvarsT r = {}" + "set ws \ \ (FvarsT ` (set ts)) = {}" + "set ws \ set xs = {}" "set ws \ set us = {}" "set ws \ set vs = {}" + "length ws = length xs" using assms(1) ts_trm assms(3-17) unfolding ws_def + using getFrN_Fvars[of "xs @ us @ vs" "r # ts" "[]" _ "length xs"] + getFrN_FvarsT[of "xs @ us @ vs" "r # ts" "[]" _ "length xs"] + getFrN_var[of "xs @ us @ vs" "r # ts" "[]" _ "length xs"] + getFrN_length[of "xs @ us @ vs" "r # ts" "[]" "length xs"] + apply - + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by force + subgoal by force + subgoal by force + subgoal by force + by auto + have "?L = rawpsubstT (rawpsubstT r (zip (map Var ws) xs)) (zip ts ws)" + using assms ws_facts by (intro rawpsubstT_compose_freshVar2_aux) auto + also have "\ = ?R" + using assms ws_facts by (intro rawpsubstT_compose_freshVar2_aux) auto + finally show ?thesis . +qed + +lemma in_fst_image: "a \ fst ` AB \ (\b. (a,b) \ AB)" by force + +(* For many cases, the simpler rawpsubstT can replace psubst: *) +lemma psubstT_eq_rawpsubstT: +assumes "r \ atrm" "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +and "distinct (map snd txs)" +(* ... namely, when the substituted variables do not belong to trms substituted for previous variables: *) +and "\ i j. i < j \ j < length txs \ snd (txs!j) \ FvarsT (fst (txs!i))" +shows "psubstT r txs = rawpsubstT r txs" +proof- + have txs_trm: "r \ trm" "fst ` (set txs) \ trm" using assms by auto + + note frt = getFrN_FvarsT[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + and fr = getFrN_Fvars[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + and var = getFrN_var[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + and l = getFrN_length[of "map snd txs" "r # map fst txs" "[]" "length txs"] + define us where us: "us \ getFrN (map snd txs) (r # map fst txs) [] (length txs)" + have us_facts: "set us \ var" + "set us \ FvarsT r = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms(2,4,5) txs_trm unfolding us + + apply - + subgoal by auto + subgoal using frt by auto + subgoal using frt by (simp add: in_fst_image Int_def) (metis prod.collapse) + subgoal using var by (simp add: in_fst_image Int_def) (metis) + subgoal using l by auto + subgoal by auto . + + show ?thesis + using rawpsubstT_compose_freshVar assms us_facts + by (simp add: psubstT_def Let_def us[symmetric]) +qed + +(* Some particular cases: *) +lemma psubstT_eq_substT: +assumes "r \ atrm" "x \ var" and "t \ atrm" +shows "psubstT r [(t,x)] = substT r t x" +proof- + have "psubstT r [(t,x)] = rawpsubstT r [(t,x)]" + using assms by (intro psubstT_eq_rawpsubstT) auto + thus ?thesis by auto +qed + +lemma psubstT_eq_rawpsubst2: +assumes "r \ atrm" "x1 \ var" "x2 \ var" "t1 \ atrm" "t2 \ atrm" +and "x1 \ x2" "x2 \ FvarsT t1" +shows "psubstT r [(t1,x1),(t2,x2)] = rawpsubstT r [(t1,x1),(t2,x2)]" + using assms using less_SucE by (intro psubstT_eq_rawpsubstT) force+ + +lemma psubstT_eq_rawpsubst3: +assumes "r \ atrm" "x1 \ var" "x2 \ var" "x3 \ var" "t1 \ atrm" "t2 \ atrm" "t3 \ atrm" +and "x1 \ x2" "x1 \ x3" "x2 \ x3" +"x2 \ FvarsT t1" "x3 \ FvarsT t1" "x3 \ FvarsT t2" +shows "psubstT r [(t1,x1),(t2,x2),(t3,x3)] = rawpsubstT r [(t1,x1),(t2,x2),(t3,x3)]" +using assms less_SucE less_Suc_eq_0_disj +by (intro psubstT_eq_rawpsubstT) auto + +lemma psubstT_eq_rawpsubst4: +assumes "r \ atrm" "x1 \ var" "x2 \ var" "x3 \ var" "x4 \ var" +"t1 \ atrm" "t2 \ atrm" "t3 \ atrm" "t4 \ atrm" +and "x1 \ x2" "x1 \ x3" "x2 \ x3" "x1 \ x4" "x2 \ x4" "x3 \ x4" +"x2 \ FvarsT t1" "x3 \ FvarsT t1" "x3 \ FvarsT t2" "x4 \ FvarsT t1" "x4 \ FvarsT t2" "x4 \ FvarsT t3" +shows "psubstT r [(t1,x1),(t2,x2),(t3,x3),(t4,x4)] = rawpsubstT r [(t1,x1),(t2,x2),(t3,x3),(t4,x4)]" +using assms less_SucE less_Suc_eq_0_disj +by (intro psubstT_eq_rawpsubstT) auto + +lemma rawpsubstT_same_Var[simp]: +assumes "r \ atrm" "set xs \ var" +shows "rawpsubstT r (map (\x. (Var x,x)) xs) = r" +using assms by (induct xs) auto + +lemma psubstT_same_Var[simp]: +assumes "r \ atrm" "set xs \ var" and "distinct xs" +shows "psubstT r (map (\x. (Var x,x)) xs) = r" +proof- + have "psubstT r (map (\x. (Var x,x)) xs) = rawpsubstT r (map (\x. (Var x,x)) xs)" + using assms FvarsT_Var[of "xs ! _"] nth_mem[of _ xs] + by (intro psubstT_eq_rawpsubstT) + (auto simp: o_def distinct_conv_nth dest!: FvarsT_VarD) + thus ?thesis using assms by auto +qed + +(* The following holds for all trms, so no need to prove it for a trms: *) +thm psubstT_notIn + +(***) + +(* Behavior of psubst w.r.t. equality formulas: *) + +lemma rawpsubst_eql: +assumes "t1 \ trm" "t2 \ trm" +and "snd ` (set txs) \ var" "fst ` (set txs) \ trm" +shows "rawpsubst (eql t1 t2) txs = eql (rawpsubstT t1 txs) (rawpsubstT t2 txs)" +using assms apply (induct txs arbitrary: t1 t2) + subgoal by auto + subgoal for tx txs t1 t2 by (cases tx) auto . + +lemma psubst_eql[simp]: +assumes "t1 \ atrm" "t2 \ atrm" +and "snd ` (set txs) \ var" "fst ` (set txs) \ atrm" +and "distinct (map snd txs)" +shows "psubst (eql t1 t2) txs = eql (psubstT t1 txs) (psubstT t2 txs)" +proof- + have t12: "fst ` (set txs) \ trm" using assms by auto + define us where us: "us \ getFrN (map snd txs) (map fst txs) [eql t1 t2] (length txs)" + have us_facts: "set us \ var" + "set us \ FvarsT t1 = {}" + "set us \ FvarsT t2 = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms(1-3) t12 unfolding us + using getFrN_Fvars[of "map snd txs" "map fst txs" "[eql t1 t2]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "map fst txs" "[eql t1 t2]" _ "length txs"] + getFrN_var[of "map snd txs" "map fst txs" "[eql t1 t2]" _ "length txs"] + getFrN_length[of "map snd txs" "map fst txs" "[eql t1 t2]" "length txs"] + apply - + subgoal by auto + subgoal by force + subgoal by force + subgoal by fastforce + subgoal by (fastforce simp: image_iff) + by auto + + define vs1 where vs1: "vs1 \ getFrN (map snd txs) (t1 # map fst txs) [] (length txs)" + have vs1_facts: "set vs1 \ var" + "set vs1 \ FvarsT t1 = {}" + "set vs1 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs1 \ snd ` (set txs) = {}" + "length vs1 = length txs" + "distinct vs1" + using assms(1-3) t12 unfolding vs1 + using getFrN_Fvars[of "map snd txs" "t1 # map fst txs" "[]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "t1 # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "t1 # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "t1 # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by force + subgoal by auto + subgoal by force + subgoal by (fastforce simp: image_iff) + by auto + + define vs2 where vs2: "vs2 \ getFrN (map snd txs) (t2 # map fst txs) [] (length txs)" + have vs2_facts: "set vs2 \ var" + "set vs2 \ FvarsT t2 = {}" + "set vs2 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs2 \ snd ` (set txs) = {}" + "length vs2 = length txs" + "distinct vs2" + using assms(1-3) t12 unfolding vs2 + using getFrN_Fvars[of "map snd txs" "t2 # map fst txs" "[]" _ "length txs"] + getFrN_FvarsT[of "map snd txs" "t2 # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "t2 # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "t2 # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by force + subgoal by auto + subgoal by force + subgoal by (fastforce simp: image_iff) + by auto + + let ?tus = "zip (map fst txs) us" + let ?uxs = "zip (map Var us) (map snd txs)" + let ?e = "rawpsubst (eql t1 t2) ?uxs" + have e: "?e = eql (rawpsubstT t1 ?uxs) (rawpsubstT t2 ?uxs)" + apply(rule rawpsubst_eql) using assms us_facts apply auto + apply(drule set_zip_rightD) apply simp apply blast + apply(drule set_zip_leftD) apply simp apply blast . + have 0: "rawpsubst ?e ?tus = + eql (rawpsubstT (rawpsubstT t1 ?uxs) ?tus) (rawpsubstT (rawpsubstT t2 ?uxs) ?tus)" + unfolding e using assms us_facts apply(intro rawpsubst_eql) + subgoal by (auto intro!: rawpsubstT dest!: set_zip_D) + subgoal by (auto intro!: rawpsubstT dest!: set_zip_D) + subgoal by (auto intro!: rawpsubstT dest!: set_zip_D) + subgoal by (fastforce intro!: rawpsubstT dest!: set_zip_D) . + have 1: "rawpsubstT (rawpsubstT t1 ?uxs) ?tus = + rawpsubstT (rawpsubstT t1 (zip (map Var vs1) (map snd txs))) (zip (map fst txs) vs1)" + using assms us_facts vs1_facts + by (intro rawpsubstT_compose_freshVar2) auto + have 2: "rawpsubstT (rawpsubstT t2 ?uxs) ?tus = + rawpsubstT (rawpsubstT t2 (zip (map Var vs2) (map snd txs))) (zip (map fst txs) vs2)" + using assms us_facts vs2_facts + by (intro rawpsubstT_compose_freshVar2) auto + show ?thesis unfolding psubstT_def psubst_def + by (simp add: Let_def us[symmetric] vs1[symmetric] vs2[symmetric] 0 1 2) +qed + +(* psubst versus the exists-unique quantifier: *) + +lemma psubst_exu[simp]: +assumes "\ \ fmla" "x \ var" "snd ` set txs \ var" "fst ` set txs \ atrm" +"x \ snd ` set txs" "x \ (\t \ fst ` set txs. FvarsT t)" "distinct (map snd txs)" +shows "psubst (exu x \) txs = exu x (psubst \ txs)" +proof- + have f: "fst ` set txs \ trm" using assms by (meson atrm_trm subset_trans) + note assms1 = assms(1-3) assms(5-7) f + define u where u: "u \ getFr (x # map snd txs) (map fst txs) [\]" + have u_facts: "u \ var" "u \ x" + "u \ snd ` set txs" "u \ (\t \ fst ` set txs. FvarsT t)" "u \ Fvars \" + unfolding u using f getFr_FvarsT_Fvars[of "x # map snd txs" "map fst txs" "[\]"] by (auto simp: assms) + hence [simp]: "psubst (subst \ (Var u) x) txs = subst (psubst \ txs) (Var u) x" + using assms apply(intro psubst_subst_fresh_switch f) by auto + show ?thesis using f assms u_facts + by (subst exu_def_var[of _ u "psubst \ txs"]) + (auto dest!: in_Fvars_psubstD split: if_splits simp: exu_def_var[of _ u] ) +qed + +(* psubst versus the arithmetic trm constructors: *) + +(* We already have: *) +thm psubstT_Var_not[no_vars] + +lemma rawpsubstT_Var_in: +assumes "snd ` (set txs) \ var" "fst ` (set txs) \ trm" +and "distinct (map snd txs)" and "(s,y) \ set txs" +and "\ i j. i < j \ j < length txs \ snd (txs!j) \ FvarsT (fst (txs!i))" +shows "rawpsubstT (Var y) txs = s" +using assms proof(induction txs) + case (Cons tx txs) + obtain t x where tx[simp]: "tx = (t,x)" by (cases tx) auto + + have 00: "FvarsT t \ snd ` set txs = {}" + using Cons.prems(5)[of 0 "Suc _"] by (auto simp: set_conv_nth) + + have "rawpsubstT (substT (Var y) t x) txs = s" + proof(cases "y = x") + case [simp]:True hence [simp]: "s = t" using `distinct (map snd (tx # txs))` + `(s, y) \ set (tx # txs)` using image_iff by fastforce + show ?thesis using Cons.prems 00 by auto + next + case False + hence [simp]: "substT (Var y) t x = Var y" + using Cons.prems by (intro substT_notIn) auto + have "rawpsubstT (Var y) txs = s" + using Cons.prems apply(intro Cons.IH) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal using False by auto + subgoal by (metis length_Cons less_Suc_eq_0_disj nth_Cons_Suc) . + thus ?thesis by simp + qed + thus ?case by simp +qed auto + +lemma psubstT_Var_in: +assumes "y \ var" "snd ` (set txs) \ var" "fst ` (set txs) \ trm" +and "distinct (map snd txs)" and "(s,y) \ set txs" +shows "psubstT (Var y) txs = s" +proof- + define us where us: "us \ getFrN (map snd txs) (Var y # map fst txs) [] (length txs)" + have us_facts: "set us \ var" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "y \ set us" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms unfolding us + using getFrN_FvarsT[of "map snd txs" "Var y # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "Var y # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "Var y # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by force + subgoal by force + by auto + obtain i where i[simp]: "i < length txs" "txs!i = (s,y)" using `(s,y) \ set txs` + by (metis in_set_conv_nth) + hence 00[simp]: "\ j. j < length txs \ txs ! j = txs ! i \ j = i" + using `distinct (map snd txs)` distinct_Ex1 nth_mem by fastforce + have 000[simp]: "\ j ia. j < length txs \ ia < length txs \ snd (txs ! j) \ us ! ia" + using assms us_facts + by (metis IntI empty_iff length_map list.set_map nth_map nth_mem) + have [simp]: "\ii jj. ii < jj \ jj < length txs \ us ! ii \ var" + using nth_mem us_facts(1) us_facts(5) by auto + have [simp]: "\i j. i < j \ j < length txs \ us ! j \ FvarsT (fst (txs ! i))" + using us_facts(2,5) by (auto simp: Int_def) + + have 0: "rawpsubstT (Var y) (zip (map Var us) (map snd txs)) = Var (us!i)" + using assms us_facts + by (intro rawpsubstT_Var_in) + (auto dest!: set_zip_D simp: in_set_conv_nth intro!: exI[of _ i]) + + have "rawpsubstT (rawpsubstT (Var y) (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = s" + unfolding 0 using assms us_facts + by (intro rawpsubstT_Var_in) + (auto dest!: set_zip_D simp: in_set_conv_nth intro!: exI[of _ i]) + thus ?thesis unfolding psubstT_def by (simp add: Let_def us[symmetric]) +qed + +lemma psubstT_Var_Cons_aux: +assumes "y \ var" "x \ var" "t \ atrm" +"snd ` set txs \ var" "fst ` set txs \ atrm" "x \ snd ` set txs" +"distinct (map snd txs)" "y \ x" +shows "psubstT (Var y) ((t, x) # txs) = psubstT (Var y) txs" +proof- + have txs_trm: "t \ trm" "fst ` set txs \ trm" using assms by auto + note assms1 = assms(1,2) assms(4) assms(6-8) txs_trm + + note fvt = getFrN_FvarsT[of "x # map snd txs" "Var y # t # map fst txs" "[]" _ "Suc (length txs)"] + and var = getFrN_var[of "x # map snd txs" "Var y # t # map fst txs" "[]" _ "Suc (length txs)"] + and l = getFrN_length[of "x # map snd txs" "Var y # t # map fst txs" "[]" "Suc (length txs)"] + define uus where uus: + "uus \ getFrN (x # map snd txs) (Var y # t # map fst txs) [] (Suc (length txs))" + have uus_facts: "set uus \ var" + "set uus \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set uus \ snd ` (set txs) = {}" + "set uus \ FvarsT t = {}" + "x \ set uus" + "y \ set uus" + "length uus = Suc (length txs)" + "distinct uus" + using assms1 unfolding uus + apply - + subgoal by auto + subgoal using fvt by (simp add: in_fst_image Int_def) (metis prod.collapse) + subgoal using var by (force simp add: in_fst_image Int_def) + subgoal using fvt by auto + subgoal using var by (fastforce simp: in_fst_image Int_def) + subgoal using fvt by (force simp: in_fst_image Int_def) + subgoal using l by auto + subgoal by auto . + + obtain u us where uus_us[simp]: "uus = u # us" using uus_facts by (cases uus) auto + + have us_facts: "set us \ var" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "set us \ FvarsT t = {}" + "x \ set us" + "y \ set us" + "length us = length txs" + "distinct us" + and u_facts: "u \ var" + "u \ \ (FvarsT ` (fst ` (set txs)))" + "u \ snd ` (set txs)" + "u \FvarsT t" + "u \ x" + "u \ y" + "u \ set us" + using uus_facts by auto + + note fvt = getFrN_FvarsT[of "map snd txs" "Var y # map fst txs" "[]" _ "length txs"] + and var = getFrN_var[of "map snd txs" "Var y # map fst txs" "[]" _ "length txs"] + and l = getFrN_length[of "map snd txs" "Var y # map fst txs" "[]" "length txs"] + define vs where vs: "vs \ getFrN (map snd txs) (Var y # map fst txs) [] (length txs)" + have vs_facts: "set vs \ var" + "set vs \ \ (FvarsT ` (fst ` (set txs))) = {}" + "y \ set vs" + "set vs \ snd ` (set txs) = {}" + "length vs = length txs" + "distinct vs" + using assms1 unfolding vs + apply - + subgoal by auto + subgoal using fvt by (simp add: in_fst_image Int_def) (metis prod.collapse) + subgoal using fvt l by fastforce + subgoal using var by (force simp: Int_def in_fst_image) + subgoal using l by auto + subgoal by auto . + + have 0: "substT (Var y) (Var u) x = Var y" + using assms u_facts by auto + have 1: "substT (rawpsubstT (Var y) (zip (map Var us) (map snd txs))) t u = + rawpsubstT (Var y) (zip (map Var us) (map snd txs))" + using assms u_facts us_facts + by (intro substT_notIn) + (auto 0 3 intro!: rawpsubstT dest!: set_zip_D in_FvarsT_rawpsubstT_imp FvarsT_VarD) + + have "rawpsubstT (rawpsubstT (Var y) (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = + rawpsubstT (rawpsubstT (Var y) (zip (map Var vs) (map snd txs))) (zip (map fst txs) vs)" + using assms vs_facts us_facts by (intro rawpsubstT_compose_freshVar2) auto + thus ?thesis unfolding psubstT_def + by (simp add: Let_def uus[symmetric] vs[symmetric] 0 1) +qed + +text \Simplification rules for parallel substitution:\ + +lemma psubstT_Var_Cons[simp]: +"y \ var \ x \ var \ t \ atrm \ + snd ` set txs \ var \ fst ` set txs \ atrm \ distinct (map snd txs) \ x \ snd ` set txs \ + psubstT (Var y) ((t,x) # txs) = (if y = x then t else psubstT (Var y) txs)" +apply(cases "y = x") +subgoal by (rule psubstT_Var_in) auto +subgoal by (auto intro!: psubstT_Var_Cons_aux) . + +lemma psubstT_zer[simp]: +assumes "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" +shows "psubstT zer txs = zer" +using assms by (intro psubstT_num) auto + +lemma rawpsubstT_suc: +assumes "r \ trm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" +shows "rawpsubstT (suc r) txs = suc (rawpsubstT r txs)" +using assms apply(induct txs arbitrary: r) +subgoal by simp +subgoal for tx txs r by (cases tx) auto . + +lemma psubstT_suc[simp]: +assumes "r \ atrm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +and "distinct (map snd txs)" +shows "psubstT (suc r) txs = suc (psubstT r txs)" +proof- + have 000: "r \ trm" "fst ` (set txs) \ trm" using assms by auto + define us where us: "us \ getFrN (map snd txs) (suc r # map fst txs) [] (length txs)" + have us_facts: "set us \ var" + "set us \ FvarsT r = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms(2) 000 unfolding us + using getFrN_FvarsT[of "map snd txs" "suc r # map fst txs" "[]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "suc r # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "suc r # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "suc r # map fst txs" "[]" "length txs"] + getFrN_length[of "map snd txs" "suc r # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by force + subgoal by auto + subgoal by force + by auto + define vs where vs: "vs \ getFrN (map snd txs) (r # map fst txs) [] (length txs)" + have vs_facts: "set vs \ var" + "set vs \ FvarsT r = {}" + "set vs \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs \ snd ` (set txs) = {}" + "length vs = length txs" + "distinct vs" + using assms(2) 000 unfolding vs + using getFrN_FvarsT[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "r # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "r # map fst txs" "[]" "length txs"] + getFrN_length[of "map snd txs" "r # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by force + by auto + have 0: "rawpsubstT (suc r) (zip (map Var vs) (map snd txs)) = + suc (rawpsubstT r (zip (map Var vs) (map snd txs)))" + using assms vs_facts by (intro rawpsubstT_suc) (auto dest!: set_zip_D) + + have "rawpsubstT (rawpsubstT (suc r) (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = + rawpsubstT (rawpsubstT (suc r) (zip (map Var vs) (map snd txs))) (zip (map fst txs) vs)" + using assms us_facts vs_facts by (intro rawpsubstT_compose_freshVar2) auto + also have "\ = suc (rawpsubstT (rawpsubstT r (zip (map Var vs) (map snd txs))) (zip (map fst txs) vs))" + unfolding 0 using assms vs_facts apply(intro rawpsubstT_suc) + subgoal by (auto dest!: set_zip_D intro!: rawpsubstT) + subgoal by (auto dest!: set_zip_D) + subgoal by (fastforce dest!: set_zip_D simp: Int_def) . + finally show ?thesis + by (simp add: Let_def us[symmetric] vs[symmetric] psubstT_def) +qed + +lemma rawpsubstT_pls: +assumes "r1 \ trm" "r2 \ trm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" +shows "rawpsubstT (pls r1 r2) txs = pls (rawpsubstT r1 txs) (rawpsubstT r2 txs)" +using assms apply(induct txs arbitrary: r1 r2) +subgoal by simp +subgoal for tx txs r by (cases tx) auto . + +lemma psubstT_pls[simp]: +assumes "r1 \ atrm" "r2 \ atrm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +and "distinct (map snd txs)" +shows "psubstT (pls r1 r2) txs = pls (psubstT r1 txs) (psubstT r2 txs)" +proof- + have 000: "fst ` (set txs) \ trm" using assms by auto + define us where us: "us \ getFrN (map snd txs) (pls r1 r2 # map fst txs) [] (length txs)" + have us_facts: "set us \ var" + "set us \ FvarsT r1 = {}" + "set us \ FvarsT r2 = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms(1-3) 000 unfolding us + using getFrN_FvarsT[of "map snd txs" "pls r1 r2 # map fst txs" "[]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "pls r1 r2 # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "pls r1 r2 # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "pls r1 r2 # map fst txs" "[]" "length txs"] + getFrN_length[of "map snd txs" "pls r1 r2 # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by force + subgoal by force + subgoal by auto + subgoal by force + by auto + define vs1 where vs1: "vs1 \ getFrN (map snd txs) (r1 # map fst txs) [] (length txs)" + have vs1_facts: "set vs1 \ var" + "set vs1 \ FvarsT r1 = {}" + "set vs1 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs1 \ snd ` (set txs) = {}" + "length vs1 = length txs" + "distinct vs1" + using assms(1-3) 000 unfolding vs1 + using getFrN_FvarsT[of "map snd txs" "r1 # map fst txs" "[]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "r1 # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "r1 # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "r1 # map fst txs" "[]" "length txs"] + getFrN_length[of "map snd txs" "r1 # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by force + by auto + define vs2 where vs2: "vs2 \ getFrN (map snd txs) (r2 # map fst txs) [] (length txs)" + have vs2_facts: "set vs2 \ var" + "set vs2 \ FvarsT r2 = {}" + "set vs2 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs2 \ snd ` (set txs) = {}" + "length vs2 = length txs" + "distinct vs2" + using assms(1-3) 000 unfolding vs2 + using getFrN_FvarsT[of "map snd txs" "r2 # map fst txs" "[]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "r2 # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "r2 # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "r2 # map fst txs" "[]" "length txs"] + getFrN_length[of "map snd txs" "r2 # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by force + by auto + have 0: "rawpsubstT (pls r1 r2) (zip (map Var us) (map snd txs)) = + pls (rawpsubstT r1 (zip (map Var us) (map snd txs))) + (rawpsubstT r2 (zip (map Var us) (map snd txs)))" + using assms us_facts by (intro rawpsubstT_pls) (auto dest!: set_zip_D) + + have 1: "rawpsubstT (rawpsubstT r1 (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = + rawpsubstT (rawpsubstT r1 (zip (map Var vs1) (map snd txs))) (zip (map fst txs) vs1)" + using assms us_facts vs1_facts by (intro rawpsubstT_compose_freshVar2) auto + + have 2: "rawpsubstT (rawpsubstT r2 (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = + rawpsubstT (rawpsubstT r2 (zip (map Var vs2) (map snd txs))) (zip (map fst txs) vs2)" + using assms us_facts vs2_facts by (intro rawpsubstT_compose_freshVar2) auto + + have 3: "rawpsubstT (rawpsubstT (pls r1 r2) (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = + pls (rawpsubstT (rawpsubstT r1 (zip (map Var us) (map snd txs))) (zip (map fst txs) us)) + (rawpsubstT (rawpsubstT r2 (zip (map Var us) (map snd txs))) (zip (map fst txs) us))" + unfolding 0 using assms us_facts apply(intro rawpsubstT_pls) + subgoal by (auto dest!: set_zip_D intro!: rawpsubstT) + subgoal by (force dest!: set_zip_D intro!: rawpsubstT simp: Int_def) + subgoal by (auto dest!: set_zip_D intro!: rawpsubstT) + subgoal by (fastforce dest!: set_zip_D intro!: rawpsubstT simp: Int_def) . + show ?thesis unfolding psubstT_def + by (simp add: Let_def us[symmetric] vs1[symmetric] vs2[symmetric] 1 2 3) +qed + +lemma rawpsubstT_tms: +assumes "r1 \ trm" "r2 \ trm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ trm" +shows "rawpsubstT (tms r1 r2) txs = tms (rawpsubstT r1 txs) (rawpsubstT r2 txs)" +using assms apply(induct txs arbitrary: r1 r2) +subgoal by simp +subgoal for tx txs r by (cases tx) auto . + +lemma psubstT_tms[simp]: +assumes "r1 \ atrm" "r2 \ atrm" and "snd ` (set txs) \ var" and "fst ` (set txs) \ atrm" +and "distinct (map snd txs)" +shows "psubstT (tms r1 r2) txs = tms (psubstT r1 txs) (psubstT r2 txs)" +proof- + have 000: "fst ` (set txs) \ trm" using assms by auto + define us where us: "us \ getFrN (map snd txs) (tms r1 r2 # map fst txs) [] (length txs)" + have us_facts: "set us \ var" + "set us \ FvarsT r1 = {}" + "set us \ FvarsT r2 = {}" + "set us \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set us \ snd ` (set txs) = {}" + "length us = length txs" + "distinct us" + using assms(1-3) 000 unfolding us + using getFrN_FvarsT[of "map snd txs" "tms r1 r2 # map fst txs" "[]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "tms r1 r2 # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "tms r1 r2 # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "tms r1 r2 # map fst txs" "[]" "length txs"] + getFrN_length[of "map snd txs" "tms r1 r2 # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by force + subgoal by force + subgoal by auto + subgoal by force + by auto + define vs1 where vs1: "vs1 \ getFrN (map snd txs) (r1 # map fst txs) [] (length txs)" + have vs1_facts: "set vs1 \ var" + "set vs1 \ FvarsT r1 = {}" + "set vs1 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs1 \ snd ` (set txs) = {}" + "length vs1 = length txs" + "distinct vs1" + using assms(1-3) 000 unfolding vs1 + using getFrN_FvarsT[of "map snd txs" "r1 # map fst txs" "[]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "r1 # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "r1 # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "r1 # map fst txs" "[]" "length txs"] + getFrN_length[of "map snd txs" "r1 # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by force + subgoal by auto + subgoal by force + subgoal by force + by auto + define vs2 where vs2: "vs2 \ getFrN (map snd txs) (r2 # map fst txs) [] (length txs)" + have vs2_facts: "set vs2 \ var" + "set vs2 \ FvarsT r2 = {}" + "set vs2 \ \ (FvarsT ` (fst ` (set txs))) = {}" + "set vs2 \ snd ` (set txs) = {}" + "length vs2 = length txs" + "distinct vs2" + using assms(1-3) 000 unfolding vs2 + using getFrN_FvarsT[of "map snd txs" "r2 # map fst txs" "[]" _ "length txs"] + getFrN_Fvars[of "map snd txs" "r2 # map fst txs" "[]" _ "length txs"] + getFrN_var[of "map snd txs" "r2 # map fst txs" "[]" _ "length txs"] + getFrN_length[of "map snd txs" "r2 # map fst txs" "[]" "length txs"] + getFrN_length[of "map snd txs" "r2 # map fst txs" "[]" "length txs"] + apply - + subgoal by auto + subgoal by force + subgoal by auto + subgoal by force + subgoal by force + by auto + have 0: "rawpsubstT (tms r1 r2) (zip (map Var us) (map snd txs)) = + tms (rawpsubstT r1 (zip (map Var us) (map snd txs))) + (rawpsubstT r2 (zip (map Var us) (map snd txs)))" + using assms us_facts by (intro rawpsubstT_tms) (auto dest!: set_zip_D) + + have 1: "rawpsubstT (rawpsubstT r1 (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = + rawpsubstT (rawpsubstT r1 (zip (map Var vs1) (map snd txs))) (zip (map fst txs) vs1)" + using assms us_facts vs1_facts by (intro rawpsubstT_compose_freshVar2) auto + + have 2: "rawpsubstT (rawpsubstT r2 (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = + rawpsubstT (rawpsubstT r2 (zip (map Var vs2) (map snd txs))) (zip (map fst txs) vs2)" + using assms us_facts vs2_facts by (intro rawpsubstT_compose_freshVar2) auto + + have 3: "rawpsubstT (rawpsubstT (tms r1 r2) (zip (map Var us) (map snd txs))) (zip (map fst txs) us) = + tms (rawpsubstT (rawpsubstT r1 (zip (map Var us) (map snd txs))) (zip (map fst txs) us)) + (rawpsubstT (rawpsubstT r2 (zip (map Var us) (map snd txs))) (zip (map fst txs) us))" + unfolding 0 using assms us_facts apply(intro rawpsubstT_tms) + subgoal by (auto dest!: set_zip_D intro!: rawpsubstT) + subgoal by (force dest!: set_zip_D intro!: rawpsubstT simp: Int_def) + subgoal by (auto dest!: set_zip_D intro!: rawpsubstT) + subgoal by (fastforce dest!: set_zip_D intro!: rawpsubstT simp: Int_def) . + + show ?thesis unfolding psubstT_def + by (simp add: Let_def us[symmetric] vs1[symmetric] vs2[symmetric] 1 2 3) +qed + + +section \The (Nonstrict and Strict) Order Relations\ + +text \Lq (less than or equal to) is a formula with free vars xx and yy. +NB: Out of the two possible ways, adding zz to the left or to the right, +we choose the former, since this seems to enable Q (Robinson arithmetic) +to prove as many useful properties as possible.\ + +definition Lq :: "'fmla" where +"Lq \ exi zz (eql (Var yy) (pls (Var zz) (Var xx)))" + +text \Alternative, more flexible definition , for any non-capturing bound variable:\ +lemma Lq_def2: "z \ var \ z \ yy \ z \ xx \ Lq = exi z (eql (Var yy) (pls (Var z) (Var xx)))" +unfolding Lq_def using exi_rename[of "eql (Var yy) (pls (Var zz) (Var xx))" zz z] by auto + +lemma Lq[simp,intro!]: "Lq \ fmla" +unfolding Lq_def by auto + +lemma Fvars_Lq[simp]: "Fvars Lq = {xx,yy}" +unfolding Lq_def by auto + +text \As usual, we also define a predicate version:\ +definition LLq where "LLq \ \ t1 t2. psubst Lq [(t1,xx), (t2,yy)]" + +lemma LLq[simp,intro]: +assumes "t1 \ trm" "t2 \ trm" +shows "LLq t1 t2 \ fmla" + using assms unfolding LLq_def by auto + +lemma LLq2[simp,intro!]: +"n \ num \ LLq n (Var yy') \ fmla" + by auto + +lemma Fvars_LLq[simp]: "t1 \ trm \ t2 \ trm \ +Fvars (LLq t1 t2) = FvarsT t1 \ FvarsT t2" +unfolding LLq_def apply(subst Fvars_psubst) +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by auto +subgoal apply safe + subgoal by auto + subgoal by auto + subgoal by force + subgoal by force + subgoal by force + subgoal by force . . + +text \This lemma will be the working definition of LLq:\ +lemma LLq_pls: +assumes [simp]: "t1 \ atrm" "t2 \ atrm" "z \ var" "z \ FvarsT t1" "z \ FvarsT t2" +shows "LLq t1 t2 = exi z (eql t2 (pls (Var z) t1))" +proof- + define z' where "z' \ getFr [xx,yy,z] [t1,t2] []" + have z_facts[simp]: "z' \ var" "z' \ yy" "z' \ xx" "z' \ z" "z \ z'" "z' \ FvarsT t1" "z' \ FvarsT t2" + using getFr_FvarsT_Fvars[of "[xx,yy,z]" "[t1,t2]" "[]"] unfolding z'_def by auto + have "LLq t1 t2 = exi z' (eql t2 (pls (Var z') t1))" + by (simp add: LLq_def Lq_def2[of z']) + also have "\ = exi z (eql t2 (pls (Var z) t1))" + using exi_rename[of "eql t2 (pls (Var z') t1)" z' z, simplified] . + finally show ?thesis . +qed + +lemma LLq_pls_zz: +assumes "t1 \ atrm" "t2 \ atrm" "zz \ FvarsT t1" "zz \ FvarsT t2" +shows "LLq t1 t2 = exi zz (eql t2 (pls (Var zz) t1))" +using assms by (intro LLq_pls) auto + +text \If we restrict attention to arithmetic terms, we can prove a uniform +substitution property for LLq:\ +lemma subst_LLq[simp]: +assumes [simp]: "t1 \ atrm" "t2 \ atrm" "s \ atrm" "x \ var" +shows "subst (LLq t1 t2) s x = LLq (substT t1 s x) (substT t2 s x)" +proof- + define z where "z \ getFr [xx,yy,x] [t1,t2,s] []" + have z_facts[simp]: "z \ var" "z \ xx" "z \ yy" "z \ x" "z \ FvarsT t1" "z \ FvarsT t2" "z \ FvarsT s" + using getFr_FvarsT_Fvars[of "[xx,yy,x]" "[t1,t2,s]" "[]"] unfolding z_def by auto + show ?thesis + by(simp add: FvarsT_substT LLq_pls[of _ _ z] subst2_fresh_switch Lq_def) +qed + +lemma psubst_LLq[simp]: +assumes 1: "t1 \ atrm" "t2 \ atrm" "fst ` set txs \ atrm" +and 2: "snd ` set txs \ var" +and 3: "distinct (map snd txs)" +shows "psubst (LLq t1 t2) txs = LLq (psubstT t1 txs) (psubstT t2 txs)" +proof- + have 0: "t1 \ trm" "t2 \ trm" "fst ` set txs \ trm" using 1 by auto + define z where z: "z \ getFr ([xx,yy] @ map snd txs) ([t1,t2] @ map fst txs) []" + have us_facts: "z \ var" "z \ xx" "z \ yy" + "z \ FvarsT t1" "z \ FvarsT t2" + "z \ \ (FvarsT ` (fst ` (set txs)))" + "z \ snd ` (set txs)" + using 0 2 unfolding z + using getFr_FvarsT[of "[xx,yy] @ map snd txs" "[t1,t2] @ map fst txs" "[]" ] + getFr_Fvars[of "[xx,yy] @ map snd txs" "[t1,t2] @ map fst txs" "[]" ] + getFr_var[of "[xx,yy] @ map snd txs" "[t1,t2] @ map fst txs" "[]"] + apply - + subgoal by auto + subgoal by force + subgoal by force + subgoal by force + subgoal by force + subgoal by auto + subgoal by (force simp: image_iff) . + + note in_FvarsT_psubstTD[dest!] + note if_splits[split] + show ?thesis + using assms 0 us_facts apply(subst LLq_pls[of _ _ z]) + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal by auto + subgoal apply(subst LLq_pls[of _ _ z]) by auto . +qed + + +text \Lq less than) is the strict version of the order relation. +We prove similar facts as for Lq\ + +definition Ls :: "'fmla" where +"Ls \ cnj Lq (neg (eql (Var xx) (Var yy)))" + +lemma Ls[simp,intro!]: "Ls \ fmla" +unfolding Ls_def by auto + +lemma Fvars_Ls[simp]: "Fvars Ls = {xx,yy}" +unfolding Ls_def by auto + +definition LLs where "LLs \ \ t1 t2. psubst Ls [(t1,xx), (t2,yy)]" + +lemma LLs[simp,intro]: +assumes "t1 \ trm" "t2 \ trm" +shows "LLs t1 t2 \ fmla" + using assms unfolding LLs_def by auto + +lemma LLs2[simp,intro!]: +"n \ num \ LLs n (Var yy') \ fmla" + by auto + +lemma Fvars_LLs[simp]: "t1 \ trm \ t2 \ trm \ +Fvars (LLs t1 t2) = FvarsT t1 \ FvarsT t2" +unfolding LLs_def apply(subst Fvars_psubst) +subgoal by auto +subgoal by auto +subgoal by auto +subgoal by auto +subgoal apply safe + subgoal by auto + subgoal by auto + subgoal by force + subgoal by force + subgoal by force + subgoal by force . . + +text \The working definition of LLs:\ +lemma LLs_LLq: +"t1 \ atrm \ t2 \ atrm \ + LLs t1 t2 = cnj (LLq t1 t2) (neg (eql t1 t2))" +by (simp add: LLs_def Ls_def LLq_def) + +lemma subst_LLs[simp]: +assumes [simp]: "t1 \ atrm" "t2 \ atrm" "s \ atrm" "x \ var" +shows "subst (LLs t1 t2) s x = LLs (substT t1 s x) (substT t2 s x)" +by(simp add: LLs_LLq subst2_fresh_switch Ls_def) + +lemma psubst_LLs[simp]: +assumes 1: "t1 \ atrm" "t2 \ atrm" "fst ` set txs \ atrm" +and 2: "snd ` set txs \ var" +and 3: "distinct (map snd txs)" +shows "psubst (LLs t1 t2) txs = LLs (psubstT t1 txs) (psubstT t2 txs)" +proof- + have 0: "t1 \ trm" "t2 \ trm" "fst ` set txs \ trm" using 1 by auto + define z where z: "z \ getFr ([xx,yy] @ map snd txs) ([t1,t2] @ map fst txs) []" + have us_facts: "z \ var" "z \ xx" "z \ yy" + "z \ FvarsT t1" "z \ FvarsT t2" + "z \ \ (FvarsT ` (fst ` (set txs)))" + "z \ snd ` (set txs)" + using 0 2 unfolding z + using getFr_FvarsT[of "[xx,yy] @ map snd txs" "[t1,t2] @ map fst txs" "[]" ] + getFr_Fvars[of "[xx,yy] @ map snd txs" "[t1,t2] @ map fst txs" "[]" ] + getFr_var[of "[xx,yy] @ map snd txs" "[t1,t2] @ map fst txs" "[]"] + apply - + subgoal by auto + subgoal by force + subgoal by force + subgoal by force + subgoal by force + subgoal by auto + subgoal by (force simp: image_iff) . + show ?thesis + using assms 0 us_facts by (simp add: LLs_LLq) +qed + + +section \Bounded Quantification\ + +text \Bounded forall\ + +definition ball :: "'var \ 'trm \ 'fmla \ 'fmla" where +"ball x t \ \ all x (imp (LLq (Var x) t) \)" + +lemma ball[simp, intro]: "x \ var \ t \ trm \ \ \ fmla \ ball x t \ \ fmla" +unfolding ball_def by auto + +lemma Fvars_ball[simp]: +"x \ var \ \ \ fmla \ t \ trm \ Fvars (ball x t \) = (Fvars \ \ FvarsT t) - {x}" +unfolding ball_def by auto + +lemma subst_ball: +"\ \ fmla \ t \ atrm \ t1 \ atrm \ x \ var \ y \ var \ x \ y \ x \ FvarsT t1 \ + subst (ball x t \) t1 y = ball x (substT t t1 y) (subst \ t1 y)" + unfolding ball_def by simp + +lemma psubst_ball: +"\ \ fmla \ y \ var \ snd ` set txs \ var \ t \ atrm \ + fst ` set txs \ trm \ fst ` set txs \ atrm \ y \ snd ` set txs \ y \ (\t \ fst ` set txs. FvarsT t) \ + distinct (map snd txs) \ + psubst (ball y t \) txs = ball y (psubstT t txs) (psubst \ txs)" +unfolding ball_def by simp + +text \Bounded exists\ + +definition bexi :: "'var \ 'trm \ 'fmla \ 'fmla" where +"bexi x t \ \ exi x (cnj (LLq (Var x) t) \)" + +lemma bexi[simp, intro]: "x \ var \ t \ trm \ \ \ fmla \ bexi x t \ \ fmla" +unfolding bexi_def by auto + +lemma Fvars_bexi[simp]: +"x \ var \ \ \ fmla \ t \ trm \ Fvars (bexi x t \) = (Fvars \ \ FvarsT t) - {x}" +unfolding bexi_def by auto + +lemma subst_bexi: +"\ \ fmla \ t \ atrm \ t1 \ atrm \ x \ var \ y \ var \ x \ y \ x \ FvarsT t1 \ + subst (bexi x t \) t1 y = bexi x (substT t t1 y) (subst \ t1 y)" +unfolding bexi_def by simp + +lemma psubst_bexi: +"\ \ fmla \ y \ var \ snd ` set txs \ var \ t \ atrm \ + fst ` set txs \ trm \ fst ` set txs \ atrm \ y \ snd ` set txs \ y \ (\t \ fst ` set txs. FvarsT t) \ + distinct (map snd txs) \ + psubst (bexi y t \) txs = bexi y (psubstT t txs) (psubst \ txs)" +unfolding bexi_def by simp + +end \ \context @{locale Syntax_Arith}\ + +(*<*) +end +(*>*) diff --git a/thys/Syntax_Independent_Logic/document/root.bib b/thys/Syntax_Independent_Logic/document/root.bib new file mode 100644 --- /dev/null +++ b/thys/Syntax_Independent_Logic/document/root.bib @@ -0,0 +1,14 @@ +@inproceedings{DBLP:conf/cade/0001T19, + author = {Andrei Popescu and + Dmitriy Traytel}, + editor = {Pascal Fontaine}, + title = {A Formally Verified Abstract Account of {G}{\"{o}}del's Incompleteness + Theorems}, + booktitle = {{CADE} 27}, + series = {LNCS}, + volume = {11716}, + pages = {442--461}, + publisher = {Springer}, + year = {2019}, + doi = {10.1007/978-3-030-29436-6\_26}, +} \ No newline at end of file diff --git a/thys/Syntax_Independent_Logic/document/root.tex b/thys/Syntax_Independent_Logic/document/root.tex new file mode 100644 --- /dev/null +++ b/thys/Syntax_Independent_Logic/document/root.tex @@ -0,0 +1,56 @@ +\documentclass[10pt,a4paper]{report} +\usepackage{isabelle,isabellesym} + +\usepackage{a4wide} +\usepackage[english]{babel} +\usepackage{eufrak} +\usepackage{amssymb} + +% this should be the last package used +\usepackage{pdfsetup} + +% urls in roman style, theory text in math-similar italics +\urlstyle{rm} +\isabellestyle{literal} + + +\begin{document} + +\title{Syntax-Independent Logic Infrastructure} +\author{Andrei Popescu \and Dmitriy Traytel} + +\maketitle + +\begin{abstract} We formalize a notion of logic whose terms and formulas are kept abstract. In particular, +logical connectives, substitution, free variables, and provability are not defined, but characterized by +their general properties as locale assumptions. Based on this abstract characterization, we develop further +reusable reasoning infrastructure. For example, we define parallel substitution (along with proving its +characterizing theorems) from single-point substitution. Similarly, we develop a natural +deduction style proof system starting from the abstract Hilbert-style one. These one-time efforts benefit +different concrete logics satisfying our locales' assumptions. + +We instantiate the syntax-independent logic infrastructure to Robinson arithmetic (also known as Q) in the +AFP entry \href{https://www.isa-afp.org/entries/Robinson_Arithmetic.html}{Robinson\_Arithmetic} and to +hereditarily finite set theory in the AFP entries +\href{https://www.isa-afp.org/entries/Goedel_HFSet_Semantic.html}{Goedel\_HFSet\_Semantic} and +\href{https://www.isa-afp.org/entries/Goedel_HFSet_Semanticless.html}{Goedel\_HFSet\_Semanticless}, which are +part of our formalization of G\"odel's Incompleteness Theorems described in our CADE-27 +paper~\cite{DBLP:conf/cade/0001T19}. \end{abstract} + +\tableofcontents + +% sane default for proof documents +\parindent 0pt\parskip 0.5ex + +% generated text of all theories +\input{session} + +\bibliographystyle{abbrv} +\bibliography{root} + +\end{document} + +%%% Local Variables: +%%% mode: latex +%%% TeX-master: t +%%% End: