From 720da0f918118388d114e09664b129d2b29be2b1 Mon Sep 17 00:00:00 2001 From: Josh Chen Date: Fri, 22 May 2020 15:43:14 +0200 Subject: some tweaks and comments, in preparation for general inductive type elimination --- spartan/lib/elimination.ML | 5 +++++ spartan/lib/focus.ML | 2 +- spartan/lib/tactics.ML | 3 +-- spartan/theories/Equivalence.thy | 8 ++++---- spartan/theories/Identity.thy | 13 +++++++------ spartan/theories/Spartan.thy | 7 +++---- 6 files changed, 21 insertions(+), 17 deletions(-) (limited to 'spartan') diff --git a/spartan/lib/elimination.ML b/spartan/lib/elimination.ML index 85ce669..bd23c94 100644 --- a/spartan/lib/elimination.ML +++ b/spartan/lib/elimination.ML @@ -6,6 +6,7 @@ Type elimination automation. structure Elim = struct +(** Context data **) (* Elimination rule data *) structure Rules = Generic_Data ( type T = thm Termtab.table @@ -30,4 +31,8 @@ val _ = Theory.setup ( fn context => (rules (Context.proof_of context))) ) +(** General elimination-induction tactic **) + + + end diff --git a/spartan/lib/focus.ML b/spartan/lib/focus.ML index dd8d3d9..1d8de78 100644 --- a/spartan/lib/focus.ML +++ b/spartan/lib/focus.ML @@ -105,7 +105,7 @@ val schematic_subgoal_cmd = gen_schematic_subgoal Attrib.attribute_cmd val parser = opt_fact_binding - -- (Scan.option (\<^keyword>\premises\ |-- Parse.!!! opt_fact_binding)) + -- (Scan.option (\<^keyword>\prems\ |-- Parse.!!! opt_fact_binding)) -- for_params >> (fn ((a, b), c) => Toplevel.proofs (Seq.make_results o Seq.single o #2 o schematic_subgoal_cmd a b c)) diff --git a/spartan/lib/tactics.ML b/spartan/lib/tactics.ML index 0e09533..c72947a 100644 --- a/spartan/lib/tactics.ML +++ b/spartan/lib/tactics.ML @@ -104,8 +104,7 @@ fun intro_tac ctxt = SUBGOAL (fn (_, i) => SIDE_CONDS fun intros_tac ctxt = SUBGOAL (fn (_, i) => (CHANGED o REPEAT o CHANGED o intro_tac ctxt) i) -(* Basic elimination tactic *) -(*Only uses existing type judgments from the context +(*Basic elimination tactic, only uses existing type judgments from the context (performs no type synthesis)*) fun elims_tac opt_tm ctxt = case opt_tm of NONE => SUBGOAL (fn (_, i) => eresolve_tac ctxt (Elim.rules ctxt) i) diff --git a/spartan/theories/Equivalence.thy b/spartan/theories/Equivalence.thy index 44b77dd..97cd18d 100644 --- a/spartan/theories/Equivalence.thy +++ b/spartan/theories/Equivalence.thy @@ -197,7 +197,7 @@ Lemma (derive) funcomp_qinv: shows "qinv f \ qinv g \ qinv (g \ f)" apply (intros, unfold qinv_def, elims) focus - premises hyps + prems prms vars _ _ finv _ ginv _ HfA HfB HgB HgC apply intro @@ -246,7 +246,7 @@ Lemma (derive) biinv_imp_qinv: apply elims text \Name the components:\ - focus premises vars _ _ _ g H1 h H2 + focus prems vars _ _ _ g H1 h H2 thm \g:_\ \h:_\ \H1:_\ \H2:_\ text \ @@ -384,14 +384,14 @@ Lemma (derive) id_imp_equiv: supply [[auto_typechk=false]] \ apply (equality \p:_\) - \<^item> premises vars A B + \<^item> prems vars A B apply (rewrite at A in "A \ B" id_comp[symmetric]) apply (rewrite at B in "_ \ B" id_comp[symmetric]) apply (rule transport, rule U_in_U) apply (rule lift_universe_codomain, rule U_in_U) apply (typechk, rule U_in_U) done - \<^item> premises vars A + \<^item> prems vars A apply (subst transport_comp) \<^enum> by (rule U_in_U) \<^enum> by reduce (rule lift_universe) diff --git a/spartan/theories/Identity.thy b/spartan/theories/Identity.thy index 19b8b7a..4a4cc40 100644 --- a/spartan/theories/Identity.thy +++ b/spartan/theories/Identity.thy @@ -15,7 +15,7 @@ axiomatization refl :: \o \ o\ and IdInd :: \o \ (o \ o \ o \ o) \ (o \ o) \ o \ o \ o \ o\ -syntax "_Id" :: \o \ o \ o \ o\ ("(2_ =\<^bsub>_\<^esub>/ _)" [111, 0, 111] 110) +syntax "_Id" :: \o \ o \ o \ o\ ("(2_ =\<^bsub>_\<^esub>/ _)" [111, 0, 111] 110) translations "a =\<^bsub>A\<^esub> b" \ "CONST Id A a b" @@ -71,7 +71,7 @@ Lemma (derive) pathcomp: shows "x =\<^bsub>A\<^esub> z" apply (equality \p:_\) - focus premises vars x p + focus prems vars x p apply (equality \p:_\) apply intro done @@ -158,9 +158,9 @@ Lemma (derive) pathcomp_assoc: "p: x =\<^bsub>A\<^esub> y" "q: y =\<^bsub>A\<^esub> z" "r: z =\<^bsub>A\<^esub> w" shows "p \ (q \ r) = p \ q \ r" apply (equality \p:_\) - focus premises vars x p + focus prems vars x p apply (equality \p:_\) - focus premises vars x p + focus prems vars x p apply (equality \p:_\) apply (reduce; intros) done @@ -200,7 +200,7 @@ Lemma (derive) ap_pathcomp: shows "f[p \ q] = f[p] \ f[q]" apply (equality \p:_\) - focus premises vars x p + focus prems vars x p apply (equality \p:_\) apply (reduce; intro) done @@ -302,7 +302,7 @@ Lemma (derive) transport_pathcomp: "p: x =\<^bsub>A\<^esub> y" "q: y =\<^bsub>A\<^esub> z" shows "trans P q (trans P p u) = trans P (p \ q) u" apply (equality \p:_\) - focus premises vars x p + focus prems vars x p apply (equality \p:_\) apply (reduce; intros) done @@ -430,4 +430,5 @@ Lemma (derive) apd_ap: shows "apd f p = trans_const B p (f x) \ f[p]" by (equality \p:_\) (reduce; intro) + end diff --git a/spartan/theories/Spartan.thy b/spartan/theories/Spartan.thy index a79f209..5274ea2 100644 --- a/spartan/theories/Spartan.thy +++ b/spartan/theories/Spartan.thy @@ -8,7 +8,7 @@ imports keywords "Theorem" "Lemma" "Corollary" "Proposition" :: thy_goal_stmt and "focus" "\" "\<^item>" "\<^enum>" "~" :: prf_script_goal % "proof" and - "derive" "vars":: quasi_command and + "derive" "prems" "vars":: quasi_command and "print_coercions" :: thy_decl begin @@ -138,9 +138,6 @@ axiomatization where \ \ \x: A. B x \ \x: A. B' x" - - - section \Proof commands\ named_theorems typechk @@ -152,6 +149,7 @@ ML_file \../lib/focus.ML\ section \Congruence automation\ +(*Work in progress*) ML_file \../lib/congruence.ML\ @@ -188,6 +186,7 @@ method_setup elim = method elims = elim+ +(*This could possibly use additional simplification hints via a simp: modifier*) method_setup typechk = \Scan.succeed (fn ctxt => SIMPLE_METHOD ( CHANGED (ALLGOALS (TRY o typechk_tac ctxt))))\ -- cgit v1.2.3