--- a/src/CCL/CCL.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/CCL/CCL.thy Fri Jan 04 23:22:53 2019 +0100
@@ -267,10 +267,10 @@
val ccl_dstncts =
let
fun mk_raw_dstnct_thm rls s =
- Goal.prove_global @{theory} [] [] (Syntax.read_prop_global @{theory} s)
+ Goal.prove_global \<^theory> [] [] (Syntax.read_prop_global \<^theory> s)
(fn {context = ctxt, ...} => resolve_tac ctxt @{thms notI} 1 THEN eresolve_tac ctxt rls 1)
in map (mk_raw_dstnct_thm caseB_lemmas)
- (mk_dstnct_rls @{theory} ["bot","true","false","pair","lambda"]) end
+ (mk_dstnct_rls \<^theory> ["bot","true","false","pair","lambda"]) end
fun mk_dstnct_thms ctxt defs inj_rls xs =
let
--- a/src/CCL/Term.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/CCL/Term.thy Fri Jan 04 23:22:53 2019 +0100
@@ -79,30 +79,30 @@
(* FIXME does not handle "_idtdummy" *)
(* FIXME should use Syntax_Trans.mark_bound, Syntax_Trans.variant_abs' *)
-fun let_tr [Free x, a, b] = Const(@{const_syntax let},dummyT) $ a $ absfree x b;
+fun let_tr [Free x, a, b] = Const(\<^const_syntax>\<open>let\<close>,dummyT) $ a $ absfree x b;
fun let_tr' [a,Abs(id,T,b)] =
let val (id',b') = Syntax_Trans.variant_abs(id,T,b)
- in Const(@{syntax_const "_let"},dummyT) $ Free(id',T) $ a $ b' end;
+ in Const(\<^syntax_const>\<open>_let\<close>,dummyT) $ Free(id',T) $ a $ b' end;
fun letrec_tr [Free f, Free x, a, b] =
- Const(@{const_syntax letrec}, dummyT) $ absfree x (absfree f a) $ absfree f b;
+ Const(\<^const_syntax>\<open>letrec\<close>, dummyT) $ absfree x (absfree f a) $ absfree f b;
fun letrec2_tr [Free f, Free x, Free y, a, b] =
- Const(@{const_syntax letrec2}, dummyT) $ absfree x (absfree y (absfree f a)) $ absfree f b;
+ Const(\<^const_syntax>\<open>letrec2\<close>, dummyT) $ absfree x (absfree y (absfree f a)) $ absfree f b;
fun letrec3_tr [Free f, Free x, Free y, Free z, a, b] =
- Const(@{const_syntax letrec3}, dummyT) $
+ Const(\<^const_syntax>\<open>letrec3\<close>, dummyT) $
absfree x (absfree y (absfree z (absfree f a))) $ absfree f b;
fun letrec_tr' [Abs(x,T,Abs(f,S,a)),Abs(ff,SS,b)] =
let val (f',b') = Syntax_Trans.variant_abs(ff,SS,b)
val (_,a'') = Syntax_Trans.variant_abs(f,S,a)
val (x',a') = Syntax_Trans.variant_abs(x,T,a'')
- in Const(@{syntax_const "_letrec"},dummyT) $ Free(f',SS) $ Free(x',T) $ a' $ b' end;
+ in Const(\<^syntax_const>\<open>_letrec\<close>,dummyT) $ Free(f',SS) $ Free(x',T) $ a' $ b' end;
fun letrec2_tr' [Abs(x,T,Abs(y,U,Abs(f,S,a))),Abs(ff,SS,b)] =
let val (f',b') = Syntax_Trans.variant_abs(ff,SS,b)
val ( _,a1) = Syntax_Trans.variant_abs(f,S,a)
val (y',a2) = Syntax_Trans.variant_abs(y,U,a1)
val (x',a') = Syntax_Trans.variant_abs(x,T,a2)
- in Const(@{syntax_const "_letrec2"},dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ a' $ b'
+ in Const(\<^syntax_const>\<open>_letrec2\<close>,dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ a' $ b'
end;
fun letrec3_tr' [Abs(x,T,Abs(y,U,Abs(z,V,Abs(f,S,a)))),Abs(ff,SS,b)] =
let val (f',b') = Syntax_Trans.variant_abs(ff,SS,b)
@@ -110,22 +110,22 @@
val (z',a2) = Syntax_Trans.variant_abs(z,V,a1)
val (y',a3) = Syntax_Trans.variant_abs(y,U,a2)
val (x',a') = Syntax_Trans.variant_abs(x,T,a3)
- in Const(@{syntax_const "_letrec3"},dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ Free(z',V) $ a' $ b'
+ in Const(\<^syntax_const>\<open>_letrec3\<close>,dummyT) $ Free(f',SS) $ Free(x',T) $ Free(y',U) $ Free(z',V) $ a' $ b'
end;
\<close>
parse_translation \<open>
- [(@{syntax_const "_let"}, K let_tr),
- (@{syntax_const "_letrec"}, K letrec_tr),
- (@{syntax_const "_letrec2"}, K letrec2_tr),
- (@{syntax_const "_letrec3"}, K letrec3_tr)]
+ [(\<^syntax_const>\<open>_let\<close>, K let_tr),
+ (\<^syntax_const>\<open>_letrec\<close>, K letrec_tr),
+ (\<^syntax_const>\<open>_letrec2\<close>, K letrec2_tr),
+ (\<^syntax_const>\<open>_letrec3\<close>, K letrec3_tr)]
\<close>
print_translation \<open>
- [(@{const_syntax let}, K let_tr'),
- (@{const_syntax letrec}, K letrec_tr'),
- (@{const_syntax letrec2}, K letrec2_tr'),
- (@{const_syntax letrec3}, K letrec3_tr')]
+ [(\<^const_syntax>\<open>let\<close>, K let_tr'),
+ (\<^const_syntax>\<open>letrec\<close>, K letrec_tr'),
+ (\<^const_syntax>\<open>letrec2\<close>, K letrec2_tr'),
+ (\<^const_syntax>\<open>letrec3\<close>, K letrec3_tr')]
\<close>
@@ -289,7 +289,7 @@
ML \<open>
ML_Thms.bind_thms ("term_dstncts",
- mkall_dstnct_thms @{context} @{thms data_defs} (@{thms ccl_injs} @ @{thms term_injs})
+ mkall_dstnct_thms \<^context> @{thms data_defs} (@{thms ccl_injs} @ @{thms term_injs})
[["bot","inl","inr"], ["bot","zero","succ"], ["bot","nil","cons"]]);
\<close>
--- a/src/CCL/Type.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/CCL/Type.thy Fri Jan 04 23:22:53 2019 +0100
@@ -43,10 +43,10 @@
"SUM x:A. B" \<rightharpoonup> "CONST Sigma(A, \<lambda>x. B)"
"A * B" \<rightharpoonup> "CONST Sigma(A, \<lambda>_. B)"
print_translation \<open>
- [(@{const_syntax Pi},
- fn _ => Syntax_Trans.dependent_tr' (@{syntax_const "_Pi"}, @{syntax_const "_arrow"})),
- (@{const_syntax Sigma},
- fn _ => Syntax_Trans.dependent_tr' (@{syntax_const "_Sigma"}, @{syntax_const "_star"}))]
+ [(\<^const_syntax>\<open>Pi\<close>,
+ fn _ => Syntax_Trans.dependent_tr' (\<^syntax_const>\<open>_Pi\<close>, \<^syntax_const>\<open>_arrow\<close>)),
+ (\<^const_syntax>\<open>Sigma\<close>,
+ fn _ => Syntax_Trans.dependent_tr' (\<^syntax_const>\<open>_Sigma\<close>, \<^syntax_const>\<open>_star\<close>))]
\<close>
definition Nat :: "i set"
--- a/src/CCL/Wfd.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/CCL/Wfd.thy Fri Jan 04 23:22:53 2019 +0100
@@ -413,13 +413,13 @@
@{thms canTs} @ @{thms icanTs} @ @{thms applyT2} @ @{thms ncanTs} @ @{thms incanTs} @
@{thms precTs} @ @{thms letrecTs} @ @{thms letT} @ @{thms Subtype_canTs};
-fun bvars (Const(@{const_name Pure.all},_) $ Abs(s,_,t)) l = bvars t (s::l)
+fun bvars (Const(\<^const_name>\<open>Pure.all\<close>,_) $ Abs(s,_,t)) l = bvars t (s::l)
| bvars _ l = l
-fun get_bno l n (Const(@{const_name Pure.all},_) $ Abs(s,_,t)) = get_bno (s::l) n t
- | get_bno l n (Const(@{const_name Trueprop},_) $ t) = get_bno l n t
- | get_bno l n (Const(@{const_name Ball},_) $ _ $ Abs(s,_,t)) = get_bno (s::l) (n+1) t
- | get_bno l n (Const(@{const_name mem},_) $ t $ _) = get_bno l n t
+fun get_bno l n (Const(\<^const_name>\<open>Pure.all\<close>,_) $ Abs(s,_,t)) = get_bno (s::l) n t
+ | get_bno l n (Const(\<^const_name>\<open>Trueprop\<close>,_) $ t) = get_bno l n t
+ | get_bno l n (Const(\<^const_name>\<open>Ball\<close>,_) $ _ $ Abs(s,_,t)) = get_bno (s::l) (n+1) t
+ | get_bno l n (Const(\<^const_name>\<open>mem\<close>,_) $ t $ _) = get_bno l n t
| get_bno l n (t $ s) = get_bno l n t
| get_bno l n (Bound m) = (m-length(l),n)
@@ -441,7 +441,7 @@
fun is_rigid_prog t =
(case (Logic.strip_assums_concl t) of
- (Const(@{const_name Trueprop},_) $ (Const(@{const_name mem},_) $ a $ _)) =>
+ (Const(\<^const_name>\<open>Trueprop\<close>,_) $ (Const(\<^const_name>\<open>mem\<close>,_) $ a $ _)) =>
null (Term.add_vars a [])
| _ => false)
@@ -500,7 +500,7 @@
ML \<open>
fun eval_tac ths =
Subgoal.FOCUS_PREMS (fn {context = ctxt, prems, ...} =>
- let val eval_rules = Named_Theorems.get ctxt @{named_theorems eval}
+ let val eval_rules = Named_Theorems.get ctxt \<^named_theorems>\<open>eval\<close>
in DEPTH_SOLVE_1 (resolve_tac ctxt (ths @ prems @ rev eval_rules) 1) end)
\<close>
@@ -524,8 +524,8 @@
apply (unfold let_def)
apply (rule 1 [THEN canonical])
apply (tactic \<open>
- REPEAT (DEPTH_SOLVE_1 (resolve_tac @{context} (@{thms assms} @ @{thms eval_rls}) 1 ORELSE
- eresolve_tac @{context} @{thms substitute} 1))\<close>)
+ REPEAT (DEPTH_SOLVE_1 (resolve_tac \<^context> (@{thms assms} @ @{thms eval_rls}) 1 ORELSE
+ eresolve_tac \<^context> @{thms substitute} 1))\<close>)
done
lemma fixV: "f(fix(f)) \<longlongrightarrow> c \<Longrightarrow> fix(f) \<longlongrightarrow> c"
--- a/src/CCL/ex/Stream.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/CCL/ex/Stream.thy Fri Jan 04 23:22:53 2019 +0100
@@ -82,8 +82,8 @@
apply EQgen
prefer 2
apply blast
- apply (tactic \<open>DEPTH_SOLVE (eresolve_tac @{context} [XH_to_E @{thm ListsXH}] 1
- THEN EQgen_tac @{context} [] 1)\<close>)
+ apply (tactic \<open>DEPTH_SOLVE (eresolve_tac \<^context> [XH_to_E @{thm ListsXH}] 1
+ THEN EQgen_tac \<^context> [] 1)\<close>)
done
--- a/src/CTT/CTT.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/CTT/CTT.thy Fri Jan 04 23:22:53 2019 +0100
@@ -304,9 +304,9 @@
ML \<open>
local
-fun is_rigid_elem (Const(@{const_name Elem},_) $ a $ _) = not(is_Var (head_of a))
- | is_rigid_elem (Const(@{const_name Eqelem},_) $ a $ _ $ _) = not(is_Var (head_of a))
- | is_rigid_elem (Const(@{const_name Type},_) $ a) = not(is_Var (head_of a))
+fun is_rigid_elem (Const(\<^const_name>\<open>Elem\<close>,_) $ a $ _) = not(is_Var (head_of a))
+ | is_rigid_elem (Const(\<^const_name>\<open>Eqelem\<close>,_) $ a $ _ $ _) = not(is_Var (head_of a))
+ | is_rigid_elem (Const(\<^const_name>\<open>Type\<close>,_) $ a) = not(is_Var (head_of a))
| is_rigid_elem _ = false
in
--- a/src/CTT/ex/Elimination.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/CTT/ex/Elimination.thy Fri Jan 04 23:22:53 2019 +0100
@@ -180,7 +180,7 @@
and "\<And>z. z:A \<times> B \<Longrightarrow> C(z) type"
shows "?a : (\<Sum>z:A \<times> B. C(z)) \<longrightarrow> (\<Sum>u:A. \<Sum>v:B. C(<u,v>))"
apply (rule intr_rls)
-apply (tactic \<open>biresolve_tac @{context} safe_brls 2\<close>)
+apply (tactic \<open>biresolve_tac \<^context> safe_brls 2\<close>)
(*Now must convert assumption C(z) into antecedent C(<kd,ke>) *)
apply (rule_tac [2] a = "y" in ProdE)
apply (typechk assms)
--- a/src/CTT/ex/Equality.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/CTT/ex/Equality.thy Fri Jan 04 23:22:53 2019 +0100
@@ -47,7 +47,7 @@
lemma "p : Sum(A,B) \<Longrightarrow> <split(p,\<lambda>x y. x), split(p,\<lambda>x y. y)> = p : Sum(A,B)"
apply (rule EqE)
apply (rule elim_rls, assumption)
-apply (tactic \<open>DEPTH_SOLVE_1 (rew_tac @{context} [])\<close>) (*!!!!!!!*)
+apply (tactic \<open>DEPTH_SOLVE_1 (rew_tac \<^context> [])\<close>) (*!!!!!!!*)
done
lemma "\<lbrakk>a : A; b : B\<rbrakk> \<Longrightarrow> (\<^bold>\<lambda>u. split(u, \<lambda>v w.<w,v>)) ` <a,b> = <b,a> : \<Sum>x:B. A"
--- a/src/CTT/ex/Synthesis.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/CTT/ex/Synthesis.thy Fri Jan 04 23:22:53 2019 +0100
@@ -91,10 +91,10 @@
\<times> (\<Prod>y:N. Eq(N, plus`succ(y)`x, succ(plus`y`x)))"
apply intr
apply eqintr
-apply (tactic "resolve_tac @{context} [TSimp.split_eqn] 3")
-apply (tactic "SELECT_GOAL (rew_tac @{context} []) 4")
-apply (tactic "resolve_tac @{context} [TSimp.split_eqn] 3")
-apply (tactic "SELECT_GOAL (rew_tac @{context} []) 4")
+apply (tactic "resolve_tac \<^context> [TSimp.split_eqn] 3")
+apply (tactic "SELECT_GOAL (rew_tac \<^context> []) 4")
+apply (tactic "resolve_tac \<^context> [TSimp.split_eqn] 3")
+apply (tactic "SELECT_GOAL (rew_tac \<^context> []) 4")
apply (rule_tac [3] p = "y" in NC_succ)
(** by (resolve_tac @{context} comp_rls 3); caused excessive branching **)
apply rew
--- a/src/Cube/Cube.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Cube/Cube.thy Fri Jan 04 23:22:53 2019 +0100
@@ -49,8 +49,8 @@
"\<Prod>x:A. B" \<rightharpoonup> "CONST Prod(A, \<lambda>x. B)"
"A \<rightarrow> B" \<rightharpoonup> "CONST Prod(A, \<lambda>_. B)"
print_translation \<open>
- [(@{const_syntax Prod},
- fn _ => Syntax_Trans.dependent_tr' (@{syntax_const "_Pi"}, @{syntax_const "_arrow"}))]
+ [(\<^const_syntax>\<open>Prod\<close>,
+ fn _ => Syntax_Trans.dependent_tr' (\<^syntax_const>\<open>_Pi\<close>, \<^syntax_const>\<open>_arrow\<close>))]
\<close>
axiomatization where
--- a/src/Doc/Isar_Ref/First_Order_Logic.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Doc/Isar_Ref/First_Order_Logic.thy Fri Jan 04 23:22:53 2019 +0100
@@ -20,8 +20,8 @@
text \<open>
Note that the object-logic judgment is implicit in the syntax: writing
- @{prop A} produces @{term "Trueprop A"} internally. From the Pure
- perspective this means ``@{prop A} is derivable in the object-logic''.
+ \<^prop>\<open>A\<close> produces \<^term>\<open>Trueprop A\<close> internally. From the Pure
+ perspective this means ``\<^prop>\<open>A\<close> is derivable in the object-logic''.
\<close>
@@ -41,7 +41,7 @@
text \<open>
Substitution is very powerful, but also hard to control in full generality.
- We derive some common symmetry~/ transitivity schemes of @{term equal} as
+ We derive some common symmetry~/ transitivity schemes of \<^term>\<open>equal\<close> as
particular consequences.
\<close>
@@ -182,10 +182,9 @@
and conjD\<^sub>2: "A \<and> B \<Longrightarrow> B"
text \<open>
- The conjunctive destructions have the disadvantage that decomposing @{prop
- "A \<and> B"} involves an immediate decision which component should be projected.
- The more convenient simultaneous elimination @{prop "A \<and> B \<Longrightarrow> (A \<Longrightarrow> B \<Longrightarrow> C) \<Longrightarrow>
- C"} can be derived as follows:
+ The conjunctive destructions have the disadvantage that decomposing \<^prop>\<open>A \<and> B\<close> involves an immediate decision which component should be projected.
+ The more convenient simultaneous elimination \<^prop>\<open>A \<and> B \<Longrightarrow> (A \<Longrightarrow> B \<Longrightarrow> C) \<Longrightarrow>
+ C\<close> can be derived as follows:
\<close>
theorem conjE [elim]:
@@ -300,8 +299,8 @@
These examples illustrate both classical reasoning and non-trivial
propositional proofs in general. All three rules characterize classical
logic independently, but the original rule is already the most convenient to
- use, because it leaves the conclusion unchanged. Note that @{prop "(\<not> C \<Longrightarrow> C)
- \<Longrightarrow> C"} fits again into our format for eliminations, despite the additional
+ use, because it leaves the conclusion unchanged. Note that \<^prop>\<open>(\<not> C \<Longrightarrow> C)
+ \<Longrightarrow> C\<close> fits again into our format for eliminations, despite the additional
twist that the context refers to the main conclusion. So we may write @{thm
classical} as the Isar statement ``\<^theory_text>\<open>obtains \<not> thesis\<close>''. This also explains
nicely how classical reasoning really works: whatever the main \<open>thesis\<close>
@@ -317,7 +316,7 @@
Representing quantifiers is easy, thanks to the higher-order nature of the
underlying framework. According to the well-known technique introduced by
Church @{cite "church40"}, quantifiers are operators on predicates, which
- are syntactically represented as \<open>\<lambda>\<close>-terms of type @{typ "i \<Rightarrow> o"}. Binder
+ are syntactically represented as \<open>\<lambda>\<close>-terms of type \<^typ>\<open>i \<Rightarrow> o\<close>. Binder
notation turns \<open>All (\<lambda>x. B x)\<close> into \<open>\<forall>x. B x\<close> etc.
\<close>
--- a/src/Doc/Logics_ZF/IFOL_examples.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Doc/Logics_ZF/IFOL_examples.thy Fri Jan 04 23:22:53 2019 +0100
@@ -36,7 +36,7 @@
done
lemma "(EX y. ALL x. Q(x,y)) --> (ALL x. EX y. Q(x,y))"
-by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>Example of Dyckhoff's method\<close>
lemma "~ ~ ((P-->Q) | (Q-->P))"
--- a/src/Doc/Logics_ZF/ZF_Isar.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Doc/Logics_ZF/ZF_Isar.thy Fri Jan 04 23:22:53 2019 +0100
@@ -23,9 +23,9 @@
@{attribute_def (ZF) TC} & : & \<open>attribute\<close> \\
\end{matharray}
- @{rail \<open>
+ \<^rail>\<open>
@@{attribute (ZF) TC} (() | 'add' | 'del')
- \<close>}
+ \<close>
\begin{description}
@@ -58,7 +58,7 @@
@{command_def (ZF) "codatatype"} & : & \<open>theory \<rightarrow> theory\<close> \\
\end{matharray}
- @{rail \<open>
+ \<^rail>\<open>
(@@{command (ZF) inductive} | @@{command (ZF) coinductive}) domains intros hints
;
@@ -76,11 +76,11 @@
@{syntax_def (ZF) typeintros}: @'type_intros' @{syntax thms}
;
@{syntax_def (ZF) typeelims}: @'type_elims' @{syntax thms}
- \<close>}
+ \<close>
In the following syntax specification \<open>monos\<close>, \<open>typeintros\<close>, and \<open>typeelims\<close> are the same as above.
- @{rail \<open>
+ \<^rail>\<open>
(@@{command (ZF) datatype} | @@{command (ZF) codatatype}) domain? (dtspec + @'and') hints
;
@@ -91,7 +91,7 @@
con: @{syntax name} ('(' (@{syntax term} ',' +) ')')?
;
hints: @{syntax (ZF) "monos"}? @{syntax (ZF) typeintros}? @{syntax (ZF) typeelims}?
- \<close>}
+ \<close>
See @{cite "isabelle-ZF"} for further information on inductive
definitions in ZF, but note that this covers the old-style theory
@@ -106,9 +106,9 @@
@{command_def (ZF) "primrec"} & : & \<open>theory \<rightarrow> theory\<close> \\
\end{matharray}
- @{rail \<open>
+ \<^rail>\<open>
@@{command (ZF) primrec} (@{syntax thmdecl}? @{syntax prop} +)
- \<close>}
+ \<close>
\<close>
@@ -125,13 +125,13 @@
@{command_def (ZF) "inductive_cases"} & : & \<open>theory \<rightarrow> theory\<close> \\
\end{matharray}
- @{rail \<open>
+ \<^rail>\<open>
(@@{method (ZF) case_tac} | @@{method (ZF) induct_tac}) @{syntax goal_spec}? @{syntax name}
;
@@{method (ZF) ind_cases} (@{syntax prop} +)
;
@@{command (ZF) inductive_cases} (@{syntax thmdecl}? (@{syntax prop} +) + @'and')
- \<close>}
+ \<close>
\<close>
end
--- a/src/Doc/System/Environment.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Doc/System/Environment.thy Fri Jan 04 23:22:53 2019 +0100
@@ -55,7 +55,7 @@
variables. When installing the system, only a few of these may have to be
adapted (probably @{setting ML_SYSTEM} etc.).
- \<^enum> The file @{path "$ISABELLE_HOME_USER/etc/settings"} (if it
+ \<^enum> The file \<^path>\<open>$ISABELLE_HOME_USER/etc/settings\<close> (if it
exists) is run in the same way as the site default settings. Note that the
variable @{setting ISABELLE_HOME_USER} has already been set before ---
usually to something like \<^verbatim>\<open>$USER_HOME/.isabelle/Isabelle2018\<close>.
@@ -95,7 +95,7 @@
On Unix systems this is usually the same as @{setting HOME}, but on Windows
it is the regular home directory of the user, not the one of within the
Cygwin root file-system.\<^footnote>\<open>Cygwin itself offers another choice whether its
- HOME should point to the @{path "/home"} directory tree or the Windows user
+ HOME should point to the \<^path>\<open>/home\<close> directory tree or the Windows user
home.\<close>
\<^descr>[@{setting_def ISABELLE_HOME}\<open>\<^sup>*\<close>] is the location of the top-level
@@ -104,8 +104,7 @@
ISABELLE_HOME} yourself from the shell!
\<^descr>[@{setting_def ISABELLE_HOME_USER}] is the user-specific counterpart of
- @{setting ISABELLE_HOME}. The default value is relative to @{path
- "$USER_HOME/.isabelle"}, under rare circumstances this may be changed in the
+ @{setting ISABELLE_HOME}. The default value is relative to \<^path>\<open>$USER_HOME/.isabelle\<close>, under rare circumstances this may be changed in the
global setting file. Typically, the @{setting ISABELLE_HOME_USER} directory
mimics @{setting ISABELLE_HOME} to some extend. In particular, site-wide
defaults may be overridden by a private \<^verbatim>\<open>$ISABELLE_HOME_USER/etc/settings\<close>.
@@ -177,15 +176,14 @@
\<^descr>[@{setting_def ISABELLE_BROWSER_INFO}] is the directory where HTML and PDF
browser information is stored (see also \secref{sec:info}); its default is
- @{path "$ISABELLE_HOME_USER/browser_info"}. For ``system build mode'' (see
+ \<^path>\<open>$ISABELLE_HOME_USER/browser_info\<close>. For ``system build mode'' (see
\secref{sec:tool-build}), @{setting_def ISABELLE_BROWSER_INFO_SYSTEM} is
- used instead; its default is @{path "$ISABELLE_HOME/browser_info"}.
+ used instead; its default is \<^path>\<open>$ISABELLE_HOME/browser_info\<close>.
\<^descr>[@{setting_def ISABELLE_HEAPS}] is the directory where session heap images,
- log files, and build databases are stored; its default is @{path
- "$ISABELLE_HOME_USER/heaps"}. For ``system build mode'' (see
+ log files, and build databases are stored; its default is \<^path>\<open>$ISABELLE_HOME_USER/heaps\<close>. For ``system build mode'' (see
\secref{sec:tool-build}), @{setting_def ISABELLE_HEAPS_SYSTEM} is used
- instead; its default is @{path "$ISABELLE_HOME/heaps"}.
+ instead; its default is \<^path>\<open>$ISABELLE_HOME/heaps\<close>.
\<^descr>[@{setting_def ISABELLE_LOGIC}] specifies the default logic to load if none
is given explicitely by the user. The default value is \<^verbatim>\<open>HOL\<close>.
@@ -249,8 +247,7 @@
The root of component initialization is @{setting ISABELLE_HOME} itself.
After initializing all of its sub-components recursively, @{setting
ISABELLE_HOME_USER} is included in the same manner (if that directory
- exists). This allows to install private components via @{path
- "$ISABELLE_HOME_USER/etc/components"}, although it is often more convenient
+ exists). This allows to install private components via \<^path>\<open>$ISABELLE_HOME_USER/etc/components\<close>, although it is often more convenient
to do that programmatically via the \<^verbatim>\<open>init_component\<close> shell function in the
\<^verbatim>\<open>etc/settings\<close> script of \<^verbatim>\<open>$ISABELLE_HOME_USER\<close> (or any other component
directory). For example:
@@ -361,7 +358,7 @@
\<^medskip>
Option \<^verbatim>\<open>-T\<close> loads a specified theory file. This is a wrapper for \<^verbatim>\<open>-e\<close> with
- a suitable @{ML use_thy} invocation.
+ a suitable \<^ML>\<open>use_thy\<close> invocation.
\<^medskip>
Option \<^verbatim>\<open>-l\<close> specifies the logic session name. Option \<^verbatim>\<open>-d\<close> specifies
@@ -443,8 +440,8 @@
The user is connected to the raw ML toplevel loop: this is neither
Isabelle/Isar nor Isabelle/ML within the usual formal context. The most
- relevant ML commands at this stage are @{ML use} (for ML files) and
- @{ML use_thy} (for theory files).
+ relevant ML commands at this stage are \<^ML>\<open>use\<close> (for ML files) and
+ \<^ML>\<open>use_thy\<close> (for theory files).
\<close>
--- a/src/Doc/System/Server.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Doc/System/Server.thy Fri Jan 04 23:22:53 2019 +0100
@@ -17,7 +17,7 @@
In contrast, the Isabelle server exposes Isabelle/Scala as a
``terminate-stay-resident'' application that manages multiple logic
\<^emph>\<open>sessions\<close> and concurrent tasks to use \<^emph>\<open>theories\<close>. This provides an
- analogous to @{ML Thy_Info.use_theories} in Isabelle/ML, but with full
+ analogous to \<^ML>\<open>Thy_Info.use_theories\<close> in Isabelle/ML, but with full
concurrency and Isabelle/PIDE markup.
The client/server arrangement via TCP sockets also opens possibilities for
@@ -48,7 +48,7 @@
The main operation of \<^verbatim>\<open>isabelle server\<close> is to ensure that a named server is
running, either by finding an already running process (according to the
- central database file @{path "$ISABELLE_HOME_USER/servers.db"}) or by
+ central database file \<^path>\<open>$ISABELLE_HOME_USER/servers.db\<close>) or by
becoming itself a new server that accepts connections on a particular TCP
socket. The server name and its address are printed as initial output line.
If another server instance is already running, the current
@@ -464,7 +464,7 @@
string, id?: long}\<close> describes a source position within Isabelle text. Only
the \<open>line\<close> and \<open>file\<close> fields make immediate sense to external programs.
Detailed \<open>offset\<close> and \<open>end_offset\<close> positions are counted according to
- Isabelle symbols, see @{ML_type Symbol.symbol} in Isabelle/ML @{cite
+ Isabelle symbols, see \<^ML_type>\<open>Symbol.symbol\<close> in Isabelle/ML @{cite
"isabelle-implementation"}. The position \<open>id\<close> belongs to the representation
of command transactions in the Isabelle/PIDE protocol: it normally does not
occur in externalized positions.
@@ -724,8 +724,7 @@
in a robust manner, instead of relying on directory locations.
\<^medskip>
- If \<open>system_mode\<close> is \<^verbatim>\<open>true\<close>, session images are stored in @{path
- "$ISABELLE_HEAPS_SYSTEM"} instead of @{path "$ISABELLE_HEAPS"}. See also
+ If \<open>system_mode\<close> is \<^verbatim>\<open>true\<close>, session images are stored in \<^path>\<open>$ISABELLE_HEAPS_SYSTEM\<close> instead of \<^path>\<open>$ISABELLE_HEAPS\<close>. See also
option \<^verbatim>\<open>-s\<close> in @{tool build} (\secref{sec:tool-build}).
\<^medskip>
--- a/src/Doc/System/Sessions.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Doc/System/Sessions.thy Fri Jan 04 23:22:53 2019 +0100
@@ -48,7 +48,7 @@
\<^verbatim>\<open>isabelle-root\<close> for session ROOT files, which is enabled by default for any
file of that name.
- @{rail \<open>
+ \<^rail>\<open>
@{syntax_def session_chapter}: @'chapter' @{syntax name}
;
@@ -77,7 +77,7 @@
document_files: @'document_files' ('(' dir ')')? (@{syntax embedded}+)
;
export_files: @'export_files' ('(' dir ')')? (@{syntax embedded}+)
- \<close>}
+ \<close>
\<^descr> \isakeyword{session}~\<open>A = B + body\<close> defines a new session \<open>A\<close> based on
parent session \<open>B\<close>, with its content given in \<open>body\<close> (imported sessions and
@@ -237,7 +237,7 @@
\<^item> @{system_option_def "profiling"} specifies a mode for global ML
profiling. Possible values are the empty string (disabled), \<^verbatim>\<open>time\<close> for
- @{ML profile_time} and \<^verbatim>\<open>allocations\<close> for @{ML profile_allocations}.
+ \<^ML>\<open>profile_time\<close> and \<^verbatim>\<open>allocations\<close> for \<^ML>\<open>profile_allocations\<close>.
Results appear near the bottom of the session log file.
The @{tool_def options} tool prints Isabelle system options. Its
@@ -396,8 +396,7 @@
\<^medskip>
Option \<^verbatim>\<open>-s\<close> enables \<^emph>\<open>system mode\<close>, which means that session images are
- stored in @{path "$ISABELLE_HEAPS_SYSTEM"} instead of @{path
- "$ISABELLE_HEAPS"}.
+ stored in \<^path>\<open>$ISABELLE_HEAPS_SYSTEM\<close> instead of \<^path>\<open>$ISABELLE_HEAPS\<close>.
\<^medskip>
Option \<^verbatim>\<open>-v\<close> increases the general level of verbosity. Option \<^verbatim>\<open>-l\<close> lists
--- a/src/Doc/antiquote_setup.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Doc/antiquote_setup.ML Fri Jan 04 23:22:53 2019 +0100
@@ -107,12 +107,12 @@
val _ =
Theory.setup
- (index_ml @{binding index_ML} "" ml_val #>
- index_ml @{binding index_ML_op} "infix" ml_op #>
- index_ml @{binding index_ML_type} "type" ml_type #>
- index_ml @{binding index_ML_exception} "exception" ml_exception #>
- index_ml @{binding index_ML_structure} "structure" ml_structure #>
- index_ml @{binding index_ML_functor} "functor" ml_functor);
+ (index_ml \<^binding>\<open>index_ML\<close> "" ml_val #>
+ index_ml \<^binding>\<open>index_ML_op\<close> "infix" ml_op #>
+ index_ml \<^binding>\<open>index_ML_type\<close> "type" ml_type #>
+ index_ml \<^binding>\<open>index_ML_exception\<close> "exception" ml_exception #>
+ index_ml \<^binding>\<open>index_ML_structure\<close> "structure" ml_structure #>
+ index_ml \<^binding>\<open>index_ML_functor\<close> "functor" ml_functor);
end;
@@ -120,7 +120,7 @@
(* named theorems *)
val _ =
- Theory.setup (Thy_Output.antiquotation_raw @{binding named_thms}
+ Theory.setup (Thy_Output.antiquotation_raw \<^binding>\<open>named_thms\<close>
(Scan.repeat (Attrib.thm -- Scan.lift (Args.parens Args.name)))
(fn ctxt =>
map (fn (thm, name) =>
@@ -185,24 +185,24 @@
val _ =
Theory.setup
- (entity_antiqs no_check "" @{binding syntax} #>
- entity_antiqs Outer_Syntax.check_command "isacommand" @{binding command} #>
- entity_antiqs check_keyword "isakeyword" @{binding keyword} #>
- entity_antiqs check_keyword "isakeyword" @{binding element} #>
- entity_antiqs Method.check_name "" @{binding method} #>
- entity_antiqs Attrib.check_name "" @{binding attribute} #>
- entity_antiqs no_check "" @{binding fact} #>
- entity_antiqs no_check "" @{binding variable} #>
- entity_antiqs no_check "" @{binding case} #>
- entity_antiqs Document_Antiquotation.check "" @{binding antiquotation} #>
- entity_antiqs Document_Antiquotation.check_option "" @{binding antiquotation_option} #>
- entity_antiqs no_check "isasystem" @{binding setting} #>
- entity_antiqs check_system_option "isasystem" @{binding system_option} #>
- entity_antiqs no_check "" @{binding inference} #>
- entity_antiqs no_check "isasystem" @{binding executable} #>
- entity_antiqs no_check "isatool" @{binding tool} #>
- entity_antiqs ML_Context.check_antiquotation "" @{binding ML_antiquotation} #>
- entity_antiqs (K JEdit.check_action) "isasystem" @{binding action});
+ (entity_antiqs no_check "" \<^binding>\<open>syntax\<close> #>
+ entity_antiqs Outer_Syntax.check_command "isacommand" \<^binding>\<open>command\<close> #>
+ entity_antiqs check_keyword "isakeyword" \<^binding>\<open>keyword\<close> #>
+ entity_antiqs check_keyword "isakeyword" \<^binding>\<open>element\<close> #>
+ entity_antiqs Method.check_name "" \<^binding>\<open>method\<close> #>
+ entity_antiqs Attrib.check_name "" \<^binding>\<open>attribute\<close> #>
+ entity_antiqs no_check "" \<^binding>\<open>fact\<close> #>
+ entity_antiqs no_check "" \<^binding>\<open>variable\<close> #>
+ entity_antiqs no_check "" \<^binding>\<open>case\<close> #>
+ entity_antiqs Document_Antiquotation.check "" \<^binding>\<open>antiquotation\<close> #>
+ entity_antiqs Document_Antiquotation.check_option "" \<^binding>\<open>antiquotation_option\<close> #>
+ entity_antiqs no_check "isasystem" \<^binding>\<open>setting\<close> #>
+ entity_antiqs check_system_option "isasystem" \<^binding>\<open>system_option\<close> #>
+ entity_antiqs no_check "" \<^binding>\<open>inference\<close> #>
+ entity_antiqs no_check "isasystem" \<^binding>\<open>executable\<close> #>
+ entity_antiqs no_check "isatool" \<^binding>\<open>tool\<close> #>
+ entity_antiqs ML_Context.check_antiquotation "" \<^binding>\<open>ML_antiquotation\<close> #>
+ entity_antiqs (K JEdit.check_action) "isasystem" \<^binding>\<open>action\<close>);
end;
--- a/src/FOL/FOL.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOL/FOL.thy Fri Jan 04 23:22:53 2019 +0100
@@ -155,7 +155,7 @@
fix y y'
assume \<open>P(y)\<close> and \<open>P(y')\<close>
with * have \<open>x = y\<close> and \<open>x = y'\<close>
- by - (tactic "IntPr.fast_tac @{context} 1")+
+ by - (tactic "IntPr.fast_tac \<^context> 1")+
then have \<open>y = y'\<close> by (rule subst)
} note r' = this
show \<open>\<forall>y y'. P(y) \<and> P(y') \<longrightarrow> y = y'\<close>
@@ -190,22 +190,22 @@
(*Propositional rules*)
lemmas [intro!] = refl TrueI conjI disjCI impI notI iffI
and [elim!] = conjE disjE impCE FalseE iffCE
-ML \<open>val prop_cs = claset_of @{context}\<close>
+ML \<open>val prop_cs = claset_of \<^context>\<close>
(*Quantifier rules*)
lemmas [intro!] = allI ex_ex1I
and [intro] = exI
and [elim!] = exE alt_ex1E
and [elim] = allE
-ML \<open>val FOL_cs = claset_of @{context}\<close>
+ML \<open>val FOL_cs = claset_of \<^context>\<close>
ML \<open>
structure Blast = Blast
(
structure Classical = Cla
val Trueprop_const = dest_Const @{const Trueprop}
- val equality_name = @{const_name eq}
- val not_name = @{const_name Not}
+ val equality_name = \<^const_name>\<open>eq\<close>
+ val not_name = \<^const_name>\<open>Not\<close>
val notE = @{thm notE}
val ccontr = @{thm ccontr}
val hyp_subst_tac = Hypsubst.blast_hyp_subst_tac
@@ -343,15 +343,15 @@
ML \<open>
(*intuitionistic simprules only*)
val IFOL_ss =
- put_simpset FOL_basic_ss @{context}
+ put_simpset FOL_basic_ss \<^context>
addsimps @{thms meta_simps IFOL_simps int_ex_simps int_all_simps}
- addsimprocs [@{simproc defined_All}, @{simproc defined_Ex}]
+ addsimprocs [\<^simproc>\<open>defined_All\<close>, \<^simproc>\<open>defined_Ex\<close>]
|> Simplifier.add_cong @{thm imp_cong}
|> simpset_of;
(*classical simprules too*)
val FOL_ss =
- put_simpset IFOL_ss @{context}
+ put_simpset IFOL_ss \<^context>
addsimps @{thms cla_simps cla_ex_simps cla_all_simps}
|> simpset_of;
\<close>
--- a/src/FOL/IFOL.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOL/IFOL.thy Fri Jan 04 23:22:53 2019 +0100
@@ -149,7 +149,7 @@
apply (rule major [THEN spec])
done
-text \<open>Duplicates the quantifier; for use with @{ML eresolve_tac}.\<close>
+text \<open>Duplicates the quantifier; for use with \<^ML>\<open>eresolve_tac\<close>.\<close>
lemma all_dupE:
assumes major: \<open>\<forall>x. P(x)\<close>
and r: \<open>\<lbrakk>P(x); \<forall>x. P(x)\<rbrakk> \<Longrightarrow> R\<close>
@@ -442,7 +442,7 @@
done
text \<open>
- Useful with @{ML eresolve_tac} for proving equalities from known
+ Useful with \<^ML>\<open>eresolve_tac\<close> for proving equalities from known
equalities.
a = b
@@ -499,7 +499,7 @@
text \<open>
Roy Dyckhoff has proved that \<open>conj_impE\<close>, \<open>disj_impE\<close>, and
- \<open>imp_impE\<close> used with @{ML mp_tac} (restricted to atomic formulae) is
+ \<open>imp_impE\<close> used with \<^ML>\<open>mp_tac\<close> (restricted to atomic formulae) is
COMPLETE for intuitionistic propositional logic.
See R. Dyckhoff, Contraction-free sequent calculi for intuitionistic logic
@@ -608,7 +608,7 @@
subsection \<open>Intuitionistic Reasoning\<close>
-setup \<open>Intuitionistic.method_setup @{binding iprover}\<close>
+setup \<open>Intuitionistic.method_setup \<^binding>\<open>iprover\<close>\<close>
lemma impE':
assumes 1: \<open>P \<longrightarrow> Q\<close>
--- a/src/FOL/ex/Intuitionistic.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOL/ex/Intuitionistic.thy Fri Jan 04 23:22:53 2019 +0100
@@ -37,56 +37,56 @@
is intuitionstically equivalent to $P$. [Andy Pitts]\<close>
lemma \<open>\<not> \<not> (P \<and> Q) \<longleftrightarrow> \<not> \<not> P \<and> \<not> \<not> Q\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>\<not> \<not> ((\<not> P \<longrightarrow> Q) \<longrightarrow> (\<not> P \<longrightarrow> \<not> Q) \<longrightarrow> P)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text \<open>Double-negation does NOT distribute over disjunction.\<close>
lemma \<open>\<not> \<not> (P \<longrightarrow> Q) \<longleftrightarrow> (\<not> \<not> P \<longrightarrow> \<not> \<not> Q)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>\<not> \<not> \<not> P \<longleftrightarrow> \<not> P\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>\<not> \<not> ((P \<longrightarrow> Q \<or> R) \<longrightarrow> (P \<longrightarrow> Q) \<or> (P \<longrightarrow> R))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>(P \<longleftrightarrow> Q) \<longleftrightarrow> (Q \<longleftrightarrow> P)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>((P \<longrightarrow> (Q \<or> (Q \<longrightarrow> R))) \<longrightarrow> R) \<longrightarrow> R\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma
\<open>(((G \<longrightarrow> A) \<longrightarrow> J) \<longrightarrow> D \<longrightarrow> E) \<longrightarrow> (((H \<longrightarrow> B) \<longrightarrow> I) \<longrightarrow> C \<longrightarrow> J)
\<longrightarrow> (A \<longrightarrow> H) \<longrightarrow> F \<longrightarrow> G \<longrightarrow> (((C \<longrightarrow> B) \<longrightarrow> I) \<longrightarrow> D) \<longrightarrow> (A \<longrightarrow> C)
\<longrightarrow> (((F \<longrightarrow> A) \<longrightarrow> B) \<longrightarrow> I) \<longrightarrow> E\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
subsection \<open>Lemmas for the propositional double-negation translation\<close>
lemma \<open>P \<longrightarrow> \<not> \<not> P\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>\<not> \<not> (\<not> \<not> P \<longrightarrow> P)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>\<not> \<not> P \<and> \<not> \<not> (P \<longrightarrow> Q) \<longrightarrow> \<not> \<not> Q\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text \<open>The following are classically but not constructively valid.
The attempt to prove them terminates quickly!\<close>
lemma \<open>((P \<longrightarrow> Q) \<longrightarrow> P) \<longrightarrow> P\<close>
-apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
apply (rule asm_rl) \<comment> \<open>Checks that subgoals remain: proof failed.\<close>
oops
lemma \<open>(P \<and> Q \<longrightarrow> R) \<longrightarrow> (P \<longrightarrow> R) \<or> (Q \<longrightarrow> R)\<close>
-apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
apply (rule asm_rl) \<comment> \<open>Checks that subgoals remain: proof failed.\<close>
oops
@@ -98,7 +98,7 @@
\<open>((P \<longleftrightarrow> Q) \<longrightarrow> P \<and> Q \<and> R) \<and>
((Q \<longleftrightarrow> R) \<longrightarrow> P \<and> Q \<and> R) \<and>
((R \<longleftrightarrow> P) \<longrightarrow> P \<and> Q \<and> R) \<longrightarrow> P \<and> Q \<and> R\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text \<open>de Bruijn formula with five predicates\<close>
@@ -108,7 +108,7 @@
((R \<longleftrightarrow> S) \<longrightarrow> P \<and> Q \<and> R \<and> S \<and> T) \<and>
((S \<longleftrightarrow> T) \<longrightarrow> P \<and> Q \<and> R \<and> S \<and> T) \<and>
((T \<longleftrightarrow> P) \<longrightarrow> P \<and> Q \<and> R \<and> S \<and> T) \<longrightarrow> P \<and> Q \<and> R \<and> S \<and> T\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text \<open>
@@ -121,11 +121,11 @@
lemma
\<open>(\<forall>x. \<exists>y. \<forall>z. p(x) \<and> q(y) \<and> r(z)) \<longleftrightarrow>
(\<forall>z. \<exists>y. \<forall>x. p(x) \<and> q(y) \<and> r(z))\<close>
- by (tactic \<open>IntPr.best_dup_tac @{context} 1\<close>) \<comment> \<open>SLOW\<close>
+ by (tactic \<open>IntPr.best_dup_tac \<^context> 1\<close>) \<comment> \<open>SLOW\<close>
text\<open>Problem 3.1\<close>
lemma \<open>\<not> (\<exists>x. \<forall>y. mem(y,x) \<longleftrightarrow> \<not> mem(x,x))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>Problem 4.1: hopeless!\<close>
lemma
@@ -138,80 +138,80 @@
text\<open>\<open>\<not>\<not>\<close>1\<close>
lemma \<open>\<not> \<not> ((P \<longrightarrow> Q) \<longleftrightarrow> (\<not> Q \<longrightarrow> \<not> P))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>2\<close>
lemma \<open>\<not> \<not> (\<not> \<not> P \<longleftrightarrow> P)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>3\<close>
lemma \<open>\<not> (P \<longrightarrow> Q) \<longrightarrow> (Q \<longrightarrow> P)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>4\<close>
lemma \<open>\<not> \<not> ((\<not> P \<longrightarrow> Q) \<longleftrightarrow> (\<not> Q \<longrightarrow> P))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>5\<close>
lemma \<open>\<not> \<not> ((P \<or> Q \<longrightarrow> P \<or> R) \<longrightarrow> P \<or> (Q \<longrightarrow> R))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>6\<close>
lemma \<open>\<not> \<not> (P \<or> \<not> P)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>7\<close>
lemma \<open>\<not> \<not> (P \<or> \<not> \<not> \<not> P)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>8. Peirce's law\<close>
lemma \<open>\<not> \<not> (((P \<longrightarrow> Q) \<longrightarrow> P) \<longrightarrow> P)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>9\<close>
lemma \<open>((P \<or> Q) \<and> (\<not> P \<or> Q) \<and> (P \<or> \<not> Q)) \<longrightarrow> \<not> (\<not> P \<or> \<not> Q)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>10\<close>
lemma \<open>(Q \<longrightarrow> R) \<longrightarrow> (R \<longrightarrow> P \<and> Q) \<longrightarrow> (P \<longrightarrow> (Q \<or> R)) \<longrightarrow> (P \<longleftrightarrow> Q)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
subsection\<open>11. Proved in each direction (incorrectly, says Pelletier!!)\<close>
lemma \<open>P \<longleftrightarrow> P\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>12. Dijkstra's law\<close>
lemma \<open>\<not> \<not> (((P \<longleftrightarrow> Q) \<longleftrightarrow> R) \<longleftrightarrow> (P \<longleftrightarrow> (Q \<longleftrightarrow> R)))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>((P \<longleftrightarrow> Q) \<longleftrightarrow> R) \<longrightarrow> \<not> \<not> (P \<longleftrightarrow> (Q \<longleftrightarrow> R))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>13. Distributive law\<close>
lemma \<open>P \<or> (Q \<and> R) \<longleftrightarrow> (P \<or> Q) \<and> (P \<or> R)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>14\<close>
lemma \<open>\<not> \<not> ((P \<longleftrightarrow> Q) \<longleftrightarrow> ((Q \<or> \<not> P) \<and> (\<not> Q \<or> P)))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>15\<close>
lemma \<open>\<not> \<not> ((P \<longrightarrow> Q) \<longleftrightarrow> (\<not> P \<or> Q))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>16\<close>
lemma \<open>\<not> \<not> ((P \<longrightarrow> Q) \<or> (Q \<longrightarrow> P))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>17\<close>
lemma \<open>\<not> \<not> (((P \<and> (Q \<longrightarrow> R)) \<longrightarrow> S) \<longleftrightarrow> ((\<not> P \<or> Q \<or> S) \<and> (\<not> P \<or> \<not> R \<or> S)))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text \<open>Dijkstra's ``Golden Rule''\<close>
lemma \<open>(P \<and> Q) \<longleftrightarrow> P \<longleftrightarrow> Q \<longleftrightarrow> (P \<or> Q)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
section \<open>Examples with quantifiers\<close>
@@ -219,47 +219,47 @@
subsection \<open>The converse is classical in the following implications \dots\<close>
lemma \<open>(\<exists>x. P(x) \<longrightarrow> Q) \<longrightarrow> (\<forall>x. P(x)) \<longrightarrow> Q\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>((\<forall>x. P(x)) \<longrightarrow> Q) \<longrightarrow> \<not> (\<forall>x. P(x) \<and> \<not> Q)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>((\<forall>x. \<not> P(x)) \<longrightarrow> Q) \<longrightarrow> \<not> (\<forall>x. \<not> (P(x) \<or> Q))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>(\<forall>x. P(x)) \<or> Q \<longrightarrow> (\<forall>x. P(x) \<or> Q)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
lemma \<open>(\<exists>x. P \<longrightarrow> Q(x)) \<longrightarrow> (P \<longrightarrow> (\<exists>x. Q(x)))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
subsection \<open>The following are not constructively valid!\<close>
text \<open>The attempt to prove them terminates quickly!\<close>
lemma \<open>((\<forall>x. P(x)) \<longrightarrow> Q) \<longrightarrow> (\<exists>x. P(x) \<longrightarrow> Q)\<close>
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
apply (rule asm_rl) \<comment> \<open>Checks that subgoals remain: proof failed.\<close>
oops
lemma \<open>(P \<longrightarrow> (\<exists>x. Q(x))) \<longrightarrow> (\<exists>x. P \<longrightarrow> Q(x))\<close>
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
apply (rule asm_rl) \<comment> \<open>Checks that subgoals remain: proof failed.\<close>
oops
lemma \<open>(\<forall>x. P(x) \<or> Q) \<longrightarrow> ((\<forall>x. P(x)) \<or> Q)\<close>
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
apply (rule asm_rl) \<comment> \<open>Checks that subgoals remain: proof failed.\<close>
oops
lemma \<open>(\<forall>x. \<not> \<not> P(x)) \<longrightarrow> \<not> \<not> (\<forall>x. P(x))\<close>
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
apply (rule asm_rl) \<comment> \<open>Checks that subgoals remain: proof failed.\<close>
oops
text \<open>Classically but not intuitionistically valid. Proved by a bug in 1986!\<close>
lemma \<open>\<exists>x. Q(x) \<longrightarrow> (\<forall>x. Q(x))\<close>
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
apply (rule asm_rl) \<comment> \<open>Checks that subgoals remain: proof failed.\<close>
oops
@@ -283,7 +283,7 @@
lemma
\<open>(\<forall>x y. \<exists>z. \<forall>w. (P(x) \<and> Q(y) \<longrightarrow> R(z) \<and> S(w)))
\<longrightarrow> (\<exists>x y. P(x) \<and> Q(y)) \<longrightarrow> (\<exists>z. R(z))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>21\<close>
lemma \<open>(\<exists>x. P \<longrightarrow> Q(x)) \<and> (\<exists>x. Q(x) \<longrightarrow> P) \<longrightarrow> \<not> \<not> (\<exists>x. P \<longleftrightarrow> Q(x))\<close>
@@ -291,11 +291,11 @@
text\<open>22\<close>
lemma \<open>(\<forall>x. P \<longleftrightarrow> Q(x)) \<longrightarrow> (P \<longleftrightarrow> (\<forall>x. Q(x)))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>23\<close>
lemma \<open>\<not> \<not> ((\<forall>x. P \<or> Q(x)) \<longleftrightarrow> (P \<or> (\<forall>x. Q(x))))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>24\<close>
lemma
@@ -306,10 +306,10 @@
Not clear why \<open>fast_tac\<close>, \<open>best_tac\<close>, \<open>ASTAR\<close> and
\<open>ITER_DEEPEN\<close> all take forever.
\<close>
- apply (tactic \<open>IntPr.safe_tac @{context}\<close>)
+ apply (tactic \<open>IntPr.safe_tac \<^context>\<close>)
apply (erule impE)
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
done
text\<open>25\<close>
@@ -319,7 +319,7 @@
(\<forall>x. P(x) \<longrightarrow> (M(x) \<and> L(x))) \<and>
((\<forall>x. P(x) \<longrightarrow> Q(x)) \<or> (\<exists>x. P(x) \<and> R(x)))
\<longrightarrow> (\<exists>x. Q(x) \<and> P(x))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>26\<close>
lemma
@@ -335,7 +335,7 @@
(\<forall>x. M(x) \<and> L(x) \<longrightarrow> P(x)) \<and>
((\<exists>x. R(x) \<and> \<not> Q(x)) \<longrightarrow> (\<forall>x. L(x) \<longrightarrow> \<not> R(x)))
\<longrightarrow> (\<forall>x. M(x) \<longrightarrow> \<not> L(x))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>28. AMENDED\<close>
lemma
@@ -343,21 +343,21 @@
(\<not> \<not> (\<forall>x. Q(x) \<or> R(x)) \<longrightarrow> (\<exists>x. Q(x) \<and> S(x))) \<and>
(\<not> \<not> (\<exists>x. S(x)) \<longrightarrow> (\<forall>x. L(x) \<longrightarrow> M(x)))
\<longrightarrow> (\<forall>x. P(x) \<and> L(x) \<longrightarrow> M(x))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>29. Essentially the same as Principia Mathematica *11.71\<close>
lemma
\<open>(\<exists>x. P(x)) \<and> (\<exists>y. Q(y))
\<longrightarrow> ((\<forall>x. P(x) \<longrightarrow> R(x)) \<and> (\<forall>y. Q(y) \<longrightarrow> S(y)) \<longleftrightarrow>
(\<forall>x y. P(x) \<and> Q(y) \<longrightarrow> R(x) \<and> S(y)))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>30\<close>
lemma
\<open>(\<forall>x. (P(x) \<or> Q(x)) \<longrightarrow> \<not> R(x)) \<and>
(\<forall>x. (Q(x) \<longrightarrow> \<not> S(x)) \<longrightarrow> P(x) \<and> R(x))
\<longrightarrow> (\<forall>x. \<not> \<not> S(x))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>31\<close>
lemma
@@ -365,7 +365,7 @@
(\<exists>x. L(x) \<and> P(x)) \<and>
(\<forall>x. \<not> R(x) \<longrightarrow> M(x))
\<longrightarrow> (\<exists>x. L(x) \<and> M(x))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>32\<close>
lemma
@@ -373,13 +373,13 @@
(\<forall>x. S(x) \<and> R(x) \<longrightarrow> L(x)) \<and>
(\<forall>x. M(x) \<longrightarrow> R(x))
\<longrightarrow> (\<forall>x. P(x) \<and> M(x) \<longrightarrow> L(x))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>\<open>\<not>\<not>\<close>33\<close>
lemma
\<open>(\<forall>x. \<not> \<not> (P(a) \<and> (P(x) \<longrightarrow> P(b)) \<longrightarrow> P(c))) \<longleftrightarrow>
(\<forall>x. \<not> \<not> ((\<not> P(a) \<or> P(x) \<or> P(c)) \<and> (\<not> P(a) \<or> \<not> P(b) \<or> P(c))))\<close>
- apply (tactic \<open>IntPr.best_tac @{context} 1\<close>)
+ apply (tactic \<open>IntPr.best_tac \<^context> 1\<close>)
done
@@ -389,7 +389,7 @@
(\<forall>x. \<exists>y. G(x,y)) \<and>
(\<forall>x y. J(x,y) \<or> G(x,y) \<longrightarrow> (\<forall>z. J(y,z) \<or> G(y,z) \<longrightarrow> H(x,z)))
\<longrightarrow> (\<forall>x. \<exists>y. H(x,y))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>37\<close>
lemma
@@ -402,13 +402,13 @@
text\<open>39\<close>
lemma \<open>\<not> (\<exists>x. \<forall>y. F(y,x) \<longleftrightarrow> \<not> F(y,y))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>40. AMENDED\<close>
lemma
\<open>(\<exists>y. \<forall>x. F(x,y) \<longleftrightarrow> F(x,x)) \<longrightarrow>
\<not> (\<forall>x. \<exists>y. \<forall>z. F(z,y) \<longleftrightarrow> \<not> F(z,x))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>44\<close>
lemma
@@ -416,37 +416,37 @@
(\<exists>y. g(y) \<and> h(x,y) \<and> (\<exists>y. g(y) \<and> \<not> h(x,y)))) \<and>
(\<exists>x. j(x) \<and> (\<forall>y. g(y) \<longrightarrow> h(x,y)))
\<longrightarrow> (\<exists>x. j(x) \<and> \<not> f(x))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>48\<close>
lemma \<open>(a = b \<or> c = d) \<and> (a = c \<or> b = d) \<longrightarrow> a = d \<or> b = c\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>51\<close>
lemma
\<open>(\<exists>z w. \<forall>x y. P(x,y) \<longleftrightarrow> (x = z \<and> y = w)) \<longrightarrow>
(\<exists>z. \<forall>x. \<exists>w. (\<forall>y. P(x,y) \<longleftrightarrow> y = w) \<longleftrightarrow> x = z)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>52\<close>
text \<open>Almost the same as 51.\<close>
lemma
\<open>(\<exists>z w. \<forall>x y. P(x,y) \<longleftrightarrow> (x = z \<and> y = w)) \<longrightarrow>
(\<exists>w. \<forall>y. \<exists>z. (\<forall>x. P(x,y) \<longleftrightarrow> x = z) \<longleftrightarrow> y = w)\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>56\<close>
lemma \<open>(\<forall>x. (\<exists>y. P(y) \<and> x = f(y)) \<longrightarrow> P(x)) \<longleftrightarrow> (\<forall>x. P(x) \<longrightarrow> P(f(x)))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>57\<close>
lemma
\<open>P(f(a,b), f(b,c)) \<and> P(f(b,c), f(a,c)) \<and>
(\<forall>x y z. P(x,y) \<and> P(y,z) \<longrightarrow> P(x,z)) \<longrightarrow> P(f(a,b), f(a,c))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text\<open>60\<close>
lemma \<open>\<forall>x. P(x,f(x)) \<longleftrightarrow> (\<exists>y. (\<forall>z. P(z,y) \<longrightarrow> P(z,f(x))) \<and> P(x,y))\<close>
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
end
--- a/src/FOL/ex/Locale_Test/Locale_Test1.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOL/ex/Locale_Test/Locale_Test1.thy Fri Jan 04 23:22:53 2019 +0100
@@ -162,8 +162,8 @@
thm d1_def d2_def (* should print as "D1(?x) <-> ..." and "D2(?x) <-> ..." *)
ML \<open>
- check_syntax @{context} @{thm d1_def} "D1(?x) \<longleftrightarrow> \<not> p2(p1(?x))";
- check_syntax @{context} @{thm d2_def} "D2(?x) \<longleftrightarrow> \<not> p2(?x)";
+ check_syntax \<^context> @{thm d1_def} "D1(?x) \<longleftrightarrow> \<not> p2(p1(?x))";
+ check_syntax \<^context> @{thm d2_def} "D2(?x) \<longleftrightarrow> \<not> p2(?x)";
\<close>
end
@@ -175,8 +175,8 @@
(* should print as "d1(?x) <-> ..." and "D2(?x) <-> ..." *)
ML \<open>
- check_syntax @{context} @{thm d1_def} "d1(?x) \<longleftrightarrow> \<not> p2(p3(?x))";
- check_syntax @{context} @{thm d2_def} "D2(?x) \<longleftrightarrow> \<not> p2(?x)";
+ check_syntax \<^context> @{thm d1_def} "d1(?x) \<longleftrightarrow> \<not> p2(p3(?x))";
+ check_syntax \<^context> @{thm d2_def} "D2(?x) \<longleftrightarrow> \<not> p2(?x)";
\<close>
end
@@ -450,7 +450,7 @@
interpretation int2?: semi \<open>(+)\<close>
by unfold_locales (* subsumed, thm int2.assoc not generated *)
-ML \<open>(Global_Theory.get_thms @{theory} "int2.assoc";
+ML \<open>(Global_Theory.get_thms \<^theory> "int2.assoc";
raise Fail "thm int2.assoc was generated")
handle ERROR _ => ([]:thm list);\<close>
--- a/src/FOL/ex/Miniscope.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOL/ex/Miniscope.thy Fri Jan 04 23:22:53 2019 +0100
@@ -68,7 +68,7 @@
lemmas mini_simps = demorgans nnf_simps ex_simps all_simps
ML \<open>
-val mini_ss = simpset_of (@{context} addsimps @{thms mini_simps});
+val mini_ss = simpset_of (\<^context> addsimps @{thms mini_simps});
fun mini_tac ctxt =
resolve_tac ctxt @{thms ccontr} THEN' asm_full_simp_tac (put_simpset mini_ss ctxt);
\<close>
--- a/src/FOL/ex/Prolog.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOL/ex/Prolog.thy Fri Jan 04 23:22:53 2019 +0100
@@ -68,24 +68,24 @@
\<close>
schematic_goal \<open>rev(?x, a:b:c:Nil)\<close>
-apply (tactic \<open>prolog_tac @{context}\<close>)
+apply (tactic \<open>prolog_tac \<^context>\<close>)
done
schematic_goal \<open>rev(a:?x:c:?y:Nil, d:?z:b:?u)\<close>
-apply (tactic \<open>prolog_tac @{context}\<close>)
+apply (tactic \<open>prolog_tac \<^context>\<close>)
done
(*rev([a..p], ?w) requires 153 inferences *)
schematic_goal \<open>rev(a:b:c:d:e:f:g:h:i:j:k:l:m:n:o:p:Nil, ?w)\<close>
apply (tactic \<open>
- DEPTH_SOLVE (resolve_tac @{context} ([@{thm refl}, @{thm conjI}] @ @{thms rules}) 1)\<close>)
+ DEPTH_SOLVE (resolve_tac \<^context> ([@{thm refl}, @{thm conjI}] @ @{thms rules}) 1)\<close>)
done
(*?x has 16, ?y has 32; rev(?y,?w) requires 561 (rather large) inferences
total inferences = 2 + 1 + 17 + 561 = 581*)
schematic_goal \<open>a:b:c:d:e:f:g:h:i:j:k:l:m:n:o:p:Nil = ?x \<and> app(?x,?x,?y) \<and> rev(?y,?w)\<close>
apply (tactic \<open>
- DEPTH_SOLVE (resolve_tac @{context} ([@{thm refl}, @{thm conjI}] @ @{thms rules}) 1)\<close>)
+ DEPTH_SOLVE (resolve_tac \<^context> ([@{thm refl}, @{thm conjI}] @ @{thms rules}) 1)\<close>)
done
end
--- a/src/FOL/ex/Propositional_Cla.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOL/ex/Propositional_Cla.thy Fri Jan 04 23:22:53 2019 +0100
@@ -12,7 +12,7 @@
text \<open>commutative laws of \<open>\<and>\<close> and \<open>\<or>\<close>\<close>
lemma \<open>P \<and> Q \<longrightarrow> Q \<and> P\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>P \<or> Q \<longrightarrow> Q \<or> P\<close>
by fast
--- a/src/FOL/ex/Propositional_Int.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOL/ex/Propositional_Int.thy Fri Jan 04 23:22:53 2019 +0100
@@ -12,94 +12,94 @@
text \<open>commutative laws of \<open>\<and>\<close> and \<open>\<or>\<close>\<close>
lemma \<open>P \<and> Q \<longrightarrow> Q \<and> P\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>P \<or> Q \<longrightarrow> Q \<or> P\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text \<open>associative laws of \<open>\<and>\<close> and \<open>\<or>\<close>\<close>
lemma \<open>(P \<and> Q) \<and> R \<longrightarrow> P \<and> (Q \<and> R)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(P \<or> Q) \<or> R \<longrightarrow> P \<or> (Q \<or> R)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text \<open>distributive laws of \<open>\<and>\<close> and \<open>\<or>\<close>\<close>
lemma \<open>(P \<and> Q) \<or> R \<longrightarrow> (P \<or> R) \<and> (Q \<or> R)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(P \<or> R) \<and> (Q \<or> R) \<longrightarrow> (P \<and> Q) \<or> R\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(P \<or> Q) \<and> R \<longrightarrow> (P \<and> R) \<or> (Q \<and> R)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(P \<and> R) \<or> (Q \<and> R) \<longrightarrow> (P \<or> Q) \<and> R\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text \<open>Laws involving implication\<close>
lemma \<open>(P \<longrightarrow> R) \<and> (Q \<longrightarrow> R) \<longleftrightarrow> (P \<or> Q \<longrightarrow> R)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(P \<and> Q \<longrightarrow> R) \<longleftrightarrow> (P \<longrightarrow> (Q \<longrightarrow> R))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>((P \<longrightarrow> R) \<longrightarrow> R) \<longrightarrow> ((Q \<longrightarrow> R) \<longrightarrow> R) \<longrightarrow> (P \<and> Q \<longrightarrow> R) \<longrightarrow> R\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>\<not> (P \<longrightarrow> R) \<longrightarrow> \<not> (Q \<longrightarrow> R) \<longrightarrow> \<not> (P \<and> Q \<longrightarrow> R)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(P \<longrightarrow> Q \<and> R) \<longleftrightarrow> (P \<longrightarrow> Q) \<and> (P \<longrightarrow> R)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text \<open>Propositions-as-types\<close>
\<comment> \<open>The combinator K\<close>
lemma \<open>P \<longrightarrow> (Q \<longrightarrow> P)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
\<comment> \<open>The combinator S\<close>
lemma \<open>(P \<longrightarrow> Q \<longrightarrow> R) \<longrightarrow> (P \<longrightarrow> Q) \<longrightarrow> (P \<longrightarrow> R)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
\<comment> \<open>Converse is classical\<close>
lemma \<open>(P \<longrightarrow> Q) \<or> (P \<longrightarrow> R) \<longrightarrow> (P \<longrightarrow> Q \<or> R)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(P \<longrightarrow> Q) \<longrightarrow> (\<not> Q \<longrightarrow> \<not> P)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text \<open>Schwichtenberg's examples (via T. Nipkow)\<close>
lemma stab_imp: \<open>(((Q \<longrightarrow> R) \<longrightarrow> R) \<longrightarrow> Q) \<longrightarrow> (((P \<longrightarrow> Q) \<longrightarrow> R) \<longrightarrow> R) \<longrightarrow> P \<longrightarrow> Q\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma stab_to_peirce:
\<open>(((P \<longrightarrow> R) \<longrightarrow> R) \<longrightarrow> P) \<longrightarrow> (((Q \<longrightarrow> R) \<longrightarrow> R) \<longrightarrow> Q)
\<longrightarrow> ((P \<longrightarrow> Q) \<longrightarrow> P) \<longrightarrow> P\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma peirce_imp1:
\<open>(((Q \<longrightarrow> R) \<longrightarrow> Q) \<longrightarrow> Q)
\<longrightarrow> (((P \<longrightarrow> Q) \<longrightarrow> R) \<longrightarrow> P \<longrightarrow> Q) \<longrightarrow> P \<longrightarrow> Q\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma peirce_imp2: \<open>(((P \<longrightarrow> R) \<longrightarrow> P) \<longrightarrow> P) \<longrightarrow> ((P \<longrightarrow> Q \<longrightarrow> R) \<longrightarrow> P) \<longrightarrow> P\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma mints: \<open>((((P \<longrightarrow> Q) \<longrightarrow> P) \<longrightarrow> P) \<longrightarrow> Q) \<longrightarrow> Q\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma mints_solovev: \<open>(P \<longrightarrow> (Q \<longrightarrow> R) \<longrightarrow> Q) \<longrightarrow> ((P \<longrightarrow> Q) \<longrightarrow> R) \<longrightarrow> R\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma tatsuta:
\<open>(((P7 \<longrightarrow> P1) \<longrightarrow> P10) \<longrightarrow> P4 \<longrightarrow> P5)
@@ -107,7 +107,7 @@
\<longrightarrow> (P1 \<longrightarrow> P8) \<longrightarrow> P6 \<longrightarrow> P7
\<longrightarrow> (((P3 \<longrightarrow> P2) \<longrightarrow> P9) \<longrightarrow> P4)
\<longrightarrow> (P1 \<longrightarrow> P3) \<longrightarrow> (((P6 \<longrightarrow> P1) \<longrightarrow> P2) \<longrightarrow> P9) \<longrightarrow> P5\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma tatsuta1:
\<open>(((P8 \<longrightarrow> P2) \<longrightarrow> P9) \<longrightarrow> P3 \<longrightarrow> P10)
@@ -115,6 +115,6 @@
\<longrightarrow> (((P6 \<longrightarrow> P1) \<longrightarrow> P2) \<longrightarrow> P9)
\<longrightarrow> (((P7 \<longrightarrow> P1) \<longrightarrow> P10) \<longrightarrow> P4 \<longrightarrow> P5)
\<longrightarrow> (P1 \<longrightarrow> P3) \<longrightarrow> (P1 \<longrightarrow> P8) \<longrightarrow> P6 \<longrightarrow> P7 \<longrightarrow> P5\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
end
--- a/src/FOL/ex/Quantifiers_Int.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOL/ex/Quantifiers_Int.thy Fri Jan 04 23:22:53 2019 +0100
@@ -10,91 +10,91 @@
begin
lemma \<open>(\<forall>x y. P(x,y)) \<longrightarrow> (\<forall>y x. P(x,y))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(\<exists>x y. P(x,y)) \<longrightarrow> (\<exists>y x. P(x,y))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
\<comment> \<open>Converse is false\<close>
lemma \<open>(\<forall>x. P(x)) \<or> (\<forall>x. Q(x)) \<longrightarrow> (\<forall>x. P(x) \<or> Q(x))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(\<forall>x. P \<longrightarrow> Q(x)) \<longleftrightarrow> (P \<longrightarrow> (\<forall>x. Q(x)))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(\<forall>x. P(x) \<longrightarrow> Q) \<longleftrightarrow> ((\<exists>x. P(x)) \<longrightarrow> Q)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text \<open>Some harder ones\<close>
lemma \<open>(\<exists>x. P(x) \<or> Q(x)) \<longleftrightarrow> (\<exists>x. P(x)) \<or> (\<exists>x. Q(x))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
\<comment> \<open>Converse is false\<close>
lemma \<open>(\<exists>x. P(x) \<and> Q(x)) \<longrightarrow> (\<exists>x. P(x)) \<and> (\<exists>x. Q(x))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text \<open>Basic test of quantifier reasoning\<close>
\<comment> \<open>TRUE\<close>
lemma \<open>(\<exists>y. \<forall>x. Q(x,y)) \<longrightarrow> (\<forall>x. \<exists>y. Q(x,y))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(\<forall>x. Q(x)) \<longrightarrow> (\<exists>x. Q(x))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text \<open>The following should fail, as they are false!\<close>
lemma \<open>(\<forall>x. \<exists>y. Q(x,y)) \<longrightarrow> (\<exists>y. \<forall>x. Q(x,y))\<close>
- apply (tactic "IntPr.fast_tac @{context} 1")?
+ apply (tactic "IntPr.fast_tac \<^context> 1")?
oops
lemma \<open>(\<exists>x. Q(x)) \<longrightarrow> (\<forall>x. Q(x))\<close>
- apply (tactic "IntPr.fast_tac @{context} 1")?
+ apply (tactic "IntPr.fast_tac \<^context> 1")?
oops
schematic_goal \<open>P(?a) \<longrightarrow> (\<forall>x. P(x))\<close>
- apply (tactic "IntPr.fast_tac @{context} 1")?
+ apply (tactic "IntPr.fast_tac \<^context> 1")?
oops
schematic_goal \<open>(P(?a) \<longrightarrow> (\<forall>x. Q(x))) \<longrightarrow> (\<forall>x. P(x) \<longrightarrow> Q(x))\<close>
- apply (tactic "IntPr.fast_tac @{context} 1")?
+ apply (tactic "IntPr.fast_tac \<^context> 1")?
oops
text \<open>Back to things that are provable \dots\<close>
lemma \<open>(\<forall>x. P(x) \<longrightarrow> Q(x)) \<and> (\<exists>x. P(x)) \<longrightarrow> (\<exists>x. Q(x))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
\<comment> \<open>An example of why exI should be delayed as long as possible\<close>
lemma \<open>(P \<longrightarrow> (\<exists>x. Q(x))) \<and> P \<longrightarrow> (\<exists>x. Q(x))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
schematic_goal \<open>(\<forall>x. P(x) \<longrightarrow> Q(f(x))) \<and> (\<forall>x. Q(x) \<longrightarrow> R(g(x))) \<and> P(d) \<longrightarrow> R(?a)\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
lemma \<open>(\<forall>x. Q(x)) \<longrightarrow> (\<exists>x. Q(x))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text \<open>Some slow ones\<close>
\<comment> \<open>Principia Mathematica *11.53\<close>
lemma \<open>(\<forall>x y. P(x) \<longrightarrow> Q(y)) \<longleftrightarrow> ((\<exists>x. P(x)) \<longrightarrow> (\<forall>y. Q(y)))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
(*Principia Mathematica *11.55 *)
lemma \<open>(\<exists>x y. P(x) \<and> Q(x,y)) \<longleftrightarrow> (\<exists>x. P(x) \<and> (\<exists>y. Q(x,y)))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
(*Principia Mathematica *11.61 *)
lemma \<open>(\<exists>y. \<forall>x. P(x) \<longrightarrow> Q(x,y)) \<longrightarrow> (\<forall>x. P(x) \<longrightarrow> (\<exists>y. Q(x,y)))\<close>
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
end
--- a/src/FOL/fologic.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOL/fologic.ML Fri Jan 04 23:22:53 2019 +0100
@@ -37,48 +37,48 @@
structure FOLogic: FOLOGIC =
struct
-val oT = Type(@{type_name o},[]);
+val oT = Type(\<^type_name>\<open>o\<close>,[]);
-val Trueprop = Const(@{const_name Trueprop}, oT-->propT);
+val Trueprop = Const(\<^const_name>\<open>Trueprop\<close>, oT-->propT);
fun mk_Trueprop P = Trueprop $ P;
-fun dest_Trueprop (Const (@{const_name Trueprop}, _) $ P) = P
+fun dest_Trueprop (Const (\<^const_name>\<open>Trueprop\<close>, _) $ P) = P
| dest_Trueprop t = raise TERM ("dest_Trueprop", [t]);
(* Logical constants *)
-val not = Const (@{const_name Not}, oT --> oT);
-val conj = Const(@{const_name conj}, [oT,oT]--->oT);
-val disj = Const(@{const_name disj}, [oT,oT]--->oT);
-val imp = Const(@{const_name imp}, [oT,oT]--->oT)
-val iff = Const(@{const_name iff}, [oT,oT]--->oT);
+val not = Const (\<^const_name>\<open>Not\<close>, oT --> oT);
+val conj = Const(\<^const_name>\<open>conj\<close>, [oT,oT]--->oT);
+val disj = Const(\<^const_name>\<open>disj\<close>, [oT,oT]--->oT);
+val imp = Const(\<^const_name>\<open>imp\<close>, [oT,oT]--->oT)
+val iff = Const(\<^const_name>\<open>iff\<close>, [oT,oT]--->oT);
fun mk_conj (t1, t2) = conj $ t1 $ t2
and mk_disj (t1, t2) = disj $ t1 $ t2
and mk_imp (t1, t2) = imp $ t1 $ t2
and mk_iff (t1, t2) = iff $ t1 $ t2;
-fun dest_imp (Const(@{const_name imp},_) $ A $ B) = (A, B)
+fun dest_imp (Const(\<^const_name>\<open>imp\<close>,_) $ A $ B) = (A, B)
| dest_imp t = raise TERM ("dest_imp", [t]);
-fun dest_conj (Const (@{const_name conj}, _) $ t $ t') = t :: dest_conj t'
+fun dest_conj (Const (\<^const_name>\<open>conj\<close>, _) $ t $ t') = t :: dest_conj t'
| dest_conj t = [t];
-fun dest_iff (Const(@{const_name iff},_) $ A $ B) = (A, B)
+fun dest_iff (Const(\<^const_name>\<open>iff\<close>,_) $ A $ B) = (A, B)
| dest_iff t = raise TERM ("dest_iff", [t]);
-fun eq_const T = Const (@{const_name eq}, [T, T] ---> oT);
+fun eq_const T = Const (\<^const_name>\<open>eq\<close>, [T, T] ---> oT);
fun mk_eq (t, u) = eq_const (fastype_of t) $ t $ u;
-fun dest_eq (Const (@{const_name eq}, _) $ lhs $ rhs) = (lhs, rhs)
+fun dest_eq (Const (\<^const_name>\<open>eq\<close>, _) $ lhs $ rhs) = (lhs, rhs)
| dest_eq t = raise TERM ("dest_eq", [t])
-fun all_const T = Const (@{const_name All}, [T --> oT] ---> oT);
+fun all_const T = Const (\<^const_name>\<open>All\<close>, [T --> oT] ---> oT);
fun mk_all (Free (x, T), P) = all_const T $ absfree (x, T) P;
-fun exists_const T = Const (@{const_name Ex}, [T --> oT] ---> oT);
+fun exists_const T = Const (\<^const_name>\<open>Ex\<close>, [T --> oT] ---> oT);
fun mk_exists (Free (x, T), P) = exists_const T $ absfree (x, T) P;
--- a/src/FOL/simpdata.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOL/simpdata.ML Fri Jan 04 23:22:53 2019 +0100
@@ -9,16 +9,16 @@
fun mk_meta_eq th =
(case Thm.concl_of th of
- _ $ (Const(@{const_name eq},_)$_$_) => th RS @{thm eq_reflection}
- | _ $ (Const(@{const_name iff},_)$_$_) => th RS @{thm iff_reflection}
+ _ $ (Const(\<^const_name>\<open>eq\<close>,_)$_$_) => th RS @{thm eq_reflection}
+ | _ $ (Const(\<^const_name>\<open>iff\<close>,_)$_$_) => th RS @{thm iff_reflection}
| _ => error "conclusion must be a =-equality or <->");
fun mk_eq th =
(case Thm.concl_of th of
- Const(@{const_name Pure.eq},_)$_$_ => th
- | _ $ (Const(@{const_name eq},_)$_$_) => mk_meta_eq th
- | _ $ (Const(@{const_name iff},_)$_$_) => mk_meta_eq th
- | _ $ (Const(@{const_name Not},_)$_) => th RS @{thm iff_reflection_F}
+ Const(\<^const_name>\<open>Pure.eq\<close>,_)$_$_ => th
+ | _ $ (Const(\<^const_name>\<open>eq\<close>,_)$_$_) => mk_meta_eq th
+ | _ $ (Const(\<^const_name>\<open>iff\<close>,_)$_$_) => mk_meta_eq th
+ | _ $ (Const(\<^const_name>\<open>Not\<close>,_)$_) => th RS @{thm iff_reflection_F}
| _ => th RS @{thm iff_reflection_T});
(*Replace premises x=y, X<->Y by X==Y*)
@@ -33,14 +33,14 @@
error("Premises and conclusion of congruence rules must use =-equality or <->");
val mksimps_pairs =
- [(@{const_name imp}, [@{thm mp}]), (@{const_name conj}, [@{thm conjunct1}, @{thm conjunct2}]),
- (@{const_name All}, [@{thm spec}]), (@{const_name True}, []), (@{const_name False}, [])];
+ [(\<^const_name>\<open>imp\<close>, [@{thm mp}]), (\<^const_name>\<open>conj\<close>, [@{thm conjunct1}, @{thm conjunct2}]),
+ (\<^const_name>\<open>All\<close>, [@{thm spec}]), (\<^const_name>\<open>True\<close>, []), (\<^const_name>\<open>False\<close>, [])];
fun mk_atomize pairs =
let
fun atoms th =
(case Thm.concl_of th of
- Const(@{const_name Trueprop},_) $ p =>
+ Const(\<^const_name>\<open>Trueprop\<close>,_) $ p =>
(case head_of p of
Const(a,_) =>
(case AList.lookup (op =) pairs a of
@@ -57,11 +57,11 @@
structure Quantifier1 = Quantifier1
(
(*abstract syntax*)
- fun dest_eq (Const (@{const_name eq}, _) $ s $ t) = SOME (s, t)
+ fun dest_eq (Const (\<^const_name>\<open>eq\<close>, _) $ s $ t) = SOME (s, t)
| dest_eq _ = NONE
- fun dest_conj (Const (@{const_name conj}, _) $ s $ t) = SOME (s, t)
+ fun dest_conj (Const (\<^const_name>\<open>conj\<close>, _) $ s $ t) = SOME (s, t)
| dest_conj _ = NONE
- fun dest_imp (Const (@{const_name imp}, _) $ s $ t) = SOME (s, t)
+ fun dest_imp (Const (\<^const_name>\<open>imp\<close>, _) $ s $ t) = SOME (s, t)
| dest_imp _ = NONE
val conj = FOLogic.conj
val imp = FOLogic.imp
@@ -87,7 +87,7 @@
structure Splitter = Splitter
(
- val context = @{context}
+ val context = \<^context>
val mk_eq = mk_eq
val meta_eq_to_iff = @{thm meta_eq_to_iff}
val iffD = @{thm iffD2}
@@ -121,7 +121,7 @@
(*No simprules, but basic infastructure for simplification*)
val FOL_basic_ss =
- empty_simpset @{context}
+ empty_simpset \<^context>
setSSolver (mk_solver "FOL safe" safe_solver)
setSolver (mk_solver "FOL unsafe" unsafe_solver)
|> Simplifier.set_subgoaler asm_simp_tac
--- a/src/FOLP/FOLP.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/FOLP.thy Fri Jan 04 23:22:53 2019 +0100
@@ -56,8 +56,8 @@
and r2: "!!y. y:Q ==> g(y):R"
shows "?p : R"
apply (rule excluded_middle [THEN disjE])
- apply (tactic \<open>DEPTH_SOLVE (assume_tac @{context} 1 ORELSE
- resolve_tac @{context} [@{thm r1}, @{thm r2}, @{thm major} RS @{thm mp}] 1)\<close>)
+ apply (tactic \<open>DEPTH_SOLVE (assume_tac \<^context> 1 ORELSE
+ resolve_tac \<^context> [@{thm r1}, @{thm r2}, @{thm major} RS @{thm mp}] 1)\<close>)
done
(*Double negation law*)
@@ -80,10 +80,10 @@
apply (insert major)
apply (unfold iff_def)
apply (rule conjE)
- apply (tactic \<open>DEPTH_SOLVE_1 (eresolve_tac @{context} @{thms impCE} 1 ORELSE
- eresolve_tac @{context} [@{thm notE}, @{thm impE}] 1 THEN assume_tac @{context} 1 ORELSE
- assume_tac @{context} 1 ORELSE
- resolve_tac @{context} [@{thm r1}, @{thm r2}] 1)\<close>)+
+ apply (tactic \<open>DEPTH_SOLVE_1 (eresolve_tac \<^context> @{thms impCE} 1 ORELSE
+ eresolve_tac \<^context> [@{thm notE}, @{thm impE}] 1 THEN assume_tac \<^context> 1 ORELSE
+ assume_tac \<^context> 1 ORELSE
+ resolve_tac \<^context> [@{thm r1}, @{thm r2}] 1)\<close>)+
done
@@ -135,7 +135,7 @@
"?p2 : ~P | P"
"?p3 : ~ ~ P <-> P"
"?p4 : (~P --> P) <-> P"
- apply (tactic \<open>ALLGOALS (Cla.fast_tac @{context} FOLP_cs)\<close>)
+ apply (tactic \<open>ALLGOALS (Cla.fast_tac \<^context> FOLP_cs)\<close>)
done
ML_file "simpdata.ML"
--- a/src/FOLP/IFOLP.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/IFOLP.thy Fri Jan 04 23:22:53 2019 +0100
@@ -62,19 +62,19 @@
syntax "_Proof" :: "[p,o]=>prop" ("(_ /: _)" [51, 10] 5)
parse_translation \<open>
- let fun proof_tr [p, P] = Const (@{const_syntax Proof}, dummyT) $ P $ p
- in [(@{syntax_const "_Proof"}, K proof_tr)] end
+ let fun proof_tr [p, P] = Const (\<^const_syntax>\<open>Proof\<close>, dummyT) $ P $ p
+ in [(\<^syntax_const>\<open>_Proof\<close>, K proof_tr)] end
\<close>
(*show_proofs = true displays the proof terms -- they are ENORMOUS*)
-ML \<open>val show_proofs = Attrib.setup_config_bool @{binding show_proofs} (K false)\<close>
+ML \<open>val show_proofs = Attrib.setup_config_bool \<^binding>\<open>show_proofs\<close> (K false)\<close>
print_translation \<open>
let
fun proof_tr' ctxt [P, p] =
- if Config.get ctxt show_proofs then Const (@{syntax_const "_Proof"}, dummyT) $ p $ P
+ if Config.get ctxt show_proofs then Const (\<^syntax_const>\<open>_Proof\<close>, dummyT) $ p $ P
else P
- in [(@{const_syntax Proof}, proof_tr')] end
+ in [(\<^const_syntax>\<open>Proof\<close>, proof_tr')] end
\<close>
@@ -250,7 +250,7 @@
ML \<open>
local
- fun discard_proof (Const (@{const_name Proof}, _) $ P $ _) = P;
+ fun discard_proof (Const (\<^const_name>\<open>Proof\<close>, _) $ P $ _) = P;
in
fun uniq_assume_tac ctxt =
SUBGOAL
@@ -504,19 +504,19 @@
schematic_goal pred1_cong: "p:a=a' ==> ?p:P(a) <-> P(a')"
apply (rule iffI)
apply (tactic \<open>
- DEPTH_SOLVE (assume_tac @{context} 1 ORELSE eresolve_tac @{context} [@{thm subst}, @{thm ssubst}] 1)\<close>)
+ DEPTH_SOLVE (assume_tac \<^context> 1 ORELSE eresolve_tac \<^context> [@{thm subst}, @{thm ssubst}] 1)\<close>)
done
schematic_goal pred2_cong: "[| p:a=a'; q:b=b' |] ==> ?p:P(a,b) <-> P(a',b')"
apply (rule iffI)
apply (tactic \<open>
- DEPTH_SOLVE (assume_tac @{context} 1 ORELSE eresolve_tac @{context} [@{thm subst}, @{thm ssubst}] 1)\<close>)
+ DEPTH_SOLVE (assume_tac \<^context> 1 ORELSE eresolve_tac \<^context> [@{thm subst}, @{thm ssubst}] 1)\<close>)
done
schematic_goal pred3_cong: "[| p:a=a'; q:b=b'; r:c=c' |] ==> ?p:P(a,b,c) <-> P(a',b',c')"
apply (rule iffI)
apply (tactic \<open>
- DEPTH_SOLVE (assume_tac @{context} 1 ORELSE eresolve_tac @{context} [@{thm subst}, @{thm ssubst}] 1)\<close>)
+ DEPTH_SOLVE (assume_tac \<^context> 1 ORELSE eresolve_tac \<^context> [@{thm subst}, @{thm ssubst}] 1)\<close>)
done
lemmas pred_congs = pred1_cong pred2_cong pred3_cong
@@ -543,8 +543,8 @@
assumes major: "p:(P|Q)-->S"
and minor: "!!x y.[| x:P-->S; y:Q-->S |] ==> q(x,y):R"
shows "?p:R"
- apply (tactic \<open>DEPTH_SOLVE (assume_tac @{context} 1 ORELSE
- resolve_tac @{context} [@{thm disjI1}, @{thm disjI2}, @{thm impI},
+ apply (tactic \<open>DEPTH_SOLVE (assume_tac \<^context> 1 ORELSE
+ resolve_tac \<^context> [@{thm disjI1}, @{thm disjI2}, @{thm impI},
@{thm major} RS @{thm mp}, @{thm minor}] 1)\<close>)
done
@@ -611,8 +611,8 @@
structure Hypsubst = Hypsubst
(
(*Take apart an equality judgement; otherwise raise Match!*)
- fun dest_eq (Const (@{const_name Proof}, _) $
- (Const (@{const_name eq}, _) $ t $ u) $ _) = (t, u);
+ fun dest_eq (Const (\<^const_name>\<open>Proof\<close>, _) $
+ (Const (\<^const_name>\<open>eq\<close>, _) $ t $ u) $ _) = (t, u);
val imp_intr = @{thm impI}
@@ -641,7 +641,7 @@
"?p6 : P & ~P <-> False"
"?p7 : ~P & P <-> False"
"?p8 : (P & Q) & R <-> P & (Q & R)"
- apply (tactic \<open>fn st => IntPr.fast_tac @{context} 1 st\<close>)+
+ apply (tactic \<open>fn st => IntPr.fast_tac \<^context> 1 st\<close>)+
done
schematic_goal disj_rews:
@@ -651,13 +651,13 @@
"?p4 : False | P <-> P"
"?p5 : P | P <-> P"
"?p6 : (P | Q) | R <-> P | (Q | R)"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)+
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)+
done
schematic_goal not_rews:
"?p1 : ~ False <-> True"
"?p2 : ~ True <-> False"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)+
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)+
done
schematic_goal imp_rews:
@@ -667,7 +667,7 @@
"?p4 : (True --> P) <-> P"
"?p5 : (P --> P) <-> True"
"?p6 : (P --> ~P) <-> ~P"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)+
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)+
done
schematic_goal iff_rews:
@@ -676,13 +676,13 @@
"?p3 : (P <-> P) <-> True"
"?p4 : (False <-> P) <-> ~P"
"?p5 : (P <-> False) <-> ~P"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)+
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)+
done
schematic_goal quant_rews:
"?p1 : (ALL x. P) <-> P"
"?p2 : (EX x. P) <-> P"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)+
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)+
done
(*These are NOT supplied by default!*)
@@ -691,7 +691,7 @@
"?p2 : P & (Q | R) <-> P&Q | P&R"
"?p3 : (Q | R) & P <-> Q&P | R&P"
"?p4 : (P | Q --> R) <-> (P --> R) & (Q --> R)"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)+
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)+
done
schematic_goal distrib_rews2:
@@ -699,17 +699,17 @@
"?p2 : ((EX x. NORM(P(x))) --> Q) <-> (ALL x. NORM(P(x)) --> Q)"
"?p3 : (EX x. NORM(P(x))) & NORM(Q) <-> (EX x. NORM(P(x)) & NORM(Q))"
"?p4 : NORM(Q) & (EX x. NORM(P(x))) <-> (EX x. NORM(Q) & NORM(P(x)))"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)+
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)+
done
lemmas distrib_rews = distrib_rews1 distrib_rews2
schematic_goal P_Imp_P_iff_T: "p:P ==> ?p:(P <-> True)"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
done
schematic_goal not_P_imp_P_iff_F: "p:~P ==> ?p:(P <-> False)"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
done
end
--- a/src/FOLP/ex/Classical.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/ex/Classical.thy Fri Jan 04 23:22:53 2019 +0100
@@ -10,14 +10,14 @@
begin
schematic_goal "?p : (P --> Q | R) --> (P-->Q) | (P-->R)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*If and only if*)
schematic_goal "?p : (P<->Q) <-> (Q<->P)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
schematic_goal "?p : ~ (P <-> ~P)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*Sample problems from
@@ -33,134 +33,134 @@
text "Pelletier's examples"
(*1*)
schematic_goal "?p : (P-->Q) <-> (~Q --> ~P)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*2*)
schematic_goal "?p : ~ ~ P <-> P"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*3*)
schematic_goal "?p : ~(P-->Q) --> (Q-->P)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*4*)
schematic_goal "?p : (~P-->Q) <-> (~Q --> P)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*5*)
schematic_goal "?p : ((P|Q)-->(P|R)) --> (P|(Q-->R))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*6*)
schematic_goal "?p : P | ~ P"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*7*)
schematic_goal "?p : P | ~ ~ ~ P"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*8. Peirce's law*)
schematic_goal "?p : ((P-->Q) --> P) --> P"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*9*)
schematic_goal "?p : ((P|Q) & (~P|Q) & (P| ~Q)) --> ~ (~P | ~Q)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*10*)
schematic_goal "?p : (Q-->R) & (R-->P&Q) & (P-->Q|R) --> (P<->Q)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*11. Proved in each direction (incorrectly, says Pelletier!!) *)
schematic_goal "?p : P<->P"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*12. "Dijkstra's law"*)
schematic_goal "?p : ((P <-> Q) <-> R) <-> (P <-> (Q <-> R))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*13. Distributive law*)
schematic_goal "?p : P | (Q & R) <-> (P | Q) & (P | R)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*14*)
schematic_goal "?p : (P <-> Q) <-> ((Q | ~P) & (~Q|P))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*15*)
schematic_goal "?p : (P --> Q) <-> (~P | Q)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*16*)
schematic_goal "?p : (P-->Q) | (Q-->P)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
(*17*)
schematic_goal "?p : ((P & (Q-->R))-->S) <-> ((~P | Q | S) & (~P | ~R | S))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Classical Logic: examples with quantifiers"
schematic_goal "?p : (ALL x. P(x) & Q(x)) <-> (ALL x. P(x)) & (ALL x. Q(x))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
schematic_goal "?p : (EX x. P-->Q(x)) <-> (P --> (EX x. Q(x)))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
schematic_goal "?p : (EX x. P(x)-->Q) <-> (ALL x. P(x)) --> Q"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
schematic_goal "?p : (ALL x. P(x)) | Q <-> (ALL x. P(x) | Q)"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problems requiring quantifier duplication"
(*Needs multiple instantiation of ALL.*)
schematic_goal "?p : (ALL x. P(x)-->P(f(x))) & P(d)-->P(f(f(f(d))))"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
(*Needs double instantiation of the quantifier*)
schematic_goal "?p : EX x. P(x) --> P(a) & P(b)"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
schematic_goal "?p : EX z. P(z) --> (ALL x. P(x))"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
text "Hard examples with quantifiers"
text "Problem 18"
schematic_goal "?p : EX y. ALL x. P(y)-->P(x)"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
text "Problem 19"
schematic_goal "?p : EX x. ALL y z. (P(y)-->Q(z)) --> (P(x)-->Q(x))"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
text "Problem 20"
schematic_goal "?p : (ALL x y. EX z. ALL w. (P(x)&Q(y)-->R(z)&S(w)))
--> (EX x y. P(x) & Q(y)) --> (EX z. R(z))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 21"
schematic_goal "?p : (EX x. P-->Q(x)) & (EX x. Q(x)-->P) --> (EX x. P<->Q(x))"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
text "Problem 22"
schematic_goal "?p : (ALL x. P <-> Q(x)) --> (P <-> (ALL x. Q(x)))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 23"
schematic_goal "?p : (ALL x. P | Q(x)) <-> (P | (ALL x. Q(x)))"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
text "Problem 24"
schematic_goal "?p : ~(EX x. S(x)&Q(x)) & (ALL x. P(x) --> Q(x)|R(x)) &
(~(EX x. P(x)) --> (EX x. Q(x))) & (ALL x. Q(x)|R(x) --> S(x))
--> (EX x. P(x)&R(x))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 25"
schematic_goal "?p : (EX x. P(x)) &
@@ -174,7 +174,7 @@
schematic_goal "?u : ((EX x. p(x)) <-> (EX x. q(x))) &
(ALL x. ALL y. p(x) & q(y) --> (r(x) <-> s(y)))
--> ((ALL x. p(x)-->r(x)) <-> (ALL x. q(x)-->s(x)))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 27"
schematic_goal "?p : (EX x. P(x) & ~Q(x)) &
@@ -182,49 +182,49 @@
(ALL x. M(x) & L(x) --> P(x)) &
((EX x. R(x) & ~ Q(x)) --> (ALL x. L(x) --> ~ R(x)))
--> (ALL x. M(x) --> ~L(x))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 28. AMENDED"
schematic_goal "?p : (ALL x. P(x) --> (ALL x. Q(x))) &
((ALL x. Q(x)|R(x)) --> (EX x. Q(x)&S(x))) &
((EX x. S(x)) --> (ALL x. L(x) --> M(x)))
--> (ALL x. P(x) & L(x) --> M(x))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 29. Essentially the same as Principia Mathematica *11.71"
schematic_goal "?p : (EX x. P(x)) & (EX y. Q(y))
--> ((ALL x. P(x)-->R(x)) & (ALL y. Q(y)-->S(y)) <->
(ALL x y. P(x) & Q(y) --> R(x) & S(y)))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 30"
schematic_goal "?p : (ALL x. P(x) | Q(x) --> ~ R(x)) &
(ALL x. (Q(x) --> ~ S(x)) --> P(x) & R(x))
--> (ALL x. S(x))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 31"
schematic_goal "?p : ~(EX x. P(x) & (Q(x) | R(x))) &
(EX x. L(x) & P(x)) &
(ALL x. ~ R(x) --> M(x))
--> (EX x. L(x) & M(x))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 32"
schematic_goal "?p : (ALL x. P(x) & (Q(x)|R(x))-->S(x)) &
(ALL x. S(x) & R(x) --> L(x)) &
(ALL x. M(x) --> R(x))
--> (ALL x. P(x) & M(x) --> L(x))"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
text "Problem 33"
schematic_goal "?p : (ALL x. P(a) & (P(x)-->P(b))-->P(c)) <->
(ALL x. (~P(a) | P(x) | P(c)) & (~P(a) | ~P(b) | P(c)))"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
text "Problem 35"
schematic_goal "?p : EX x y. P(x,y) --> (ALL u v. P(u,v))"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
text "Problem 36"
schematic_goal
@@ -232,7 +232,7 @@
(ALL x. EX y. G(x,y)) &
(ALL x y. J(x,y) | G(x,y) --> (ALL z. J(y,z) | G(y,z) --> H(x,z)))
--> (ALL x. EX y. H(x,y))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 37"
schematic_goal "?p : (ALL z. EX w. ALL x. EX y.
@@ -240,62 +240,62 @@
(ALL x z. ~P(x,z) --> (EX y. Q(y,z))) &
((EX x y. Q(x,y)) --> (ALL x. R(x,x)))
--> (ALL x. EX y. R(x,y))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 39"
schematic_goal "?p : ~ (EX x. ALL y. F(y,x) <-> ~F(y,y))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 40. AMENDED"
schematic_goal "?p : (EX y. ALL x. F(x,y) <-> F(x,x)) -->
~(ALL x. EX y. ALL z. F(z,y) <-> ~ F(z,x))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 41"
schematic_goal "?p : (ALL z. EX y. ALL x. f(x,y) <-> f(x,z) & ~ f(x,x))
--> ~ (EX z. ALL x. f(x,z))"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
text "Problem 44"
schematic_goal "?p : (ALL x. f(x) -->
(EX y. g(y) & h(x,y) & (EX y. g(y) & ~ h(x,y)))) &
(EX x. j(x) & (ALL y. g(y) --> h(x,y)))
--> (EX x. j(x) & ~f(x))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problems (mainly) involving equality or functions"
text "Problem 48"
schematic_goal "?p : (a=b | c=d) & (a=c | b=d) --> a=d | b=c"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 50"
(*What has this to do with equality?*)
schematic_goal "?p : (ALL x. P(a,x) | (ALL y. P(x,y))) --> (EX x. ALL y. P(x,y))"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
text "Problem 56"
schematic_goal
"?p : (ALL x. (EX y. P(y) & x=f(y)) --> P(x)) <-> (ALL x. P(x) --> P(f(x)))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 57"
schematic_goal
"?p : P(f(a,b), f(b,c)) & P(f(b,c), f(a,c)) &
(ALL x y z. P(x,y) & P(y,z) --> P(x,z)) --> P(f(a,b), f(a,c))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
text "Problem 58 NOT PROVED AUTOMATICALLY"
schematic_goal "?p : (ALL x y. f(x)=g(y)) --> (ALL x y. f(f(x))=f(g(y)))"
supply f_cong = subst_context [where t = f]
- by (tactic \<open>fast_tac @{context} (FOLP_cs addSIs [@{thm f_cong}]) 1\<close>)
+ by (tactic \<open>fast_tac \<^context> (FOLP_cs addSIs [@{thm f_cong}]) 1\<close>)
text "Problem 59"
schematic_goal "?p : (ALL x. P(x) <-> ~P(f(x))) --> (EX x. P(x) & ~P(f(x)))"
- by (tactic "best_tac @{context} FOLP_dup_cs 1")
+ by (tactic "best_tac \<^context> FOLP_dup_cs 1")
text "Problem 60"
schematic_goal "?p : ALL x. P(x,f(x)) <-> (EX y. (ALL z. P(z,y) --> P(z,f(x))) & P(x,y))"
- by (tactic "fast_tac @{context} FOLP_cs 1")
+ by (tactic "fast_tac \<^context> FOLP_cs 1")
end
--- a/src/FOLP/ex/If.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/ex/If.thy Fri Jan 04 23:22:53 2019 +0100
@@ -9,7 +9,7 @@
assumes "!!x. x : P ==> f(x) : Q" "!!x. x : ~P ==> g(x) : R"
shows "?p : if(P,Q,R)"
apply (unfold if_def)
-apply (tactic \<open>fast_tac @{context} (FOLP_cs addIs @{thms assms}) 1\<close>)
+apply (tactic \<open>fast_tac \<^context> (FOLP_cs addIs @{thms assms}) 1\<close>)
done
schematic_goal ifE:
@@ -19,7 +19,7 @@
shows "?p : S"
apply (insert 1)
apply (unfold if_def)
-apply (tactic \<open>fast_tac @{context} (FOLP_cs addIs [@{thm 2}, @{thm 3}]) 1\<close>)
+apply (tactic \<open>fast_tac \<^context> (FOLP_cs addIs [@{thm 2}, @{thm 3}]) 1\<close>)
done
schematic_goal if_commute: "?p : if(P, if(Q,A,B), if(Q,C,D)) <-> if(Q, if(P,A,C), if(P,B,D))"
@@ -33,11 +33,11 @@
ML \<open>val if_cs = FOLP_cs addSIs [@{thm ifI}] addSEs [@{thm ifE}]\<close>
schematic_goal if_commute: "?p : if(P, if(Q,A,B), if(Q,C,D)) <-> if(Q, if(P,A,C), if(P,B,D))"
-apply (tactic \<open>fast_tac @{context} if_cs 1\<close>)
+apply (tactic \<open>fast_tac \<^context> if_cs 1\<close>)
done
schematic_goal nested_ifs: "?p : if(if(P,Q,R), A, B) <-> if(P, if(Q,A,B), if(R,A,B))"
-apply (tactic \<open>fast_tac @{context} if_cs 1\<close>)
+apply (tactic \<open>fast_tac \<^context> if_cs 1\<close>)
done
end
--- a/src/FOLP/ex/Intro.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/ex/Intro.thy Fri Jan 04 23:22:53 2019 +0100
@@ -45,13 +45,13 @@
schematic_goal "?p : (EX y. ALL x. J(y,x) <-> ~J(x,x))
--> ~ (ALL x. EX y. ALL z. J(z,y) <-> ~ J(z,x))"
-apply (tactic \<open>fast_tac @{context} FOLP_cs 1\<close>)
+apply (tactic \<open>fast_tac \<^context> FOLP_cs 1\<close>)
done
schematic_goal "?p : ALL x. P(x,f(x)) <->
(EX y. (ALL z. P(z,y) --> P(z,f(x))) & P(x,y))"
-apply (tactic \<open>fast_tac @{context} FOLP_cs 1\<close>)
+apply (tactic \<open>fast_tac \<^context> FOLP_cs 1\<close>)
done
--- a/src/FOLP/ex/Intuitionistic.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/ex/Intuitionistic.thy Fri Jan 04 23:22:53 2019 +0100
@@ -31,39 +31,39 @@
begin
schematic_goal "?p : ~~(P&Q) <-> ~~P & ~~Q"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : ~~~P <-> ~P"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : ~~((P --> Q | R) --> (P-->Q) | (P-->R))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (P<->Q) <-> (Q<->P)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
subsection \<open>Lemmas for the propositional double-negation translation\<close>
schematic_goal "?p : P --> ~~P"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : ~~(~~P --> P)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : ~~P & ~~(P --> Q) --> ~~Q"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
subsection \<open>The following are classically but not constructively valid\<close>
(*The attempt to prove them terminates quickly!*)
schematic_goal "?p : ((P-->Q) --> P) --> P"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
oops
schematic_goal "?p : (P&Q-->R) --> (P-->R) | (Q-->R)"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
oops
@@ -71,74 +71,74 @@
text "Problem ~~1"
schematic_goal "?p : ~~((P-->Q) <-> (~Q --> ~P))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~2"
schematic_goal "?p : ~~(~~P <-> P)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem 3"
schematic_goal "?p : ~(P-->Q) --> (Q-->P)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~4"
schematic_goal "?p : ~~((~P-->Q) <-> (~Q --> P))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~5"
schematic_goal "?p : ~~((P|Q-->P|R) --> P|(Q-->R))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~6"
schematic_goal "?p : ~~(P | ~P)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~7"
schematic_goal "?p : ~~(P | ~~~P)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~8. Peirce's law"
schematic_goal "?p : ~~(((P-->Q) --> P) --> P)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem 9"
schematic_goal "?p : ((P|Q) & (~P|Q) & (P| ~Q)) --> ~ (~P | ~Q)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem 10"
schematic_goal "?p : (Q-->R) --> (R-->P&Q) --> (P-->(Q|R)) --> (P<->Q)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "11. Proved in each direction (incorrectly, says Pelletier!!) "
schematic_goal "?p : P<->P"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~12. Dijkstra's law "
schematic_goal "?p : ~~(((P <-> Q) <-> R) <-> (P <-> (Q <-> R)))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : ((P <-> Q) <-> R) --> ~~(P <-> (Q <-> R))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem 13. Distributive law"
schematic_goal "?p : P | (Q & R) <-> (P | Q) & (P | R)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~14"
schematic_goal "?p : ~~((P <-> Q) <-> ((Q | ~P) & (~Q|P)))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~15"
schematic_goal "?p : ~~((P --> Q) <-> (~P | Q))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~16"
schematic_goal "?p : ~~((P-->Q) | (Q-->P))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~17"
schematic_goal "?p : ~~(((P & (Q-->R))-->S) <-> ((~P | Q | S) & (~P | ~R | S)))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>) \<comment> \<open>slow\<close>
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>) \<comment> \<open>slow\<close>
subsection \<open>Examples with quantifiers\<close>
@@ -146,43 +146,43 @@
text "The converse is classical in the following implications..."
schematic_goal "?p : (EX x. P(x)-->Q) --> (ALL x. P(x)) --> Q"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : ((ALL x. P(x))-->Q) --> ~ (ALL x. P(x) & ~Q)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : ((ALL x. ~P(x))-->Q) --> ~ (ALL x. ~ (P(x)|Q))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (ALL x. P(x)) | Q --> (ALL x. P(x) | Q)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (EX x. P --> Q(x)) --> (P --> (EX x. Q(x)))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "The following are not constructively valid!"
text "The attempt to prove them terminates quickly!"
schematic_goal "?p : ((ALL x. P(x))-->Q) --> (EX x. P(x)-->Q)"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
oops
schematic_goal "?p : (P --> (EX x. Q(x))) --> (EX x. P-->Q(x))"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
oops
schematic_goal "?p : (ALL x. P(x) | Q) --> ((ALL x. P(x)) | Q)"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
oops
schematic_goal "?p : (ALL x. ~~P(x)) --> ~~(ALL x. P(x))"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
oops
(*Classically but not intuitionistically valid. Proved by a bug in 1986!*)
schematic_goal "?p : EX x. Q(x) --> (ALL x. Q(x))"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
oops
@@ -204,7 +204,7 @@
text "Problem 20"
schematic_goal "?p : (ALL x y. EX z. ALL w. (P(x)&Q(y)-->R(z)&S(w)))
--> (EX x y. P(x) & Q(y)) --> (EX z. R(z))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem 21"
schematic_goal "?p : (EX x. P-->Q(x)) & (EX x. Q(x)-->P) --> ~~(EX x. P<->Q(x))" oops
@@ -212,21 +212,21 @@
text "Problem 22"
schematic_goal "?p : (ALL x. P <-> Q(x)) --> (P <-> (ALL x. Q(x)))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem ~~23"
schematic_goal "?p : ~~ ((ALL x. P | Q(x)) <-> (P | (ALL x. Q(x))))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Problem 24"
schematic_goal "?p : ~(EX x. S(x)&Q(x)) & (ALL x. P(x) --> Q(x)|R(x)) &
(~(EX x. P(x)) --> (EX x. Q(x))) & (ALL x. Q(x)|R(x) --> S(x))
--> ~~(EX x. P(x)&R(x))"
(*Not clear why fast_tac, best_tac, ASTAR and ITER_DEEPEN all take forever*)
- apply (tactic "IntPr.safe_tac @{context}")
+ apply (tactic "IntPr.safe_tac \<^context>")
apply (erule impE)
- apply (tactic "IntPr.fast_tac @{context} 1")
- apply (tactic "IntPr.fast_tac @{context} 1")
+ apply (tactic "IntPr.fast_tac \<^context> 1")
+ apply (tactic "IntPr.fast_tac \<^context> 1")
done
text "Problem 25"
@@ -235,72 +235,72 @@
(ALL x. P(x) --> (M(x) & L(x))) &
((ALL x. P(x)-->Q(x)) | (EX x. P(x)&R(x)))
--> (EX x. Q(x)&P(x))"
- by (tactic "IntPr.best_tac @{context} 1")
+ by (tactic "IntPr.best_tac \<^context> 1")
text "Problem 29. Essentially the same as Principia Mathematica *11.71"
schematic_goal "?p : (EX x. P(x)) & (EX y. Q(y))
--> ((ALL x. P(x)-->R(x)) & (ALL y. Q(y)-->S(y)) <->
(ALL x y. P(x) & Q(y) --> R(x) & S(y)))"
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text "Problem ~~30"
schematic_goal "?p : (ALL x. (P(x) | Q(x)) --> ~ R(x)) &
(ALL x. (Q(x) --> ~ S(x)) --> P(x) & R(x))
--> (ALL x. ~~S(x))"
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text "Problem 31"
schematic_goal "?p : ~(EX x. P(x) & (Q(x) | R(x))) &
(EX x. L(x) & P(x)) &
(ALL x. ~ R(x) --> M(x))
--> (EX x. L(x) & M(x))"
- by (tactic "IntPr.fast_tac @{context} 1")
+ by (tactic "IntPr.fast_tac \<^context> 1")
text "Problem 32"
schematic_goal "?p : (ALL x. P(x) & (Q(x)|R(x))-->S(x)) &
(ALL x. S(x) & R(x) --> L(x)) &
(ALL x. M(x) --> R(x))
--> (ALL x. P(x) & M(x) --> L(x))"
- by (tactic "IntPr.best_tac @{context} 1") \<comment> \<open>slow\<close>
+ by (tactic "IntPr.best_tac \<^context> 1") \<comment> \<open>slow\<close>
text "Problem 39"
schematic_goal "?p : ~ (EX x. ALL y. F(y,x) <-> ~F(y,y))"
- by (tactic "IntPr.best_tac @{context} 1")
+ by (tactic "IntPr.best_tac \<^context> 1")
text "Problem 40. AMENDED"
schematic_goal "?p : (EX y. ALL x. F(x,y) <-> F(x,x)) -->
~(ALL x. EX y. ALL z. F(z,y) <-> ~ F(z,x))"
- by (tactic "IntPr.best_tac @{context} 1") \<comment> \<open>slow\<close>
+ by (tactic "IntPr.best_tac \<^context> 1") \<comment> \<open>slow\<close>
text "Problem 44"
schematic_goal "?p : (ALL x. f(x) -->
(EX y. g(y) & h(x,y) & (EX y. g(y) & ~ h(x,y)))) &
(EX x. j(x) & (ALL y. g(y) --> h(x,y)))
--> (EX x. j(x) & ~f(x))"
- by (tactic "IntPr.best_tac @{context} 1")
+ by (tactic "IntPr.best_tac \<^context> 1")
text "Problem 48"
schematic_goal "?p : (a=b | c=d) & (a=c | b=d) --> a=d | b=c"
- by (tactic "IntPr.best_tac @{context} 1")
+ by (tactic "IntPr.best_tac \<^context> 1")
text "Problem 51"
schematic_goal
"?p : (EX z w. ALL x y. P(x,y) <-> (x=z & y=w)) -->
(EX z. ALL x. EX w. (ALL y. P(x,y) <-> y=w) <-> x=z)"
- by (tactic "IntPr.best_tac @{context} 1") \<comment> \<open>60 seconds\<close>
+ by (tactic "IntPr.best_tac \<^context> 1") \<comment> \<open>60 seconds\<close>
text "Problem 56"
schematic_goal "?p : (ALL x. (EX y. P(y) & x=f(y)) --> P(x)) <-> (ALL x. P(x) --> P(f(x)))"
- by (tactic "IntPr.best_tac @{context} 1")
+ by (tactic "IntPr.best_tac \<^context> 1")
text "Problem 57"
schematic_goal
"?p : P(f(a,b), f(b,c)) & P(f(b,c), f(a,c)) &
(ALL x y z. P(x,y) & P(y,z) --> P(x,z)) --> P(f(a,b), f(a,c))"
- by (tactic "IntPr.best_tac @{context} 1")
+ by (tactic "IntPr.best_tac \<^context> 1")
text "Problem 60"
schematic_goal "?p : ALL x. P(x,f(x)) <-> (EX y. (ALL z. P(z,y) --> P(z,f(x))) & P(x,y))"
- by (tactic "IntPr.best_tac @{context} 1")
+ by (tactic "IntPr.best_tac \<^context> 1")
end
--- a/src/FOLP/ex/Nat.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/ex/Nat.thy Fri Jan 04 23:22:53 2019 +0100
@@ -84,24 +84,24 @@
ML \<open>
val add_ss =
FOLP_ss addcongs @{thms nat_congs}
- |> fold (addrew @{context}) @{thms add_0 add_Suc}
+ |> fold (addrew \<^context>) @{thms add_0 add_Suc}
\<close>
schematic_goal add_assoc: "?p : (k+m)+n = k+(m+n)"
apply (rule_tac n = k in induct)
-apply (tactic \<open>SIMP_TAC @{context} add_ss 1\<close>)
-apply (tactic \<open>ASM_SIMP_TAC @{context} add_ss 1\<close>)
+apply (tactic \<open>SIMP_TAC \<^context> add_ss 1\<close>)
+apply (tactic \<open>ASM_SIMP_TAC \<^context> add_ss 1\<close>)
done
schematic_goal add_0_right: "?p : m+0 = m"
apply (rule_tac n = m in induct)
-apply (tactic \<open>SIMP_TAC @{context} add_ss 1\<close>)
-apply (tactic \<open>ASM_SIMP_TAC @{context} add_ss 1\<close>)
+apply (tactic \<open>SIMP_TAC \<^context> add_ss 1\<close>)
+apply (tactic \<open>ASM_SIMP_TAC \<^context> add_ss 1\<close>)
done
schematic_goal add_Suc_right: "?p : m+Suc(n) = Suc(m+n)"
apply (rule_tac n = m in induct)
-apply (tactic \<open>ALLGOALS (ASM_SIMP_TAC @{context} add_ss)\<close>)
+apply (tactic \<open>ALLGOALS (ASM_SIMP_TAC \<^context> add_ss)\<close>)
done
(*mk_typed_congs appears not to work with FOLP's version of subst*)
--- a/src/FOLP/ex/Propositional_Cla.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/ex/Propositional_Cla.thy Fri Jan 04 23:22:53 2019 +0100
@@ -12,106 +12,106 @@
text "commutative laws of & and | "
schematic_goal "?p : P & Q --> Q & P"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : P | Q --> Q | P"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
text "associative laws of & and | "
schematic_goal "?p : (P & Q) & R --> P & (Q & R)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (P | Q) | R --> P | (Q | R)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
text "distributive laws of & and | "
schematic_goal "?p : (P & Q) | R --> (P | R) & (Q | R)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (P | R) & (Q | R) --> (P & Q) | R"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (P | Q) & R --> (P & R) | (Q & R)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (P & R) | (Q & R) --> (P | Q) & R"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
text "Laws involving implication"
schematic_goal "?p : (P-->R) & (Q-->R) <-> (P|Q --> R)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (P & Q --> R) <-> (P--> (Q-->R))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : ((P-->R)-->R) --> ((Q-->R)-->R) --> (P&Q-->R) --> R"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : ~(P-->R) --> ~(Q-->R) --> ~(P&Q-->R)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (P --> Q & R) <-> (P-->Q) & (P-->R)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
text "Propositions-as-types"
(*The combinator K*)
schematic_goal "?p : P --> (Q --> P)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
(*The combinator S*)
schematic_goal "?p : (P-->Q-->R) --> (P-->Q) --> (P-->R)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
(*Converse is classical*)
schematic_goal "?p : (P-->Q) | (P-->R) --> (P --> Q | R)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (P-->Q) --> (~Q --> ~P)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
text "Schwichtenberg's examples (via T. Nipkow)"
schematic_goal stab_imp: "?p : (((Q-->R)-->R)-->Q) --> (((P-->Q)-->R)-->R)-->P-->Q"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal stab_to_peirce: "?p : (((P --> R) --> R) --> P) --> (((Q --> R) --> R) --> Q)
--> ((P --> Q) --> P) --> P"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal peirce_imp1: "?p : (((Q --> R) --> Q) --> Q)
--> (((P --> Q) --> R) --> P --> Q) --> P --> Q"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal peirce_imp2: "?p : (((P --> R) --> P) --> P) --> ((P --> Q --> R) --> P) --> P"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal mints: "?p : ((((P --> Q) --> P) --> P) --> Q) --> Q"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal mints_solovev: "?p : (P --> (Q --> R) --> Q) --> ((P --> Q) --> R) --> R"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal tatsuta: "?p : (((P7 --> P1) --> P10) --> P4 --> P5)
--> (((P8 --> P2) --> P9) --> P3 --> P10)
--> (P1 --> P8) --> P6 --> P7
--> (((P3 --> P2) --> P9) --> P4)
--> (P1 --> P3) --> (((P6 --> P1) --> P2) --> P9) --> P5"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal tatsuta1: "?p : (((P8 --> P2) --> P9) --> P3 --> P10)
--> (((P3 --> P2) --> P9) --> P4)
--> (((P6 --> P1) --> P2) --> P9)
--> (((P7 --> P1) --> P10) --> P4 --> P5)
--> (P1 --> P3) --> (P1 --> P8) --> P6 --> P7 --> P5"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
end
--- a/src/FOLP/ex/Propositional_Int.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/ex/Propositional_Int.thy Fri Jan 04 23:22:53 2019 +0100
@@ -12,106 +12,106 @@
text "commutative laws of & and | "
schematic_goal "?p : P & Q --> Q & P"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : P | Q --> Q | P"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "associative laws of & and | "
schematic_goal "?p : (P & Q) & R --> P & (Q & R)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (P | Q) | R --> P | (Q | R)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "distributive laws of & and | "
schematic_goal "?p : (P & Q) | R --> (P | R) & (Q | R)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (P | R) & (Q | R) --> (P & Q) | R"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (P | Q) & R --> (P & R) | (Q & R)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (P & R) | (Q & R) --> (P | Q) & R"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Laws involving implication"
schematic_goal "?p : (P-->R) & (Q-->R) <-> (P|Q --> R)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (P & Q --> R) <-> (P--> (Q-->R))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : ((P-->R)-->R) --> ((Q-->R)-->R) --> (P&Q-->R) --> R"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : ~(P-->R) --> ~(Q-->R) --> ~(P&Q-->R)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (P --> Q & R) <-> (P-->Q) & (P-->R)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Propositions-as-types"
(*The combinator K*)
schematic_goal "?p : P --> (Q --> P)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
(*The combinator S*)
schematic_goal "?p : (P-->Q-->R) --> (P-->Q) --> (P-->R)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
(*Converse is classical*)
schematic_goal "?p : (P-->Q) | (P-->R) --> (P --> Q | R)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (P-->Q) --> (~Q --> ~P)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Schwichtenberg's examples (via T. Nipkow)"
schematic_goal stab_imp: "?p : (((Q-->R)-->R)-->Q) --> (((P-->Q)-->R)-->R)-->P-->Q"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal stab_to_peirce: "?p : (((P --> R) --> R) --> P) --> (((Q --> R) --> R) --> Q)
--> ((P --> Q) --> P) --> P"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal peirce_imp1: "?p : (((Q --> R) --> Q) --> Q)
--> (((P --> Q) --> R) --> P --> Q) --> P --> Q"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal peirce_imp2: "?p : (((P --> R) --> P) --> P) --> ((P --> Q --> R) --> P) --> P"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal mints: "?p : ((((P --> Q) --> P) --> P) --> Q) --> Q"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal mints_solovev: "?p : (P --> (Q --> R) --> Q) --> ((P --> Q) --> R) --> R"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal tatsuta: "?p : (((P7 --> P1) --> P10) --> P4 --> P5)
--> (((P8 --> P2) --> P9) --> P3 --> P10)
--> (P1 --> P8) --> P6 --> P7
--> (((P3 --> P2) --> P9) --> P4)
--> (P1 --> P3) --> (((P6 --> P1) --> P2) --> P9) --> P5"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal tatsuta1: "?p : (((P8 --> P2) --> P9) --> P3 --> P10)
--> (((P3 --> P2) --> P9) --> P4)
--> (((P6 --> P1) --> P2) --> P9)
--> (((P7 --> P1) --> P10) --> P4 --> P5)
--> (P1 --> P3) --> (P1 --> P8) --> P6 --> P7 --> P5"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
end
--- a/src/FOLP/ex/Quantifiers_Cla.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/ex/Quantifiers_Cla.thy Fri Jan 04 23:22:53 2019 +0100
@@ -11,91 +11,91 @@
begin
schematic_goal "?p : (ALL x y. P(x,y)) --> (ALL y x. P(x,y))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (EX x y. P(x,y)) --> (EX y x. P(x,y))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
(*Converse is false*)
schematic_goal "?p : (ALL x. P(x)) | (ALL x. Q(x)) --> (ALL x. P(x) | Q(x))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (ALL x. P-->Q(x)) <-> (P--> (ALL x. Q(x)))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (ALL x. P(x)-->Q) <-> ((EX x. P(x)) --> Q)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
text "Some harder ones"
schematic_goal "?p : (EX x. P(x) | Q(x)) <-> (EX x. P(x)) | (EX x. Q(x))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
(*Converse is false*)
schematic_goal "?p : (EX x. P(x)&Q(x)) --> (EX x. P(x)) & (EX x. Q(x))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
text "Basic test of quantifier reasoning"
(*TRUE*)
schematic_goal "?p : (EX y. ALL x. Q(x,y)) --> (ALL x. EX y. Q(x,y))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (ALL x. Q(x)) --> (EX x. Q(x))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
text "The following should fail, as they are false!"
schematic_goal "?p : (ALL x. EX y. Q(x,y)) --> (EX y. ALL x. Q(x,y))"
- apply (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)?
+ apply (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)?
oops
schematic_goal "?p : (EX x. Q(x)) --> (ALL x. Q(x))"
- apply (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)?
+ apply (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)?
oops
schematic_goal "?p : P(?a) --> (ALL x. P(x))"
- apply (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)?
+ apply (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)?
oops
schematic_goal "?p : (P(?a) --> (ALL x. Q(x))) --> (ALL x. P(x) --> Q(x))"
- apply (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)?
+ apply (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)?
oops
text "Back to things that are provable..."
schematic_goal "?p : (ALL x. P(x)-->Q(x)) & (EX x. P(x)) --> (EX x. Q(x))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
(*An example of why exI should be delayed as long as possible*)
schematic_goal "?p : (P --> (EX x. Q(x))) & P --> (EX x. Q(x))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (ALL x. P(x)-->Q(f(x))) & (ALL x. Q(x)-->R(g(x))) & P(d) --> R(?a)"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
schematic_goal "?p : (ALL x. Q(x)) --> (EX x. Q(x))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
text "Some slow ones"
(*Principia Mathematica *11.53 *)
schematic_goal "?p : (ALL x y. P(x) --> Q(y)) <-> ((EX x. P(x)) --> (ALL y. Q(y)))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
(*Principia Mathematica *11.55 *)
schematic_goal "?p : (EX x y. P(x) & Q(x,y)) <-> (EX x. P(x) & (EX y. Q(x,y)))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
(*Principia Mathematica *11.61 *)
schematic_goal "?p : (EX y. ALL x. P(x) --> Q(x,y)) --> (ALL x. P(x) --> (EX y. Q(x,y)))"
- by (tactic \<open>Cla.fast_tac @{context} FOLP_cs 1\<close>)
+ by (tactic \<open>Cla.fast_tac \<^context> FOLP_cs 1\<close>)
end
--- a/src/FOLP/ex/Quantifiers_Int.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/ex/Quantifiers_Int.thy Fri Jan 04 23:22:53 2019 +0100
@@ -11,91 +11,91 @@
begin
schematic_goal "?p : (ALL x y. P(x,y)) --> (ALL y x. P(x,y))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (EX x y. P(x,y)) --> (EX y x. P(x,y))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
(*Converse is false*)
schematic_goal "?p : (ALL x. P(x)) | (ALL x. Q(x)) --> (ALL x. P(x) | Q(x))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (ALL x. P-->Q(x)) <-> (P--> (ALL x. Q(x)))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (ALL x. P(x)-->Q) <-> ((EX x. P(x)) --> Q)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Some harder ones"
schematic_goal "?p : (EX x. P(x) | Q(x)) <-> (EX x. P(x)) | (EX x. Q(x))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
(*Converse is false*)
schematic_goal "?p : (EX x. P(x)&Q(x)) --> (EX x. P(x)) & (EX x. Q(x))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Basic test of quantifier reasoning"
(*TRUE*)
schematic_goal "?p : (EX y. ALL x. Q(x,y)) --> (ALL x. EX y. Q(x,y))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (ALL x. Q(x)) --> (EX x. Q(x))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "The following should fail, as they are false!"
schematic_goal "?p : (ALL x. EX y. Q(x,y)) --> (EX y. ALL x. Q(x,y))"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
oops
schematic_goal "?p : (EX x. Q(x)) --> (ALL x. Q(x))"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
oops
schematic_goal "?p : P(?a) --> (ALL x. P(x))"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
oops
schematic_goal "?p : (P(?a) --> (ALL x. Q(x))) --> (ALL x. P(x) --> Q(x))"
- apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
+ apply (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)?
oops
text "Back to things that are provable..."
schematic_goal "?p : (ALL x. P(x)-->Q(x)) & (EX x. P(x)) --> (EX x. Q(x))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
(*An example of why exI should be delayed as long as possible*)
schematic_goal "?p : (P --> (EX x. Q(x))) & P --> (EX x. Q(x))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (ALL x. P(x)-->Q(f(x))) & (ALL x. Q(x)-->R(g(x))) & P(d) --> R(?a)"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
schematic_goal "?p : (ALL x. Q(x)) --> (EX x. Q(x))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
text "Some slow ones"
(*Principia Mathematica *11.53 *)
schematic_goal "?p : (ALL x y. P(x) --> Q(y)) <-> ((EX x. P(x)) --> (ALL y. Q(y)))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
(*Principia Mathematica *11.55 *)
schematic_goal "?p : (EX x y. P(x) & Q(x,y)) <-> (EX x. P(x) & (EX y. Q(x,y)))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
(*Principia Mathematica *11.61 *)
schematic_goal "?p : (EX y. ALL x. P(x) --> Q(x,y)) --> (ALL x. P(x) --> (EX y. Q(x,y)))"
- by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
+ by (tactic \<open>IntPr.fast_tac \<^context> 1\<close>)
end
--- a/src/FOLP/hypsubst.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/hypsubst.ML Fri Jan 04 23:22:53 2019 +0100
@@ -58,8 +58,8 @@
assumption. Returns the number of intervening assumptions, paried with
the rule asm_rl (resp. sym). *)
fun eq_var bnd =
- let fun eq_var_aux k (Const(@{const_name Pure.all},_) $ Abs(_,_,t)) = eq_var_aux k t
- | eq_var_aux k (Const(@{const_name Pure.imp},_) $ A $ B) =
+ let fun eq_var_aux k (Const(\<^const_name>\<open>Pure.all\<close>,_) $ Abs(_,_,t)) = eq_var_aux k t
+ | eq_var_aux k (Const(\<^const_name>\<open>Pure.imp\<close>,_) $ A $ B) =
((k, inspect_pair bnd (dest_eq A))
(*Exception Match comes from inspect_pair or dest_eq*)
handle Match => eq_var_aux (k+1) B)
--- a/src/FOLP/simp.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/simp.ML Fri Jan 04 23:22:53 2019 +0100
@@ -399,10 +399,10 @@
else ();
(* Skip the first n hyps of a goal, and return the rest in generalized form *)
-fun strip_varify(Const(@{const_name Pure.imp}, _) $ H $ B, n, vs) =
+fun strip_varify(Const(\<^const_name>\<open>Pure.imp\<close>, _) $ H $ B, n, vs) =
if n=0 then subst_bounds(vs,H)::strip_varify(B,0,vs)
else strip_varify(B,n-1,vs)
- | strip_varify(Const(@{const_name Pure.all},_)$Abs(_,T,t), n, vs) =
+ | strip_varify(Const(\<^const_name>\<open>Pure.all\<close>,_)$Abs(_,T,t), n, vs) =
strip_varify(t,n,Var(("?",length vs),T)::vs)
| strip_varify _ = [];
--- a/src/FOLP/simpdata.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/FOLP/simpdata.ML Fri Jan 04 23:22:53 2019 +0100
@@ -17,18 +17,18 @@
(* Conversion into rewrite rules *)
fun mk_eq th = case Thm.concl_of th of
- _ $ (Const (@{const_name iff}, _) $ _ $ _) $ _ => th
- | _ $ (Const (@{const_name eq}, _) $ _ $ _) $ _ => th
- | _ $ (Const (@{const_name Not}, _) $ _) $ _ => th RS @{thm not_P_imp_P_iff_F}
+ _ $ (Const (\<^const_name>\<open>iff\<close>, _) $ _ $ _) $ _ => th
+ | _ $ (Const (\<^const_name>\<open>eq\<close>, _) $ _ $ _) $ _ => th
+ | _ $ (Const (\<^const_name>\<open>Not\<close>, _) $ _) $ _ => th RS @{thm not_P_imp_P_iff_F}
| _ => make_iff_T th;
val mksimps_pairs =
- [(@{const_name imp}, [@{thm mp}]),
- (@{const_name conj}, [@{thm conjunct1}, @{thm conjunct2}]),
- (@{const_name "All"}, [@{thm spec}]),
- (@{const_name True}, []),
- (@{const_name False}, [])];
+ [(\<^const_name>\<open>imp\<close>, [@{thm mp}]),
+ (\<^const_name>\<open>conj\<close>, [@{thm conjunct1}, @{thm conjunct2}]),
+ (\<^const_name>\<open>All\<close>, [@{thm spec}]),
+ (\<^const_name>\<open>True\<close>, []),
+ (\<^const_name>\<open>False\<close>, [])];
fun mk_atomize pairs =
let fun atoms th =
@@ -78,9 +78,9 @@
val auto_ss = empty_ss setauto (fn ctxt => ares_tac ctxt @{thms TrueI});
-val IFOLP_ss = auto_ss addcongs FOLP_congs |> fold (addrew @{context}) IFOLP_rews;
+val IFOLP_ss = auto_ss addcongs FOLP_congs |> fold (addrew \<^context>) IFOLP_rews;
val FOLP_rews = IFOLP_rews @ @{thms cla_rews};
-val FOLP_ss = auto_ss addcongs FOLP_congs |> fold (addrew @{context}) FOLP_rews;
+val FOLP_ss = auto_ss addcongs FOLP_congs |> fold (addrew \<^context>) FOLP_rews;
--- a/src/HOL/BNF_Wellorder_Relation.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/BNF_Wellorder_Relation.thy Fri Jan 04 23:22:53 2019 +0100
@@ -22,7 +22,7 @@
begin
text\<open>The following context encompasses all this section. In other words,
-for the whole section, we consider a fixed well-order relation @{term "r"}.\<close>
+for the whole section, we consider a fixed well-order relation \<^term>\<open>r\<close>.\<close>
(* context wo_rel *)
--- a/src/HOL/Binomial.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Binomial.thy Fri Jan 04 23:22:53 2019 +0100
@@ -425,7 +425,7 @@
by (simp add: gbinomial_binomial [symmetric] of_nat_gbinomial)
setup
- \<open>Sign.add_const_constraint (@{const_name gbinomial}, SOME @{typ "'a::field_char_0 \<Rightarrow> nat \<Rightarrow> 'a"})\<close>
+ \<open>Sign.add_const_constraint (\<^const_name>\<open>gbinomial\<close>, SOME \<^typ>\<open>'a::field_char_0 \<Rightarrow> nat \<Rightarrow> 'a\<close>)\<close>
lemma gbinomial_mult_1:
fixes a :: "'a::field_char_0"
@@ -622,7 +622,7 @@
qed
text \<open>Contributed by Manuel Eberl, generalised by LCP.
- Alternative definition of the binomial coefficient as @{term "\<Prod>i<k. (n - i) / (k - i)"}.\<close>
+ Alternative definition of the binomial coefficient as \<^term>\<open>\<Prod>i<k. (n - i) / (k - i)\<close>.\<close>
lemma gbinomial_altdef_of_nat: "a gchoose k = (\<Prod>i = 0..<k. (a - of_nat i) / of_nat (k - i) :: 'a)"
for k :: nat and a :: "'a::field_char_0"
by (simp add: prod_dividef gbinomial_prod_rev fact_prod_rev)
@@ -1142,7 +1142,7 @@
finally show ?thesis ..
qed
-text \<open>The number of nat lists of length \<open>m\<close> summing to \<open>N\<close> is @{term "(N + m - 1) choose N"}:\<close>
+text \<open>The number of nat lists of length \<open>m\<close> summing to \<open>N\<close> is \<^term>\<open>(N + m - 1) choose N\<close>:\<close>
lemma card_length_sum_list_rec:
assumes "m \<ge> 1"
shows "card {l::nat list. length l = m \<and> sum_list l = N} =
--- a/src/HOL/Code_Numeral.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Code_Numeral.thy Fri Jan 04 23:22:53 2019 +0100
@@ -668,8 +668,8 @@
setup \<open>
fold (fn target =>
- Numeral.add_code @{const_name Code_Numeral.Pos} I Code_Printer.literal_numeral target
- #> Numeral.add_code @{const_name Code_Numeral.Neg} (~) Code_Printer.literal_numeral target)
+ Numeral.add_code \<^const_name>\<open>Code_Numeral.Pos\<close> I Code_Printer.literal_numeral target
+ #> Numeral.add_code \<^const_name>\<open>Code_Numeral.Neg\<close> (~) Code_Printer.literal_numeral target)
["SML", "OCaml", "Haskell", "Scala"]
\<close>
--- a/src/HOL/Complete_Lattices.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Complete_Lattices.thy Fri Jan 04 23:22:53 2019 +0100
@@ -615,7 +615,7 @@
end
-subsection \<open>Complete lattice on @{typ bool}\<close>
+subsection \<open>Complete lattice on \<^typ>\<open>bool\<close>\<close>
instantiation bool :: complete_lattice
begin
@@ -644,7 +644,7 @@
instance bool :: complete_boolean_algebra
by (standard, fastforce)
-subsection \<open>Complete lattice on @{typ "_ \<Rightarrow> _"}\<close>
+subsection \<open>Complete lattice on \<^typ>\<open>_ \<Rightarrow> _\<close>\<close>
instantiation "fun" :: (type, Inf) Inf
begin
@@ -763,7 +763,7 @@
using assms by auto
-subsection \<open>Complete lattice on @{typ "_ set"}\<close>
+subsection \<open>Complete lattice on \<^typ>\<open>_ set\<close>\<close>
instantiation "set" :: (type) complete_lattice
begin
@@ -798,9 +798,9 @@
by (simp add: Inter_eq)
text \<open>
- \<^medskip> A ``destruct'' rule -- every @{term X} in @{term C}
- contains @{term A} as an element, but @{prop "A \<in> X"} can hold when
- @{prop "X \<in> C"} does not! This rule is analogous to \<open>spec\<close>.
+ \<^medskip> A ``destruct'' rule -- every \<^term>\<open>X\<close> in \<^term>\<open>C\<close>
+ contains \<^term>\<open>A\<close> as an element, but \<^prop>\<open>A \<in> X\<close> can hold when
+ \<^prop>\<open>X \<in> C\<close> does not! This rule is analogous to \<open>spec\<close>.
\<close>
lemma InterD [elim, Pure.elim]: "A \<in> \<Inter>C \<Longrightarrow> X \<in> C \<Longrightarrow> A \<in> X"
@@ -808,7 +808,7 @@
lemma InterE [elim]: "A \<in> \<Inter>C \<Longrightarrow> (X \<notin> C \<Longrightarrow> R) \<Longrightarrow> (A \<in> X \<Longrightarrow> R) \<Longrightarrow> R"
\<comment> \<open>``Classical'' elimination rule -- does not require proving
- @{prop "X \<in> C"}.\<close>
+ \<^prop>\<open>X \<in> C\<close>.\<close>
unfolding Inter_eq by blast
lemma Inter_lower: "B \<in> A \<Longrightarrow> \<Inter>A \<subseteq> B"
@@ -876,7 +876,7 @@
by auto
lemma INT_E [elim]: "b \<in> (\<Inter>x\<in>A. B x) \<Longrightarrow> (b \<in> B a \<Longrightarrow> R) \<Longrightarrow> (a \<notin> A \<Longrightarrow> R) \<Longrightarrow> R"
- \<comment> \<open>"Classical" elimination -- by the Excluded Middle on @{prop "a\<in>A"}.\<close>
+ \<comment> \<open>"Classical" elimination -- by the Excluded Middle on \<^prop>\<open>a\<in>A\<close>.\<close>
by auto
lemma Collect_ball_eq: "{x. \<forall>y\<in>A. P x y} = (\<Inter>y\<in>A. {x. P x y})"
@@ -949,8 +949,8 @@
by (unfold Union_eq) blast
lemma UnionI [intro]: "X \<in> C \<Longrightarrow> A \<in> X \<Longrightarrow> A \<in> \<Union>C"
- \<comment> \<open>The order of the premises presupposes that @{term C} is rigid;
- @{term A} may be flexible.\<close>
+ \<comment> \<open>The order of the premises presupposes that \<^term>\<open>C\<close> is rigid;
+ \<^term>\<open>A\<close> may be flexible.\<close>
by auto
lemma UnionE [elim!]: "A \<in> \<Union>C \<Longrightarrow> (\<And>X. A \<in> X \<Longrightarrow> X \<in> C \<Longrightarrow> R) \<Longrightarrow> R"
@@ -1023,7 +1023,7 @@
text \<open>
Note the difference between ordinary syntax of indexed
unions and intersections (e.g.\ \<open>\<Union>a\<^sub>1\<in>A\<^sub>1. B\<close>)
- and their \LaTeX\ rendition: @{term"\<Union>a\<^sub>1\<in>A\<^sub>1. B"}.
+ and their \LaTeX\ rendition: \<^term>\<open>\<Union>a\<^sub>1\<in>A\<^sub>1. B\<close>.
\<close>
lemma disjoint_UN_iff: "disjnt A (\<Union>i\<in>I. B i) \<longleftrightarrow> (\<forall>i\<in>I. disjnt A (B i))"
@@ -1045,8 +1045,8 @@
using Union_iff [of _ "B ` A"] by simp
lemma UN_I [intro]: "a \<in> A \<Longrightarrow> b \<in> B a \<Longrightarrow> b \<in> (\<Union>x\<in>A. B x)"
- \<comment> \<open>The order of the premises presupposes that @{term A} is rigid;
- @{term b} may be flexible.\<close>
+ \<comment> \<open>The order of the premises presupposes that \<^term>\<open>A\<close> is rigid;
+ \<^term>\<open>b\<close> may be flexible.\<close>
by auto
lemma UN_E [elim!]: "b \<in> (\<Union>x\<in>A. B x) \<Longrightarrow> (\<And>x. x\<in>A \<Longrightarrow> b \<in> B x \<Longrightarrow> R) \<Longrightarrow> R"
--- a/src/HOL/Complete_Partial_Order.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Complete_Partial_Order.thy Fri Jan 04 23:22:53 2019 +0100
@@ -11,7 +11,7 @@
subsection \<open>Monotone functions\<close>
-text \<open>Dictionary-passing version of @{const Orderings.mono}.\<close>
+text \<open>Dictionary-passing version of \<^const>\<open>Orderings.mono\<close>.\<close>
definition monotone :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
where "monotone orda ordb f \<longleftrightarrow> (\<forall>x y. orda x y \<longrightarrow> ordb (f x) (f y))"
--- a/src/HOL/Conditionally_Complete_Lattices.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Conditionally_Complete_Lattices.thy Fri Jan 04 23:22:53 2019 +0100
@@ -170,8 +170,8 @@
text \<open>
-To avoid name classes with the @{class complete_lattice}-class we prefix @{const Sup} and
-@{const Inf} in theorem names with c.
+To avoid name classes with the \<^class>\<open>complete_lattice\<close>-class we prefix \<^const>\<open>Sup\<close> and
+\<^const>\<open>Inf\<close> in theorem names with c.
\<close>
--- a/src/HOL/Deriv.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Deriv.thy Fri Jan 04 23:22:53 2019 +0100
@@ -20,10 +20,10 @@
((\<lambda>y. ((f y - f (Lim F (\<lambda>x. x))) - f' (y - Lim F (\<lambda>x. x))) /\<^sub>R norm (y - Lim F (\<lambda>x. x))) \<longlongrightarrow> 0) F"
text \<open>
- Usually the filter @{term F} is @{term "at x within s"}. @{term "(f has_derivative D)
- (at x within s)"} means: @{term D} is the derivative of function @{term f} at point @{term x}
- within the set @{term s}. Where @{term s} is used to express left or right sided derivatives. In
- most cases @{term s} is either a variable or @{term UNIV}.
+ Usually the filter \<^term>\<open>F\<close> is \<^term>\<open>at x within s\<close>. \<^term>\<open>(f has_derivative D)
+ (at x within s)\<close> means: \<^term>\<open>D\<close> is the derivative of function \<^term>\<open>f\<close> at point \<^term>\<open>x\<close>
+ within the set \<^term>\<open>s\<close>. Where \<^term>\<open>s\<close> is used to express left or right sided derivatives. In
+ most cases \<^term>\<open>s\<close> is either a variable or \<^term>\<open>UNIV\<close>.
\<close>
text \<open>These are the only cases we'll care about, probably.\<close>
@@ -60,7 +60,7 @@
Global_Theory.add_thms_dynamic
(\<^binding>\<open>derivative_eq_intros\<close>,
fn context =>
- Named_Theorems.get (Context.proof_of context) @{named_theorems derivative_intros}
+ Named_Theorems.get (Context.proof_of context) \<^named_theorems>\<open>derivative_intros\<close>
|> map_filter eq_rule)
end
\<close>
@@ -510,7 +510,7 @@
subsection \<open>Uniqueness\<close>
text \<open>
-This can not generally shown for @{const has_derivative}, as we need to approach the point from
+This can not generally shown for \<^const>\<open>has_derivative\<close>, as we need to approach the point from
all directions. There is a proof in \<open>Analysis\<close> for \<open>euclidean_space\<close>.
\<close>
@@ -1107,7 +1107,7 @@
subsection \<open>Local extrema\<close>
-text \<open>If @{term "0 < f' x"} then @{term x} is Locally Strictly Increasing At The Right.\<close>
+text \<open>If \<^term>\<open>0 < f' x\<close> then \<^term>\<open>x\<close> is Locally Strictly Increasing At The Right.\<close>
lemma has_real_derivative_pos_inc_right:
fixes f :: "real \<Rightarrow> real"
@@ -1273,10 +1273,10 @@
by (force dest: lemma_interval_lt)
text \<open>Rolle's Theorem.
- If @{term f} is defined and continuous on the closed interval
+ If \<^term>\<open>f\<close> is defined and continuous on the closed interval
\<open>[a,b]\<close> and differentiable on the open interval \<open>(a,b)\<close>,
- and @{term "f a = f b"},
- then there exists \<open>x0 \<in> (a,b)\<close> such that @{term "f' x0 = 0"}\<close>
+ and \<^term>\<open>f a = f b\<close>,
+ then there exists \<open>x0 \<in> (a,b)\<close> such that \<^term>\<open>f' x0 = 0\<close>\<close>
theorem Rolle_deriv:
fixes f :: "real \<Rightarrow> real"
assumes "a < b"
@@ -1301,7 +1301,7 @@
then show ?thesis
proof cases
case 1
- \<comment> \<open>@{term f} attains its maximum within the interval\<close>
+ \<comment> \<open>\<^term>\<open>f\<close> attains its maximum within the interval\<close>
then obtain l where der: "DERIV f x :> l"
using derf differentiable_def real_differentiable_def by blast
obtain d where d: "0 < d" and bound: "\<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
@@ -1321,7 +1321,7 @@
then show ?thesis
proof cases
case 1
- \<comment> \<open>@{term f} attains its minimum within the interval\<close>
+ \<comment> \<open>\<^term>\<open>f\<close> attains its minimum within the interval\<close>
then obtain l where der: "DERIV f x' :> l"
using derf differentiable_def real_differentiable_def by blast
from lemma_interval [OF 1]
@@ -1335,7 +1335,7 @@
by (metis has_derivative_unique has_field_derivative_def mult_zero_left)
next
case 2
- \<comment> \<open>@{term f} is constant throughout the interval\<close>
+ \<comment> \<open>\<^term>\<open>f\<close> is constant throughout the interval\<close>
then have fx': "f b = f x'" by (auto simp: fab)
from dense [OF \<open>a < b\<close>] obtain r where r: "a < r" "r < b" by blast
obtain d where d: "0 < d" and bound: "\<forall>y. \<bar>r - y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
--- a/src/HOL/Divides.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Divides.thy Fri Jan 04 23:22:53 2019 +0100
@@ -354,7 +354,7 @@
lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
-subsubsection \<open>Proving @{term "a div (b * c) = (a div b) div c"}\<close>
+subsubsection \<open>Proving \<^term>\<open>a div (b * c) = (a div b) div c\<close>\<close>
(*The condition c>0 seems necessary. Consider that 7 div ~6 = ~2 but
7 div 2 div ~3 = 3 div ~3 = ~1. The subcase (a div b) mod c = 0 seems
@@ -495,9 +495,9 @@
by (auto simp add: split_pos_lemma [of concl: "\<lambda>x y. P y"] split_neg_lemma [of concl: "\<lambda>x y. P y"])
qed auto
-text \<open>Enable (lin)arith to deal with @{const divide} and @{const modulo}
+text \<open>Enable (lin)arith to deal with \<^const>\<open>divide\<close> and \<^const>\<open>modulo\<close>
when these are applied to some constant that is of the form
- @{term "numeral k"}:\<close>
+ \<^term>\<open>numeral k\<close>:\<close>
declare split_zdiv [of _ _ "numeral k", arith_split] for k
declare split_zmod [of _ _ "numeral k", arith_split] for k
@@ -1257,7 +1257,7 @@
"- numeral a div numeral b :: int" | "- numeral a mod numeral b :: int" |
"- numeral a div - numeral b :: int" | "- numeral a mod - numeral b :: int") =
\<open> let
- val if_cong = the (Code.get_case_cong @{theory} @{const_name If});
+ val if_cong = the (Code.get_case_cong \<^theory> \<^const_name>\<open>If\<close>);
fun successful_rewrite ctxt ct =
let
val thm = Simplifier.rewrite ctxt ct
--- a/src/HOL/Eisbach/Eisbach_Tools.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Eisbach/Eisbach_Tools.thy Fri Jan 04 23:22:53 2019 +0100
@@ -27,17 +27,17 @@
val _ =
Theory.setup
- (setup_trace_method @{binding print_fact}
+ (setup_trace_method \<^binding>\<open>print_fact\<close>
(Scan.lift (Scan.ahead Parse.not_eof) -- Attrib.thms)
(fn ctxt => fn (tok, thms) =>
(* FIXME proper formatting!? *)
Token.unparse tok ^ ": " ^ commas (map (Thm.string_of_thm ctxt) thms)) #>
- setup_trace_method @{binding print_term}
+ setup_trace_method \<^binding>\<open>print_term\<close>
(Scan.lift (Scan.ahead Parse.not_eof) -- Args.term)
(fn ctxt => fn (tok, t) =>
(* FIXME proper formatting!? *)
Token.unparse tok ^ ": " ^ Syntax.string_of_term ctxt t) #>
- setup_trace_method @{binding print_type}
+ setup_trace_method \<^binding>\<open>print_type\<close>
(Scan.lift (Scan.ahead Parse.not_eof) -- Args.typ)
(fn ctxt => fn (tok, t) =>
(* FIXME proper formatting!? *)
--- a/src/HOL/Eisbach/eisbach_rule_insts.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Eisbach/eisbach_rule_insts.ML Fri Jan 04 23:22:53 2019 +0100
@@ -199,7 +199,7 @@
val _ =
Theory.setup
- (Attrib.setup @{binding "where"}
+ (Attrib.setup \<^binding>\<open>where\<close>
(Scan.lift
(Parse.and_list1 (Args.var -- (Args.$$$ "=" |-- Parse_Tools.name_term)) -- Parse.for_fixes)
>> (fn args =>
@@ -211,7 +211,7 @@
val _ =
Theory.setup
- (Attrib.setup @{binding "of"}
+ (Attrib.setup \<^binding>\<open>of\<close>
(Scan.lift
(Args.mode "unchecked" --
(Scan.repeat (Scan.unless concl inst) --
--- a/src/HOL/Eisbach/match_method.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Eisbach/match_method.ML Fri Jan 04 23:22:53 2019 +0100
@@ -44,9 +44,9 @@
val aconv_net = Item_Net.init (op aconv) single;
val parse_match_kind =
- Scan.lift @{keyword "conclusion"} >> K Match_Concl ||
- Scan.lift (@{keyword "premises"} |-- Args.mode "local") >> Match_Prems ||
- Scan.lift (@{keyword "("}) |-- Args.term --| Scan.lift (@{keyword ")"}) >>
+ Scan.lift \<^keyword>\<open>conclusion\<close> >> K Match_Concl ||
+ Scan.lift (\<^keyword>\<open>premises\<close> |-- Args.mode "local") >> Match_Prems ||
+ Scan.lift (\<^keyword>\<open>(\<close>) |-- Args.term --| Scan.lift (\<^keyword>\<open>)\<close>) >>
(fn t => Match_Term (Item_Net.update t aconv_net)) ||
Attrib.thms >> (fn thms => Match_Fact (fold Item_Net.update thms Thm.full_rules));
@@ -62,10 +62,10 @@
val fixes =
Parse.and_list1 (Scan.repeat1 (Parse.position bound_term) --
- Scan.option (@{keyword "::"} |-- Parse.!!! Parse.typ)
+ Scan.option (\<^keyword>\<open>::\<close> |-- Parse.!!! Parse.typ)
>> (fn (xs, T) => map (fn (x, pos) => ((x, T), pos)) xs)) >> flat;
-val for_fixes = Scan.optional (@{keyword "for"} |-- fixes) [];
+val for_fixes = Scan.optional (\<^keyword>\<open>for\<close> |-- fixes) [];
fun pos_of dyn = Parse_Tools.the_parse_val dyn |> Binding.pos_of;
@@ -95,7 +95,7 @@
else
let val b = #1 (the opt_dyn)
in error ("Cannot bind fact name in term match" ^ Position.here (pos_of b)) end)) --
- Scan.lift (for_fixes -- (@{keyword "\<Rightarrow>"} |-- Parse.token Parse.text))
+ Scan.lift (for_fixes -- (\<^keyword>\<open>\<Rightarrow>\<close> |-- Parse.token Parse.text))
>> (fn ((ctxt, ts), (fixes, body)) =>
(case Token.get_value body of
SOME (Token.Source src) =>
@@ -124,11 +124,11 @@
fun drop_judgment_dummy t =
(case t of
Const (judgment, _) $
- (Const (@{syntax_const "_type_constraint_"}, T) $
- Const (@{const_name Pure.dummy_pattern}, _)) =>
+ (Const (\<^syntax_const>\<open>_type_constraint_\<close>, T) $
+ Const (\<^const_name>\<open>Pure.dummy_pattern\<close>, _)) =>
if judgment = Object_Logic.judgment_name ctxt then
- Const (@{syntax_const "_type_constraint_"}, T) $
- Const (@{const_name Pure.dummy_pattern}, propT)
+ Const (\<^syntax_const>\<open>_type_constraint_\<close>, T) $
+ Const (\<^const_name>\<open>Pure.dummy_pattern\<close>, propT)
else t
| t1 $ t2 => drop_judgment_dummy t1 $ drop_judgment_dummy t2
| Abs (a, T, b) => Abs (a, T, drop_judgment_dummy b)
@@ -400,7 +400,7 @@
(*TODO: Preliminary analysis to see if we're trying to clear in a non-focus match?*)
val _ =
Theory.setup
- (Attrib.setup @{binding "thin"}
+ (Attrib.setup \<^binding>\<open>thin\<close>
(Scan.succeed
(Thm.declaration_attribute (fn th => Context.mapping I (remove_focus_prem th))))
"clear premise inside match method");
@@ -730,9 +730,9 @@
val _ =
Theory.setup
- (Method.setup @{binding match}
+ (Method.setup \<^binding>\<open>match\<close>
(parse_match_kind :--
- (fn kind => Scan.lift @{keyword "in"} |-- Parse.enum1' "\<bar>" (parse_named_pats kind)) >>
+ (fn kind => Scan.lift \<^keyword>\<open>in\<close> |-- Parse.enum1' "\<bar>" (parse_named_pats kind)) >>
(fn (matches, bodies) => fn ctxt =>
CONTEXT_METHOD (fn using => Method.RUNTIME (fn (goal_ctxt, st) =>
let
--- a/src/HOL/Eisbach/method_closure.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Eisbach/method_closure.ML Fri Jan 04 23:22:53 2019 +0100
@@ -239,12 +239,12 @@
end;
val _ =
- Outer_Syntax.local_theory @{command_keyword method} "Eisbach method definition"
+ Outer_Syntax.local_theory \<^command_keyword>\<open>method\<close> "Eisbach method definition"
(Parse.binding -- Parse.for_fixes --
- ((Scan.optional (@{keyword "methods"} |-- Parse.!!! (Scan.repeat1 Parse.binding)) []) --
- (Scan.optional (@{keyword "uses"} |-- Parse.!!! (Scan.repeat1 Parse.binding)) [])) --
- (Scan.optional (@{keyword "declares"} |-- Parse.!!! (Scan.repeat1 Parse.binding)) []) --
- Parse.!!! (@{keyword "="} |-- Parse.args1 (K true)) >>
+ ((Scan.optional (\<^keyword>\<open>methods\<close> |-- Parse.!!! (Scan.repeat1 Parse.binding)) []) --
+ (Scan.optional (\<^keyword>\<open>uses\<close> |-- Parse.!!! (Scan.repeat1 Parse.binding)) [])) --
+ (Scan.optional (\<^keyword>\<open>declares\<close> |-- Parse.!!! (Scan.repeat1 Parse.binding)) []) --
+ Parse.!!! (\<^keyword>\<open>=\<close> |-- Parse.args1 (K true)) >>
(fn ((((name, vars), (methods, uses)), declares), src) =>
#2 o method_cmd name vars uses declares methods src));
--- a/src/HOL/Enum.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Enum.thy Fri Jan 04 23:22:53 2019 +0100
@@ -52,7 +52,7 @@
end
-subsection \<open>Implementations using @{class enum}\<close>
+subsection \<open>Implementations using \<^class>\<open>enum\<close>\<close>
subsubsection \<open>Unbounded operations and quantifiers\<close>
@@ -241,7 +241,7 @@
by (simp add: card_UNIV_def acc_bacc_eq)
-subsection \<open>Default instances for @{class enum}\<close>
+subsection \<open>Default instances for \<^class>\<open>enum\<close>\<close>
lemma map_of_zip_enum_is_Some:
assumes "length ys = length (enum :: 'a::enum list)"
@@ -566,7 +566,7 @@
simproc_setup finite_1_eq ("x::finite_1") = \<open>
fn _ => fn _ => fn ct =>
(case Thm.term_of ct of
- Const (@{const_name a\<^sub>1}, _) => NONE
+ Const (\<^const_name>\<open>a\<^sub>1\<close>, _) => NONE
| _ => SOME (mk_meta_eq @{thm finite_1_eq}))
\<close>
@@ -993,8 +993,8 @@
instantiation finite_4 :: finite_distrib_lattice begin
-text \<open>@{term a\<^sub>1} $<$ @{term a\<^sub>2},@{term a\<^sub>3} $<$ @{term a\<^sub>4},
- but @{term a\<^sub>2} and @{term a\<^sub>3} are incomparable.\<close>
+text \<open>\<^term>\<open>a\<^sub>1\<close> $<$ \<^term>\<open>a\<^sub>2\<close>,\<^term>\<open>a\<^sub>3\<close> $<$ \<^term>\<open>a\<^sub>4\<close>,
+ but \<^term>\<open>a\<^sub>2\<close> and \<^term>\<open>a\<^sub>3\<close> are incomparable.\<close>
definition
"x < y \<longleftrightarrow> (case (x, y) of
--- a/src/HOL/Euclidean_Division.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Euclidean_Division.thy Fri Jan 04 23:22:53 2019 +0100
@@ -761,7 +761,7 @@
end
-subsection \<open>Euclidean division on @{typ nat}\<close>
+subsection \<open>Euclidean division on \<^typ>\<open>nat\<close>\<close>
instantiation nat :: normalization_semidom
begin
@@ -889,10 +889,10 @@
ML \<open>
structure Cancel_Div_Mod_Nat = Cancel_Div_Mod
(
- val div_name = @{const_name divide};
- val mod_name = @{const_name modulo};
+ val div_name = \<^const_name>\<open>divide\<close>;
+ val mod_name = \<^const_name>\<open>modulo\<close>;
val mk_binop = HOLogic.mk_binop;
- val dest_plus = HOLogic.dest_bin @{const_name Groups.plus} HOLogic.natT;
+ val dest_plus = HOLogic.dest_bin \<^const_name>\<open>Groups.plus\<close> HOLogic.natT;
val mk_sum = Arith_Data.mk_sum;
fun dest_sum tm =
if HOLogic.is_zero tm then []
@@ -1145,7 +1145,7 @@
by (simp add: div_add1_eq [of m q k])
qed
-text \<open>Antimonotonicity of @{const divide} in second argument\<close>
+text \<open>Antimonotonicity of \<^const>\<open>divide\<close> in second argument\<close>
lemma div_le_mono2:
"k div n \<le> k div m" if "0 < m" and "m \<le> n" for m n k :: nat
@@ -1408,7 +1408,7 @@
qed
-subsection \<open>Euclidean division on @{typ int}\<close>
+subsection \<open>Euclidean division on \<^typ>\<open>int\<close>\<close>
instantiation int :: normalization_semidom
begin
--- a/src/HOL/Extraction.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Extraction.thy Fri Jan 04 23:22:53 2019 +0100
@@ -22,7 +22,7 @@
Proofterm.rewrite_proof thy
(RewriteHOLProof.rews,
ProofRewriteRules.rprocs true @ [ProofRewriteRules.expand_of_class ctxt]) o
- ProofRewriteRules.elim_vars (curry Const @{const_name default})
+ ProofRewriteRules.elim_vars (curry Const \<^const_name>\<open>default\<close>)
end)
\<close>
--- a/src/HOL/Fields.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Fields.thy Fri Jan 04 23:22:53 2019 +0100
@@ -942,7 +942,7 @@
apply (simp add: less_imp_not_eq nonzero_minus_divide_right [symmetric])
done
-text\<open>The last premise ensures that @{term a} and @{term b}
+text\<open>The last premise ensures that \<^term>\<open>a\<close> and \<^term>\<open>b\<close>
have the same sign\<close>
lemma divide_strict_left_mono:
"[|b < a; 0 < c; 0 < a*b|] ==> c / a < c / b"
@@ -1268,7 +1268,7 @@
finally show ?thesis .
qed
-text\<open>For creating values between @{term u} and @{term v}.\<close>
+text\<open>For creating values between \<^term>\<open>u\<close> and \<^term>\<open>v\<close>.\<close>
lemma scaling_mono:
assumes "u \<le> v" "0 \<le> r" "r \<le> s"
shows "u + r * (v - u) / s \<le> v"
--- a/src/HOL/Filter.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Filter.thy Fri Jan 04 23:22:53 2019 +0100
@@ -251,8 +251,8 @@
subsubsection \<open>Finer-than relation\<close>
-text \<open>@{term "F \<le> F'"} means that filter @{term F} is finer than
-filter @{term F'}.\<close>
+text \<open>\<^term>\<open>F \<le> F'\<close> means that filter \<^term>\<open>F\<close> is finer than
+filter \<^term>\<open>F'\<close>.\<close>
instantiation filter :: (type) complete_lattice
begin
@@ -1395,7 +1395,7 @@
unfolding filterlim_def
by (rule order_trans[OF filtermap_Pair prod_filter_mono])
-subsection \<open>Limits to @{const at_top} and @{const at_bot}\<close>
+subsection \<open>Limits to \<^const>\<open>at_top\<close> and \<^const>\<open>at_bot\<close>\<close>
lemma filterlim_at_top:
fixes f :: "'a \<Rightarrow> ('b::linorder)"
@@ -1527,7 +1527,7 @@
by eventually_elim (insert n, auto)
qed
-subsection \<open>Setup @{typ "'a filter"} for lifting and transfer\<close>
+subsection \<open>Setup \<^typ>\<open>'a filter\<close> for lifting and transfer\<close>
lemma filtermap_id [simp, id_simps]: "filtermap id = id"
by(simp add: fun_eq_iff id_def filtermap_ident)
--- a/src/HOL/Finite_Set.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Finite_Set.thy Fri Jan 04 23:22:53 2019 +0100
@@ -777,7 +777,7 @@
text \<open>
A tempting alternative for the definiens is
- @{term "if finite A then THE y. fold_graph f z A y else e"}.
+ \<^term>\<open>if finite A then THE y. fold_graph f z A y else e\<close>.
It allows the removal of finiteness assumptions from the theorems
\<open>fold_comm\<close>, \<open>fold_reindex\<close> and \<open>fold_distrib\<close>.
The proofs become ugly. It is not worth the effort. (???)
@@ -787,7 +787,7 @@
by (induct rule: finite_induct) auto
-subsubsection \<open>From @{const fold_graph} to @{term fold}\<close>
+subsubsection \<open>From \<^const>\<open>fold_graph\<close> to \<^term>\<open>fold\<close>\<close>
context comp_fun_commute
begin
@@ -868,7 +868,7 @@
lemma (in -) fold_empty [simp]: "fold f z {} = z"
by (auto simp: fold_def)
-text \<open>The various recursion equations for @{const fold}:\<close>
+text \<open>The various recursion equations for \<^const>\<open>fold\<close>:\<close>
lemma fold_insert [simp]:
assumes "finite A" and "x \<notin> A"
@@ -933,7 +933,7 @@
end
-text \<open>Other properties of @{const fold}:\<close>
+text \<open>Other properties of \<^const>\<open>fold\<close>:\<close>
lemma fold_image:
assumes "inj_on g A"
@@ -1101,7 +1101,7 @@
qed
-subsubsection \<open>Expressing set operations via @{const fold}\<close>
+subsubsection \<open>Expressing set operations via \<^const>\<open>fold\<close>\<close>
lemma comp_fun_commute_const: "comp_fun_commute (\<lambda>_. f)"
by standard rule
@@ -1356,9 +1356,9 @@
text \<open>
The traditional definition
- @{prop "card A \<equiv> LEAST n. \<exists>f. A = {f i |i. i < n}"}
+ \<^prop>\<open>card A \<equiv> LEAST n. \<exists>f. A = {f i |i. i < n}\<close>
is ugly to work with.
- But now that we have @{const fold} things are easy:
+ But now that we have \<^const>\<open>fold\<close> things are easy:
\<close>
global_interpretation card: folding "\<lambda>_. Suc" 0
--- a/src/HOL/Fun.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Fun.thy Fri Jan 04 23:22:53 2019 +0100
@@ -856,16 +856,16 @@
simproc_setup fun_upd2 ("f(v := w, x := y)") = \<open>fn _ =>
let
fun gen_fun_upd NONE T _ _ = NONE
- | gen_fun_upd (SOME f) T x y = SOME (Const (@{const_name fun_upd}, T) $ f $ x $ y)
+ | gen_fun_upd (SOME f) T x y = SOME (Const (\<^const_name>\<open>fun_upd\<close>, T) $ f $ x $ y)
fun dest_fun_T1 (Type (_, T :: Ts)) = T
- fun find_double (t as Const (@{const_name fun_upd},T) $ f $ x $ y) =
+ fun find_double (t as Const (\<^const_name>\<open>fun_upd\<close>,T) $ f $ x $ y) =
let
- fun find (Const (@{const_name fun_upd},T) $ g $ v $ w) =
+ fun find (Const (\<^const_name>\<open>fun_upd\<close>,T) $ g $ v $ w) =
if v aconv x then SOME g else gen_fun_upd (find g) T v w
| find t = NONE
in (dest_fun_T1 T, gen_fun_upd (find f) T x y) end
- val ss = simpset_of @{context}
+ val ss = simpset_of \<^context>
fun proc ctxt ct =
let
--- a/src/HOL/GCD.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/GCD.thy Fri Jan 04 23:22:53 2019 +0100
@@ -1709,7 +1709,7 @@
end
-subsection \<open>GCD and LCM on @{typ nat} and @{typ int}\<close>
+subsection \<open>GCD and LCM on \<^typ>\<open>nat\<close> and \<^typ>\<open>int\<close>\<close>
instantiation nat :: gcd
begin
@@ -1893,7 +1893,7 @@
declare gcd_nat.simps [simp del]
text \<open>
- \<^medskip> @{term "gcd m n"} divides \<open>m\<close> and \<open>n\<close>.
+ \<^medskip> \<^term>\<open>gcd m n\<close> divides \<open>m\<close> and \<open>n\<close>.
The conjunctions don't seem provable separately.
\<close>
@@ -2368,7 +2368,7 @@
qed
-subsection \<open>LCM properties on @{typ nat} and @{typ int}\<close>
+subsection \<open>LCM properties on \<^typ>\<open>nat\<close> and \<^typ>\<open>int\<close>\<close>
lemma lcm_altdef_int [code]: "lcm a b = \<bar>a\<bar> * \<bar>b\<bar> div gcd a b"
for a b :: int
@@ -2445,7 +2445,7 @@
by auto
-subsection \<open>The complete divisibility lattice on @{typ nat} and @{typ int}\<close>
+subsection \<open>The complete divisibility lattice on \<^typ>\<open>nat\<close> and \<^typ>\<open>int\<close>\<close>
text \<open>
Lifting \<open>gcd\<close> and \<open>lcm\<close> to sets (\<open>Gcd\<close> / \<open>Lcm\<close>).
@@ -2670,7 +2670,7 @@
qed simp_all
-subsection \<open>GCD and LCM on @{typ integer}\<close>
+subsection \<open>GCD and LCM on \<^typ>\<open>integer\<close>\<close>
instantiation integer :: gcd
begin
--- a/src/HOL/Groebner_Basis.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Groebner_Basis.thy Fri Jan 04 23:22:53 2019 +0100
@@ -10,9 +10,9 @@
subsection \<open>Groebner Bases\<close>
-lemmas bool_simps = simp_thms(1-34) \<comment> \<open>FIXME move to @{theory HOL.HOL}\<close>
+lemmas bool_simps = simp_thms(1-34) \<comment> \<open>FIXME move to \<^theory>\<open>HOL.HOL\<close>\<close>
-lemma nnf_simps: \<comment> \<open>FIXME shadows fact binding in @{theory HOL.HOL}\<close>
+lemma nnf_simps: \<comment> \<open>FIXME shadows fact binding in \<^theory>\<open>HOL.HOL\<close>\<close>
"(\<not>(P \<and> Q)) = (\<not>P \<or> \<not>Q)" "(\<not>(P \<or> Q)) = (\<not>P \<and> \<not>Q)"
"(P \<longrightarrow> Q) = (\<not>P \<or> Q)"
"(P = Q) = ((P \<and> Q) \<or> (\<not>P \<and> \<not> Q))" "(\<not> \<not>(P)) = P"
--- a/src/HOL/Groups.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Groups.thy Fri Jan 04 23:22:53 2019 +0100
@@ -167,8 +167,8 @@
setup \<open>
Reorient_Proc.add
- (fn Const(@{const_name Groups.zero}, _) => true
- | Const(@{const_name Groups.one}, _) => true
+ (fn Const(\<^const_name>\<open>Groups.zero\<close>, _) => true
+ | Const(\<^const_name>\<open>Groups.one\<close>, _) => true
| _ => false)
\<close>
@@ -179,10 +179,10 @@
let
fun tr' c = (c, fn ctxt => fn T => fn ts =>
if null ts andalso Printer.type_emphasis ctxt T then
- Syntax.const @{syntax_const "_constrain"} $ Syntax.const c $
+ Syntax.const \<^syntax_const>\<open>_constrain\<close> $ Syntax.const c $
Syntax_Phases.term_of_typ ctxt T
else raise Match);
- in map tr' [@{const_syntax Groups.one}, @{const_syntax Groups.zero}] end
+ in map tr' [\<^const_syntax>\<open>Groups.one\<close>, \<^const_syntax>\<open>Groups.zero\<close>] end
\<close> \<comment> \<open>show types that are presumably too general\<close>
class plus =
--- a/src/HOL/Groups_Big.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Groups_Big.thy Fri Jan 04 23:22:53 2019 +0100
@@ -519,7 +519,7 @@
end
-text \<open>Now: lots of fancy syntax. First, @{term "sum (\<lambda>x. e) A"} is written \<open>\<Sum>x\<in>A. e\<close>.\<close>
+text \<open>Now: lots of fancy syntax. First, \<^term>\<open>sum (\<lambda>x. e) A\<close> is written \<open>\<Sum>x\<in>A. e\<close>.\<close>
syntax (ASCII)
"_sum" :: "pttrn \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b::comm_monoid_add" ("(3SUM (_/:_)./ _)" [0, 51, 10] 10)
@@ -528,7 +528,7 @@
translations \<comment> \<open>Beware of argument permutation!\<close>
"\<Sum>i\<in>A. b" \<rightleftharpoons> "CONST sum (\<lambda>i. b) A"
-text \<open>Instead of @{term"\<Sum>x\<in>{x. P}. e"} we introduce the shorter \<open>\<Sum>x|P. e\<close>.\<close>
+text \<open>Instead of \<^term>\<open>\<Sum>x\<in>{x. P}. e\<close> we introduce the shorter \<open>\<Sum>x|P. e\<close>.\<close>
syntax (ASCII)
"_qsum" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(3SUM _ |/ _./ _)" [0, 0, 10] 10)
@@ -539,7 +539,7 @@
print_translation \<open>
let
- fun sum_tr' [Abs (x, Tx, t), Const (@{const_syntax Collect}, _) $ Abs (y, Ty, P)] =
+ fun sum_tr' [Abs (x, Tx, t), Const (\<^const_syntax>\<open>Collect\<close>, _) $ Abs (y, Ty, P)] =
if x <> y then raise Match
else
let
@@ -547,10 +547,10 @@
val t' = subst_bound (x', t);
val P' = subst_bound (x', P);
in
- Syntax.const @{syntax_const "_qsum"} $ Syntax_Trans.mark_bound_abs (x, Tx) $ P' $ t'
+ Syntax.const \<^syntax_const>\<open>_qsum\<close> $ Syntax_Trans.mark_bound_abs (x, Tx) $ P' $ t'
end
| sum_tr' _ = raise Match;
-in [(@{const_syntax sum}, K sum_tr')] end
+in [(\<^const_syntax>\<open>sum\<close>, K sum_tr')] end
\<close>
@@ -938,7 +938,7 @@
qed simp_all
-subsubsection \<open>Cardinality as special case of @{const sum}\<close>
+subsubsection \<open>Cardinality as special case of \<^const>\<open>sum\<close>\<close>
lemma card_eq_sum: "card A = sum (\<lambda>x. 1) A"
proof -
@@ -1134,7 +1134,7 @@
translations \<comment> \<open>Beware of argument permutation!\<close>
"\<Prod>i\<in>A. b" == "CONST prod (\<lambda>i. b) A"
-text \<open>Instead of @{term"\<Prod>x\<in>{x. P}. e"} we introduce the shorter \<open>\<Prod>x|P. e\<close>.\<close>
+text \<open>Instead of \<^term>\<open>\<Prod>x\<in>{x. P}. e\<close> we introduce the shorter \<open>\<Prod>x|P. e\<close>.\<close>
syntax (ASCII)
"_qprod" :: "pttrn \<Rightarrow> bool \<Rightarrow> 'a \<Rightarrow> 'a" ("(4PROD _ |/ _./ _)" [0, 0, 10] 10)
--- a/src/HOL/Groups_List.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Groups_List.thy Fri Jan 04 23:22:53 2019 +0100
@@ -252,7 +252,7 @@
"sum_list (map f [k..l]) = sum f (set [k..l])"
by (simp add: sum_list_distinct_conv_sum_set)
-text \<open>General equivalence between @{const sum_list} and @{const sum}\<close>
+text \<open>General equivalence between \<^const>\<open>sum_list\<close> and \<^const>\<open>sum\<close>\<close>
lemma (in monoid_add) sum_list_sum_nth:
"sum_list xs = (\<Sum> i = 0 ..< length xs. xs ! i)"
using interv_sum_list_conv_sum_set_nat [of "(!) xs" 0 "length xs"] by (simp add: map_nth)
@@ -327,7 +327,7 @@
qed
-subsection \<open>Further facts about @{const List.n_lists}\<close>
+subsection \<open>Further facts about \<^const>\<open>List.n_lists\<close>\<close>
lemma length_n_lists: "length (List.n_lists n xs) = length xs ^ n"
by (induct n) (auto simp add: comp_def length_concat sum_list_triv)
--- a/src/HOL/HOL.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/HOL.thy Fri Jan 04 23:22:53 2019 +0100
@@ -45,11 +45,11 @@
\<close>
ML \<open>
Plugin_Name.define_setup \<^binding>\<open>quickcheck\<close>
- [@{plugin quickcheck_exhaustive},
- @{plugin quickcheck_random},
- @{plugin quickcheck_bounded_forall},
- @{plugin quickcheck_full_exhaustive},
- @{plugin quickcheck_narrowing}]
+ [\<^plugin>\<open>quickcheck_exhaustive\<close>,
+ \<^plugin>\<open>quickcheck_random\<close>,
+ \<^plugin>\<open>quickcheck_bounded_forall\<close>,
+ \<^plugin>\<open>quickcheck_full_exhaustive\<close>,
+ \<^plugin>\<open>quickcheck_narrowing\<close>]
\<close>
@@ -68,7 +68,7 @@
setup \<open>Axclass.class_axiomatization (\<^binding>\<open>type\<close>, [])\<close>
default_sort type
-setup \<open>Object_Logic.add_base_sort @{sort type}\<close>
+setup \<open>Object_Logic.add_base_sort \<^sort>\<open>type\<close>\<close>
axiomatization where fun_arity: "OFCLASS('a \<Rightarrow> 'b, type_class)"
instance "fun" :: (type, type) type by (rule fun_arity)
@@ -129,7 +129,7 @@
translations "\<exists>!x. P" \<rightleftharpoons> "CONST Ex1 (\<lambda>x. P)"
print_translation \<open>
- [Syntax_Trans.preserve_binder_abs_tr' @{const_syntax Ex1} @{syntax_const "_Ex1"}]
+ [Syntax_Trans.preserve_binder_abs_tr' \<^const_syntax>\<open>Ex1\<close> \<^syntax_const>\<open>_Ex1\<close>]
\<close> \<comment> \<open>to avoid eta-contraction of body\<close>
@@ -158,9 +158,9 @@
syntax "_The" :: "[pttrn, bool] \<Rightarrow> 'a" ("(3THE _./ _)" [0, 10] 10)
translations "THE x. P" \<rightleftharpoons> "CONST The (\<lambda>x. P)"
print_translation \<open>
- [(@{const_syntax The}, fn _ => fn [Abs abs] =>
+ [(\<^const_syntax>\<open>The\<close>, fn _ => fn [Abs abs] =>
let val (x, t) = Syntax_Trans.atomic_abs_tr' abs
- in Syntax.const @{syntax_const "_The"} $ x $ t end)]
+ in Syntax.const \<^syntax_const>\<open>_The\<close> $ x $ t end)]
\<close> \<comment> \<open>To avoid eta-contraction of body\<close>
nonterminal letbinds and letbind
@@ -833,7 +833,7 @@
setup \<open>
(*prevent substitution on bool*)
let
- fun non_bool_eq (@{const_name HOL.eq}, Type (_, [T, _])) = T <> @{typ bool}
+ fun non_bool_eq (\<^const_name>\<open>HOL.eq\<close>, Type (_, [T, _])) = T <> \<^typ>\<open>bool\<close>
| non_bool_eq _ = false;
fun hyp_subst_tac' ctxt =
SUBGOAL (fn (goal, i) =>
@@ -866,7 +866,7 @@
declare exE [elim!]
allE [elim]
-ML \<open>val HOL_cs = claset_of @{context}\<close>
+ML \<open>val HOL_cs = claset_of \<^context>\<close>
lemma contrapos_np: "\<not> Q \<Longrightarrow> (\<not> P \<Longrightarrow> Q) \<Longrightarrow> P"
apply (erule swap)
@@ -890,7 +890,7 @@
apply (rule prem)
apply assumption
apply (rule allI)+
- apply (tactic \<open>eresolve_tac @{context} [Classical.dup_elim @{context} @{thm allE}] 1\<close>)
+ apply (tactic \<open>eresolve_tac \<^context> [Classical.dup_elim \<^context> @{thm allE}] 1\<close>)
apply iprover
done
@@ -899,8 +899,8 @@
(
structure Classical = Classical
val Trueprop_const = dest_Const @{const Trueprop}
- val equality_name = @{const_name HOL.eq}
- val not_name = @{const_name Not}
+ val equality_name = \<^const_name>\<open>HOL.eq\<close>
+ val not_name = \<^const_name>\<open>Not\<close>
val notE = @{thm notE}
val ccontr = @{thm ccontr}
val hyp_subst_tac = Hypsubst.blast_hyp_subst_tac
@@ -1240,7 +1240,7 @@
| count_loose (s $ t) k = count_loose s k + count_loose t k
| count_loose (Abs (_, _, t)) k = count_loose t (k + 1)
| count_loose _ _ = 0;
- fun is_trivial_let (Const (@{const_name Let}, _) $ x $ t) =
+ fun is_trivial_let (Const (\<^const_name>\<open>Let\<close>, _) $ x $ t) =
(case t of
Abs (_, _, t') => count_loose t' 0 <= 1
| _ => true);
@@ -1254,7 +1254,7 @@
val ([t'], ctxt') = Variable.import_terms false [t] ctxt;
in
Option.map (hd o Variable.export ctxt' ctxt o single)
- (case t' of Const (@{const_name Let},_) $ x $ f => (* x and f are already in normal form *)
+ (case t' of Const (\<^const_name>\<open>Let\<close>,_) $ x $ f => (* x and f are already in normal form *)
if is_Free x orelse is_Bound x orelse is_Const x
then SOME @{thm Let_def}
else
@@ -1366,7 +1366,7 @@
lemmas [cong] = imp_cong simp_implies_cong
lemmas [split] = if_split
-ML \<open>val HOL_ss = simpset_of @{context}\<close>
+ML \<open>val HOL_ss = simpset_of \<^context>\<close>
text \<open>Simplifies \<open>x\<close> assuming \<open>c\<close> and \<open>y\<close> assuming \<open>\<not> c\<close>.\<close>
lemma if_cong:
@@ -1493,7 +1493,7 @@
val rulify = @{thms induct_rulify'}
val rulify_fallback = @{thms induct_rulify_fallback}
val equal_def = @{thm induct_equal_def}
- fun dest_def (Const (@{const_name induct_equal}, _) $ t $ u) = SOME (t, u)
+ fun dest_def (Const (\<^const_name>\<open>induct_equal\<close>, _) $ t $ u) = SOME (t, u)
| dest_def _ = NONE
fun trivial_tac ctxt = match_tac ctxt @{thms induct_trueI}
)
@@ -1504,22 +1504,22 @@
declaration \<open>
fn _ => Induct.map_simpset (fn ss => ss
addsimprocs
- [Simplifier.make_simproc @{context} "swap_induct_false"
- {lhss = [@{term "induct_false \<Longrightarrow> PROP P \<Longrightarrow> PROP Q"}],
+ [Simplifier.make_simproc \<^context> "swap_induct_false"
+ {lhss = [\<^term>\<open>induct_false \<Longrightarrow> PROP P \<Longrightarrow> PROP Q\<close>],
proc = fn _ => fn _ => fn ct =>
(case Thm.term_of ct of
_ $ (P as _ $ @{const induct_false}) $ (_ $ Q $ _) =>
if P <> Q then SOME Drule.swap_prems_eq else NONE
| _ => NONE)},
- Simplifier.make_simproc @{context} "induct_equal_conj_curry"
- {lhss = [@{term "induct_conj P Q \<Longrightarrow> PROP R"}],
+ Simplifier.make_simproc \<^context> "induct_equal_conj_curry"
+ {lhss = [\<^term>\<open>induct_conj P Q \<Longrightarrow> PROP R\<close>],
proc = fn _ => fn _ => fn ct =>
(case Thm.term_of ct of
_ $ (_ $ P) $ _ =>
let
fun is_conj (@{const induct_conj} $ P $ Q) =
is_conj P andalso is_conj Q
- | is_conj (Const (@{const_name induct_equal}, _) $ _ $ _) = true
+ | is_conj (Const (\<^const_name>\<open>induct_equal\<close>, _) $ _ $ _) = true
| is_conj @{const induct_true} = true
| is_conj @{const induct_false} = true
| is_conj _ = false
@@ -1597,7 +1597,7 @@
val atomize_exL = @{thm atomize_exL};
val atomize_conjL = @{thm atomize_conjL};
val atomize_disjL = @{thm atomize_disjL};
- val operator_names = [@{const_name HOL.disj}, @{const_name HOL.conj}, @{const_name Ex}];
+ val operator_names = [\<^const_name>\<open>HOL.disj\<close>, \<^const_name>\<open>HOL.conj\<close>, \<^const_name>\<open>Ex\<close>];
);
\<close>
@@ -1762,7 +1762,7 @@
\<close>
text \<open>
- This setup ensures that a rewrite rule of the form @{term "NO_MATCH pat val \<Longrightarrow> t"}
+ This setup ensures that a rewrite rule of the form \<^term>\<open>NO_MATCH pat val \<Longrightarrow> t\<close>
is only applied, if the pattern \<open>pat\<close> does not match the value \<open>val\<close>.
\<close>
@@ -1838,18 +1838,18 @@
setup \<open>
Code_Preproc.map_pre (fn ctxt =>
ctxt addsimprocs
- [Simplifier.make_simproc @{context} "equal"
- {lhss = [@{term HOL.eq}],
+ [Simplifier.make_simproc \<^context> "equal"
+ {lhss = [\<^term>\<open>HOL.eq\<close>],
proc = fn _ => fn _ => fn ct =>
(case Thm.term_of ct of
- Const (_, Type (@{type_name fun}, [Type _, _])) => SOME @{thm eq_equal}
+ Const (_, Type (\<^type_name>\<open>fun\<close>, [Type _, _])) => SOME @{thm eq_equal}
| _ => NONE)}])
\<close>
subsubsection \<open>Generic code generator foundation\<close>
-text \<open>Datatype @{typ bool}\<close>
+text \<open>Datatype \<^typ>\<open>bool\<close>\<close>
code_datatype True False
@@ -1874,7 +1874,7 @@
and "(P \<longrightarrow> True) \<longleftrightarrow> True"
by simp_all
-text \<open>More about @{typ prop}\<close>
+text \<open>More about \<^typ>\<open>prop\<close>\<close>
lemma [code nbe]:
shows "(True \<Longrightarrow> PROP Q) \<equiv> PROP Q"
@@ -1905,14 +1905,14 @@
lemma equal_itself_code [code]: "equal TYPE('a) TYPE('a) \<longleftrightarrow> True"
by (simp add: equal)
-setup \<open>Sign.add_const_constraint (@{const_name equal}, SOME @{typ "'a::type \<Rightarrow> 'a \<Rightarrow> bool"})\<close>
+setup \<open>Sign.add_const_constraint (\<^const_name>\<open>equal\<close>, SOME \<^typ>\<open>'a::type \<Rightarrow> 'a \<Rightarrow> bool\<close>)\<close>
lemma equal_alias_cert: "OFCLASS('a, equal_class) \<equiv> (((=) :: 'a \<Rightarrow> 'a \<Rightarrow> bool) \<equiv> equal)"
(is "?ofclass \<equiv> ?equal")
proof
assume "PROP ?ofclass"
show "PROP ?equal"
- by (tactic \<open>ALLGOALS (resolve_tac @{context} [Thm.unconstrainT @{thm eq_equal}])\<close>)
+ by (tactic \<open>ALLGOALS (resolve_tac \<^context> [Thm.unconstrainT @{thm eq_equal}])\<close>)
(fact \<open>PROP ?ofclass\<close>)
next
assume "PROP ?equal"
@@ -1920,7 +1920,7 @@
qed (simp add: \<open>PROP ?equal\<close>)
qed
-setup \<open>Sign.add_const_constraint (@{const_name equal}, SOME @{typ "'a::equal \<Rightarrow> 'a \<Rightarrow> bool"})\<close>
+setup \<open>Sign.add_const_constraint (\<^const_name>\<open>equal\<close>, SOME \<^typ>\<open>'a::equal \<Rightarrow> 'a \<Rightarrow> bool\<close>)\<close>
setup \<open>Nbe.add_const_alias @{thm equal_alias_cert}\<close>
@@ -1933,7 +1933,7 @@
setup \<open>
Code.declare_case_global @{thm Let_case_cert} #>
- Code.declare_undefined_global @{const_name undefined}
+ Code.declare_undefined_global \<^const_name>\<open>undefined\<close>
\<close>
declare [[code abort: undefined]]
@@ -1941,7 +1941,7 @@
subsubsection \<open>Generic code generator target languages\<close>
-text \<open>type @{typ bool}\<close>
+text \<open>type \<^typ>\<open>bool\<close>\<close>
code_printing
type_constructor bool \<rightharpoonup>
@@ -2057,7 +2057,7 @@
ML \<open>
(* combination of (spec RS spec RS ...(j times) ... spec RS mp) *)
local
- fun wrong_prem (Const (@{const_name All}, _) $ Abs (_, _, t)) = wrong_prem t
+ fun wrong_prem (Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, _, t)) = wrong_prem t
| wrong_prem (Bound _) = true
| wrong_prem _ = false;
val filter_right = filter (not o wrong_prem o HOLogic.dest_Trueprop o hd o Thm.prems_of);
@@ -2068,7 +2068,7 @@
local
val nnf_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms simp_thms nnf_simps});
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps @{thms simp_thms nnf_simps});
in
fun nnf_conv ctxt = Simplifier.rewrite (put_simpset nnf_ss ctxt);
end
--- a/src/HOL/Hilbert_Choice.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Hilbert_Choice.thy Fri Jan 04 23:22:53 2019 +0100
@@ -26,9 +26,9 @@
"SOME x. P" \<rightleftharpoons> "CONST Eps (\<lambda>x. P)"
print_translation \<open>
- [(@{const_syntax Eps}, fn _ => fn [Abs abs] =>
+ [(\<^const_syntax>\<open>Eps\<close>, fn _ => fn [Abs abs] =>
let val (x, t) = Syntax_Trans.atomic_abs_tr' abs
- in Syntax.const @{syntax_const "_Eps"} $ x $ t end)]
+ in Syntax.const \<^syntax_const>\<open>_Eps\<close> $ x $ t end)]
\<close> \<comment> \<open>to avoid eta-contraction of body\<close>
definition inv_into :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'a)" where
@@ -54,7 +54,7 @@
text \<open>
Easier to apply than \<open>someI\<close> because the conclusion has only one
- occurrence of @{term P}.
+ occurrence of \<^term>\<open>P\<close>.
\<close>
lemma someI2: "P a \<Longrightarrow> (\<And>x. P x \<Longrightarrow> Q x) \<Longrightarrow> Q (SOME x. P x)"
by (blast intro: someI)
@@ -560,7 +560,7 @@
subsection \<open>Other Consequences of Hilbert's Epsilon\<close>
-text \<open>Hilbert's Epsilon and the @{term split} Operator\<close>
+text \<open>Hilbert's Epsilon and the \<^term>\<open>split\<close> Operator\<close>
text \<open>Looping simprule!\<close>
lemma split_paired_Eps: "(SOME x. P x) = (SOME (a, b). P (a, b))"
--- a/src/HOL/Inductive.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Inductive.thy Fri Jan 04 23:22:53 2019 +0100
@@ -270,8 +270,8 @@
subsection \<open>Even Stronger Coinduction Rule, by Martin Coen\<close>
-text \<open>Weakens the condition @{term "X \<subseteq> f X"} to one expressed using both
- @{term lfp} and @{term gfp}\<close>
+text \<open>Weakens the condition \<^term>\<open>X \<subseteq> f X\<close> to one expressed using both
+ \<^term>\<open>lfp\<close> and \<^term>\<open>gfp\<close>\<close>
lemma coinduct3_mono_lemma: "mono f \<Longrightarrow> mono (\<lambda>x. f x \<union> X \<union> B)"
by (iprover intro: subset_refl monoI Un_mono monoD)
@@ -312,7 +312,7 @@
lemma def_coinduct3: "A \<equiv> gfp f \<Longrightarrow> mono f \<Longrightarrow> a \<in> X \<Longrightarrow> X \<subseteq> f (lfp (\<lambda>x. f x \<union> X \<union> A)) \<Longrightarrow> a \<in> A"
by (auto intro!: coinduct3)
-text \<open>Monotonicity of @{term gfp}!\<close>
+text \<open>Monotonicity of \<^term>\<open>gfp\<close>!\<close>
lemma gfp_mono: "(\<And>Z. f Z \<le> g Z) \<Longrightarrow> gfp f \<le> gfp g"
by (rule gfp_upperbound [THEN gfp_least]) (blast intro: order_trans)
@@ -535,7 +535,7 @@
val x = Syntax.free (fst (Name.variant "x" (Term.declare_term_frees cs Name.context)));
val ft = Case_Translation.case_tr true ctxt [x, cs];
in lambda x ft end
- in [(@{syntax_const "_lam_pats_syntax"}, fun_tr)] end
+ in [(\<^syntax_const>\<open>_lam_pats_syntax\<close>, fun_tr)] end
\<close>
end
--- a/src/HOL/Int.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Int.thy Fri Jan 04 23:22:53 2019 +0100
@@ -430,7 +430,7 @@
end
-text \<open>Comparisons involving @{term of_int}.\<close>
+text \<open>Comparisons involving \<^term>\<open>of_int\<close>.\<close>
lemma of_int_eq_numeral_iff [iff]: "of_int z = (numeral n :: 'a::ring_char_0) \<longleftrightarrow> z = numeral n"
using of_int_eq_iff by fastforce
@@ -493,7 +493,7 @@
lemma nat_le_eq_zle: "0 < w \<or> 0 \<le> z \<Longrightarrow> nat w \<le> nat z \<longleftrightarrow> w \<le> z"
by transfer (clarsimp, arith)
-text \<open>An alternative condition is @{term "0 \<le> w"}.\<close>
+text \<open>An alternative condition is \<^term>\<open>0 \<le> w\<close>.\<close>
lemma nat_mono_iff: "0 < z \<Longrightarrow> nat w < nat z \<longleftrightarrow> w < z"
by (simp add: nat_le_eq_zle linorder_not_le [symmetric])
@@ -669,7 +669,7 @@
lemma measure_function_int[measure_function]: "is_measure (nat \<circ> abs)" ..
-subsection \<open>Lemmas about the Function @{term of_nat} and Orderings\<close>
+subsection \<open>Lemmas about the Function \<^term>\<open>of_nat\<close> and Orderings\<close>
lemma negative_zless_0: "- (int (Suc n)) < (0 :: int)"
by (simp add: order_less_le del: of_nat_Suc)
@@ -975,7 +975,7 @@
by (cases "of_int b = 0") simp_all
qed
-text \<open>The premise involving @{term Ints} prevents @{term "a = 1/2"}.\<close>
+text \<open>The premise involving \<^term>\<open>Ints\<close> prevents \<^term>\<open>a = 1/2\<close>.\<close>
lemma Ints_double_eq_0_iff:
fixes a :: "'a::ring_char_0"
@@ -1037,7 +1037,7 @@
qed
-subsection \<open>@{term sum} and @{term prod}\<close>
+subsection \<open>\<^term>\<open>sum\<close> and \<^term>\<open>prod\<close>\<close>
context semiring_1
begin
@@ -1132,9 +1132,9 @@
using Ints_nonzero_abs_ge1 [of x] by auto
-subsection \<open>The functions @{term nat} and @{term int}\<close>
+subsection \<open>The functions \<^term>\<open>nat\<close> and \<^term>\<open>int\<close>\<close>
-text \<open>Simplify the term @{term "w + - z"}.\<close>
+text \<open>Simplify the term \<^term>\<open>w + - z\<close>.\<close>
lemma one_less_nat_eq [simp]: "Suc 0 < nat z \<longleftrightarrow> 1 < z"
using zless_nat_conj [of 1 z] by auto
--- a/src/HOL/Isar_Examples/Higher_Order_Logic.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Isar_Examples/Higher_Order_Logic.thy Fri Jan 04 23:22:53 2019 +0100
@@ -490,7 +490,7 @@
qed
text \<open>
- This means, the hypothetical predicate @{const classical} always holds
+ This means, the hypothetical predicate \<^const>\<open>classical\<close> always holds
unconditionally (with all consequences).
\<close>
--- a/src/HOL/Lattices.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Lattices.thy Fri Jan 04 23:22:53 2019 +0100
@@ -802,7 +802,7 @@
qed
-subsection \<open>Lattice on @{typ bool}\<close>
+subsection \<open>Lattice on \<^typ>\<open>bool\<close>\<close>
instantiation bool :: boolean_algebra
begin
@@ -829,7 +829,7 @@
by auto
-subsection \<open>Lattice on @{typ "_ \<Rightarrow> _"}\<close>
+subsection \<open>Lattice on \<^typ>\<open>_ \<Rightarrow> _\<close>\<close>
instantiation "fun" :: (type, semilattice_sup) semilattice_sup
begin
--- a/src/HOL/Lattices_Big.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Lattices_Big.thy Fri Jan 04 23:22:53 2019 +0100
@@ -478,7 +478,7 @@
"MAX x. f" \<rightleftharpoons> "CONST Max (CONST range (\<lambda>x. f))"
"MAX x\<in>A. f" \<rightleftharpoons> "CONST Max ((\<lambda>x. f) ` A)"
-text \<open>An aside: @{const Min}/@{const Max} on linear orders as special case of @{const Inf_fin}/@{const Sup_fin}\<close>
+text \<open>An aside: \<^const>\<open>Min\<close>/\<^const>\<open>Max\<close> on linear orders as special case of \<^const>\<open>Inf_fin\<close>/\<^const>\<open>Sup_fin\<close>\<close>
lemma Inf_fin_Min:
"Inf_fin = (Min :: 'a::{semilattice_inf, linorder} set \<Rightarrow> 'a)"
--- a/src/HOL/Library/AList.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/AList.thy Fri Jan 04 23:22:53 2019 +0100
@@ -13,8 +13,8 @@
text \<open>
The operations preserve distinctness of keys and
- function @{term "clearjunk"} distributes over them. Since
- @{term clearjunk} enforces distinctness of keys it can be used
+ function \<^term>\<open>clearjunk\<close> distributes over them. Since
+ \<^term>\<open>clearjunk\<close> enforces distinctness of keys it can be used
to establish the invariant, e.g. for inductive proofs.
\<close>
@@ -69,8 +69,8 @@
by (induct al) auto
text \<open>Note that the lists are not necessarily the same:
- @{term "update k v (update k' v' []) = [(k', v'), (k, v)]"} and
- @{term "update k' v' (update k v []) = [(k, v), (k', v')]"}.\<close>
+ \<^term>\<open>update k v (update k' v' []) = [(k', v'), (k, v)]\<close> and
+ \<^term>\<open>update k' v' (update k v []) = [(k, v), (k', v')]\<close>.\<close>
lemma update_swap:
"k \<noteq> k' \<Longrightarrow> map_of (update k v (update k' v' al)) = map_of (update k' v' (update k v al))"
@@ -223,7 +223,7 @@
(if (fst p = k) then (k, f (snd p)) # ps else p # update_with_aux v k f ps)"
text \<open>
- The above @{term "delete"} traverses all the list even if it has found the key.
+ The above \<^term>\<open>delete\<close> traverses all the list even if it has found the key.
This one does not have to keep going because is assumes the invariant that keys are distinct.
\<close>
qualified fun delete_aux :: "'key \<Rightarrow> ('key \<times> 'val) list \<Rightarrow> ('key \<times> 'val) list"
--- a/src/HOL/Library/Bit.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Bit.thy Fri Jan 04 23:22:53 2019 +0100
@@ -87,7 +87,7 @@
by (simp_all add: equal set_iff)
-subsection \<open>Type @{typ bit} forms a field\<close>
+subsection \<open>Type \<^typ>\<open>bit\<close> forms a field\<close>
instantiation bit :: field
begin
@@ -128,7 +128,7 @@
unfolding plus_bit_def by (simp split: bit.split)
-subsection \<open>Numerals at type @{typ bit}\<close>
+subsection \<open>Numerals at type \<^typ>\<open>bit\<close>\<close>
text \<open>All numerals reduce to either 0 or 1.\<close>
@@ -145,7 +145,7 @@
by (simp only: numeral_Bit1 bit_add_self add_0_left)
-subsection \<open>Conversion from @{typ bit}\<close>
+subsection \<open>Conversion from \<^typ>\<open>bit\<close>\<close>
context zero_neq_one
begin
--- a/src/HOL/Library/Cancellation/cancel.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Cancellation/cancel.ML Fri Jan 04 23:22:53 2019 +0100
@@ -49,15 +49,15 @@
val t = Thm.term_of ct
val ([t'], ctxt') = Variable.import_terms true [t] ctxt
val pre_simplified_ct = Simplifier.full_rewrite (clear_simpset ctxt addsimps
- Named_Theorems.get ctxt @{named_theorems cancelation_simproc_pre} addsimprocs
- [@{simproc NO_MATCH}]) (Thm.cterm_of ctxt t');
+ Named_Theorems.get ctxt \<^named_theorems>\<open>cancelation_simproc_pre\<close> addsimprocs
+ [\<^simproc>\<open>NO_MATCH\<close>]) (Thm.cterm_of ctxt t');
val t' = Thm.term_of (Thm.rhs_of pre_simplified_ct)
val export = singleton (Variable.export ctxt' ctxt)
val (t1,_) = Data.dest_bal t'
- val sort_not_general_enough = ((fastype_of t1) = @{typ nat}) orelse
+ val sort_not_general_enough = ((fastype_of t1) = \<^typ>\<open>nat\<close>) orelse
Sorts.of_sort (Sign.classes_of (Proof_Context.theory_of ctxt))
- (fastype_of t1, @{sort "comm_ring_1"})
+ (fastype_of t1, \<^sort>\<open>comm_ring_1\<close>)
val _ =
if sort_not_general_enough
then raise SORT_NOT_GENERAL_ENOUGH("type too precise, another simproc should do the job",
@@ -67,8 +67,8 @@
fun add_pre_simplification thm = @{thm Pure.transitive} OF [pre_simplified_ct, thm]
fun add_post_simplification thm =
(let val post_simplified_ct = Simplifier.full_rewrite (clear_simpset ctxt addsimps
- Named_Theorems.get ctxt @{named_theorems cancelation_simproc_post} addsimprocs
- [@{simproc NO_MATCH}])
+ Named_Theorems.get ctxt \<^named_theorems>\<open>cancelation_simproc_post\<close> addsimprocs
+ [\<^simproc>\<open>NO_MATCH\<close>])
(Thm.rhs_of thm)
in @{thm Pure.transitive} OF [thm, post_simplified_ct] end)
in
--- a/src/HOL/Library/Cancellation/cancel_data.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Cancellation/cancel_data.ML Fri Jan 04 23:22:53 2019 +0100
@@ -32,12 +32,12 @@
fun fast_mk_iterate_add (n, mset) =
let val T = fastype_of mset
in
- Const (@{const_name "iterate_add"}, @{typ nat} --> T --> T) $ n $ mset
+ Const (\<^const_name>\<open>iterate_add\<close>, \<^typ>\<open>nat\<close> --> T --> T) $ n $ mset
end;
(*iterate_add is not symmetric, unlike multiplication over natural numbers.*)
fun mk_iterate_add (t, u) =
- (if fastype_of t = @{typ nat} then (t, u) else (u, t))
+ (if fastype_of t = \<^typ>\<open>nat\<close> then (t, u) else (u, t))
|> fast_mk_iterate_add;
(*Maps n to #n for n = 1, 2*)
@@ -45,7 +45,7 @@
map (fn th => th RS sym) @{thms numeral_One numeral_2_eq_2 numeral_1_eq_Suc_0};
val numeral_sym_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps numeral_syms);
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps numeral_syms);
fun mk_number 1 = HOLogic.numeral_const HOLogic.natT $ HOLogic.one_const
| mk_number n = HOLogic.mk_number HOLogic.natT n;
@@ -56,16 +56,16 @@
handle TERM _ => find_first_numeral (t::past) terms)
| find_first_numeral _ [] = raise TERM("find_first_numeral", []);
-fun typed_zero T = Const (@{const_name "Groups.zero"}, T);
+fun typed_zero T = Const (\<^const_name>\<open>Groups.zero\<close>, T);
fun typed_one T = HOLogic.numeral_const T $ HOLogic.one_const
-val mk_plus = HOLogic.mk_binop @{const_name Groups.plus};
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>Groups.plus\<close>;
(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero.*)
fun mk_sum T [] = typed_zero T
| mk_sum _ [t,u] = mk_plus (t, u)
| mk_sum T (t :: ts) = mk_plus (t, mk_sum T ts);
-val dest_plus = HOLogic.dest_bin @{const_name Groups.plus} dummyT;
+val dest_plus = HOLogic.dest_bin \<^const_name>\<open>Groups.plus\<close> dummyT;
(*** Other simproc items ***)
@@ -85,7 +85,7 @@
| mk_prod _ [t] = t
| mk_prod T (t :: ts) = if t = one then mk_prod T ts else mk_iterate_add (t, mk_prod T ts);
-val dest_iterate_add = HOLogic.dest_bin @{const_name iterate_add} dummyT;
+val dest_iterate_add = HOLogic.dest_bin \<^const_name>\<open>iterate_add\<close> dummyT;
fun dest_iterate_adds t =
let val (t,u) = dest_iterate_add t in
@@ -121,7 +121,7 @@
fun dest_sum t = dest_summation (t, []);
-val rename_numerals = simplify (put_simpset numeral_sym_ss @{context}) o Thm.transfer @{theory};
+val rename_numerals = simplify (put_simpset numeral_sym_ss \<^context>) o Thm.transfer \<^theory>;
(*Simplify \<open>iterate_add (Suc 0) n\<close>, \<open>iterate_add n (Suc 0)\<close>, \<open>n+0\<close>, and \<open>0+n\<close> to \<open>n\<close>*)
val add_0s = map rename_numerals @{thms monoid_add_class.add_0_left monoid_add_class.add_0_right};
@@ -130,7 +130,7 @@
(*And these help the simproc return False when appropriate. We use the same list as the
simproc for natural numbers, but adapted.*)
fun contra_rules ctxt =
- @{thms le_zero_eq} @ Named_Theorems.get ctxt @{named_theorems cancelation_simproc_eq_elim};
+ @{thms le_zero_eq} @ Named_Theorems.get ctxt \<^named_theorems>\<open>cancelation_simproc_eq_elim\<close>;
fun simplify_meta_eq ctxt =
Arith_Data.simplify_meta_eq
@@ -148,11 +148,11 @@
val trans_tac = Numeral_Simprocs.trans_tac;
val norm_ss1 =
- simpset_of (put_simpset Numeral_Simprocs.num_ss @{context} addsimps
+ simpset_of (put_simpset Numeral_Simprocs.num_ss \<^context> addsimps
numeral_syms @ add_0s @ mult_1s @ @{thms ac_simps iterate_add_simps});
val norm_ss2 =
- simpset_of (put_simpset Numeral_Simprocs.num_ss @{context} addsimps
+ simpset_of (put_simpset Numeral_Simprocs.num_ss \<^context> addsimps
bin_simps @
@{thms ac_simps});
@@ -161,7 +161,7 @@
THEN ALLGOALS (simp_tac (put_simpset norm_ss2 ctxt));
val mset_simps_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps bin_simps);
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps bin_simps);
fun numeral_simp_tac ctxt = ALLGOALS (simp_tac (put_simpset mset_simps_ss ctxt));
--- a/src/HOL/Library/Cancellation/cancel_simprocs.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Cancellation/cancel_simprocs.ML Fri Jan 04 23:22:53 2019 +0100
@@ -19,31 +19,31 @@
structure Eq_Cancel_Comm_Monoid_add = Cancel_Fun
(open Cancel_Data
val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin @{const_name HOL.eq} dummyT
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>HOL.eq\<close> dummyT
val bal_add1 = @{thm iterate_add_eq_add_iff1} RS trans
val bal_add2 = @{thm iterate_add_eq_add_iff2} RS trans
);
structure Eq_Cancel_Comm_Monoid_less = Cancel_Fun
(open Cancel_Data
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} dummyT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less\<close> dummyT
val bal_add1 = @{thm iterate_add_less_iff1} RS trans
val bal_add2 = @{thm iterate_add_less_iff2} RS trans
);
structure Eq_Cancel_Comm_Monoid_less_eq = Cancel_Fun
(open Cancel_Data
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} dummyT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less_eq\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less_eq\<close> dummyT
val bal_add1 = @{thm iterate_add_less_eq_iff1} RS trans
val bal_add2 = @{thm iterate_add_less_eq_iff2} RS trans
);
structure Diff_Cancel_Comm_Monoid_less_eq = Cancel_Fun
(open Cancel_Data
- val mk_bal = HOLogic.mk_binop @{const_name Groups.minus}
- val dest_bal = HOLogic.dest_bin @{const_name Groups.minus} dummyT
+ val mk_bal = HOLogic.mk_binop \<^const_name>\<open>Groups.minus\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Groups.minus\<close> dummyT
val bal_add1 = @{thm iterate_add_add_eq1} RS trans
val bal_add2 = @{thm iterate_add_diff_add_eq2} RS trans
);
--- a/src/HOL/Library/Cardinality.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Cardinality.thy Fri Jan 04 23:22:53 2019 +0100
@@ -36,9 +36,9 @@
print_translation \<open>
let
- fun card_univ_tr' ctxt [Const (@{const_syntax UNIV}, Type (_, [T]))] =
- Syntax.const @{syntax_const "_type_card"} $ Syntax_Phases.term_of_typ ctxt T
- in [(@{const_syntax card}, card_univ_tr')] end
+ fun card_univ_tr' ctxt [Const (\<^const_syntax>\<open>UNIV\<close>, Type (_, [T]))] =
+ Syntax.const \<^syntax_const>\<open>_type_card\<close> $ Syntax_Phases.term_of_typ ctxt T
+ in [(\<^const_syntax>\<open>card\<close>, card_univ_tr')] end
\<close>
lemma card_prod [simp]: "CARD('a \<times> 'b) = CARD('a) * CARD('b)"
@@ -377,11 +377,11 @@
subsection \<open>Code setup for sets\<close>
text \<open>
- Implement @{term "CARD('a)"} via @{term card_UNIV} and provide
- implementations for @{term "finite"}, @{term "card"}, @{term "(\<subseteq>)"},
- and @{term "(=)"}if the calling context already provides @{class finite_UNIV}
- and @{class card_UNIV} instances. If we implemented the latter
- always via @{term card_UNIV}, we would require instances of essentially all
+ Implement \<^term>\<open>CARD('a)\<close> via \<^term>\<open>card_UNIV\<close> and provide
+ implementations for \<^term>\<open>finite\<close>, \<^term>\<open>card\<close>, \<^term>\<open>(\<subseteq>)\<close>,
+ and \<^term>\<open>(=)\<close>if the calling context already provides \<^class>\<open>finite_UNIV\<close>
+ and \<^class>\<open>card_UNIV\<close> instances. If we implemented the latter
+ always via \<^term>\<open>card_UNIV\<close>, we would require instances of essentially all
element types, i.e., a lot of instantiation proofs and -- at run time --
possibly slow dictionary constructions.
\<close>
@@ -492,8 +492,8 @@
Provide more informative exceptions than Match for non-rewritten cases.
If generated code raises one these exceptions, then a code equation calls
the mentioned operator for an element type that is not an instance of
- @{class card_UNIV} and is therefore not implemented via @{term card_UNIV}.
- Constrain the element type with sort @{class card_UNIV} to change this.
+ \<^class>\<open>card_UNIV\<close> and is therefore not implemented via \<^term>\<open>card_UNIV\<close>.
+ Constrain the element type with sort \<^class>\<open>card_UNIV\<close> to change this.
\<close>
lemma card_coset_error [code]:
--- a/src/HOL/Library/Code_Abstract_Nat.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Code_Abstract_Nat.thy Fri Jan 04 23:22:53 2019 +0100
@@ -10,7 +10,7 @@
text \<open>
When natural numbers are implemented in another than the
- conventional inductive @{term "0::nat"}/@{term Suc} representation,
+ conventional inductive \<^term>\<open>0::nat\<close>/\<^term>\<open>Suc\<close> representation,
it is necessary to avoid all pattern matching on natural numbers
altogether. This is accomplished by this theory (up to a certain
extent).
@@ -31,7 +31,7 @@
subsection \<open>Preprocessors\<close>
text \<open>
- The term @{term "Suc n"} is no longer a valid pattern. Therefore,
+ The term \<^term>\<open>Suc n\<close> is no longer a valid pattern. Therefore,
all occurrences of this term in a position where a pattern is
expected (i.e.~on the left-hand side of a code equation) must be
eliminated. This can be accomplished -- as far as possible -- by
@@ -62,7 +62,7 @@
val lhs_of = snd o Thm.dest_comb o fst o Thm.dest_comb o Thm.cprop_of;
val rhs_of = snd o Thm.dest_comb o Thm.cprop_of;
fun find_vars ct = (case Thm.term_of ct of
- (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
+ (Const (\<^const_name>\<open>Suc\<close>, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
| _ $ _ =>
let val (ct1, ct2) = Thm.dest_comb ct
in
@@ -97,7 +97,7 @@
fun eqn_suc_base_preproc ctxt thms =
let
val dest = fst o Logic.dest_equals o Thm.prop_of;
- val contains_suc = exists_Const (fn (c, _) => c = @{const_name Suc});
+ val contains_suc = exists_Const (fn (c, _) => c = \<^const_name>\<open>Suc\<close>);
in
if forall (can dest) thms andalso exists (contains_suc o dest) thms
then thms |> perhaps_loop (remove_suc ctxt) |> (Option.map o map) Drule.zero_var_indexes
--- a/src/HOL/Library/Code_Binary_Nat.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Code_Binary_Nat.thy Fri Jan 04 23:22:53 2019 +0100
@@ -10,8 +10,8 @@
text \<open>
When generating code for functions on natural numbers, the
- canonical representation using @{term "0::nat"} and
- @{term Suc} is unsuitable for computations involving large
+ canonical representation using \<^term>\<open>0::nat\<close> and
+ \<^term>\<open>Suc\<close> is unsuitable for computations involving large
numbers. This theory refines the representation of
natural numbers for code generation to use binary
numerals, which do not grow linear in size but logarithmic.
--- a/src/HOL/Library/Code_Lazy.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Code_Lazy.thy Fri Jan 04 23:22:53 2019 +0100
@@ -60,7 +60,7 @@
by (rule term_of_anything)
text \<open>
- The implementations of @{typ "_ lazy"} using language primitives cache forced values.
+ The implementations of \<^typ>\<open>_ lazy\<close> using language primitives cache forced values.
Term reconstruction for lazy looks into the lazy value and reconstructs it to the depth it has been evaluated.
This is not done for Haskell as we do not know of any portable way to inspect whether a lazy value
@@ -119,7 +119,7 @@
code_reserved SML Lazy
code_printing \<comment> \<open>For code generation within the Isabelle environment, we reuse the thread-safe
- implementation of lazy from @{file "~~/src/Pure/Concurrent/lazy.ML"}\<close>
+ implementation of lazy from \<^file>\<open>~~/src/Pure/Concurrent/lazy.ML\<close>\<close>
code_module Lazy \<rightharpoonup> (Eval) \<open>\<close> for constant undefined
| type_constructor lazy \<rightharpoonup> (Eval) "_ Lazy.lazy"
| constant delay \<rightharpoonup> (Eval) "Lazy.lazy"
@@ -220,7 +220,7 @@
code_reserved Scala Lazy
-text \<open>Make evaluation with the simplifier respect @{term delay}s.\<close>
+text \<open>Make evaluation with the simplifier respect \<^term>\<open>delay\<close>s.\<close>
lemma delay_lazy_cong: "delay f = delay f" by simp
setup \<open>Code_Simp.map_ss (Simplifier.add_cong @{thm delay_lazy_cong})\<close>
--- a/src/HOL/Library/Code_Prolog.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Code_Prolog.thy Fri Jan 04 23:22:53 2019 +0100
@@ -13,8 +13,8 @@
section \<open>Setup for Numerals\<close>
-setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name numeral}]\<close>
+setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>numeral\<close>]\<close>
-setup \<open>Predicate_Compile_Data.keep_functions [@{const_name numeral}]\<close>
+setup \<open>Predicate_Compile_Data.keep_functions [\<^const_name>\<open>numeral\<close>]\<close>
end
--- a/src/HOL/Library/Code_Target_Nat.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Code_Target_Nat.thy Fri Jan 04 23:22:53 2019 +0100
@@ -8,7 +8,7 @@
imports Code_Abstract_Nat
begin
-subsection \<open>Implementation for @{typ nat}\<close>
+subsection \<open>Implementation for \<^typ>\<open>nat\<close>\<close>
context
includes natural.lifting integer.lifting
@@ -163,8 +163,8 @@
by (cases c) (simp add: nat_of_char_def integer_of_char_def integer_of_nat_eq_of_nat)
lemma term_of_nat_code [code]:
- \<comment> \<open>Use @{term Code_Numeral.nat_of_integer} in term reconstruction
- instead of @{term Code_Target_Nat.Nat} such that reconstructed
+ \<comment> \<open>Use \<^term>\<open>Code_Numeral.nat_of_integer\<close> in term reconstruction
+ instead of \<^term>\<open>Code_Target_Nat.Nat\<close> such that reconstructed
terms can be fed back to the code generator\<close>
"term_of_class.term_of n =
Code_Evaluation.App
--- a/src/HOL/Library/Code_Test.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Code_Test.thy Fri Jan 04 23:22:53 2019 +0100
@@ -9,7 +9,7 @@
keywords "test_code" :: diag
begin
-subsection \<open>YXML encoding for @{typ Code_Evaluation.term}\<close>
+subsection \<open>YXML encoding for \<^typ>\<open>Code_Evaluation.term\<close>\<close>
datatype (plugins del: code size "quickcheck") yxml_of_term = YXML
@@ -24,7 +24,7 @@
definition yot_concat :: "yxml_of_term list \<Rightarrow> yxml_of_term"
where [code del]: "yot_concat _ = YXML"
-text \<open>Serialise @{typ yxml_of_term} to native string of target language\<close>
+text \<open>Serialise \<^typ>\<open>yxml_of_term\<close> to native string of target language\<close>
code_printing type_constructor yxml_of_term
\<rightharpoonup> (SML) "string"
@@ -55,7 +55,7 @@
text \<open>
Stripped-down implementations of Isabelle's XML tree with YXML encoding as
defined in \<^file>\<open>~~/src/Pure/PIDE/xml.ML\<close>, \<^file>\<open>~~/src/Pure/PIDE/yxml.ML\<close>
- sufficient to encode @{typ "Code_Evaluation.term"} as in
+ sufficient to encode \<^typ>\<open>Code_Evaluation.term\<close> as in
\<^file>\<open>~~/src/Pure/term_xml.ML\<close>.
\<close>
@@ -114,7 +114,7 @@
where "yxml_string_of_body ts = foldr yxml_string_of_xml_tree ts yot_empty"
text \<open>
- Encoding @{typ Code_Evaluation.term} into XML trees as defined in
+ Encoding \<^typ>\<open>Code_Evaluation.term\<close> into XML trees as defined in
\<^file>\<open>~~/src/Pure/term_xml.ML\<close>.
\<close>
@@ -132,8 +132,8 @@
"xml_of_term (Code_Evaluation.Const x ty) = [xml.tagged (STR ''0'') (Some x) (xml_of_typ ty)]"
"xml_of_term (Code_Evaluation.App t1 t2) = [xml.tagged (STR ''5'') None [xml.node (xml_of_term t1), xml.node (xml_of_term t2)]]"
"xml_of_term (Code_Evaluation.Abs x ty t) = [xml.tagged (STR ''4'') (Some x) [xml.node (xml_of_typ ty), xml.node (xml_of_term t)]]"
- \<comment> \<open>FIXME: @{const Code_Evaluation.Free} is used only in @{theory "HOL.Quickcheck_Narrowing"} to represent
- uninstantiated parameters in constructors. Here, we always translate them to @{ML Free} variables.\<close>
+ \<comment> \<open>FIXME: \<^const>\<open>Code_Evaluation.Free\<close> is used only in \<^theory>\<open>HOL.Quickcheck_Narrowing\<close> to represent
+ uninstantiated parameters in constructors. Here, we always translate them to \<^ML>\<open>Free\<close> variables.\<close>
"xml_of_term (Code_Evaluation.Free x ty) = [xml.tagged (STR ''1'') (Some x) (xml_of_typ ty)]"
by(simp_all add: xml_of_term_def xml_tree_anything)
--- a/src/HOL/Library/Complete_Partial_Order2.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Complete_Partial_Order2.thy Fri Jan 04 23:22:53 2019 +0100
@@ -355,7 +355,7 @@
(* apply cont_intro rules as intro and try to solve
the remaining of the emerging subgoals with simp *)
fun cont_intro_tac ctxt =
- REPEAT_ALL_NEW (resolve_tac ctxt (rev (Named_Theorems.get ctxt @{named_theorems cont_intro})))
+ REPEAT_ALL_NEW (resolve_tac ctxt (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>cont_intro\<close>)))
THEN_ALL_NEW (SOLVED' (simp_tac ctxt))
fun cont_intro_simproc ctxt ct =
@@ -370,9 +370,9 @@
| NONE => NONE
in
case Thm.term_of ct of
- t as Const (@{const_name ccpo.admissible}, _) $ _ $ _ $ _ => mk_thm t
- | t as Const (@{const_name mcont}, _) $ _ $ _ $ _ $ _ $ _ => mk_thm t
- | t as Const (@{const_name monotone}, _) $ _ $ _ $ _ => mk_thm t
+ t as Const (\<^const_name>\<open>ccpo.admissible\<close>, _) $ _ $ _ $ _ => mk_thm t
+ | t as Const (\<^const_name>\<open>mcont\<close>, _) $ _ $ _ $ _ $ _ $ _ => mk_thm t
+ | t as Const (\<^const_name>\<open>monotone\<close>, _) $ _ $ _ $ _ => mk_thm t
| _ => NONE
end
handle THM _ => NONE
@@ -997,7 +997,7 @@
end
-subsection \<open>@{term "(=)"} as order\<close>
+subsection \<open>\<^term>\<open>(=)\<close> as order\<close>
definition lub_singleton :: "('a set \<Rightarrow> 'a) \<Rightarrow> bool"
where "lub_singleton lub \<longleftrightarrow> (\<forall>a. lub {a} = a)"
@@ -1431,13 +1431,13 @@
interpretation lfp: partial_function_definitions "(\<le>) :: _ :: complete_lattice \<Rightarrow> _" Sup
by(rule complete_lattice_partial_function_definitions)
-declaration \<open>Partial_Function.init "lfp" @{term lfp.fixp_fun} @{term lfp.mono_body}
+declaration \<open>Partial_Function.init "lfp" \<^term>\<open>lfp.fixp_fun\<close> \<^term>\<open>lfp.mono_body\<close>
@{thm lfp.fixp_rule_uc} @{thm lfp.fixp_induct_uc} NONE\<close>
interpretation gfp: partial_function_definitions "(\<ge>) :: _ :: complete_lattice \<Rightarrow> _" Inf
by(rule complete_lattice_partial_function_definitions_dual)
-declaration \<open>Partial_Function.init "gfp" @{term gfp.fixp_fun} @{term gfp.mono_body}
+declaration \<open>Partial_Function.init "gfp" \<^term>\<open>gfp.fixp_fun\<close> \<^term>\<open>gfp.mono_body\<close>
@{thm gfp.fixp_rule_uc} @{thm gfp.fixp_induct_uc} NONE\<close>
lemma insert_mono [partial_function_mono]:
--- a/src/HOL/Library/Countable.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Countable.thy Fri Jan 04 23:22:53 2019 +0100
@@ -168,7 +168,7 @@
let
val ty_name =
(case goal of
- (_ $ Const (@{const_name Pure.type}, Type (@{type_name itself}, [Type (n, _)]))) => n
+ (_ $ Const (\<^const_name>\<open>Pure.type\<close>, Type (\<^type_name>\<open>itself\<close>, [Type (n, _)]))) => n
| _ => raise Match)
val typedef_info = hd (Typedef.get_info ctxt ty_name)
val typedef_thm = #type_definition (snd typedef_info)
@@ -183,7 +183,7 @@
val induct_thm = the (AList.lookup (op =) alist pred_name)
val vars = rev (Term.add_vars (Thm.prop_of induct_thm) [])
val insts = vars |> map (fn (_, T) => try (Thm.cterm_of ctxt)
- (Const (@{const_name Countable.finite_item}, T)))
+ (Const (\<^const_name>\<open>Countable.finite_item\<close>, T)))
val induct_thm' = Thm.instantiate' [] insts induct_thm
val rules = @{thms finite_item.intros}
in
--- a/src/HOL/Library/Countable_Set_Type.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Countable_Set_Type.thy Fri Jan 04 23:22:53 2019 +0100
@@ -413,7 +413,7 @@
apply (rule equal_intr_rule)
by (transfer, simp)+
-subsubsection \<open>@{const cUnion}\<close>
+subsubsection \<open>\<^const>\<open>cUnion\<close>\<close>
lemma cUNION_cimage: "cUNION (cimage f A) g = cUNION A (g \<circ> f)"
by transfer simp
--- a/src/HOL/Library/DAList_Multiset.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/DAList_Multiset.thy Fri Jan 04 23:22:53 2019 +0100
@@ -202,7 +202,7 @@
lemma mset_eq [code]: "HOL.equal (m1::'a::equal multiset) m2 \<longleftrightarrow> m1 \<subseteq># m2 \<and> m2 \<subseteq># m1"
by (metis equal_multiset_def subset_mset.eq_iff)
-text \<open>By default the code for \<open><\<close> is @{prop"xs < ys \<longleftrightarrow> xs \<le> ys \<and> \<not> xs = ys"}.
+text \<open>By default the code for \<open><\<close> is \<^prop>\<open>xs < ys \<longleftrightarrow> xs \<le> ys \<and> \<not> xs = ys\<close>.
With equality implemented by \<open>\<le>\<close>, this leads to three calls of \<open>\<le>\<close>.
Here is a more efficient version:\<close>
lemma mset_less[code]: "xs \<subset># (ys :: 'a multiset) \<longleftrightarrow> xs \<subseteq># ys \<and> \<not> ys \<subseteq># xs"
--- a/src/HOL/Library/Disjoint_Sets.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Disjoint_Sets.thy Fri Jan 04 23:22:53 2019 +0100
@@ -234,7 +234,7 @@
subsection \<open>Partitions\<close>
text \<open>
- Partitions @{term P} of a set @{term A}. We explicitly disallow empty sets.
+ Partitions \<^term>\<open>P\<close> of a set \<^term>\<open>A\<close>. We explicitly disallow empty sets.
\<close>
definition partition_on :: "'a set \<Rightarrow> 'a set set \<Rightarrow> bool"
--- a/src/HOL/Library/Dlist.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Dlist.thy Fri Jan 04 23:22:53 2019 +0100
@@ -25,7 +25,7 @@
"list_of_dlist dxs = list_of_dlist dys \<Longrightarrow> dxs = dys"
by (simp add: dlist_eq_iff)
-text \<open>Formal, totalized constructor for @{typ "'a dlist"}:\<close>
+text \<open>Formal, totalized constructor for \<^typ>\<open>'a dlist\<close>:\<close>
definition Dlist :: "'a list \<Rightarrow> 'a dlist" where
"Dlist xs = Abs_dlist (remdups xs)"
--- a/src/HOL/Library/Extended_Nat.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Extended_Nat.thy Fri Jan 04 23:22:53 2019 +0100
@@ -33,7 +33,7 @@
typedef enat = "UNIV :: nat option set" ..
-text \<open>TODO: introduce enat as coinductive datatype, enat is just @{const of_nat}\<close>
+text \<open>TODO: introduce enat as coinductive datatype, enat is just \<^const>\<open>of_nat\<close>\<close>
definition enat :: "nat \<Rightarrow> enat" where
"enat n = Abs_enat (Some n)"
@@ -537,7 +537,7 @@
if u aconv t then (rev past @ terms)
else find_first_t (t::past) u terms
- fun dest_summing (Const (@{const_name Groups.plus}, _) $ t $ u, ts) =
+ fun dest_summing (Const (\<^const_name>\<open>Groups.plus\<close>, _) $ t $ u, ts) =
dest_summing (t, dest_summing (u, ts))
| dest_summing (t, ts) = t :: ts
@@ -546,7 +546,7 @@
val find_first = find_first_t []
val trans_tac = Numeral_Simprocs.trans_tac
val norm_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps @{thms ac_simps add_0_left add_0_right})
fun norm_tac ctxt = ALLGOALS (simp_tac (put_simpset norm_ss ctxt))
fun simplify_meta_eq ctxt cancel_th th =
@@ -558,21 +558,21 @@
structure Eq_Enat_Cancel = ExtractCommonTermFun
(open Cancel_Enat_Common
val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin @{const_name HOL.eq} @{typ enat}
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>HOL.eq\<close> \<^typ>\<open>enat\<close>
fun simp_conv _ _ = SOME @{thm enat_add_left_cancel}
)
structure Le_Enat_Cancel = ExtractCommonTermFun
(open Cancel_Enat_Common
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} @{typ enat}
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less_eq\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less_eq\<close> \<^typ>\<open>enat\<close>
fun simp_conv _ _ = SOME @{thm enat_add_left_cancel_le}
)
structure Less_Enat_Cancel = ExtractCommonTermFun
(open Cancel_Enat_Common
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} @{typ enat}
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less\<close> \<^typ>\<open>enat\<close>
fun simp_conv _ _ = SOME @{thm enat_add_left_cancel_less}
)
\<close>
--- a/src/HOL/Library/Extended_Nonnegative_Real.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Extended_Nonnegative_Real.thy Fri Jan 04 23:22:53 2019 +0100
@@ -408,7 +408,7 @@
if u aconv t then (rev past @ terms)
else find_first_t (t::past) u terms
- fun dest_summing (Const (@{const_name Groups.plus}, _) $ t $ u, ts) =
+ fun dest_summing (Const (\<^const_name>\<open>Groups.plus\<close>, _) $ t $ u, ts) =
dest_summing (t, dest_summing (u, ts))
| dest_summing (t, ts) = t :: ts
@@ -417,7 +417,7 @@
val find_first = find_first_t []
val trans_tac = Numeral_Simprocs.trans_tac
val norm_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps @{thms ac_simps add_0_left add_0_right})
fun norm_tac ctxt = ALLGOALS (simp_tac (put_simpset norm_ss ctxt))
fun simplify_meta_eq ctxt cancel_th th =
@@ -429,21 +429,21 @@
structure Eq_Ennreal_Cancel = ExtractCommonTermFun
(open Cancel_Ennreal_Common
val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin @{const_name HOL.eq} @{typ ennreal}
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>HOL.eq\<close> \<^typ>\<open>ennreal\<close>
fun simp_conv _ _ = SOME @{thm ennreal_add_left_cancel}
)
structure Le_Ennreal_Cancel = ExtractCommonTermFun
(open Cancel_Ennreal_Common
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} @{typ ennreal}
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less_eq\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less_eq\<close> \<^typ>\<open>ennreal\<close>
fun simp_conv _ _ = SOME @{thm ennreal_add_left_cancel_le}
)
structure Less_Ennreal_Cancel = ExtractCommonTermFun
(open Cancel_Ennreal_Common
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} @{typ ennreal}
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less\<close> \<^typ>\<open>ennreal\<close>
fun simp_conv _ _ = SOME @{thm ennreal_add_left_cancel_less}
)
\<close>
@@ -828,7 +828,7 @@
by (cases a) (auto simp: top_ereal_def)
done
-subsection \<open>Coercion from @{typ real} to @{typ ennreal}\<close>
+subsection \<open>Coercion from \<^typ>\<open>real\<close> to \<^typ>\<open>ennreal\<close>\<close>
lift_definition ennreal :: "real \<Rightarrow> ennreal" is "sup 0 \<circ> ereal"
by simp
@@ -1059,7 +1059,7 @@
by (cases x rule: ennreal_cases)
(auto simp: ennreal_of_nat_eq_real_of_nat ennreal_less_iff reals_Archimedean2)
-subsection \<open>Coercion from @{typ ennreal} to @{typ real}\<close>
+subsection \<open>Coercion from \<^typ>\<open>ennreal\<close> to \<^typ>\<open>real\<close>\<close>
definition "enn2real x = real_of_ereal (enn2ereal x)"
@@ -1106,7 +1106,7 @@
lemma enn2real_eq_1_iff[simp]: "enn2real x = 1 \<longleftrightarrow> x = 1"
by (cases x) auto
-subsection \<open>Coercion from @{typ enat} to @{typ ennreal}\<close>
+subsection \<open>Coercion from \<^typ>\<open>enat\<close> to \<^typ>\<open>ennreal\<close>\<close>
definition ennreal_of_enat :: "enat \<Rightarrow> ennreal"
@@ -1174,7 +1174,7 @@
lemma ennreal_of_enat_eSuc[simp]: "ennreal_of_enat (eSuc x) = 1 + ennreal_of_enat x"
by (cases x) (auto simp: eSuc_enat)
-subsection \<open>Topology on @{typ ennreal}\<close>
+subsection \<open>Topology on \<^typ>\<open>ennreal\<close>\<close>
lemma enn2ereal_Iio: "enn2ereal -` {..<a} = (if 0 \<le> a then {..< e2ennreal a} else {})"
using enn2ereal_nonneg
@@ -1774,7 +1774,7 @@
lifting_forget ennreal.lifting
-subsection \<open>@{typ ennreal} theorems\<close>
+subsection \<open>\<^typ>\<open>ennreal\<close> theorems\<close>
lemma neq_top_trans: fixes x y :: ennreal shows "\<lbrakk> y \<noteq> top; x \<le> y \<rbrakk> \<Longrightarrow> x \<noteq> top"
by (auto simp: top_unique)
--- a/src/HOL/Library/Extended_Real.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Extended_Real.thy Fri Jan 04 23:22:53 2019 +0100
@@ -13,9 +13,8 @@
begin
text \<open>
- This should be part of @{theory "HOL-Library.Extended_Nat"} or @{theory
- "HOL-Library.Order_Continuity"}, but then the AFP-entry \<open>Jinja_Thread\<close> fails, as it does overload
- certain named from @{theory Complex_Main}.
+ This should be part of \<^theory>\<open>HOL-Library.Extended_Nat\<close> or \<^theory>\<open>HOL-Library.Order_Continuity\<close>, but then the AFP-entry \<open>Jinja_Thread\<close> fails, as it does overload
+ certain named from \<^theory>\<open>Complex_Main\<close>.
\<close>
lemma incseq_sumI2:
@@ -468,7 +467,7 @@
by (cases rule: ereal2_cases[of a b]) auto
-subsubsection "Linear order on @{typ ereal}"
+subsubsection "Linear order on \<^typ>\<open>ereal\<close>"
instantiation ereal :: linorder
begin
@@ -2540,7 +2539,7 @@
"A \<noteq> {} \<Longrightarrow> \<exists>f::nat \<Rightarrow> ereal. range f \<subseteq> g`A \<and> Sup (g ` A) = Sup (f ` UNIV)"
using Sup_countable_SUP [of "g`A"] by auto
-subsection "Relation to @{typ enat}"
+subsection "Relation to \<^typ>\<open>enat\<close>"
definition "ereal_of_enat n = (case n of enat n \<Rightarrow> ereal (real n) | \<infinity> \<Rightarrow> \<infinity>)"
@@ -2629,7 +2628,7 @@
"A \<noteq> {} \<Longrightarrow> ereal_of_enat (SUP a\<in>A. f a) = (SUP a \<in> A. ereal_of_enat (f a))"
using ereal_of_enat_Sup[of "f`A"] by auto
-subsection "Limits on @{typ ereal}"
+subsection "Limits on \<^typ>\<open>ereal\<close>"
lemma open_PInfty: "open A \<Longrightarrow> \<infinity> \<in> A \<Longrightarrow> (\<exists>x. {ereal x<..} \<subseteq> A)"
unfolding open_ereal_generated
--- a/src/HOL/Library/FSet.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/FSet.thy Fri Jan 04 23:22:53 2019 +0100
@@ -1207,7 +1207,7 @@
including fset.lifting by transfer (auto intro: sum.reindex_cong subset_inj_on)
setup \<open>
-BNF_LFP_Size.register_size_global @{type_name fset} @{const_name size_fset}
+BNF_LFP_Size.register_size_global \<^type_name>\<open>fset\<close> \<^const_name>\<open>size_fset\<close>
@{thm size_fset_overloaded_def} @{thms size_fset_simps size_fset_overloaded_simps}
@{thms fset_size_o_map}
\<close>
--- a/src/HOL/Library/Finite_Lattice.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Finite_Lattice.thy Fri Jan 04 23:22:53 2019 +0100
@@ -8,14 +8,14 @@
text \<open>A non-empty finite lattice is a complete lattice.
Since types are never empty in Isabelle/HOL,
-a type of classes @{class finite} and @{class lattice}
-should also have class @{class complete_lattice}.
+a type of classes \<^class>\<open>finite\<close> and \<^class>\<open>lattice\<close>
+should also have class \<^class>\<open>complete_lattice\<close>.
A type class is defined
-that extends classes @{class finite} and @{class lattice}
-with the operators @{const bot}, @{const top}, @{const Inf}, and @{const Sup},
+that extends classes \<^class>\<open>finite\<close> and \<^class>\<open>lattice\<close>
+with the operators \<^const>\<open>bot\<close>, \<^const>\<open>top\<close>, \<^const>\<open>Inf\<close>, and \<^const>\<open>Sup\<close>,
along with assumptions that define these operators
-in terms of the ones of classes @{class finite} and @{class lattice}.
-The resulting class is a subclass of @{class complete_lattice}.\<close>
+in terms of the ones of classes \<^class>\<open>finite\<close> and \<^class>\<open>lattice\<close>.
+The resulting class is a subclass of \<^class>\<open>complete_lattice\<close>.\<close>
class finite_lattice_complete = finite + lattice + bot + top + Inf + Sup +
assumes bot_def: "bot = Inf_fin UNIV"
@@ -24,8 +24,8 @@
assumes Sup_def: "Sup A = Finite_Set.fold sup bot A"
text \<open>The definitional assumptions
-on the operators @{const bot} and @{const top}
-of class @{class finite_lattice_complete}
+on the operators \<^const>\<open>bot\<close> and \<^const>\<open>top\<close>
+of class \<^class>\<open>finite_lattice_complete\<close>
ensure that they yield bottom and top.\<close>
lemma finite_lattice_complete_bot_least: "(bot::'a::finite_lattice_complete) \<le> x"
@@ -43,8 +43,8 @@
instance finite_lattice_complete \<subseteq> bounded_lattice ..
text \<open>The definitional assumptions
-on the operators @{const Inf} and @{const Sup}
-of class @{class finite_lattice_complete}
+on the operators \<^const>\<open>Inf\<close> and \<^const>\<open>Sup\<close>
+of class \<^class>\<open>finite_lattice_complete\<close>
ensure that they yield infimum and supremum.\<close>
lemma finite_lattice_complete_Inf_empty: "Inf {} = (top :: 'a::finite_lattice_complete)"
@@ -152,8 +152,8 @@
subsection \<open>Finite Distributive Lattices\<close>
text \<open>A finite distributive lattice is a complete lattice
-whose @{const inf} and @{const sup} operators
-distribute over @{const Sup} and @{const Inf}.\<close>
+whose \<^const>\<open>inf\<close> and \<^const>\<open>sup\<close> operators
+distribute over \<^const>\<open>Sup\<close> and \<^const>\<open>Inf\<close>.\<close>
class finite_distrib_lattice_complete =
distrib_lattice + finite_lattice_complete
@@ -203,19 +203,19 @@
text \<open>A linear order is a distributive lattice.
A type class is defined
-that extends class @{class linorder}
-with the operators @{const inf} and @{const sup},
+that extends class \<^class>\<open>linorder\<close>
+with the operators \<^const>\<open>inf\<close> and \<^const>\<open>sup\<close>,
along with assumptions that define these operators
-in terms of the ones of class @{class linorder}.
-The resulting class is a subclass of @{class distrib_lattice}.\<close>
+in terms of the ones of class \<^class>\<open>linorder\<close>.
+The resulting class is a subclass of \<^class>\<open>distrib_lattice\<close>.\<close>
class linorder_lattice = linorder + inf + sup +
assumes inf_def: "inf x y = (if x \<le> y then x else y)"
assumes sup_def: "sup x y = (if x \<ge> y then x else y)"
text \<open>The definitional assumptions
-on the operators @{const inf} and @{const sup}
-of class @{class linorder_lattice}
+on the operators \<^const>\<open>inf\<close> and \<^const>\<open>sup\<close>
+of class \<^class>\<open>linorder_lattice\<close>
ensure that they yield infimum and supremum
and that they distribute over each other.\<close>
@@ -264,8 +264,8 @@
instance finite_linorder_complete \<subseteq> complete_linorder ..
text \<open>A (non-empty) finite linear order is a complete lattice
-whose @{const inf} and @{const sup} operators
-distribute over @{const Sup} and @{const Inf}.\<close>
+whose \<^const>\<open>inf\<close> and \<^const>\<open>sup\<close> operators
+distribute over \<^const>\<open>Sup\<close> and \<^const>\<open>Inf\<close>.\<close>
instance finite_linorder_complete \<subseteq> finite_distrib_lattice_complete ..
--- a/src/HOL/Library/Finite_Map.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Finite_Map.thy Fri Jan 04 23:22:53 2019 +0100
@@ -9,7 +9,7 @@
abbrevs "(=" = "\<subseteq>\<^sub>f"
begin
-subsection \<open>Auxiliary constants and lemmas over @{type map}\<close>
+subsection \<open>Auxiliary constants and lemmas over \<^type>\<open>map\<close>\<close>
parametric_constant map_add_transfer[transfer_rule]: map_add_def
parametric_constant map_of_transfer[transfer_rule]: map_of_def
@@ -1029,7 +1029,7 @@
by transfer' (auto simp: set_of_map_def)
-subsection \<open>@{const size} setup\<close>
+subsection \<open>\<^const>\<open>size\<close> setup\<close>
definition size_fmap :: "('a \<Rightarrow> nat) \<Rightarrow> ('b \<Rightarrow> nat) \<Rightarrow> ('a, 'b) fmap \<Rightarrow> nat" where
[simp]: "size_fmap f g m = size_fset (\<lambda>(a, b). f a + g b) (fset_of_fmap m)"
@@ -1060,7 +1060,7 @@
done
setup \<open>
-BNF_LFP_Size.register_size_global @{type_name fmap} @{const_name size_fmap}
+BNF_LFP_Size.register_size_global \<^type_name>\<open>fmap\<close> \<^const_name>\<open>size_fmap\<close>
@{thm size_fmap_overloaded_def} @{thms size_fmap_def size_fmap_overloaded_simps}
@{thms fmap_size_o_map}
\<close>
@@ -1431,7 +1431,7 @@
fmfilter fmadd fmmap fmmap_keys fmcomp
checking SML Scala Haskell? OCaml?
-\<comment> \<open>\<open>lifting\<close> through @{type fmap}\<close>
+\<comment> \<open>\<open>lifting\<close> through \<^type>\<open>fmap\<close>\<close>
experiment begin
--- a/src/HOL/Library/Float.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Float.thy Fri Jan 04 23:22:53 2019 +0100
@@ -639,7 +639,7 @@
end
-subsection \<open>Lemmas for types @{typ real}, @{typ nat}, @{typ int}\<close>
+subsection \<open>Lemmas for types \<^typ>\<open>real\<close>, \<^typ>\<open>nat\<close>, \<^typ>\<open>int\<close>\<close>
lemmas real_of_ints =
of_int_add
--- a/src/HOL/Library/FuncSet.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/FuncSet.thy Fri Jan 04 23:22:53 2019 +0100
@@ -33,7 +33,7 @@
where "compose A g f = (\<lambda>x\<in>A. g (f x))"
-subsection \<open>Basic Properties of @{term Pi}\<close>
+subsection \<open>Basic Properties of \<^term>\<open>Pi\<close>\<close>
lemma Pi_I[intro!]: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> B x) \<Longrightarrow> f \<in> Pi A B"
by (simp add: Pi_def)
@@ -72,7 +72,7 @@
apply (simp add: Pi_def)
apply auto
txt \<open>Converse direction requires Axiom of Choice to exhibit a function
- picking an element from each non-empty @{term "B x"}\<close>
+ picking an element from each non-empty \<^term>\<open>B x\<close>\<close>
apply (drule_tac x = "\<lambda>u. SOME y. y \<in> B u" in spec)
apply auto
apply (cut_tac P = "\<lambda>y. y \<in> B x" in some_eq_ex)
@@ -156,7 +156,7 @@
done
-subsection \<open>Composition With a Restricted Domain: @{term compose}\<close>
+subsection \<open>Composition With a Restricted Domain: \<^term>\<open>compose\<close>\<close>
lemma funcset_compose: "f \<in> A \<rightarrow> B \<Longrightarrow> g \<in> B \<rightarrow> C \<Longrightarrow> compose A g f \<in> A \<rightarrow> C"
by (simp add: Pi_def compose_def restrict_def)
@@ -173,7 +173,7 @@
by (auto simp add: image_def compose_eq)
-subsection \<open>Bounded Abstraction: @{term restrict}\<close>
+subsection \<open>Bounded Abstraction: \<^term>\<open>restrict\<close>\<close>
lemma restrict_cong: "I = J \<Longrightarrow> (\<And>i. i \<in> J =simp=> f i = g i) \<Longrightarrow> restrict f I = restrict g J"
by (auto simp: restrict_def fun_eq_iff simp_implies_def)
@@ -223,8 +223,8 @@
subsection \<open>Bijections Between Sets\<close>
-text \<open>The definition of @{const bij_betw} is in \<open>Fun.thy\<close>, but most of
-the theorems belong here, or need at least @{term Hilbert_Choice}.\<close>
+text \<open>The definition of \<^const>\<open>bij_betw\<close> is in \<open>Fun.thy\<close>, but most of
+the theorems belong here, or need at least \<^term>\<open>Hilbert_Choice\<close>.\<close>
lemma bij_betwI:
assumes "f \<in> A \<rightarrow> B"
--- a/src/HOL/Library/Function_Division.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Function_Division.thy Fri Jan 04 23:22:53 2019 +0100
@@ -32,7 +32,7 @@
text \<open>
Unfortunately, we cannot lift this operations to algebraic type
classes for division: being different from the constant
- zero function @{term "f \<noteq> 0"} is too weak as precondition.
+ zero function \<^term>\<open>f \<noteq> 0\<close> is too weak as precondition.
So we must introduce our own set of lemmas.
\<close>
@@ -58,8 +58,8 @@
text \<open>
Another possibility would be a reformulation of the division type
- classes to user a @{term zero_free} predicate rather than
- a direct @{term "a \<noteq> 0"} condition.
+ classes to user a \<^term>\<open>zero_free\<close> predicate rather than
+ a direct \<^term>\<open>a \<noteq> 0\<close> condition.
\<close>
end
--- a/src/HOL/Library/Going_To_Filter.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Going_To_Filter.thy Fri Jan 04 23:22:53 2019 +0100
@@ -20,26 +20,26 @@
where "f going_to F \<equiv> f going_to F within UNIV"
text \<open>
- The \<open>going_to\<close> filter is, in a sense, the opposite of @{term filtermap}.
+ The \<open>going_to\<close> filter is, in a sense, the opposite of \<^term>\<open>filtermap\<close>.
It corresponds to the intuition of, given a function $f: A \to B$ and a filter $F$ on the
range of $B$, looking at such values of $x$ that $f(x)$ approaches $F$. This can be
- written as @{term "f going_to F"}.
+ written as \<^term>\<open>f going_to F\<close>.
- A classic example is the @{term "at_infinity"} filter, which describes the neigbourhood
+ A classic example is the \<^term>\<open>at_infinity\<close> filter, which describes the neigbourhood
of infinity (i.\,e.\ all values sufficiently far away from the zero). This can also be written
- as @{term "norm going_to at_top"}.
+ as \<^term>\<open>norm going_to at_top\<close>.
Additionally, the \<open>going_to\<close> filter can be restricted with an optional `within' parameter.
For instance, if one would would want to consider the filter of complex numbers near infinity
that do not lie on the negative real line, one could write
- @{term "norm going_to at_top within - complex_of_real ` {..0}"}.
+ \<^term>\<open>norm going_to at_top within - complex_of_real ` {..0}\<close>.
A third, less mathematical example lies in the complexity analysis of algorithms.
Suppose we wanted to say that an algorithm on lists takes $O(n^2)$ time where $n$ is
the length of the input list. We can write this using the Landau symbols from the AFP,
- where the underlying filter is @{term "length going_to at_top"}. If, on the other hand,
+ where the underlying filter is \<^term>\<open>length going_to at_top\<close>. If, on the other hand,
we want to look the complexity of the algorithm on sorted lists, we could use the filter
- @{term "length going_to at_top within {xs. sorted xs}"}.
+ \<^term>\<open>length going_to at_top within {xs. sorted xs}\<close>.
\<close>
lemma going_to_def: "f going_to F = filtercomap f F"
--- a/src/HOL/Library/IArray.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/IArray.thy Fri Jan 04 23:22:53 2019 +0100
@@ -188,7 +188,7 @@
subsection \<open>Code Generation for Haskell\<close>
-text \<open>We map @{typ "'a iarray"}s in Isabelle/HOL to \<open>Data.Array.IArray.array\<close>
+text \<open>We map \<^typ>\<open>'a iarray\<close>s in Isabelle/HOL to \<open>Data.Array.IArray.array\<close>
in Haskell. Performance mapping to \<open>Data.Array.Unboxed.Array\<close> and
\<open>Data.Array.Array\<close> is similar.\<close>
--- a/src/HOL/Library/Infinite_Set.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Infinite_Set.thy Fri Jan 04 23:22:53 2019 +0100
@@ -214,7 +214,7 @@
text \<open>
Could be generalized to
- @{prop "enumerate' S n = (SOME t. t \<in> s \<and> finite {s\<in>S. s < t} \<and> card {s\<in>S. s < t} = n)"}.
+ \<^prop>\<open>enumerate' S n = (SOME t. t \<in> s \<and> finite {s\<in>S. s < t} \<and> card {s\<in>S. s < t} = n)\<close>.
\<close>
primrec (in wellorder) enumerate :: "'a set \<Rightarrow> nat \<Rightarrow> 'a"
--- a/src/HOL/Library/LaTeXsugar.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/LaTeXsugar.thy Fri Jan 04 23:22:53 2019 +0100
@@ -112,13 +112,13 @@
let
val rhs_vars = Term.add_vars rhs [];
fun dummy (v as Var (ixn as (_, T))) =
- if member ((=) ) rhs_vars ixn then v else Const (@{const_name DUMMY}, T)
+ if member ((=) ) rhs_vars ixn then v else Const (\<^const_name>\<open>DUMMY\<close>, T)
| dummy (t $ u) = dummy t $ dummy u
| dummy (Abs (n, T, b)) = Abs (n, T, dummy b)
| dummy t = t;
in wrap $ (eq $ dummy lhs $ rhs) end
in
- Term_Style.setup @{binding dummy_pats} (Scan.succeed (K dummy_pats))
+ Term_Style.setup \<^binding>\<open>dummy_pats\<close> (Scan.succeed (K dummy_pats))
end
\<close>
@@ -145,7 +145,7 @@
val style_eta_expand =
(Scan.repeat Args.name) >> (fn xs => fn ctxt => fn t => fst (eta_expand [] t xs))
-in Term_Style.setup @{binding eta_expand} style_eta_expand end
+in Term_Style.setup \<^binding>\<open>eta_expand\<close> style_eta_expand end
\<close>
end
--- a/src/HOL/Library/Lub_Glb.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Lub_Glb.thy Fri Jan 04 23:22:53 2019 +0100
@@ -45,7 +45,7 @@
where "ubs R S = Collect (isUb R S)"
-subsection \<open>Rules about the Operators @{term leastP}, @{term ub} and @{term lub}\<close>
+subsection \<open>Rules about the Operators \<^term>\<open>leastP\<close>, \<^term>\<open>ub\<close> and \<^term>\<open>lub\<close>\<close>
lemma leastPD1: "leastP P x \<Longrightarrow> P x"
by (simp add: leastP_def)
@@ -118,7 +118,7 @@
where "lbs R S = Collect (isLb R S)"
-subsection \<open>Rules about the Operators @{term greatestP}, @{term isLb} and @{term isGlb}\<close>
+subsection \<open>Rules about the Operators \<^term>\<open>greatestP\<close>, \<^term>\<open>isLb\<close> and \<^term>\<open>isGlb\<close>\<close>
lemma greatestPD1: "greatestP P x \<Longrightarrow> P x"
by (simp add: greatestP_def)
--- a/src/HOL/Library/Monad_Syntax.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Monad_Syntax.thy Fri Jan 04 23:22:53 2019 +0100
@@ -11,7 +11,7 @@
text \<open>
We provide a convenient do-notation for monadic expressions
- well-known from Haskell. @{const Let} is printed
+ well-known from Haskell. \<^const>\<open>Let\<close> is printed
specially in do-expressions.
\<close>
--- a/src/HOL/Library/Multiset.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Multiset.thy Fri Jan 04 23:22:53 2019 +0100
@@ -31,7 +31,7 @@
lemma multiset_eqI: "(\<And>x. count A x = count B x) \<Longrightarrow> A = B"
using multiset_eq_iff by auto
-text \<open>Preservation of the representing set @{term multiset}.\<close>
+text \<open>Preservation of the representing set \<^term>\<open>multiset\<close>.\<close>
lemma const0_in_multiset: "(\<lambda>a. 0) \<in> multiset"
by (simp add: multiset_def)
@@ -1653,10 +1653,10 @@
text \<open>
A note on code generation: When defining some function containing a
- subterm @{term "fold_mset F"}, code generation is not automatic. When
+ subterm \<^term>\<open>fold_mset F\<close>, code generation is not automatic. When
interpreting locale \<open>left_commutative\<close> with \<open>F\<close>, the
- would be code thms for @{const fold_mset} become thms like
- @{term "fold_mset F z {#} = z"} where \<open>F\<close> is not a pattern but
+ would be code thms for \<^const>\<open>fold_mset\<close> become thms like
+ \<^term>\<open>fold_mset F z {#} = z\<close> where \<open>F\<close> is not a pattern but
contains defined symbols, i.e.\ is not a code thm. Hence a separate
constant with its own code thms needs to be introduced for \<open>F\<close>. See the image operator below.
\<close>
@@ -1746,10 +1746,10 @@
"{#e | x\<in>#M. P#}" \<rightharpoonup> "{#e. x \<in># {# x\<in>#M. P#}#}"
text \<open>
- This allows to write not just filters like @{term "{#x\<in>#M. x<c#}"}
- but also images like @{term "{#x+x. x\<in>#M #}"} and @{term [source]
+ This allows to write not just filters like \<^term>\<open>{#x\<in>#M. x<c#}\<close>
+ but also images like \<^term>\<open>{#x+x. x\<in>#M #}\<close> and @{term [source]
"{#x+x|x\<in>#M. x<c#}"}, where the latter is currently displayed as
- @{term "{#x+x|x\<in>#M. x<c#}"}.
+ \<^term>\<open>{#x+x|x\<in>#M. x<c#}\<close>.
\<close>
lemma in_image_mset: "y \<in># {#f x. x \<in># M#} \<longleftrightarrow> y \<in> f ` set_mset M"
@@ -1965,7 +1965,7 @@
qed
then show "PROP ?P" "PROP ?Q" "PROP ?R"
by (auto elim!: Set.set_insert)
-qed \<comment> \<open>TODO: maybe define @{const mset_set} also in terms of @{const Abs_multiset}\<close>
+qed \<comment> \<open>TODO: maybe define \<^const>\<open>mset_set\<close> also in terms of \<^const>\<open>Abs_multiset\<close>\<close>
lemma elem_mset_set[simp, intro]: "finite A \<Longrightarrow> x \<in># mset_set A \<longleftrightarrow> x \<in> A"
by (induct A rule: finite_induct) simp_all
@@ -3245,14 +3245,14 @@
setup \<open>
let
- fun msetT T = Type (@{type_name multiset}, [T]);
-
- fun mk_mset T [] = Const (@{const_abbrev Mempty}, msetT T)
+ fun msetT T = Type (\<^type_name>\<open>multiset\<close>, [T]);
+
+ fun mk_mset T [] = Const (\<^const_abbrev>\<open>Mempty\<close>, msetT T)
| mk_mset T [x] =
- Const (@{const_name add_mset}, T --> msetT T --> msetT T) $ x $
- Const (@{const_abbrev Mempty}, msetT T)
+ Const (\<^const_name>\<open>add_mset\<close>, T --> msetT T --> msetT T) $ x $
+ Const (\<^const_abbrev>\<open>Mempty\<close>, msetT T)
| mk_mset T (x :: xs) =
- Const (@{const_name plus}, msetT T --> msetT T --> msetT T) $
+ Const (\<^const_name>\<open>plus\<close>, msetT T --> msetT T --> msetT T) $
mk_mset T [x] $ mk_mset T xs
fun mset_member_tac ctxt m i =
@@ -3267,7 +3267,7 @@
resolve_tac ctxt @{thms nonempty_single}
fun regroup_munion_conv ctxt =
- Function_Lib.regroup_conv ctxt @{const_abbrev Mempty} @{const_name plus}
+ Function_Lib.regroup_conv ctxt \<^const_abbrev>\<open>Mempty\<close> \<^const_name>\<open>plus\<close>
(map (fn t => t RS eq_reflection) (@{thms ac_simps} @ @{thms empty_neutral}))
fun unfold_pwleq_tac ctxt i =
@@ -3358,13 +3358,13 @@
in
(case maps elems_for (all_values elem_T) @
(if maybe_opt then [Const (Nitpick_Model.unrep_mixfix (), elem_T)] else []) of
- [] => Const (@{const_name zero_class.zero}, T)
+ [] => Const (\<^const_name>\<open>zero_class.zero\<close>, T)
| ts =>
- foldl1 (fn (s, t) => Const (@{const_name add_mset}, elem_T --> T --> T) $ s $ t)
+ foldl1 (fn (s, t) => Const (\<^const_name>\<open>add_mset\<close>, elem_T --> T --> T) $ s $ t)
ts)
end
| multiset_postproc _ _ _ _ t = t
- in Nitpick_Model.register_term_postprocessor @{typ "'a multiset"} multiset_postproc end
+ in Nitpick_Model.register_term_postprocessor \<^typ>\<open>'a multiset\<close> multiset_postproc end
\<close>
@@ -3513,8 +3513,8 @@
qed
text \<open>
- Exercise for the casual reader: add implementations for @{term "(\<le>)"}
- and @{term "(<)"} (multiset order).
+ Exercise for the casual reader: add implementations for \<^term>\<open>(\<le>)\<close>
+ and \<^term>\<open>(<)\<close> (multiset order).
\<close>
text \<open>Quickcheck generators\<close>
@@ -3865,7 +3865,7 @@
lemma rel_mset_rel_mset': "rel_mset R M N = rel_mset' R M N"
using rel_mset_imp_rel_mset' rel_mset'_imp_rel_mset by auto
-text \<open>The main end product for @{const rel_mset}: inductive characterization:\<close>
+text \<open>The main end product for \<^const>\<open>rel_mset\<close>: inductive characterization:\<close>
lemmas rel_mset_induct[case_names empty add, induct pred: rel_mset] =
rel_mset'.induct[unfolded rel_mset_rel_mset'[symmetric]]
@@ -3878,7 +3878,7 @@
done
setup \<open>
- BNF_LFP_Size.register_size_global @{type_name multiset} @{const_name size_multiset}
+ BNF_LFP_Size.register_size_global \<^type_name>\<open>multiset\<close> \<^const_name>\<open>size_multiset\<close>
@{thm size_multiset_overloaded_def}
@{thms size_multiset_empty size_multiset_single size_multiset_union size_empty size_single
size_union}
--- a/src/HOL/Library/Nat_Bijection.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Nat_Bijection.thy Fri Jan 04 23:22:53 2019 +0100
@@ -12,7 +12,7 @@
imports Main
begin
-subsection \<open>Type @{typ "nat \<times> nat"}\<close>
+subsection \<open>Type \<^typ>\<open>nat \<times> nat\<close>\<close>
text \<open>Triangle numbers: 0, 1, 3, 6, 10, 15, ...\<close>
@@ -28,7 +28,7 @@
definition prod_encode :: "nat \<times> nat \<Rightarrow> nat"
where "prod_encode = (\<lambda>(m, n). triangle (m + n) + m)"
-text \<open>In this auxiliary function, @{term "triangle k + m"} is an invariant.\<close>
+text \<open>In this auxiliary function, \<^term>\<open>triangle k + m\<close> is an invariant.\<close>
fun prod_decode_aux :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat"
where "prod_decode_aux k m =
@@ -98,7 +98,7 @@
by (induct b) (simp_all add: prod_encode_def)
-subsection \<open>Type @{typ "nat + nat"}\<close>
+subsection \<open>Type \<^typ>\<open>nat + nat\<close>\<close>
definition sum_encode :: "nat + nat \<Rightarrow> nat"
where "sum_encode x = (case x of Inl a \<Rightarrow> 2 * a | Inr b \<Rightarrow> Suc (2 * b))"
@@ -137,7 +137,7 @@
by (rule inj_sum_decode [THEN inj_eq])
-subsection \<open>Type @{typ "int"}\<close>
+subsection \<open>Type \<^typ>\<open>int\<close>\<close>
definition int_encode :: "int \<Rightarrow> nat"
where "int_encode i = sum_encode (if 0 \<le> i then Inl (nat i) else Inr (nat (- i - 1)))"
@@ -177,7 +177,7 @@
by (rule inj_int_decode [THEN inj_eq])
-subsection \<open>Type @{typ "nat list"}\<close>
+subsection \<open>Type \<^typ>\<open>nat list\<close>\<close>
fun list_encode :: "nat list \<Rightarrow> nat"
where
--- a/src/HOL/Library/Nonpos_Ints.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Nonpos_Ints.thy Fri Jan 04 23:22:53 2019 +0100
@@ -11,7 +11,7 @@
subsection\<open>Non-positive integers\<close>
text \<open>
The set of non-positive integers on a ring. (in analogy to the set of non-negative
- integers @{term "\<nat>"}) This is useful e.g. for the Gamma function.
+ integers \<^term>\<open>\<nat>\<close>) This is useful e.g. for the Gamma function.
\<close>
definition nonpos_Ints ("\<int>\<^sub>\<le>\<^sub>0") where "\<int>\<^sub>\<le>\<^sub>0 = {of_int n |n. n \<le> 0}"
--- a/src/HOL/Library/Numeral_Type.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Numeral_Type.thy Fri Jan 04 23:22:53 2019 +0100
@@ -182,7 +182,7 @@
text \<open>
Unfortunately \<open>ring_1\<close> instance is not possible for
- @{typ num1}, since 0 and 1 are not distinct.
+ \<^typ>\<open>num1\<close>, since 0 and 1 are not distinct.
\<close>
instantiation num1 :: "{comm_ring,comm_monoid_mult,numeral}"
@@ -317,7 +317,7 @@
subsection \<open>Code setup and type classes for code generation\<close>
-text \<open>Code setup for @{typ num0} and @{typ num1}\<close>
+text \<open>Code setup for \<^typ>\<open>num0\<close> and \<^typ>\<open>num1\<close>\<close>
definition Num0 :: num0 where "Num0 = Abs_num0 0"
code_datatype Num0
@@ -365,7 +365,7 @@
end
-text \<open>Code setup for @{typ "'a bit0"} and @{typ "'a bit1"}\<close>
+text \<open>Code setup for \<^typ>\<open>'a bit0\<close> and \<^typ>\<open>'a bit1\<close>\<close>
declare
bit0.Rep_inverse[code abstype]
@@ -477,11 +477,11 @@
let
fun mk_bintype n =
let
- fun mk_bit 0 = Syntax.const @{type_syntax bit0}
- | mk_bit 1 = Syntax.const @{type_syntax bit1};
+ fun mk_bit 0 = Syntax.const \<^type_syntax>\<open>bit0\<close>
+ | mk_bit 1 = Syntax.const \<^type_syntax>\<open>bit1\<close>;
fun bin_of n =
- if n = 1 then Syntax.const @{type_syntax num1}
- else if n = 0 then Syntax.const @{type_syntax num0}
+ if n = 1 then Syntax.const \<^type_syntax>\<open>num1\<close>
+ else if n = 0 then Syntax.const \<^type_syntax>\<open>num0\<close>
else if n = ~1 then raise TERM ("negative type numeral", [])
else
let val (q, r) = Integer.div_mod n 2;
@@ -491,7 +491,7 @@
fun numeral_tr [Free (str, _)] = mk_bintype (the (Int.fromString str))
| numeral_tr ts = raise TERM ("numeral_tr", ts);
- in [(@{syntax_const "_NumeralType"}, K numeral_tr)] end
+ in [(\<^syntax_const>\<open>_NumeralType\<close>, K numeral_tr)] end
\<close>
print_translation \<open>
@@ -499,10 +499,10 @@
fun int_of [] = 0
| int_of (b :: bs) = b + 2 * int_of bs;
- fun bin_of (Const (@{type_syntax num0}, _)) = []
- | bin_of (Const (@{type_syntax num1}, _)) = [1]
- | bin_of (Const (@{type_syntax bit0}, _) $ bs) = 0 :: bin_of bs
- | bin_of (Const (@{type_syntax bit1}, _) $ bs) = 1 :: bin_of bs
+ fun bin_of (Const (\<^type_syntax>\<open>num0\<close>, _)) = []
+ | bin_of (Const (\<^type_syntax>\<open>num1\<close>, _)) = [1]
+ | bin_of (Const (\<^type_syntax>\<open>bit0\<close>, _) $ bs) = 0 :: bin_of bs
+ | bin_of (Const (\<^type_syntax>\<open>bit1\<close>, _) $ bs) = 1 :: bin_of bs
| bin_of t = raise TERM ("bin_of", [t]);
fun bit_tr' b [t] =
@@ -511,12 +511,12 @@
val i = int_of rev_digs;
val num = string_of_int (abs i);
in
- Syntax.const @{syntax_const "_NumeralType"} $ Syntax.free num
+ Syntax.const \<^syntax_const>\<open>_NumeralType\<close> $ Syntax.free num
end
| bit_tr' b _ = raise Match;
in
- [(@{type_syntax bit0}, K (bit_tr' 0)),
- (@{type_syntax bit1}, K (bit_tr' 1))]
+ [(\<^type_syntax>\<open>bit0\<close>, K (bit_tr' 0)),
+ (\<^type_syntax>\<open>bit1\<close>, K (bit_tr' 1))]
end
\<close>
--- a/src/HOL/Library/Open_State_Syntax.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Open_State_Syntax.thy Fri Jan 04 23:22:53 2019 +0100
@@ -59,20 +59,20 @@
notation scomp (infixl "\<circ>\<rightarrow>" 60)
text \<open>
- Given two transformations @{term f} and @{term g}, they may be
- directly composed using the @{term "(\<circ>>)"} combinator, forming a
- forward composition: @{prop "(f \<circ>> g) s = f (g s)"}.
+ Given two transformations \<^term>\<open>f\<close> and \<^term>\<open>g\<close>, they may be
+ directly composed using the \<^term>\<open>(\<circ>>)\<close> combinator, forming a
+ forward composition: \<^prop>\<open>(f \<circ>> g) s = f (g s)\<close>.
After any yielding transformation, we bind the side result
immediately using a lambda abstraction. This is the purpose of the
- @{term "(\<circ>\<rightarrow>)"} combinator: @{prop "(f \<circ>\<rightarrow> (\<lambda>x. g)) s = (let (x, s')
- = f s in g s')"}.
+ \<^term>\<open>(\<circ>\<rightarrow>)\<close> combinator: \<^prop>\<open>(f \<circ>\<rightarrow> (\<lambda>x. g)) s = (let (x, s')
+ = f s in g s')\<close>.
- For queries, the existing @{term "Let"} is appropriate.
+ For queries, the existing \<^term>\<open>Let\<close> is appropriate.
Naturally, a computation may yield a side result by pairing it to
the state from the left; we introduce the suggestive abbreviation
- @{term return} for this purpose.
+ \<^term>\<open>return\<close> for this purpose.
The most crucial distinction to Haskell is that we do not need to
introduce distinguished type constructors for different kinds of
--- a/src/HOL/Library/Pattern_Aliases.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Pattern_Aliases.thy Fri Jan 04 23:22:53 2019 +0100
@@ -14,8 +14,8 @@
well for function definitions (see usage below). All features are packed into a @{command bundle}.
The following caveats should be kept in mind:
- \<^item> The translation expects a term of the form @{prop "f x y = rhs"}, where \<open>x\<close> and \<open>y\<close> are patterns
- that may contain aliases. The result of the translation is a nested @{const Let}-expression on
+ \<^item> The translation expects a term of the form \<^prop>\<open>f x y = rhs\<close>, where \<open>x\<close> and \<open>y\<close> are patterns
+ that may contain aliases. The result of the translation is a nested \<^const>\<open>Let\<close>-expression on
the right hand side. The code generator \<^emph>\<open>does not\<close> print Isabelle pattern aliases to target
language pattern aliases.
\<^item> The translation does not process nested equalities; only the top-level equality is translated.
@@ -26,13 +26,13 @@
additionally introduced variables are bound using a ``fake quantifier'' that does not
appear in the output.
\<^item> To obtain reasonable induction principles in function definitions, the bundle also declares
- a custom congruence rule for @{const Let} that only affects @{command fun}. This congruence
+ a custom congruence rule for \<^const>\<open>Let\<close> that only affects @{command fun}. This congruence
rule might lead to an explosion in term size (although that is rare)! In some circumstances
(using \<open>let\<close> to destructure tuples), the internal construction of functions stumbles over this
rule and prints an error. To mitigate this, either
- \<^item> activate the bundle locally (@{theory_text \<open>context includes ... begin\<close>}) or
- \<^item> rewrite the \<open>let\<close>-expression to use \<open>case\<close>: @{term \<open>let (a, b) = x in (b, a)\<close>} becomes
- @{term \<open>case x of (a, b) \<Rightarrow> (b, a)\<close>}.
+ \<^item> activate the bundle locally (\<^theory_text>\<open>context includes ... begin\<close>) or
+ \<^item> rewrite the \<open>let\<close>-expression to use \<open>case\<close>: \<^term>\<open>let (a, b) = x in (b, a)\<close> becomes
+ \<^term>\<open>case x of (a, b) \<Rightarrow> (b, a)\<close>.
\<^item> The bundle also adds the @{thm Let_def} rule to the simpset.
\<close>
@@ -84,7 +84,7 @@
in fst (go t) end
(* adapted from logic.ML *)
-fun fake_const T = Const (@{const_name fake_quant}, (T --> propT) --> propT);
+fun fake_const T = Const (\<^const_name>\<open>fake_quant\<close>, (T --> propT) --> propT);
fun dependent_fake_name v t =
let
@@ -97,14 +97,14 @@
fun check_pattern_syntax t =
case strip_all t of
- (vars, @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ lhs $ rhs)) =>
+ (vars, @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ lhs $ rhs)) =>
let
- fun go (Const (@{const_name as}, _) $ pat $ var, rhs) =
+ fun go (Const (\<^const_name>\<open>as\<close>, _) $ pat $ var, rhs) =
let
val (pat', rhs') = go (pat, rhs)
val _ = if is_Free var then () else error "Right-hand side of =: must be a free variable"
val rhs'' =
- Const (@{const_name Let}, let_typ (fastype_of var) (fastype_of rhs)) $
+ Const (\<^const_name>\<open>Let\<close>, let_typ (fastype_of var) (fastype_of rhs)) $
pat' $ lambda var rhs'
in
(pat', rhs'')
@@ -126,15 +126,15 @@
fun uncheck_pattern_syntax ctxt t =
case strip_all t of
- (vars, @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ lhs $ rhs)) =>
+ (vars, @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ lhs $ rhs)) =>
let
(* restricted to going down abstractions; ignores eta-contracted rhs *)
- fun go lhs (rhs as Const (@{const_name Let}, _) $ pat $ Abs (name, typ, t)) ctxt frees =
+ fun go lhs (rhs as Const (\<^const_name>\<open>Let\<close>, _) $ pat $ Abs (name, typ, t)) ctxt frees =
if exists_subterm (fn t' => t' = pat) lhs then
let
val ([name'], ctxt') = Variable.variant_fixes [name] ctxt
val free = Free (name', typ)
- val subst = (pat, Const (@{const_name as}, as_typ typ) $ pat $ free)
+ val subst = (pat, Const (\<^const_name>\<open>as\<close>, as_typ typ) $ pat $ free)
val lhs' = subst_once subst lhs
val rhs' = subst_bound (free, t)
in
@@ -199,10 +199,10 @@
val actual =
@{thm test_2.simps(1)}
|> Thm.prop_of
- |> Syntax.string_of_term @{context}
+ |> Syntax.string_of_term \<^context>
|> YXML.content_of
val expected = "test_2 (?y # (?y' # ?ys =: x') =: x) = x @ x' @ x'"
-in @{assert} (actual = expected) end
+in \<^assert> (actual = expected) end
\<close>
end
--- a/src/HOL/Library/Periodic_Fun.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Periodic_Fun.thy Fri Jan 04 23:22:53 2019 +0100
@@ -13,10 +13,10 @@
for some period $p$ and gets derived results like $f(x - p) = f(x)$ and $f(x + 2p) = f(x)$
for free.
- @{term g} and @{term gm} are ``plus/minus k periods'' functions.
- @{term g1} and @{term gn1} are ``plus/minus one period'' functions.
+ \<^term>\<open>g\<close> and \<^term>\<open>gm\<close> are ``plus/minus k periods'' functions.
+ \<^term>\<open>g1\<close> and \<^term>\<open>gn1\<close> are ``plus/minus one period'' functions.
This is useful e.g. if the period is one; the lemmas one gets are then
- @{term "f (x + 1) = f x"} instead of @{term "f (x + 1 * 1) = f x"} etc.
+ \<^term>\<open>f (x + 1) = f x\<close> instead of \<^term>\<open>f (x + 1 * 1) = f x\<close> etc.
\<close>
locale periodic_fun =
fixes f :: "('a :: {ring_1}) \<Rightarrow> 'b" and g gm :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" and g1 gn1 :: "'a \<Rightarrow> 'a"
@@ -63,8 +63,8 @@
text \<open>
- Specialised case of the @{term periodic_fun} locale for periods that are not 1.
- Gives lemmas @{term "f (x - period) = f x"} etc.
+ Specialised case of the \<^term>\<open>periodic_fun\<close> locale for periods that are not 1.
+ Gives lemmas \<^term>\<open>f (x - period) = f x\<close> etc.
\<close>
locale periodic_fun_simple =
fixes f :: "('a :: {ring_1}) \<Rightarrow> 'b" and period :: 'a
@@ -77,8 +77,8 @@
text \<open>
- Specialised case of the @{term periodic_fun} locale for period 1.
- Gives lemmas @{term "f (x - 1) = f x"} etc.
+ Specialised case of the \<^term>\<open>periodic_fun\<close> locale for period 1.
+ Gives lemmas \<^term>\<open>f (x - 1) = f x\<close> etc.
\<close>
locale periodic_fun_simple' =
fixes f :: "('a :: {ring_1}) \<Rightarrow> 'b"
--- a/src/HOL/Library/Phantom_Type.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Phantom_Type.thy Fri Jan 04 23:22:53 2019 +0100
@@ -23,11 +23,11 @@
typed_print_translation \<open>
let
- fun phantom_tr' ctxt (Type (@{type_name fun}, [_, Type (@{type_name phantom}, [T, _])])) ts =
+ fun phantom_tr' ctxt (Type (\<^type_name>\<open>fun\<close>, [_, Type (\<^type_name>\<open>phantom\<close>, [T, _])])) ts =
list_comb
- (Syntax.const @{syntax_const "_Phantom"} $ Syntax_Phases.term_of_typ ctxt T, ts)
+ (Syntax.const \<^syntax_const>\<open>_Phantom\<close> $ Syntax_Phases.term_of_typ ctxt T, ts)
| phantom_tr' _ _ _ = raise Match;
- in [(@{const_syntax phantom}, phantom_tr')] end
+ in [(\<^const_syntax>\<open>phantom\<close>, phantom_tr')] end
\<close>
lemma of_phantom_inject [simp]:
--- a/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy Fri Jan 04 23:22:53 2019 +0100
@@ -22,16 +22,16 @@
"((A::bool) \<noteq> (B::bool)) = ((A \<and> \<not> B) \<or> (B \<and> \<not> A))"
by fast
-setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name Let}]\<close>
+setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>Let\<close>]\<close>
section \<open>Pairs\<close>
-setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name fst}, @{const_name snd}, @{const_name case_prod}]\<close>
+setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>fst\<close>, \<^const_name>\<open>snd\<close>, \<^const_name>\<open>case_prod\<close>]\<close>
section \<open>Filters\<close>
(*TODO: shouldn't this be done by typedef? *)
-setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name Abs_filter}, @{const_name Rep_filter}]\<close>
+setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>Abs_filter\<close>, \<^const_name>\<open>Rep_filter\<close>]\<close>
section \<open>Bounded quantifiers\<close>
@@ -54,12 +54,12 @@
section \<open>Setup for Numerals\<close>
-setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name numeral}]\<close>
-setup \<open>Predicate_Compile_Data.keep_functions [@{const_name numeral}]\<close>
-setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name Char}]\<close>
-setup \<open>Predicate_Compile_Data.keep_functions [@{const_name Char}]\<close>
+setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>numeral\<close>]\<close>
+setup \<open>Predicate_Compile_Data.keep_functions [\<^const_name>\<open>numeral\<close>]\<close>
+setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>Char\<close>]\<close>
+setup \<open>Predicate_Compile_Data.keep_functions [\<^const_name>\<open>Char\<close>]\<close>
-setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name divide}, @{const_name modulo}, @{const_name times}]\<close>
+setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>divide\<close>, \<^const_name>\<open>modulo\<close>, \<^const_name>\<open>times\<close>]\<close>
section \<open>Arithmetic operations\<close>
@@ -95,57 +95,57 @@
val ioi = Fun (Input, Fun (Output, Fun (Input, Bool)))
val oii = Fun (Output, Fun (Input, Fun (Input, Bool)))
val ooi = Fun (Output, Fun (Output, Fun (Input, Bool)))
- val plus_nat = Core_Data.functional_compilation @{const_name plus} iio
- val minus_nat = Core_Data.functional_compilation @{const_name "minus"} iio
+ val plus_nat = Core_Data.functional_compilation \<^const_name>\<open>plus\<close> iio
+ val minus_nat = Core_Data.functional_compilation \<^const_name>\<open>minus\<close> iio
fun subtract_nat compfuns (_ : typ) =
let
- val T = Predicate_Compile_Aux.mk_monadT compfuns @{typ nat}
+ val T = Predicate_Compile_Aux.mk_monadT compfuns \<^typ>\<open>nat\<close>
in
- absdummy @{typ nat} (absdummy @{typ nat}
- (Const (@{const_name "If"}, @{typ bool} --> T --> T --> T) $
- (@{term "(>) :: nat => nat => bool"} $ Bound 1 $ Bound 0) $
- Predicate_Compile_Aux.mk_empty compfuns @{typ nat} $
+ absdummy \<^typ>\<open>nat\<close> (absdummy \<^typ>\<open>nat\<close>
+ (Const (\<^const_name>\<open>If\<close>, \<^typ>\<open>bool\<close> --> T --> T --> T) $
+ (\<^term>\<open>(>) :: nat => nat => bool\<close> $ Bound 1 $ Bound 0) $
+ Predicate_Compile_Aux.mk_empty compfuns \<^typ>\<open>nat\<close> $
Predicate_Compile_Aux.mk_single compfuns
- (@{term "(-) :: nat => nat => nat"} $ Bound 0 $ Bound 1)))
+ (\<^term>\<open>(-) :: nat => nat => nat\<close> $ Bound 0 $ Bound 1)))
end
fun enumerate_addups_nat compfuns (_ : typ) =
- absdummy @{typ nat} (Predicate_Compile_Aux.mk_iterate_upto compfuns @{typ "nat * nat"}
- (absdummy @{typ natural} (@{term "Pair :: nat => nat => nat * nat"} $
- (@{term "nat_of_natural"} $ Bound 0) $
- (@{term "(-) :: nat => nat => nat"} $ Bound 1 $ (@{term "nat_of_natural"} $ Bound 0))),
- @{term "0 :: natural"}, @{term "natural_of_nat"} $ Bound 0))
+ absdummy \<^typ>\<open>nat\<close> (Predicate_Compile_Aux.mk_iterate_upto compfuns \<^typ>\<open>nat * nat\<close>
+ (absdummy \<^typ>\<open>natural\<close> (\<^term>\<open>Pair :: nat => nat => nat * nat\<close> $
+ (\<^term>\<open>nat_of_natural\<close> $ Bound 0) $
+ (\<^term>\<open>(-) :: nat => nat => nat\<close> $ Bound 1 $ (\<^term>\<open>nat_of_natural\<close> $ Bound 0))),
+ \<^term>\<open>0 :: natural\<close>, \<^term>\<open>natural_of_nat\<close> $ Bound 0))
fun enumerate_nats compfuns (_ : typ) =
let
- val (single_const, _) = strip_comb (Predicate_Compile_Aux.mk_single compfuns @{term "0 :: nat"})
- val T = Predicate_Compile_Aux.mk_monadT compfuns @{typ nat}
+ val (single_const, _) = strip_comb (Predicate_Compile_Aux.mk_single compfuns \<^term>\<open>0 :: nat\<close>)
+ val T = Predicate_Compile_Aux.mk_monadT compfuns \<^typ>\<open>nat\<close>
in
- absdummy @{typ nat} (absdummy @{typ nat}
- (Const (@{const_name If}, @{typ bool} --> T --> T --> T) $
- (@{term "(=) :: nat => nat => bool"} $ Bound 0 $ @{term "0::nat"}) $
- (Predicate_Compile_Aux.mk_iterate_upto compfuns @{typ nat} (@{term "nat_of_natural"},
- @{term "0::natural"}, @{term "natural_of_nat"} $ Bound 1)) $
- (single_const $ (@{term "(+) :: nat => nat => nat"} $ Bound 1 $ Bound 0))))
+ absdummy \<^typ>\<open>nat\<close> (absdummy \<^typ>\<open>nat\<close>
+ (Const (\<^const_name>\<open>If\<close>, \<^typ>\<open>bool\<close> --> T --> T --> T) $
+ (\<^term>\<open>(=) :: nat => nat => bool\<close> $ Bound 0 $ \<^term>\<open>0::nat\<close>) $
+ (Predicate_Compile_Aux.mk_iterate_upto compfuns \<^typ>\<open>nat\<close> (\<^term>\<open>nat_of_natural\<close>,
+ \<^term>\<open>0::natural\<close>, \<^term>\<open>natural_of_nat\<close> $ Bound 1)) $
+ (single_const $ (\<^term>\<open>(+) :: nat => nat => nat\<close> $ Bound 1 $ Bound 0))))
end
in
- Core_Data.force_modes_and_compilations @{const_name plus_eq_nat}
+ Core_Data.force_modes_and_compilations \<^const_name>\<open>plus_eq_nat\<close>
[(iio, (plus_nat, false)), (oii, (subtract_nat, false)), (ioi, (subtract_nat, false)),
(ooi, (enumerate_addups_nat, false))]
#> Predicate_Compile_Fun.add_function_predicate_translation
- (@{term "plus :: nat => nat => nat"}, @{term "plus_eq_nat"})
- #> Core_Data.force_modes_and_compilations @{const_name minus_eq_nat}
+ (\<^term>\<open>plus :: nat => nat => nat\<close>, \<^term>\<open>plus_eq_nat\<close>)
+ #> Core_Data.force_modes_and_compilations \<^const_name>\<open>minus_eq_nat\<close>
[(iio, (minus_nat, false)), (oii, (enumerate_nats, false))]
#> Predicate_Compile_Fun.add_function_predicate_translation
- (@{term "minus :: nat => nat => nat"}, @{term "minus_eq_nat"})
- #> Core_Data.force_modes_and_functions @{const_name plus_eq_int}
- [(iio, (@{const_name plus}, false)), (ioi, (@{const_name subtract}, false)),
- (oii, (@{const_name subtract}, false))]
+ (\<^term>\<open>minus :: nat => nat => nat\<close>, \<^term>\<open>minus_eq_nat\<close>)
+ #> Core_Data.force_modes_and_functions \<^const_name>\<open>plus_eq_int\<close>
+ [(iio, (\<^const_name>\<open>plus\<close>, false)), (ioi, (\<^const_name>\<open>subtract\<close>, false)),
+ (oii, (\<^const_name>\<open>subtract\<close>, false))]
#> Predicate_Compile_Fun.add_function_predicate_translation
- (@{term "plus :: int => int => int"}, @{term "plus_eq_int"})
- #> Core_Data.force_modes_and_functions @{const_name minus_eq_int}
- [(iio, (@{const_name minus}, false)), (oii, (@{const_name plus}, false)),
- (ioi, (@{const_name minus}, false))]
+ (\<^term>\<open>plus :: int => int => int\<close>, \<^term>\<open>plus_eq_int\<close>)
+ #> Core_Data.force_modes_and_functions \<^const_name>\<open>minus_eq_int\<close>
+ [(iio, (\<^const_name>\<open>minus\<close>, false)), (oii, (\<^const_name>\<open>plus\<close>, false)),
+ (ioi, (\<^const_name>\<open>minus\<close>, false))]
#> Predicate_Compile_Fun.add_function_predicate_translation
- (@{term "minus :: int => int => int"}, @{term "minus_eq_int"})
+ (\<^term>\<open>minus :: int => int => int\<close>, \<^term>\<open>minus_eq_int\<close>)
end
\<close>
@@ -244,7 +244,7 @@
section \<open>Setup for String.literal\<close>
-setup \<open>Predicate_Compile_Data.ignore_consts [@{const_name String.Literal}]\<close>
+setup \<open>Predicate_Compile_Data.ignore_consts [\<^const_name>\<open>String.Literal\<close>]\<close>
section \<open>Simplification rules for optimisation\<close>
--- a/src/HOL/Library/Quotient_Type.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Quotient_Type.thy Fri Jan 04 23:22:53 2019 +0100
@@ -58,7 +58,7 @@
end
text \<open>The quotient type \<open>'a quot\<close> consists of all \emph{equivalence
- classes} over elements of the base type @{typ 'a}.\<close>
+ classes} over elements of the base type \<^typ>\<open>'a\<close>.\<close>
definition (in eqv) "quot = {{x. a \<sim> x} | a. True}"
--- a/src/HOL/Library/RBT_Impl.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/RBT_Impl.thy Fri Jan 04 23:22:53 2019 +0100
@@ -2017,7 +2017,7 @@
ord.rbt_map_entry.simps
ord.rbt_bulkload_def
-text \<open>More efficient implementations for @{term entries} and @{term keys}\<close>
+text \<open>More efficient implementations for \<^term>\<open>entries\<close> and \<^term>\<open>keys\<close>\<close>
definition gen_entries ::
"(('a \<times> 'b) \<times> ('a, 'b) rbt) list \<Rightarrow> ('a, 'b) rbt \<Rightarrow> ('a \<times> 'b) list"
@@ -2050,24 +2050,24 @@
text \<open>Restore original type constraints for constants\<close>
setup \<open>
fold Sign.add_const_constraint
- [(@{const_name rbt_less}, SOME @{typ "('a :: order) \<Rightarrow> ('a, 'b) rbt \<Rightarrow> bool"}),
- (@{const_name rbt_greater}, SOME @{typ "('a :: order) \<Rightarrow> ('a, 'b) rbt \<Rightarrow> bool"}),
- (@{const_name rbt_sorted}, SOME @{typ "('a :: linorder, 'b) rbt \<Rightarrow> bool"}),
- (@{const_name rbt_lookup}, SOME @{typ "('a :: linorder, 'b) rbt \<Rightarrow> 'a \<rightharpoonup> 'b"}),
- (@{const_name is_rbt}, SOME @{typ "('a :: linorder, 'b) rbt \<Rightarrow> bool"}),
- (@{const_name rbt_ins}, SOME @{typ "('a::linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_insert_with_key}, SOME @{typ "('a::linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_insert_with}, SOME @{typ "('b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a :: linorder) \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_insert}, SOME @{typ "('a :: linorder) \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_del_from_left}, SOME @{typ "('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_del_from_right}, SOME @{typ "('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_del}, SOME @{typ "('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_delete}, SOME @{typ "('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_union_with_key}, SOME @{typ "('a::linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_union_with}, SOME @{typ "('b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a::linorder,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_union}, SOME @{typ "('a::linorder,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_map_entry}, SOME @{typ "'a::linorder \<Rightarrow> ('b \<Rightarrow> 'b) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt"}),
- (@{const_name rbt_bulkload}, SOME @{typ "('a \<times> 'b) list \<Rightarrow> ('a::linorder,'b) rbt"})]
+ [(\<^const_name>\<open>rbt_less\<close>, SOME \<^typ>\<open>('a :: order) \<Rightarrow> ('a, 'b) rbt \<Rightarrow> bool\<close>),
+ (\<^const_name>\<open>rbt_greater\<close>, SOME \<^typ>\<open>('a :: order) \<Rightarrow> ('a, 'b) rbt \<Rightarrow> bool\<close>),
+ (\<^const_name>\<open>rbt_sorted\<close>, SOME \<^typ>\<open>('a :: linorder, 'b) rbt \<Rightarrow> bool\<close>),
+ (\<^const_name>\<open>rbt_lookup\<close>, SOME \<^typ>\<open>('a :: linorder, 'b) rbt \<Rightarrow> 'a \<rightharpoonup> 'b\<close>),
+ (\<^const_name>\<open>is_rbt\<close>, SOME \<^typ>\<open>('a :: linorder, 'b) rbt \<Rightarrow> bool\<close>),
+ (\<^const_name>\<open>rbt_ins\<close>, SOME \<^typ>\<open>('a::linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_insert_with_key\<close>, SOME \<^typ>\<open>('a::linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_insert_with\<close>, SOME \<^typ>\<open>('b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a :: linorder) \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_insert\<close>, SOME \<^typ>\<open>('a :: linorder) \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_del_from_left\<close>, SOME \<^typ>\<open>('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_del_from_right\<close>, SOME \<^typ>\<open>('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_del\<close>, SOME \<^typ>\<open>('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_delete\<close>, SOME \<^typ>\<open>('a::linorder) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_union_with_key\<close>, SOME \<^typ>\<open>('a::linorder \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_union_with\<close>, SOME \<^typ>\<open>('b \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> ('a::linorder,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_union\<close>, SOME \<^typ>\<open>('a::linorder,'b) rbt \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_map_entry\<close>, SOME \<^typ>\<open>'a::linorder \<Rightarrow> ('b \<Rightarrow> 'b) \<Rightarrow> ('a,'b) rbt \<Rightarrow> ('a,'b) rbt\<close>),
+ (\<^const_name>\<open>rbt_bulkload\<close>, SOME \<^typ>\<open>('a \<times> 'b) list \<Rightarrow> ('a::linorder,'b) rbt\<close>)]
\<close>
hide_const (open) R B Empty entries keys fold gen_keys gen_entries
--- a/src/HOL/Library/RBT_Mapping.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/RBT_Mapping.thy Fri Jan 04 23:22:53 2019 +0100
@@ -113,25 +113,24 @@
text \<open>
This theory defines abstract red-black trees as an efficient
representation of finite maps, backed by the implementation
- in @{theory "HOL-Library.RBT_Impl"}.
+ in \<^theory>\<open>HOL-Library.RBT_Impl\<close>.
\<close>
subsection \<open>Data type and invariant\<close>
text \<open>
- The type @{typ "('k, 'v) RBT_Impl.rbt"} denotes red-black trees with
- keys of type @{typ "'k"} and values of type @{typ "'v"}. To function
+ The type \<^typ>\<open>('k, 'v) RBT_Impl.rbt\<close> denotes red-black trees with
+ keys of type \<^typ>\<open>'k\<close> and values of type \<^typ>\<open>'v\<close>. To function
properly, the key type musorted belong to the \<open>linorder\<close>
class.
- A value @{term t} of this type is a valid red-black tree if it
- satisfies the invariant \<open>is_rbt t\<close>. The abstract type @{typ
- "('k, 'v) rbt"} always obeys this invariant, and for this reason you
- should only use this in our application. Going back to @{typ "('k,
- 'v) RBT_Impl.rbt"} may be necessary in proofs if not yet proven
+ A value \<^term>\<open>t\<close> of this type is a valid red-black tree if it
+ satisfies the invariant \<open>is_rbt t\<close>. The abstract type \<^typ>\<open>('k, 'v) rbt\<close> always obeys this invariant, and for this reason you
+ should only use this in our application. Going back to \<^typ>\<open>('k,
+ 'v) RBT_Impl.rbt\<close> may be necessary in proofs if not yet proven
properties about the operations must be established.
- The interpretation function @{const "RBT.lookup"} returns the partial
+ The interpretation function \<^const>\<open>RBT.lookup\<close> returns the partial
map represented by a red-black tree:
@{term_type[display] "RBT.lookup"}
--- a/src/HOL/Library/Ramsey.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Ramsey.thy Fri Jan 04 23:22:53 2019 +0100
@@ -154,11 +154,11 @@
subsubsection \<open>Partitions of a Set\<close>
definition part :: "nat \<Rightarrow> nat \<Rightarrow> 'a set \<Rightarrow> ('a set \<Rightarrow> nat) \<Rightarrow> bool"
- \<comment> \<open>the function @{term f} partitions the @{term r}-subsets of the typically
- infinite set @{term Y} into @{term s} distinct categories.\<close>
+ \<comment> \<open>the function \<^term>\<open>f\<close> partitions the \<^term>\<open>r\<close>-subsets of the typically
+ infinite set \<^term>\<open>Y\<close> into \<^term>\<open>s\<close> distinct categories.\<close>
where "part r s Y f \<longleftrightarrow> (\<forall>X. X \<subseteq> Y \<and> finite X \<and> card X = r \<longrightarrow> f X < s)"
-text \<open>For induction, we decrease the value of @{term r} in partitions.\<close>
+text \<open>For induction, we decrease the value of \<^term>\<open>r\<close> in partitions.\<close>
lemma part_Suc_imp_part:
"\<lbrakk>infinite Y; part (Suc r) s Y f; y \<in> Y\<rbrakk> \<Longrightarrow> part r s (Y - {y}) (\<lambda>u. f (insert y u))"
apply (simp add: part_def)
--- a/src/HOL/Library/Sum_of_Squares/sos_wrapper.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Sum_of_Squares/sos_wrapper.ML Fri Jan 04 23:22:53 2019 +0100
@@ -71,7 +71,7 @@
(Sum_of_Squares.Certificate (Positivstellensatz_Tools.read_cert ctxt cert)) ctxt
val _ = Theory.setup
- (Method.setup @{binding sos}
+ (Method.setup \<^binding>\<open>sos\<close>
(Scan.lift (Scan.option Parse.string)
>> (fn arg => fn ctxt => SIMPLE_METHOD' (sos_tac ctxt arg)))
"prove universal problems over the reals using sums of squares")
--- a/src/HOL/Library/Tree.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Tree.thy Fri Jan 04 23:22:53 2019 +0100
@@ -100,7 +100,7 @@
(heap l \<and> heap r \<and> (\<forall>x \<in> set_tree l \<union> set_tree r. m \<le> x))"
-subsection \<open>@{const map_tree}\<close>
+subsection \<open>\<^const>\<open>map_tree\<close>\<close>
lemma eq_map_tree_Leaf[simp]: "map_tree f t = Leaf \<longleftrightarrow> t = Leaf"
by (rule tree.map_disc_iff)
@@ -109,7 +109,7 @@
by (cases t) auto
-subsection \<open>@{const size}\<close>
+subsection \<open>\<^const>\<open>size\<close>\<close>
lemma size1_size: "size1 t = size t + 1"
by (induction t) simp_all
@@ -133,7 +133,7 @@
by (simp add: size1_size)
-subsection \<open>@{const set_tree}\<close>
+subsection \<open>\<^const>\<open>set_tree\<close>\<close>
lemma eq_set_tree_empty[simp]: "set_tree t = {} \<longleftrightarrow> t = Leaf"
by (cases t) auto
@@ -145,7 +145,7 @@
by(induction t) auto
-subsection \<open>@{const subtrees}\<close>
+subsection \<open>\<^const>\<open>subtrees\<close>\<close>
lemma neq_subtrees_empty[simp]: "subtrees t \<noteq> {}"
by (cases t)(auto)
@@ -163,7 +163,7 @@
by (metis Node_notin_subtrees_if)
-subsection \<open>@{const height} and @{const min_height}\<close>
+subsection \<open>\<^const>\<open>height\<close> and \<^const>\<open>min_height\<close>\<close>
lemma eq_height_0[simp]: "height t = 0 \<longleftrightarrow> t = Leaf"
by(cases t) auto
@@ -221,7 +221,7 @@
qed simp
-subsection \<open>@{const complete}\<close>
+subsection \<open>\<^const>\<open>complete\<close>\<close>
lemma complete_iff_height: "complete t \<longleftrightarrow> (min_height t = height t)"
apply(induction t)
@@ -287,7 +287,7 @@
using complete_if_size1_height size1_if_complete by blast
-subsection \<open>@{const balanced}\<close>
+subsection \<open>\<^const>\<open>balanced\<close>\<close>
lemma balanced_subtreeL: "balanced (Node l x r) \<Longrightarrow> balanced l"
by(simp add: balanced_def)
@@ -335,13 +335,13 @@
qed
-subsection \<open>@{const wbalanced}\<close>
+subsection \<open>\<^const>\<open>wbalanced\<close>\<close>
lemma wbalanced_subtrees: "\<lbrakk> wbalanced t; s \<in> subtrees t \<rbrakk> \<Longrightarrow> wbalanced s"
using [[simp_depth_limit=1]] by(induction t arbitrary: s) auto
-subsection \<open>@{const ipl}\<close>
+subsection \<open>\<^const>\<open>ipl\<close>\<close>
text \<open>The internal path length of a tree:\<close>
@@ -413,10 +413,10 @@
done
-subsection \<open>@{const heap}\<close>
+subsection \<open>\<^const>\<open>heap\<close>\<close>
-subsection \<open>@{const mirror}\<close>
+subsection \<open>\<^const>\<open>mirror\<close>\<close>
lemma mirror_Leaf[simp]: "mirror t = \<langle>\<rangle> \<longleftrightarrow> t = \<langle>\<rangle>"
by (induction t) simp_all
--- a/src/HOL/Library/Tree_Multiset.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Tree_Multiset.thy Fri Jan 04 23:22:53 2019 +0100
@@ -7,9 +7,7 @@
begin
text \<open>
- Kept separate from theory @{theory "HOL-Library.Tree"} to avoid importing all of theory @{theory
- "HOL-Library.Multiset"} into @{theory "HOL-Library.Tree"}. Should be merged if @{theory
- "HOL-Library.Multiset"} ever becomes part of @{theory Main}.
+ Kept separate from theory \<^theory>\<open>HOL-Library.Tree\<close> to avoid importing all of theory \<^theory>\<open>HOL-Library.Multiset\<close> into \<^theory>\<open>HOL-Library.Tree\<close>. Should be merged if \<^theory>\<open>HOL-Library.Multiset\<close> ever becomes part of \<^theory>\<open>Main\<close>.
\<close>
fun mset_tree :: "'a tree \<Rightarrow> 'a multiset" where
--- a/src/HOL/Library/Tree_Real.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Tree_Real.thy Fri Jan 04 23:22:53 2019 +0100
@@ -7,8 +7,8 @@
begin
text \<open>
- This theory is separate from @{theory "HOL-Library.Tree"} because the former is discrete and
- builds on @{theory Main} whereas this theory builds on @{theory Complex_Main}.
+ This theory is separate from \<^theory>\<open>HOL-Library.Tree\<close> because the former is discrete and
+ builds on \<^theory>\<open>Main\<close> whereas this theory builds on \<^theory>\<open>Complex_Main\<close>.
\<close>
--- a/src/HOL/Library/Type_Length.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/Type_Length.thy Fri Jan 04 23:22:53 2019 +0100
@@ -24,9 +24,9 @@
print_translation \<open>
let
- fun len_of_itself_tr' ctxt [Const (@{const_syntax Pure.type}, Type (_, [T]))] =
- Syntax.const @{syntax_const "_type_length"} $ Syntax_Phases.term_of_typ ctxt T
- in [(@{const_syntax len_of}, len_of_itself_tr')] end
+ fun len_of_itself_tr' ctxt [Const (\<^const_syntax>\<open>Pure.type\<close>, Type (_, [T]))] =
+ Syntax.const \<^syntax_const>\<open>_type_length\<close> $ Syntax_Phases.term_of_typ ctxt T
+ in [(\<^const_syntax>\<open>len_of\<close>, len_of_itself_tr')] end
\<close>
text \<open>Some theorems are only true on words with length greater 0.\<close>
--- a/src/HOL/Library/While_Combinator.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/While_Combinator.thy Fri Jan 04 23:22:53 2019 +0100
@@ -209,7 +209,7 @@
text \<open>
- The proof rule for @{term while}, where @{term P} is the invariant.
+ The proof rule for \<^term>\<open>while\<close>, where \<^term>\<open>P\<close> is the invariant.
\<close>
theorem while_rule_lemma:
--- a/src/HOL/Library/adhoc_overloading.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/adhoc_overloading.ML Fri Jan 04 23:22:53 2019 +0100
@@ -19,7 +19,7 @@
structure Adhoc_Overloading: ADHOC_OVERLOADING =
struct
-val show_variants = Attrib.setup_config_bool @{binding show_variants} (K false);
+val show_variants = Attrib.setup_config_bool \<^binding>\<open>show_variants\<close> (K false);
(* errors *)
@@ -233,12 +233,12 @@
end;
val _ =
- Outer_Syntax.local_theory @{command_keyword adhoc_overloading}
+ Outer_Syntax.local_theory \<^command_keyword>\<open>adhoc_overloading\<close>
"add adhoc overloading for constants / fixed variables"
(Parse.and_list1 (Parse.const -- Scan.repeat Parse.term) >> adhoc_overloading_cmd true);
val _ =
- Outer_Syntax.local_theory @{command_keyword no_adhoc_overloading}
+ Outer_Syntax.local_theory \<^command_keyword>\<open>no_adhoc_overloading\<close>
"delete adhoc overloading for constants / fixed variables"
(Parse.and_list1 (Parse.const -- Scan.repeat Parse.term) >> adhoc_overloading_cmd false);
--- a/src/HOL/Library/case_converter.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/case_converter.ML Fri Jan 04 23:22:53 2019 +0100
@@ -21,7 +21,7 @@
fun mk_abort msg t =
let
val T = fastype_of t
- val abort = Const (@{const_name missing_pattern_match}, HOLogic.literalT --> (HOLogic.unitT --> T) --> T)
+ val abort = Const (\<^const_name>\<open>missing_pattern_match\<close>, HOLogic.literalT --> (HOLogic.unitT --> T) --> T)
in
abort $ HOLogic.mk_literal msg $ absdummy HOLogic.unitT t
end
--- a/src/HOL/Library/cconv.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/cconv.ML Fri Jan 04 23:22:53 2019 +0100
@@ -49,8 +49,8 @@
val combination_thm =
let
- val fg = @{cprop "f :: 'a :: {} \<Rightarrow> 'b :: {} \<equiv> g"}
- val st = @{cprop "s :: 'a :: {} \<equiv> t"}
+ val fg = \<^cprop>\<open>f :: 'a :: {} \<Rightarrow> 'b :: {} \<equiv> g\<close>
+ val st = \<^cprop>\<open>s :: 'a :: {} \<equiv> t\<close>
val thm = Thm.combination (Thm.assume fg) (Thm.assume st)
|> Thm.implies_intr st
|> Thm.implies_intr fg
@@ -58,8 +58,8 @@
fun abstract_rule_thm n =
let
- val eq = @{cprop "\<And>x :: 'a :: {}. (s :: 'a \<Rightarrow> 'b :: {}) x \<equiv> t x"}
- val x = @{cterm "x :: 'a :: {}"}
+ val eq = \<^cprop>\<open>\<And>x :: 'a :: {}. (s :: 'a \<Rightarrow> 'b :: {}) x \<equiv> t x\<close>
+ val x = \<^cterm>\<open>x :: 'a :: {}\<close>
val thm = eq
|> Thm.assume
|> Thm.forall_elim x
@@ -178,7 +178,7 @@
fun prems_cconv 0 cv ct = cv ct
| prems_cconv n cv ct =
(case ct |> Thm.term_of of
- (Const (@{const_name "Pure.imp"}, _) $ _) $ _ =>
+ (Const (\<^const_name>\<open>Pure.imp\<close>, _) $ _) $ _ =>
((if n = 1 then fun_cconv else I) o arg_cconv) (prems_cconv (n-1) cv) ct
| _ => cv ct)
--- a/src/HOL/Library/code_lazy.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/code_lazy.ML Fri Jan 04 23:22:53 2019 +0100
@@ -84,10 +84,10 @@
let
val (name, _) = mk_name "lazy_" "" short_type_name lthy
val freeT = HOLogic.unitT --> lazyT
- val lazyT' = Type (@{type_name lazy}, [lazyT])
+ val lazyT' = Type (\<^type_name>\<open>lazy\<close>, [lazyT])
val def = Logic.all_const freeT $ absdummy freeT (Logic.mk_equals (
Free (name, (freeT --> eagerT)) $ Bound 0,
- lazy_ctr $ (Const (@{const_name delay}, (freeT --> lazyT')) $ Bound 0)))
+ lazy_ctr $ (Const (\<^const_name>\<open>delay\<close>, (freeT --> lazyT')) $ Bound 0)))
val (_, lthy') = Local_Theory.open_target lthy
val ((t, (_, thm)), lthy') = Specification.definition NONE [] []
((Thm.def_binding (Binding.name name), []), def) lthy'
@@ -235,7 +235,7 @@
val (result, lthy1) = (Typedef.add_typedef
{ overloaded=false }
(binding, rev (Term.add_tfreesT eager_type []), Mixfix.NoSyn)
- (Const (@{const_name "top"}, Type (@{type_name set}, [eager_type])))
+ (Const (\<^const_name>\<open>top\<close>, Type (\<^type_name>\<open>set\<close>, [eager_type])))
NONE
(fn ctxt => resolve_tac ctxt [@{thm UNIV_witness}] 1)
o (Local_Theory.open_target #> snd)) lthy
@@ -270,9 +270,9 @@
ctrs
fun to_destr_eagerT typ = case typ of
- Type (@{type_name "fun"}, [_, Type (@{type_name "fun"}, Ts)]) =>
- to_destr_eagerT (Type (@{type_name "fun"}, Ts))
- | Type (@{type_name "fun"}, [T, _]) => T
+ Type (\<^type_name>\<open>fun\<close>, [_, Type (\<^type_name>\<open>fun\<close>, Ts)]) =>
+ to_destr_eagerT (Type (\<^type_name>\<open>fun\<close>, Ts))
+ | Type (\<^type_name>\<open>fun\<close>, [T, _]) => T
| _ => raise Match
val (case', lthy4) =
let
@@ -299,7 +299,7 @@
({binding = binding, const = Const (Local_Theory.full_name lthy2 binding, T), thm = def_thm}, lthy2)
end;
- val lazy_datatype = Type (@{type_name lazy}, [lazy_type])
+ val lazy_datatype = Type (\<^type_name>\<open>lazy\<close>, [lazy_type])
val Lazy_type = lazy_datatype --> eagerT
val unstr_type = eagerT --> lazy_datatype
@@ -307,8 +307,8 @@
if n > i then apply_bounds i (n-1) (term $ Bound (n-1))
else term
fun all_abs Ts t = Logic.list_all (map (pair Name.uu) Ts, t)
- fun mk_force t = Const (@{const_name force}, lazy_datatype --> lazy_type) $ t
- fun mk_delay t = Const (@{const_name delay}, (@{typ unit} --> lazy_type) --> lazy_datatype) $ t
+ fun mk_force t = Const (\<^const_name>\<open>force\<close>, lazy_datatype --> lazy_type) $ t
+ fun mk_delay t = Const (\<^const_name>\<open>delay\<close>, (\<^typ>\<open>unit\<close> --> lazy_type) --> lazy_datatype) $ t
val lazy_ctr = all_abs [lazy_datatype]
(Logic.mk_equals (Free (lazy_ctr_name, Lazy_type) $ Bound 0, Rep_lazy $ mk_force (Bound 0)))
@@ -316,13 +316,13 @@
val lazy_sel = all_abs [eagerT]
(Logic.mk_equals (Free (lazy_sel_name, unstr_type) $ Bound 0,
- mk_delay (Abs (Name.uu, @{typ unit}, Abs_lazy $ Bound 1))))
+ mk_delay (Abs (Name.uu, \<^typ>\<open>unit\<close>, Abs_lazy $ Bound 1))))
val (lazy_sel_def, lthy6) = mk_def (lazy_sel_name, unstr_type, lazy_sel) lthy5
fun mk_lazy_ctr (name, eager_ctr) =
let
val (_, ctrT) = dest_Const eager_ctr
- fun to_lazy_ctrT (Type (@{type_name fun}, [T1, T2])) = T1 --> to_lazy_ctrT T2
+ fun to_lazy_ctrT (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) = T1 --> to_lazy_ctrT T2
| to_lazy_ctrT T = if T = eagerT then lazy_type else raise Match
val lazy_ctrT = to_lazy_ctrT ctrT
val argsT = binder_types ctrT
@@ -336,7 +336,7 @@
val (lazy_case_def, lthy8) =
let
val (_, caseT) = dest_Const case'
- fun to_lazy_caseT (Type (@{type_name fun}, [T1, T2])) =
+ fun to_lazy_caseT (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
if T1 = eagerT then lazy_type --> T2 else T1 --> to_lazy_caseT T2
val lazy_caseT = to_lazy_caseT caseT
val argsT = binder_types lazy_caseT
@@ -379,7 +379,7 @@
val mk_Lazy_delay_eq =
(#const lazy_ctr_def $ mk_delay (Bound 0), Rep_lazy $ (Bound 0 $ @{const Unity}))
- |> mk_eq |> all_abs [@{typ unit} --> lazy_type]
+ |> mk_eq |> all_abs [\<^typ>\<open>unit\<close> --> lazy_type]
val (Lazy_delay_thm, lthy8a) = mk_thm
((Lazy_delay_eq_name, mk_Lazy_delay_eq), [#thm lazy_ctr_def, @{thm force_delay}])
lthy8
@@ -406,7 +406,7 @@
val n = length argsT
val lhs = apply_bounds 0 n eager_ctr
val rhs = #const lazy_ctr_def $
- (mk_delay (Abs (Name.uu, @{typ unit}, apply_bounds 1 (n + 1) lazy_ctr)))
+ (mk_delay (Abs (Name.uu, \<^typ>\<open>unit\<close>, apply_bounds 1 (n + 1) lazy_ctr)))
in
(lhs, rhs) |> mk_eq |> all_abs argsT
end
@@ -493,7 +493,7 @@
val delay_dummy_thm = (pat_def_thm RS @{thm symmetric})
|> Drule.infer_instantiate' lthy10
- [SOME (Thm.cterm_of lthy10 (Const (@{const_name "Pure.dummy_pattern"}, HOLogic.unitT --> lazy_type)))]
+ [SOME (Thm.cterm_of lthy10 (Const (\<^const_name>\<open>Pure.dummy_pattern\<close>, HOLogic.unitT --> lazy_type)))]
|> Thm.generalize (map (fst o dest_TFree) type_args, []) (Variable.maxidx_of lthy10 + 1);
val ctr_post = delay_dummy_thm :: map (fn thm => thm RS @{thm sym}) ctrs_lazy_thms
@@ -552,7 +552,7 @@
val ((code_eqs, nbe_eqs), pure) =
((case hd eqs |> fst |> Thm.prop_of of
- Const (@{const_name Pure.eq}, _) $ _ $ _ =>
+ Const (\<^const_name>\<open>Pure.eq\<close>, _) $ _ $ _ =>
(map (apfst (fn x => x RS @{thm meta_eq_to_obj_eq})) eqs, true)
| _ => (eqs, false))
|> apfst (List.partition snd))
@@ -600,7 +600,7 @@
Syntax.pretty_term ctxt (#destr info),
Pretty.str ":",
Pretty.brk 1,
- Syntax.pretty_typ ctxt (Type (@{type_name lazy}, [#lazyT info])),
+ Syntax.pretty_typ ctxt (Type (\<^type_name>\<open>lazy\<close>, [#lazyT info])),
Pretty.str ")"
]
],
@@ -633,27 +633,27 @@
val _ =
- Outer_Syntax.command @{command_keyword code_lazy_type}
+ Outer_Syntax.command \<^command_keyword>\<open>code_lazy_type\<close>
"make a lazy copy of the datatype and activate substitution"
(Parse.binding >> (fn b => Toplevel.theory (Binding.name_of b |> code_lazy_type)));
val _ =
- Outer_Syntax.command @{command_keyword activate_lazy_type}
+ Outer_Syntax.command \<^command_keyword>\<open>activate_lazy_type\<close>
"activate substitution on a specific (lazy) type"
(Parse.binding >> (fn b => Toplevel.theory (Binding.name_of b |> activate_lazy_type)));
val _ =
- Outer_Syntax.command @{command_keyword deactivate_lazy_type}
+ Outer_Syntax.command \<^command_keyword>\<open>deactivate_lazy_type\<close>
"deactivate substitution on a specific (lazy) type"
(Parse.binding >> (fn b => Toplevel.theory (Binding.name_of b |> deactivate_lazy_type)));
val _ =
- Outer_Syntax.command @{command_keyword activate_lazy_types}
+ Outer_Syntax.command \<^command_keyword>\<open>activate_lazy_types\<close>
"activate substitution on all (lazy) types"
(pair (Toplevel.theory activate_lazy_types));
val _ =
- Outer_Syntax.command @{command_keyword deactivate_lazy_types}
+ Outer_Syntax.command \<^command_keyword>\<open>deactivate_lazy_types\<close>
"deactivate substitution on all (lazy) type"
(pair (Toplevel.theory deactivate_lazy_types));
val _ =
- Outer_Syntax.command @{command_keyword print_lazy_types}
+ Outer_Syntax.command \<^command_keyword>\<open>print_lazy_types\<close>
"print the types that have been declared as lazy and their substitution state"
(pair (Toplevel.theory (tap print_lazy_types)));
--- a/src/HOL/Library/code_test.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/code_test.ML Fri Jan 04 23:22:53 2019 +0100
@@ -41,11 +41,11 @@
(* convert a list of terms into nested tuples and back *)
-fun mk_tuples [] = @{term "()"}
+fun mk_tuples [] = \<^term>\<open>()\<close>
| mk_tuples [t] = t
| mk_tuples (t :: ts) = HOLogic.mk_prod (t, mk_tuples ts)
-fun dest_tuples (Const (@{const_name Pair}, _) $ l $ r) = l :: dest_tuples r
+fun dest_tuples (Const (\<^const_name>\<open>Pair\<close>, _) $ l $ r) = l :: dest_tuples r
| dest_tuples t = [t]
@@ -146,7 +146,7 @@
(* driver invocation *)
-val overlord = Attrib.setup_config_bool @{binding "code_test_overlord"} (K false)
+val overlord = Attrib.setup_config_bool \<^binding>\<open>code_test_overlord\<close> (K false)
fun with_overlord_dir name f =
let
@@ -174,40 +174,40 @@
(* term preprocessing *)
-fun add_eval (Const (@{const_name Trueprop}, _) $ t) = add_eval t
- | add_eval (Const (@{const_name "HOL.eq"}, _) $ lhs $ rhs) = (fn acc =>
+fun add_eval (Const (\<^const_name>\<open>Trueprop\<close>, _) $ t) = add_eval t
+ | add_eval (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ lhs $ rhs) = (fn acc =>
acc
|> add_eval rhs
|> add_eval lhs
|> cons rhs
|> cons lhs)
- | add_eval (Const (@{const_name "Not"}, _) $ t) = add_eval t
- | add_eval (Const (@{const_name "Orderings.ord_class.less_eq"}, _) $ lhs $ rhs) = (fn acc =>
+ | add_eval (Const (\<^const_name>\<open>Not\<close>, _) $ t) = add_eval t
+ | add_eval (Const (\<^const_name>\<open>Orderings.ord_class.less_eq\<close>, _) $ lhs $ rhs) = (fn acc =>
lhs :: rhs :: acc)
- | add_eval (Const (@{const_name "Orderings.ord_class.less"}, _) $ lhs $ rhs) = (fn acc =>
+ | add_eval (Const (\<^const_name>\<open>Orderings.ord_class.less\<close>, _) $ lhs $ rhs) = (fn acc =>
lhs :: rhs :: acc)
| add_eval _ = I
-fun mk_term_of [] = @{term "None :: (unit \<Rightarrow> yxml_of_term) option"}
+fun mk_term_of [] = \<^term>\<open>None :: (unit \<Rightarrow> yxml_of_term) option\<close>
| mk_term_of ts =
let
val tuple = mk_tuples ts
val T = fastype_of tuple
in
- @{term "Some :: (unit \<Rightarrow> yxml_of_term) \<Rightarrow> (unit \<Rightarrow> yxml_of_term) option"} $
- (absdummy @{typ unit} (@{const yxml_string_of_term} $
- (Const (@{const_name Code_Evaluation.term_of}, T --> @{typ term}) $ tuple)))
+ \<^term>\<open>Some :: (unit \<Rightarrow> yxml_of_term) \<Rightarrow> (unit \<Rightarrow> yxml_of_term) option\<close> $
+ (absdummy \<^typ>\<open>unit\<close> (@{const yxml_string_of_term} $
+ (Const (\<^const_name>\<open>Code_Evaluation.term_of\<close>, T --> \<^typ>\<open>term\<close>) $ tuple)))
end
fun test_terms ctxt ts target =
let
val thy = Proof_Context.theory_of ctxt
- fun term_of t = Sign.of_sort thy (fastype_of t, @{sort term_of})
+ fun term_of t = Sign.of_sort thy (fastype_of t, \<^sort>\<open>term_of\<close>)
fun ensure_bool t =
(case fastype_of t of
- @{typ bool} => ()
+ \<^typ>\<open>bool\<close> => ()
| _ =>
error (Pretty.string_of
(Pretty.block [Pretty.str "Test case not of type bool:", Pretty.brk 1,
@@ -219,7 +219,7 @@
val eval = map mk_term_of evals
val t =
- HOLogic.mk_list @{typ "bool \<times> (unit \<Rightarrow> yxml_of_term) option"}
+ HOLogic.mk_list \<^typ>\<open>bool \<times> (unit \<Rightarrow> yxml_of_term) option\<close>
(map HOLogic.mk_prod (ts ~~ eval))
val result = dynamic_value_strict ctxt t target
@@ -261,13 +261,13 @@
val T = fastype_of t
val _ =
- if Sign.of_sort (Proof_Context.theory_of ctxt) (T, @{sort term_of}) then ()
+ if Sign.of_sort (Proof_Context.theory_of ctxt) (T, \<^sort>\<open>term_of\<close>) then ()
else error ("Type " ^ Syntax.string_of_typ ctxt T ^
- " of term not of sort " ^ Syntax.string_of_sort ctxt @{sort term_of})
+ " of term not of sort " ^ Syntax.string_of_sort ctxt \<^sort>\<open>term_of\<close>)
val t' =
- HOLogic.mk_list @{typ "bool \<times> (unit \<Rightarrow> yxml_of_term) option"}
- [HOLogic.mk_prod (@{term "False"}, mk_term_of [t])]
+ HOLogic.mk_list \<^typ>\<open>bool \<times> (unit \<Rightarrow> yxml_of_term) option\<close>
+ [HOLogic.mk_prod (\<^term>\<open>False\<close>, mk_term_of [t])]
val result = dynamic_value_strict ctxt t' target
in (case result of [(_, SOME [t])] => t | _ => error "Evaluation failed") end
@@ -484,7 +484,7 @@
val ghcN = "GHC"
val ISABELLE_GHC = "ISABELLE_GHC"
-val ghc_options = Attrib.setup_config_string @{binding code_test_ghc} (K "")
+val ghc_options = Attrib.setup_config_string \<^binding>\<open>code_test_ghc\<close> (K "")
fun mk_driver_ghc ctxt path modules value_name =
let
@@ -573,9 +573,9 @@
(* command setup *)
val _ =
- Outer_Syntax.command @{command_keyword test_code}
+ Outer_Syntax.command \<^command_keyword>\<open>test_code\<close>
"compile test cases to target languages, execute them and report results"
- (Scan.repeat1 Parse.prop -- (@{keyword "in"} |-- Scan.repeat1 Parse.name)
+ (Scan.repeat1 Parse.prop -- (\<^keyword>\<open>in\<close> |-- Scan.repeat1 Parse.name)
>> (fn (ts, targets) => Toplevel.keep (test_code_cmd ts targets o Toplevel.context_of)))
val target_Scala = "Scala_eval"
--- a/src/HOL/Library/conditional_parametricity.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/conditional_parametricity.ML Fri Jan 04 23:22:53 2019 +0100
@@ -125,7 +125,7 @@
let
fun is_correct_rule t =
(case t of
- Const (@{const_name "HOL.Trueprop"}, _) $ (Const (@{const_name "Transfer.Rel"}, _) $
+ Const (\<^const_name>\<open>HOL.Trueprop\<close>, _) $ (Const (\<^const_name>\<open>Transfer.Rel\<close>, _) $
_ $ Bound x' $ Bound y') => x = x' andalso y = y'
| _ => false);
val idx = find_index is_correct_rule (t |> Logic.strip_assums_hyp);
@@ -186,12 +186,12 @@
fun step_tac' settings ctxt parametricity_thms (tm, i) =
(case tm |> Logic.strip_assums_concl of
- Const (@{const_name "HOL.Trueprop"}, _) $ (Const (rel, _) $ _ $ t $ u) =>
+ Const (\<^const_name>\<open>HOL.Trueprop\<close>, _) $ (Const (rel, _) $ _ $ t $ u) =>
let
val (arity_of_t, arity_of_u) = apply2 (strip_comb #> snd #> length) (t, u);
in
(case rel of
- @{const_name "Transfer.Rel"} =>
+ \<^const_name>\<open>Transfer.Rel\<close> =>
(case (head_of t, head_of u) of
(Abs _, _) => rel_abs_tac ctxt
| (_, Abs _) => rel_abs_tac ctxt
@@ -210,11 +210,11 @@
else error_tac' ctxt "Malformed term. Arities of t and u don't match."
| _ => error_tac' ctxt
"Unexpected format. Expected (Abs _, _), (_, Abs _), (Const _, Const _) or (Bound _, Bound _).")
- | @{const_name "Conditional_Parametricity.Rel_match"} =>
+ | \<^const_name>\<open>Conditional_Parametricity.Rel_match\<close> =>
parametricity_thm_match_tac ctxt parametricity_thms arity_of_t
| _ => error_tac' ctxt "Unexpected format. Expected Transfer.Rel or Rel_match marker." ) i
end
- | Const (@{const_name "HOL.Trueprop"}, _) $ (Const (@{const_name "Transfer.is_equality"}, _) $ _) =>
+ | Const (\<^const_name>\<open>HOL.Trueprop\<close>, _) $ (Const (\<^const_name>\<open>Transfer.is_equality\<close>, _) $ _) =>
Transfer.eq_tac ctxt i
| _ => error_tac' ctxt "Unexpected format. Not of form Const (HOL.Trueprop, _) $ _" i);
@@ -227,8 +227,8 @@
(* Goal Generation *)
fun strip_boundvars_from_rel_match t =
(case t of
- (Tp as Const (@{const_name "HOL.Trueprop"}, _)) $
- ((Rm as Const (@{const_name "Conditional_Parametricity.Rel_match"}, _)) $ R $ t $ t') =>
+ (Tp as Const (\<^const_name>\<open>HOL.Trueprop\<close>, _)) $
+ ((Rm as Const (\<^const_name>\<open>Conditional_Parametricity.Rel_match\<close>, _)) $ R $ t $ t') =>
Tp $ (Rm $ apply_Var_to_bounds R $ t $ t')
| _ => t);
@@ -251,9 +251,9 @@
val u = subst_atomic_types ((map TVar tvars) ~~ new_frees) t;
val T = fastype_of t;
val U = fastype_of u;
- val R = [T,U] ---> @{typ bool}
+ val R = [T,U] ---> \<^typ>\<open>bool\<close>
val r = Var (("R", 2 * i), R);
- val transfer_rel = Const (@{const_name "Transfer.Rel"}, [R,T,U] ---> @{typ bool});
+ val transfer_rel = Const (\<^const_name>\<open>Transfer.Rel\<close>, [R,T,U] ---> \<^typ>\<open>bool\<close>);
in HOLogic.mk_Trueprop (transfer_rel $ r $ t $ u) end;
fun mk_abs_helper T t =
@@ -294,14 +294,14 @@
let
val t =
(case Thm.full_prop_of thm of
- (Const (@{const_name "Pure.eq"}, _) $ t' $ _) => t'
+ (Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t' $ _) => t'
| _ => theorem_format_error ctxt thm);
in mk_goal ctxt t end;
(* Transformations and parametricity theorems *)
fun transform_class_rule ctxt thm =
(case Thm.concl_of thm of
- Const (@{const_name "HOL.Trueprop"}, _) $ (Const (@{const_name "Transfer.Rel"}, _) $ _ $ t $ u ) =>
+ Const (\<^const_name>\<open>HOL.Trueprop\<close>, _) $ (Const (\<^const_name>\<open>Transfer.Rel\<close>, _) $ _ $ t $ u ) =>
(if curry Term.aconv_untyped t u andalso is_class_op ctxt t then
thm RS @{thm Rel_Rel_match}
else thm)
@@ -309,23 +309,23 @@
fun is_parametricity_theorem thm =
(case Thm.concl_of thm of
- Const (@{const_name "HOL.Trueprop"}, _) $ (Const (rel, _) $ _ $ t $ u ) =>
- if rel = @{const_name "Transfer.Rel"} orelse
- rel = @{const_name "Conditional_Parametricity.Rel_match"}
+ Const (\<^const_name>\<open>HOL.Trueprop\<close>, _) $ (Const (rel, _) $ _ $ t $ u ) =>
+ if rel = \<^const_name>\<open>Transfer.Rel\<close> orelse
+ rel = \<^const_name>\<open>Conditional_Parametricity.Rel_match\<close>
then curry Term.aconv_untyped t u
else false
| _ => false);
(* Pre- and postprocessing of theorems *)
fun mk_Domainp_assm (T, R) =
- HOLogic.mk_eq ((Const (@{const_name Domainp}, Term.fastype_of T --> Term.fastype_of R) $ T), R);
+ HOLogic.mk_eq ((Const (\<^const_name>\<open>Domainp\<close>, Term.fastype_of T --> Term.fastype_of R) $ T), R);
val Domainp_lemma =
@{lemma "(!!R. Domainp T = R ==> PROP (P R)) == PROP (P (Domainp T))"
by (rule, drule meta_spec,
erule meta_mp, rule HOL.refl, simp)};
-fun fold_Domainp f (t as Const (@{const_name Domainp},_) $ (Var (_,_))) = f t
+fun fold_Domainp f (t as Const (\<^const_name>\<open>Domainp\<close>,_) $ (Var (_,_))) = f t
| fold_Domainp f (t $ u) = fold_Domainp f t #> fold_Domainp f u
| fold_Domainp f (Abs (_, _, t)) = fold_Domainp f t
| fold_Domainp _ _ = I;
@@ -387,7 +387,7 @@
fun fold_relator_eqs_conv ctxt ct = (Transfer.bottom_rewr_conv (Transfer.get_relator_eq ctxt)) ct;
fun mk_is_equality t =
- Const (@{const_name is_equality}, Term.fastype_of t --> HOLogic.boolT) $ t;
+ Const (\<^const_name>\<open>is_equality\<close>, Term.fastype_of t --> HOLogic.boolT) $ t;
val is_equality_lemma =
@{lemma "(!!R. is_equality R ==> PROP (P R)) == PROP (P (=))"
@@ -399,7 +399,7 @@
val prop = Thm.prop_of thm
val (t, mk_prop') = dest prop
(* Only consider "(=)" at non-base types *)
- fun is_eq (Const (@{const_name HOL.eq}, Type ("fun", [T, _]))) =
+ fun is_eq (Const (\<^const_name>\<open>HOL.eq\<close>, Type ("fun", [T, _]))) =
(case T of Type (_, []) => false | _ => true)
| is_eq _ = false
val add_eqs = Term.fold_aterms (fn t => if is_eq t then insert (op =) t else I)
@@ -440,7 +440,7 @@
fun prep_rule ctxt = abstract_equalities_transfer ctxt #> abstract_domains_transfer ctxt;
fun get_preprocess_theorems ctxt =
- Named_Theorems.get ctxt @{named_theorems parametricity_preprocess};
+ Named_Theorems.get ctxt \<^named_theorems>\<open>parametricity_preprocess\<close>;
fun preprocess_theorem ctxt =
Local_Defs.unfold0 ctxt (get_preprocess_theorems ctxt)
@@ -513,7 +513,7 @@
(singleton o Attrib.eval_thms);
val _ =
- Outer_Syntax.local_theory @{command_keyword parametric_constant} "proves parametricity"
+ Outer_Syntax.local_theory \<^command_keyword>\<open>parametric_constant\<close> "proves parametricity"
((Parse_Spec.opt_thm_name ":" -- Parse.thm) >> parametric_constant_cmd);
end;
--- a/src/HOL/Library/datatype_records.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/datatype_records.ML Fri Jan 04 23:22:53 2019 +0100
@@ -36,7 +36,7 @@
)
fun mk_eq_dummy (lhs, rhs) =
- Const (@{const_name HOL.eq}, dummyT --> dummyT --> @{typ bool}) $ lhs $ rhs
+ Const (\<^const_name>\<open>HOL.eq\<close>, dummyT --> dummyT --> \<^typ>\<open>bool\<close>) $ lhs $ rhs
val dummify = map_types (K dummyT)
fun repeat_split_tac ctxt thm = REPEAT_ALL_NEW (CHANGED o Splitter.split_tac ctxt [thm])
@@ -278,7 +278,7 @@
NONE => raise Fail ("not a valid record field: " ^ name)
| SOME s => Const (s, dummyT) $ Abs (Name.uu_, dummyT, arg)
end
- | field_update_tr _ t = raise TERM ("field_update_tr", [@{print} t]);
+ | field_update_tr _ t = raise TERM ("field_update_tr", [\<^print> t]);
fun field_updates_tr ctxt (Const (\<^syntax_const>\<open>_datatype_field_updates\<close>, _) $ t $ u) =
field_update_tr ctxt t :: field_updates_tr ctxt u
@@ -291,7 +291,7 @@
| record_update_tr _ ts = raise TERM ("record_update_tr", ts);
val parse_ctr_options =
- Scan.optional (@{keyword "("} |-- Parse.list1 (Plugin_Name.parse_filter >> K) --| @{keyword ")"} >>
+ Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.list1 (Plugin_Name.parse_filter >> K) --| \<^keyword>\<open>)\<close> >>
(fn fs => fold I fs default_ctr_options_cmd)) default_ctr_options_cmd
val parser =
@@ -300,7 +300,7 @@
val _ =
Outer_Syntax.local_theory
- @{command_keyword datatype_record}
+ \<^command_keyword>\<open>datatype_record\<close>
"Defines a record based on the BNF/datatype machinery"
(parser >> (fn (((ctr_options, tyargs), binding), args) =>
record_cmd binding ctr_options tyargs args))
--- a/src/HOL/Library/multiset_simprocs.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/multiset_simprocs.ML Fri Jan 04 23:22:53 2019 +0100
@@ -16,16 +16,16 @@
structure Subset_Cancel_Multiset = Cancel_Fun
(open Cancel_Data
- val mk_bal = HOLogic.mk_binrel @{const_name subset_mset}
- val dest_bal = HOLogic.dest_bin @{const_name subset_mset} dummyT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>subset_mset\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>subset_mset\<close> dummyT
val bal_add1 = @{thm mset_subset_add_iff1[unfolded repeat_mset_iterate_add]} RS trans
val bal_add2 = @{thm mset_subset_add_iff2[unfolded repeat_mset_iterate_add]} RS trans
);
structure Subseteq_Cancel_Multiset = Cancel_Fun
(open Cancel_Data
- val mk_bal = HOLogic.mk_binrel @{const_name subseteq_mset}
- val dest_bal = HOLogic.dest_bin @{const_name subseteq_mset} dummyT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>subseteq_mset\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>subseteq_mset\<close> dummyT
val bal_add1 = @{thm mset_subseteq_add_iff1[unfolded repeat_mset_iterate_add]} RS trans
val bal_add2 = @{thm mset_subseteq_add_iff2[unfolded repeat_mset_iterate_add]} RS trans
);
--- a/src/HOL/Library/old_recdef.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/old_recdef.ML Fri Jan 04 23:22:53 2019 +0100
@@ -460,7 +460,7 @@
*
*---------------------------------------------------------------------------*)
val mk_prim_vartype = TVar;
-fun mk_vartype s = mk_prim_vartype ((s, 0), @{sort type});
+fun mk_vartype s = mk_prim_vartype ((s, 0), \<^sort>\<open>type\<close>);
(* But internally, it's useful *)
fun dest_vtype (TVar x) = x
@@ -514,36 +514,36 @@
fun mk_imp{ant,conseq} =
- let val c = Const(@{const_name HOL.implies},HOLogic.boolT --> HOLogic.boolT --> HOLogic.boolT)
+ let val c = Const(\<^const_name>\<open>HOL.implies\<close>,HOLogic.boolT --> HOLogic.boolT --> HOLogic.boolT)
in list_comb(c,[ant,conseq])
end;
fun mk_select (r as {Bvar,Body}) =
let val ty = type_of Bvar
- val c = Const(@{const_name Eps},(ty --> HOLogic.boolT) --> ty)
+ val c = Const(\<^const_name>\<open>Eps\<close>,(ty --> HOLogic.boolT) --> ty)
in list_comb(c,[mk_abs r])
end;
fun mk_forall (r as {Bvar,Body}) =
let val ty = type_of Bvar
- val c = Const(@{const_name All},(ty --> HOLogic.boolT) --> HOLogic.boolT)
+ val c = Const(\<^const_name>\<open>All\<close>,(ty --> HOLogic.boolT) --> HOLogic.boolT)
in list_comb(c,[mk_abs r])
end;
fun mk_exists (r as {Bvar,Body}) =
let val ty = type_of Bvar
- val c = Const(@{const_name Ex},(ty --> HOLogic.boolT) --> HOLogic.boolT)
+ val c = Const(\<^const_name>\<open>Ex\<close>,(ty --> HOLogic.boolT) --> HOLogic.boolT)
in list_comb(c,[mk_abs r])
end;
fun mk_conj{conj1,conj2} =
- let val c = Const(@{const_name HOL.conj},HOLogic.boolT --> HOLogic.boolT --> HOLogic.boolT)
+ let val c = Const(\<^const_name>\<open>HOL.conj\<close>,HOLogic.boolT --> HOLogic.boolT --> HOLogic.boolT)
in list_comb(c,[conj1,conj2])
end;
fun mk_disj{disj1,disj2} =
- let val c = Const(@{const_name HOL.disj},HOLogic.boolT --> HOLogic.boolT --> HOLogic.boolT)
+ let val c = Const(\<^const_name>\<open>HOL.disj\<close>,HOLogic.boolT --> HOLogic.boolT --> HOLogic.boolT)
in list_comb(c,[disj1,disj2])
end;
@@ -551,8 +551,8 @@
local
fun mk_uncurry (xt, yt, zt) =
- Const(@{const_name case_prod}, (xt --> yt --> zt) --> prod_ty xt yt --> zt)
-fun dest_pair(Const(@{const_name Pair},_) $ M $ N) = {fst=M, snd=N}
+ Const(\<^const_name>\<open>case_prod\<close>, (xt --> yt --> zt) --> prod_ty xt yt --> zt)
+fun dest_pair(Const(\<^const_name>\<open>Pair\<close>,_) $ M $ N) = {fst=M, snd=N}
| dest_pair _ = raise USYN_ERR "dest_pair" "not a pair"
fun is_var (Var _) = true | is_var (Free _) = true | is_var _ = false
in
@@ -599,39 +599,39 @@
end
| dest_abs _ _ = raise USYN_ERR "dest_abs" "not an abstraction";
-fun dest_eq(Const(@{const_name HOL.eq},_) $ M $ N) = {lhs=M, rhs=N}
+fun dest_eq(Const(\<^const_name>\<open>HOL.eq\<close>,_) $ M $ N) = {lhs=M, rhs=N}
| dest_eq _ = raise USYN_ERR "dest_eq" "not an equality";
-fun dest_imp(Const(@{const_name HOL.implies},_) $ M $ N) = {ant=M, conseq=N}
+fun dest_imp(Const(\<^const_name>\<open>HOL.implies\<close>,_) $ M $ N) = {ant=M, conseq=N}
| dest_imp _ = raise USYN_ERR "dest_imp" "not an implication";
-fun dest_forall(Const(@{const_name All},_) $ (a as Abs _)) = fst (dest_abs [] a)
+fun dest_forall(Const(\<^const_name>\<open>All\<close>,_) $ (a as Abs _)) = fst (dest_abs [] a)
| dest_forall _ = raise USYN_ERR "dest_forall" "not a forall";
-fun dest_exists(Const(@{const_name Ex},_) $ (a as Abs _)) = fst (dest_abs [] a)
+fun dest_exists(Const(\<^const_name>\<open>Ex\<close>,_) $ (a as Abs _)) = fst (dest_abs [] a)
| dest_exists _ = raise USYN_ERR "dest_exists" "not an existential";
-fun dest_neg(Const(@{const_name Not},_) $ M) = M
+fun dest_neg(Const(\<^const_name>\<open>Not\<close>,_) $ M) = M
| dest_neg _ = raise USYN_ERR "dest_neg" "not a negation";
-fun dest_conj(Const(@{const_name HOL.conj},_) $ M $ N) = {conj1=M, conj2=N}
+fun dest_conj(Const(\<^const_name>\<open>HOL.conj\<close>,_) $ M $ N) = {conj1=M, conj2=N}
| dest_conj _ = raise USYN_ERR "dest_conj" "not a conjunction";
-fun dest_disj(Const(@{const_name HOL.disj},_) $ M $ N) = {disj1=M, disj2=N}
+fun dest_disj(Const(\<^const_name>\<open>HOL.disj\<close>,_) $ M $ N) = {disj1=M, disj2=N}
| dest_disj _ = raise USYN_ERR "dest_disj" "not a disjunction";
fun mk_pair{fst,snd} =
let val ty1 = type_of fst
val ty2 = type_of snd
- val c = Const(@{const_name Pair},ty1 --> ty2 --> prod_ty ty1 ty2)
+ val c = Const(\<^const_name>\<open>Pair\<close>,ty1 --> ty2 --> prod_ty ty1 ty2)
in list_comb(c,[fst,snd])
end;
-fun dest_pair(Const(@{const_name Pair},_) $ M $ N) = {fst=M, snd=N}
+fun dest_pair(Const(\<^const_name>\<open>Pair\<close>,_) $ M $ N) = {fst=M, snd=N}
| dest_pair _ = raise USYN_ERR "dest_pair" "not a pair";
-local fun ucheck t = (if #Name (dest_const t) = @{const_name case_prod} then t
+local fun ucheck t = (if #Name (dest_const t) = \<^const_name>\<open>case_prod\<close> then t
else raise Match)
in
fun dest_pabs used tm =
@@ -727,7 +727,7 @@
(* Miscellaneous *)
fun mk_vstruct ty V =
- let fun follow_prod_type (Type(@{type_name Product_Type.prod},[ty1,ty2])) vs =
+ let fun follow_prod_type (Type(\<^type_name>\<open>Product_Type.prod\<close>,[ty1,ty2])) vs =
let val (ltm,vs1) = follow_prod_type ty1 vs
val (rtm,vs2) = follow_prod_type ty2 vs1
in (mk_pair{fst=ltm, snd=rtm}, vs2) end
@@ -748,16 +748,16 @@
fun dest_relation tm =
if (type_of tm = HOLogic.boolT)
- then let val (Const(@{const_name Set.member},_) $ (Const(@{const_name Pair},_)$y$x) $ R) = tm
+ then let val (Const(\<^const_name>\<open>Set.member\<close>,_) $ (Const(\<^const_name>\<open>Pair\<close>,_)$y$x) $ R) = tm
in (R,y,x)
end handle Bind => raise USYN_ERR "dest_relation" "unexpected term structure"
else raise USYN_ERR "dest_relation" "not a boolean term";
-fun is_WFR (Const(@{const_name Wellfounded.wf},_)$_) = true
+fun is_WFR (Const(\<^const_name>\<open>Wellfounded.wf\<close>,_)$_) = true
| is_WFR _ = false;
fun ARB ty = mk_select{Bvar=Free("v",ty),
- Body=Const(@{const_name True},HOLogic.boolT)};
+ Body=Const(\<^const_name>\<open>True\<close>,HOLogic.boolT)};
end;
@@ -788,19 +788,19 @@
* Some simple constructor functions.
*---------------------------------------------------------------------------*)
-val mk_hol_const = Thm.cterm_of @{theory_context HOL} o Const;
+val mk_hol_const = Thm.cterm_of \<^theory_context>\<open>HOL\<close> o Const;
fun mk_exists (r as (Bvar, Body)) =
let val ty = Thm.typ_of_cterm Bvar
- val c = mk_hol_const(@{const_name Ex}, (ty --> HOLogic.boolT) --> HOLogic.boolT)
+ val c = mk_hol_const(\<^const_name>\<open>Ex\<close>, (ty --> HOLogic.boolT) --> HOLogic.boolT)
in capply c (uncurry cabs r) end;
-local val c = mk_hol_const(@{const_name HOL.conj}, HOLogic.boolT --> HOLogic.boolT --> HOLogic.boolT)
+local val c = mk_hol_const(\<^const_name>\<open>HOL.conj\<close>, HOLogic.boolT --> HOLogic.boolT --> HOLogic.boolT)
in fun mk_conj(conj1,conj2) = capply (capply c conj1) conj2
end;
-local val c = mk_hol_const(@{const_name HOL.disj}, HOLogic.boolT --> HOLogic.boolT --> HOLogic.boolT)
+local val c = mk_hol_const(\<^const_name>\<open>HOL.disj\<close>, HOLogic.boolT --> HOLogic.boolT --> HOLogic.boolT)
in fun mk_disj(disj1,disj2) = capply (capply c disj1) disj2
end;
@@ -842,14 +842,14 @@
handle Utils.ERR _ => raise ERR "dest_binder" ("Not a(n) " ^ quote expected);
-val dest_neg = dest_monop @{const_name Not}
-val dest_pair = dest_binop @{const_name Pair}
-val dest_eq = dest_binop @{const_name HOL.eq}
-val dest_imp = dest_binop @{const_name HOL.implies}
-val dest_conj = dest_binop @{const_name HOL.conj}
-val dest_disj = dest_binop @{const_name HOL.disj}
-val dest_exists = dest_binder @{const_name Ex}
-val dest_forall = dest_binder @{const_name All}
+val dest_neg = dest_monop \<^const_name>\<open>Not\<close>
+val dest_pair = dest_binop \<^const_name>\<open>Pair\<close>
+val dest_eq = dest_binop \<^const_name>\<open>HOL.eq\<close>
+val dest_imp = dest_binop \<^const_name>\<open>HOL.implies\<close>
+val dest_conj = dest_binop \<^const_name>\<open>HOL.conj\<close>
+val dest_disj = dest_binop \<^const_name>\<open>HOL.disj\<close>
+val dest_exists = dest_binder \<^const_name>\<open>Ex\<close>
+val dest_forall = dest_binder \<^const_name>\<open>All\<close>
(* Query routines *)
@@ -896,10 +896,10 @@
fun is_Trueprop ct =
(case Thm.term_of ct of
- Const (@{const_name Trueprop}, _) $ _ => true
+ Const (\<^const_name>\<open>Trueprop\<close>, _) $ _ => true
| _ => false);
-fun mk_prop ct = if is_Trueprop ct then ct else Thm.apply @{cterm Trueprop} ct;
+fun mk_prop ct = if is_Trueprop ct then ct else Thm.apply \<^cterm>\<open>Trueprop\<close> ct;
fun drop_prop ct = if is_Trueprop ct then Thm.dest_arg ct else ct;
end;
@@ -1014,7 +1014,7 @@
local
val prop = Thm.prop_of disjI1
val [_,Q] = Misc_Legacy.term_vars prop
- val disj1 = Thm.forall_intr (Thm.cterm_of @{context} Q) disjI1
+ val disj1 = Thm.forall_intr (Thm.cterm_of \<^context> Q) disjI1
in
fun DISJ1 thm tm = thm RS (Thm.forall_elim (Dcterm.drop_prop tm) disj1)
handle THM (msg, _, _) => raise RULES_ERR "DISJ1" msg;
@@ -1023,7 +1023,7 @@
local
val prop = Thm.prop_of disjI2
val [P,_] = Misc_Legacy.term_vars prop
- val disj2 = Thm.forall_intr (Thm.cterm_of @{context} P) disjI2
+ val disj2 = Thm.forall_intr (Thm.cterm_of \<^context> P) disjI2
in
fun DISJ2 tm thm = thm RS (Thm.forall_elim (Dcterm.drop_prop tm) disj2)
handle THM (msg, _, _) => raise RULES_ERR "DISJ2" msg;
@@ -1118,7 +1118,7 @@
val prop = Thm.prop_of spec
val x = hd (tl (Misc_Legacy.term_vars prop))
val TV = dest_TVar (type_of x)
- val gspec = Thm.forall_intr (Thm.cterm_of @{context} x) spec
+ val gspec = Thm.forall_intr (Thm.cterm_of \<^context> x) spec
in
fun SPEC tm thm =
let val gspec' = Drule.instantiate_normalize ([(TV, Thm.ctyp_of_cterm tm)], []) gspec
@@ -1146,7 +1146,7 @@
fun GEN ctxt v th =
let val gth = Thm.forall_intr v th
val thy = Proof_Context.theory_of ctxt
- val Const(@{const_name Pure.all},_)$Abs(x,ty,rst) = Thm.prop_of gth
+ val Const(\<^const_name>\<open>Pure.all\<close>,_)$Abs(x,ty,rst) = Thm.prop_of gth
val P' = Abs(x,ty, HOLogic.dest_Trueprop rst) (* get rid of trueprop *)
val theta = Pattern.match thy (P,P') (Vartab.empty, Vartab.empty);
val allI2 = Drule.instantiate_normalize (certify ctxt theta) allI
@@ -1253,21 +1253,21 @@
(* Fragile: it's a cong if it is not "R y x ==> cut f R x y = f y" *)
fun is_cong thm =
case (Thm.prop_of thm) of
- (Const(@{const_name Pure.imp},_)$(Const(@{const_name Trueprop},_)$ _) $
- (Const(@{const_name Pure.eq},_) $ (Const (@{const_name Wfrec.cut},_) $ _ $ _ $ _ $ _) $ _)) =>
+ (Const(\<^const_name>\<open>Pure.imp\<close>,_)$(Const(\<^const_name>\<open>Trueprop\<close>,_)$ _) $
+ (Const(\<^const_name>\<open>Pure.eq\<close>,_) $ (Const (\<^const_name>\<open>Wfrec.cut\<close>,_) $ _ $ _ $ _ $ _) $ _)) =>
false
| _ => true;
-fun dest_equal(Const (@{const_name Pure.eq},_) $
- (Const (@{const_name Trueprop},_) $ lhs)
- $ (Const (@{const_name Trueprop},_) $ rhs)) = {lhs=lhs, rhs=rhs}
- | dest_equal(Const (@{const_name Pure.eq},_) $ lhs $ rhs) = {lhs=lhs, rhs=rhs}
+fun dest_equal(Const (\<^const_name>\<open>Pure.eq\<close>,_) $
+ (Const (\<^const_name>\<open>Trueprop\<close>,_) $ lhs)
+ $ (Const (\<^const_name>\<open>Trueprop\<close>,_) $ rhs)) = {lhs=lhs, rhs=rhs}
+ | dest_equal(Const (\<^const_name>\<open>Pure.eq\<close>,_) $ lhs $ rhs) = {lhs=lhs, rhs=rhs}
| dest_equal tm = USyntax.dest_eq tm;
fun get_lhs tm = #lhs(dest_equal (HOLogic.dest_Trueprop tm));
-fun dest_all used (Const(@{const_name Pure.all},_) $ (a as Abs _)) = USyntax.dest_abs used a
+fun dest_all used (Const(\<^const_name>\<open>Pure.all\<close>,_) $ (a as Abs _)) = USyntax.dest_abs used a
| dest_all _ _ = raise RULES_ERR "dest_all" "not a !!";
val is_all = can (dest_all []);
@@ -1280,7 +1280,7 @@
end
else ([], fm, used);
-fun list_break_all(Const(@{const_name Pure.all},_) $ Abs (s,ty,body)) =
+fun list_break_all(Const(\<^const_name>\<open>Pure.all\<close>,_) $ Abs (s,ty,body)) =
let val (L,core) = list_break_all body
in ((s,ty)::L, core)
end
@@ -1383,11 +1383,11 @@
local fun dest_pair M = let val {fst,snd} = USyntax.dest_pair M in (fst,snd) end
fun mk_fst tm =
- let val ty as Type(@{type_name Product_Type.prod}, [fty,sty]) = type_of tm
- in Const (@{const_name Product_Type.fst}, ty --> fty) $ tm end
+ let val ty as Type(\<^type_name>\<open>Product_Type.prod\<close>, [fty,sty]) = type_of tm
+ in Const (\<^const_name>\<open>Product_Type.fst\<close>, ty --> fty) $ tm end
fun mk_snd tm =
- let val ty as Type(@{type_name Product_Type.prod}, [fty,sty]) = type_of tm
- in Const (@{const_name Product_Type.snd}, ty --> sty) $ tm end
+ let val ty as Type(\<^type_name>\<open>Product_Type.prod\<close>, [fty,sty]) = type_of tm
+ in Const (\<^const_name>\<open>Product_Type.snd\<close>, ty --> sty) $ tm end
in
fun XFILL tych x vstruct =
let fun traverse p xocc L =
@@ -1443,7 +1443,7 @@
end;
fun restricted t = is_some (USyntax.find_term
- (fn (Const(@{const_name Wfrec.cut},_)) =>true | _ => false)
+ (fn (Const(\<^const_name>\<open>Wfrec.cut\<close>,_)) =>true | _ => false)
t)
fun CONTEXT_REWRITE_RULE main_ctxt (func, G, cut_lemma, congs) th =
@@ -1525,7 +1525,7 @@
fun eliminate thm =
case Thm.prop_of thm of
- Const(@{const_name Pure.imp},_) $ imp $ _ =>
+ Const(\<^const_name>\<open>Pure.imp\<close>,_) $ imp $ _ =>
eliminate
(if not(is_all imp)
then uq_eliminate (thm, imp)
@@ -1539,7 +1539,7 @@
let val _ = say "restrict_prover:"
val cntxt = rev (Simplifier.prems_of ctxt)
val _ = print_thms ctxt "cntxt:" cntxt
- val Const(@{const_name Pure.imp},_) $ (Const(@{const_name Trueprop},_) $ A) $ _ =
+ val Const(\<^const_name>\<open>Pure.imp\<close>,_) $ (Const(\<^const_name>\<open>Trueprop\<close>,_) $ A) $ _ =
Thm.prop_of thm
fun genl tm = let val vlist = subtract (op aconv) globals
(Misc_Legacy.add_term_frees(tm,[]))
@@ -1994,7 +1994,7 @@
(*For Isabelle, the lhs of a definition must be a constant.*)
fun const_def sign (c, Ty, rhs) =
singleton (Syntax.check_terms (Proof_Context.init_global sign))
- (Const(@{const_name Pure.eq},dummyT) $ Const(c,Ty) $ rhs);
+ (Const(\<^const_name>\<open>Pure.eq\<close>,dummyT) $ Const(c,Ty) $ rhs);
(*Make all TVars available for instantiation by adding a ? to the front*)
fun poly_tvars (Type(a,Ts)) = Type(a, map (poly_tvars) Ts)
@@ -2539,8 +2539,8 @@
val P_imp_P_eq_True = @{thm eqTrueI} RS eq_reflection;
fun mk_meta_eq r =
(case Thm.concl_of r of
- Const(@{const_name Pure.eq},_)$_$_ => r
- | _ $(Const(@{const_name HOL.eq},_)$_$_) => r RS eq_reflection
+ Const(\<^const_name>\<open>Pure.eq\<close>,_)$_$_ => r
+ | _ $(Const(\<^const_name>\<open>HOL.eq\<close>,_)$_$_) => r RS eq_reflection
| _ => r RS P_imp_P_eq_True)
(*Is this the best way to invoke the simplifier??*)
@@ -2607,7 +2607,7 @@
(*Strip off the outer !P*)
val spec'=
- Rule_Insts.read_instantiate @{context} [((("x", 0), Position.none), "P::'b=>bool")] [] spec;
+ Rule_Insts.read_instantiate \<^context> [((("x", 0), Position.none), "P::'b=>bool")] [] spec;
fun simplify_defn ctxt strict congs wfs pats def0 =
let
@@ -2834,7 +2834,7 @@
val rules = (map o map) fst (partition_eq (eq_snd (op = : int * int -> bool)) rules_idx);
val simp_att =
if null tcs then [Simplifier.simp_add,
- Named_Theorems.add @{named_theorems nitpick_simp}]
+ Named_Theorems.add \<^named_theorems>\<open>nitpick_simp\<close>]
else [];
val ((simps' :: rules', [induct']), thy2) =
Proof_Context.theory_of ctxt1
@@ -2862,30 +2862,30 @@
val _ =
Theory.setup
- (Attrib.setup @{binding recdef_simp} (Attrib.add_del simp_add simp_del)
+ (Attrib.setup \<^binding>\<open>recdef_simp\<close> (Attrib.add_del simp_add simp_del)
"declaration of recdef simp rule" #>
- Attrib.setup @{binding recdef_cong} (Attrib.add_del cong_add cong_del)
+ Attrib.setup \<^binding>\<open>recdef_cong\<close> (Attrib.add_del cong_add cong_del)
"declaration of recdef cong rule" #>
- Attrib.setup @{binding recdef_wf} (Attrib.add_del wf_add wf_del)
+ Attrib.setup \<^binding>\<open>recdef_wf\<close> (Attrib.add_del wf_add wf_del)
"declaration of recdef wf rule");
(* outer syntax *)
val hints =
- @{keyword "("} |--
- Parse.!!! ((Parse.token @{keyword "hints"} ::: Parse.args) --| @{keyword ")"});
+ \<^keyword>\<open>(\<close> |--
+ Parse.!!! ((Parse.token \<^keyword>\<open>hints\<close> ::: Parse.args) --| \<^keyword>\<open>)\<close>);
val recdef_decl =
Scan.optional
- (@{keyword "("} -- Parse.!!! (@{keyword "permissive"} -- @{keyword ")"}) >> K false) true --
+ (\<^keyword>\<open>(\<close> -- Parse.!!! (\<^keyword>\<open>permissive\<close> -- \<^keyword>\<open>)\<close>) >> K false) true --
Parse.name -- Parse.term -- Scan.repeat1 (Parse_Spec.opt_thm_name ":" -- Parse.prop)
-- Scan.option hints
>> (fn ((((p, f), R), eqs), src) =>
#1 o add_recdef p f R (map (fn ((x, y), z) => ((x, z), y)) eqs) src);
val _ =
- Outer_Syntax.command @{command_keyword recdef} "define general recursive functions (obsolete TFL)"
+ Outer_Syntax.command \<^command_keyword>\<open>recdef\<close> "define general recursive functions (obsolete TFL)"
(recdef_decl >> Toplevel.theory);
end;
--- a/src/HOL/Library/positivstellensatz.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/positivstellensatz.ML Fri Jan 04 23:22:53 2019 +0100
@@ -713,7 +713,7 @@
local
val absmaxmin_elim_ss1 =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps real_abs_thms1)
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps real_abs_thms1)
fun absmaxmin_elim_conv1 ctxt =
Simplifier.rewrite (put_simpset absmaxmin_elim_ss1 ctxt)
--- a/src/HOL/Library/refute.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/refute.ML Fri Jan 04 23:22:53 2019 +0100
@@ -474,7 +474,7 @@
| get_typedef_ax ((axname, ax) :: axioms) =
(let
fun type_of_type_definition (Const (s', T')) =
- if s'= @{const_name type_definition} then
+ if s'= \<^const_name>\<open>type_definition\<close> then
SOME T'
else
NONE
@@ -536,43 +536,43 @@
fun unfold_loop t =
case t of
(* Pure *)
- Const (@{const_name Pure.all}, _) => t
- | Const (@{const_name Pure.eq}, _) => t
- | Const (@{const_name Pure.imp}, _) => t
- | Const (@{const_name Pure.type}, _) => t (* axiomatic type classes *)
+ Const (\<^const_name>\<open>Pure.all\<close>, _) => t
+ | Const (\<^const_name>\<open>Pure.eq\<close>, _) => t
+ | Const (\<^const_name>\<open>Pure.imp\<close>, _) => t
+ | Const (\<^const_name>\<open>Pure.type\<close>, _) => t (* axiomatic type classes *)
(* HOL *)
- | Const (@{const_name Trueprop}, _) => t
- | Const (@{const_name Not}, _) => t
+ | Const (\<^const_name>\<open>Trueprop\<close>, _) => t
+ | Const (\<^const_name>\<open>Not\<close>, _) => t
| (* redundant, since 'True' is also an IDT constructor *)
- Const (@{const_name True}, _) => t
+ Const (\<^const_name>\<open>True\<close>, _) => t
| (* redundant, since 'False' is also an IDT constructor *)
- Const (@{const_name False}, _) => t
- | Const (@{const_name undefined}, _) => t
- | Const (@{const_name The}, _) => t
- | Const (@{const_name Hilbert_Choice.Eps}, _) => t
- | Const (@{const_name All}, _) => t
- | Const (@{const_name Ex}, _) => t
- | Const (@{const_name HOL.eq}, _) => t
- | Const (@{const_name HOL.conj}, _) => t
- | Const (@{const_name HOL.disj}, _) => t
- | Const (@{const_name HOL.implies}, _) => t
+ Const (\<^const_name>\<open>False\<close>, _) => t
+ | Const (\<^const_name>\<open>undefined\<close>, _) => t
+ | Const (\<^const_name>\<open>The\<close>, _) => t
+ | Const (\<^const_name>\<open>Hilbert_Choice.Eps\<close>, _) => t
+ | Const (\<^const_name>\<open>All\<close>, _) => t
+ | Const (\<^const_name>\<open>Ex\<close>, _) => t
+ | Const (\<^const_name>\<open>HOL.eq\<close>, _) => t
+ | Const (\<^const_name>\<open>HOL.conj\<close>, _) => t
+ | Const (\<^const_name>\<open>HOL.disj\<close>, _) => t
+ | Const (\<^const_name>\<open>HOL.implies\<close>, _) => t
(* sets *)
- | Const (@{const_name Collect}, _) => t
- | Const (@{const_name Set.member}, _) => t
+ | Const (\<^const_name>\<open>Collect\<close>, _) => t
+ | Const (\<^const_name>\<open>Set.member\<close>, _) => t
(* other optimizations *)
- | Const (@{const_name Finite_Set.card}, _) => t
- | Const (@{const_name Finite_Set.finite}, _) => t
- | Const (@{const_name Orderings.less}, Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ bool}])])) => t
- | Const (@{const_name Groups.plus}, Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ nat}])])) => t
- | Const (@{const_name Groups.minus}, Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ nat}])])) => t
- | Const (@{const_name Groups.times}, Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ nat}])])) => t
- | Const (@{const_name append}, _) => t
- | Const (@{const_name fst}, _) => t
- | Const (@{const_name snd}, _) => t
+ | Const (\<^const_name>\<open>Finite_Set.card\<close>, _) => t
+ | Const (\<^const_name>\<open>Finite_Set.finite\<close>, _) => t
+ | Const (\<^const_name>\<open>Orderings.less\<close>, Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>bool\<close>])])) => t
+ | Const (\<^const_name>\<open>Groups.plus\<close>, Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>nat\<close>])])) => t
+ | Const (\<^const_name>\<open>Groups.minus\<close>, Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>nat\<close>])])) => t
+ | Const (\<^const_name>\<open>Groups.times\<close>, Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>nat\<close>])])) => t
+ | Const (\<^const_name>\<open>append\<close>, _) => t
+ | Const (\<^const_name>\<open>fst\<close>, _) => t
+ | Const (\<^const_name>\<open>snd\<close>, _) => t
(* simply-typed lambda calculus *)
| Const (s, T) =>
(if is_IDT_constructor thy (s, T)
@@ -630,8 +630,8 @@
fun get_axiom thy xname =
Name_Space.check (Context.Theory thy) (Theory.axiom_table thy) (xname, Position.none);
-val the_eq_trivial = get_axiom @{theory HOL} "the_eq_trivial";
-val someI = get_axiom @{theory Hilbert_Choice} "someI";
+val the_eq_trivial = get_axiom \<^theory>\<open>HOL\<close> "the_eq_trivial";
+val someI = get_axiom \<^theory>\<open>Hilbert_Choice\<close> "someI";
in
@@ -680,11 +680,11 @@
and collect_type_axioms T axs =
case T of
(* simple types *)
- Type (@{type_name prop}, []) => axs
- | Type (@{type_name fun}, [T1, T2]) => collect_type_axioms T2 (collect_type_axioms T1 axs)
- | Type (@{type_name set}, [T1]) => collect_type_axioms T1 axs
+ Type (\<^type_name>\<open>prop\<close>, []) => axs
+ | Type (\<^type_name>\<open>fun\<close>, [T1, T2]) => collect_type_axioms T2 (collect_type_axioms T1 axs)
+ | Type (\<^type_name>\<open>set\<close>, [T1]) => collect_type_axioms T1 axs
(* axiomatic type classes *)
- | Type (@{type_name itself}, [T1]) => collect_type_axioms T1 axs
+ | Type (\<^type_name>\<open>itself\<close>, [T1]) => collect_type_axioms T1 axs
| Type (s, Ts) =>
(case BNF_LFP_Compat.get_info thy [] s of
SOME _ => (* inductive datatype *)
@@ -705,59 +705,59 @@
and collect_term_axioms t axs =
case t of
(* Pure *)
- Const (@{const_name Pure.all}, _) => axs
- | Const (@{const_name Pure.eq}, _) => axs
- | Const (@{const_name Pure.imp}, _) => axs
+ Const (\<^const_name>\<open>Pure.all\<close>, _) => axs
+ | Const (\<^const_name>\<open>Pure.eq\<close>, _) => axs
+ | Const (\<^const_name>\<open>Pure.imp\<close>, _) => axs
(* axiomatic type classes *)
- | Const (@{const_name Pure.type}, T) => collect_type_axioms T axs
+ | Const (\<^const_name>\<open>Pure.type\<close>, T) => collect_type_axioms T axs
(* HOL *)
- | Const (@{const_name Trueprop}, _) => axs
- | Const (@{const_name Not}, _) => axs
+ | Const (\<^const_name>\<open>Trueprop\<close>, _) => axs
+ | Const (\<^const_name>\<open>Not\<close>, _) => axs
(* redundant, since 'True' is also an IDT constructor *)
- | Const (@{const_name True}, _) => axs
+ | Const (\<^const_name>\<open>True\<close>, _) => axs
(* redundant, since 'False' is also an IDT constructor *)
- | Const (@{const_name False}, _) => axs
- | Const (@{const_name undefined}, T) => collect_type_axioms T axs
- | Const (@{const_name The}, T) =>
+ | Const (\<^const_name>\<open>False\<close>, _) => axs
+ | Const (\<^const_name>\<open>undefined\<close>, T) => collect_type_axioms T axs
+ | Const (\<^const_name>\<open>The\<close>, T) =>
let
- val ax = specialize_type thy (@{const_name The}, T) (#2 the_eq_trivial)
+ val ax = specialize_type thy (\<^const_name>\<open>The\<close>, T) (#2 the_eq_trivial)
in
collect_this_axiom (#1 the_eq_trivial, ax) axs
end
- | Const (@{const_name Hilbert_Choice.Eps}, T) =>
+ | Const (\<^const_name>\<open>Hilbert_Choice.Eps\<close>, T) =>
let
- val ax = specialize_type thy (@{const_name Hilbert_Choice.Eps}, T) (#2 someI)
+ val ax = specialize_type thy (\<^const_name>\<open>Hilbert_Choice.Eps\<close>, T) (#2 someI)
in
collect_this_axiom (#1 someI, ax) axs
end
- | Const (@{const_name All}, T) => collect_type_axioms T axs
- | Const (@{const_name Ex}, T) => collect_type_axioms T axs
- | Const (@{const_name HOL.eq}, T) => collect_type_axioms T axs
- | Const (@{const_name HOL.conj}, _) => axs
- | Const (@{const_name HOL.disj}, _) => axs
- | Const (@{const_name HOL.implies}, _) => axs
+ | Const (\<^const_name>\<open>All\<close>, T) => collect_type_axioms T axs
+ | Const (\<^const_name>\<open>Ex\<close>, T) => collect_type_axioms T axs
+ | Const (\<^const_name>\<open>HOL.eq\<close>, T) => collect_type_axioms T axs
+ | Const (\<^const_name>\<open>HOL.conj\<close>, _) => axs
+ | Const (\<^const_name>\<open>HOL.disj\<close>, _) => axs
+ | Const (\<^const_name>\<open>HOL.implies\<close>, _) => axs
(* sets *)
- | Const (@{const_name Collect}, T) => collect_type_axioms T axs
- | Const (@{const_name Set.member}, T) => collect_type_axioms T axs
+ | Const (\<^const_name>\<open>Collect\<close>, T) => collect_type_axioms T axs
+ | Const (\<^const_name>\<open>Set.member\<close>, T) => collect_type_axioms T axs
(* other optimizations *)
- | Const (@{const_name Finite_Set.card}, T) => collect_type_axioms T axs
- | Const (@{const_name Finite_Set.finite}, T) =>
+ | Const (\<^const_name>\<open>Finite_Set.card\<close>, T) => collect_type_axioms T axs
+ | Const (\<^const_name>\<open>Finite_Set.finite\<close>, T) =>
collect_type_axioms T axs
- | Const (@{const_name Orderings.less}, T as Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ bool}])])) =>
+ | Const (\<^const_name>\<open>Orderings.less\<close>, T as Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>bool\<close>])])) =>
collect_type_axioms T axs
- | Const (@{const_name Groups.plus}, T as Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ nat}])])) =>
+ | Const (\<^const_name>\<open>Groups.plus\<close>, T as Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>nat\<close>])])) =>
collect_type_axioms T axs
- | Const (@{const_name Groups.minus}, T as Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ nat}])])) =>
+ | Const (\<^const_name>\<open>Groups.minus\<close>, T as Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>nat\<close>])])) =>
collect_type_axioms T axs
- | Const (@{const_name Groups.times}, T as Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ nat}])])) =>
+ | Const (\<^const_name>\<open>Groups.times\<close>, T as Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>nat\<close>])])) =>
collect_type_axioms T axs
- | Const (@{const_name append}, T) => collect_type_axioms T axs
- | Const (@{const_name fst}, T) => collect_type_axioms T axs
- | Const (@{const_name snd}, T) => collect_type_axioms T axs
+ | Const (\<^const_name>\<open>append\<close>, T) => collect_type_axioms T axs
+ | Const (\<^const_name>\<open>fst\<close>, T) => collect_type_axioms T axs
+ | Const (\<^const_name>\<open>snd\<close>, T) => collect_type_axioms T axs
(* simply-typed lambda calculus *)
| Const (s, T) =>
if is_const_of_class thy (s, T) then
@@ -811,9 +811,9 @@
val thy = Proof_Context.theory_of ctxt
fun collect_types T acc =
(case T of
- Type (@{type_name fun}, [T1, T2]) => collect_types T1 (collect_types T2 acc)
- | Type (@{type_name prop}, []) => acc
- | Type (@{type_name set}, [T1]) => collect_types T1 acc
+ Type (\<^type_name>\<open>fun\<close>, [T1, T2]) => collect_types T1 (collect_types T2 acc)
+ | Type (\<^type_name>\<open>prop\<close>, []) => acc
+ | Type (\<^type_name>\<open>set\<close>, [T1]) => collect_types T1 acc
| Type (s, Ts) =>
(case BNF_LFP_Compat.get_info thy [] s of
SOME info => (* inductive datatype *)
@@ -1173,19 +1173,19 @@
(* interpretation which includes values for the (formerly) *)
(* quantified variables. *)
(* maps !!x1...xn. !xk...xm. t to t *)
- fun strip_all_body (Const (@{const_name Pure.all}, _) $ Abs (_, _, t)) =
+ fun strip_all_body (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (_, _, t)) =
strip_all_body t
- | strip_all_body (Const (@{const_name Trueprop}, _) $ t) =
+ | strip_all_body (Const (\<^const_name>\<open>Trueprop\<close>, _) $ t) =
strip_all_body t
- | strip_all_body (Const (@{const_name All}, _) $ Abs (_, _, t)) =
+ | strip_all_body (Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, _, t)) =
strip_all_body t
| strip_all_body t = t
(* maps !!x1...xn. !xk...xm. t to [x1, ..., xn, xk, ..., xm] *)
- fun strip_all_vars (Const (@{const_name Pure.all}, _) $ Abs (a, T, t)) =
+ fun strip_all_vars (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (a, T, t)) =
(a, T) :: strip_all_vars t
- | strip_all_vars (Const (@{const_name Trueprop}, _) $ t) =
+ | strip_all_vars (Const (\<^const_name>\<open>Trueprop\<close>, _) $ t) =
strip_all_vars t
- | strip_all_vars (Const (@{const_name All}, _) $ Abs (a, T, t)) =
+ | strip_all_vars (Const (\<^const_name>\<open>All\<close>, _) $ Abs (a, T, t)) =
(a, T) :: strip_all_vars t
| strip_all_vars _ = [] : (string * typ) list
val strip_t = strip_all_body ex_closure
@@ -1559,7 +1559,7 @@
fun Pure_interpreter ctxt model args t =
case t of
- Const (@{const_name Pure.all}, _) $ t1 =>
+ Const (\<^const_name>\<open>Pure.all\<close>, _) $ t1 =>
let
val (i, m, a) = interpret ctxt model args t1
in
@@ -1576,9 +1576,9 @@
raise REFUTE ("Pure_interpreter",
"\"Pure.all\" is followed by a non-function")
end
- | Const (@{const_name Pure.all}, _) =>
+ | Const (\<^const_name>\<open>Pure.all\<close>, _) =>
SOME (interpret ctxt model args (eta_expand t 1))
- | Const (@{const_name Pure.eq}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t1 $ t2 =>
let
val (i1, m1, a1) = interpret ctxt model args t1
val (i2, m2, a2) = interpret ctxt m1 a1 t2
@@ -1587,11 +1587,11 @@
SOME ((if #def_eq args then make_def_equality else make_equality)
(i1, i2), m2, a2)
end
- | Const (@{const_name Pure.eq}, _) $ _ =>
+ | Const (\<^const_name>\<open>Pure.eq\<close>, _) $ _ =>
SOME (interpret ctxt model args (eta_expand t 1))
- | Const (@{const_name Pure.eq}, _) =>
+ | Const (\<^const_name>\<open>Pure.eq\<close>, _) =>
SOME (interpret ctxt model args (eta_expand t 2))
- | Const (@{const_name Pure.imp}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>Pure.imp\<close>, _) $ t1 $ t2 =>
(* 3-valued logic *)
let
val (i1, m1, a1) = interpret ctxt model args t1
@@ -1601,9 +1601,9 @@
in
SOME (Leaf [fmTrue, fmFalse], m2, a2)
end
- | Const (@{const_name Pure.imp}, _) $ _ =>
+ | Const (\<^const_name>\<open>Pure.imp\<close>, _) $ _ =>
SOME (interpret ctxt model args (eta_expand t 1))
- | Const (@{const_name Pure.imp}, _) =>
+ | Const (\<^const_name>\<open>Pure.imp\<close>, _) =>
SOME (interpret ctxt model args (eta_expand t 2))
| _ => NONE;
@@ -1612,17 +1612,17 @@
(* logical constants. In HOL however, logical constants can themselves be *)
(* arguments. They are then translated using eta-expansion. *)
case t of
- Const (@{const_name Trueprop}, _) =>
+ Const (\<^const_name>\<open>Trueprop\<close>, _) =>
SOME (Node [TT, FF], model, args)
- | Const (@{const_name Not}, _) =>
+ | Const (\<^const_name>\<open>Not\<close>, _) =>
SOME (Node [FF, TT], model, args)
(* redundant, since 'True' is also an IDT constructor *)
- | Const (@{const_name True}, _) =>
+ | Const (\<^const_name>\<open>True\<close>, _) =>
SOME (TT, model, args)
(* redundant, since 'False' is also an IDT constructor *)
- | Const (@{const_name False}, _) =>
+ | Const (\<^const_name>\<open>False\<close>, _) =>
SOME (FF, model, args)
- | Const (@{const_name All}, _) $ t1 => (* similar to "Pure.all" *)
+ | Const (\<^const_name>\<open>All\<close>, _) $ t1 => (* similar to "Pure.all" *)
let
val (i, m, a) = interpret ctxt model args t1
in
@@ -1639,9 +1639,9 @@
raise REFUTE ("HOLogic_interpreter",
"\"All\" is followed by a non-function")
end
- | Const (@{const_name All}, _) =>
+ | Const (\<^const_name>\<open>All\<close>, _) =>
SOME (interpret ctxt model args (eta_expand t 1))
- | Const (@{const_name Ex}, _) $ t1 =>
+ | Const (\<^const_name>\<open>Ex\<close>, _) $ t1 =>
let
val (i, m, a) = interpret ctxt model args t1
in
@@ -1658,20 +1658,20 @@
raise REFUTE ("HOLogic_interpreter",
"\"Ex\" is followed by a non-function")
end
- | Const (@{const_name Ex}, _) =>
+ | Const (\<^const_name>\<open>Ex\<close>, _) =>
SOME (interpret ctxt model args (eta_expand t 1))
- | Const (@{const_name HOL.eq}, _) $ t1 $ t2 => (* similar to Pure.eq *)
+ | Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2 => (* similar to Pure.eq *)
let
val (i1, m1, a1) = interpret ctxt model args t1
val (i2, m2, a2) = interpret ctxt m1 a1 t2
in
SOME (make_equality (i1, i2), m2, a2)
end
- | Const (@{const_name HOL.eq}, _) $ _ =>
+ | Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ =>
SOME (interpret ctxt model args (eta_expand t 1))
- | Const (@{const_name HOL.eq}, _) =>
+ | Const (\<^const_name>\<open>HOL.eq\<close>, _) =>
SOME (interpret ctxt model args (eta_expand t 2))
- | Const (@{const_name HOL.conj}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>HOL.conj\<close>, _) $ t1 $ t2 =>
(* 3-valued logic *)
let
val (i1, m1, a1) = interpret ctxt model args t1
@@ -1681,14 +1681,14 @@
in
SOME (Leaf [fmTrue, fmFalse], m2, a2)
end
- | Const (@{const_name HOL.conj}, _) $ _ =>
+ | Const (\<^const_name>\<open>HOL.conj\<close>, _) $ _ =>
SOME (interpret ctxt model args (eta_expand t 1))
- | Const (@{const_name HOL.conj}, _) =>
+ | Const (\<^const_name>\<open>HOL.conj\<close>, _) =>
SOME (interpret ctxt model args (eta_expand t 2))
(* this would make "undef" propagate, even for formulae like *)
(* "False & undef": *)
(* SOME (Node [Node [TT, FF], Node [FF, FF]], model, args) *)
- | Const (@{const_name HOL.disj}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>HOL.disj\<close>, _) $ t1 $ t2 =>
(* 3-valued logic *)
let
val (i1, m1, a1) = interpret ctxt model args t1
@@ -1698,14 +1698,14 @@
in
SOME (Leaf [fmTrue, fmFalse], m2, a2)
end
- | Const (@{const_name HOL.disj}, _) $ _ =>
+ | Const (\<^const_name>\<open>HOL.disj\<close>, _) $ _ =>
SOME (interpret ctxt model args (eta_expand t 1))
- | Const (@{const_name HOL.disj}, _) =>
+ | Const (\<^const_name>\<open>HOL.disj\<close>, _) =>
SOME (interpret ctxt model args (eta_expand t 2))
(* this would make "undef" propagate, even for formulae like *)
(* "True | undef": *)
(* SOME (Node [Node [TT, TT], Node [TT, FF]], model, args) *)
- | Const (@{const_name HOL.implies}, _) $ t1 $ t2 => (* similar to Pure.imp *)
+ | Const (\<^const_name>\<open>HOL.implies\<close>, _) $ t1 $ t2 => (* similar to Pure.imp *)
(* 3-valued logic *)
let
val (i1, m1, a1) = interpret ctxt model args t1
@@ -1715,9 +1715,9 @@
in
SOME (Leaf [fmTrue, fmFalse], m2, a2)
end
- | Const (@{const_name HOL.implies}, _) $ _ =>
+ | Const (\<^const_name>\<open>HOL.implies\<close>, _) $ _ =>
SOME (interpret ctxt model args (eta_expand t 1))
- | Const (@{const_name HOL.implies}, _) =>
+ | Const (\<^const_name>\<open>HOL.implies\<close>, _) =>
SOME (interpret ctxt model args (eta_expand t 2))
(* this would make "undef" propagate, even for formulae like *)
(* "False --> undef": *)
@@ -1850,9 +1850,9 @@
val pairss = map (map HOLogic.mk_prod) functions
val HOLogic_prodT = HOLogic.mk_prodT (T1, T2)
val HOLogic_setT = HOLogic.mk_setT HOLogic_prodT
- val HOLogic_empty_set = Const (@{const_abbrev Set.empty}, HOLogic_setT)
+ val HOLogic_empty_set = Const (\<^const_abbrev>\<open>Set.empty\<close>, HOLogic_setT)
val HOLogic_insert =
- Const (@{const_name insert}, HOLogic_prodT --> HOLogic_setT --> HOLogic_setT)
+ Const (\<^const_name>\<open>insert\<close>, HOLogic_prodT --> HOLogic_setT --> HOLogic_setT)
in
(* functions as graphs, i.e. as a (HOL) set of pairs "(x, y)" *)
map (fn ps => fold_rev (fn pair => fn acc => HOLogic_insert $ pair $ acc) ps
@@ -2412,21 +2412,21 @@
SOME (intr, model, args)
| NONE =>
(case t of
- Free (x, Type (@{type_name set}, [T])) =>
+ Free (x, Type (\<^type_name>\<open>set\<close>, [T])) =>
let
val (intr, _, args') =
interpret ctxt (typs, []) args (Free (x, T --> HOLogic.boolT))
in
SOME (intr, (typs, (t, intr)::terms), args')
end
- | Var ((x, i), Type (@{type_name set}, [T])) =>
+ | Var ((x, i), Type (\<^type_name>\<open>set\<close>, [T])) =>
let
val (intr, _, args') =
interpret ctxt (typs, []) args (Var ((x,i), T --> HOLogic.boolT))
in
SOME (intr, (typs, (t, intr)::terms), args')
end
- | Const (s, Type (@{type_name set}, [T])) =>
+ | Const (s, Type (\<^type_name>\<open>set\<close>, [T])) =>
let
val (intr, _, args') =
interpret ctxt (typs, []) args (Const (s, T --> HOLogic.boolT))
@@ -2434,16 +2434,16 @@
SOME (intr, (typs, (t, intr)::terms), args')
end
(* 'Collect' == identity *)
- | Const (@{const_name Collect}, _) $ t1 =>
+ | Const (\<^const_name>\<open>Collect\<close>, _) $ t1 =>
SOME (interpret ctxt model args t1)
- | Const (@{const_name Collect}, _) =>
+ | Const (\<^const_name>\<open>Collect\<close>, _) =>
SOME (interpret ctxt model args (eta_expand t 1))
(* 'op :' == application *)
- | Const (@{const_name Set.member}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>Set.member\<close>, _) $ t1 $ t2 =>
SOME (interpret ctxt model args (t2 $ t1))
- | Const (@{const_name Set.member}, _) $ _ =>
+ | Const (\<^const_name>\<open>Set.member\<close>, _) $ _ =>
SOME (interpret ctxt model args (eta_expand t 1))
- | Const (@{const_name Set.member}, _) =>
+ | Const (\<^const_name>\<open>Set.member\<close>, _) =>
SOME (interpret ctxt model args (eta_expand t 2))
| _ => NONE)
end;
@@ -2454,8 +2454,8 @@
fun Finite_Set_card_interpreter ctxt model args t =
case t of
- Const (@{const_name Finite_Set.card},
- Type ("fun", [Type (@{type_name set}, [T]), @{typ nat}])) =>
+ Const (\<^const_name>\<open>Finite_Set.card\<close>,
+ Type ("fun", [Type (\<^type_name>\<open>set\<close>, [T]), \<^typ>\<open>nat\<close>])) =>
let
fun number_of_elements (Node xs) =
fold (fn x => fn n =>
@@ -2470,7 +2470,7 @@
| number_of_elements (Leaf _) =
raise REFUTE ("Finite_Set_card_interpreter",
"interpretation for set type is a leaf")
- val size_of_nat = size_of_type ctxt model (@{typ nat})
+ val size_of_nat = size_of_type ctxt model (\<^typ>\<open>nat\<close>)
(* takes an interpretation for a set and returns an interpretation *)
(* for a 'nat' denoting the set's cardinality *)
fun card i =
@@ -2495,13 +2495,13 @@
fun Finite_Set_finite_interpreter ctxt model args t =
case t of
- Const (@{const_name Finite_Set.finite},
- Type ("fun", [_, @{typ bool}])) $ _ =>
+ Const (\<^const_name>\<open>Finite_Set.finite\<close>,
+ Type ("fun", [_, \<^typ>\<open>bool\<close>])) $ _ =>
(* we only consider finite models anyway, hence EVERY set is *)
(* "finite" *)
SOME (TT, model, args)
- | Const (@{const_name Finite_Set.finite},
- Type ("fun", [set_T, @{typ bool}])) =>
+ | Const (\<^const_name>\<open>Finite_Set.finite\<close>,
+ Type ("fun", [set_T, \<^typ>\<open>bool\<close>])) =>
let
val size_of_set = size_of_type ctxt model set_T
in
@@ -2517,10 +2517,10 @@
fun Nat_less_interpreter ctxt model args t =
case t of
- Const (@{const_name Orderings.less}, Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ bool}])])) =>
+ Const (\<^const_name>\<open>Orderings.less\<close>, Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>bool\<close>])])) =>
let
- val size_of_nat = size_of_type ctxt model (@{typ nat})
+ val size_of_nat = size_of_type ctxt model (\<^typ>\<open>nat\<close>)
(* the 'n'-th nat is not less than the first 'n' nats, while it *)
(* is less than the remaining 'size_of_nat - n' nats *)
fun less n = Node ((replicate n FF) @ (replicate (size_of_nat - n) TT))
@@ -2535,10 +2535,10 @@
fun Nat_plus_interpreter ctxt model args t =
case t of
- Const (@{const_name Groups.plus}, Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ nat}])])) =>
+ Const (\<^const_name>\<open>Groups.plus\<close>, Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>nat\<close>])])) =>
let
- val size_of_nat = size_of_type ctxt model (@{typ nat})
+ val size_of_nat = size_of_type ctxt model (\<^typ>\<open>nat\<close>)
fun plus m n =
let
val element = m + n
@@ -2561,10 +2561,10 @@
fun Nat_minus_interpreter ctxt model args t =
case t of
- Const (@{const_name Groups.minus}, Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ nat}])])) =>
+ Const (\<^const_name>\<open>Groups.minus\<close>, Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>nat\<close>])])) =>
let
- val size_of_nat = size_of_type ctxt model (@{typ nat})
+ val size_of_nat = size_of_type ctxt model (\<^typ>\<open>nat\<close>)
fun minus m n =
let
val element = Int.max (m-n, 0)
@@ -2584,10 +2584,10 @@
fun Nat_times_interpreter ctxt model args t =
case t of
- Const (@{const_name Groups.times}, Type ("fun", [@{typ nat},
- Type ("fun", [@{typ nat}, @{typ nat}])])) =>
+ Const (\<^const_name>\<open>Groups.times\<close>, Type ("fun", [\<^typ>\<open>nat\<close>,
+ Type ("fun", [\<^typ>\<open>nat\<close>, \<^typ>\<open>nat\<close>])])) =>
let
- val size_of_nat = size_of_type ctxt model (@{typ nat})
+ val size_of_nat = size_of_type ctxt model (\<^typ>\<open>nat\<close>)
fun mult m n =
let
val element = m * n
@@ -2610,12 +2610,12 @@
fun List_append_interpreter ctxt model args t =
case t of
- Const (@{const_name append},
- Type (@{type_name fun}, [Type (@{type_name list}, [T]),
- Type (@{type_name fun}, [Type (@{type_name list}, [_]), Type (@{type_name list}, [_])])])) =>
+ Const (\<^const_name>\<open>append\<close>,
+ Type (\<^type_name>\<open>fun\<close>, [Type (\<^type_name>\<open>list\<close>, [T]),
+ Type (\<^type_name>\<open>fun\<close>, [Type (\<^type_name>\<open>list\<close>, [_]), Type (\<^type_name>\<open>list\<close>, [_])])])) =>
let
val size_elem = size_of_type ctxt model T
- val size_list = size_of_type ctxt model (Type (@{type_name list}, [T]))
+ val size_list = size_of_type ctxt model (Type (\<^type_name>\<open>list\<close>, [T]))
(* maximal length of lists; 0 if we only consider the empty list *)
val list_length =
let
@@ -2699,7 +2699,7 @@
fun Product_Type_fst_interpreter ctxt model args t =
case t of
- Const (@{const_name fst}, Type ("fun", [Type (@{type_name Product_Type.prod}, [T, U]), _])) =>
+ Const (\<^const_name>\<open>fst\<close>, Type ("fun", [Type (\<^type_name>\<open>Product_Type.prod\<close>, [T, U]), _])) =>
let
val constants_T = make_constants ctxt model T
val size_U = size_of_type ctxt model U
@@ -2714,7 +2714,7 @@
fun Product_Type_snd_interpreter ctxt model args t =
case t of
- Const (@{const_name snd}, Type ("fun", [Type (@{type_name Product_Type.prod}, [T, U]), _])) =>
+ Const (\<^const_name>\<open>snd\<close>, Type ("fun", [Type (\<^type_name>\<open>Product_Type.prod\<close>, [T, U]), _])) =>
let
val size_T = size_of_type ctxt model T
val constants_U = make_constants ctxt model U
@@ -2759,34 +2759,34 @@
(constants ~~ results)
val HOLogic_prodT = HOLogic.mk_prodT (T1, T2)
val HOLogic_setT = HOLogic.mk_setT HOLogic_prodT
- val HOLogic_empty_set = Const (@{const_abbrev Set.empty}, HOLogic_setT)
+ val HOLogic_empty_set = Const (\<^const_abbrev>\<open>Set.empty\<close>, HOLogic_setT)
val HOLogic_insert =
- Const (@{const_name insert}, HOLogic_prodT --> HOLogic_setT --> HOLogic_setT)
+ Const (\<^const_name>\<open>insert\<close>, HOLogic_prodT --> HOLogic_setT --> HOLogic_setT)
in
SOME (fold_rev (fn pair => fn acc => HOLogic_insert $ pair $ acc) pairs HOLogic_empty_set)
end
- | Type (@{type_name prop}, []) =>
+ | Type (\<^type_name>\<open>prop\<close>, []) =>
(case index_from_interpretation intr of
- ~1 => SOME (HOLogic.mk_Trueprop (Const (@{const_name undefined}, HOLogic.boolT)))
- | 0 => SOME (HOLogic.mk_Trueprop @{term True})
- | 1 => SOME (HOLogic.mk_Trueprop @{term False})
+ ~1 => SOME (HOLogic.mk_Trueprop (Const (\<^const_name>\<open>undefined\<close>, HOLogic.boolT)))
+ | 0 => SOME (HOLogic.mk_Trueprop \<^term>\<open>True\<close>)
+ | 1 => SOME (HOLogic.mk_Trueprop \<^term>\<open>False\<close>)
| _ => raise REFUTE ("stlc_interpreter",
"illegal interpretation for a propositional value"))
| Type _ =>
if index_from_interpretation intr = (~1) then
- SOME (Const (@{const_name undefined}, T))
+ SOME (Const (\<^const_name>\<open>undefined\<close>, T))
else
SOME (Const (string_of_typ T ^
string_of_int (index_from_interpretation intr), T))
| TFree _ =>
if index_from_interpretation intr = (~1) then
- SOME (Const (@{const_name undefined}, T))
+ SOME (Const (\<^const_name>\<open>undefined\<close>, T))
else
SOME (Const (string_of_typ T ^
string_of_int (index_from_interpretation intr), T))
| TVar _ =>
if index_from_interpretation intr = (~1) then
- SOME (Const (@{const_name undefined}, T))
+ SOME (Const (\<^const_name>\<open>undefined\<close>, T))
else
SOME (Const (string_of_typ T ^
string_of_int (index_from_interpretation intr), T))
@@ -2794,7 +2794,7 @@
fun set_printer ctxt model T intr assignment =
(case T of
- Type (@{type_name set}, [T1]) =>
+ Type (\<^type_name>\<open>set\<close>, [T1]) =>
let
(* create all constants of type 'T1' *)
val constants = make_constants ctxt model T1
@@ -2814,9 +2814,9 @@
"illegal interpretation for a Boolean value"))
(constants ~~ results)
val HOLogic_setT1 = HOLogic.mk_setT T1
- val HOLogic_empty_set = Const (@{const_abbrev Set.empty}, HOLogic_setT1)
+ val HOLogic_empty_set = Const (\<^const_abbrev>\<open>Set.empty\<close>, HOLogic_setT1)
val HOLogic_insert =
- Const (@{const_name insert}, T1 --> HOLogic_setT1 --> HOLogic_setT1)
+ Const (\<^const_name>\<open>insert\<close>, T1 --> HOLogic_setT1 --> HOLogic_setT1)
in
SOME (Library.foldl (fn (acc, elem) => HOLogic_insert $ elem $ acc)
(HOLogic_empty_set, elements))
@@ -2854,7 +2854,7 @@
"interpretation is not a leaf"))
in
if element < 0 then
- SOME (Const (@{const_name undefined}, Type (s, Ts)))
+ SOME (Const (\<^const_name>\<open>undefined\<close>, Type (s, Ts)))
else
let
(* takes a datatype constructor, and if for some arguments this *)
@@ -2956,14 +2956,14 @@
(*optional list of arguments of the form [name1=value1, name2=value2, ...]*)
-val scan_parm = Parse.name -- (Scan.optional (@{keyword "="} |-- Parse.name) "true")
-val scan_parms = Scan.optional (@{keyword "["} |-- Parse.list scan_parm --| @{keyword "]"}) [];
+val scan_parm = Parse.name -- (Scan.optional (\<^keyword>\<open>=\<close> |-- Parse.name) "true")
+val scan_parms = Scan.optional (\<^keyword>\<open>[\<close> |-- Parse.list scan_parm --| \<^keyword>\<open>]\<close>) [];
(* 'refute' command *)
val _ =
- Outer_Syntax.command @{command_keyword refute}
+ Outer_Syntax.command \<^command_keyword>\<open>refute\<close>
"try to find a model that refutes a given subgoal"
(scan_parms -- Scan.optional Parse.nat 1 >>
(fn (parms, i) =>
@@ -2977,7 +2977,7 @@
(* 'refute_params' command *)
val _ =
- Outer_Syntax.command @{command_keyword refute_params}
+ Outer_Syntax.command \<^command_keyword>\<open>refute_params\<close>
"show/store default parameters for the 'refute' command"
(scan_parms >> (fn parms =>
Toplevel.theory (fn thy =>
--- a/src/HOL/Library/rewrite.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/rewrite.ML Fri Jan 04 23:22:53 2019 +0100
@@ -68,13 +68,13 @@
fun is_hole (Var ((name, _), _)) = (name = holeN)
| is_hole _ = false
-fun is_hole_const (Const (@{const_name rewrite_HOLE}, _)) = true
+fun is_hole_const (Const (\<^const_name>\<open>rewrite_HOLE\<close>, _)) = true
| is_hole_const _ = false
val hole_syntax =
let
(* Modified variant of Term.replace_hole *)
- fun replace_hole Ts (Const (@{const_name rewrite_HOLE}, T)) i =
+ fun replace_hole Ts (Const (\<^const_name>\<open>rewrite_HOLE\<close>, T)) i =
(list_comb (mk_hole i (Ts ---> T), map_range Bound (length Ts)), i + 1)
| replace_hole Ts (Abs (x, T, t)) i =
let val (t', i') = replace_hole (T :: Ts) t i
@@ -161,14 +161,14 @@
fun params_pconv cv ctxt tytenv ct =
let val pconv =
case Thm.term_of ct of
- Const (@{const_name "Pure.all"}, _) $ Abs _ => (raw_arg_pconv o raw_abs_pconv) (fn _ => params_pconv cv)
- | Const (@{const_name "Pure.all"}, _) => raw_arg_pconv (params_pconv cv)
+ Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs _ => (raw_arg_pconv o raw_abs_pconv) (fn _ => params_pconv cv)
+ | Const (\<^const_name>\<open>Pure.all\<close>, _) => raw_arg_pconv (params_pconv cv)
| _ => cv
in pconv ctxt tytenv ct end
fun forall_pconv cv ident ctxt tytenv ct =
case Thm.term_of ct of
- Const (@{const_name "Pure.all"}, T) $ _ =>
+ Const (\<^const_name>\<open>Pure.all\<close>, T) $ _ =>
let
val def_U = T |> dest_funT |> fst |> dest_funT |> fst
val ident' = apsnd (the_default (def_U)) ident
@@ -179,7 +179,7 @@
fun for_pconv cv idents ctxt tytenv ct =
let
- fun f rev_idents (Const (@{const_name "Pure.all"}, _) $ t) =
+ fun f rev_idents (Const (\<^const_name>\<open>Pure.all\<close>, _) $ t) =
let val (rev_idents', cv') = f rev_idents (case t of Abs (_,_,u) => u | _ => t)
in
case rev_idents' of
@@ -195,17 +195,17 @@
fun concl_pconv cv ctxt tytenv ct =
case Thm.term_of ct of
- (Const (@{const_name "Pure.imp"}, _) $ _) $ _ => imp_pconv (concl_pconv cv) ctxt tytenv ct
+ (Const (\<^const_name>\<open>Pure.imp\<close>, _) $ _) $ _ => imp_pconv (concl_pconv cv) ctxt tytenv ct
| _ => cv ctxt tytenv ct
fun asm_pconv cv ctxt tytenv ct =
case Thm.term_of ct of
- (Const (@{const_name "Pure.imp"}, _) $ _) $ _ => CConv.with_prems_cconv ~1 (cv ctxt tytenv) ct
+ (Const (\<^const_name>\<open>Pure.imp\<close>, _) $ _) $ _ => CConv.with_prems_cconv ~1 (cv ctxt tytenv) ct
| t => raise TERM ("asm_pconv", [t])
fun asms_pconv cv ctxt tytenv ct =
case Thm.term_of ct of
- (Const (@{const_name "Pure.imp"}, _) $ _) $ _ =>
+ (Const (\<^const_name>\<open>Pure.imp\<close>, _) $ _) $ _ =>
((CConv.with_prems_cconv ~1 oo cv) else_pconv imp_pconv (asms_pconv cv)) ctxt tytenv ct
| t => raise TERM ("asms_pconv", [t])
@@ -445,7 +445,7 @@
let val scan = raw_pattern -- to_parser -- Parse.thms1
in context_lift scan prep_args end
in
- Method.setup @{binding rewrite} (subst_parser >>
+ Method.setup \<^binding>\<open>rewrite\<close> (subst_parser >>
(fn (pattern, inthms, (to, pat_ctxt)) => fn orig_ctxt =>
SIMPLE_METHOD' (rewrite_export_tac orig_ctxt ((pattern, to), SOME pat_ctxt) inthms)))
"single-step rewriting, allowing subterm selection via patterns."
--- a/src/HOL/Library/simps_case_conv.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Library/simps_case_conv.ML Fri Jan 04 23:22:53 2019 +0100
@@ -64,7 +64,7 @@
let
val is_free_eq_imp = is_Free o fst o HOLogic.dest_eq o fst o HOLogic.dest_imp
val get_conjs = HOLogic.dest_conj o HOLogic.dest_Trueprop
- fun dest_alls (Const (@{const_name All}, _) $ Abs (_, _, t)) = dest_alls t
+ fun dest_alls (Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, _, t)) = dest_alls t
| dest_alls t = t
in forall (is_free_eq_imp o dest_alls) (get_conjs t) end
handle TERM _ => false
@@ -132,15 +132,15 @@
end
val _ =
- Outer_Syntax.local_theory @{command_keyword case_of_simps}
+ Outer_Syntax.local_theory \<^command_keyword>\<open>case_of_simps\<close>
"turn a list of equations into a case expression"
(Parse_Spec.opt_thm_name ":" -- Parse.thms1 >> case_of_simps_cmd)
-val parse_splits = @{keyword "("} |-- Parse.reserved "splits" |-- @{keyword ":"} |--
- Parse.thms1 --| @{keyword ")"}
+val parse_splits = \<^keyword>\<open>(\<close> |-- Parse.reserved "splits" |-- \<^keyword>\<open>:\<close> |--
+ Parse.thms1 --| \<^keyword>\<open>)\<close>
val _ =
- Outer_Syntax.local_theory @{command_keyword simps_of_case}
+ Outer_Syntax.local_theory \<^command_keyword>\<open>simps_of_case\<close>
"perform case split on rule"
(Parse_Spec.opt_thm_name ":" -- Parse.thm --
Scan.optional parse_splits [] >> simps_of_case_cmd)
--- a/src/HOL/Limits.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Limits.thy Fri Jan 04 23:22:53 2019 +0100
@@ -1292,11 +1292,11 @@
qed
-subsection \<open>Relate @{const at}, @{const at_left} and @{const at_right}\<close>
+subsection \<open>Relate \<^const>\<open>at\<close>, \<^const>\<open>at_left\<close> and \<^const>\<open>at_right\<close>\<close>
text \<open>
- This lemmas are useful for conversion between @{term "at x"} to @{term "at_left x"} and
- @{term "at_right x"} and also @{term "at_right 0"}.
+ This lemmas are useful for conversion between \<^term>\<open>at x\<close> to \<^term>\<open>at_left x\<close> and
+ \<^term>\<open>at_right x\<close> and also \<^term>\<open>at_right 0\<close>.
\<close>
lemmas filterlim_split_at_real = filterlim_split_at[where 'a=real]
@@ -2060,13 +2060,13 @@
apply (rule filterlim_compose[OF tendsto_inverse_0])
by (metis assms eventually_at_top_linorderI filterlim_at_top_dense filterlim_at_top_imp_at_infinity)
-text \<open>The sequence @{term "1/n"} tends to 0 as @{term n} tends to infinity.\<close>
+text \<open>The sequence \<^term>\<open>1/n\<close> tends to 0 as \<^term>\<open>n\<close> tends to infinity.\<close>
lemma LIMSEQ_inverse_real_of_nat: "(\<lambda>n. inverse (real (Suc n))) \<longlonglongrightarrow> 0"
by (metis filterlim_compose tendsto_inverse_0 filterlim_mono order_refl filterlim_Suc
filterlim_compose[OF filterlim_real_sequentially] at_top_le_at_infinity)
text \<open>
- The sequence @{term "r + 1/n"} tends to @{term r} as @{term n} tends to
+ The sequence \<^term>\<open>r + 1/n\<close> tends to \<^term>\<open>r\<close> as \<^term>\<open>n\<close> tends to
infinity is now easily proved.
\<close>
@@ -2389,7 +2389,7 @@
by eventually_elim (auto simp: N)
qed
-text \<open>Limit of @{term "c^n"} for @{term"\<bar>c\<bar> < 1"}.\<close>
+text \<open>Limit of \<^term>\<open>c^n\<close> for \<^term>\<open>\<bar>c\<bar> < 1\<close>.\<close>
lemma LIMSEQ_abs_realpow_zero: "\<bar>c\<bar> < 1 \<Longrightarrow> (\<lambda>n. \<bar>c\<bar> ^ n :: real) \<longlonglongrightarrow> 0"
by (rule LIMSEQ_realpow_zero [OF abs_ge_zero])
--- a/src/HOL/List.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/List.thy Fri Jan 04 23:22:53 2019 +0100
@@ -182,7 +182,7 @@
"find P (x#xs) = (if P x then Some x else find P xs)"
text \<open>In the context of multisets, \<open>count_list\<close> is equivalent to
- @{term "count \<circ> mset"} and it it advisable to use the latter.\<close>
+ \<^term>\<open>count \<circ> mset\<close> and it it advisable to use the latter.\<close>
primrec count_list :: "'a list \<Rightarrow> 'a \<Rightarrow> nat" where
"count_list [] y = 0" |
"count_list (x#xs) y = (if x=y then count_list xs y + 1 else count_list xs y)"
@@ -273,7 +273,7 @@
by pat_completeness simp_all
termination by lexicographic_order
-text\<open>Use only if you cannot use @{const Min} instead:\<close>
+text\<open>Use only if you cannot use \<^const>\<open>Min\<close> instead:\<close>
fun min_list :: "'a::ord list \<Rightarrow> 'a" where
"min_list (x # xs) = (case xs of [] \<Rightarrow> x | _ \<Rightarrow> min x (min_list xs))"
@@ -416,7 +416,7 @@
Just like in Haskell, list comprehension is just a shorthand. To avoid
misunderstandings, the translation into desugared form is not reversed
upon output. Note that the translation of \<open>[e. x \<leftarrow> xs]\<close> is
-optmized to @{term"map (%x. e) xs"}.
+optmized to \<^term>\<open>map (%x. e) xs\<close>.
It is easy to write short list comprehensions which stand for complex
expressions. During proofs, they may become unreadable (and
@@ -438,12 +438,12 @@
parse_translation \<open>
let
- val NilC = Syntax.const @{const_syntax Nil};
- val ConsC = Syntax.const @{const_syntax Cons};
- val mapC = Syntax.const @{const_syntax map};
- val concatC = Syntax.const @{const_syntax concat};
- val IfC = Syntax.const @{const_syntax If};
- val dummyC = Syntax.const @{const_syntax Pure.dummy_pattern}
+ val NilC = Syntax.const \<^const_syntax>\<open>Nil\<close>;
+ val ConsC = Syntax.const \<^const_syntax>\<open>Cons\<close>;
+ val mapC = Syntax.const \<^const_syntax>\<open>map\<close>;
+ val concatC = Syntax.const \<^const_syntax>\<open>concat\<close>;
+ val IfC = Syntax.const \<^const_syntax>\<open>If\<close>;
+ val dummyC = Syntax.const \<^const_syntax>\<open>Pure.dummy_pattern\<close>
fun single x = ConsC $ x $ NilC;
@@ -453,18 +453,18 @@
val x =
Free (singleton (Name.variant_list (fold Term.add_free_names [p, e] [])) "x", dummyT);
val e = if opti then single e else e;
- val case1 = Syntax.const @{syntax_const "_case1"} $ p $ e;
+ val case1 = Syntax.const \<^syntax_const>\<open>_case1\<close> $ p $ e;
val case2 =
- Syntax.const @{syntax_const "_case1"} $ dummyC $ NilC;
- val cs = Syntax.const @{syntax_const "_case2"} $ case1 $ case2;
+ Syntax.const \<^syntax_const>\<open>_case1\<close> $ dummyC $ NilC;
+ val cs = Syntax.const \<^syntax_const>\<open>_case2\<close> $ case1 $ case2;
in Syntax_Trans.abs_tr [x, Case_Translation.case_tr false ctxt [x, cs]] end;
fun pair_pat_tr (x as Free _) e = Syntax_Trans.abs_tr [x, e]
| pair_pat_tr (_ $ p1 $ p2) e =
- Syntax.const @{const_syntax case_prod} $ pair_pat_tr p1 (pair_pat_tr p2 e)
+ Syntax.const \<^const_syntax>\<open>case_prod\<close> $ pair_pat_tr p1 (pair_pat_tr p2 e)
| pair_pat_tr dummy e = Syntax_Trans.abs_tr [Syntax.const "_idtdummy", e]
- fun pair_pat ctxt (Const (@{const_syntax "Pair"},_) $ s $ t) =
+ fun pair_pat ctxt (Const (\<^const_syntax>\<open>Pair\<close>,_) $ s $ t) =
pair_pat ctxt s andalso pair_pat ctxt t
| pair_pat ctxt (Free (s,_)) =
let
@@ -480,31 +480,31 @@
else (pat_tr ctxt p e opti, false)
end
- fun lc_tr ctxt [e, Const (@{syntax_const "_lc_test"}, _) $ b, qs] =
+ fun lc_tr ctxt [e, Const (\<^syntax_const>\<open>_lc_test\<close>, _) $ b, qs] =
let
val res =
(case qs of
- Const (@{syntax_const "_lc_end"}, _) => single e
- | Const (@{syntax_const "_lc_quals"}, _) $ q $ qs => lc_tr ctxt [e, q, qs]);
+ Const (\<^syntax_const>\<open>_lc_end\<close>, _) => single e
+ | Const (\<^syntax_const>\<open>_lc_quals\<close>, _) $ q $ qs => lc_tr ctxt [e, q, qs]);
in IfC $ b $ res $ NilC end
| lc_tr ctxt
- [e, Const (@{syntax_const "_lc_gen"}, _) $ p $ es,
- Const(@{syntax_const "_lc_end"}, _)] =
+ [e, Const (\<^syntax_const>\<open>_lc_gen\<close>, _) $ p $ es,
+ Const(\<^syntax_const>\<open>_lc_end\<close>, _)] =
(case abs_tr ctxt p e true of
(f, true) => mapC $ f $ es
| (f, false) => concatC $ (mapC $ f $ es))
| lc_tr ctxt
- [e, Const (@{syntax_const "_lc_gen"}, _) $ p $ es,
- Const (@{syntax_const "_lc_quals"}, _) $ q $ qs] =
+ [e, Const (\<^syntax_const>\<open>_lc_gen\<close>, _) $ p $ es,
+ Const (\<^syntax_const>\<open>_lc_quals\<close>, _) $ q $ qs] =
let val e' = lc_tr ctxt [e, q, qs];
in concatC $ (mapC $ (fst (abs_tr ctxt p e' false)) $ es) end;
-in [(@{syntax_const "_listcompr"}, lc_tr)] end
+in [(\<^syntax_const>\<open>_listcompr\<close>, lc_tr)] end
\<close>
ML_val \<open>
let
- val read = Syntax.read_term @{context} o Syntax.implode_input;
+ val read = Syntax.read_term \<^context> o Syntax.implode_input;
fun check s1 s2 =
read s1 aconv read s2 orelse
error ("Check failed: " ^
@@ -555,19 +555,19 @@
fun all_exists_conv cv ctxt ct =
(case Thm.term_of ct of
- Const (@{const_name Ex}, _) $ Abs _ =>
+ Const (\<^const_name>\<open>Ex\<close>, _) $ Abs _ =>
Conv.arg_conv (Conv.abs_conv (all_exists_conv cv o #2) ctxt) ct
| _ => cv ctxt ct)
fun all_but_last_exists_conv cv ctxt ct =
(case Thm.term_of ct of
- Const (@{const_name Ex}, _) $ Abs (_, _, Const (@{const_name Ex}, _) $ _) =>
+ Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (_, _, Const (\<^const_name>\<open>Ex\<close>, _) $ _) =>
Conv.arg_conv (Conv.abs_conv (all_but_last_exists_conv cv o #2) ctxt) ct
| _ => cv ctxt ct)
fun Collect_conv cv ctxt ct =
(case Thm.term_of ct of
- Const (@{const_name Collect}, _) $ Abs _ => Conv.arg_conv (Conv.abs_conv cv ctxt) ct
+ Const (\<^const_name>\<open>Collect\<close>, _) $ Abs _ => Conv.arg_conv (Conv.abs_conv cv ctxt) ct
| _ => raise CTERM ("Collect_conv", [ct]))
fun rewr_conv' th = Conv.rewr_conv (mk_meta_eq th)
@@ -592,10 +592,10 @@
val inst_Collect_mem_eq = @{lemma "set A = {x. x \<in> set A}" by simp}
val del_refl_eq = @{lemma "(t = t \<and> P) \<equiv> P" by simp}
-fun mk_set T = Const (@{const_name set}, HOLogic.listT T --> HOLogic.mk_setT T)
-fun dest_set (Const (@{const_name set}, _) $ xs) = xs
-
-fun dest_singleton_list (Const (@{const_name Cons}, _) $ t $ (Const (@{const_name Nil}, _))) = t
+fun mk_set T = Const (\<^const_name>\<open>set\<close>, HOLogic.listT T --> HOLogic.mk_setT T)
+fun dest_set (Const (\<^const_name>\<open>set\<close>, _) $ xs) = xs
+
+fun dest_singleton_list (Const (\<^const_name>\<open>Cons\<close>, _) $ t $ (Const (\<^const_name>\<open>Nil\<close>, _))) = t
| dest_singleton_list t = raise TERM ("dest_singleton_list", [t])
(*We check that one case returns a singleton list and all other cases
@@ -604,14 +604,14 @@
let
fun check (i, case_t) s =
(case strip_abs_body case_t of
- (Const (@{const_name Nil}, _)) => s
+ (Const (\<^const_name>\<open>Nil\<close>, _)) => s
| _ => (case s of SOME NONE => SOME (SOME i) | _ => NONE))
in
fold_index check cases (SOME NONE) |> the_default NONE
end
(*returns condition continuing term option*)
-fun dest_if (Const (@{const_name If}, _) $ cond $ then_t $ Const (@{const_name Nil}, _)) =
+fun dest_if (Const (\<^const_name>\<open>If\<close>, _) $ cond $ then_t $ Const (\<^const_name>\<open>Nil\<close>, _)) =
SOME (cond, then_t)
| dest_if _ = NONE
@@ -717,7 +717,7 @@
val constr_t =
list_comb
(Const (constr_name, map snd vs ---> T), map Bound (((length vs) - 1) downto 0))
- val constr_eq = Const (@{const_name HOL.eq}, T --> T --> @{typ bool}) $ constr_t $ x'
+ val constr_eq = Const (\<^const_name>\<open>HOL.eq\<close>, T --> T --> \<^typ>\<open>bool\<close>) $ constr_t $ x'
in
make_inner_eqs (rev vs @ bound_vs) (Case (T, i) :: Tis) (constr_eq :: eqs') body
end
@@ -728,14 +728,14 @@
if null eqs then NONE (*no rewriting, nothing to be done*)
else
let
- val Type (@{type_name list}, [rT]) = fastype_of1 (map snd bound_vs, t)
+ val Type (\<^type_name>\<open>list\<close>, [rT]) = fastype_of1 (map snd bound_vs, t)
val pat_eq =
(case try dest_singleton_list t of
SOME t' =>
- Const (@{const_name HOL.eq}, rT --> rT --> @{typ bool}) $
+ Const (\<^const_name>\<open>HOL.eq\<close>, rT --> rT --> \<^typ>\<open>bool\<close>) $
Bound (length bound_vs) $ t'
| NONE =>
- Const (@{const_name Set.member}, rT --> HOLogic.mk_setT rT --> @{typ bool}) $
+ Const (\<^const_name>\<open>Set.member\<close>, rT --> HOLogic.mk_setT rT --> \<^typ>\<open>bool\<close>) $
Bound (length bound_vs) $ (mk_set rT $ t))
val reverse_bounds = curry subst_bounds
((map Bound ((length bound_vs - 1) downto 0)) @ [Bound (length bound_vs)])
@@ -768,7 +768,7 @@
hide_const (open) coset
-subsubsection \<open>@{const Nil} and @{const Cons}\<close>
+subsubsection \<open>\<^const>\<open>Nil\<close> and \<^const>\<open>Cons\<close>\<close>
lemma not_Cons_self [simp]:
"xs \<noteq> x # xs"
@@ -804,7 +804,7 @@
lemma inj_on_Cons1 [simp]: "inj_on ((#) x) A"
by(simp add: inj_on_def)
-subsubsection \<open>@{const length}\<close>
+subsubsection \<open>\<^const>\<open>length\<close>\<close>
text \<open>
Needs to come before \<open>@\<close> because of theorem \<open>append_eq_append_conv\<close>.
@@ -900,14 +900,14 @@
let
-fun len (Const(@{const_name Nil},_)) acc = acc
- | len (Const(@{const_name Cons},_) $ _ $ xs) (ts,n) = len xs (ts,n+1)
- | len (Const(@{const_name append},_) $ xs $ ys) acc = len xs (len ys acc)
- | len (Const(@{const_name rev},_) $ xs) acc = len xs acc
- | len (Const(@{const_name map},_) $ _ $ xs) acc = len xs acc
+fun len (Const(\<^const_name>\<open>Nil\<close>,_)) acc = acc
+ | len (Const(\<^const_name>\<open>Cons\<close>,_) $ _ $ xs) (ts,n) = len xs (ts,n+1)
+ | len (Const(\<^const_name>\<open>append\<close>,_) $ xs $ ys) acc = len xs (len ys acc)
+ | len (Const(\<^const_name>\<open>rev\<close>,_) $ xs) acc = len xs acc
+ | len (Const(\<^const_name>\<open>map\<close>,_) $ _ $ xs) acc = len xs acc
| len t (ts,n) = (t::ts,n);
-val ss = simpset_of @{context};
+val ss = simpset_of \<^context>;
fun list_neq ctxt ct =
let
@@ -1042,21 +1042,21 @@
simproc_setup list_eq ("(xs::'a list) = ys") = \<open>
let
- fun last (cons as Const (@{const_name Cons}, _) $ _ $ xs) =
- (case xs of Const (@{const_name Nil}, _) => cons | _ => last xs)
- | last (Const(@{const_name append},_) $ _ $ ys) = last ys
+ fun last (cons as Const (\<^const_name>\<open>Cons\<close>, _) $ _ $ xs) =
+ (case xs of Const (\<^const_name>\<open>Nil\<close>, _) => cons | _ => last xs)
+ | last (Const(\<^const_name>\<open>append\<close>,_) $ _ $ ys) = last ys
| last t = t;
- fun list1 (Const(@{const_name Cons},_) $ _ $ Const(@{const_name Nil},_)) = true
+ fun list1 (Const(\<^const_name>\<open>Cons\<close>,_) $ _ $ Const(\<^const_name>\<open>Nil\<close>,_)) = true
| list1 _ = false;
- fun butlast ((cons as Const(@{const_name Cons},_) $ x) $ xs) =
- (case xs of Const (@{const_name Nil}, _) => xs | _ => cons $ butlast xs)
- | butlast ((app as Const (@{const_name append}, _) $ xs) $ ys) = app $ butlast ys
- | butlast xs = Const(@{const_name Nil}, fastype_of xs);
+ fun butlast ((cons as Const(\<^const_name>\<open>Cons\<close>,_) $ x) $ xs) =
+ (case xs of Const (\<^const_name>\<open>Nil\<close>, _) => xs | _ => cons $ butlast xs)
+ | butlast ((app as Const (\<^const_name>\<open>append\<close>, _) $ xs) $ ys) = app $ butlast ys
+ | butlast xs = Const(\<^const_name>\<open>Nil\<close>, fastype_of xs);
val rearr_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps [@{thm append_assoc}, @{thm append_Nil}, @{thm append_Cons}]);
fun list_eq ctxt (F as (eq as Const(_,eqT)) $ lhs $ rhs) =
@@ -1067,7 +1067,7 @@
val lhs1 = butlast lhs and rhs1 = butlast rhs;
val Type(_,listT::_) = eqT
val appT = [listT,listT] ---> listT
- val app = Const(@{const_name append},appT)
+ val app = Const(\<^const_name>\<open>append\<close>,appT)
val F2 = eq $ (app$lhs1$lastl) $ (app$rhs1$lastr)
val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (F,F2));
val thm = Goal.prove ctxt [] [] eq
@@ -1082,7 +1082,7 @@
\<close>
-subsubsection \<open>@{const map}\<close>
+subsubsection \<open>\<^const>\<open>map\<close>\<close>
lemma hd_map: "xs \<noteq> [] \<Longrightarrow> hd (map f xs) = f (hd xs)"
by (cases xs) simp_all
@@ -1214,7 +1214,7 @@
declare map.id [simp]
-subsubsection \<open>@{const rev}\<close>
+subsubsection \<open>\<^const>\<open>rev\<close>\<close>
lemma rev_append [simp]: "rev (xs @ ys) = rev ys @ rev xs"
by (induct xs) auto
@@ -1277,7 +1277,7 @@
by(rule rev_cases[of xs]) auto
-subsubsection \<open>@{const set}\<close>
+subsubsection \<open>\<^const>\<open>set\<close>\<close>
declare list.set[code_post] \<comment> \<open>pretty output\<close>
@@ -1445,7 +1445,7 @@
by(auto simp: append_eq_Cons_conv Cons_eq_append_conv append_eq_append_conv2)
-subsubsection \<open>@{const filter}\<close>
+subsubsection \<open>\<^const>\<open>filter\<close>\<close>
lemma filter_append [simp]: "filter P (xs @ ys) = filter P xs @ filter P ys"
by (induct xs) auto
@@ -1626,7 +1626,7 @@
declare partition.simps[simp del]
-subsubsection \<open>@{const concat}\<close>
+subsubsection \<open>\<^const>\<open>concat\<close>\<close>
lemma concat_append [simp]: "concat (xs @ ys) = concat xs @ concat ys"
by (induct xs) auto
@@ -1662,7 +1662,7 @@
by (simp add: concat_eq_concat_iff)
-subsubsection \<open>@{const nth}\<close>
+subsubsection \<open>\<^const>\<open>nth\<close>\<close>
lemma nth_Cons_0 [simp, code]: "(x # xs)!0 = x"
by auto
@@ -1814,7 +1814,7 @@
qed
-subsubsection \<open>@{const list_update}\<close>
+subsubsection \<open>\<^const>\<open>list_update\<close>\<close>
lemma length_list_update [simp]: "length(xs[i:=x]) = length xs"
by (induct xs arbitrary: i) (auto split: nat.split)
@@ -1894,7 +1894,7 @@
by simp_all
-subsubsection \<open>@{const last} and @{const butlast}\<close>
+subsubsection \<open>\<^const>\<open>last\<close> and \<^const>\<open>butlast\<close>\<close>
lemma last_snoc [simp]: "last (xs @ [x]) = x"
by (induct xs) auto
@@ -1994,7 +1994,7 @@
unfolding rev_swap rev_append by (metis last_rev rev_is_Nil_conv)
-subsubsection \<open>@{const take} and @{const drop}\<close>
+subsubsection \<open>\<^const>\<open>take\<close> and \<^const>\<open>drop\<close>\<close>
lemma take_0: "take 0 xs = []"
by (induct xs) auto
@@ -2267,7 +2267,7 @@
by(auto simp: set_conv_nth image_def) (metis Suc_le_eq nth_take order_trans)
-subsubsection \<open>@{const takeWhile} and @{const dropWhile}\<close>
+subsubsection \<open>\<^const>\<open>takeWhile\<close> and \<^const>\<open>dropWhile\<close>\<close>
lemma length_takeWhile_le: "length (takeWhile P xs) \<le> length xs"
by (induct xs) auto
@@ -2441,7 +2441,7 @@
by (induct xs) auto
-subsubsection \<open>@{const zip}\<close>
+subsubsection \<open>\<^const>\<open>zip\<close>\<close>
lemma zip_Nil [simp]: "zip [] ys = []"
by (induct ys) auto
@@ -2635,7 +2635,7 @@
qed
-subsubsection \<open>@{const list_all2}\<close>
+subsubsection \<open>\<^const>\<open>list_all2\<close>\<close>
lemma list_all2_lengthD [intro?]:
"list_all2 P xs ys ==> length xs = length ys"
@@ -2816,7 +2816,7 @@
lemma zip_replicate2: "zip xs (replicate n y) = map (\<lambda>x. (x, y)) (take n xs)"
by(subst zip_commute)(simp add: zip_replicate1)
-subsubsection \<open>@{const List.product} and @{const product_lists}\<close>
+subsubsection \<open>\<^const>\<open>List.product\<close> and \<^const>\<open>product_lists\<close>\<close>
lemma product_concat_map:
"List.product xs ys = concat (map (\<lambda>x. map (\<lambda>y. (x,y)) ys) xs)"
@@ -2857,7 +2857,7 @@
qed
-subsubsection \<open>@{const fold} with natural argument order\<close>
+subsubsection \<open>\<^const>\<open>fold\<close> with natural argument order\<close>
lemma fold_simps [code]: \<comment> \<open>eta-expanded variant for generated code -- enables tail-recursion optimisation in Scala\<close>
"fold f [] s = s"
@@ -2919,7 +2919,7 @@
lemma fold_append_concat_rev: "fold append xss = append (concat (rev xss))"
by (induct xss) simp_all
-text \<open>@{const Finite_Set.fold} and @{const fold}\<close>
+text \<open>\<^const>\<open>Finite_Set.fold\<close> and \<^const>\<open>fold\<close>\<close>
lemma (in comp_fun_commute) fold_set_fold_remdups:
"Finite_Set.fold f y (set xs) = fold f (remdups xs) y"
@@ -2997,7 +2997,7 @@
using Sup_set_fold [of "map f xs"] by (simp add: fold_map)
-subsubsection \<open>Fold variants: @{const foldr} and @{const foldl}\<close>
+subsubsection \<open>Fold variants: \<^const>\<open>foldr\<close> and \<^const>\<open>foldl\<close>\<close>
text \<open>Correspondence\<close>
@@ -3050,7 +3050,7 @@
by (simp add: fold_append_concat_rev foldr_conv_fold)
-subsubsection \<open>@{const upt}\<close>
+subsubsection \<open>\<^const>\<open>upt\<close>\<close>
lemma upt_rec[code]: "[i..<j] = (if i<j then i#[Suc i..<j] else [])"
\<comment> \<open>simp does not terminate!\<close>
@@ -3186,7 +3186,7 @@
by (simp add: nth_Cons')
-subsubsection \<open>\<open>upto\<close>: interval-list on @{typ int}\<close>
+subsubsection \<open>\<open>upto\<close>: interval-list on \<^typ>\<open>int\<close>\<close>
function upto :: "int \<Rightarrow> int \<Rightarrow> int list" ("(1[_../_])") where
"upto i j = (if i \<le> j then i # [i+1..j] else [])"
@@ -3270,7 +3270,7 @@
by(simp add: upto_aux_def)
-subsubsection \<open>@{const distinct} and @{const remdups} and @{const remdups_adj}\<close>
+subsubsection \<open>\<^const>\<open>distinct\<close> and \<^const>\<open>remdups\<close> and \<^const>\<open>remdups_adj\<close>\<close>
lemma distinct_tl: "distinct xs \<Longrightarrow> distinct (tl xs)"
by (cases xs) simp_all
@@ -3793,7 +3793,7 @@
qed
-subsubsection \<open>@{const insert}\<close>
+subsubsection \<open>\<^const>\<open>insert\<close>\<close>
lemma in_set_insert [simp]:
"x \<in> set xs \<Longrightarrow> List.insert x xs = xs"
@@ -3817,7 +3817,7 @@
by (simp add: List.insert_def)
-subsubsection \<open>@{const List.union}\<close>
+subsubsection \<open>\<^const>\<open>List.union\<close>\<close>
text\<open>This is all one should need to know about union:\<close>
lemma set_union[simp]: "set (List.union xs ys) = set xs \<union> set ys"
@@ -3829,7 +3829,7 @@
by(induct xs arbitrary: ys) simp_all
-subsubsection \<open>@{const List.find}\<close>
+subsubsection \<open>\<^const>\<open>List.find\<close>\<close>
lemma find_None_iff: "List.find P xs = None \<longleftrightarrow> \<not> (\<exists>x. x \<in> set xs \<and> P x)"
proof (induction xs)
@@ -3868,7 +3868,7 @@
by (induct xs) simp_all
-subsubsection \<open>@{const count_list}\<close>
+subsubsection \<open>\<^const>\<open>count_list\<close>\<close>
lemma count_notin[simp]: "x \<notin> set xs \<Longrightarrow> count_list xs x = 0"
by (induction xs) auto
@@ -3886,7 +3886,7 @@
qed simp
-subsubsection \<open>@{const List.extract}\<close>
+subsubsection \<open>\<^const>\<open>List.extract\<close>\<close>
lemma extract_None_iff: "List.extract P xs = None \<longleftrightarrow> \<not> (\<exists> x\<in>set xs. P x)"
by(auto simp: extract_def dropWhile_eq_Cons_conv split: list.splits)
@@ -3914,7 +3914,7 @@
(metis dropWhile_eq_Nil_conv list.distinct(1))
-subsubsection \<open>@{const remove1}\<close>
+subsubsection \<open>\<^const>\<open>remove1\<close>\<close>
lemma remove1_append:
"remove1 x (xs @ ys) =
@@ -3960,7 +3960,7 @@
by (induct xs) simp_all
-subsubsection \<open>@{const removeAll}\<close>
+subsubsection \<open>\<^const>\<open>removeAll\<close>\<close>
lemma removeAll_filter_not_eq:
"removeAll x = filter (\<lambda>y. x \<noteq> y)"
@@ -4014,7 +4014,7 @@
by (auto dest: length_filter_less simp add: removeAll_filter_not_eq)
-subsubsection \<open>@{const replicate}\<close>
+subsubsection \<open>\<^const>\<open>replicate\<close>\<close>
lemma length_replicate [simp]: "length (replicate n x) = n"
by (induct n) auto
@@ -4218,7 +4218,7 @@
by (subst foldr_fold [symmetric]) simp_all
-subsubsection \<open>@{const enumerate}\<close>
+subsubsection \<open>\<^const>\<open>enumerate\<close>\<close>
lemma enumerate_simps [simp, code]:
"enumerate n [] = []"
@@ -4276,7 +4276,7 @@
by (cases "n \<le> m") (simp_all add: zip_map2 zip_same_conv_map enumerate_eq_zip)
-subsubsection \<open>@{const rotate1} and @{const rotate}\<close>
+subsubsection \<open>\<^const>\<open>rotate1\<close> and \<^const>\<open>rotate\<close>\<close>
lemma rotate0[simp]: "rotate 0 = id"
by(simp add:rotate_def)
@@ -4380,7 +4380,7 @@
by (induct l arbitrary: q) (auto simp add: rotate1_rotate_swap)
-subsubsection \<open>@{const nths} --- a generalization of @{const nth} to sets\<close>
+subsubsection \<open>\<^const>\<open>nths\<close> --- a generalization of \<^const>\<open>nth\<close> to sets\<close>
lemma nths_empty [simp]: "nths xs {} = []"
by (auto simp add: nths_def)
@@ -4483,7 +4483,7 @@
qed
-subsubsection \<open>@{const subseqs} and @{const List.n_lists}\<close>
+subsubsection \<open>\<^const>\<open>subseqs\<close> and \<^const>\<open>List.n_lists\<close>\<close>
lemma length_subseqs: "length (subseqs xs) = 2 ^ length xs"
by (induct xs) (simp_all add: Let_def)
@@ -4548,7 +4548,7 @@
qed simp
-subsubsection \<open>@{const splice}\<close>
+subsubsection \<open>\<^const>\<open>splice\<close>\<close>
lemma splice_Nil2 [simp]: "splice xs [] = xs"
by (cases xs) simp_all
@@ -4564,7 +4564,7 @@
apply (auto simp add: Cons_replicate_eq dest: gr0_implies_Suc)
done
-subsubsection \<open>@{const shuffles}\<close>
+subsubsection \<open>\<^const>\<open>shuffles\<close>\<close>
lemma shuffles_commutes: "shuffles xs ys = shuffles ys xs"
by (induction xs ys rule: shuffles.induct) (simp_all add: Un_commute)
@@ -4817,7 +4817,7 @@
by (simp add: nth_transpose filter_map comp_def)
qed
-subsubsection \<open>@{const min} and @{const arg_min}\<close>
+subsubsection \<open>\<^const>\<open>min\<close> and \<^const>\<open>arg_min\<close>\<close>
lemma min_list_Min: "xs \<noteq> [] \<Longrightarrow> min_list xs = Min (set xs)"
by (induction xs rule: induct_list012)(auto)
@@ -4930,9 +4930,9 @@
subsection \<open>Sorting\<close>
-subsubsection \<open>@{const sorted_wrt}\<close>
-
-text \<open>Sometimes the second equation in the definition of @{const sorted_wrt} is too aggressive
+subsubsection \<open>\<^const>\<open>sorted_wrt\<close>\<close>
+
+text \<open>Sometimes the second equation in the definition of \<^const>\<open>sorted_wrt\<close> is too aggressive
because it relates each list element to \emph{all} its successors. Then this equation
should be removed and \<open>sorted_wrt2_simps\<close> should be added instead.\<close>
@@ -5004,12 +5004,12 @@
qed
-subsubsection \<open>@{const sorted}\<close>
+subsubsection \<open>\<^const>\<open>sorted\<close>\<close>
context linorder
begin
-text \<open>Sometimes the second equation in the definition of @{const sorted} is too aggressive
+text \<open>Sometimes the second equation in the definition of \<^const>\<open>sorted\<close> is too aggressive
because it relates each list element to \emph{all} its successors. Then this equation
should be removed and \<open>sorted2_simps\<close> should be added instead.
Executable code is one such use case.\<close>
@@ -5195,7 +5195,7 @@
subsubsection \<open>Sorting functions\<close>
-text\<open>Currently it is not shown that @{const sort} returns a
+text\<open>Currently it is not shown that \<^const>\<open>sort\<close> returns a
permutation of its input because the nicest proof is via multisets,
which are not part of Main. Alternatively one could define a function
that counts the number of occurrences of an element in a list and use
@@ -5402,7 +5402,7 @@
lemma sorted_enumerate [simp]: "sorted (map fst (enumerate n xs))"
by (simp add: enumerate_eq_zip)
-text \<open>Stability of @{const sort_key}:\<close>
+text \<open>Stability of \<^const>\<open>sort_key\<close>:\<close>
lemma sort_key_stable: "filter (\<lambda>y. f y = k) (sort_key f xs) = filter (\<lambda>y. f y = k) xs"
proof (induction xs)
@@ -5433,7 +5433,7 @@
by (metis (mono_tags) filter_True sort_key_stable)
-subsubsection \<open>@{const transpose} on sorted lists\<close>
+subsubsection \<open>\<^const>\<open>transpose\<close> on sorted lists\<close>
lemma sorted_transpose[simp]: "sorted (rev (map length (transpose xs)))"
by (auto simp: sorted_iff_nth_mono rev_nth nth_transpose
@@ -5586,7 +5586,7 @@
text\<open>This function maps (finite) linearly ordered sets to sorted
lists. Warning: in most cases it is not a good idea to convert from
sets to lists but one should convert in the other direction (via
-@{const set}).\<close>
+\<^const>\<open>set\<close>).\<close>
context linorder
begin
@@ -5757,7 +5757,7 @@
subsubsection \<open>Lists as Cartesian products\<close>
text\<open>\<open>set_Cons A Xs\<close>: the set of lists with head drawn from
-@{term A} and tail drawn from @{term Xs}.\<close>
+\<^term>\<open>A\<close> and tail drawn from \<^term>\<open>Xs\<close>.\<close>
definition set_Cons :: "'a set \<Rightarrow> 'a list set \<Rightarrow> 'a list set" where
"set_Cons A XS = {z. \<exists>x xs. z = x # xs \<and> x \<in> A \<and> xs \<in> XS}"
@@ -6498,7 +6498,7 @@
"listrel r `` {x#xs} = set_Cons (r``{x}) (listrel r `` {xs})"
by (auto simp add: set_Cons_def intro: listrel.intros)
-text \<open>Relating @{term listrel1}, @{term listrel} and closures:\<close>
+text \<open>Relating \<^term>\<open>listrel1\<close>, \<^term>\<open>listrel\<close> and closures:\<close>
lemma listrel1_rtrancl_subset_rtrancl_listrel1:
"listrel1 (r\<^sup>*) \<subseteq> (listrel1 r)\<^sup>*"
@@ -6621,7 +6621,7 @@
subsection \<open>Code generation\<close>
-text\<open>Optional tail recursive version of @{const map}. Can avoid
+text\<open>Optional tail recursive version of \<^const>\<open>map\<close>. Can avoid
stack overflow in some target languages.\<close>
fun map_tailrec_rev :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'b list" where
@@ -6647,7 +6647,7 @@
text \<open>
Use \<open>member\<close> only for generating executable code. Otherwise use
- @{prop "x \<in> set xs"} instead --- it is much easier to reason about.
+ \<^prop>\<open>x \<in> set xs\<close> instead --- it is much easier to reason about.
\<close>
lemma member_rec [code]:
@@ -6669,8 +6669,8 @@
text \<open>
Usually you should prefer \<open>\<forall>x\<in>set xs\<close>, \<open>\<exists>x\<in>set xs\<close>
- and \<open>\<exists>!x. x\<in>set xs \<and> _\<close> over @{const list_all}, @{const list_ex}
- and @{const list_ex1} in specifications.
+ and \<open>\<exists>!x. x\<in>set xs \<and> _\<close> over \<^const>\<open>list_all\<close>, \<^const>\<open>list_ex\<close>
+ and \<^const>\<open>list_ex1\<close> in specifications.
\<close>
lemma list_all_simps [code]:
@@ -6858,7 +6858,7 @@
[code_abbrev]: "null xs \<longleftrightarrow> xs = []"
text \<open>
- Efficient emptyness check is implemented by @{const null}.
+ Efficient emptyness check is implemented by \<^const>\<open>null\<close>.
\<close>
lemma null_rec [code]:
@@ -6882,7 +6882,7 @@
[code_post]: "map_filter f xs = map (the \<circ> f) (filter (\<lambda>x. f x \<noteq> None) xs)"
text \<open>
- Operations @{const maps} and @{const map_filter} avoid
+ Operations \<^const>\<open>maps\<close> and \<^const>\<open>map_filter\<close> avoid
intermediate lists on execution -- do not use for proving.
\<close>
@@ -6953,7 +6953,7 @@
"list_ex P [i..j] \<longleftrightarrow> \<not> (all_interval_int (Not \<circ> P) i j)"
by (simp add: list_ex_iff all_interval_int_def)
-text \<open>optimized code (tail-recursive) for @{term length}\<close>
+text \<open>optimized code (tail-recursive) for \<^term>\<open>length\<close>\<close>
definition gen_length :: "nat \<Rightarrow> 'a list \<Rightarrow> nat"
where "gen_length n xs = n + length xs"
@@ -6988,11 +6988,11 @@
fun implode_list t =
let
- fun dest_cons (IConst { sym = Code_Symbol.Constant @{const_name Cons}, ... } `$ t1 `$ t2) = SOME (t1, t2)
+ fun dest_cons (IConst { sym = Code_Symbol.Constant \<^const_name>\<open>Cons\<close>, ... } `$ t1 `$ t2) = SOME (t1, t2)
| dest_cons _ = NONE;
val (ts, t') = Code_Thingol.unfoldr dest_cons t;
in case t'
- of IConst { sym = Code_Symbol.Constant @{const_name Nil}, ... } => SOME ts
+ of IConst { sym = Code_Symbol.Constant \<^const_name>\<open>Nil\<close>, ... } => SOME ts
| _ => NONE
end;
@@ -7012,7 +7012,7 @@
| NONE =>
print_list (Code_Printer.infix_cons literals) (pr vars) fxy t1 t2;
in
- Code_Target.set_printings (Code_Symbol.Constant (@{const_name Cons},
+ Code_Target.set_printings (Code_Symbol.Constant (\<^const_name>\<open>Cons\<close>,
[(target, SOME (Code_Printer.complex_const_syntax (2, pretty)))]))
end
--- a/src/HOL/Map.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Map.thy Fri Jan 04 23:22:53 2019 +0100
@@ -268,7 +268,7 @@
using dom_map_option [of "\<lambda>_. g" m] by (simp add: comp_def)
-subsection \<open>@{const map_option} related\<close>
+subsection \<open>\<^const>\<open>map_option\<close> related\<close>
lemma map_option_o_empty [simp]: "map_option f \<circ> empty = empty"
by (rule ext) simp
--- a/src/HOL/Meson.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Meson.thy Fri Jan 04 23:22:53 2019 +0100
@@ -28,7 +28,7 @@
and not_impD: "\<not>(P\<longrightarrow>Q) \<Longrightarrow> P \<and> \<not>Q"
and iff_to_disjD: "P=Q \<Longrightarrow> (\<not>P \<or> Q) \<and> (\<not>Q \<or> P)"
and not_iffD: "\<not>(P=Q) \<Longrightarrow> (P \<or> Q) \<and> (\<not>P \<or> \<not>Q)"
- \<comment> \<open>Much more efficient than @{prop "(P \<and> \<not>Q) \<or> (Q \<and> \<not>P)"} for computing CNF\<close>
+ \<comment> \<open>Much more efficient than \<^prop>\<open>(P \<and> \<not>Q) \<or> (Q \<and> \<not>P)\<close> for computing CNF\<close>
and not_refl_disj_D: "x \<noteq> x \<or> P \<Longrightarrow> P"
by fast+
@@ -70,7 +70,7 @@
lemma make_refined_neg_rule: "\<not>P\<or>Q \<Longrightarrow> (P \<Longrightarrow> Q)"
by blast
-text\<open>@{term P} should be a literal\<close>
+text\<open>\<^term>\<open>P\<close> should be a literal\<close>
lemma make_pos_rule: "P\<or>Q \<Longrightarrow> ((P\<Longrightarrow>\<not>P) \<Longrightarrow> Q)"
by blast
--- a/src/HOL/Nat.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Nat.thy Fri Jan 04 23:22:53 2019 +0100
@@ -142,8 +142,8 @@
ML \<open>
val nat_basic_lfp_sugar =
let
- val ctr_sugar = the (Ctr_Sugar.ctr_sugar_of_global @{theory} @{type_name nat});
- val recx = Logic.varify_types_global @{term rec_nat};
+ val ctr_sugar = the (Ctr_Sugar.ctr_sugar_of_global \<^theory> \<^type_name>\<open>nat\<close>);
+ val recx = Logic.varify_types_global \<^term>\<open>rec_nat\<close>;
val C = body_type (fastype_of recx);
in
{T = HOLogic.natT, fp_res_index = 0, C = C, fun_arg_Tsss = [[], [[HOLogic.natT, C]]],
@@ -153,7 +153,7 @@
setup \<open>
let
- fun basic_lfp_sugars_of _ [@{typ nat}] _ _ ctxt =
+ fun basic_lfp_sugars_of _ [\<^typ>\<open>nat\<close>] _ _ ctxt =
([], [0], [nat_basic_lfp_sugar], [], [], [], TrueI (*dummy*), [], false, ctxt)
| basic_lfp_sugars_of bs arg_Ts callers callssss ctxt =
BNF_LFP_Rec_Sugar.default_basic_lfp_sugars_of bs arg_Ts callers callssss ctxt;
@@ -261,7 +261,7 @@
lemma Suc_n_not_n: "Suc n \<noteq> n"
by (rule not_sym) (rule n_not_Suc_n)
-text \<open>A special form of induction for reasoning about @{term "m < n"} and @{term "m - n"}.\<close>
+text \<open>A special form of induction for reasoning about \<^term>\<open>m < n\<close> and \<^term>\<open>m - n\<close>.\<close>
lemma diff_induct:
assumes "\<And>x. P x 0"
and "\<And>y. P 0 (Suc y)"
@@ -464,7 +464,7 @@
by (subst mult_cancel1) simp
-subsection \<open>Orders on @{typ nat}\<close>
+subsection \<open>Orders on \<^typ>\<open>nat\<close>\<close>
subsubsection \<open>Operation definition\<close>
@@ -688,7 +688,7 @@
by simp (auto simp add: less_Suc_eq dest: Suc_lessD)
qed
-text \<open>Can be used with \<open>less_Suc_eq\<close> to get @{prop "n = m \<or> n < m"}.\<close>
+text \<open>Can be used with \<open>less_Suc_eq\<close> to get \<^prop>\<open>n = m \<or> n < m\<close>.\<close>
lemma not_less_eq: "\<not> m < n \<longleftrightarrow> n < Suc m"
by (simp only: not_less less_Suc_eq_le)
@@ -883,7 +883,7 @@
qed
text \<open>Addition is the inverse of subtraction:
- if @{term "n \<le> m"} then @{term "n + (m - n) = m"}.\<close>
+ if \<^term>\<open>n \<le> m\<close> then \<^term>\<open>n + (m - n) = m\<close>.\<close>
lemma add_diff_inverse_nat: "\<not> m < n \<Longrightarrow> n + (m - n) = m"
for m n :: nat
by (induct m n rule: diff_induct) simp_all
@@ -921,7 +921,7 @@
instance nat :: ordered_cancel_comm_monoid_diff ..
-subsubsection \<open>@{term min} and @{term max}\<close>
+subsubsection \<open>\<^term>\<open>min\<close> and \<^term>\<open>max\<close>\<close>
lemma mono_Suc: "mono Suc"
by (rule monoI) simp
@@ -989,7 +989,7 @@
(auto dest: mult_left_le_imp_le mult_left_less_imp_less le_less_trans)
-subsubsection \<open>Additional theorems about @{term "(\<le>)"}\<close>
+subsubsection \<open>Additional theorems about \<^term>\<open>(\<le>)\<close>\<close>
text \<open>Complete induction, aka course-of-values induction\<close>
@@ -1454,7 +1454,7 @@
with assms show "n * m \<le> n * q" by simp
qed
-text \<open>The lattice order on @{typ nat}.\<close>
+text \<open>The lattice order on \<^typ>\<open>nat\<close>.\<close>
instantiation nat :: distrib_lattice
begin
@@ -1702,7 +1702,7 @@
qed
-subsection \<open>Embedding of the naturals into any \<open>semiring_1\<close>: @{term of_nat}\<close>
+subsection \<open>Embedding of the naturals into any \<open>semiring_1\<close>: \<^term>\<open>of_nat\<close>\<close>
context semiring_1
begin
@@ -2345,7 +2345,7 @@
by (auto intro!: funpow_increasing simp: antimono_def)
-subsection \<open>The divides relation on @{typ nat}\<close>
+subsection \<open>The divides relation on \<^typ>\<open>nat\<close>\<close>
lemma dvd_1_left [iff]: "Suc 0 dvd k"
by (simp add: dvd_def)
--- a/src/HOL/Nitpick.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Nitpick.thy Fri Jan 04 23:22:53 2019 +0100
@@ -219,12 +219,12 @@
setup \<open>
Nitpick_HOL.register_ersatz_global
- [(@{const_name card}, @{const_name card'}),
- (@{const_name sum}, @{const_name sum'}),
- (@{const_name fold_graph}, @{const_name fold_graph'}),
- (@{const_name wf}, @{const_name wf'}),
- (@{const_name wf_wfrec}, @{const_name wf_wfrec'}),
- (@{const_name wfrec}, @{const_name wfrec'})]
+ [(\<^const_name>\<open>card\<close>, \<^const_name>\<open>card'\<close>),
+ (\<^const_name>\<open>sum\<close>, \<^const_name>\<open>sum'\<close>),
+ (\<^const_name>\<open>fold_graph\<close>, \<^const_name>\<open>fold_graph'\<close>),
+ (\<^const_name>\<open>wf\<close>, \<^const_name>\<open>wf'\<close>),
+ (\<^const_name>\<open>wf_wfrec\<close>, \<^const_name>\<open>wf_wfrec'\<close>),
+ (\<^const_name>\<open>wfrec\<close>, \<^const_name>\<open>wfrec'\<close>)]
\<close>
hide_const (open) unknown is_unknown bisim bisim_iterator_max Quot safe_The FunBox PairBox Word prod
--- a/src/HOL/Num.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Num.thy Fri Jan 04 23:22:53 2019 +0100
@@ -13,7 +13,7 @@
datatype num = One | Bit0 num | Bit1 num
-text \<open>Increment function for type @{typ num}\<close>
+text \<open>Increment function for type \<^typ>\<open>num\<close>\<close>
primrec inc :: "num \<Rightarrow> num"
where
@@ -21,7 +21,7 @@
| "inc (Bit0 x) = Bit1 x"
| "inc (Bit1 x) = Bit0 (inc x)"
-text \<open>Converting between type @{typ num} and type @{typ nat}\<close>
+text \<open>Converting between type \<^typ>\<open>num\<close> and type \<^typ>\<open>nat\<close>\<close>
primrec nat_of_num :: "num \<Rightarrow> nat"
where
@@ -46,7 +46,7 @@
lemma num_of_nat_double: "0 < n \<Longrightarrow> num_of_nat (n + n) = Bit0 (num_of_nat n)"
by (induct n) simp_all
-text \<open>Type @{typ num} is isomorphic to the strictly positive natural numbers.\<close>
+text \<open>Type \<^typ>\<open>num\<close> is isomorphic to the strictly positive natural numbers.\<close>
lemma nat_of_num_inverse: "num_of_nat (nat_of_num x) = x"
by (induct x) (simp_all add: num_of_nat_double nat_of_num_pos)
@@ -82,7 +82,7 @@
qed
text \<open>
- From now on, there are two possible models for @{typ num}: as positive
+ From now on, there are two possible models for \<^typ>\<open>num\<close>: as positive
naturals (rule \<open>num_induct\<close>) and as digit representation (rules
\<open>num.induct\<close>, \<open>num.cases\<close>).
\<close>
@@ -186,7 +186,7 @@
lemma mult_inc: "x * inc y = x * y + x"
by (simp add: num_eq_iff nat_of_num_mult nat_of_num_add nat_of_num_inc)
-text \<open>The @{const num_of_nat} conversion.\<close>
+text \<open>The \<^const>\<open>num_of_nat\<close> conversion.\<close>
lemma num_of_nat_One: "n \<le> 1 \<Longrightarrow> num_of_nat n = One"
by (cases n) simp_all
@@ -296,12 +296,12 @@
parse_translation \<open>
let
- fun numeral_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] =
+ fun numeral_tr [(c as Const (\<^syntax_const>\<open>_constrain\<close>, _)) $ t $ u] =
c $ numeral_tr [t] $ u
| numeral_tr [Const (num, _)] =
(Numeral.mk_number_syntax o #value o Lexicon.read_num) num
| numeral_tr ts = raise TERM ("numeral_tr", ts);
- in [(@{syntax_const "_Numeral"}, K numeral_tr)] end
+ in [(\<^syntax_const>\<open>_Numeral\<close>, K numeral_tr)] end
\<close>
typed_print_translation \<open>
@@ -310,26 +310,26 @@
let
val k = Numeral.dest_num_syntax n;
val t' =
- Syntax.const @{syntax_const "_Numeral"} $
+ Syntax.const \<^syntax_const>\<open>_Numeral\<close> $
Syntax.free (string_of_int k);
in
(case T of
- Type (@{type_name fun}, [_, T']) =>
+ Type (\<^type_name>\<open>fun\<close>, [_, T']) =>
if Printer.type_emphasis ctxt T' then
- Syntax.const @{syntax_const "_constrain"} $ t' $
+ Syntax.const \<^syntax_const>\<open>_constrain\<close> $ t' $
Syntax_Phases.term_of_typ ctxt T'
else t'
| _ => if T = dummyT then t' else raise Match)
end;
in
- [(@{const_syntax numeral}, num_tr')]
+ [(\<^const_syntax>\<open>numeral\<close>, num_tr')]
end
\<close>
subsection \<open>Class-specific numeral rules\<close>
-text \<open>@{const numeral} is a morphism.\<close>
+text \<open>\<^const>\<open>numeral\<close> is a morphism.\<close>
subsubsection \<open>Structures with addition: class \<open>numeral\<close>\<close>
@@ -1038,7 +1038,7 @@
lemmas numeral_nat = eval_nat_numeral BitM.simps One_nat_def
-text \<open>Comparisons involving @{term Suc}.\<close>
+text \<open>Comparisons involving \<^term>\<open>Suc\<close>.\<close>
lemma eq_numeral_Suc [simp]: "numeral k = Suc n \<longleftrightarrow> pred_numeral k = n"
by (simp add: numeral_eq_Suc)
@@ -1076,7 +1076,7 @@
lemma min_numeral_Suc [simp]: "min (numeral k) (Suc n) = Suc (min (pred_numeral k) n)"
by (simp add: numeral_eq_Suc)
-text \<open>For @{term case_nat} and @{term rec_nat}.\<close>
+text \<open>For \<^term>\<open>case_nat\<close> and \<^term>\<open>rec_nat\<close>.\<close>
lemma case_nat_numeral [simp]: "case_nat a f (numeral v) = (let pv = pred_numeral v in f pv)"
by (simp add: numeral_eq_Suc)
@@ -1093,7 +1093,7 @@
"rec_nat a f (numeral v + n) = (let pv = pred_numeral v in f (pv + n) (rec_nat a f (pv + n)))"
by (simp add: numeral_eq_Suc Let_def)
-text \<open>Case analysis on @{term "n < 2"}.\<close>
+text \<open>Case analysis on \<^term>\<open>n < 2\<close>.\<close>
lemma less_2_cases: "n < 2 \<Longrightarrow> n = 0 \<or> n = Suc 0"
by (auto simp add: numeral_2_eq_2)
@@ -1113,7 +1113,7 @@
lemmas nat_1_add_1 = one_add_one [where 'a=nat] (* legacy *)
-subsection \<open>Particular lemmas concerning @{term 2}\<close>
+subsection \<open>Particular lemmas concerning \<^term>\<open>2\<close>\<close>
context linordered_field
begin
@@ -1298,8 +1298,8 @@
setup \<open>
Reorient_Proc.add
- (fn Const (@{const_name numeral}, _) $ _ => true
- | Const (@{const_name uminus}, _) $ (Const (@{const_name numeral}, _) $ _) => true
+ (fn Const (\<^const_name>\<open>numeral\<close>, _) $ _ => true
+ | Const (\<^const_name>\<open>uminus\<close>, _) $ (Const (\<^const_name>\<open>numeral\<close>, _) $ _) => true
| _ => false)
\<close>
@@ -1363,7 +1363,7 @@
declaration \<open>
let
fun number_of ctxt T n =
- if not (Sign.of_sort (Proof_Context.theory_of ctxt) (T, @{sort numeral}))
+ if not (Sign.of_sort (Proof_Context.theory_of ctxt) (T, \<^sort>\<open>numeral\<close>))
then raise CTERM ("number_of", [])
else Numeral.mk_cnumber (Thm.ctyp_of ctxt T) n;
in
--- a/src/HOL/Numeral_Simprocs.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Numeral_Simprocs.thy Fri Jan 04 23:22:53 2019 +0100
@@ -285,18 +285,18 @@
declaration \<open>
K (Lin_Arith.add_simprocs
- [@{simproc semiring_assoc_fold},
- @{simproc int_combine_numerals},
- @{simproc inteq_cancel_numerals},
- @{simproc intless_cancel_numerals},
- @{simproc intle_cancel_numerals},
- @{simproc field_combine_numerals}]
+ [\<^simproc>\<open>semiring_assoc_fold\<close>,
+ \<^simproc>\<open>int_combine_numerals\<close>,
+ \<^simproc>\<open>inteq_cancel_numerals\<close>,
+ \<^simproc>\<open>intless_cancel_numerals\<close>,
+ \<^simproc>\<open>intle_cancel_numerals\<close>,
+ \<^simproc>\<open>field_combine_numerals\<close>]
#> Lin_Arith.add_simprocs
- [@{simproc nat_combine_numerals},
- @{simproc nateq_cancel_numerals},
- @{simproc natless_cancel_numerals},
- @{simproc natle_cancel_numerals},
- @{simproc natdiff_cancel_numerals}])
+ [\<^simproc>\<open>nat_combine_numerals\<close>,
+ \<^simproc>\<open>nateq_cancel_numerals\<close>,
+ \<^simproc>\<open>natless_cancel_numerals\<close>,
+ \<^simproc>\<open>natle_cancel_numerals\<close>,
+ \<^simproc>\<open>natdiff_cancel_numerals\<close>])
\<close>
end
--- a/src/HOL/Orderings.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Orderings.thy Fri Jan 04 23:22:53 2019 +0100
@@ -502,7 +502,7 @@
end;
val _ =
- Outer_Syntax.command @{command_keyword print_orders}
+ Outer_Syntax.command \<^command_keyword>\<open>print_orders\<close>
"print order structures available to transitivity reasoner"
(Scan.succeed (Toplevel.keep (print_structures o Toplevel.context_of)));
@@ -527,7 +527,7 @@
else if Pattern.matches thy (less, bin_op) then SOME (t1, "<", t2)
else NONE
| rel _ = NONE;
- fun dec (Const (@{const_name Not}, _) $ t) =
+ fun dec (Const (\<^const_name>\<open>Not\<close>, _) $ t) =
(case rel t of NONE =>
NONE
| SOME (t1, rel, t2) => SOME (t1, "~" ^ rel, t2))
@@ -674,7 +674,7 @@
(le as Const (_, T)) $ r $ s =>
(let
val prems = Simplifier.prems_of ctxt;
- val less = Const (@{const_name less}, T);
+ val less = Const (\<^const_name>\<open>less\<close>, T);
val t = HOLogic.mk_Trueprop(le $ s $ r);
in
(case find_first (prp t) prems of
@@ -693,7 +693,7 @@
NotC $ ((less as Const(_,T)) $ r $ s) =>
(let
val prems = Simplifier.prems_of ctxt;
- val le = Const (@{const_name less_eq}, T);
+ val le = Const (\<^const_name>\<open>less_eq\<close>, T);
val t = HOLogic.mk_Trueprop(le $ r $ s);
in
(case find_first (prp t) prems of
@@ -766,32 +766,32 @@
print_translation \<open>
let
- val All_binder = Mixfix.binder_name @{const_syntax All};
- val Ex_binder = Mixfix.binder_name @{const_syntax Ex};
- val impl = @{const_syntax HOL.implies};
- val conj = @{const_syntax HOL.conj};
- val less = @{const_syntax less};
- val less_eq = @{const_syntax less_eq};
+ val All_binder = Mixfix.binder_name \<^const_syntax>\<open>All\<close>;
+ val Ex_binder = Mixfix.binder_name \<^const_syntax>\<open>Ex\<close>;
+ val impl = \<^const_syntax>\<open>HOL.implies\<close>;
+ val conj = \<^const_syntax>\<open>HOL.conj\<close>;
+ val less = \<^const_syntax>\<open>less\<close>;
+ val less_eq = \<^const_syntax>\<open>less_eq\<close>;
val trans =
[((All_binder, impl, less),
- (@{syntax_const "_All_less"}, @{syntax_const "_All_greater"})),
+ (\<^syntax_const>\<open>_All_less\<close>, \<^syntax_const>\<open>_All_greater\<close>)),
((All_binder, impl, less_eq),
- (@{syntax_const "_All_less_eq"}, @{syntax_const "_All_greater_eq"})),
+ (\<^syntax_const>\<open>_All_less_eq\<close>, \<^syntax_const>\<open>_All_greater_eq\<close>)),
((Ex_binder, conj, less),
- (@{syntax_const "_Ex_less"}, @{syntax_const "_Ex_greater"})),
+ (\<^syntax_const>\<open>_Ex_less\<close>, \<^syntax_const>\<open>_Ex_greater\<close>)),
((Ex_binder, conj, less_eq),
- (@{syntax_const "_Ex_less_eq"}, @{syntax_const "_Ex_greater_eq"}))];
+ (\<^syntax_const>\<open>_Ex_less_eq\<close>, \<^syntax_const>\<open>_Ex_greater_eq\<close>))];
fun matches_bound v t =
(case t of
- Const (@{syntax_const "_bound"}, _) $ Free (v', _) => v = v'
+ Const (\<^syntax_const>\<open>_bound\<close>, _) $ Free (v', _) => v = v'
| _ => false);
fun contains_var v = Term.exists_subterm (fn Free (x, _) => x = v | _ => false);
fun mk x c n P = Syntax.const c $ Syntax_Trans.mark_bound_body x $ n $ P;
fun tr' q = (q, fn _ =>
- (fn [Const (@{syntax_const "_bound"}, _) $ Free (v, T),
+ (fn [Const (\<^syntax_const>\<open>_bound\<close>, _) $ Free (v, T),
Const (c, _) $ (Const (d, _) $ t $ u) $ P] =>
(case AList.lookup (=) trans (q, c, d) of
NONE => raise Match
@@ -1523,7 +1523,7 @@
end
-subsection \<open>Order on @{typ bool}\<close>
+subsection \<open>Order on \<^typ>\<open>bool\<close>\<close>
instantiation bool :: "{order_bot, order_top, linorder}"
begin
@@ -1571,7 +1571,7 @@
by simp_all
-subsection \<open>Order on @{typ "_ \<Rightarrow> _"}\<close>
+subsection \<open>Order on \<^typ>\<open>_ \<Rightarrow> _\<close>\<close>
instantiation "fun" :: (type, ord) ord
begin
--- a/src/HOL/Parity.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Parity.thy Fri Jan 04 23:22:53 2019 +0100
@@ -454,7 +454,7 @@
end
-subsection \<open>Instance for @{typ nat}\<close>
+subsection \<open>Instance for \<^typ>\<open>nat\<close>\<close>
instance nat :: semiring_parity
by standard (simp_all add: dvd_eq_mod_eq_0)
@@ -679,7 +679,7 @@
end
-subsection \<open>Instance for @{typ int}\<close>
+subsection \<open>Instance for \<^typ>\<open>int\<close>\<close>
instance int :: ring_parity
by standard (simp_all add: dvd_eq_mod_eq_0 divide_int_def division_segment_int_def)
@@ -706,7 +706,7 @@
begin
text \<open>The primary purpose of the following operations is
- to avoid ad-hoc simplification of concrete expressions @{term "2 ^ n"}\<close>
+ to avoid ad-hoc simplification of concrete expressions \<^term>\<open>2 ^ n\<close>\<close>
definition push_bit :: "nat \<Rightarrow> 'a \<Rightarrow> 'a"
where push_bit_eq_mult: "push_bit n a = a * 2 ^ n"
--- a/src/HOL/Partial_Function.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Partial_Function.thy Fri Jan 04 23:22:53 2019 +0100
@@ -226,7 +226,7 @@
done
-text \<open>Rules for @{term mono_body}:\<close>
+text \<open>Rules for \<^term>\<open>mono_body\<close>:\<close>
lemma const_mono[partial_function_mono]: "monotone ord leq (\<lambda>f. c)"
by (rule monotoneI) (rule leq_refl)
@@ -446,12 +446,12 @@
using step defined option.fixp_induct_uc[of U F C, OF mono eq inverse2 option_admissible]
unfolding fun_lub_def flat_lub_def by(auto 9 2)
-declaration \<open>Partial_Function.init "tailrec" @{term tailrec.fixp_fun}
- @{term tailrec.mono_body} @{thm tailrec.fixp_rule_uc} @{thm tailrec.fixp_induct_uc}
+declaration \<open>Partial_Function.init "tailrec" \<^term>\<open>tailrec.fixp_fun\<close>
+ \<^term>\<open>tailrec.mono_body\<close> @{thm tailrec.fixp_rule_uc} @{thm tailrec.fixp_induct_uc}
(SOME @{thm fixp_induct_tailrec[where c = undefined]})\<close>
-declaration \<open>Partial_Function.init "option" @{term option.fixp_fun}
- @{term option.mono_body} @{thm option.fixp_rule_uc} @{thm option.fixp_induct_uc}
+declaration \<open>Partial_Function.init "option" \<^term>\<open>option.fixp_fun\<close>
+ \<^term>\<open>option.mono_body\<close> @{thm option.fixp_rule_uc} @{thm option.fixp_induct_uc}
(SOME @{thm fixp_induct_option})\<close>
hide_const (open) chain
--- a/src/HOL/Power.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Power.thy Fri Jan 04 23:22:53 2019 +0100
@@ -457,7 +457,7 @@
by (force simp add: order_antisym power_le_imp_le_exp)
text \<open>
- Can relax the first premise to @{term "0<a"} in the case of the
+ Can relax the first premise to \<^term>\<open>0<a\<close> in the case of the
natural numbers.
\<close>
lemma power_less_imp_less_exp: "1 < a \<Longrightarrow> a ^ m < a ^ n \<Longrightarrow> m < n"
--- a/src/HOL/Predicate_Compile.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Predicate_Compile.thy Fri Jan 04 23:22:53 2019 +0100
@@ -80,14 +80,14 @@
val ii = Fun (Input, Fun (Input, Bool))
in
Core_Data.PredData.map (Graph.new_node
- (@{const_name contains},
+ (\<^const_name>\<open>contains\<close>,
Core_Data.PredData {
pos = Position.thread_data (),
intros = [(NONE, @{thm containsI})],
elim = SOME @{thm containsE},
preprocessed = true,
function_names = [(Predicate_Compile_Aux.Pred,
- [(io, @{const_name pred_of_set}), (ii, @{const_name contains_pred})])],
+ [(io, \<^const_name>\<open>pred_of_set\<close>), (ii, \<^const_name>\<open>contains_pred\<close>)])],
predfun_data = [
(io, Core_Data.PredfunData {
elim = @{thm pred_of_setE}, intro = @{thm pred_of_setI},
--- a/src/HOL/Presburger.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Presburger.thy Fri Jan 04 23:22:53 2019 +0100
@@ -488,7 +488,7 @@
by simp
-subsection \<open>Nice facts about division by @{term 4}\<close>
+subsection \<open>Nice facts about division by \<^term>\<open>4\<close>\<close>
lemma even_even_mod_4_iff:
"even (n::nat) \<longleftrightarrow> even (n mod 4)"
--- a/src/HOL/Product_Type.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Product_Type.thy Fri Jan 04 23:22:53 2019 +0100
@@ -10,7 +10,7 @@
keywords "inductive_set" "coinductive_set" :: thy_decl
begin
-subsection \<open>@{typ bool} is a datatype\<close>
+subsection \<open>\<^typ>\<open>bool\<close> is a datatype\<close>
free_constructors (discs_sels) case_bool for True | False
by auto
@@ -280,7 +280,7 @@
subsubsection \<open>Tuple syntax\<close>
text \<open>
- Patterns -- extends pre-defined type @{typ pttrn} used in
+ Patterns -- extends pre-defined type \<^typ>\<open>pttrn\<close> used in
abstractions.
\<close>
@@ -307,27 +307,27 @@
"\<lambda>(). b" \<rightleftharpoons> "CONST case_unit b"
"_abs (CONST Unity) t" \<rightharpoonup> "\<lambda>(). t"
-text \<open>print @{term "case_prod f"} as @{term "\<lambda>(x, y). f x y"} and
- @{term "case_prod (\<lambda>x. f x)"} as @{term "\<lambda>(x, y). f x y"}\<close>
+text \<open>print \<^term>\<open>case_prod f\<close> as \<^term>\<open>\<lambda>(x, y). f x y\<close> and
+ \<^term>\<open>case_prod (\<lambda>x. f x)\<close> as \<^term>\<open>\<lambda>(x, y). f x y\<close>\<close>
typed_print_translation \<open>
let
fun case_prod_guess_names_tr' T [Abs (x, _, Abs _)] = raise Match
| case_prod_guess_names_tr' T [Abs (x, xT, t)] =
(case (head_of t) of
- Const (@{const_syntax case_prod}, _) => raise Match
+ Const (\<^const_syntax>\<open>case_prod\<close>, _) => raise Match
| _ =>
let
val (_ :: yT :: _) = binder_types (domain_type T) handle Bind => raise Match;
val (y, t') = Syntax_Trans.atomic_abs_tr' ("y", yT, incr_boundvars 1 t $ Bound 0);
val (x', t'') = Syntax_Trans.atomic_abs_tr' (x, xT, t');
in
- Syntax.const @{syntax_const "_abs"} $
- (Syntax.const @{syntax_const "_pattern"} $ x' $ y) $ t''
+ Syntax.const \<^syntax_const>\<open>_abs\<close> $
+ (Syntax.const \<^syntax_const>\<open>_pattern\<close> $ x' $ y) $ t''
end)
| case_prod_guess_names_tr' T [t] =
(case head_of t of
- Const (@{const_syntax case_prod}, _) => raise Match
+ Const (\<^const_syntax>\<open>case_prod\<close>, _) => raise Match
| _ =>
let
val (xT :: yT :: _) = binder_types (domain_type T) handle Bind => raise Match;
@@ -335,14 +335,14 @@
Syntax_Trans.atomic_abs_tr' ("y", yT, incr_boundvars 2 t $ Bound 1 $ Bound 0);
val (x', t'') = Syntax_Trans.atomic_abs_tr' ("x", xT, t');
in
- Syntax.const @{syntax_const "_abs"} $
- (Syntax.const @{syntax_const "_pattern"} $ x' $ y) $ t''
+ Syntax.const \<^syntax_const>\<open>_abs\<close> $
+ (Syntax.const \<^syntax_const>\<open>_pattern\<close> $ x' $ y) $ t''
end)
| case_prod_guess_names_tr' _ _ = raise Match;
- in [(@{const_syntax case_prod}, K case_prod_guess_names_tr')] end
+ in [(\<^const_syntax>\<open>case_prod\<close>, K case_prod_guess_names_tr')] end
\<close>
-text \<open>Reconstruct pattern from (nested) @{const case_prod}s,
+text \<open>Reconstruct pattern from (nested) \<^const>\<open>case_prod\<close>s,
avoiding eta-contraction of body; required for enclosing "let",
if "let" does not avoid eta-contraction, which has been observed to occur.\<close>
@@ -354,33 +354,33 @@
val (y, t') = Syntax_Trans.atomic_abs_tr' abs;
val (x', t'') = Syntax_Trans.atomic_abs_tr' (x, T, t');
in
- Syntax.const @{syntax_const "_abs"} $
- (Syntax.const @{syntax_const "_pattern"} $ x' $ y) $ t''
+ Syntax.const \<^syntax_const>\<open>_abs\<close> $
+ (Syntax.const \<^syntax_const>\<open>_pattern\<close> $ x' $ y) $ t''
end
- | case_prod_tr' [Abs (x, T, (s as Const (@{const_syntax case_prod}, _) $ t))] =
+ | case_prod_tr' [Abs (x, T, (s as Const (\<^const_syntax>\<open>case_prod\<close>, _) $ t))] =
(* case_prod (\<lambda>x. (case_prod (\<lambda>y z. t))) \<Rightarrow> \<lambda>(x, y, z). t *)
let
- val Const (@{syntax_const "_abs"}, _) $
- (Const (@{syntax_const "_pattern"}, _) $ y $ z) $ t' =
+ val Const (\<^syntax_const>\<open>_abs\<close>, _) $
+ (Const (\<^syntax_const>\<open>_pattern\<close>, _) $ y $ z) $ t' =
case_prod_tr' [t];
val (x', t'') = Syntax_Trans.atomic_abs_tr' (x, T, t');
in
- Syntax.const @{syntax_const "_abs"} $
- (Syntax.const @{syntax_const "_pattern"} $ x' $
- (Syntax.const @{syntax_const "_patterns"} $ y $ z)) $ t''
+ Syntax.const \<^syntax_const>\<open>_abs\<close> $
+ (Syntax.const \<^syntax_const>\<open>_pattern\<close> $ x' $
+ (Syntax.const \<^syntax_const>\<open>_patterns\<close> $ y $ z)) $ t''
end
- | case_prod_tr' [Const (@{const_syntax case_prod}, _) $ t] =
+ | case_prod_tr' [Const (\<^const_syntax>\<open>case_prod\<close>, _) $ t] =
(* case_prod (case_prod (\<lambda>x y z. t)) \<Rightarrow> \<lambda>((x, y), z). t *)
case_prod_tr' [(case_prod_tr' [t])]
(* inner case_prod_tr' creates next pattern *)
- | case_prod_tr' [Const (@{syntax_const "_abs"}, _) $ x_y $ Abs abs] =
+ | case_prod_tr' [Const (\<^syntax_const>\<open>_abs\<close>, _) $ x_y $ Abs abs] =
(* case_prod (\<lambda>pttrn z. t) \<Rightarrow> \<lambda>(pttrn, z). t *)
let val (z, t) = Syntax_Trans.atomic_abs_tr' abs in
- Syntax.const @{syntax_const "_abs"} $
- (Syntax.const @{syntax_const "_pattern"} $ x_y $ z) $ t
+ Syntax.const \<^syntax_const>\<open>_abs\<close> $
+ (Syntax.const \<^syntax_const>\<open>_pattern\<close> $ x_y $ z) $ t
end
| case_prod_tr' _ = raise Match;
- in [(@{const_syntax case_prod}, K case_prod_tr')] end
+ in [(\<^const_syntax>\<open>case_prod\<close>, K case_prod_tr')] end
\<close>
@@ -443,7 +443,7 @@
by (simp add: fun_eq_iff split: prod.split)
lemma case_prod_eta: "(\<lambda>(x, y). f (x, y)) = f"
- \<comment> \<open>Subsumes the old \<open>split_Pair\<close> when @{term f} is the identity function.\<close>
+ \<comment> \<open>Subsumes the old \<open>split_Pair\<close> when \<^term>\<open>f\<close> is the identity function.\<close>
by (simp add: fun_eq_iff split: prod.split)
(* This looks like a sensible simp-rule but appears to do more harm than good:
@@ -483,16 +483,16 @@
ML \<open>
(* replace parameters of product type by individual component parameters *)
local (* filtering with exists_paired_all is an essential optimization *)
- fun exists_paired_all (Const (@{const_name Pure.all}, _) $ Abs (_, T, t)) =
+ fun exists_paired_all (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (_, T, t)) =
can HOLogic.dest_prodT T orelse exists_paired_all t
| exists_paired_all (t $ u) = exists_paired_all t orelse exists_paired_all u
| exists_paired_all (Abs (_, _, t)) = exists_paired_all t
| exists_paired_all _ = false;
val ss =
simpset_of
- (put_simpset HOL_basic_ss @{context}
+ (put_simpset HOL_basic_ss \<^context>
addsimps [@{thm split_paired_all}, @{thm unit_all_eq2}, @{thm unit_abs_eta_conv}]
- addsimprocs [@{simproc unit_eq}]);
+ addsimprocs [\<^simproc>\<open>unit_eq\<close>]);
in
fun split_all_tac ctxt = SUBGOAL (fn (t, i) =>
if exists_paired_all t then safe_full_simp_tac (put_simpset ss ctxt) i else no_tac);
@@ -529,9 +529,9 @@
ML \<open>
local
val cond_case_prod_eta_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms cond_case_prod_eta});
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps @{thms cond_case_prod_eta});
fun Pair_pat k 0 (Bound m) = (m = k)
- | Pair_pat k i (Const (@{const_name Pair}, _) $ Bound m $ t) =
+ | Pair_pat k i (Const (\<^const_name>\<open>Pair\<close>, _) $ Bound m $ t) =
i > 0 andalso m = k + i andalso Pair_pat k (i - 1) t
| Pair_pat _ _ _ = false;
fun no_args k i (Abs (_, _, t)) = no_args (k + 1) i t
@@ -539,7 +539,7 @@
| no_args k i (Bound m) = m < k orelse m > k + i
| no_args _ _ _ = true;
fun split_pat tp i (Abs (_, _, t)) = if tp 0 i t then SOME (i, t) else NONE
- | split_pat tp i (Const (@{const_name case_prod}, _) $ Abs (_, _, t)) = split_pat tp (i + 1) t
+ | split_pat tp i (Const (\<^const_name>\<open>case_prod\<close>, _) $ Abs (_, _, t)) = split_pat tp (i + 1) t
| split_pat tp i _ = NONE;
fun metaeq ctxt lhs rhs = mk_meta_eq (Goal.prove ctxt [] []
(HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs)))
@@ -557,12 +557,12 @@
else (subst arg k i t $ subst arg k i u)
| subst arg k i t = t;
in
- fun beta_proc ctxt (s as Const (@{const_name case_prod}, _) $ Abs (_, _, t) $ arg) =
+ fun beta_proc ctxt (s as Const (\<^const_name>\<open>case_prod\<close>, _) $ Abs (_, _, t) $ arg) =
(case split_pat beta_term_pat 1 t of
SOME (i, f) => SOME (metaeq ctxt s (subst arg 0 i f))
| NONE => NONE)
| beta_proc _ _ = NONE;
- fun eta_proc ctxt (s as Const (@{const_name case_prod}, _) $ Abs (_, _, t)) =
+ fun eta_proc ctxt (s as Const (\<^const_name>\<open>case_prod\<close>, _) $ Abs (_, _, t)) =
(case split_pat eta_term_pat 1 t of
SOME (_, ft) => SOME (metaeq ctxt s (let val f $ _ = ft in f end))
| NONE => NONE)
@@ -578,7 +578,7 @@
by (auto simp: fun_eq_iff)
text \<open>
- \<^medskip> @{const case_prod} used as a logical connective or set former.
+ \<^medskip> \<^const>\<open>case_prod\<close> used as a logical connective or set former.
\<^medskip> These rules are for use with \<open>blast\<close>; could instead
call \<open>simp\<close> using @{thm [source] prod.split} as rewrite.\<close>
@@ -631,7 +631,7 @@
ML \<open>
local (* filtering with exists_p_split is an essential optimization *)
- fun exists_p_split (Const (@{const_name case_prod},_) $ _ $ (Const (@{const_name Pair},_)$_$_)) = true
+ fun exists_p_split (Const (\<^const_name>\<open>case_prod\<close>,_) $ _ $ (Const (\<^const_name>\<open>Pair\<close>,_)$_$_)) = true
| exists_p_split (t $ u) = exists_p_split t orelse exists_p_split u
| exists_p_split (Abs (_, _, t)) = exists_p_split t
| exists_p_split _ = false;
@@ -804,7 +804,7 @@
no_notation scomp (infixl "\<circ>\<rightarrow>" 60)
text \<open>
- @{term map_prod} --- action of the product functor upon functions.
+ \<^term>\<open>map_prod\<close> --- action of the product functor upon functions.
\<close>
definition map_prod :: "('a \<Rightarrow> 'c) \<Rightarrow> ('b \<Rightarrow> 'd) \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'c \<times> 'd"
@@ -983,7 +983,7 @@
unfolding Sigma_def by blast
text \<open>
- Elimination of @{term "(a, b) \<in> A \<times> B"} -- introduces no
+ Elimination of \<^term>\<open>(a, b) \<in> A \<times> B\<close> -- introduces no
eigenvariables.
\<close>
@@ -1177,7 +1177,7 @@
end
-text \<open>The following @{const map_prod} lemmas are due to Joachim Breitner:\<close>
+text \<open>The following \<^const>\<open>map_prod\<close> lemmas are due to Joachim Breitner:\<close>
lemma map_prod_inj_on:
assumes "inj_on f A"
@@ -1267,8 +1267,8 @@
setup \<open>
Code_Preproc.map_pre (fn ctxt => ctxt addsimprocs
- [Simplifier.make_simproc @{context} "set comprehension"
- {lhss = [@{term "Collect P"}],
+ [Simplifier.make_simproc \<^context> "set comprehension"
+ {lhss = [\<^term>\<open>Collect P\<close>],
proc = K Set_Comprehension_Pointfree.code_simproc}])
\<close>
@@ -1279,10 +1279,10 @@
simproc_setup Collect_mem ("Collect t") = \<open>
fn _ => fn ctxt => fn ct =>
(case Thm.term_of ct of
- S as Const (@{const_name Collect}, Type (@{type_name fun}, [_, T])) $ t =>
+ S as Const (\<^const_name>\<open>Collect\<close>, Type (\<^type_name>\<open>fun\<close>, [_, T])) $ t =>
let val (u, _, ps) = HOLogic.strip_ptupleabs t in
(case u of
- (c as Const (@{const_name Set.member}, _)) $ q $ S' =>
+ (c as Const (\<^const_name>\<open>Set.member\<close>, _)) $ q $ S' =>
(case try (HOLogic.strip_ptuple ps) q of
NONE => NONE
| SOME ts =>
@@ -1294,7 +1294,7 @@
addsimps [@{thm split_paired_all}, @{thm case_prod_conv}]) 1
in
SOME (Goal.prove ctxt [] []
- (Const (@{const_name Pure.eq}, T --> T --> propT) $ S $ S')
+ (Const (\<^const_name>\<open>Pure.eq\<close>, T --> T --> propT) $ S $ S')
(K (EVERY
[resolve_tac ctxt [eq_reflection] 1,
resolve_tac ctxt @{thms subset_antisym} 1,
--- a/src/HOL/Quickcheck_Narrowing.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Quickcheck_Narrowing.thy Fri Jan 04 23:22:53 2019 +0100
@@ -32,8 +32,8 @@
val target = "Haskell_Quickcheck";
fun print _ = Code_Haskell.print_numeral "Prelude.Int";
in
- Numeral.add_code @{const_name Code_Numeral.Pos} I print target
- #> Numeral.add_code @{const_name Code_Numeral.Neg} (~) print target
+ Numeral.add_code \<^const_name>\<open>Code_Numeral.Pos\<close> I print target
+ #> Numeral.add_code \<^const_name>\<open>Code_Numeral.Neg\<close> (~) print target
end
\<close>
@@ -54,7 +54,7 @@
where
"map_cons f (Narrowing_cons ty cs) = Narrowing_cons ty (map (\<lambda>c. f \<circ> c) cs)"
-subsubsection \<open>From narrowing's deep representation of terms to @{theory HOL.Code_Evaluation}'s terms\<close>
+subsubsection \<open>From narrowing's deep representation of terms to \<^theory>\<open>HOL.Code_Evaluation\<close>'s terms\<close>
class partial_term_of = typerep +
fixes partial_term_of :: "'a itself => narrowing_term => Code_Evaluation.term"
--- a/src/HOL/Quickcheck_Random.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Quickcheck_Random.thy Fri Jan 04 23:22:53 2019 +0100
@@ -127,7 +127,7 @@
subsection \<open>Complex generators\<close>
-text \<open>Towards @{typ "'a \<Rightarrow> 'b"}\<close>
+text \<open>Towards \<^typ>\<open>'a \<Rightarrow> 'b\<close>\<close>
axiomatization random_fun_aux :: "typerep \<Rightarrow> typerep \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> term)
\<Rightarrow> (Random.seed \<Rightarrow> ('b \<times> (unit \<Rightarrow> term)) \<times> Random.seed)
@@ -217,7 +217,7 @@
code_printing
constant random_fun_aux \<rightharpoonup> (Quickcheck) "Random'_Generators.random'_fun"
- \<comment> \<open>With enough criminal energy this can be abused to derive @{prop False};
+ \<comment> \<open>With enough criminal energy this can be abused to derive \<^prop>\<open>False\<close>;
for this reason we use a distinguished target \<open>Quickcheck\<close>
not spoiling the regular trusted code generation\<close>
--- a/src/HOL/Rat.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Rat.thy Fri Jan 04 23:22:53 2019 +0100
@@ -665,8 +665,8 @@
@{thm of_int_minus}, @{thm of_int_diff},
@{thm of_int_of_nat_eq}]
#> Lin_Arith.add_simprocs [Numeral_Simprocs.field_divide_cancel_numeral_factor]
- #> Lin_Arith.add_inj_const (@{const_name of_nat}, @{typ "nat \<Rightarrow> rat"})
- #> Lin_Arith.add_inj_const (@{const_name of_int}, @{typ "int \<Rightarrow> rat"}))
+ #> Lin_Arith.add_inj_const (\<^const_name>\<open>of_nat\<close>, \<^typ>\<open>nat \<Rightarrow> rat\<close>)
+ #> Lin_Arith.add_inj_const (\<^const_name>\<open>of_int\<close>, \<^typ>\<open>int \<Rightarrow> rat\<close>))
\<close>
@@ -1130,17 +1130,17 @@
subsection \<open>Setup for Nitpick\<close>
declaration \<open>
- Nitpick_HOL.register_frac_type @{type_name rat}
- [(@{const_name Abs_Rat}, @{const_name Nitpick.Abs_Frac}),
- (@{const_name zero_rat_inst.zero_rat}, @{const_name Nitpick.zero_frac}),
- (@{const_name one_rat_inst.one_rat}, @{const_name Nitpick.one_frac}),
- (@{const_name plus_rat_inst.plus_rat}, @{const_name Nitpick.plus_frac}),
- (@{const_name times_rat_inst.times_rat}, @{const_name Nitpick.times_frac}),
- (@{const_name uminus_rat_inst.uminus_rat}, @{const_name Nitpick.uminus_frac}),
- (@{const_name inverse_rat_inst.inverse_rat}, @{const_name Nitpick.inverse_frac}),
- (@{const_name ord_rat_inst.less_rat}, @{const_name Nitpick.less_frac}),
- (@{const_name ord_rat_inst.less_eq_rat}, @{const_name Nitpick.less_eq_frac}),
- (@{const_name field_char_0_class.of_rat}, @{const_name Nitpick.of_frac})]
+ Nitpick_HOL.register_frac_type \<^type_name>\<open>rat\<close>
+ [(\<^const_name>\<open>Abs_Rat\<close>, \<^const_name>\<open>Nitpick.Abs_Frac\<close>),
+ (\<^const_name>\<open>zero_rat_inst.zero_rat\<close>, \<^const_name>\<open>Nitpick.zero_frac\<close>),
+ (\<^const_name>\<open>one_rat_inst.one_rat\<close>, \<^const_name>\<open>Nitpick.one_frac\<close>),
+ (\<^const_name>\<open>plus_rat_inst.plus_rat\<close>, \<^const_name>\<open>Nitpick.plus_frac\<close>),
+ (\<^const_name>\<open>times_rat_inst.times_rat\<close>, \<^const_name>\<open>Nitpick.times_frac\<close>),
+ (\<^const_name>\<open>uminus_rat_inst.uminus_rat\<close>, \<^const_name>\<open>Nitpick.uminus_frac\<close>),
+ (\<^const_name>\<open>inverse_rat_inst.inverse_rat\<close>, \<^const_name>\<open>Nitpick.inverse_frac\<close>),
+ (\<^const_name>\<open>ord_rat_inst.less_rat\<close>, \<^const_name>\<open>Nitpick.less_frac\<close>),
+ (\<^const_name>\<open>ord_rat_inst.less_eq_rat\<close>, \<^const_name>\<open>Nitpick.less_eq_frac\<close>),
+ (\<^const_name>\<open>field_char_0_class.of_rat\<close>, \<^const_name>\<open>Nitpick.of_frac\<close>)]
\<close>
lemmas [nitpick_unfold] =
@@ -1159,15 +1159,15 @@
fun mk_frac str =
let
val {mant = i, exp = n} = Lexicon.read_float str;
- val exp = Syntax.const @{const_syntax Power.power};
+ val exp = Syntax.const \<^const_syntax>\<open>Power.power\<close>;
val ten = Numeral.mk_number_syntax 10;
val exp10 = if n = 1 then ten else exp $ ten $ Numeral.mk_number_syntax n;
- in Syntax.const @{const_syntax Fields.inverse_divide} $ Numeral.mk_number_syntax i $ exp10 end;
+ in Syntax.const \<^const_syntax>\<open>Fields.inverse_divide\<close> $ Numeral.mk_number_syntax i $ exp10 end;
- fun float_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] = c $ float_tr [t] $ u
+ fun float_tr [(c as Const (\<^syntax_const>\<open>_constrain\<close>, _)) $ t $ u] = c $ float_tr [t] $ u
| float_tr [t as Const (str, _)] = mk_frac str
| float_tr ts = raise TERM ("float_tr", ts);
- in [(@{syntax_const "_Float"}, K float_tr)] end
+ in [(\<^syntax_const>\<open>_Float\<close>, K float_tr)] end
\<close>
text\<open>Test:\<close>
--- a/src/HOL/Real.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Real.thy Fri Jan 04 23:22:53 2019 +0100
@@ -1262,8 +1262,8 @@
@{thm of_int_add}, @{thm of_int_minus}, @{thm of_int_diff},
@{thm of_int_mult}, @{thm of_int_of_nat_eq},
@{thm of_nat_numeral}, @{thm of_nat_numeral}, @{thm of_int_neg_numeral}]
- #> Lin_Arith.add_inj_const (@{const_name of_nat}, @{typ "nat \<Rightarrow> real"})
- #> Lin_Arith.add_inj_const (@{const_name of_int}, @{typ "int \<Rightarrow> real"}))
+ #> Lin_Arith.add_inj_const (\<^const_name>\<open>of_nat\<close>, \<^typ>\<open>nat \<Rightarrow> real\<close>)
+ #> Lin_Arith.add_inj_const (\<^const_name>\<open>of_int\<close>, \<^typ>\<open>int \<Rightarrow> real\<close>))
\<close>
@@ -1625,15 +1625,15 @@
subsection \<open>Setup for Nitpick\<close>
declaration \<open>
- Nitpick_HOL.register_frac_type @{type_name real}
- [(@{const_name zero_real_inst.zero_real}, @{const_name Nitpick.zero_frac}),
- (@{const_name one_real_inst.one_real}, @{const_name Nitpick.one_frac}),
- (@{const_name plus_real_inst.plus_real}, @{const_name Nitpick.plus_frac}),
- (@{const_name times_real_inst.times_real}, @{const_name Nitpick.times_frac}),
- (@{const_name uminus_real_inst.uminus_real}, @{const_name Nitpick.uminus_frac}),
- (@{const_name inverse_real_inst.inverse_real}, @{const_name Nitpick.inverse_frac}),
- (@{const_name ord_real_inst.less_real}, @{const_name Nitpick.less_frac}),
- (@{const_name ord_real_inst.less_eq_real}, @{const_name Nitpick.less_eq_frac})]
+ Nitpick_HOL.register_frac_type \<^type_name>\<open>real\<close>
+ [(\<^const_name>\<open>zero_real_inst.zero_real\<close>, \<^const_name>\<open>Nitpick.zero_frac\<close>),
+ (\<^const_name>\<open>one_real_inst.one_real\<close>, \<^const_name>\<open>Nitpick.one_frac\<close>),
+ (\<^const_name>\<open>plus_real_inst.plus_real\<close>, \<^const_name>\<open>Nitpick.plus_frac\<close>),
+ (\<^const_name>\<open>times_real_inst.times_real\<close>, \<^const_name>\<open>Nitpick.times_frac\<close>),
+ (\<^const_name>\<open>uminus_real_inst.uminus_real\<close>, \<^const_name>\<open>Nitpick.uminus_frac\<close>),
+ (\<^const_name>\<open>inverse_real_inst.inverse_real\<close>, \<^const_name>\<open>Nitpick.inverse_frac\<close>),
+ (\<^const_name>\<open>ord_real_inst.less_real\<close>, \<^const_name>\<open>Nitpick.less_frac\<close>),
+ (\<^const_name>\<open>ord_real_inst.less_eq_real\<close>, \<^const_name>\<open>Nitpick.less_eq_frac\<close>)]
\<close>
lemmas [nitpick_unfold] = inverse_real_inst.inverse_real one_real_inst.one_real
--- a/src/HOL/Real_Vector_Spaces.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Real_Vector_Spaces.thy Fri Jan 04 23:22:53 2019 +0100
@@ -1212,21 +1212,21 @@
subsection \<open>Extra type constraints\<close>
-text \<open>Only allow @{term "open"} in class \<open>topological_space\<close>.\<close>
+text \<open>Only allow \<^term>\<open>open\<close> in class \<open>topological_space\<close>.\<close>
setup \<open>Sign.add_const_constraint
- (@{const_name "open"}, SOME @{typ "'a::topological_space set \<Rightarrow> bool"})\<close>
+ (\<^const_name>\<open>open\<close>, SOME \<^typ>\<open>'a::topological_space set \<Rightarrow> bool\<close>)\<close>
-text \<open>Only allow @{term "uniformity"} in class \<open>uniform_space\<close>.\<close>
+text \<open>Only allow \<^term>\<open>uniformity\<close> in class \<open>uniform_space\<close>.\<close>
setup \<open>Sign.add_const_constraint
- (@{const_name "uniformity"}, SOME @{typ "('a::uniformity \<times> 'a) filter"})\<close>
+ (\<^const_name>\<open>uniformity\<close>, SOME \<^typ>\<open>('a::uniformity \<times> 'a) filter\<close>)\<close>
-text \<open>Only allow @{term dist} in class \<open>metric_space\<close>.\<close>
+text \<open>Only allow \<^term>\<open>dist\<close> in class \<open>metric_space\<close>.\<close>
setup \<open>Sign.add_const_constraint
- (@{const_name dist}, SOME @{typ "'a::metric_space \<Rightarrow> 'a \<Rightarrow> real"})\<close>
+ (\<^const_name>\<open>dist\<close>, SOME \<^typ>\<open>'a::metric_space \<Rightarrow> 'a \<Rightarrow> real\<close>)\<close>
-text \<open>Only allow @{term norm} in class \<open>real_normed_vector\<close>.\<close>
+text \<open>Only allow \<^term>\<open>norm\<close> in class \<open>real_normed_vector\<close>.\<close>
setup \<open>Sign.add_const_constraint
- (@{const_name norm}, SOME @{typ "'a::real_normed_vector \<Rightarrow> real"})\<close>
+ (\<^const_name>\<open>norm\<close>, SOME \<^typ>\<open>'a::real_normed_vector \<Rightarrow> real\<close>)\<close>
subsection \<open>Sign function\<close>
@@ -2087,8 +2087,8 @@
\<close>
text \<open>
- If sequence @{term "X"} is Cauchy, then its limit is the lub of
- @{term "{r::real. \<exists>N. \<forall>n\<ge>N. r < X n}"}
+ If sequence \<^term>\<open>X\<close> is Cauchy, then its limit is the lub of
+ \<^term>\<open>{r::real. \<exists>N. \<forall>n\<ge>N. r < X n}\<close>
\<close>
lemma increasing_LIMSEQ:
fixes f :: "nat \<Rightarrow> real"
--- a/src/HOL/Relation.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Relation.thy Fri Jan 04 23:22:53 2019 +0100
@@ -1152,7 +1152,7 @@
lemmas Powp_mono [mono] = Pow_mono [to_pred]
-subsubsection \<open>Expressing relation operations via @{const Finite_Set.fold}\<close>
+subsubsection \<open>Expressing relation operations via \<^const>\<open>Finite_Set.fold\<close>\<close>
lemma Id_on_fold:
assumes "finite A"
--- a/src/HOL/Rings.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Rings.thy Fri Jan 04 23:22:53 2019 +0100
@@ -648,7 +648,7 @@
class divide =
fixes divide :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" (infixl "div" 70)
-setup \<open>Sign.add_const_constraint (@{const_name "divide"}, SOME @{typ "'a \<Rightarrow> 'a \<Rightarrow> 'a"})\<close>
+setup \<open>Sign.add_const_constraint (\<^const_name>\<open>divide\<close>, SOME \<^typ>\<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close>)\<close>
context semiring
begin
@@ -670,7 +670,7 @@
end
-setup \<open>Sign.add_const_constraint (@{const_name "divide"}, SOME @{typ "'a::divide \<Rightarrow> 'a \<Rightarrow> 'a"})\<close>
+setup \<open>Sign.add_const_constraint (\<^const_name>\<open>divide\<close>, SOME \<^typ>\<open>'a::divide \<Rightarrow> 'a \<Rightarrow> 'a\<close>)\<close>
text \<open>Algebraic classes with division\<close>
@@ -780,7 +780,7 @@
begin
text \<open>
- Class @{class algebraic_semidom} enriches a integral domain
+ Class \<^class>\<open>algebraic_semidom\<close> enriches a integral domain
by notions from algebra, like units in a ring.
It is a separate class to avoid spoiling fields with notions
which are degenerated there.
@@ -1292,9 +1292,9 @@
begin
text \<open>
- Class @{class normalization_semidom} cultivates the idea that each integral
+ Class \<^class>\<open>normalization_semidom\<close> cultivates the idea that each integral
domain can be split into equivalence classes whose representants are
- associated, i.e. divide each other. @{const normalize} specifies a canonical
+ associated, i.e. divide each other. \<^const>\<open>normalize\<close> specifies a canonical
representant for each equivalence class. The rationale behind this is that
it is easier to reason about equality than equivalences, hence we prefer to
think about equality of normalized values rather than associated elements.
@@ -1552,8 +1552,7 @@
text \<open>
We avoid an explicit definition of associated elements but prefer explicit
- normalisation instead. In theory we could define an abbreviation like @{prop
- "associated a b \<longleftrightarrow> normalize a = normalize b"} but this is counterproductive
+ normalisation instead. In theory we could define an abbreviation like \<^prop>\<open>associated a b \<longleftrightarrow> normalize a = normalize b\<close> but this is counterproductive
without suggestive infix syntax, which we do not want to sacrifice for this
purpose here.
\<close>
@@ -1770,8 +1769,8 @@
ML \<open>
structure Cancel_Div_Mod_Ring = Cancel_Div_Mod
(
- val div_name = @{const_name divide};
- val mod_name = @{const_name modulo};
+ val div_name = \<^const_name>\<open>divide\<close>;
+ val mod_name = \<^const_name>\<open>modulo\<close>;
val mk_binop = HOLogic.mk_binop;
val mk_sum = Arith_Data.mk_sum;
val dest_sum = Arith_Data.dest_sum;
@@ -2179,7 +2178,7 @@
using zero_le_mult_iff [of "- a" b] by auto
text \<open>
- Cancellation laws for @{term "c * a < c * b"} and @{term "a * c < b * c"},
+ Cancellation laws for \<^term>\<open>c * a < c * b\<close> and \<^term>\<open>a * c < b * c\<close>,
also with the relations \<open>\<le>\<close> and equality.
\<close>
--- a/src/HOL/Semiring_Normalization.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Semiring_Normalization.thy Fri Jan 04 23:22:53 2019 +0100
@@ -114,7 +114,7 @@
local_setup \<open>
Semiring_Normalizer.declare @{thm comm_semiring_1_axioms}
- {semiring = ([@{term "x + y"}, @{term "x * y"}, @{term "x ^ n"}, @{term 0}, @{term 1}],
+ {semiring = ([\<^term>\<open>x + y\<close>, \<^term>\<open>x * y\<close>, \<^term>\<open>x ^ n\<close>, \<^term>\<open>0\<close>, \<^term>\<open>1\<close>],
@{thms semiring_normalization_rules}),
ring = ([], []),
field = ([], []),
@@ -134,9 +134,9 @@
local_setup \<open>
Semiring_Normalizer.declare @{thm comm_ring_1_axioms}
- {semiring = ([@{term "x + y"}, @{term "x * y"}, @{term "x ^ n"}, @{term 0}, @{term 1}],
+ {semiring = ([\<^term>\<open>x + y\<close>, \<^term>\<open>x * y\<close>, \<^term>\<open>x ^ n\<close>, \<^term>\<open>0\<close>, \<^term>\<open>1\<close>],
@{thms semiring_normalization_rules}),
- ring = ([@{term "x - y"}, @{term "- x"}], @{thms ring_normalization_rules}),
+ ring = ([\<^term>\<open>x - y\<close>, \<^term>\<open>- x\<close>], @{thms ring_normalization_rules}),
field = ([], []),
idom = [],
ideal = []}
@@ -149,7 +149,7 @@
local_setup \<open>
Semiring_Normalizer.declare @{thm comm_semiring_1_cancel_crossproduct_axioms}
- {semiring = ([@{term "x + y"}, @{term "x * y"}, @{term "x ^ n"}, @{term 0}, @{term 1}],
+ {semiring = ([\<^term>\<open>x + y\<close>, \<^term>\<open>x * y\<close>, \<^term>\<open>x ^ n\<close>, \<^term>\<open>0\<close>, \<^term>\<open>1\<close>],
@{thms semiring_normalization_rules}),
ring = ([], []),
field = ([], []),
@@ -164,9 +164,9 @@
local_setup \<open>
Semiring_Normalizer.declare @{thm idom_axioms}
- {semiring = ([@{term "x + y"}, @{term "x * y"}, @{term "x ^ n"}, @{term 0}, @{term 1}],
+ {semiring = ([\<^term>\<open>x + y\<close>, \<^term>\<open>x * y\<close>, \<^term>\<open>x ^ n\<close>, \<^term>\<open>0\<close>, \<^term>\<open>1\<close>],
@{thms semiring_normalization_rules}),
- ring = ([@{term "x - y"}, @{term "- x"}], @{thms ring_normalization_rules}),
+ ring = ([\<^term>\<open>x - y\<close>, \<^term>\<open>- x\<close>], @{thms ring_normalization_rules}),
field = ([], []),
idom = @{thms crossproduct_noteq add_scale_eq_noteq},
ideal = @{thms right_minus_eq add_0_iff}}
@@ -179,10 +179,10 @@
local_setup \<open>
Semiring_Normalizer.declare @{thm field_axioms}
- {semiring = ([@{term "x + y"}, @{term "x * y"}, @{term "x ^ n"}, @{term 0}, @{term 1}],
+ {semiring = ([\<^term>\<open>x + y\<close>, \<^term>\<open>x * y\<close>, \<^term>\<open>x ^ n\<close>, \<^term>\<open>0\<close>, \<^term>\<open>1\<close>],
@{thms semiring_normalization_rules}),
- ring = ([@{term "x - y"}, @{term "- x"}], @{thms ring_normalization_rules}),
- field = ([@{term "x / y"}, @{term "inverse x"}], @{thms divide_inverse inverse_eq_divide}),
+ ring = ([\<^term>\<open>x - y\<close>, \<^term>\<open>- x\<close>], @{thms ring_normalization_rules}),
+ field = ([\<^term>\<open>x / y\<close>, \<^term>\<open>inverse x\<close>], @{thms divide_inverse inverse_eq_divide}),
idom = @{thms crossproduct_noteq add_scale_eq_noteq},
ideal = @{thms right_minus_eq add_0_iff}}
\<close>
--- a/src/HOL/Series.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Series.thy Fri Jan 04 23:22:53 2019 +0100
@@ -958,7 +958,7 @@
using Cauchy_product_sums[OF assms] by (simp add: sums_iff)
-subsection \<open>Series on @{typ real}s\<close>
+subsection \<open>Series on \<^typ>\<open>real\<close>s\<close>
lemma summable_norm_comparison_test:
"\<exists>N. \<forall>n\<ge>N. norm (f n) \<le> g n \<Longrightarrow> summable g \<Longrightarrow> summable (\<lambda>n. norm (f n))"
--- a/src/HOL/Set.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Set.thy Fri Jan 04 23:22:53 2019 +0100
@@ -232,18 +232,18 @@
print_translation \<open>
let
- val All_binder = Mixfix.binder_name @{const_syntax All};
- val Ex_binder = Mixfix.binder_name @{const_syntax Ex};
- val impl = @{const_syntax HOL.implies};
- val conj = @{const_syntax HOL.conj};
- val sbset = @{const_syntax subset};
- val sbset_eq = @{const_syntax subset_eq};
+ val All_binder = Mixfix.binder_name \<^const_syntax>\<open>All\<close>;
+ val Ex_binder = Mixfix.binder_name \<^const_syntax>\<open>Ex\<close>;
+ val impl = \<^const_syntax>\<open>HOL.implies\<close>;
+ val conj = \<^const_syntax>\<open>HOL.conj\<close>;
+ val sbset = \<^const_syntax>\<open>subset\<close>;
+ val sbset_eq = \<^const_syntax>\<open>subset_eq\<close>;
val trans =
- [((All_binder, impl, sbset), @{syntax_const "_setlessAll"}),
- ((All_binder, impl, sbset_eq), @{syntax_const "_setleAll"}),
- ((Ex_binder, conj, sbset), @{syntax_const "_setlessEx"}),
- ((Ex_binder, conj, sbset_eq), @{syntax_const "_setleEx"})];
+ [((All_binder, impl, sbset), \<^syntax_const>\<open>_setlessAll\<close>),
+ ((All_binder, impl, sbset_eq), \<^syntax_const>\<open>_setleAll\<close>),
+ ((Ex_binder, conj, sbset), \<^syntax_const>\<open>_setlessEx\<close>),
+ ((Ex_binder, conj, sbset_eq), \<^syntax_const>\<open>_setleEx\<close>)];
fun mk v (v', T) c n P =
if v = v' andalso not (Term.exists_subterm (fn Free (x, _) => x = v | _ => false) n)
@@ -251,9 +251,9 @@
else raise Match;
fun tr' q = (q, fn _ =>
- (fn [Const (@{syntax_const "_bound"}, _) $ Free (v, Type (@{type_name set}, _)),
+ (fn [Const (\<^syntax_const>\<open>_bound\<close>, _) $ Free (v, Type (\<^type_name>\<open>set\<close>, _)),
Const (c, _) $
- (Const (d, _) $ (Const (@{syntax_const "_bound"}, _) $ Free (v', T)) $ n) $ P] =>
+ (Const (d, _) $ (Const (\<^syntax_const>\<open>_bound\<close>, _) $ Free (v', T)) $ n) $ P] =>
(case AList.lookup (=) trans (q, c, d) of
NONE => raise Match
| SOME l => mk v (v', T) l n P)
@@ -275,58 +275,58 @@
parse_translation \<open>
let
- val ex_tr = snd (Syntax_Trans.mk_binder_tr ("EX ", @{const_syntax Ex}));
-
- fun nvars (Const (@{syntax_const "_idts"}, _) $ _ $ idts) = nvars idts + 1
+ val ex_tr = snd (Syntax_Trans.mk_binder_tr ("EX ", \<^const_syntax>\<open>Ex\<close>));
+
+ fun nvars (Const (\<^syntax_const>\<open>_idts\<close>, _) $ _ $ idts) = nvars idts + 1
| nvars _ = 1;
fun setcompr_tr ctxt [e, idts, b] =
let
- val eq = Syntax.const @{const_syntax HOL.eq} $ Bound (nvars idts) $ e;
- val P = Syntax.const @{const_syntax HOL.conj} $ eq $ b;
+ val eq = Syntax.const \<^const_syntax>\<open>HOL.eq\<close> $ Bound (nvars idts) $ e;
+ val P = Syntax.const \<^const_syntax>\<open>HOL.conj\<close> $ eq $ b;
val exP = ex_tr ctxt [idts, P];
- in Syntax.const @{const_syntax Collect} $ absdummy dummyT exP end;
-
- in [(@{syntax_const "_Setcompr"}, setcompr_tr)] end
+ in Syntax.const \<^const_syntax>\<open>Collect\<close> $ absdummy dummyT exP end;
+
+ in [(\<^syntax_const>\<open>_Setcompr\<close>, setcompr_tr)] end
\<close>
print_translation \<open>
- [Syntax_Trans.preserve_binder_abs2_tr' @{const_syntax Ball} @{syntax_const "_Ball"},
- Syntax_Trans.preserve_binder_abs2_tr' @{const_syntax Bex} @{syntax_const "_Bex"}]
+ [Syntax_Trans.preserve_binder_abs2_tr' \<^const_syntax>\<open>Ball\<close> \<^syntax_const>\<open>_Ball\<close>,
+ Syntax_Trans.preserve_binder_abs2_tr' \<^const_syntax>\<open>Bex\<close> \<^syntax_const>\<open>_Bex\<close>]
\<close> \<comment> \<open>to avoid eta-contraction of body\<close>
print_translation \<open>
let
- val ex_tr' = snd (Syntax_Trans.mk_binder_tr' (@{const_syntax Ex}, "DUMMY"));
+ val ex_tr' = snd (Syntax_Trans.mk_binder_tr' (\<^const_syntax>\<open>Ex\<close>, "DUMMY"));
fun setcompr_tr' ctxt [Abs (abs as (_, _, P))] =
let
- fun check (Const (@{const_syntax Ex}, _) $ Abs (_, _, P), n) = check (P, n + 1)
- | check (Const (@{const_syntax HOL.conj}, _) $
- (Const (@{const_syntax HOL.eq}, _) $ Bound m $ e) $ P, n) =
+ fun check (Const (\<^const_syntax>\<open>Ex\<close>, _) $ Abs (_, _, P), n) = check (P, n + 1)
+ | check (Const (\<^const_syntax>\<open>HOL.conj\<close>, _) $
+ (Const (\<^const_syntax>\<open>HOL.eq\<close>, _) $ Bound m $ e) $ P, n) =
n > 0 andalso m = n andalso not (loose_bvar1 (P, n)) andalso
subset (=) (0 upto (n - 1), add_loose_bnos (e, 0, []))
| check _ = false;
fun tr' (_ $ abs) =
let val _ $ idts $ (_ $ (_ $ _ $ e) $ Q) = ex_tr' ctxt [abs]
- in Syntax.const @{syntax_const "_Setcompr"} $ e $ idts $ Q end;
+ in Syntax.const \<^syntax_const>\<open>_Setcompr\<close> $ e $ idts $ Q end;
in
if check (P, 0) then tr' P
else
let
val (x as _ $ Free(xN, _), t) = Syntax_Trans.atomic_abs_tr' abs;
- val M = Syntax.const @{syntax_const "_Coll"} $ x $ t;
+ val M = Syntax.const \<^syntax_const>\<open>_Coll\<close> $ x $ t;
in
case t of
- Const (@{const_syntax HOL.conj}, _) $
- (Const (@{const_syntax Set.member}, _) $
- (Const (@{syntax_const "_bound"}, _) $ Free (yN, _)) $ A) $ P =>
- if xN = yN then Syntax.const @{syntax_const "_Collect"} $ x $ A $ P else M
+ Const (\<^const_syntax>\<open>HOL.conj\<close>, _) $
+ (Const (\<^const_syntax>\<open>Set.member\<close>, _) $
+ (Const (\<^syntax_const>\<open>_bound\<close>, _) $ Free (yN, _)) $ A) $ P =>
+ if xN = yN then Syntax.const \<^syntax_const>\<open>_Collect\<close> $ x $ A $ P else M
| _ => M
end
end;
- in [(@{const_syntax Collect}, setcompr_tr')] end
+ in [(\<^const_syntax>\<open>Collect\<close>, setcompr_tr')] end
\<close>
simproc_setup defined_Bex ("\<exists>x\<in>A. P x \<and> Q x") = \<open>
@@ -361,7 +361,7 @@
structure Simpdata =
struct
open Simpdata;
- val mksimps_pairs = [(@{const_name Ball}, @{thms bspec})] @ mksimps_pairs;
+ val mksimps_pairs = [(\<^const_name>\<open>Ball\<close>, @{thms bspec})] @ mksimps_pairs;
end;
open Simpdata;
@@ -515,8 +515,8 @@
text \<open>
\<^medskip>
Be careful when adding this to the claset as \<open>subset_empty\<close> is in the
- simpset: @{prop "A = {}"} goes to @{prop "{} \<subseteq> A"} and @{prop "A \<subseteq> {}"}
- and then back to @{prop "A = {}"}!
+ simpset: \<^prop>\<open>A = {}\<close> goes to \<^prop>\<open>{} \<subseteq> A\<close> and \<^prop>\<open>A \<subseteq> {}\<close>
+ and then back to \<^prop>\<open>A = {}\<close>!
\<close>
lemma equalityE: "A = B \<Longrightarrow> (A \<subseteq> B \<Longrightarrow> B \<subseteq> A \<Longrightarrow> P) \<Longrightarrow> P"
@@ -544,7 +544,7 @@
by simp
lemma empty_subsetI [iff]: "{} \<subseteq> A"
- \<comment> \<open>One effect is to delete the ASSUMPTION @{prop "{} \<subseteq> A"}\<close>
+ \<comment> \<open>One effect is to delete the ASSUMPTION \<^prop>\<open>{} \<subseteq> A\<close>\<close>
by blast
lemma equals0I: "(\<And>y. y \<in> A \<Longrightarrow> False) \<Longrightarrow> A = {}"
@@ -738,7 +738,7 @@
by blast
-subsubsection \<open>Augmenting a set -- @{const insert}\<close>
+subsubsection \<open>Augmenting a set -- \<^const>\<open>insert\<close>\<close>
lemma insert_iff [simp]: "a \<in> insert b A \<longleftrightarrow> a = b \<or> a \<in> A"
unfolding insert_def by blast
@@ -1516,7 +1516,7 @@
lemma subset_Compl_singleton [simp]: "A \<subseteq> - {b} \<longleftrightarrow> b \<notin> A"
by blast
-text \<open>\<^medskip> Quantification over type @{typ bool}.\<close>
+text \<open>\<^medskip> Quantification over type \<^typ>\<open>bool\<close>.\<close>
lemma bool_induct: "P True \<Longrightarrow> P False \<Longrightarrow> P x"
by (cases x) auto
--- a/src/HOL/Set_Interval.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Set_Interval.thy Fri Jan 04 23:22:53 2019 +0100
@@ -55,9 +55,8 @@
end
-text\<open>A note of warning when using @{term"{..<n}"} on type @{typ
-nat}: it is equivalent to @{term"{0::nat..<n}"} but some lemmas involving
-@{term"{m..<n}"} may not exist in @{term"{..<n}"}-form as well.\<close>
+text\<open>A note of warning when using \<^term>\<open>{..<n}\<close> on type \<^typ>\<open>nat\<close>: it is equivalent to \<^term>\<open>{0::nat..<n}\<close> but some lemmas involving
+\<^term>\<open>{m..<n}\<close> may not exist in \<^term>\<open>{..<n}\<close>-form as well.\<close>
syntax (ASCII)
"_UNION_le" :: "'a => 'a => 'b set => 'b set" ("(3UN _<=_./ _)" [0, 0, 10] 10)
@@ -672,7 +671,7 @@
subsection \<open>Intervals of natural numbers\<close>
-subsubsection \<open>The Constant @{term lessThan}\<close>
+subsubsection \<open>The Constant \<^term>\<open>lessThan\<close>\<close>
lemma lessThan_0 [simp]: "lessThan (0::nat) = {}"
by (simp add: lessThan_def)
@@ -682,7 +681,7 @@
text \<open>The following proof is convenient in induction proofs where
new elements get indices at the beginning. So it is used to transform
-@{term "{..<Suc n}"} to @{term "0::nat"} and @{term "{..< n}"}.\<close>
+\<^term>\<open>{..<Suc n}\<close> to \<^term>\<open>0::nat\<close> and \<^term>\<open>{..< n}\<close>.\<close>
lemma zero_notin_Suc_image: "0 \<notin> Suc ` A"
by auto
@@ -699,7 +698,7 @@
lemma UN_lessThan_UNIV: "(\<Union>m::nat. lessThan m) = UNIV"
by blast
-subsubsection \<open>The Constant @{term greaterThan}\<close>
+subsubsection \<open>The Constant \<^term>\<open>greaterThan\<close>\<close>
lemma greaterThan_0: "greaterThan 0 = range Suc"
unfolding greaterThan_def
@@ -712,7 +711,7 @@
lemma INT_greaterThan_UNIV: "(\<Inter>m::nat. greaterThan m) = {}"
by blast
-subsubsection \<open>The Constant @{term atLeast}\<close>
+subsubsection \<open>The Constant \<^term>\<open>atLeast\<close>\<close>
lemma atLeast_0 [simp]: "atLeast (0::nat) = UNIV"
by (unfold atLeast_def UNIV_def, simp)
@@ -726,7 +725,7 @@
lemma UN_atLeast_UNIV: "(\<Union>m::nat. atLeast m) = UNIV"
by blast
-subsubsection \<open>The Constant @{term atMost}\<close>
+subsubsection \<open>The Constant \<^term>\<open>atMost\<close>\<close>
lemma atMost_0 [simp]: "atMost (0::nat) = {0}"
by (simp add: atMost_def)
@@ -737,7 +736,7 @@
lemma UN_atMost_UNIV: "(\<Union>m::nat. atMost m) = UNIV"
by blast
-subsubsection \<open>The Constant @{term atLeastLessThan}\<close>
+subsubsection \<open>The Constant \<^term>\<open>atLeastLessThan\<close>\<close>
text\<open>The orientation of the following 2 rules is tricky. The lhs is
defined in terms of the rhs. Hence the chosen orientation makes sense
@@ -768,7 +767,7 @@
by (simp add: atLeast0LessThan lessThan_Suc_eq_insert_0)
-subsubsection \<open>The Constant @{term atLeastAtMost}\<close>
+subsubsection \<open>The Constant \<^term>\<open>atLeastAtMost\<close>\<close>
lemma Icc_eq_insert_lb_nat: "m \<le> n \<Longrightarrow> {m..n} = insert m {Suc m..n}"
by auto
@@ -782,7 +781,7 @@
by (simp add: atLeast0AtMost atMost_Suc_eq_insert_0)
-subsubsection \<open>Intervals of nats with @{term Suc}\<close>
+subsubsection \<open>Intervals of nats with \<^term>\<open>Suc\<close>\<close>
text\<open>Not a simprule because the RHS is too messy.\<close>
lemma atLeastLessThanSuc:
@@ -809,7 +808,7 @@
lemma atLeastAtMost_insertL: "m \<le> n \<Longrightarrow> insert m {Suc m..n} = {m ..n}"
by auto
-text \<open>The analogous result is useful on @{typ int}:\<close>
+text \<open>The analogous result is useful on \<^typ>\<open>int\<close>:\<close>
(* here, because we don't have an own int section *)
lemma atLeastAtMostPlus1_int_conv:
"m <= 1+n \<Longrightarrow> {m..1+n} = insert (1+n) {m..n::int}"
@@ -1795,10 +1794,10 @@
\begin{center}
\begin{tabular}{lll}
Old & New & \LaTeX\\
-@{term[source]"\<Sum>x\<in>{a..b}. e"} & @{term"\<Sum>x=a..b. e"} & @{term[mode=latex_sum]"\<Sum>x=a..b. e"}\\
-@{term[source]"\<Sum>x\<in>{a..<b}. e"} & @{term"\<Sum>x=a..<b. e"} & @{term[mode=latex_sum]"\<Sum>x=a..<b. e"}\\
-@{term[source]"\<Sum>x\<in>{..b}. e"} & @{term"\<Sum>x\<le>b. e"} & @{term[mode=latex_sum]"\<Sum>x\<le>b. e"}\\
-@{term[source]"\<Sum>x\<in>{..<b}. e"} & @{term"\<Sum>x<b. e"} & @{term[mode=latex_sum]"\<Sum>x<b. e"}
+@{term[source]"\<Sum>x\<in>{a..b}. e"} & \<^term>\<open>\<Sum>x=a..b. e\<close> & @{term[mode=latex_sum]"\<Sum>x=a..b. e"}\\
+@{term[source]"\<Sum>x\<in>{a..<b}. e"} & \<^term>\<open>\<Sum>x=a..<b. e\<close> & @{term[mode=latex_sum]"\<Sum>x=a..<b. e"}\\
+@{term[source]"\<Sum>x\<in>{..b}. e"} & \<^term>\<open>\<Sum>x\<le>b. e\<close> & @{term[mode=latex_sum]"\<Sum>x\<le>b. e"}\\
+@{term[source]"\<Sum>x\<in>{..<b}. e"} & \<^term>\<open>\<Sum>x<b. e\<close> & @{term[mode=latex_sum]"\<Sum>x<b. e"}
\end{tabular}
\end{center}
The left column shows the term before introduction of the new syntax,
@@ -1809,14 +1808,14 @@
antiquotations). It is not the default \LaTeX\ output because it only
works well with italic-style formulae, not tt-style.
-Note that for uniformity on @{typ nat} it is better to use
-@{term"\<Sum>x::nat=0..<n. e"} rather than \<open>\<Sum>x<n. e\<close>: \<open>sum\<close> may
-not provide all lemmas available for @{term"{m..<n}"} also in the
-special form for @{term"{..<n}"}.\<close>
+Note that for uniformity on \<^typ>\<open>nat\<close> it is better to use
+\<^term>\<open>\<Sum>x::nat=0..<n. e\<close> rather than \<open>\<Sum>x<n. e\<close>: \<open>sum\<close> may
+not provide all lemmas available for \<^term>\<open>{m..<n}\<close> also in the
+special form for \<^term>\<open>{..<n}\<close>.\<close>
text\<open>This congruence rule should be used for sums over intervals as
the standard theorem @{text[source]sum.cong} does not work well
-with the simplifier who adds the unsimplified premise @{term"x\<in>B"} to
+with the simplifier who adds the unsimplified premise \<^term>\<open>x\<in>B\<close> to
the context.\<close>
lemmas sum_ivl_cong = sum.ivl_cong
--- a/src/HOL/String.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/String.thy Fri Jan 04 23:22:53 2019 +0100
@@ -10,7 +10,7 @@
text \<open>
When modelling strings, we follow the approach given
- in @{url "https://utf8everywhere.org/"}:
+ in \<^url>\<open>https://utf8everywhere.org/\<close>:
\<^item> Strings are a list of bytes (8 bit).
@@ -668,9 +668,9 @@
| constant "(\<le>) :: String.literal \<Rightarrow> String.literal \<Rightarrow> bool" \<rightharpoonup>
(SML) "!((_ : string) <= _)"
and (OCaml) "!((_ : string) <= _)"
- \<comment> \<open>Order operations for @{typ String.literal} work in Haskell only
+ \<comment> \<open>Order operations for \<^typ>\<open>String.literal\<close> work in Haskell only
if no type class instance needs to be generated, because String = [Char] in Haskell
- and @{typ "char list"} need not have the same order as @{typ String.literal}.\<close>
+ and \<^typ>\<open>char list\<close> need not have the same order as \<^typ>\<open>String.literal\<close>.\<close>
and (Haskell) infix 4 "<="
and (Scala) infixl 4 "<="
and (Eval) infixl 6 "<="
--- a/src/HOL/TPTP/TPTP_Parser/tptp_syntax.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/TPTP/TPTP_Parser/tptp_syntax.ML Fri Jan 04 23:22:53 2019 +0100
@@ -289,7 +289,7 @@
type tptp_problem = tptp_line list
-fun debug f x = if Options.default_bool @{system_option ML_exception_trace} then (f x; ()) else ()
+fun debug f x = if Options.default_bool \<^system_option>\<open>ML_exception_trace\<close> then (f x; ()) else ()
fun pos_of_line tptp_line =
case tptp_line of
--- a/src/HOL/Tools/ATP/atp_problem_generate.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/ATP/atp_problem_generate.ML Fri Jan 04 23:22:53 2019 +0100
@@ -313,37 +313,37 @@
NONE
val proxy_table =
- [("c_False", (@{const_name False}, (@{thm fFalse_def}, ("fFalse", @{const_name fFalse})))),
- ("c_True", (@{const_name True}, (@{thm fTrue_def}, ("fTrue", @{const_name fTrue})))),
- ("c_Not", (@{const_name Not}, (@{thm fNot_def}, ("fNot", @{const_name fNot})))),
- ("c_conj", (@{const_name conj}, (@{thm fconj_def}, ("fconj", @{const_name fconj})))),
- ("c_disj", (@{const_name disj}, (@{thm fdisj_def}, ("fdisj", @{const_name fdisj})))),
- ("c_implies", (@{const_name implies}, (@{thm fimplies_def}, ("fimplies", @{const_name fimplies})))),
- ("equal", (@{const_name HOL.eq}, (@{thm fequal_def}, ("fequal", @{const_name fequal})))),
- ("c_All", (@{const_name All}, (@{thm fAll_def}, ("fAll", @{const_name fAll})))),
- ("c_Ex", (@{const_name Ex}, (@{thm fEx_def}, ("fEx", @{const_name fEx}))))]
+ [("c_False", (\<^const_name>\<open>False\<close>, (@{thm fFalse_def}, ("fFalse", \<^const_name>\<open>fFalse\<close>)))),
+ ("c_True", (\<^const_name>\<open>True\<close>, (@{thm fTrue_def}, ("fTrue", \<^const_name>\<open>fTrue\<close>)))),
+ ("c_Not", (\<^const_name>\<open>Not\<close>, (@{thm fNot_def}, ("fNot", \<^const_name>\<open>fNot\<close>)))),
+ ("c_conj", (\<^const_name>\<open>conj\<close>, (@{thm fconj_def}, ("fconj", \<^const_name>\<open>fconj\<close>)))),
+ ("c_disj", (\<^const_name>\<open>disj\<close>, (@{thm fdisj_def}, ("fdisj", \<^const_name>\<open>fdisj\<close>)))),
+ ("c_implies", (\<^const_name>\<open>implies\<close>, (@{thm fimplies_def}, ("fimplies", \<^const_name>\<open>fimplies\<close>)))),
+ ("equal", (\<^const_name>\<open>HOL.eq\<close>, (@{thm fequal_def}, ("fequal", \<^const_name>\<open>fequal\<close>)))),
+ ("c_All", (\<^const_name>\<open>All\<close>, (@{thm fAll_def}, ("fAll", \<^const_name>\<open>fAll\<close>)))),
+ ("c_Ex", (\<^const_name>\<open>Ex\<close>, (@{thm fEx_def}, ("fEx", \<^const_name>\<open>fEx\<close>))))]
val proxify_const = AList.lookup (op =) proxy_table #> Option.map (snd o snd)
(* Readable names for the more common symbolic functions. Do not mess with the
table unless you know what you are doing. *)
val const_trans_table =
- [(@{const_name False}, "False"),
- (@{const_name True}, "True"),
- (@{const_name Not}, "Not"),
- (@{const_name conj}, "conj"),
- (@{const_name disj}, "disj"),
- (@{const_name implies}, "implies"),
- (@{const_name HOL.eq}, "equal"),
- (@{const_name All}, "All"),
- (@{const_name Ex}, "Ex"),
- (@{const_name If}, "If"),
- (@{const_name Set.member}, "member"),
- (@{const_name Meson.COMBI}, combinator_prefix ^ "I"),
- (@{const_name Meson.COMBK}, combinator_prefix ^ "K"),
- (@{const_name Meson.COMBB}, combinator_prefix ^ "B"),
- (@{const_name Meson.COMBC}, combinator_prefix ^ "C"),
- (@{const_name Meson.COMBS}, combinator_prefix ^ "S")]
+ [(\<^const_name>\<open>False\<close>, "False"),
+ (\<^const_name>\<open>True\<close>, "True"),
+ (\<^const_name>\<open>Not\<close>, "Not"),
+ (\<^const_name>\<open>conj\<close>, "conj"),
+ (\<^const_name>\<open>disj\<close>, "disj"),
+ (\<^const_name>\<open>implies\<close>, "implies"),
+ (\<^const_name>\<open>HOL.eq\<close>, "equal"),
+ (\<^const_name>\<open>All\<close>, "All"),
+ (\<^const_name>\<open>Ex\<close>, "Ex"),
+ (\<^const_name>\<open>If\<close>, "If"),
+ (\<^const_name>\<open>Set.member\<close>, "member"),
+ (\<^const_name>\<open>Meson.COMBI\<close>, combinator_prefix ^ "I"),
+ (\<^const_name>\<open>Meson.COMBK\<close>, combinator_prefix ^ "K"),
+ (\<^const_name>\<open>Meson.COMBB\<close>, combinator_prefix ^ "B"),
+ (\<^const_name>\<open>Meson.COMBC\<close>, combinator_prefix ^ "C"),
+ (\<^const_name>\<open>Meson.COMBS\<close>, combinator_prefix ^ "S")]
|> Symtab.make
|> fold (Symtab.update o swap o snd o snd o snd) proxy_table
@@ -380,7 +380,7 @@
val choice_const = (fst o dest_Const o HOLogic.choice_const) dummyT
fun default c = const_prefix ^ lookup_const c
in
- fun make_fixed_const _ @{const_name HOL.eq} = tptp_old_equal
+ fun make_fixed_const _ \<^const_name>\<open>HOL.eq\<close> = tptp_old_equal
| make_fixed_const (SOME (Native (Higher_Order THF_With_Choice, _, _))) c =
if c = choice_const then tptp_choice else default c
| make_fixed_const _ c = default c
@@ -397,17 +397,17 @@
(* These are ignored anyway by the relevance filter (unless they appear in
higher-order places) but not by the monomorphizer. *)
val atp_logical_consts =
- [@{const_name Pure.prop}, @{const_name Pure.conjunction},
- @{const_name Pure.all}, @{const_name Pure.imp}, @{const_name Pure.eq},
- @{const_name Trueprop}, @{const_name All}, @{const_name Ex},
- @{const_name Ex1}, @{const_name Ball}, @{const_name Bex}]
+ [\<^const_name>\<open>Pure.prop\<close>, \<^const_name>\<open>Pure.conjunction\<close>,
+ \<^const_name>\<open>Pure.all\<close>, \<^const_name>\<open>Pure.imp\<close>, \<^const_name>\<open>Pure.eq\<close>,
+ \<^const_name>\<open>Trueprop\<close>, \<^const_name>\<open>All\<close>, \<^const_name>\<open>Ex\<close>,
+ \<^const_name>\<open>Ex1\<close>, \<^const_name>\<open>Ball\<close>, \<^const_name>\<open>Bex\<close>]
(* These are either simplified away by "Meson.presimplify" (most of the time) or
handled specially via "fFalse", "fTrue", ..., "fequal". *)
val atp_irrelevant_consts =
- [@{const_name False}, @{const_name True}, @{const_name Not}, @{const_name conj},
- @{const_name disj}, @{const_name implies}, @{const_name HOL.eq}, @{const_name If},
- @{const_name Let}]
+ [\<^const_name>\<open>False\<close>, \<^const_name>\<open>True\<close>, \<^const_name>\<open>Not\<close>, \<^const_name>\<open>conj\<close>,
+ \<^const_name>\<open>disj\<close>, \<^const_name>\<open>implies\<close>, \<^const_name>\<open>HOL.eq\<close>, \<^const_name>\<open>If\<close>,
+ \<^const_name>\<open>Let\<close>]
val atp_widely_irrelevant_consts = atp_logical_consts @ atp_irrelevant_consts
@@ -427,11 +427,11 @@
fun atp_schematic_consts_of t = add_schematic_consts_of t Symtab.empty
val tvar_a_str = "'a"
-val tvar_a_z = ((tvar_a_str, 0), @{sort type})
+val tvar_a_z = ((tvar_a_str, 0), \<^sort>\<open>type\<close>)
val tvar_a = TVar tvar_a_z
val tvar_a_name = tvar_name tvar_a_z
-val itself_name = `make_fixed_type_const @{type_name itself}
-val TYPE_name = `(make_fixed_const NONE) @{const_name Pure.type}
+val itself_name = `make_fixed_type_const \<^type_name>\<open>itself\<close>
+val TYPE_name = `(make_fixed_const NONE) \<^const_name>\<open>Pure.type\<close>
val tvar_a_atype = AType ((tvar_a_name, []), [])
val a_itself_atype = AType ((itself_name, []), [tvar_a_atype])
@@ -442,7 +442,7 @@
(* In our data structures, [] exceptionally refers to the top class, not to
the empty class. *)
-val class_of_types = the_single @{sort type}
+val class_of_types = the_single \<^sort>\<open>type\<close>
fun normalize_classes cls = if member (op =) cls class_of_types then [] else cls
@@ -451,7 +451,7 @@
let
val args = args |> map normalize_classes
val tvars =
- 1 upto length args |> map (fn j => TVar ((tvar_a_str, j), @{sort type}))
+ 1 upto length args |> map (fn j => TVar ((tvar_a_str, j), \<^sort>\<open>type\<close>))
in (name, args ~~ tvars, (cl, Type (s, tvars))) end
(* Generate all pairs (tycon, class, sorts) such that tycon belongs to class in
@@ -532,7 +532,7 @@
[new_skolem_const_prefix, s, string_of_int num_T_args]
|> Long_Name.implode
-val alpha_to_beta = Logic.varifyT_global @{typ "'a => 'b"}
+val alpha_to_beta = Logic.varifyT_global \<^typ>\<open>'a => 'b\<close>
val alpha_to_beta_to_alpha_to_beta = alpha_to_beta --> alpha_to_beta
fun robust_const_type thy s =
@@ -544,7 +544,7 @@
(* Old Skolems throw a "TYPE" exception here, which will be caught. *)
s |> Sign.the_const_type thy
-fun ary_of (Type (@{type_name fun}, [_, T])) = 1 + ary_of T
+fun ary_of (Type (\<^type_name>\<open>fun\<close>, [_, T])) = 1 + ary_of T
| ary_of _ = 0
(* This function only makes sense if "T" is as general as possible. *)
@@ -704,14 +704,14 @@
fun is_lambda_free t =
(case t of
@{const Not} $ t1 => is_lambda_free t1
- | Const (@{const_name All}, _) $ Abs (_, _, t') => is_lambda_free t'
- | Const (@{const_name All}, _) $ t1 => is_lambda_free t1
- | Const (@{const_name Ex}, _) $ Abs (_, _, t') => is_lambda_free t'
- | Const (@{const_name Ex}, _) $ t1 => is_lambda_free t1
+ | Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, _, t') => is_lambda_free t'
+ | Const (\<^const_name>\<open>All\<close>, _) $ t1 => is_lambda_free t1
+ | Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (_, _, t') => is_lambda_free t'
+ | Const (\<^const_name>\<open>Ex\<close>, _) $ t1 => is_lambda_free t1
| @{const HOL.conj} $ t1 $ t2 => is_lambda_free t1 andalso is_lambda_free t2
| @{const HOL.disj} $ t1 $ t2 => is_lambda_free t1 andalso is_lambda_free t2
| @{const HOL.implies} $ t1 $ t2 => is_lambda_free t1 andalso is_lambda_free t2
- | Const (@{const_name HOL.eq}, Type (_, [@{typ bool}, _])) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>HOL.eq\<close>, Type (_, [\<^typ>\<open>bool\<close>, _])) $ t1 $ t2 =>
is_lambda_free t1 andalso is_lambda_free t2
| _ => not (exists_subterm (fn Abs _ => true | _ => false) t))
@@ -723,16 +723,16 @@
fun trans Ts t =
(case t of
@{const Not} $ t1 => @{const Not} $ trans Ts t1
- | (t0 as Const (@{const_name All}, _)) $ Abs (s, T, t') =>
+ | (t0 as Const (\<^const_name>\<open>All\<close>, _)) $ Abs (s, T, t') =>
t0 $ Abs (s, T, trans (T :: Ts) t')
- | (t0 as Const (@{const_name All}, _)) $ t1 => trans Ts (t0 $ eta_expand Ts t1 1)
- | (t0 as Const (@{const_name Ex}, _)) $ Abs (s, T, t') =>
+ | (t0 as Const (\<^const_name>\<open>All\<close>, _)) $ t1 => trans Ts (t0 $ eta_expand Ts t1 1)
+ | (t0 as Const (\<^const_name>\<open>Ex\<close>, _)) $ Abs (s, T, t') =>
t0 $ Abs (s, T, trans (T :: Ts) t')
- | (t0 as Const (@{const_name Ex}, _)) $ t1 => trans Ts (t0 $ eta_expand Ts t1 1)
+ | (t0 as Const (\<^const_name>\<open>Ex\<close>, _)) $ t1 => trans Ts (t0 $ eta_expand Ts t1 1)
| (t0 as @{const HOL.conj}) $ t1 $ t2 => t0 $ trans Ts t1 $ trans Ts t2
| (t0 as @{const HOL.disj}) $ t1 $ t2 => t0 $ trans Ts t1 $ trans Ts t2
| (t0 as @{const HOL.implies}) $ t1 $ t2 => t0 $ trans Ts t1 $ trans Ts t2
- | (t0 as Const (@{const_name HOL.eq}, Type (_, [@{typ bool}, _]))) $ t1 $ t2 =>
+ | (t0 as Const (\<^const_name>\<open>HOL.eq\<close>, Type (_, [\<^typ>\<open>bool\<close>, _]))) $ t1 $ t2 =>
t0 $ trans Ts t1 $ trans Ts t2
| _ =>
if not (exists_subterm (fn Abs _ => true | _ => false) t) then t
@@ -795,9 +795,9 @@
fun lift_lams ctxt = lift_lams_part_2 ctxt oo lift_lams_part_1 ctxt
-fun intentionalize_def (Const (@{const_name All}, _) $ Abs (_, _, t)) =
+fun intentionalize_def (Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, _, t)) =
intentionalize_def t
- | intentionalize_def (Const (@{const_name HOL.eq}, _) $ t $ u) =
+ | intentionalize_def (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t $ u) =
let
fun lam T t = Abs (Name.uu, T, t)
val (head, args) = strip_comb t ||> rev
@@ -828,7 +828,7 @@
end
fun chop_fun 0 T = ([], T)
- | chop_fun n (Type (@{type_name fun}, [dom_T, ran_T])) =
+ | chop_fun n (Type (\<^type_name>\<open>fun\<close>, [dom_T, ran_T])) =
chop_fun (n - 1) ran_T |>> cons dom_T
| chop_fun _ T = ([], T)
@@ -864,7 +864,7 @@
val ctr_infer_type_args = gen_type_args fst strip_type
val level = level_of_type_enc type_enc
in
- if level = No_Types orelse s = @{const_name HOL.eq} orelse
+ if level = No_Types orelse s = \<^const_name>\<open>HOL.eq\<close> orelse
(case level of Const_Types _ => s = app_op_name | _ => false) then
[]
else if poly = Mangled_Monomorphic then
@@ -890,9 +890,9 @@
let
fun term (Type (s, Ts)) =
AType
- ((if s = @{type_name fun} andalso is_type_enc_higher_order type_enc then
+ ((if s = \<^type_name>\<open>fun\<close> andalso is_type_enc_higher_order type_enc then
`I tptp_fun_type
- else if s = @{type_name bool} andalso is_type_enc_full_higher_order type_enc then
+ else if s = \<^type_name>\<open>bool\<close> andalso is_type_enc_full_higher_order type_enc then
`I tptp_bool_type
else if s = fused_infinite_type_name andalso is_type_enc_native type_enc then
`I tptp_individual_type
@@ -960,7 +960,7 @@
fun generic_add_sorts_on_type _ [] = I
| generic_add_sorts_on_type T (s :: ss) =
generic_add_sorts_on_type T ss
- #> (if s = the_single @{sort type} then I else insert (op =) (s, T))
+ #> (if s = the_single \<^sort>\<open>type\<close> then I else insert (op =) (s, T))
fun add_sorts_on_tfree (T as TFree (_, S)) = generic_add_sorts_on_type T S
| add_sorts_on_tfree _ = I
fun add_sorts_on_tvar (T as TVar (_, S)) = generic_add_sorts_on_type T S
@@ -1199,16 +1199,16 @@
(case t of
@{const Trueprop} $ t1 => do_formula bs pos t1
| @{const Not} $ t1 => do_formula bs (Option.map not pos) t1 #>> mk_anot
- | Const (@{const_name All}, _) $ Abs (s, T, t') => do_quant bs AForall pos s T t'
- | (t0 as Const (@{const_name All}, _)) $ t1 =>
+ | Const (\<^const_name>\<open>All\<close>, _) $ Abs (s, T, t') => do_quant bs AForall pos s T t'
+ | (t0 as Const (\<^const_name>\<open>All\<close>, _)) $ t1 =>
do_formula bs pos (t0 $ eta_expand (map (snd o snd) bs) t1 1)
- | Const (@{const_name Ex}, _) $ Abs (s, T, t') => do_quant bs AExists pos s T t'
- | (t0 as Const (@{const_name Ex}, _)) $ t1 =>
+ | Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (s, T, t') => do_quant bs AExists pos s T t'
+ | (t0 as Const (\<^const_name>\<open>Ex\<close>, _)) $ t1 =>
do_formula bs pos (t0 $ eta_expand (map (snd o snd) bs) t1 1)
| @{const HOL.conj} $ t1 $ t2 => do_conn bs AAnd pos t1 pos t2
| @{const HOL.disj} $ t1 $ t2 => do_conn bs AOr pos t1 pos t2
| @{const HOL.implies} $ t1 $ t2 => do_conn bs AImplies (Option.map not pos) t1 pos t2
- | Const (@{const_name HOL.eq}, Type (_, [@{typ bool}, _])) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>HOL.eq\<close>, Type (_, [\<^typ>\<open>bool\<close>, _])) $ t1 $ t2 =>
if iff_for_eq then do_conn bs AIff NONE t1 NONE t2 else do_term bs t
| _ => do_term bs t)
in do_formula [] end
@@ -1255,7 +1255,7 @@
val t = t |> Envir.beta_eta_contract
|> transform_elim_prop
|> Object_Logic.atomize_term ctxt
- val need_trueprop = (fastype_of t = @{typ bool})
+ val need_trueprop = (fastype_of t = \<^typ>\<open>bool\<close>)
val is_ho = is_type_enc_full_higher_order type_enc
in
t |> need_trueprop ? HOLogic.mk_Trueprop
@@ -1311,7 +1311,7 @@
else
let
val footprint = tvar_footprint thy s ary
- val eq = (s = @{const_name HOL.eq})
+ val eq = (s = \<^const_name>\<open>HOL.eq\<close>)
fun cover _ [] = []
| cover seen ((i, tvars) :: args) =
cover (union (op =) seen tvars) args
@@ -1333,7 +1333,7 @@
(* These types witness that the type classes they belong to allow infinite
models and hence that any types with these type classes is monotonic. *)
-val known_infinite_types = [@{typ nat}, HOLogic.intT, HOLogic.realT, @{typ "nat => bool"}]
+val known_infinite_types = [\<^typ>\<open>nat\<close>, HOLogic.intT, HOLogic.realT, \<^typ>\<open>nat => bool\<close>]
fun is_type_kind_of_surely_infinite ctxt strictness cached_Ts T =
strictness <> Strict andalso is_type_surely_infinite ctxt true cached_Ts T
@@ -1393,7 +1393,7 @@
let
val should_encode = should_encode_type ctxt mono level
fun fuse 0 T = if should_encode T then T else fused_infinite_type
- | fuse ary (Type (@{type_name fun}, [T1, T2])) =
+ | fuse ary (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
fuse 0 T1 --> fuse (ary - 1) T2
| fuse _ _ = raise Fail "expected function type"
in fuse end
@@ -1405,7 +1405,7 @@
in_conj : bool}
fun default_sym_tab_entries type_enc =
- (make_fixed_const NONE @{const_name undefined},
+ (make_fixed_const NONE \<^const_name>\<open>undefined\<close>,
{pred_sym = false, min_ary = 0, max_ary = 0, types = [], in_conj = false}) ::
([tptp_false, tptp_true]
|> map (rpair {pred_sym = true, min_ary = 0, max_ary = 0, types = [], in_conj = false})) @
@@ -1435,11 +1435,11 @@
fun add_universal_var T (accum as ((bool_vars, fun_var_Ts), sym_tab)) =
if (app_op_level = Sufficient_App_Op andalso can dest_funT T) orelse
(app_op_level = Sufficient_App_Op_And_Predicator andalso
- (can dest_funT T orelse T = @{typ bool})) then
+ (can dest_funT T orelse T = \<^typ>\<open>bool\<close>)) then
let
val bool_vars' =
bool_vars orelse
- (app_op_level = Sufficient_App_Op_And_Predicator andalso body_type T = @{typ bool})
+ (app_op_level = Sufficient_App_Op_And_Predicator andalso body_type T = \<^typ>\<open>bool\<close>)
fun repair_min_ary {pred_sym, min_ary, max_ary, types, in_conj} =
{pred_sym = pred_sym andalso not bool_vars',
min_ary = fold (fn T' => consider_var_ary T' T) types min_ary,
@@ -1543,12 +1543,12 @@
SOME ({pred_sym, min_ary, max_ary, ...} : sym_info) => pred_sym andalso min_ary = max_ary
| NONE => false)
-val fTrue_iconst = IConst ((const_prefix ^ "fTrue", @{const_name fTrue}), @{typ bool}, [])
-val predicator_iconst = IConst (`(make_fixed_const NONE) predicator_name, @{typ "bool => bool"}, [])
+val fTrue_iconst = IConst ((const_prefix ^ "fTrue", \<^const_name>\<open>fTrue\<close>), \<^typ>\<open>bool\<close>, [])
+val predicator_iconst = IConst (`(make_fixed_const NONE) predicator_name, \<^typ>\<open>bool => bool\<close>, [])
fun predicatify completish tm =
if completish > 1 then
- IApp (IApp (IConst (`I tptp_equal, @{typ "bool => bool => bool"}, []), tm), fTrue_iconst)
+ IApp (IApp (IConst (`I tptp_equal, \<^typ>\<open>bool => bool => bool\<close>, []), tm), fTrue_iconst)
else
IApp (predicator_iconst, tm)
@@ -1788,7 +1788,7 @@
needed. *)
fun add_type_ctrs_in_term thy =
let
- fun add (Const (@{const_name Meson.skolem}, _) $ _) = I
+ fun add (Const (\<^const_name>\<open>Meson.skolem\<close>, _) $ _) = I
| add (t $ u) = add t #> add u
| add (Const x) =
x |> robust_const_type_args thy |> fold (fold_type_ctrs set_insert)
@@ -1814,8 +1814,8 @@
#> lift_lams_part_2 ctxt
else if lam_trans = combs_or_liftingN then
lift_lams_part_1 ctxt type_enc
- ##> map (fn t => (case head_of (strip_qnt_body @{const_name All} t) of
- @{term "(=) ::bool => bool => bool"} => t
+ ##> map (fn t => (case head_of (strip_qnt_body \<^const_name>\<open>All\<close> t) of
+ \<^term>\<open>(=) ::bool => bool => bool\<close> => t
| _ => introduce_combinators ctxt (intentionalize_def t)))
#> lift_lams_part_2 ctxt
else if lam_trans = keep_lamsN then
@@ -1848,8 +1848,8 @@
in List.partition (curry (op =) Definition o #role) #>> reorder [] #> op @ end
fun s_not_prop (@{const Trueprop} $ t) = @{const Trueprop} $ s_not t
- | s_not_prop (@{const Pure.imp} $ t $ @{prop False}) = t
- | s_not_prop t = @{const Pure.imp} $ t $ @{prop False}
+ | s_not_prop (@{const Pure.imp} $ t $ \<^prop>\<open>False\<close>) = t
+ | s_not_prop t = @{const Pure.imp} $ t $ \<^prop>\<open>False\<close>
fun translate_formulas ctxt prem_role format type_enc lam_trans presimp hyp_ts concl_t facts =
let
@@ -1858,7 +1858,7 @@
val fact_ts = facts |> map snd
(* Remove existing facts from the conjecture, as this can dramatically boost an ATP's
performance (for some reason). *)
- val hyp_ts = hyp_ts |> map (fn t => if member (op aconv) fact_ts t then @{prop True} else t)
+ val hyp_ts = hyp_ts |> map (fn t => if member (op aconv) fact_ts t then \<^prop>\<open>True\<close> else t)
val hyp_ts = map freeze_term hyp_ts;
val concl_t = freeze_term concl_t;
@@ -1899,7 +1899,7 @@
val type_guard = `(make_fixed_const NONE) type_guard_name
fun type_guard_iterm type_enc T tm =
- IApp (IConst (type_guard, T --> @{typ bool}, [T])
+ IApp (IConst (type_guard, T --> \<^typ>\<open>bool\<close>, [T])
|> mangle_type_args_in_iterm type_enc, tm)
fun is_var_positively_naked_in_term _ (SOME false) _ accum = accum
@@ -2159,7 +2159,7 @@
let
(* FIXME: make sure type arguments are filtered / clean up code *)
val (s, s') =
- `(make_fixed_const NONE) @{const_name undefined}
+ `(make_fixed_const NONE) \<^const_name>\<open>undefined\<close>
|> (is_type_enc_mangling type_enc ? mangled_const_name type_enc [T])
in
Symtab.map_default (s, [])
@@ -2169,7 +2169,7 @@
let val (s, s') = TYPE_name in
Symtab.map_default (s, [])
(insert_type thy #3
- (s', [tvar_a], @{typ "'a itself"}, false, 0, false))
+ (s', [tvar_a], \<^typ>\<open>'a itself\<close>, false, 0, false))
end
in
Symtab.empty
@@ -2185,9 +2185,9 @@
(* We add "bool" in case the helper "True_or_False" is included later. *)
fun default_mono level completish =
- {maybe_finite_Ts = [@{typ bool}],
+ {maybe_finite_Ts = [\<^typ>\<open>bool\<close>],
surely_infinite_Ts = (case level of Nonmono_Types (Strict, _) => [] | _ => known_infinite_types),
- maybe_nonmono_Ts = [if completish >= 3 then tvar_a else @{typ bool}]}
+ maybe_nonmono_Ts = [if completish >= 3 then tvar_a else \<^typ>\<open>bool\<close>]}
(* This inference is described in section 4 of Blanchette et al., "Encoding
monomorphic and polymorphic types", TACAS 2013. *)
@@ -2214,7 +2214,7 @@
| _ => mono)
fun update_mono_rec (IConst ((_, s'), Type (_, [T, _]), _)) =
- if String.isPrefix @{const_name fequal} s' then update_mono T else I
+ if String.isPrefix \<^const_name>\<open>fequal\<close> s' then update_mono T else I
| update_mono_rec (IApp (tm1, tm2)) = fold update_mono_rec [tm1, tm2]
| update_mono_rec (IAbs (_, tm)) = update_mono_rec tm
| update_mono_rec _ = I
@@ -2378,7 +2378,7 @@
fun rationalize_decls thy (decls as decl :: (decls' as _ :: _)) =
let
- val T = result_type_of_decl decl |> map_type_tvar (fn (z, _) => TVar (z, @{sort type}))
+ val T = result_type_of_decl decl |> map_type_tvar (fn (z, _) => TVar (z, \<^sort>\<open>type\<close>))
in
if forall (type_generalization thy T o result_type_of_decl) decls' then [decl]
else decls
--- a/src/HOL/Tools/ATP/atp_proof_reconstruct.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/ATP/atp_proof_reconstruct.ML Fri Jan 04 23:22:53 2019 +0100
@@ -107,26 +107,26 @@
fun make_tfree ctxt w =
let val ww = "'" ^ w in
- TFree (ww, the_default @{sort type} (Variable.def_sort ctxt (ww, ~1)))
+ TFree (ww, the_default \<^sort>\<open>type\<close> (Variable.def_sort ctxt (ww, ~1)))
end
-fun simplify_bool ((all as Const (@{const_name All}, _)) $ Abs (s, T, t)) =
+fun simplify_bool ((all as Const (\<^const_name>\<open>All\<close>, _)) $ Abs (s, T, t)) =
let val t' = simplify_bool t in
if loose_bvar1 (t', 0) then all $ Abs (s, T, t') else t'
end
- | simplify_bool (Const (@{const_name Not}, _) $ t) = s_not (simplify_bool t)
- | simplify_bool (Const (@{const_name conj}, _) $ t $ u) =
+ | simplify_bool (Const (\<^const_name>\<open>Not\<close>, _) $ t) = s_not (simplify_bool t)
+ | simplify_bool (Const (\<^const_name>\<open>conj\<close>, _) $ t $ u) =
s_conj (simplify_bool t, simplify_bool u)
- | simplify_bool (Const (@{const_name disj}, _) $ t $ u) =
+ | simplify_bool (Const (\<^const_name>\<open>disj\<close>, _) $ t $ u) =
s_disj (simplify_bool t, simplify_bool u)
- | simplify_bool (Const (@{const_name implies}, _) $ t $ u) =
+ | simplify_bool (Const (\<^const_name>\<open>implies\<close>, _) $ t $ u) =
s_imp (simplify_bool t, simplify_bool u)
- | simplify_bool ((t as Const (@{const_name HOL.eq}, _)) $ u $ v) =
+ | simplify_bool ((t as Const (\<^const_name>\<open>HOL.eq\<close>, _)) $ u $ v) =
(case (u, v) of
- (Const (@{const_name True}, _), _) => v
- | (u, Const (@{const_name True}, _)) => u
- | (Const (@{const_name False}, _), v) => s_not v
- | (u, Const (@{const_name False}, _)) => s_not u
+ (Const (\<^const_name>\<open>True\<close>, _), _) => v
+ | (u, Const (\<^const_name>\<open>True\<close>, _)) => u
+ | (Const (\<^const_name>\<open>False\<close>, _), v) => s_not v
+ | (u, Const (\<^const_name>\<open>False\<close>, _)) => s_not u
| _ => if u aconv v then @{const True} else t $ simplify_bool u $ simplify_bool v)
| simplify_bool (t $ u) = simplify_bool t $ simplify_bool u
| simplify_bool (Abs (s, T, t)) = Abs (s, T, simplify_bool t)
@@ -137,9 +137,9 @@
String.extract (Name.desymbolize (SOME upper) (Long_Name.base_name s'), 0, SOME 1)
end
-fun var_name_of_typ (Type (@{type_name fun}, [_, T])) =
+fun var_name_of_typ (Type (\<^type_name>\<open>fun\<close>, [_, T])) =
if body_type T = HOLogic.boolT then "p" else "f"
- | var_name_of_typ (Type (@{type_name set}, [T])) =
+ | var_name_of_typ (Type (\<^type_name>\<open>set\<close>, [T])) =
let fun default () = single_letter true (var_name_of_typ T) in
(case T of
Type (s, [T1, T2]) => if String.isSuffix "prod" s andalso T1 = T2 then "r" else default ()
@@ -197,7 +197,7 @@
Sometimes variables from the ATP are indistinguishable from Isabelle variables, which
forces us to use a type parameter in all cases. *)
Type_Infer.param 0 ("'" ^ perhaps (unprefix_and_unascii tvar_prefix) a,
- (if null clss then @{sort type} else map class_of_atp_class clss)))))
+ (if null clss then \<^sort>\<open>type\<close> else map class_of_atp_class clss)))))
end
| typ_of_atp_type ctxt (AFun (ty1, ty2)) = typ_of_atp_type ctxt ty1 --> typ_of_atp_type ctxt ty2
@@ -230,7 +230,7 @@
else
(s, Sign.the_const_type thy s) |> Sign.const_typargs thy |> length
-fun slack_fastype_of t = fastype_of t handle TERM _ => Type_Infer.anyT @{sort type}
+fun slack_fastype_of t = fastype_of t handle TERM _ => Type_Infer.anyT \<^sort>\<open>type\<close>
val spass_skolem_prefix = "sk" (* "skc" or "skf" *)
val vampire_skolem_prefix = "sK"
@@ -273,7 +273,7 @@
then error "Isar proof reconstruction failed because the ATP proof \
\contains unparsable material"
else if s = tptp_equal then
- list_comb (Const (@{const_name HOL.eq}, Type_Infer.anyT @{sort type}),
+ list_comb (Const (\<^const_name>\<open>HOL.eq\<close>, Type_Infer.anyT \<^sort>\<open>type\<close>),
map (do_term NONE) us)
else if not (null us) then
let
@@ -285,15 +285,15 @@
else if s = tptp_and then HOLogic.conj
else if s = tptp_implies then HOLogic.imp
else if s = tptp_iff orelse s = tptp_equal then HOLogic.eq_const dummyT
- else if s = tptp_not_iff orelse s = tptp_not_equal then @{term "\<lambda>P Q. Q \<noteq> P"}
- else if s = tptp_if then @{term "\<lambda>P Q. Q \<longrightarrow> P"}
- else if s = tptp_not_and then @{term "\<lambda>P Q. \<not> (P \<and> Q)"}
- else if s = tptp_not_or then @{term "\<lambda>P Q. \<not> (P \<or> Q)"}
+ else if s = tptp_not_iff orelse s = tptp_not_equal then \<^term>\<open>\<lambda>P Q. Q \<noteq> P\<close>
+ else if s = tptp_if then \<^term>\<open>\<lambda>P Q. Q \<longrightarrow> P\<close>
+ else if s = tptp_not_and then \<^term>\<open>\<lambda>P Q. \<not> (P \<and> Q)\<close>
+ else if s = tptp_not_or then \<^term>\<open>\<lambda>P Q. \<not> (P \<or> Q)\<close>
else if s = tptp_not then HOLogic.Not
else if s = tptp_ho_forall then HOLogic.all_const dummyT
else if s = tptp_ho_exists then HOLogic.exists_const dummyT
else if s = tptp_hilbert_choice then HOLogic.choice_const dummyT
- else if s = tptp_hilbert_the then @{term "The"}
+ else if s = tptp_hilbert_the then \<^term>\<open>The\<close>
else
(case unprefix_and_unascii const_prefix s of
SOME s' =>
@@ -311,7 +311,7 @@
|> (fn SOME T => T
| NONE =>
map slack_fastype_of term_ts --->
- the_default (Type_Infer.anyT @{sort type}) opt_T)
+ the_default (Type_Infer.anyT \<^sort>\<open>type\<close>) opt_T)
val t = Const (unproxify_const s', T)
in list_comb (t, term_ts) end
| NONE => (* a free or schematic variable *)
@@ -324,7 +324,7 @@
map slack_fastype_of ts --->
(case opt_T of
SOME T => T
- | NONE => Type_Infer.anyT @{sort type}))
+ | NONE => Type_Infer.anyT \<^sort>\<open>type\<close>))
val t =
(case unprefix_and_unascii fixed_var_prefix s of
SOME s => Free (s, T)
@@ -353,7 +353,7 @@
else if String.isPrefix native_type_prefix s then
@{const True} (* ignore TPTP type information (needed?) *)
else if s = tptp_equal then
- list_comb (Const (@{const_name HOL.eq}, Type_Infer.anyT @{sort type}),
+ list_comb (Const (\<^const_name>\<open>HOL.eq\<close>, Type_Infer.anyT \<^sort>\<open>type\<close>),
map (do_term [] NONE) us)
else
(case unprefix_and_unascii const_prefix s of
@@ -364,7 +364,7 @@
[typ_u, term_u] => do_term extra_ts (SOME (typ_of_atp_term ctxt typ_u)) term_u
| _ => raise ATP_TERM us)
else if s' = predicator_name then
- do_term [] (SOME @{typ bool}) (hd us)
+ do_term [] (SOME \<^typ>\<open>bool\<close>) (hd us)
else if s' = app_op_name then
let val extra_t = do_term [] NONE (List.last us) in
do_term (extra_t :: extra_ts)
@@ -391,7 +391,7 @@
|> (fn SOME T => T
| NONE =>
map slack_fastype_of term_ts --->
- the_default (Type_Infer.anyT @{sort type}) opt_T)
+ the_default (Type_Infer.anyT \<^sort>\<open>type\<close>) opt_T)
val t =
if new_skolem then Var ((new_skolem_var_name_of_const s'', var_index), T)
else Const (unproxify_const s', T)
@@ -414,7 +414,7 @@
| _ =>
(case opt_T of
SOME T => map slack_fastype_of term_ts ---> T
- | NONE => map slack_fastype_of ts ---> Type_Infer.anyT @{sort type}))
+ | NONE => map slack_fastype_of ts ---> Type_Infer.anyT \<^sort>\<open>type\<close>))
val t =
(case unprefix_and_unascii fixed_var_prefix s of
SOME s => Free (s, T)
@@ -438,7 +438,7 @@
add_type_constraint pos (type_constraint_of_term ctxt u)
#> pair @{const True}
else
- pair (term_of_atp ctxt format type_enc textual sym_tab (SOME @{typ bool}) u)
+ pair (term_of_atp ctxt format type_enc textual sym_tab (SOME \<^typ>\<open>bool\<close>) u)
(* Update schematic type variables with detected sort constraints. It's not
totally clear whether this code is necessary. *)
@@ -568,11 +568,11 @@
#> map (set_var_index 0)
val combinator_table =
- [(@{const_name Meson.COMBI}, @{thm Meson.COMBI_def [abs_def]}),
- (@{const_name Meson.COMBK}, @{thm Meson.COMBK_def [abs_def]}),
- (@{const_name Meson.COMBB}, @{thm Meson.COMBB_def [abs_def]}),
- (@{const_name Meson.COMBC}, @{thm Meson.COMBC_def [abs_def]}),
- (@{const_name Meson.COMBS}, @{thm Meson.COMBS_def [abs_def]})]
+ [(\<^const_name>\<open>Meson.COMBI\<close>, @{thm Meson.COMBI_def [abs_def]}),
+ (\<^const_name>\<open>Meson.COMBK\<close>, @{thm Meson.COMBK_def [abs_def]}),
+ (\<^const_name>\<open>Meson.COMBB\<close>, @{thm Meson.COMBB_def [abs_def]}),
+ (\<^const_name>\<open>Meson.COMBC\<close>, @{thm Meson.COMBC_def [abs_def]}),
+ (\<^const_name>\<open>Meson.COMBS\<close>, @{thm Meson.COMBS_def [abs_def]})]
fun uncombine_term thy =
let
@@ -674,7 +674,7 @@
val (haves, have_nots) =
HOLogic.disjuncts t
|> List.partition (exists_subterm (curry (op =) (Var v)))
- |> apply2 (fn lits => fold (curry s_disj) lits @{term False})
+ |> apply2 (fn lits => fold (curry s_disj) lits \<^term>\<open>False\<close>)
in
s_disj (HOLogic.all_const T
$ Abs (s, T, unskolem (safe_abstract_over (Var v, kill_skolem_arg haves))),
--- a/src/HOL/Tools/ATP/atp_satallax.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/ATP/atp_satallax.ML Fri Jan 04 23:22:53 2019 +0100
@@ -101,7 +101,7 @@
if state = 1 orelse state = 0 then
sep_dep l used_assumptions (x :: new_goals) generated_assumptions 1
else
- raise Fail ("incorrect Satallax proof: " ^ @{make_string} l)
+ raise Fail ("incorrect Satallax proof: " ^ \<^make_string> l)
in
sep_dep dependencies [] [] [] 0
end
@@ -156,7 +156,7 @@
fun find_proof_step ((x as Satallax_Step {id, ...}) :: l) h =
if h = id then x else find_proof_step l h
- | find_proof_step [] h = raise Fail ("not_found: " ^ @{make_string} h ^ " (probably a parsing \
+ | find_proof_step [] h = raise Fail ("not_found: " ^ \<^make_string> h ^ " (probably a parsing \
\error)")
fun remove_not_not (x as ATerm ((op1, _), [ATerm ((op2, _), [th])])) =
--- a/src/HOL/Tools/ATP/atp_systems.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/ATP/atp_systems.ML Fri Jan 04 23:22:53 2019 +0100
@@ -148,7 +148,7 @@
val sosN = "sos"
val no_sosN = "no_sos"
-val force_sos = Attrib.setup_config_bool @{binding atp_force_sos} (K false)
+val force_sos = Attrib.setup_config_bool \<^binding>\<open>atp_force_sos\<close> (K false)
val smartN = "smart"
(* val kboN = "kbo" *)
@@ -160,7 +160,7 @@
(* Possible values for "atp_term_order":
"smart", "(kbo|lpo)(_weights)?(_prec|_simp)?" *)
val term_order =
- Attrib.setup_config_string @{binding atp_term_order} (K smartN)
+ Attrib.setup_config_string \<^binding>\<open>atp_term_order\<close> (K smartN)
(* agsyHOL *)
@@ -213,20 +213,20 @@
val e_sym_offset_weightN = "sym_offset_weight"
val e_selection_heuristic =
- Attrib.setup_config_string @{binding atp_e_selection_heuristic} (K e_smartN)
+ Attrib.setup_config_string \<^binding>\<open>atp_e_selection_heuristic\<close> (K e_smartN)
(* FUDGE *)
val e_default_fun_weight =
- Attrib.setup_config_real @{binding atp_e_default_fun_weight} (K 20.0)
+ Attrib.setup_config_real \<^binding>\<open>atp_e_default_fun_weight\<close> (K 20.0)
val e_fun_weight_base =
- Attrib.setup_config_real @{binding atp_e_fun_weight_base} (K 0.0)
+ Attrib.setup_config_real \<^binding>\<open>atp_e_fun_weight_base\<close> (K 0.0)
val e_fun_weight_span =
- Attrib.setup_config_real @{binding atp_e_fun_weight_span} (K 40.0)
+ Attrib.setup_config_real \<^binding>\<open>atp_e_fun_weight_span\<close> (K 40.0)
val e_default_sym_offs_weight =
- Attrib.setup_config_real @{binding atp_e_default_sym_offs_weight} (K 1.0)
+ Attrib.setup_config_real \<^binding>\<open>atp_e_default_sym_offs_weight\<close> (K 1.0)
val e_sym_offs_weight_base =
- Attrib.setup_config_real @{binding atp_e_sym_offs_weight_base} (K ~20.0)
+ Attrib.setup_config_real \<^binding>\<open>atp_e_sym_offs_weight_base\<close> (K ~20.0)
val e_sym_offs_weight_span =
- Attrib.setup_config_real @{binding atp_e_sym_offs_weight_span} (K 60.0)
+ Attrib.setup_config_real \<^binding>\<open>atp_e_sym_offs_weight_span\<close> (K 60.0)
fun e_selection_heuristic_case heuristic fw sow =
if heuristic = e_fun_weightN then fw
@@ -496,7 +496,7 @@
val spass_H2SOS = "-Heuristic=2 -SOS"
val spass_extra_options =
- Attrib.setup_config_string @{binding atp_spass_extra_options} (K "")
+ Attrib.setup_config_string \<^binding>\<open>atp_spass_extra_options\<close> (K "")
val spass_config : atp_config =
{exec = K (["SPASS_HOME"], ["SPASS"]),
@@ -538,7 +538,7 @@
fun is_vampire_noncommercial_license_accepted () =
let
- val flag = Options.default_string @{system_option vampire_noncommercial}
+ val flag = Options.default_string \<^system_option>\<open>vampire_noncommercial\<close>
|> String.map Char.toLower
in
if flag = "yes" then
--- a/src/HOL/Tools/ATP/atp_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/ATP/atp_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -167,7 +167,7 @@
val type_equiv = Sign.typ_equiv
fun varify_type ctxt T =
- Variable.polymorphic_types ctxt [Const (@{const_name undefined}, T)]
+ Variable.polymorphic_types ctxt [Const (\<^const_name>\<open>undefined\<close>, T)]
|> snd |> the_single |> dest_Const |> snd
(* TODO: use "Term_Subst.instantiateT" instead? *)
@@ -202,7 +202,7 @@
SOME k => k
| NONE =>
case T of
- Type (@{type_name fun}, [T1, T2]) =>
+ Type (\<^type_name>\<open>fun\<close>, [T1, T2]) =>
(case (aux slack avoid T1, aux slack avoid T2) of
(k, 1) => if slack andalso k = 0 then 0 else 1
| (0, _) => 0
@@ -210,10 +210,10 @@
| (k1, k2) =>
if k1 >= max orelse k2 >= max then max
else Int.min (max, Integer.pow k2 k1))
- | Type (@{type_name set}, [T']) => aux slack avoid (T' --> @{typ bool})
- | @{typ prop} => 2
- | @{typ bool} => 2 (* optimization *)
- | @{typ nat} => 0 (* optimization *)
+ | Type (\<^type_name>\<open>set\<close>, [T']) => aux slack avoid (T' --> \<^typ>\<open>bool\<close>)
+ | \<^typ>\<open>prop\<close> => 2
+ | \<^typ>\<open>bool\<close> => 2 (* optimization *)
+ | \<^typ>\<open>nat\<close> => 0 (* optimization *)
| Type ("Int.int", []) => 0 (* optimization *)
| Type (s, _) =>
(case free_constructors_of ctxt T of
@@ -260,10 +260,10 @@
(* Simple simplifications to ensure that sort annotations don't leave a trail of
spurious "True"s. *)
-fun s_not (Const (@{const_name All}, T) $ Abs (s, T', t')) =
- Const (@{const_name Ex}, T) $ Abs (s, T', s_not t')
- | s_not (Const (@{const_name Ex}, T) $ Abs (s, T', t')) =
- Const (@{const_name All}, T) $ Abs (s, T', s_not t')
+fun s_not (Const (\<^const_name>\<open>All\<close>, T) $ Abs (s, T', t')) =
+ Const (\<^const_name>\<open>Ex\<close>, T) $ Abs (s, T', s_not t')
+ | s_not (Const (\<^const_name>\<open>Ex\<close>, T) $ Abs (s, T', t')) =
+ Const (\<^const_name>\<open>All\<close>, T) $ Abs (s, T', s_not t')
| s_not (@{const HOL.implies} $ t1 $ t2) = @{const HOL.conj} $ t1 $ s_not t2
| s_not (@{const HOL.conj} $ t1 $ t2) =
@{const HOL.disj} $ s_not t1 $ s_not t2
@@ -313,7 +313,7 @@
(Term.add_vars t []) t
fun hol_open_form unprefix
- (t as Const (@{const_name All}, _) $ Abs (s, T, t')) =
+ (t as Const (\<^const_name>\<open>All\<close>, _) $ Abs (s, T, t')) =
(case try unprefix s of
SOME s =>
let
@@ -332,15 +332,15 @@
(list_comb (incr_boundvars n t, map Bound (n - 1 downto 0)))
fun cong_extensionalize_term ctxt t =
- if exists_Const (fn (s, _) => s = @{const_name Not}) t then
+ if exists_Const (fn (s, _) => s = \<^const_name>\<open>Not\<close>) t then
t |> Skip_Proof.make_thm (Proof_Context.theory_of ctxt)
|> Meson.cong_extensionalize_thm ctxt
|> Thm.prop_of
else
t
-fun is_fun_equality (@{const_name HOL.eq},
- Type (_, [Type (@{type_name fun}, _), _])) = true
+fun is_fun_equality (\<^const_name>\<open>HOL.eq\<close>,
+ Type (_, [Type (\<^type_name>\<open>fun\<close>, _), _])) = true
| is_fun_equality _ = false
fun abs_extensionalize_term ctxt t =
@@ -352,12 +352,12 @@
fun unextensionalize_def t =
case t of
- @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ lhs $ rhs) =>
+ @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ lhs $ rhs) =>
(case strip_comb lhs of
(c as Const (_, T), args) =>
if forall is_Var args andalso not (has_duplicates (op =) args) then
@{const Trueprop}
- $ (Const (@{const_name HOL.eq}, T --> T --> @{typ bool})
+ $ (Const (\<^const_name>\<open>HOL.eq\<close>, T --> T --> \<^typ>\<open>bool\<close>)
$ c $ fold_rev lambda args rhs)
else
t
@@ -370,9 +370,9 @@
"Meson_Clausify".) *)
fun transform_elim_prop t =
case Logic.strip_imp_concl t of
- @{const Trueprop} $ Var (z, @{typ bool}) =>
+ @{const Trueprop} $ Var (z, \<^typ>\<open>bool\<close>) =>
subst_Vars [(z, @{const False})] t
- | Var (z, @{typ prop}) => subst_Vars [(z, @{prop False})] t
+ | Var (z, \<^typ>\<open>prop\<close>) => subst_Vars [(z, \<^prop>\<open>False\<close>)] t
| _ => t
fun specialize_type thy (s, T) t =
@@ -401,7 +401,7 @@
val concl_t = t |> Logic.strip_assums_concl |> curry subst_bounds frees
in (rev params, hyp_ts, concl_t) end
-fun extract_lambda_def dest_head (Const (@{const_name HOL.eq}, _) $ t $ u) =
+fun extract_lambda_def dest_head (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t $ u) =
let val (head, args) = strip_comb t in
(head |> dest_head |> fst,
fold_rev (fn t as Var ((s, _), T) =>
--- a/src/HOL/Tools/ATP/atp_waldmeister.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/ATP/atp_waldmeister.ML Fri Jan 04 23:22:53 2019 +0100
@@ -47,8 +47,8 @@
open HOLogic
-fun contains_quantor (Const (@{const_name Ex}, _) $ _) = true
- | contains_quantor (Const (@{const_name All}, _) $ _) = true
+fun contains_quantor (Const (\<^const_name>\<open>Ex\<close>, _) $ _) = true
+ | contains_quantor (Const (\<^const_name>\<open>All\<close>, _) $ _) = true
| contains_quantor (t1 $ t2) = contains_quantor t1 orelse contains_quantor t2
| contains_quantor _ = false
@@ -93,22 +93,22 @@
(ctxt1, ctxt2', spets, trm', var :: vars)
end
-fun skolemize' pos ctxt1 ctxt2 spets vars (Const (@{const_name Not}, _) $ trm') =
+fun skolemize' pos ctxt1 ctxt2 spets vars (Const (\<^const_name>\<open>Not\<close>, _) $ trm') =
let
val (ctxt1', ctxt2', spets', trm'') = skolemize' (not pos) ctxt1 ctxt2 spets vars trm'
in
(ctxt1', ctxt2', map mk_not spets', mk_not trm'')
end
- | skolemize' pos ctxt1 ctxt2 spets vars (trm as (Const (@{const_name HOL.eq}, t) $ a $ b)) =
- if t = @{typ "bool \<Rightarrow> bool \<Rightarrow> bool"} andalso contains_quantor trm then
+ | skolemize' pos ctxt1 ctxt2 spets vars (trm as (Const (\<^const_name>\<open>HOL.eq\<close>, t) $ a $ b)) =
+ if t = \<^typ>\<open>bool \<Rightarrow> bool \<Rightarrow> bool\<close> andalso contains_quantor trm then
skolemize' pos ctxt1 ctxt2 (trm :: spets) vars (mk_conj (mk_imp (a, b), mk_imp (b, a)))
else
(ctxt1, ctxt2, spets, trm)
| skolemize' pos ctxt1 ctxt2 spets vars (trm as (Const (name, _) $ Abs x)) =
- if name = @{const_name Ex} orelse name = @{const_name All} then
+ if name = \<^const_name>\<open>Ex\<close> orelse name = \<^const_name>\<open>All\<close> then
let
- val is_free = (name = @{const_name Ex} andalso pos)
- orelse (name = @{const_name All} andalso not pos)
+ val is_free = (name = \<^const_name>\<open>Ex\<close> andalso pos)
+ orelse (name = \<^const_name>\<open>All\<close> andalso not pos)
val (ctxt1', ctxt2', spets', trm', vars') =
skolem_bound is_free ctxt1 ctxt2 (if is_free then trm :: spets else spets) vars x
in
@@ -117,10 +117,10 @@
else
(ctxt1, ctxt2, spets, trm)
| skolemize' pos ctxt1 ctxt2 spets vars ((c as Const (name, _)) $ a $ b) =
- if name = @{const_name conj} orelse name = @{const_name disj} orelse
- name = @{const_name implies} then
+ if name = \<^const_name>\<open>conj\<close> orelse name = \<^const_name>\<open>disj\<close> orelse
+ name = \<^const_name>\<open>implies\<close> then
let
- val pos_a = if name = @{const_name implies} then not pos else pos
+ val pos_a = if name = \<^const_name>\<open>implies\<close> then not pos else pos
val (ctxt1', ctxt2', spets', a') = skolemize' pos_a ctxt1 ctxt2 [] vars a
val (ctxt1'', ctxt2'', spets'', b') = skolemize' pos ctxt1' ctxt2' [] vars b
in
@@ -248,8 +248,8 @@
fun gen_ascii_tuple str = (str, ascii_of str)
-fun mk_eq_true (trm as (Const (@{const_name HOL.eq}, _) $ _ $ _)) = (NONE,trm)
- | mk_eq_true trm = (SOME trm,HOLogic.mk_eq (trm, @{term True}))
+fun mk_eq_true (trm as (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ _)) = (NONE,trm)
+ | mk_eq_true trm = (SOME trm,HOLogic.mk_eq (trm, \<^term>\<open>True\<close>))
val is_lambda_name = String.isPrefix lam_lifted_poly_prefix
@@ -358,7 +358,7 @@
fun trm_to_atp' thy trm = trm_to_atp'' thy trm [] |> hd
-fun eq_trm_to_atp thy (Const (@{const_name HOL.eq}, _) $ lhs $ rhs) =
+fun eq_trm_to_atp thy (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ lhs $ rhs) =
ATerm ((("equal", "equal"), []), [trm_to_atp' thy lhs, trm_to_atp' thy rhs])
| eq_trm_to_atp _ _ = raise FailureMessage (WM_ERROR_MSG ^ "Non-eq term")
@@ -399,9 +399,9 @@
(WM_ERROR_MSG ^ "waldmeister equals needs 2 arguments but has " ^
Int.toString (length args)))
else if name = waldmeister_true then
- @{term True}
+ \<^term>\<open>True\<close>
else if name = waldmeister_false then
- @{term False}
+ \<^term>\<open>False\<close>
else
raise FailureMessage
(WM_ERROR_MSG ^ "Unknown name prefix when parsing Waldmeister proof: name = " ^ name)
@@ -415,7 +415,7 @@
fun atp_to_trm thy (ATerm (("equal", _), [lhs, rhs])) =
mk_eq (atp_to_trm' thy lhs, atp_to_trm' thy rhs)
- | atp_to_trm _ (ATerm (("$true", _), _)) = @{term True}
+ | atp_to_trm _ (ATerm (("$true", _), _)) = \<^term>\<open>True\<close>
| atp_to_trm _ _ = raise FailureMessage (WM_ERROR_MSG ^ "atp_to_trm expects ATerm")
fun formula_to_trm thy (AAtom aterm) = aterm |> atp_to_trm thy
@@ -562,7 +562,7 @@
SOME (_, (step :: steps,_)) =>
let
val raw_trm = dest_Trueprop trm
- val is_narrowing = raw_trm = @{term "True = False"} orelse raw_trm = @{term "False = True"}
+ val is_narrowing = raw_trm = \<^term>\<open>True = False\<close> orelse raw_trm = \<^term>\<open>False = True\<close>
val is_conjecture = String.isPrefix "1.0.0.0" waldmeister_name andalso not is_narrowing
in
if is_narrowing then
--- a/src/HOL/Tools/BNF/bnf_axiomatization.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_axiomatization.ML Fri Jan 04 23:22:53 2019 +0100
@@ -103,26 +103,26 @@
val bnf_axiomatization = prepare_decl (K I) (K I) (K I);
-fun read_constraint _ NONE = @{sort type}
+fun read_constraint _ NONE = \<^sort>\<open>type\<close>
| read_constraint ctxt (SOME s) = Syntax.read_sort ctxt s;
val bnf_axiomatization_cmd = prepare_decl Plugin_Name.make_filter read_constraint Syntax.read_typ;
val parse_witTs =
- @{keyword "["} |-- (Parse.name --| @{keyword ":"} -- Scan.repeat Parse.typ
+ \<^keyword>\<open>[\<close> |-- (Parse.name --| \<^keyword>\<open>:\<close> -- Scan.repeat Parse.typ
>> (fn ("wits", Ts) => Ts
| (s, _) => error ("Unknown label " ^ quote s ^ " (expected \"wits\")"))) --|
- @{keyword "]"} || Scan.succeed [];
+ \<^keyword>\<open>]\<close> || Scan.succeed [];
val parse_bnf_axiomatization_options =
- Scan.optional (@{keyword "("} |-- Plugin_Name.parse_filter --| @{keyword ")"}) (K (K true));
+ Scan.optional (\<^keyword>\<open>(\<close> |-- Plugin_Name.parse_filter --| \<^keyword>\<open>)\<close>) (K (K true));
val parse_bnf_axiomatization =
parse_bnf_axiomatization_options -- parse_type_args_named_constrained -- Parse.binding --
parse_witTs -- Parse.opt_mixfix -- parse_map_rel_pred_bindings;
val _ =
- Outer_Syntax.local_theory @{command_keyword bnf_axiomatization} "bnf declaration"
+ Outer_Syntax.local_theory \<^command_keyword>\<open>bnf_axiomatization\<close> "bnf declaration"
(parse_bnf_axiomatization >>
(fn (((((plugins, bsTs), b), witTs), mx), (mapb, relb, predb)) =>
bnf_axiomatization_cmd plugins bsTs b mx mapb relb predb witTs #> snd));
--- a/src/HOL/Tools/BNF/bnf_comp.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_comp.ML Fri Jan 04 23:22:53 2019 +0100
@@ -83,7 +83,7 @@
open BNF_Tactics
open BNF_Comp_Tactics
-val typedef_threshold = Attrib.setup_config_int @{binding bnf_typedef_threshold} (K 6);
+val typedef_threshold = Attrib.setup_config_int \<^binding>\<open>bnf_typedef_threshold\<close> (K 6);
fun with_typedef_threshold threshold f lthy =
lthy
@@ -97,8 +97,8 @@
|> f
||> Config.put typedef_threshold (Config.get lthy typedef_threshold);
-val ID_bnf = the (bnf_of @{context} "BNF_Composition.ID");
-val DEADID_bnf = the (bnf_of @{context} "BNF_Composition.DEADID");
+val ID_bnf = the (bnf_of \<^context> "BNF_Composition.ID");
+val DEADID_bnf = the (bnf_of \<^context> "BNF_Composition.DEADID");
type comp_cache = (bnf * (typ list * typ list)) Typtab.table;
@@ -160,9 +160,9 @@
val id_bnf_def = @{thm id_bnf_def};
val expand_id_bnf_def = expand_term_const [Thm.prop_of id_bnf_def |> Logic.dest_equals];
-fun is_sum_prod_natLeq (Const (@{const_name csum}, _) $ t $ u) = forall is_sum_prod_natLeq [t, u]
- | is_sum_prod_natLeq (Const (@{const_name cprod}, _) $ t $ u) = forall is_sum_prod_natLeq [t, u]
- | is_sum_prod_natLeq t = t aconv @{term natLeq};
+fun is_sum_prod_natLeq (Const (\<^const_name>\<open>csum\<close>, _) $ t $ u) = forall is_sum_prod_natLeq [t, u]
+ | is_sum_prod_natLeq (Const (\<^const_name>\<open>cprod\<close>, _) $ t $ u) = forall is_sum_prod_natLeq [t, u]
+ | is_sum_prod_natLeq t = t aconv \<^term>\<open>natLeq\<close>;
fun clean_compose_bnf const_policy qualify b outer inners (unfold_set, lthy) =
let
@@ -183,11 +183,11 @@
val (Dss, lthy2) = apfst (map (map TFree))
(fold_map Variable.invent_types (map (map Type.sort_of_atyp) ideadss) lthy1);
val (Ass, lthy3) = apfst (replicate ilive o map TFree)
- (Variable.invent_types (replicate ilive @{sort type}) lthy2);
+ (Variable.invent_types (replicate ilive \<^sort>\<open>type\<close>) lthy2);
val As = if ilive > 0 then hd Ass else [];
val Ass_repl = replicate olive As;
val (Bs, names_lthy) = apfst (map TFree)
- (Variable.invent_types (replicate ilive @{sort type}) lthy3);
+ (Variable.invent_types (replicate ilive \<^sort>\<open>type\<close>) lthy3);
val Bss_repl = replicate olive Bs;
val (((((fs', Qs'), Ps'), Asets), xs), _) = names_lthy
@@ -246,7 +246,7 @@
fun mk_simplified_set set =
let
val setT = fastype_of set;
- val var_set' = Const (@{const_name id_bnf}, setT --> setT) $ Var ((Name.uu, 0), setT);
+ val var_set' = Const (\<^const_name>\<open>id_bnf\<close>, setT --> setT) $ Var ((Name.uu, 0), setT);
val goal = mk_Trueprop_eq (var_set', set);
fun tac {context = ctxt, prems = _} =
mk_simplified_set_tac ctxt (collect_set_map_of_bnf outer);
@@ -268,9 +268,9 @@
val (bd', bd_ordIso_natLeq_thm_opt) =
if is_sum_prod_natLeq bd then
let
- val bd' = @{term natLeq};
+ val bd' = \<^term>\<open>natLeq\<close>;
val bd_bd' = HOLogic.mk_prod (bd, bd');
- val ordIso = Const (@{const_name ordIso}, HOLogic.mk_setT (fastype_of bd_bd'));
+ val ordIso = Const (\<^const_name>\<open>ordIso\<close>, HOLogic.mk_setT (fastype_of bd_bd'));
val goal = mk_Trueprop_mem (bd_bd', ordIso);
in
(bd', SOME (Goal.prove_sorry lthy [] [] goal (bd_ordIso_natLeq_tac o #context)
@@ -423,14 +423,14 @@
val (Ds, lthy1) = apfst (map TFree)
(Variable.invent_types (map Type.sort_of_atyp deads) lthy);
val ((killedAs, As), lthy2) = apfst (`(take n) o map TFree)
- (Variable.invent_types (replicate live @{sort type}) lthy1);
+ (Variable.invent_types (replicate live \<^sort>\<open>type\<close>) lthy1);
val (Bs, _(*lthy3*)) = apfst (append killedAs o map TFree)
- (Variable.invent_types (replicate (live - n) @{sort type}) lthy2);
+ (Variable.invent_types (replicate (live - n) \<^sort>\<open>type\<close>) lthy2);
val ((Asets, lives), _(*names_lthy*)) = lthy
|> mk_Frees "A" (map HOLogic.mk_setT (drop n As))
||>> mk_Frees "x" (drop n As);
- val xs = map (fn T => Const (@{const_name undefined}, T)) killedAs @ lives;
+ val xs = map (fn T => Const (\<^const_name>\<open>undefined\<close>, T)) killedAs @ lives;
val T = mk_T_of_bnf Ds As bnf;
@@ -440,7 +440,7 @@
val rel = Term.list_comb (mk_rel_of_bnf Ds As Bs bnf, map HOLogic.eq_const killedAs);
(*bnf.pred (%_. True) ... (%_ True)*)
val pred = Term.list_comb (mk_pred_of_bnf Ds As bnf,
- map (fn T => Term.absdummy T @{term True}) killedAs);
+ map (fn T => Term.absdummy T \<^term>\<open>True\<close>) killedAs);
val bnf_sets = mk_sets_of_bnf (replicate live Ds) (replicate live As) bnf;
val sets = drop n bnf_sets;
@@ -529,9 +529,9 @@
val (Ds, lthy1) = apfst (map TFree)
(Variable.invent_types (map Type.sort_of_atyp deads) lthy);
val ((newAs, As), lthy2) = apfst (chop n o map TFree)
- (Variable.invent_types (replicate (n + live) @{sort type}) lthy1);
+ (Variable.invent_types (replicate (n + live) \<^sort>\<open>type\<close>) lthy1);
val ((newBs, Bs), _(*lthy3*)) = apfst (chop n o map TFree)
- (Variable.invent_types (replicate (n + live) @{sort type}) lthy2);
+ (Variable.invent_types (replicate (n + live) \<^sort>\<open>type\<close>) lthy2);
val (Asets, _(*names_lthy*)) = lthy
|> mk_Frees "A" (map HOLogic.mk_setT (newAs @ As));
@@ -626,9 +626,9 @@
val (Ds, lthy1) = apfst (map TFree)
(Variable.invent_types (map Type.sort_of_atyp deads) lthy);
val (As, lthy2) = apfst (map TFree)
- (Variable.invent_types (replicate live @{sort type}) lthy1);
+ (Variable.invent_types (replicate live \<^sort>\<open>type\<close>) lthy1);
val (Bs, _(*lthy3*)) = apfst (map TFree)
- (Variable.invent_types (replicate live @{sort type}) lthy2);
+ (Variable.invent_types (replicate live \<^sort>\<open>type\<close>) lthy2);
val (Asets, _(*names_lthy*)) = lthy
|> mk_Frees "A" (map HOLogic.mk_setT (permute As));
@@ -801,8 +801,8 @@
else raise Term.TYPE ("mk_repT", [absT, repT, absU], [])
| _ => raise Term.TYPE ("mk_repT", [absT, repT, absU], []));
-fun mk_abs_or_rep _ absU (Const (@{const_name id_bnf}, _)) =
- Const (@{const_name id_bnf}, absU --> absU)
+fun mk_abs_or_rep _ absU (Const (\<^const_name>\<open>id_bnf\<close>, _)) =
+ Const (\<^const_name>\<open>id_bnf\<close>, absU --> absU)
| mk_abs_or_rep getT (Type (_, Us)) abs =
let val Ts = snd (dest_Type (getT (fastype_of abs)))
in Term.subst_atomic_types (Ts ~~ Us) abs end;
@@ -825,7 +825,7 @@
(Rep_name, Abs_name, type_definition, Abs_inverse, Abs_inject, Abs_cases)))
else
((repT,
- (@{const_name id_bnf}, @{const_name id_bnf},
+ (\<^const_name>\<open>id_bnf\<close>, \<^const_name>\<open>id_bnf\<close>,
@{thm type_definition_id_bnf_UNIV},
@{thm type_definition.Abs_inverse[OF type_definition_id_bnf_UNIV]},
@{thm type_definition.Abs_inject[OF type_definition_id_bnf_UNIV]},
@@ -838,8 +838,8 @@
val nwits = nwits_of_bnf bnf;
val ((As, As'), lthy1) = apfst (`(map TFree))
- (Variable.invent_types (replicate live @{sort type}) (fold Variable.declare_typ all_Ds lthy));
- val (Bs, _) = apfst (map TFree) (Variable.invent_types (replicate live @{sort type}) lthy1);
+ (Variable.invent_types (replicate live \<^sort>\<open>type\<close>) (fold Variable.declare_typ all_Ds lthy));
+ val (Bs, _) = apfst (map TFree) (Variable.invent_types (replicate live \<^sort>\<open>type\<close>) lthy1);
val ((((fs, fs'), (Rs, Rs')), (Ps, Ps')), _(*names_lthy*)) = lthy
|> mk_Frees' "f" (map2 (curry op -->) As Bs)
--- a/src/HOL/Tools/BNF/bnf_def.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_def.ML Fri Jan 04 23:22:53 2019 +0100
@@ -710,7 +710,7 @@
fun normalize_wit insts CA As wit =
let
- fun strip_param (Ts, T as Type (@{type_name fun}, [T1, T2])) =
+ fun strip_param (Ts, T as Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
if Type.raw_instance (CA, T) then (Ts, T) else strip_param (T1 :: Ts, T2)
| strip_param x = x;
val (Ts, T) = strip_param ([], fastype_of wit);
@@ -777,9 +777,9 @@
in build end;
val build_map = build_map_or_rel mk_map HOLogic.id_const map_of_bnf dest_funT
- [(@{type_name set}, (1, @{term image}))];
+ [(\<^type_name>\<open>set\<close>, (1, \<^term>\<open>image\<close>))];
val build_rel = build_map_or_rel mk_rel HOLogic.eq_const rel_of_bnf dest_pred2T o append
- [(@{type_name set}, (1, @{term rel_set})), (@{type_name fun}, (2, @{term rel_fun}))];
+ [(\<^type_name>\<open>set\<close>, (1, \<^term>\<open>rel_set\<close>)), (\<^type_name>\<open>fun\<close>, (2, \<^term>\<open>rel_fun\<close>))];
fun build_set ctxt A =
let
@@ -796,7 +796,7 @@
val set_apps = map (fn set => Term.betapply (set, Bound 0)) sets;
fun recurse set_app =
- let val Type (@{type_name set}, [elemT]) = fastype_of set_app in
+ let val Type (\<^type_name>\<open>set\<close>, [elemT]) = fastype_of set_app in
if elemT = A then set_app else mk_UNION set_app (build elemT)
end;
in
@@ -885,8 +885,8 @@
datatype fact_policy = Dont_Note | Note_Some | Note_All;
-val bnf_internals = Attrib.setup_config_bool @{binding bnf_internals} (K false);
-val bnf_timing = Attrib.setup_config_bool @{binding bnf_timing} (K false);
+val bnf_internals = Attrib.setup_config_bool \<^binding>\<open>bnf_internals\<close> (K false);
+val bnf_timing = Attrib.setup_config_bool \<^binding>\<open>bnf_timing\<close> (K false);
fun user_policy policy ctxt = if Config.get ctxt bnf_internals then Note_All else policy;
@@ -1008,7 +1008,7 @@
val z = nth zs i;
val set_wit = nth sets i $ Term.list_comb (wit, xs);
val concl = HOLogic.mk_Trueprop
- (if member (op =) I i then HOLogic.mk_eq (z, nth bs i) else @{term False});
+ (if member (op =) I i then HOLogic.mk_eq (z, nth bs i) else \<^term>\<open>False\<close>);
in
fold_rev Logic.all (z :: xs) (Logic.mk_implies (mk_Trueprop_mem (z, set_wit), concl))
end;
@@ -1153,7 +1153,7 @@
rel_rhs);
val pred_spec =
- if live = 0 then Term.absdummy (mk_bnf_T Ds As Calpha) @{term True} else
+ if live = 0 then Term.absdummy (mk_bnf_T Ds As Calpha) \<^term>\<open>True\<close> else
let
val sets = map (mk_bnf_t Ds As) bnf_sets;
val argTs = map mk_pred1T As;
@@ -1178,7 +1178,7 @@
if null wit_rhss then
[fold_rev Term.absdummy As (Term.list_comb (mk_bnf_map Ds As As,
map2 (fn T => fn i => Term.absdummy T (Bound i)) As (live downto 1)) $
- Const (@{const_name undefined}, CA))]
+ Const (\<^const_name>\<open>undefined\<close>, CA))]
else wit_rhss;
val nwits = length wit_rhss;
val wit_binds_defs =
@@ -1505,7 +1505,7 @@
end;
val map_cong = Lazy.lazy (mk_map_cong Logic.mk_implies);
- val map_cong_simp = Lazy.lazy (mk_map_cong (fn (a, b) => @{term simp_implies} $ a $ b));
+ val map_cong_simp = Lazy.lazy (mk_map_cong (fn (a, b) => \<^term>\<open>simp_implies\<close> $ a $ b));
fun mk_inj_map () =
let
@@ -1708,7 +1708,7 @@
end;
val rel_cong = Lazy.lazy (mk_rel_cong Logic.mk_implies);
- val rel_cong_simp = Lazy.lazy (mk_rel_cong (fn (a, b) => @{term simp_implies} $ a $ b));
+ val rel_cong_simp = Lazy.lazy (mk_rel_cong (fn (a, b) => \<^term>\<open>simp_implies\<close> $ a $ b));
fun mk_pred_prems f = map2 (HOLogic.mk_Trueprop oo f) Ps Ps_copy;
fun mk_pred_concl f = HOLogic.mk_Trueprop
@@ -1794,7 +1794,7 @@
end;
val pred_cong = Lazy.lazy (mk_pred_cong Logic.mk_implies);
- val pred_cong_simp = Lazy.lazy (mk_pred_cong (fn (a, b) => @{term simp_implies} $ a $ b));
+ val pred_cong_simp = Lazy.lazy (mk_pred_cong (fn (a, b) => \<^term>\<open>simp_implies\<close> $ a $ b));
fun mk_map_cong_pred () =
let
@@ -1878,8 +1878,8 @@
fun mk_pred_True () =
let
- val lhs = Term.list_comb (pred, map (fn T => absdummy T @{term True}) As');
- val rhs = absdummy CA' @{term True};
+ val lhs = Term.list_comb (pred, map (fn T => absdummy T \<^term>\<open>True\<close>) As');
+ val rhs = absdummy CA' \<^term>\<open>True\<close>;
val goal = mk_Trueprop_eq (lhs, rhs);
in
Goal.prove_sorry lthy [] [] goal
@@ -1971,7 +1971,7 @@
fun mk_set_transfer () =
let
- val rel_sets = map2 (fn A => fn B => mk_rel 1 [A] [B] @{term rel_set}) As' Bs';
+ val rel_sets = map2 (fn A => fn B => mk_rel 1 [A] [B] \<^term>\<open>rel_set\<close>) As' Bs';
val rel_Rs = Term.list_comb (rel, Rs);
val goals = @{map 4} (fn R => fn rel_set => fn setA => fn setB => HOLogic.mk_Trueprop
(mk_rel_fun rel_Rs (rel_set $ R) $ setA $ setB)) Rs rel_sets bnf_sets_As bnf_sets_Bs;
@@ -2138,23 +2138,23 @@
end;
val _ =
- Outer_Syntax.command @{command_keyword print_bnfs}
+ Outer_Syntax.command \<^command_keyword>\<open>print_bnfs\<close>
"print all bounded natural functors"
(Scan.succeed (Toplevel.keep (print_bnfs o Toplevel.context_of)));
val _ =
- Outer_Syntax.local_theory_to_proof @{command_keyword bnf}
+ Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>bnf\<close>
"register a type as a bounded natural functor"
(parse_opt_binding_colon -- Parse.typ --|
- (Parse.reserved "map" -- @{keyword ":"}) -- Parse.term --
- Scan.optional ((Parse.reserved "sets" -- @{keyword ":"}) |--
+ (Parse.reserved "map" -- \<^keyword>\<open>:\<close>) -- Parse.term --
+ Scan.optional ((Parse.reserved "sets" -- \<^keyword>\<open>:\<close>) |--
Scan.repeat1 (Scan.unless (Parse.reserved "bd") Parse.term)) [] --|
- (Parse.reserved "bd" -- @{keyword ":"}) -- Parse.term --
- Scan.optional ((Parse.reserved "wits" -- @{keyword ":"}) |--
+ (Parse.reserved "bd" -- \<^keyword>\<open>:\<close>) -- Parse.term --
+ Scan.optional ((Parse.reserved "wits" -- \<^keyword>\<open>:\<close>) |--
Scan.repeat1 (Scan.unless (Parse.reserved "rel" ||
Parse.reserved "plugins") Parse.term)) [] --
- Scan.option ((Parse.reserved "rel" -- @{keyword ":"}) |-- Parse.term) --
- Scan.option ((Parse.reserved "pred" -- @{keyword ":"}) |-- Parse.term) --
+ Scan.option ((Parse.reserved "rel" -- \<^keyword>\<open>:\<close>) |-- Parse.term) --
+ Scan.option ((Parse.reserved "pred" -- \<^keyword>\<open>:\<close>) |-- Parse.term) --
Scan.optional Plugin_Name.parse_filter (K Plugin_Name.default_filter)
>> bnf_cmd);
--- a/src/HOL/Tools/BNF/bnf_fp_def_sugar.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_fp_def_sugar.ML Fri Jan 04 23:22:53 2019 +0100
@@ -1141,7 +1141,7 @@
else
[mk_Trueprop_eq (build_rel_app names_lthy Rs [] ta tb,
(case flat (@{map 5} (mk_conjunct n) (1 upto n) discAs selAss discBs selBss) of
- [] => @{term True}
+ [] => \<^term>\<open>True\<close>
| conjuncts => Library.foldr1 HOLogic.mk_conj conjuncts))];
fun prove goal =
@@ -1247,7 +1247,7 @@
val map_rhs = build_map lthy [] []
(the o (AList.lookup (op =) (live_AsBs ~~ fs))) (map_rhsT, lhsT);
val rhs = (case map_rhs of
- Const (@{const_name id}, _) => selA $ ta
+ Const (\<^const_name>\<open>id\<close>, _) => selA $ ta
| _ => map_rhs $ (selA $ ta));
val concl = mk_Trueprop_eq (lhs, rhs);
in
@@ -1342,7 +1342,7 @@
val pred_injects =
let
fun top_sweep_rewr_conv rewrs =
- Conv.top_sweep_conv (K (Conv.rewrs_conv rewrs)) @{context};
+ Conv.top_sweep_conv (K (Conv.rewrs_conv rewrs)) \<^context>;
val rel_eq_onp_with_tops_of = Conv.fconv_rule (HOLogic.Trueprop_conv (Conv.arg1_conv
(top_sweep_rewr_conv @{thms eq_onp_top_eq_eq[symmetric, THEN eq_reflection]})));
@@ -1470,10 +1470,10 @@
val transfer_gfp_sugar_thms = morph_gfp_sugar_thms o Morphism.transfer_morphism;
-fun unzip_recT (Type (@{type_name prod}, [_, TFree x]))
- (T as Type (@{type_name prod}, Ts as [_, TFree y])) =
+fun unzip_recT (Type (\<^type_name>\<open>prod\<close>, [_, TFree x]))
+ (T as Type (\<^type_name>\<open>prod\<close>, Ts as [_, TFree y])) =
if x = y then [T] else Ts
- | unzip_recT _ (Type (@{type_name prod}, Ts as [_, TFree _])) = Ts
+ | unzip_recT _ (Type (\<^type_name>\<open>prod\<close>, Ts as [_, TFree _])) = Ts
| unzip_recT _ T = [T];
fun mk_recs_args_types ctxt ctr_Tsss Cs absTs repTs ns mss ctor_rec_fun_Ts =
@@ -1495,8 +1495,8 @@
(f_Tss, x_Tssss, fss, xssss)
end;
-fun unzip_corecT (Type (@{type_name sum}, _)) T = [T]
- | unzip_corecT _ (Type (@{type_name sum}, Ts)) = Ts
+fun unzip_corecT (Type (\<^type_name>\<open>sum\<close>, _)) T = [T]
+ | unzip_corecT _ (Type (\<^type_name>\<open>sum\<close>, Ts)) = Ts
| unzip_corecT _ T = [T];
(*avoid "'a itself" arguments in corecursors*)
@@ -1690,7 +1690,7 @@
@{map 6} (mk_coinduct_prem_ctr_concls ctxt Xss fpTss rs' n)
(1 upto n) udiscs uselss vdiscs vselss ctrXs_Tss
|> flat |> Library.foldr1 HOLogic.mk_conj
- handle List.Empty => @{term True};
+ handle List.Empty => \<^term>\<open>True\<close>;
fun mk_coinduct_prem ctxt Xss fpTss rs' uvr u v n udiscs uselss vdiscs vselss ctrXs_Tss =
fold_rev Logic.all [u, v] (Logic.mk_implies (HOLogic.mk_Trueprop uvr,
@@ -1928,7 +1928,7 @@
fun mk_prem_concl n discA_ts selA_tss discB_ts selB_tss =
Library.foldr1 HOLogic.mk_conj (flat (@{map 5} (mk_prem_ctr_concls n)
(1 upto n) discA_ts selA_tss discB_ts selB_tss))
- handle List.Empty => @{term True};
+ handle List.Empty => \<^term>\<open>True\<close>;
fun mk_prem IR tA tB n discA_ts selA_tss discB_ts selB_tss =
fold_rev Logic.all [tA, tB] (Logic.mk_implies (HOLogic.mk_Trueprop (IR $ tA $ tB),
@@ -2283,7 +2283,7 @@
end;
val Ass0 = map (map prepare_type_arg o type_args_named_constrained_of_spec) specs;
- val unsorted_Ass0 = map (map (resort_tfree_or_tvar @{sort type})) Ass0;
+ val unsorted_Ass0 = map (map (resort_tfree_or_tvar \<^sort>\<open>type\<close>)) Ass0;
val unsorted_As = Library.foldr1 (merge_type_args fp) unsorted_Ass0;
val num_As = length unsorted_As;
@@ -2409,7 +2409,7 @@
val fake_T = qsoty (unfreeze_fp X);
val fake_T_backdrop = qsoty (unfreeze_fp X_backdrop);
fun register_hint () =
- "\nUse the " ^ quote (#1 @{command_keyword bnf}) ^ " command to register " ^
+ "\nUse the " ^ quote (#1 \<^command_keyword>\<open>bnf\<close>) ^ " command to register " ^
quote bad_tc ^ " as a bounded natural functor to allow nested (co)recursion through \
\it";
in
@@ -2909,7 +2909,7 @@
handle EMPTY_DATATYPE s => error ("Cannot define empty datatype " ^ quote s);
val parse_ctr_arg =
- @{keyword "("} |-- parse_binding_colon -- Parse.typ --| @{keyword ")"}
+ \<^keyword>\<open>(\<close> |-- parse_binding_colon -- Parse.typ --| \<^keyword>\<open>)\<close>
|| Parse.typ >> pair Binding.empty;
val parse_ctr_specs =
@@ -2917,7 +2917,7 @@
val parse_spec =
parse_type_args_named_constrained -- Parse.binding -- Parse.opt_mixfix --
- (@{keyword "="} |-- parse_ctr_specs) -- parse_map_rel_pred_bindings -- parse_sel_default_eqs;
+ (\<^keyword>\<open>=\<close> |-- parse_ctr_specs) -- parse_map_rel_pred_bindings -- parse_sel_default_eqs;
val parse_co_datatype = parse_ctr_options -- Parse.and_list1 parse_spec;
--- a/src/HOL/Tools/BNF/bnf_fp_def_sugar_tactics.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_fp_def_sugar_tactics.ML Fri Jan 04 23:22:53 2019 +0100
@@ -91,19 +91,19 @@
fun is_def_looping def =
(case Thm.prop_of def of
- Const (@{const_name Pure.eq}, _) $ lhs $ rhs => Term.exists_subterm (curry (op aconv) lhs) rhs
+ Const (\<^const_name>\<open>Pure.eq\<close>, _) $ lhs $ rhs => Term.exists_subterm (curry (op aconv) lhs) rhs
| _ => false);
fun hhf_concl_conv cv ctxt ct =
(case Thm.term_of ct of
- Const (@{const_name Pure.all}, _) $ Abs _ =>
+ Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs _ =>
Conv.arg_conv (Conv.abs_conv (hhf_concl_conv cv o snd) ctxt) ct
| _ => Conv.concl_conv ~1 cv ct);
fun co_induct_inst_as_projs ctxt k thm =
let
val fs = Term.add_vars (Thm.prop_of thm) []
- |> filter (fn (_, Type (@{type_name fun}, [_, T'])) => T' <> HOLogic.boolT | _ => false);
+ |> filter (fn (_, Type (\<^type_name>\<open>fun\<close>, [_, T'])) => T' <> HOLogic.boolT | _ => false);
fun mk_inst (xi, T) = (xi, Thm.cterm_of ctxt (mk_proj T (num_binder_types T) k));
in
infer_instantiate ctxt (map mk_inst fs) thm
@@ -193,7 +193,7 @@
val ctor_rec_transfers' =
map (infer_instantiate' ctxt (map SOME (passives @ actives))) ctor_rec_transfers;
val total_n = Integer.sum ns;
- val True = @{term True};
+ val True = \<^term>\<open>True\<close>;
in
HEADGOAL Goal.conjunction_tac THEN
EVERY (map (fn ctor_rec_transfer =>
@@ -442,7 +442,7 @@
TRYALL (assume_tac ctxt ORELSE' etac ctxt FalseE ORELSE'
(REPEAT_DETERM o dtac ctxt meta_spec THEN'
TRY o filter_prems_tac ctxt
- (forall (curry (op <>) (HOLogic.mk_Trueprop @{term False})) o Logic.strip_imp_prems) THEN'
+ (forall (curry (op <>) (HOLogic.mk_Trueprop \<^term>\<open>False\<close>)) o Logic.strip_imp_prems) THEN'
REPEAT_DETERM o (dtac ctxt meta_mp THEN' rtac ctxt refl) THEN'
(assume_tac ctxt ORELSE' Goal.assume_rule_tac ctxt)));
--- a/src/HOL/Tools/BNF/bnf_fp_n2m.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_fp_n2m.ML Fri Jan 04 23:22:53 2019 +0100
@@ -41,7 +41,7 @@
val cacheN = "cache"
fun mk_cacheN i = cacheN ^ string_of_int i ^ "_";
-val cache_threshold = Attrib.setup_config_int @{binding bnf_n2m_cache_threshold} (K 200);
+val cache_threshold = Attrib.setup_config_int \<^binding>\<open>bnf_n2m_cache_threshold\<close> (K 200);
type cache = int * (term * thm) Typtab.table
val empty_cache = (0, Typtab.empty)
fun update_cache b0 TU t (cache as (i, tab), lthy) =
@@ -374,7 +374,7 @@
let
val S = HOLogic.mk_tupleT fold_strTs;
val s = HOLogic.mk_tuple ss;
- val u = Const (@{const_name Let}, S --> (S --> TU) --> TU) $ s $ absdummy S t;
+ val u = Const (\<^const_name>\<open>Let\<close>, S --> (S --> TU) --> TU) $ s $ absdummy S t;
in
Local_Theory.define ((b, NoSyn), ((Binding.concealed (Thm.def_binding b), []), u))
#>> apsnd snd ##> pair cache
--- a/src/HOL/Tools/BNF/bnf_fp_n2m_sugar.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_fp_n2m_sugar.ML Fri Jan 04 23:22:53 2019 +0100
@@ -63,19 +63,19 @@
Local_Theory.declaration {syntax = false, pervasive = false}
(fn phi => Data.map (Typtab.update (key, morph_n2m_sugar phi n2m_sugar)));
-fun unfold_lets_splits (Const (@{const_name Let}, _) $ t $ u) =
+fun unfold_lets_splits (Const (\<^const_name>\<open>Let\<close>, _) $ t $ u) =
unfold_lets_splits (betapply (unfold_splits_lets u, t))
| unfold_lets_splits (t $ u) = betapply (unfold_lets_splits t, unfold_lets_splits u)
| unfold_lets_splits (Abs (s, T, t)) = Abs (s, T, unfold_lets_splits t)
| unfold_lets_splits t = t
-and unfold_splits_lets ((t as Const (@{const_name case_prod}, _)) $ u) =
+and unfold_splits_lets ((t as Const (\<^const_name>\<open>case_prod\<close>, _)) $ u) =
(case unfold_splits_lets u of
u' as Abs (s1, T1, Abs (s2, T2, _)) =>
let val v = Var ((s1 ^ s2, Term.maxidx_of_term u' + 1), HOLogic.mk_prodT (T1, T2)) in
lambda v (incr_boundvars 1 (betapplys (u', [HOLogic.mk_fst v, HOLogic.mk_snd v])))
end
| _ => t $ unfold_lets_splits u)
- | unfold_splits_lets (t as Const (@{const_name Let}, _) $ _ $ _) = unfold_lets_splits t
+ | unfold_splits_lets (t as Const (\<^const_name>\<open>Let\<close>, _) $ _ $ _) = unfold_lets_splits t
| unfold_splits_lets (t $ u) = betapply (unfold_splits_lets t, unfold_lets_splits u)
| unfold_splits_lets (Abs (s, T, t)) = Abs (s, T, unfold_splits_lets t)
| unfold_splits_lets t = unfold_lets_splits t;
--- a/src/HOL/Tools/BNF/bnf_fp_rec_sugar_transfer.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_fp_rec_sugar_transfer.ML Fri Jan 04 23:22:53 2019 +0100
@@ -42,7 +42,7 @@
let
fun instantiate_with_lambda thm =
let
- val prop as @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ (Var (_, fT) $ _) $ _) =
+ val prop as @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ (Var (_, fT) $ _) $ _) =
Thm.prop_of thm;
val T = range_type fT;
val j = Term.maxidx_of_term prop + 1;
--- a/src/HOL/Tools/BNF/bnf_fp_rec_sugar_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_fp_rec_sugar_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -201,7 +201,7 @@
end;
fun check_top_sort ctxt b T =
- ignore (Sign.of_sort (Proof_Context.theory_of ctxt) (T, @{sort type}) orelse
+ ignore (Sign.of_sort (Proof_Context.theory_of ctxt) (T, \<^sort>\<open>type\<close>) orelse
error ("Type of " ^ Binding.print b ^ " contains top sort"));
datatype fp_kind = Least_FP | Greatest_FP;
@@ -264,7 +264,7 @@
val mk_common_name = space_implode "_";
-fun num_binder_types (Type (@{type_name fun}, [_, T])) = 1 + num_binder_types T
+fun num_binder_types (Type (\<^type_name>\<open>fun\<close>, [_, T])) = 1 + num_binder_types T
| num_binder_types _ = 0;
val exists_subtype_in = Term.exists_subtype o member (op =);
@@ -278,8 +278,8 @@
| retype_const_or_free _ t = raise TERM ("retype_const_or_free", [t]);
fun drop_all t =
- subst_bounds (strip_qnt_vars @{const_name Pure.all} t |> map Free |> rev,
- strip_qnt_body @{const_name Pure.all} t);
+ subst_bounds (strip_qnt_vars \<^const_name>\<open>Pure.all\<close> t |> map Free |> rev,
+ strip_qnt_body \<^const_name>\<open>Pure.all\<close> t);
fun permute_args n t =
list_comb (t, map Bound (0 :: (n downto 1))) |> fold (K (Term.abs (Name.uu, dummyT))) (0 upto n);
--- a/src/HOL/Tools/BNF/bnf_fp_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_fp_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -401,11 +401,11 @@
fun co_prefix fp = case_fp fp "" "co";
-fun dest_sumT (Type (@{type_name sum}, [T, T'])) = (T, T');
+fun dest_sumT (Type (\<^type_name>\<open>sum\<close>, [T, T'])) = (T, T');
val dest_sumTN_balanced = Balanced_Tree.dest dest_sumT;
-fun dest_tupleT_balanced 0 @{typ unit} = []
+fun dest_tupleT_balanced 0 \<^typ>\<open>unit\<close> = []
| dest_tupleT_balanced n T = Balanced_Tree.dest HOLogic.dest_prodT n T;
fun dest_absumprodT absT repT n ms =
@@ -429,26 +429,26 @@
val (fU, fTU) = `range_type (fastype_of f);
val ((gT, gU), gTU) = `dest_funT (fastype_of g);
val convolT = fTU --> gTU --> gT --> HOLogic.mk_prodT (fU, gU);
- in Const (@{const_name convol}, convolT) $ f $ g end;
+ in Const (\<^const_name>\<open>convol\<close>, convolT) $ f $ g end;
fun mk_rel_prod R S =
let
val ((A1, A2), RT) = `dest_pred2T (fastype_of R);
val ((B1, B2), ST) = `dest_pred2T (fastype_of S);
val rel_prodT = RT --> ST --> mk_pred2T (HOLogic.mk_prodT (A1, B1)) (HOLogic.mk_prodT (A2, B2));
- in Const (@{const_name rel_prod}, rel_prodT) $ R $ S end;
+ in Const (\<^const_name>\<open>rel_prod\<close>, rel_prodT) $ R $ S end;
fun mk_rel_sum R S =
let
val ((A1, A2), RT) = `dest_pred2T (fastype_of R);
val ((B1, B2), ST) = `dest_pred2T (fastype_of S);
val rel_sumT = RT --> ST --> mk_pred2T (mk_sumT (A1, B1)) (mk_sumT (A2, B2));
- in Const (@{const_name rel_sum}, rel_sumT) $ R $ S end;
+ in Const (\<^const_name>\<open>rel_sum\<close>, rel_sumT) $ R $ S end;
-fun Inl_const LT RT = Const (@{const_name Inl}, LT --> mk_sumT (LT, RT));
+fun Inl_const LT RT = Const (\<^const_name>\<open>Inl\<close>, LT --> mk_sumT (LT, RT));
fun mk_Inl RT t = Inl_const (fastype_of t) RT $ t;
-fun Inr_const LT RT = Const (@{const_name Inr}, RT --> mk_sumT (LT, RT));
+fun Inr_const LT RT = Const (\<^const_name>\<open>Inr\<close>, RT --> mk_sumT (LT, RT));
fun mk_Inr LT t = Inr_const LT (fastype_of t) $ t;
fun mk_prod1 bound_Ts (t, u) =
@@ -487,12 +487,12 @@
HOLogic.mk_comp (mk_case_sumN_balanced
(@{map 3} mk_tupled_fun fs (map mk_tuple_balanced xss) xss'), mk_rep absT rep);
-fun If_const T = Const (@{const_name If}, HOLogic.boolT --> T --> T --> T);
+fun If_const T = Const (\<^const_name>\<open>If\<close>, HOLogic.boolT --> T --> T --> T);
fun mk_If p t f = let val T = fastype_of t in If_const T $ p $ t $ f end;
fun mk_Field r =
let val T = fst (dest_relT (fastype_of r));
- in Const (@{const_name Field}, mk_relT (T, T) --> HOLogic.mk_setT T) $ r end;
+ in Const (\<^const_name>\<open>Field\<close>, mk_relT (T, T) --> HOLogic.mk_setT T) $ r end;
(*dangerous; use with monotonic, converging functions only!*)
fun fixpoint eq f X = if subset eq (f X, X) then X else fixpoint eq f (f X);
@@ -514,12 +514,12 @@
fun mk_tupled_allIN_balanced 0 = @{thm unit_all_impI}
| mk_tupled_allIN_balanced n =
let
- val (tfrees, _) = BNF_Util.mk_TFrees n @{context};
+ val (tfrees, _) = BNF_Util.mk_TFrees n \<^context>;
val T = mk_tupleT_balanced tfrees;
in
@{thm asm_rl[of "\<forall>x. P x \<longrightarrow> Q x" for P Q]}
- |> Thm.instantiate' [SOME (Thm.ctyp_of @{context} T)] []
- |> Raw_Simplifier.rewrite_goals_rule @{context} @{thms split_paired_All[THEN eq_reflection]}
+ |> Thm.instantiate' [SOME (Thm.ctyp_of \<^context> T)] []
+ |> Raw_Simplifier.rewrite_goals_rule \<^context> @{thms split_paired_All[THEN eq_reflection]}
|> (fn thm => impI RS funpow n (fn th => allI RS th) thm)
|> Thm.varifyT_global
end;
--- a/src/HOL/Tools/BNF/bnf_gfp.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp.ML Fri Jan 04 23:22:53 2019 +0100
@@ -1768,7 +1768,7 @@
define_bnf_consts Hardly_Inline (user_policy Note_Some lthy) false (SOME deads)
map_b rel_b pred_b set_bs
(((((((b, T), fold_rev Term.absfree fs' mapx), sets), sbd),
- [Const (@{const_name undefined}, T)]), NONE), NONE) lthy)
+ [Const (\<^const_name>\<open>undefined\<close>, T)]), NONE), NONE) lthy)
bs map_bs rel_bs pred_bs set_bss fs_maps setss Ts lthy;
val (_, Jconsts, Jconst_defs, mk_Jconsts) = @{split_list 4} Jbnf_consts;
@@ -2422,8 +2422,8 @@
(if dummy = NONE orelse member (op =) I (j - 1) then
HOLogic.mk_imp (HOLogic.mk_eq (z, wit),
if member (op =) I (j - 1) then HOLogic.mk_eq (y_copy, y)
- else @{term False})
- else @{term True}));
+ else \<^term>\<open>False\<close>)
+ else \<^term>\<open>True\<close>));
in
HOLogic.mk_Trueprop
(Library.foldr1 HOLogic.mk_conj (@{map 4} mk_conjunct sets Jzs dummys wits))
@@ -2603,9 +2603,9 @@
end;
val _ =
- Outer_Syntax.local_theory @{command_keyword codatatype} "define coinductive datatypes"
+ Outer_Syntax.local_theory \<^command_keyword>\<open>codatatype\<close> "define coinductive datatypes"
(parse_co_datatype_cmd Greatest_FP construct_gfp);
-val _ = Theory.setup (fp_antiquote_setup @{binding codatatype});
+val _ = Theory.setup (fp_antiquote_setup \<^binding>\<open>codatatype\<close>);
end;
--- a/src/HOL/Tools/BNF/bnf_gfp_grec.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_grec.ML Fri Jan 04 23:22:53 2019 +0100
@@ -169,15 +169,15 @@
error ("Not a codatatype: " ^ Syntax.string_of_typ ctxt T);
fun mutual_codatatype () =
error ("Mutually corecursive codatatypes are not supported (try " ^
- quote (#1 @{command_keyword primcorec}) ^ " instead of " ^
- quote (#1 @{command_keyword corec}) ^ ")");
+ quote (#1 \<^command_keyword>\<open>primcorec\<close>) ^ " instead of " ^
+ quote (#1 \<^command_keyword>\<open>corec\<close>) ^ ")");
fun noncorecursive_codatatype () =
error ("Noncorecursive codatatypes are not supported (try " ^
- quote (#1 @{command_keyword definition}) ^ " instead of " ^
- quote (#1 @{command_keyword corec}) ^ ")");
+ quote (#1 \<^command_keyword>\<open>definition\<close>) ^ " instead of " ^
+ quote (#1 \<^command_keyword>\<open>corec\<close>) ^ ")");
fun singleton_codatatype ctxt =
error ("Singleton corecursive codatatypes are not supported (use " ^
- quote (Syntax.string_of_typ ctxt @{typ unit}) ^ " instead)");
+ quote (Syntax.string_of_typ ctxt \<^typ>\<open>unit\<close>) ^ " instead)");
fun merge_lists eq old1 old2 = (old1 |> subtract eq old2) @ old2;
@@ -515,7 +515,7 @@
val T = qsoty (unfreeze_fp Y);
val T_backdrop = qsoty (unfreeze_fp Y_backdrop);
fun register_hint () =
- "\nUse the " ^ quote (#1 @{command_keyword bnf}) ^ " command to register " ^
+ "\nUse the " ^ quote (#1 \<^command_keyword>\<open>bnf\<close>) ^ " command to register " ^
quote bad_tc ^ " as a bounded natural functor to allow nested (co)recursion through \
\it";
in
@@ -898,7 +898,7 @@
fun derive_dtor_transfer ctxt live_EsFs Y Z pre_rel fp_rel Rs dtor dtor_rel_thm =
let
- val Type (@{type_name fun}, [fpT, Type (@{type_name fun}, [fpTB, @{typ bool}])]) =
+ val Type (\<^type_name>\<open>fun\<close>, [fpT, Type (\<^type_name>\<open>fun\<close>, [fpTB, \<^typ>\<open>bool\<close>])]) =
snd (strip_typeN (length live_EsFs) (fastype_of fp_rel));
val pre_rel' = Term.subst_atomic_types [(Y, fpT), (Z, fpTB)] pre_rel;
@@ -1668,7 +1668,7 @@
cutSsig_def algLam_def corecU_def live_pre_bnf pre_bnf dead_pre_bnf fp_bnf sig_bnf ssig_bnf
dead_ssig_bnf =
let
- val SOME prod_bnf = bnf_of ctxt @{type_name prod};
+ val SOME prod_bnf = bnf_of ctxt \<^type_name>\<open>prod\<close>;
val f' = substT Z fpT f;
val dead_ssig_map' = substT Z fpT dead_ssig_map;
@@ -1846,7 +1846,7 @@
sctr_pointful_natural), lthy)
end;
-fun mk_equivp T = Const (@{const_name equivp}, mk_predT [mk_pred2T T T]);
+fun mk_equivp T = Const (\<^const_name>\<open>equivp\<close>, mk_predT [mk_pred2T T T]);
fun derive_equivp_Retr ctxt fpT Retr R dead_pre_rel_refl_thm dead_pre_rel_flip_thm
dead_pre_rel_mono_thm dead_pre_rel_compp_thm =
@@ -1890,12 +1890,12 @@
fun mk_gen_cong fpT eval_domT =
let val fp_relT = mk_pred2T fpT fpT in
- Const (@{const_name "cong.gen_cong"},
+ Const (\<^const_name>\<open>cong.gen_cong\<close>,
[mk_predT [fp_relT, eval_domT, eval_domT], eval_domT --> fpT, fp_relT] ---> fp_relT)
end;
fun mk_cong_locale rel eval Retr =
- Const (@{const_name cong}, mk_predT (map fastype_of [rel, eval, Retr]));
+ Const (\<^const_name>\<open>cong\<close>, mk_predT (map fastype_of [rel, eval, Retr]));
fun derive_cong_locale ctxt rel eval Retr0 tac =
let
--- a/src/HOL/Tools/BNF/bnf_gfp_grec_sugar.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_grec_sugar.ML Fri Jan 04 23:22:53 2019 +0100
@@ -295,7 +295,7 @@
fun is_set ctxt (const_name, T) =
(case T of
- Type (@{type_name fun}, [Type (fpT_name, _), Type (@{type_name set}, [_])]) =>
+ Type (\<^type_name>\<open>fun\<close>, [Type (fpT_name, _), Type (\<^type_name>\<open>set\<close>, [_])]) =>
(case bnf_of ctxt fpT_name of
SOME bnf => exists (fn Const (s, _) => s = const_name | _ => false) (sets_of_bnf bnf)
| NONE => false)
@@ -385,7 +385,7 @@
val ssig_map_thms = #map_thms ssig_fp_bnf_sugar;
val all_algLam_alg_pointfuls = map (mk_pointful ctxt) all_algLam_algs;
- val @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ lhs $ rhs) = code_goal;
+ val @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ lhs $ rhs) = code_goal;
val (fun_t, args) = strip_comb lhs;
val closed_rhs = fold_rev lambda args rhs;
@@ -447,10 +447,10 @@
val fp_nesting_Ts = map T_of_bnf fp_nesting_bnfs;
- fun is_nullary_disc_def (@{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ _
- $ (Const (@{const_name HOL.eq}, _) $ _ $ _))) = true
- | is_nullary_disc_def (Const (@{const_name Pure.eq}, _) $ _
- $ (Const (@{const_name HOL.eq}, _) $ _ $ _)) = true
+ fun is_nullary_disc_def (@{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _
+ $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ _))) = true
+ | is_nullary_disc_def (Const (\<^const_name>\<open>Pure.eq\<close>, _) $ _
+ $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ _)) = true
| is_nullary_disc_def _ = false;
val dtor_ctor = nth (#dtor_ctors fp_res) fp_res_index;
@@ -621,13 +621,13 @@
val fpT as Type (_, fp_argTs) = range_type (fastype_of algrho);
- fun has_algrho (@{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ _ $ rhs)) =
+ fun has_algrho (@{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ rhs)) =
fst (dest_Const (head_of (strip_abs_body rhs))) = algrho_name;
val eq_algrho :: _ =
maps (filter (has_algrho o Thm.prop_of) o #eq_algrhos o snd) (all_friend_extras_of ctxt);
- val @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ friend0 $ _) = Thm.prop_of eq_algrho;
+ val @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ friend0 $ _) = Thm.prop_of eq_algrho;
val friend = mk_ctr fp_argTs friend0;
val goal = mk_cong_intro_ctr_or_friend_goal ctxt fpT Rcong friend;
@@ -668,7 +668,7 @@
val n = length ctrXs_Tss;
val ms = map length ctrXs_Tss;
- val X' = TVar ((X_s, maxidx_of_typ fpT + 1), @{sort type});
+ val X' = TVar ((X_s, maxidx_of_typ fpT + 1), \<^sort>\<open>type\<close>);
val As_rho = tvar_subst thy T0_args fpT_args;
val substXAT = Term.typ_subst_TVars As_rho o Tsubst X X';
val substXA = Term.subst_TVars As_rho o substT X X';
@@ -699,7 +699,7 @@
let
fun build_simple (T, U) =
if T = U then
- @{term "%y. y"}
+ \<^term>\<open>%y. y\<close>
else
Bound 0
|> explore {bound_Us = T :: bound_Us, bound_Ts = T :: bound_Ts, U = U, T = T}
@@ -736,7 +736,7 @@
fun massage_let explore params t =
(case strip_comb t of
- (Const (@{const_name Let}, _), [_, _]) => unfold_lets_splits t
+ (Const (\<^const_name>\<open>Let\<close>, _), [_, _]) => unfold_lets_splits t
| _ => t)
|> explore params;
@@ -916,7 +916,7 @@
val sel_lhss = map (rapp lhs o mk_disc_or_sel Ts) ordered_sels;
val sel_condss = map collect_sel_condss sel_positionss;
- fun is_undefined (Const (@{const_name undefined}, _)) = true
+ fun is_undefined (Const (\<^const_name>\<open>undefined\<close>, _)) = true
| is_undefined _ = false;
in
sel_condss ~~ (sel_lhss ~~ sel_rhss)
@@ -1001,7 +1001,7 @@
(* We are assuming that set functions are marked with "[transfer_rule]" (cf. the "transfer"
plugin). Otherwise, the "eq_algrho" tactic might fail. *)
fun is_special_parametric_const (x as (s, _)) =
- s = @{const_name id} orelse is_set lthy x;
+ s = \<^const_name>\<open>id\<close> orelse is_set lthy x;
fun add_parametric_const s general_T T U =
let
@@ -1103,7 +1103,7 @@
fun massage_if explore_cond explore (params as {bound_Us, bound_Ts, ...}) t =
(case strip_comb t of
- (const as Const (@{const_name If}, _), obj :: (branches as [_, _])) =>
+ (const as Const (\<^const_name>\<open>If\<close>, _), obj :: (branches as [_, _])) =>
(case List.partition Term.is_dummy_pattern (map (explore params) branches) of
(dummy_branch' :: _, []) => dummy_branch'
| (_, [branch']) => branch'
@@ -1112,7 +1112,7 @@
val brancheUs = map (curry fastype_of1 bound_Us) branches';
val U = deduce_according_type (fastype_of1 (bound_Ts, hd branches)) brancheUs;
val const_obj' = (If_const U, obj)
- ||> explore_cond (update_UT params @{typ bool} @{typ bool})
+ ||> explore_cond (update_UT params \<^typ>\<open>bool\<close> \<^typ>\<open>bool\<close>)
|> op $;
in
build_function_after_encapsulation (const $ obj) const_obj' params branches branches'
@@ -1166,7 +1166,7 @@
fun massage_comp explore (params as {bound_Us, ...}) t =
(case strip_comb t of
- (Const (@{const_name comp}, _), f1 :: f2 :: args) =>
+ (Const (\<^const_name>\<open>comp\<close>, _), f1 :: f2 :: args) =>
let
val args' = map (typ_before explore params) args;
val f2' = typ_before (explore_fun (map (curry fastype_of1 bound_Us) args') explore) params
@@ -1206,7 +1206,7 @@
| const_of _ _ = NONE;
fun massage_disc explore (params as {T, bound_Us, bound_Ts, ...}) t =
- (case (strip_comb t, T = @{typ bool}) of
+ (case (strip_comb t, T = \<^typ>\<open>bool\<close>) of
((fun_t, arg :: []), true) =>
let val arg_T = fastype_of1 (bound_Ts, arg) in
if arg_T <> res_T then
@@ -1251,7 +1251,7 @@
end;
fun massage_equality explore (params as {bound_Us, bound_Ts, ...})
- (t as Const (@{const_name HOL.eq}, _) $ t1 $ t2) =
+ (t as Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2) =
let
val check_is_VLeaf =
not o (Term.exists_subterm (fn t => t aconv CLeaf orelse t aconv Oper));
@@ -1681,7 +1681,7 @@
fun massage_comp explore params t =
(case strip_comb t of
- (Const (@{const_name comp}, _), f1 :: f2 :: args) =>
+ (Const (\<^const_name>\<open>comp\<close>, _), f1 :: f2 :: args) =>
explore params (betapply (f1, (betapplys (f2, args))))
| _ => explore params t);
@@ -2190,11 +2190,11 @@
prepare_corec_ursive_cmd int false opts (raw_fixes, raw_eq) lthy;
in
if not (null termin_goals) then
- error ("Termination prover failed (try " ^ quote (#1 @{command_keyword corecursive}) ^
- " instead of " ^ quote (#1 @{command_keyword corec}) ^ ")")
+ error ("Termination prover failed (try " ^ quote (#1 \<^command_keyword>\<open>corecursive\<close>) ^
+ " instead of " ^ quote (#1 \<^command_keyword>\<open>corec\<close>) ^ ")")
else if not (null const_transfer_goals) then
- error ("Transfer prover failed (try " ^ quote (#1 @{command_keyword corecursive}) ^
- " instead of " ^ quote (#1 @{command_keyword corec}) ^ ")")
+ error ("Transfer prover failed (try " ^ quote (#1 \<^command_keyword>\<open>corecursive\<close>) ^
+ " instead of " ^ quote (#1 \<^command_keyword>\<open>corec\<close>) ^ ")")
else
def_fun inner_fp_triple const_transfers [] lthy
end;
@@ -2241,7 +2241,7 @@
val fun_T =
(case code_goal of
- @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ t $ _) => fastype_of (head_of t)
+ @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t $ _) => fastype_of (head_of t)
| _ => ill_formed_equation_lhs_rhs lthy [code_goal]);
val fun_t = Const (fun_name, fun_T);
@@ -2365,24 +2365,24 @@
SOME (Named_Target.theory_map consolidate thy)
handle Same.SAME => NONE;
-val _ = Outer_Syntax.local_theory @{command_keyword corec}
+val _ = Outer_Syntax.local_theory \<^command_keyword>\<open>corec\<close>
"define nonprimitive corecursive functions"
- ((Scan.optional (@{keyword "("} |-- Parse.!!! (Parse.list1 corec_option_parser)
- --| @{keyword ")"}) []) -- (Parse.vars --| Parse.where_ -- Parse.prop)
+ ((Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.!!! (Parse.list1 corec_option_parser)
+ --| \<^keyword>\<open>)\<close>) []) -- (Parse.vars --| Parse.where_ -- Parse.prop)
>> uncurry (corec_cmd true));
-val _ = Outer_Syntax.local_theory_to_proof @{command_keyword corecursive}
+val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>corecursive\<close>
"define nonprimitive corecursive functions"
- ((Scan.optional (@{keyword "("} |-- Parse.!!! (Parse.list1 corec_option_parser)
- --| @{keyword ")"}) []) -- (Parse.vars --| Parse.where_ -- Parse.prop)
+ ((Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.!!! (Parse.list1 corec_option_parser)
+ --| \<^keyword>\<open>)\<close>) []) -- (Parse.vars --| Parse.where_ -- Parse.prop)
>> uncurry (corecursive_cmd true));
-val _ = Outer_Syntax.local_theory_to_proof @{command_keyword friend_of_corec}
+val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>friend_of_corec\<close>
"register a function as a legal context for nonprimitive corecursion"
(Parse.const -- Scan.option (Parse.$$$ "::" |-- Parse.typ) --| Parse.where_ -- Parse.prop
>> friend_of_corec_cmd);
-val _ = Outer_Syntax.local_theory @{command_keyword coinduction_upto}
+val _ = Outer_Syntax.local_theory \<^command_keyword>\<open>coinduction_upto\<close>
"derive a coinduction up-to principle and a corresponding congruence closure"
(Parse.name --| Parse.$$$ ":" -- Parse.typ >> coinduction_upto_cmd);
--- a/src/HOL/Tools/BNF/bnf_gfp_grec_sugar_tactics.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_grec_sugar_tactics.ML Fri Jan 04 23:22:53 2019 +0100
@@ -132,7 +132,7 @@
val simp_ctxt = (ctxt
|> Context_Position.set_visible false
- |> put_simpset (simpset_of (Proof_Context.init_global @{theory Main}))
+ |> put_simpset (simpset_of (Proof_Context.init_global \<^theory>\<open>Main\<close>))
|> Raw_Simplifier.add_cong @{thm if_cong})
addsimps pre_map_def :: abs_inverse :: fp_map_ident :: dtor_ctor :: rho_def ::
@{thm convol_def} :: fpsig_nesting_map_ident0s @ fpsig_nesting_map_comps @
--- a/src/HOL/Tools/BNF/bnf_gfp_grec_sugar_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_grec_sugar_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -57,7 +57,7 @@
(case AList.lookup (op =) (!vars) (T, U) of
SOME V => V
| NONE =>
- let val V = TVar ((Name.aT, length (!vars) + max_j), @{sort type}) in
+ let val V = TVar ((Name.aT, length (!vars) + max_j), \<^sort>\<open>type\<close>) in
vars := ((T, U), V) :: !vars; V
end);
@@ -106,7 +106,7 @@
val num_curry_uncurryN_balanced_precomp = 8;
val curry_uncurryN_balanced_precomp =
- map (mk_curry_uncurryN_balanced_raw @{context}) (0 upto num_curry_uncurryN_balanced_precomp);
+ map (mk_curry_uncurryN_balanced_raw \<^context>) (0 upto num_curry_uncurryN_balanced_precomp);
fun mk_curry_uncurryN_balanced ctxt n =
if n <= num_curry_uncurryN_balanced_precomp then nth curry_uncurryN_balanced_precomp n
--- a/src/HOL/Tools/BNF/bnf_gfp_grec_tactics.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_grec_tactics.ML Fri Jan 04 23:22:53 2019 +0100
@@ -93,14 +93,14 @@
|> context_transfer_rule_add transfers);
fun instantiate_natural_rule_with_id ctxt live =
- Rule_Insts.of_rule ctxt ([], NONE :: replicate live (SOME @{const_name id})) [];
+ Rule_Insts.of_rule ctxt ([], NONE :: replicate live (SOME \<^const_name>\<open>id\<close>)) [];
fun instantiate_transfer_rule_with_Grp_UNIV ctxt alives thm =
let
val n = length alives;
val fs = map (prefix "f" o string_of_int) (1 upto n);
- val ss = map2 (fn live => fn f => SOME (@{const_name BNF_Def.Grp} ^ " " ^ @{const_name top} ^
- " " ^ (if live then f else @{const_name id}))) alives fs;
+ val ss = map2 (fn live => fn f => SOME (\<^const_name>\<open>BNF_Def.Grp\<close> ^ " " ^ \<^const_name>\<open>top\<close> ^
+ " " ^ (if live then f else \<^const_name>\<open>id\<close>))) alives fs;
val bs = map_filter (fn (live, f) => if live then SOME (Binding.name f, NONE, NoSyn) else NONE)
(alives ~~ fs);
in
@@ -135,7 +135,7 @@
fun mk_cong_locale_tac ctxt dead_pre_rel_mono dead_pre_rel_maps equivp_Retr
ssig_rel_mono ssig_rel_maps eval eval_core_transfer =
- HEADGOAL (resolve_tac ctxt (Locale.get_unfolds @{context}) THEN'
+ HEADGOAL (resolve_tac ctxt (Locale.get_unfolds \<^context>) THEN'
etac ctxt ssig_rel_mono THEN' etac ctxt equivp_Retr) THEN
unfold_thms_tac ctxt (eval :: dead_pre_rel_maps @ @{thms id_apply}) THEN
HEADGOAL (rtac ctxt (@{thm predicate2I} RS (dead_pre_rel_mono RS @{thm predicate2D})) THEN'
--- a/src/HOL/Tools/BNF/bnf_gfp_grec_unique_sugar.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_grec_unique_sugar.ML Fri Jan 04 23:22:53 2019 +0100
@@ -23,7 +23,7 @@
let
(* Workaround for odd name clash for goals with "x" in their context *)
val (_, ctxt) = ctxt
- |> yield_singleton (mk_Frees "x") @{typ unit};
+ |> yield_singleton (mk_Frees "x") \<^typ>\<open>unit\<close>;
val code_thm = (if null prems then error "No premise" else hd prems)
|> Object_Logic.rulify ctxt;
@@ -53,7 +53,7 @@
(case maybe_corec_info_of ctxt res_T of
SOME (info as {buffer, ...}) => (info, corec_parse_info_of ctxt arg_Ts res_T buffer)
| NONE => error ("No corecursor for " ^ quote (Syntax.string_of_typ ctxt res_T) ^
- " (use " ^ quote (#1 @{command_keyword coinduction_upto}) ^ " to derive it)"));
+ " (use " ^ quote (#1 \<^command_keyword>\<open>coinduction_upto\<close>) ^ " to derive it)"));
val Type (fpT_name, _) = res_T;
--- a/src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_rec_sugar.ML Fri Jan 04 23:22:53 2019 +0100
@@ -122,8 +122,8 @@
val simp_attrs = @{attributes [simp]};
fun use_primcorecursive () =
- error ("\"auto\" failed (try " ^ quote (#1 @{command_keyword primcorecursive}) ^ " instead of " ^
- quote (#1 @{command_keyword primcorec}) ^ ")");
+ error ("\"auto\" failed (try " ^ quote (#1 \<^command_keyword>\<open>primcorecursive\<close>) ^ " instead of " ^
+ quote (#1 \<^command_keyword>\<open>primcorec\<close>) ^ ")");
datatype corec_option =
Plugins_Option of Proof.context -> Plugin_Name.filter |
@@ -184,7 +184,7 @@
val abs_tuple_balanced = HOLogic.tupled_lambda o mk_tuple_balanced;
-fun curried_type (Type (@{type_name fun}, [Type (@{type_name prod}, Ts), T])) =
+fun curried_type (Type (\<^type_name>\<open>fun\<close>, [Type (\<^type_name>\<open>prod\<close>, Ts), T])) =
Ts ---> T;
fun sort_list_duplicates xs = map snd (sort (int_ord o apply2 fst) xs);
@@ -241,8 +241,8 @@
fun fld conds t =
(case Term.strip_comb t of
- (Const (@{const_name Let}, _), [_, _]) => fld conds (unfold_lets_splits t)
- | (Const (@{const_name If}, _), [cond, then_branch, else_branch]) =>
+ (Const (\<^const_name>\<open>Let\<close>, _), [_, _]) => fld conds (unfold_lets_splits t)
+ | (Const (\<^const_name>\<open>If\<close>, _), [cond, then_branch, else_branch]) =>
fld (conds @ conjuncts_s cond) then_branch o fld (conds @ s_not_conj [cond]) else_branch
| (Const (c, _), args as _ :: _ :: _) =>
let val n = num_binder_types (Sign.the_const_type thy c) - 1 in
@@ -282,15 +282,15 @@
and massage_rec bound_Ts t =
let val typof = curry fastype_of1 bound_Ts in
(case Term.strip_comb t of
- (Const (@{const_name Let}, _), [_, _]) => massage_rec bound_Ts (unfold_lets_splits t)
- | (Const (@{const_name If}, _), obj :: (branches as [_, _])) =>
+ (Const (\<^const_name>\<open>Let\<close>, _), [_, _]) => massage_rec bound_Ts (unfold_lets_splits t)
+ | (Const (\<^const_name>\<open>If\<close>, _), obj :: (branches as [_, _])) =>
(case List.partition Term.is_dummy_pattern (map (massage_rec bound_Ts) branches) of
(dummy_branch' :: _, []) => dummy_branch'
| (_, [branch']) => branch'
| (_, branches') =>
Term.list_comb (If_const (typof (hd branches')) $ tap (check_no_call bound_Ts) obj,
branches'))
- | (c as Const (@{const_name case_prod}, _), arg :: args) =>
+ | (c as Const (\<^const_name>\<open>case_prod\<close>, _), arg :: args) =>
massage_rec bound_Ts
(unfold_splits_lets (Term.list_comb (c $ Envir.eta_long bound_Ts arg, args)))
| (Const (c, _), args as _ :: _ :: _) =>
@@ -333,7 +333,7 @@
in
massage_rec bound_Ts t0
|> Term.map_aterms (fn t =>
- if Term.is_dummy_pattern t then Const (@{const_name undefined}, fastype_of t) else t)
+ if Term.is_dummy_pattern t then Const (\<^const_name>\<open>undefined\<close>, fastype_of t) else t)
end;
fun massage_let_if_case_corec ctxt has_call massage_leaf bound_Ts t0 =
@@ -344,8 +344,8 @@
let
fun check_no_call t = if has_call t then unexpected_corec_call_in ctxt [t0] t else ();
- fun massage_mutual_call bound_Ts (Type (@{type_name fun}, [_, U2]))
- (Type (@{type_name fun}, [T1, T2])) t =
+ fun massage_mutual_call bound_Ts (Type (\<^type_name>\<open>fun\<close>, [_, U2]))
+ (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) t =
Abs (Name.uu, T1, massage_mutual_call (T1 :: bound_Ts) U2 T2 (incr_boundvars 1 t $ Bound 0))
| massage_mutual_call bound_Ts U T t =
(if has_call t then massage_call else massage_noncall) bound_Ts U T t;
@@ -379,7 +379,7 @@
(betapply (t, var))));
in
(case t of
- Const (@{const_name comp}, _) $ t1 $ t2 =>
+ Const (\<^const_name>\<open>comp\<close>, _) $ t1 $ t2 =>
if has_call t2 then massage_body ()
else mk_comp bound_Ts (massage_mutual_fun bound_Ts U T t1, t2)
| _ => massage_body ())
@@ -402,12 +402,12 @@
end
| NONE =>
(case t of
- Const (@{const_name case_prod}, _) $ t' =>
+ Const (\<^const_name>\<open>case_prod\<close>, _) $ t' =>
let
val U' = curried_type U;
val T' = curried_type T;
in
- Const (@{const_name case_prod}, U' --> U) $ massage_any_call bound_Ts U' T' t'
+ Const (\<^const_name>\<open>case_prod\<close>, U' --> U) $ massage_any_call bound_Ts U' T' t'
end
| t1 $ t2 =>
(if has_call t2 then
@@ -555,7 +555,7 @@
val perm_Cs' = map substCT perm_Cs;
- fun call_of nullary [] [g_i] [Type (@{type_name fun}, [_, T])] =
+ fun call_of nullary [] [g_i] [Type (\<^type_name>\<open>fun\<close>, [_, T])] =
(if exists_subtype_in Cs T then Nested_Corec
else if nullary then Dummy_No_Corec
else No_Corec) g_i
@@ -595,7 +595,7 @@
is_some gfp_sugar_thms, lthy)
end;
-val undef_const = Const (@{const_name undefined}, dummyT);
+val undef_const = Const (\<^const_name>\<open>undefined\<close>, dummyT);
type coeqn_data_disc =
{fun_name: string,
@@ -676,7 +676,7 @@
val discs = map #disc basic_ctr_specs;
val ctrs = map #ctr basic_ctr_specs;
- val not_disc = head_of concl = @{term Not};
+ val not_disc = head_of concl = \<^term>\<open>Not\<close>;
val _ = not_disc andalso length ctrs <> 2 andalso
error_at ctxt [concl] "Negated discriminator for a type with \<noteq> 2 constructors";
val disc' = find_subterm (member (op =) discs o head_of) concl;
@@ -894,7 +894,7 @@
let
val bound_Ts = List.rev (map fastype_of fun_args);
- fun rewrite_stop _ t = if has_call t then @{term False} else @{term True};
+ fun rewrite_stop _ t = if has_call t then \<^term>\<open>False\<close> else \<^term>\<open>True\<close>;
fun rewrite_end _ t = if has_call t then undef_const else t;
fun rewrite_cont bound_Ts t =
if has_call t then mk_tuple1_balanced bound_Ts (snd (strip_comb t)) else undef_const;
@@ -921,7 +921,7 @@
let val (u, vs) = strip_comb t in
if is_Free u andalso has_call u then
Inr_const T U2 $ mk_tuple1_balanced bound_Ts vs
- else if try (fst o dest_Const) u = SOME @{const_name case_prod} then
+ else if try (fst o dest_Const) u = SOME \<^const_name>\<open>case_prod\<close> then
map (rewrite bound_Ts) vs |> chop 1
|>> HOLogic.mk_case_prod o the_single
|> Term.list_comb
@@ -974,8 +974,8 @@
val corec_args = hd corecs
|> fst o split_last o binder_types o fastype_of
|> map (fn T =>
- if range_type T = HOLogic.boolT then Abs (Name.uu_, domain_type T, @{term False})
- else Const (@{const_name undefined}, T))
+ if range_type T = HOLogic.boolT then Abs (Name.uu_, domain_type T, \<^term>\<open>False\<close>)
+ else Const (\<^const_name>\<open>undefined\<close>, T))
|> fold2 (fold o build_corec_arg_disc) ctr_specss disc_eqnss
|> fold2 (fold o build_corec_args_sel ctxt has_call) sel_eqnss ctr_specss;
@@ -1245,7 +1245,7 @@
fun prove_disc ({ctr_specs, ...} : corec_spec) excludesss
({fun_name, fun_T, fun_args, ctr_no, prems, eqn_pos, ...} : coeqn_data_disc) =
- if Term.aconv_untyped (#disc (nth ctr_specs ctr_no), @{term "\<lambda>x. x = x"}) then
+ if Term.aconv_untyped (#disc (nth ctr_specs ctr_no), \<^term>\<open>\<lambda>x. x = x\<close>) then
[]
else
let
@@ -1259,7 +1259,7 @@
|> curry Logic.list_implies (map HOLogic.mk_Trueprop prems)
|> curry Logic.list_all (map dest_Free fun_args);
in
- if prems = [@{term False}] then
+ if prems = [\<^term>\<open>False\<close>] then
[]
else
Goal.prove_sorry lthy [] [] goal
@@ -1341,7 +1341,7 @@
val disc_thm_opt = AList.lookup (op =) disc_alist disc;
val sel_thms = map (snd o snd) (filter (member (op =) sels o fst) sel_alist);
in
- if prems = [@{term False}] then
+ if prems = [\<^term>\<open>False\<close>] then
[]
else
Goal.prove_sorry lthy [] [] goal
@@ -1409,7 +1409,7 @@
(if exhaustive_code then
split_last (map_filter I ctr_conds_argss_opt) ||> snd
else
- Const (@{const_name Code.abort}, @{typ String.literal} -->
+ Const (\<^const_name>\<open>Code.abort\<close>, \<^typ>\<open>String.literal\<close> -->
(HOLogic.unitT --> body_type fun_T) --> body_type fun_T) $
HOLogic.mk_literal fun_name $
absdummy HOLogic.unitT (incr_boundvars 1 lhs)
@@ -1587,16 +1587,16 @@
val where_alt_props_of_parser = Parse.where_ |-- Parse.!!! (Parse.enum1 "|"
((Parse.prop >> pair Binding.empty_atts) -- Scan.option (Parse.reserved "of" |-- Parse.const)));
-val _ = Outer_Syntax.local_theory_to_proof @{command_keyword primcorecursive}
+val _ = Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>primcorecursive\<close>
"define primitive corecursive functions"
- ((Scan.optional (@{keyword "("} |--
- Parse.!!! (Parse.list1 corec_option_parser) --| @{keyword ")"}) []) --
+ ((Scan.optional (\<^keyword>\<open>(\<close> |--
+ Parse.!!! (Parse.list1 corec_option_parser) --| \<^keyword>\<open>)\<close>) []) --
(Parse.vars -- where_alt_props_of_parser) >> uncurry (primcorecursive_cmd true));
-val _ = Outer_Syntax.local_theory @{command_keyword primcorec}
+val _ = Outer_Syntax.local_theory \<^command_keyword>\<open>primcorec\<close>
"define primitive corecursive functions"
- ((Scan.optional (@{keyword "("} |-- Parse.!!! (Parse.list1 corec_option_parser)
- --| @{keyword ")"}) []) --
+ ((Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.!!! (Parse.list1 corec_option_parser)
+ --| \<^keyword>\<open>)\<close>) []) --
(Parse.vars -- where_alt_props_of_parser) >> uncurry (primcorec_cmd true));
val _ = Theory.setup (gfp_rec_sugar_interpretation transfer_plugin
--- a/src/HOL/Tools/BNF/bnf_gfp_rec_sugar_tactics.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_rec_sugar_tactics.ML Fri Jan 04 23:22:53 2019 +0100
@@ -154,7 +154,7 @@
fun inst_split_eq ctxt split =
(case Thm.prop_of split of
- @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ (Var (_, Type (_, [T, _])) $ _) $ _) =>
+ @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ (Var (_, Type (_, [T, _])) $ _) $ _) =>
let
val s = Name.uu;
val eq = Abs (Name.uu, T, HOLogic.mk_eq (Free (s, T), Bound 0));
--- a/src/HOL/Tools/BNF/bnf_gfp_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_gfp_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -46,10 +46,10 @@
open BNF_Util
open BNF_FP_Util
-val mk_append = HOLogic.mk_binop @{const_name append};
+val mk_append = HOLogic.mk_binop \<^const_name>\<open>append\<close>;
fun mk_equiv B R =
- Const (@{const_name equiv}, fastype_of B --> fastype_of R --> HOLogic.boolT) $ B $ R;
+ Const (\<^const_name>\<open>equiv\<close>, fastype_of B --> fastype_of R --> HOLogic.boolT) $ B $ R;
fun mk_InN [_] t 1 = t
| mk_InN (_ :: Ts) t 1 = mk_Inl (mk_sumTN Ts) t
@@ -61,43 +61,43 @@
val AT = fastype_of A;
val BT = fastype_of B;
val ABT = mk_relT (HOLogic.dest_setT AT, HOLogic.dest_setT (range_type BT));
- in Const (@{const_name Sigma}, AT --> BT --> ABT) $ A $ B end;
+ in Const (\<^const_name>\<open>Sigma\<close>, AT --> BT --> ABT) $ A $ B end;
fun mk_Id_on A =
let
val AT = fastype_of A;
val AAT = mk_relT (HOLogic.dest_setT AT, HOLogic.dest_setT AT);
- in Const (@{const_name Id_on}, AT --> AAT) $ A end;
+ in Const (\<^const_name>\<open>Id_on\<close>, AT --> AAT) $ A end;
fun mk_in_rel R =
let
val ((A, B), RT) = `dest_relT (fastype_of R);
- in Const (@{const_name in_rel}, RT --> mk_pred2T A B) $ R end;
+ in Const (\<^const_name>\<open>in_rel\<close>, RT --> mk_pred2T A B) $ R end;
fun mk_Times (A, B) =
let val AT = HOLogic.dest_setT (fastype_of A);
in mk_Sigma (A, Term.absdummy AT B) end;
-fun dest_listT (Type (@{type_name list}, [T])) = T
+fun dest_listT (Type (\<^type_name>\<open>list\<close>, [T])) = T
| dest_listT T = raise TYPE ("dest_setT: set type expected", [T], []);
fun mk_Succ Kl kl =
let val T = fastype_of kl;
in
- Const (@{const_name Succ},
+ Const (\<^const_name>\<open>Succ\<close>,
HOLogic.mk_setT T --> T --> HOLogic.mk_setT (dest_listT T)) $ Kl $ kl
end;
fun mk_Shift Kl k =
let val T = fastype_of Kl;
in
- Const (@{const_name Shift}, T --> dest_listT (HOLogic.dest_setT T) --> T) $ Kl $ k
+ Const (\<^const_name>\<open>Shift\<close>, T --> dest_listT (HOLogic.dest_setT T) --> T) $ Kl $ k
end;
fun mk_shift lab k =
let val T = fastype_of lab;
in
- Const (@{const_name shift}, T --> dest_listT (Term.domain_type T) --> T) $ lab $ k
+ Const (\<^const_name>\<open>shift\<close>, T --> dest_listT (Term.domain_type T) --> T) $ lab $ k
end;
fun mk_toCard A r =
@@ -105,7 +105,7 @@
val AT = fastype_of A;
val rT = fastype_of r;
in
- Const (@{const_name toCard},
+ Const (\<^const_name>\<open>toCard\<close>,
AT --> rT --> HOLogic.dest_setT AT --> fst (dest_relT rT)) $ A $ r
end;
@@ -114,43 +114,43 @@
val AT = fastype_of A;
val rT = fastype_of r;
in
- Const (@{const_name fromCard},
+ Const (\<^const_name>\<open>fromCard\<close>,
AT --> rT --> fst (dest_relT rT) --> HOLogic.dest_setT AT) $ A $ r
end;
fun mk_Cons x xs =
let val T = fastype_of xs;
- in Const (@{const_name Cons}, dest_listT T --> T --> T) $ x $ xs end;
+ in Const (\<^const_name>\<open>Cons\<close>, dest_listT T --> T --> T) $ x $ xs end;
fun mk_size t = HOLogic.size_const (fastype_of t) $ t;
fun mk_quotient A R =
let val T = fastype_of A;
- in Const (@{const_name quotient}, T --> fastype_of R --> HOLogic.mk_setT T) $ A $ R end;
+ in Const (\<^const_name>\<open>quotient\<close>, T --> fastype_of R --> HOLogic.mk_setT T) $ A $ R end;
fun mk_proj R =
let val ((AT, BT), T) = `dest_relT (fastype_of R);
- in Const (@{const_name proj}, T --> AT --> HOLogic.mk_setT BT) $ R end;
+ in Const (\<^const_name>\<open>proj\<close>, T --> AT --> HOLogic.mk_setT BT) $ R end;
fun mk_univ f =
let val ((AT, BT), T) = `dest_funT (fastype_of f);
- in Const (@{const_name univ}, T --> HOLogic.mk_setT AT --> BT) $ f end;
+ in Const (\<^const_name>\<open>univ\<close>, T --> HOLogic.mk_setT AT --> BT) $ f end;
fun mk_congruent R f =
- Const (@{const_name congruent}, fastype_of R --> fastype_of f --> HOLogic.boolT) $ R $ f;
+ Const (\<^const_name>\<open>congruent\<close>, fastype_of R --> fastype_of f --> HOLogic.boolT) $ R $ f;
-fun mk_undefined T = Const (@{const_name undefined}, T);
+fun mk_undefined T = Const (\<^const_name>\<open>undefined\<close>, T);
fun mk_rec_nat Zero Suc =
let val T = fastype_of Zero;
- in Const (@{const_name old.rec_nat}, T --> fastype_of Suc --> HOLogic.natT --> T) $ Zero $ Suc end;
+ in Const (\<^const_name>\<open>old.rec_nat\<close>, T --> fastype_of Suc --> HOLogic.natT --> T) $ Zero $ Suc end;
fun mk_rec_list Nil Cons =
let
val T = fastype_of Nil;
val (U, consT) = `(Term.domain_type) (fastype_of Cons);
in
- Const (@{const_name rec_list}, T --> consT --> HOLogic.listT U --> T) $ Nil $ Cons
+ Const (\<^const_name>\<open>rec_list\<close>, T --> consT --> HOLogic.listT U --> T) $ Nil $ Cons
end;
fun mk_InN_not_InM 1 _ = @{thm Inl_not_Inr}
--- a/src/HOL/Tools/BNF/bnf_lfp.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_lfp.ML Fri Jan 04 23:22:53 2019 +0100
@@ -563,7 +563,7 @@
(Term.absfree jdx' (mk_nthN n (Asi $ jdx) k));
fun mk_minH_component Asi i sets Ts s k =
- HOLogic.mk_binop @{const_name "sup"}
+ HOLogic.mk_binop \<^const_name>\<open>sup\<close>
(mk_minG Asi i k, mk_image s $ mk_in (passive_UNIVs @ map (mk_minG Asi i) ks) sets Ts);
fun mk_min_algs ss =
@@ -1867,9 +1867,9 @@
end;
val _ =
- Outer_Syntax.local_theory @{command_keyword datatype} "define inductive datatypes"
+ Outer_Syntax.local_theory \<^command_keyword>\<open>datatype\<close> "define inductive datatypes"
(parse_co_datatype_cmd Least_FP construct_lfp);
-val _ = Theory.setup (fp_antiquote_setup @{binding datatype});
+val _ = Theory.setup (fp_antiquote_setup \<^binding>\<open>datatype\<close>);
end;
--- a/src/HOL/Tools/BNF/bnf_lfp_basic_sugar.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_lfp_basic_sugar.ML Fri Jan 04 23:22:53 2019 +0100
@@ -17,8 +17,8 @@
open BNF_FP_Def_Sugar
fun trivial_absT_info_of fpT =
- {absT = fpT, repT = fpT, abs = Const (@{const_name id_bnf}, fpT --> fpT),
- rep = Const (@{const_name id_bnf}, fpT --> fpT),
+ {absT = fpT, repT = fpT, abs = Const (\<^const_name>\<open>id_bnf\<close>, fpT --> fpT),
+ rep = Const (\<^const_name>\<open>id_bnf\<close>, fpT --> fpT),
abs_inject = @{thm type_definition.Abs_inject[OF type_definition_id_bnf_UNIV UNIV_I UNIV_I]},
abs_inverse = @{thm type_definition.Abs_inverse[OF type_definition_id_bnf_UNIV UNIV_I]},
type_definition = @{thm type_definition_id_bnf_UNIV}};
@@ -31,8 +31,8 @@
fun trivial_fp_result_of fp_bnf fpT C xtor_map xtor_sets xtor_rel ctor_rec_o_map
xtor_rel_induct ctor_rec_transfer =
let
- val xtors = [Const (@{const_name xtor}, fpT --> fpT)];
- val co_recs = [Const (@{const_name ctor_rec}, (fpT --> C) --> (fpT --> C))];
+ val xtors = [Const (\<^const_name>\<open>xtor\<close>, fpT --> fpT)];
+ val co_recs = [Const (\<^const_name>\<open>ctor_rec\<close>, (fpT --> C) --> (fpT --> C))];
val co_rec_thms = [map_id0_of_bnf fp_bnf RS @{thm ctor_rec}];
val co_rec_unique_thm = map_id0_of_bnf fp_bnf RS @{thm ctor_rec_unique};
in
@@ -52,10 +52,10 @@
fun fp_sugar_of_sum ctxt =
let
- val fpT as Type (fpT_name, As) = @{typ "'a + 'b"};
- val fpBT = @{typ "'c + 'd"};
- val C = @{typ 'e};
- val X = @{typ 'sum};
+ val fpT as Type (fpT_name, As) = \<^typ>\<open>'a + 'b\<close>;
+ val fpBT = \<^typ>\<open>'c + 'd\<close>;
+ val C = \<^typ>\<open>'e\<close>;
+ val X = \<^typ>\<open>'sum\<close>;
val ctr_Tss = map single As;
val fp_bnf = the (bnf_of ctxt fpT_name);
@@ -105,7 +105,7 @@
set_cases = @{thms setl.cases[simplified hypsubst_in_prems]
setr.cases[simplified hypsubst_in_prems]}},
fp_co_induct_sugar = SOME
- {co_rec = Const (@{const_name case_sum}, map (fn Ts => (Ts ---> C)) ctr_Tss ---> fpT --> C),
+ {co_rec = Const (\<^const_name>\<open>case_sum\<close>, map (fn Ts => (Ts ---> C)) ctr_Tss ---> fpT --> C),
common_co_inducts = @{thms sum.induct},
co_inducts = @{thms sum.induct},
co_rec_def = @{thm ctor_rec_def_alt[of "case_sum f1 f2" for f1 f2]},
@@ -124,10 +124,10 @@
fun fp_sugar_of_prod ctxt =
let
- val fpT as Type (fpT_name, As) = @{typ "'a * 'b"};
- val fpBT = @{typ "'c * 'd"};
- val C = @{typ 'e};
- val X = @{typ 'prod};
+ val fpT as Type (fpT_name, As) = \<^typ>\<open>'a * 'b\<close>;
+ val fpBT = \<^typ>\<open>'c * 'd\<close>;
+ val C = \<^typ>\<open>'e\<close>;
+ val X = \<^typ>\<open>'prod\<close>;
val ctr_Ts = As;
val fp_bnf = the (bnf_of ctxt fpT_name);
@@ -177,7 +177,7 @@
set_cases = @{thms fsts.cases[simplified eq_fst_iff ex_neg_all_pos]
snds.cases[simplified eq_snd_iff ex_neg_all_pos]}},
fp_co_induct_sugar = SOME
- {co_rec = Const (@{const_name case_prod}, (ctr_Ts ---> C) --> fpT --> C),
+ {co_rec = Const (\<^const_name>\<open>case_prod\<close>, (ctr_Ts ---> C) --> fpT --> C),
common_co_inducts = @{thms prod.induct},
co_inducts = @{thms prod.induct},
co_rec_def = @{thm ctor_rec_def_alt[of "case_prod f" for f]},
--- a/src/HOL/Tools/BNF/bnf_lfp_compat.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_lfp_compat.ML Fri Jan 04 23:22:53 2019 +0100
@@ -56,7 +56,7 @@
fun mk_split_rec_rhs ctxt fpTs Cs (recs as rec1 :: _) =
let
fun repair_rec_arg_args [] [] = []
- | repair_rec_arg_args ((g_T as Type (@{type_name fun}, _)) :: g_Ts) (g :: gs) =
+ | repair_rec_arg_args ((g_T as Type (\<^type_name>\<open>fun\<close>, _)) :: g_Ts) (g :: gs) =
let
val (x_Ts, body_T) = strip_type g_T;
in
@@ -127,7 +127,7 @@
val Xs_frecs = Xs ~~ frecs;
val fss = unflat ctrss fs;
- fun mk_rec_call g n (Type (@{type_name fun}, [_, ran_T])) =
+ fun mk_rec_call g n (Type (\<^type_name>\<open>fun\<close>, [_, ran_T])) =
Abs (Name.uu, Term.dummyT, mk_rec_call g (n + 1) ran_T)
| mk_rec_call g n X =
let
@@ -184,7 +184,7 @@
end;
fun body_rec_indices (Old_Datatype_Aux.DtRec kk) = [kk]
- | body_rec_indices (Old_Datatype_Aux.DtType (@{type_name fun}, [_, D])) = body_rec_indices D
+ | body_rec_indices (Old_Datatype_Aux.DtType (\<^type_name>\<open>fun\<close>, [_, D])) = body_rec_indices D
| body_rec_indices _ = [];
fun reindex_desc desc =
@@ -276,7 +276,7 @@
val ctr_Tsss = map (map (map (Old_Datatype_Aux.typ_of_dtyp descr) o snd) o #3 o snd) descr;
val kkssss = map (map (map body_rec_indices o snd) o #3 o snd) descr;
- val callers = map (fn kk => Var ((Name.uu, kk), @{typ "unit => unit"})) (0 upto nn - 1);
+ val callers = map (fn kk => Var ((Name.uu, kk), \<^typ>\<open>unit => unit\<close>)) (0 upto nn - 1);
fun apply_comps n kk =
mk_partial_compN n (replicate n HOLogic.unitT ---> HOLogic.unitT) (nth callers kk);
@@ -306,7 +306,7 @@
val recs = map (#co_rec o the o #fp_co_induct_sugar) fp_sugars';
val rec_thmss = map (#co_rec_thms o the o #fp_co_induct_sugar) fp_sugars';
- fun is_nested_rec_type (Type (@{type_name fun}, [_, T])) = member (op =) Xs' (body_type T)
+ fun is_nested_rec_type (Type (\<^type_name>\<open>fun\<close>, [_, T])) = member (op =) Xs' (body_type T)
| is_nested_rec_type _ = false;
val ((lfp_sugar_thms'', (inducts', induct', recs', rec'_thmss)), lthy'') =
@@ -523,7 +523,7 @@
fun new_type_args_of (s, S) =
(if member (op =) prefs Kill_Type_Args then NONE else SOME Binding.empty,
- (TFree (s, @{sort type}), S));
+ (TFree (s, \<^sort>\<open>type\<close>), S));
fun new_ctr_spec_of (b, Ts, mx) = (((Binding.empty, b), map (pair Binding.empty) Ts), mx);
fun new_spec_of ((b, old_tyargs, mx), old_ctr_specs) =
@@ -548,7 +548,7 @@
BNF_LFP_Rec_Sugar.primrec_simple false;
val _ =
- Outer_Syntax.local_theory @{command_keyword datatype_compat}
+ Outer_Syntax.local_theory \<^command_keyword>\<open>datatype_compat\<close>
"register datatypes as old-style datatypes and derive old-style properties"
(Scan.repeat1 Parse.type_const >> datatype_compat_cmd);
--- a/src/HOL/Tools/BNF/bnf_lfp_countable.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_lfp_countable.ML Fri Jan 04 23:22:53 2019 +0100
@@ -21,7 +21,7 @@
open BNF_FP_Util
open BNF_FP_Def_Sugar
-val countableS = @{sort countable};
+val countableS = \<^sort>\<open>countable\<close>;
fun nchotomy_tac ctxt nchotomy =
HEADGOAL (resolve_tac ctxt [nchotomy RS @{thm all_reg[rotated]}] THEN'
@@ -74,7 +74,7 @@
right = fn t => @{const sum_encode} $ (@{const Inr (nat, nat)} $ t)}
n k;
-fun encode_tuple [] = @{term "0 :: nat"}
+fun encode_tuple [] = \<^term>\<open>0 :: nat\<close>
| encode_tuple ts =
Balanced_Tree.make (fn (t, u) => @{const prod_encode} $ (@{const Pair (nat, nat)} $ u $ t)) ts;
@@ -87,14 +87,14 @@
raise TYPE ("Type is not of sort " ^ Syntax.string_of_sort ctxt countableS, [T], []);
fun mk_to_nat_checked T =
- Const (@{const_name to_nat}, tap check_countable T --> HOLogic.natT);
+ Const (\<^const_name>\<open>to_nat\<close>, tap check_countable T --> HOLogic.natT);
val nn = length ns;
val recs as rec1 :: _ = map2 (mk_co_rec thy Least_FP (replicate nn HOLogic.natT)) fpTs recs0;
val arg_Ts = binder_fun_types (fastype_of rec1);
val arg_Tss = Library.unflat ctrss0 arg_Ts;
- fun mk_U (Type (@{type_name prod}, [T1, T2])) =
+ fun mk_U (Type (\<^type_name>\<open>prod\<close>, [T1, T2])) =
if member (op =) fpTs T1 then T2 else HOLogic.mk_prodT (mk_U T1, mk_U T2)
| mk_U (Type (s, Ts)) = Type (s, map mk_U Ts)
| mk_U T = T;
@@ -181,9 +181,9 @@
|> map Thm.close_derivation
end;
-fun get_countable_goal_type_name (@{const Trueprop} $ (Const (@{const_name Ex}, _)
- $ Abs (_, Type (_, [Type (s, _), _]), Const (@{const_name inj_on}, _) $ Bound 0
- $ Const (@{const_name top}, _)))) = s
+fun get_countable_goal_type_name (@{const Trueprop} $ (Const (\<^const_name>\<open>Ex\<close>, _)
+ $ Abs (_, Type (_, [Type (s, _), _]), Const (\<^const_name>\<open>inj_on\<close>, _) $ Bound 0
+ $ Const (\<^const_name>\<open>top\<close>, _)))) = s
| get_countable_goal_type_name _ = error "Wrong goal format for datatype countability tactic";
fun core_countable_datatype_tac ctxt st =
--- a/src/HOL/Tools/BNF/bnf_lfp_rec_sugar.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_lfp_rec_sugar.ML Fri Jan 04 23:22:53 2019 +0100
@@ -274,7 +274,7 @@
induct_attrs, map #T basic_lfp_sugars), lthy)
end;
-val undef_const = Const (@{const_name undefined}, dummyT);
+val undef_const = Const (\<^const_name>\<open>undefined\<close>, dummyT);
type eqn_data = {
fun_name: string,
@@ -677,10 +677,10 @@
|| Parse.reserved "nonexhaustive" >> K Nonexhaustive_Option
|| Parse.reserved "transfer" >> K Transfer_Option);
-val _ = Outer_Syntax.local_theory @{command_keyword primrec}
+val _ = Outer_Syntax.local_theory \<^command_keyword>\<open>primrec\<close>
"define primitive recursive functions"
- ((Scan.optional (@{keyword "("} |-- Parse.!!! (Parse.list1 rec_option_parser)
- --| @{keyword ")"}) []) -- Parse_Spec.specification
+ ((Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.!!! (Parse.list1 rec_option_parser)
+ --| \<^keyword>\<open>)\<close>) []) -- Parse_Spec.specification
>> (fn (opts, (fixes, specs)) => snd o primrec_cmd true opts fixes specs));
end;
--- a/src/HOL/Tools/BNF/bnf_lfp_rec_sugar_more.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_lfp_rec_sugar_more.ML Fri Jan 04 23:22:53 2019 +0100
@@ -30,13 +30,13 @@
fun special_endgame_tac ctxt fp_nesting_map_ident0s fp_nesting_map_comps fp_nesting_pred_maps =
ALLGOALS (CONVERSION Thm.eta_long_conversion) THEN
HEADGOAL (simp_tac (ss_only @{thms pred_fun_True_id} ctxt
- addsimprocs [@{simproc NO_MATCH}])) THEN
+ addsimprocs [\<^simproc>\<open>NO_MATCH\<close>])) THEN
unfold_thms_tac ctxt (nested_simps @
map (unfold_thms ctxt @{thms id_def}) (fp_nesting_map_ident0s @ fp_nesting_map_comps @
fp_nesting_pred_maps)) THEN
ALLGOALS (rtac ctxt refl);
-fun is_new_datatype _ @{type_name nat} = true
+fun is_new_datatype _ \<^type_name>\<open>nat\<close> = true
| is_new_datatype ctxt s =
(case fp_sugar_of ctxt s of
SOME {fp = Least_FP, fp_co_induct_sugar = SOME _, ...} => true
@@ -47,7 +47,7 @@
{T = T, fp_res_index = fp_res_index, C = C, fun_arg_Tsss = fun_arg_Tsss, ctr_sugar = ctr_sugar,
recx = recx, rec_thms = rec_thms};
-fun basic_lfp_sugars_of _ [@{typ nat}] _ _ lthy =
+fun basic_lfp_sugars_of _ [\<^typ>\<open>nat\<close>] _ _ lthy =
([], [0], [nat_basic_lfp_sugar], [], [], [], TrueI (*dummy*), [], false, lthy)
| basic_lfp_sugars_of bs arg_Ts callers callssss0 lthy0 =
let
@@ -99,7 +99,7 @@
fun massage_mutual_fun U T t =
(case t of
- Const (@{const_name comp}, _) $ t1 $ t2 =>
+ Const (\<^const_name>\<open>comp\<close>, _) $ t1 $ t2 =>
mk_comp bound_Ts (tap check_no_call t1, massage_mutual_fun U T t2)
| _ =>
if has_call t then massage_fun U T t else mk_comp bound_Ts (t, massage_no_call (U, T)));
--- a/src/HOL/Tools/BNF/bnf_lfp_size.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_lfp_size.ML Fri Jan 04 23:22:53 2019 +0100
@@ -30,7 +30,7 @@
val nitpicksimp_attrs = @{attributes [nitpick_simp]};
val simp_attrs = @{attributes [simp]};
-fun mk_plus_nat (t1, t2) = Const (@{const_name Groups.plus},
+fun mk_plus_nat (t1, t2) = Const (\<^const_name>\<open>Groups.plus\<close>,
HOLogic.natT --> HOLogic.natT --> HOLogic.natT) $ t1 $ t2;
fun mk_to_natT T = T --> HOLogic.natT;
@@ -51,7 +51,7 @@
fun check_size_type thy T_name size_name =
let
val n = Sign.arity_number thy T_name;
- val As = map (fn s => TFree (s, @{sort type})) (Name.invent Name.context Name.aT n);
+ val As = map (fn s => TFree (s, \<^sort>\<open>type\<close>)) (Name.invent Name.context Name.aT n);
val T = Type (T_name, As);
val size_T = map mk_to_natT As ---> mk_to_natT T;
val size_const = Const (size_name, size_T);
@@ -132,7 +132,7 @@
map ((fn base => Binding.qualify false base (Binding.name (prefix size_N base))) o
Long_Name.base_name) T_names;
- fun is_prod_C @{type_name prod} [_, T'] = member (op =) Cs T'
+ fun is_prod_C \<^type_name>\<open>prod\<close> [_, T'] = member (op =) Cs T'
| is_prod_C _ _ = false;
fun mk_size_of_typ (T as TFree _) =
@@ -227,7 +227,7 @@
val overloaded_size_rhss = map (fn c => Term.list_comb (c, zeros)) size_consts;
val overloaded_size_Ts = map fastype_of overloaded_size_rhss;
- val overloaded_size_consts = map (curry Const @{const_name size}) overloaded_size_Ts;
+ val overloaded_size_consts = map (curry Const \<^const_name>\<open>size\<close>) overloaded_size_Ts;
val overloaded_size_def_bs =
map (maybe_conceal_def_binding o Binding.suffix_name "_overloaded") size_bs;
@@ -282,7 +282,7 @@
fun rhs_is_zero thm =
let val Const (trueprop, _) $ (Const (eq, _) $ _ $ rhs) = Thm.prop_of thm in
- trueprop = @{const_name Trueprop} andalso eq = @{const_name HOL.eq} andalso
+ trueprop = \<^const_name>\<open>Trueprop\<close> andalso eq = \<^const_name>\<open>HOL.eq\<close> andalso
rhs = HOLogic.zero
end;
@@ -343,7 +343,7 @@
val size_gen_o_map_thmss =
if nested_size_gen_o_maps_complete
- andalso forall (fn TFree (_, S) => S = @{sort type}) As then
+ andalso forall (fn TFree (_, S) => S = \<^sort>\<open>type\<close>) As then
@{map 3} (fn goal => fn size_def => fn rec_o_map =>
Goal.prove_sorry lthy2 [] [] goal (fn {context = ctxt, ...} =>
mk_size_gen_o_map_tac ctxt size_def rec_o_map all_inj_maps nested_size_maps)
@@ -393,7 +393,7 @@
end
| generate_datatype_size _ lthy = lthy;
-val size_plugin = Plugin_Name.declare_setup @{binding size};
+val size_plugin = Plugin_Name.declare_setup \<^binding>\<open>size\<close>;
val _ = Theory.setup (fp_sugars_interpretation size_plugin generate_datatype_size);
end;
--- a/src/HOL/Tools/BNF/bnf_lfp_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_lfp_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -28,22 +28,22 @@
fun mk_underS r =
let val T = fst (dest_relT (fastype_of r));
- in Const (@{const_name underS}, mk_relT (T, T) --> T --> HOLogic.mk_setT T) $ r end;
+ in Const (\<^const_name>\<open>underS\<close>, mk_relT (T, T) --> T --> HOLogic.mk_setT T) $ r end;
fun mk_worec r f =
let val (A, AB) = apfst domain_type (dest_funT (fastype_of f));
- in Const (@{const_name wo_rel.worec}, mk_relT (A, A) --> (AB --> AB) --> AB) $ r $ f end;
+ in Const (\<^const_name>\<open>wo_rel.worec\<close>, mk_relT (A, A) --> (AB --> AB) --> AB) $ r $ f end;
fun mk_relChain r f =
let val (A, AB) = `domain_type (fastype_of f);
- in Const (@{const_name relChain}, mk_relT (A, A) --> AB --> HOLogic.boolT) $ r $ f end;
+ in Const (\<^const_name>\<open>relChain\<close>, mk_relT (A, A) --> AB --> HOLogic.boolT) $ r $ f end;
fun mk_cardSuc r =
let val T = fst (dest_relT (fastype_of r));
- in Const (@{const_name cardSuc}, mk_relT (T, T) --> mk_relT (`I (HOLogic.mk_setT T))) $ r end;
+ in Const (\<^const_name>\<open>cardSuc\<close>, mk_relT (T, T) --> mk_relT (`I (HOLogic.mk_setT T))) $ r end;
fun mk_bij_betw f A B =
- Const (@{const_name bij_betw},
+ Const (\<^const_name>\<open>bij_betw\<close>,
fastype_of f --> fastype_of A --> fastype_of B --> HOLogic.boolT) $ f $ A $ B;
fun mk_not_eq x y = HOLogic.mk_not (HOLogic.mk_eq (x, y));
--- a/src/HOL/Tools/BNF/bnf_lift.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_lift.ML Fri Jan 04 23:22:53 2019 +0100
@@ -357,11 +357,11 @@
| NONE => Typedef.get_info lthy Tname |> hd |> snd |> #type_definition);
val wits = (Option.map o map) (prepare_term lthy) raw_wits;
val specs =
- map (apsnd (apsnd (the_default @{sort type} o Option.map (prepare_sort lthy)))) raw_specs;
+ map (apsnd (apsnd (the_default \<^sort>\<open>type\<close> o Option.map (prepare_sort lthy)))) raw_specs;
val _ =
(case HOLogic.dest_Trueprop (Thm.prop_of input_thm) of
- Const (@{const_name type_definition}, _) $ _ $ _ $ _ => ()
+ Const (\<^const_name>\<open>type_definition\<close>, _) $ _ $ _ $ _ => ()
| _ => error "Unsupported type of a theorem: only type_definition is supported");
in
typedef_bnf input_thm wits specs map_b rel_b pred_b plugins lthy
@@ -415,20 +415,20 @@
local
val parse_wits =
- @{keyword "["} |-- (Parse.name --| @{keyword ":"} -- Scan.repeat Parse.term >>
+ \<^keyword>\<open>[\<close> |-- (Parse.name --| \<^keyword>\<open>:\<close> -- Scan.repeat Parse.term >>
(fn ("wits", Ts) => Ts
| (s, _) => error ("Unknown label " ^ quote s ^ " (expected \"wits\")"))) --|
- @{keyword "]"} || Scan.succeed [];
+ \<^keyword>\<open>]\<close> || Scan.succeed [];
val parse_options =
- Scan.optional (@{keyword "("} |--
+ Scan.optional (\<^keyword>\<open>(\<close> |--
Parse.list1 (Parse.group (K "option")
(Plugin_Name.parse_filter >> Plugins_Option
|| Parse.reserved "no_warn_wits" >> K No_Warn_Wits))
- --| @{keyword ")"}) [];
+ --| \<^keyword>\<open>)\<close>) [];
val parse_plugins =
- Scan.optional (@{keyword "("} |-- Plugin_Name.parse_filter --| @{keyword ")"})
+ Scan.optional (\<^keyword>\<open>(\<close> |-- Plugin_Name.parse_filter --| \<^keyword>\<open>)\<close>)
(K Plugin_Name.default_filter) >> Plugins_Option >> single;
val parse_typedef_thm = Scan.option (Parse.reserved "via" |-- Parse.thm);
@@ -436,13 +436,13 @@
in
val _ =
- Outer_Syntax.local_theory_to_proof @{command_keyword lift_bnf}
+ Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>lift_bnf\<close>
"register a subtype of a bounded natural functor (BNF) as a BNF"
((parse_options -- parse_type_args_named_constrained -- Parse.type_const -- parse_wits --
parse_typedef_thm -- parse_map_rel_pred_bindings) >> lift_bnf_cmd);
val _ =
- Outer_Syntax.local_theory @{command_keyword copy_bnf}
+ Outer_Syntax.local_theory \<^command_keyword>\<open>copy_bnf\<close>
"register a type copy of a bounded natural functor (BNF) as a BNF"
((parse_plugins -- parse_type_args_named_constrained -- Parse.type_const --
parse_typedef_thm -- parse_map_rel_pred_bindings) >> copy_bnf_cmd);
--- a/src/HOL/Tools/BNF/bnf_tactics.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_tactics.ML Fri Jan 04 23:22:53 2019 +0100
@@ -44,7 +44,7 @@
end
handle Pattern.MATCH => no_tac) ctxt;
-fun clean_blast_tac ctxt = blast_tac (put_claset (claset_of @{theory_context HOL}) ctxt);
+fun clean_blast_tac ctxt = blast_tac (put_claset (claset_of \<^theory_context>\<open>HOL\<close>) ctxt);
(*unlike "unfold_thms_tac", it succeed when the RHS contains schematic variables not in the LHS*)
fun subst_tac ctxt = EqSubst.eqsubst_tac ctxt o the_default [0];
--- a/src/HOL/Tools/BNF/bnf_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/BNF/bnf_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -123,7 +123,7 @@
open Ctr_Sugar_Util
open BNF_FP_Rec_Sugar_Util
-val transfer_plugin = Plugin_Name.declare_setup @{binding transfer};
+val transfer_plugin = Plugin_Name.declare_setup \<^binding>\<open>transfer\<close>;
(* Library proper *)
@@ -137,7 +137,7 @@
fun unflattt xssss = fst o unflattt0 xssss;
val parse_type_arg_constrained =
- Parse.type_ident -- Scan.option (@{keyword "::"} |-- Parse.!!! Parse.sort);
+ Parse.type_ident -- Scan.option (\<^keyword>\<open>::\<close> |-- Parse.!!! Parse.sort);
val parse_type_arg_named_constrained =
(Parse.reserved "dead" >> K NONE || parse_opt_binding_colon >> SOME) --
@@ -145,10 +145,10 @@
val parse_type_args_named_constrained =
parse_type_arg_constrained >> (single o pair (SOME Binding.empty)) ||
- @{keyword "("} |-- Parse.!!! (Parse.list1 parse_type_arg_named_constrained --| @{keyword ")"}) ||
+ \<^keyword>\<open>(\<close> |-- Parse.!!! (Parse.list1 parse_type_arg_named_constrained --| \<^keyword>\<open>)\<close>) ||
Scan.succeed [];
-val parse_map_rel_pred_binding = Parse.name --| @{keyword ":"} -- Parse.binding;
+val parse_map_rel_pred_binding = Parse.name --| \<^keyword>\<open>:\<close> -- Parse.binding;
val no_map_rel = (Binding.empty, Binding.empty, Binding.empty);
@@ -158,7 +158,7 @@
| extract_map_rel_pred (s, _) = error ("Unknown label " ^ quote s ^ " (expected \"map\" or \"rel\")");
val parse_map_rel_pred_bindings =
- @{keyword "for"} |-- Scan.repeat parse_map_rel_pred_binding
+ \<^keyword>\<open>for\<close> |-- Scan.repeat parse_map_rel_pred_binding
>> (fn ps => fold extract_map_rel_pred ps no_map_rel)
|| Scan.succeed no_map_rel;
@@ -204,7 +204,7 @@
(*maps [T1,...,Tn]--->T to ([T1,T2,...,Tn], T)*)
fun strip_typeN 0 T = ([], T)
- | strip_typeN n (Type (@{type_name fun}, [T, T'])) = strip_typeN (n - 1) T' |>> cons T
+ | strip_typeN n (Type (\<^type_name>\<open>fun\<close>, [T, T'])) = strip_typeN (n - 1) T' |>> cons T
| strip_typeN _ T = raise TYPE ("strip_typeN", [T], []);
(*maps [T1,...,Tn]--->T-->U to ([T1,T2,...,Tn], T-->U), where U is not a function type*)
@@ -217,14 +217,14 @@
val mk_relT = HOLogic.mk_setT o HOLogic.mk_prodT;
val dest_relT = HOLogic.dest_prodT o HOLogic.dest_setT;
val dest_pred2T = apsnd Term.domain_type o Term.dest_funT;
-fun mk_sumT (LT, RT) = Type (@{type_name Sum_Type.sum}, [LT, RT]);
+fun mk_sumT (LT, RT) = Type (\<^type_name>\<open>Sum_Type.sum\<close>, [LT, RT]);
(** Constants **)
-fun fst_const T = Const (@{const_name fst}, T --> fst (HOLogic.dest_prodT T));
-fun snd_const T = Const (@{const_name snd}, T --> snd (HOLogic.dest_prodT T));
-fun Id_const T = Const (@{const_name Id}, mk_relT (T, T));
+fun fst_const T = Const (\<^const_name>\<open>fst\<close>, T --> fst (HOLogic.dest_prodT T));
+fun snd_const T = Const (\<^const_name>\<open>snd\<close>, T --> snd (HOLogic.dest_prodT T));
+fun Id_const T = Const (\<^const_name>\<open>Id\<close>, mk_relT (T, T));
(** Operators **)
@@ -236,69 +236,69 @@
let
val RT = dest_relT (fastype_of R);
val RST = mk_relT (snd RT, fst RT);
- in Const (@{const_name converse}, fastype_of R --> RST) $ R end;
+ in Const (\<^const_name>\<open>converse\<close>, fastype_of R --> RST) $ R end;
fun mk_rel_comp (R, S) =
let
val RT = fastype_of R;
val ST = fastype_of S;
val RST = mk_relT (fst (dest_relT RT), snd (dest_relT ST));
- in Const (@{const_name relcomp}, RT --> ST --> RST) $ R $ S end;
+ in Const (\<^const_name>\<open>relcomp\<close>, RT --> ST --> RST) $ R $ S end;
fun mk_Gr A f =
let val ((AT, BT), FT) = `dest_funT (fastype_of f);
- in Const (@{const_name Gr}, HOLogic.mk_setT AT --> FT --> mk_relT (AT, BT)) $ A $ f end;
+ in Const (\<^const_name>\<open>Gr\<close>, HOLogic.mk_setT AT --> FT --> mk_relT (AT, BT)) $ A $ f end;
fun mk_conversep R =
let
val RT = dest_pred2T (fastype_of R);
val RST = mk_pred2T (snd RT) (fst RT);
- in Const (@{const_name conversep}, fastype_of R --> RST) $ R end;
+ in Const (\<^const_name>\<open>conversep\<close>, fastype_of R --> RST) $ R end;
fun mk_rel_compp (R, S) =
let
val RT = fastype_of R;
val ST = fastype_of S;
val RST = mk_pred2T (fst (dest_pred2T RT)) (snd (dest_pred2T ST));
- in Const (@{const_name relcompp}, RT --> ST --> RST) $ R $ S end;
+ in Const (\<^const_name>\<open>relcompp\<close>, RT --> ST --> RST) $ R $ S end;
fun mk_Grp A f =
let val ((AT, BT), FT) = `dest_funT (fastype_of f);
- in Const (@{const_name Grp}, HOLogic.mk_setT AT --> FT --> mk_pred2T AT BT) $ A $ f end;
+ in Const (\<^const_name>\<open>Grp\<close>, HOLogic.mk_setT AT --> FT --> mk_pred2T AT BT) $ A $ f end;
fun mk_image f =
let val (T, U) = dest_funT (fastype_of f);
- in Const (@{const_name image}, (T --> U) --> HOLogic.mk_setT T --> HOLogic.mk_setT U) $ f end;
+ in Const (\<^const_name>\<open>image\<close>, (T --> U) --> HOLogic.mk_setT T --> HOLogic.mk_setT U) $ f end;
fun mk_Ball X f =
- Const (@{const_name Ball}, fastype_of X --> fastype_of f --> HOLogic.boolT) $ X $ f;
+ Const (\<^const_name>\<open>Ball\<close>, fastype_of X --> fastype_of f --> HOLogic.boolT) $ X $ f;
fun mk_Bex X f =
- Const (@{const_name Bex}, fastype_of X --> fastype_of f --> HOLogic.boolT) $ X $ f;
+ Const (\<^const_name>\<open>Bex\<close>, fastype_of X --> fastype_of f --> HOLogic.boolT) $ X $ f;
fun mk_UNION X f =
let
val (T, U) = dest_funT (fastype_of f);
in
- Const (@{const_name Sup}, HOLogic.mk_setT U --> U)
- $ (Const (@{const_name image}, (T --> U) --> fastype_of X --> HOLogic.mk_setT U) $ f $ X)
+ Const (\<^const_name>\<open>Sup\<close>, HOLogic.mk_setT U --> U)
+ $ (Const (\<^const_name>\<open>image\<close>, (T --> U) --> fastype_of X --> HOLogic.mk_setT U) $ f $ X)
end;
fun mk_Union T =
- Const (@{const_name Sup}, HOLogic.mk_setT (HOLogic.mk_setT T) --> HOLogic.mk_setT T);
+ Const (\<^const_name>\<open>Sup\<close>, HOLogic.mk_setT (HOLogic.mk_setT T) --> HOLogic.mk_setT T);
-val mk_union = HOLogic.mk_binop @{const_name sup};
+val mk_union = HOLogic.mk_binop \<^const_name>\<open>sup\<close>;
fun mk_Field r =
let val T = fst (dest_relT (fastype_of r));
- in Const (@{const_name Field}, mk_relT (T, T) --> HOLogic.mk_setT T) $ r end;
+ in Const (\<^const_name>\<open>Field\<close>, mk_relT (T, T) --> HOLogic.mk_setT T) $ r end;
fun mk_card_order bd =
let
val T = fastype_of bd;
val AT = fst (dest_relT T);
in
- Const (@{const_name card_order_on}, HOLogic.mk_setT AT --> T --> HOLogic.boolT) $
+ Const (\<^const_name>\<open>card_order_on\<close>, HOLogic.mk_setT AT --> T --> HOLogic.boolT) $
HOLogic.mk_UNIV AT $ bd
end;
@@ -307,33 +307,33 @@
val T = fastype_of bd;
val AT = fst (dest_relT T);
in
- Const (@{const_name card_order_on}, HOLogic.mk_setT AT --> T --> HOLogic.boolT) $
+ Const (\<^const_name>\<open>card_order_on\<close>, HOLogic.mk_setT AT --> T --> HOLogic.boolT) $
mk_Field bd $ bd
end;
-fun mk_cinfinite bd = Const (@{const_name cinfinite}, fastype_of bd --> HOLogic.boolT) $ bd;
+fun mk_cinfinite bd = Const (\<^const_name>\<open>cinfinite\<close>, fastype_of bd --> HOLogic.boolT) $ bd;
fun mk_ordLeq t1 t2 =
HOLogic.mk_mem (HOLogic.mk_prod (t1, t2),
- Const (@{const_name ordLeq}, mk_relT (fastype_of t1, fastype_of t2)));
+ Const (\<^const_name>\<open>ordLeq\<close>, mk_relT (fastype_of t1, fastype_of t2)));
fun mk_card_of A =
let
val AT = fastype_of A;
val T = HOLogic.dest_setT AT;
in
- Const (@{const_name card_of}, AT --> mk_relT (T, T)) $ A
+ Const (\<^const_name>\<open>card_of\<close>, AT --> mk_relT (T, T)) $ A
end;
fun mk_dir_image r f =
let val (T, U) = dest_funT (fastype_of f);
- in Const (@{const_name dir_image}, mk_relT (T, T) --> (T --> U) --> mk_relT (U, U)) $ r $ f end;
+ in Const (\<^const_name>\<open>dir_image\<close>, mk_relT (T, T) --> (T --> U) --> mk_relT (U, U)) $ r $ f end;
fun mk_rel_fun R S =
let
val ((RA, RB), RT) = `dest_pred2T (fastype_of R);
val ((SA, SB), ST) = `dest_pred2T (fastype_of S);
- in Const (@{const_name rel_fun}, RT --> ST --> mk_pred2T (RA --> SA) (RB --> SB)) $ R $ S end;
+ in Const (\<^const_name>\<open>rel_fun\<close>, RT --> ST --> mk_pred2T (RA --> SA) (RB --> SB)) $ R $ S end;
(*FIXME: "x"?*)
(*(nth sets i) must be of type "T --> 'ai set"*)
@@ -341,20 +341,20 @@
let
fun in_single set A =
let val AT = fastype_of A;
- in Const (@{const_name less_eq}, AT --> AT --> HOLogic.boolT) $ (set $ Free ("x", T)) $ A end;
+ in Const (\<^const_name>\<open>less_eq\<close>, AT --> AT --> HOLogic.boolT) $ (set $ Free ("x", T)) $ A end;
in
if null sets then HOLogic.mk_UNIV T
else HOLogic.mk_Collect ("x", T, foldr1 (HOLogic.mk_conj) (map2 in_single sets As))
end;
fun mk_inj t =
- let val T as Type (@{type_name fun}, [domT, _]) = fastype_of t in
- Const (@{const_name inj_on}, T --> HOLogic.mk_setT domT --> HOLogic.boolT) $ t
+ let val T as Type (\<^type_name>\<open>fun\<close>, [domT, _]) = fastype_of t in
+ Const (\<^const_name>\<open>inj_on\<close>, T --> HOLogic.mk_setT domT --> HOLogic.boolT) $ t
$ HOLogic.mk_UNIV domT
end;
fun mk_leq t1 t2 =
- Const (@{const_name less_eq}, fastype_of t1 --> fastype_of t2 --> HOLogic.boolT) $ t1 $ t2;
+ Const (\<^const_name>\<open>less_eq\<close>, fastype_of t1 --> fastype_of t2 --> HOLogic.boolT) $ t1 $ t2;
fun mk_card_binop binop typop t1 t2 =
let
@@ -362,21 +362,21 @@
val (T2, relT2) = `(fst o dest_relT) (fastype_of t2);
in Const (binop, relT1 --> relT2 --> mk_relT (typop (T1, T2), typop (T1, T2))) $ t1 $ t2 end;
-val mk_csum = mk_card_binop @{const_name csum} mk_sumT;
-val mk_cprod = mk_card_binop @{const_name cprod} HOLogic.mk_prodT;
-val mk_cexp = mk_card_binop @{const_name cexp} (op --> o swap);
-val ctwo = @{term ctwo};
+val mk_csum = mk_card_binop \<^const_name>\<open>csum\<close> mk_sumT;
+val mk_cprod = mk_card_binop \<^const_name>\<open>cprod\<close> HOLogic.mk_prodT;
+val mk_cexp = mk_card_binop \<^const_name>\<open>cexp\<close> (op --> o swap);
+val ctwo = \<^term>\<open>ctwo\<close>;
fun mk_collect xs defT =
let val T = (case xs of [] => defT | (x::_) => fastype_of x);
- in Const (@{const_name collect}, HOLogic.mk_setT T --> T) $ (HOLogic.mk_set T xs) end;
+ in Const (\<^const_name>\<open>collect\<close>, HOLogic.mk_setT T --> T) $ (HOLogic.mk_set T xs) end;
fun mk_vimage2p f g =
let
val (T1, T2) = dest_funT (fastype_of f);
val (U1, U2) = dest_funT (fastype_of g);
in
- Const (@{const_name vimage2p},
+ Const (\<^const_name>\<open>vimage2p\<close>,
(T1 --> T2) --> (U1 --> U2) --> mk_pred2T T2 U2 --> mk_pred2T T1 U1) $ f $ g
end;
@@ -384,14 +384,14 @@
let
val T = domain_type (fastype_of P);
in
- Const (@{const_name eq_onp}, (T --> HOLogic.boolT) --> T --> T --> HOLogic.boolT) $ P
+ Const (\<^const_name>\<open>eq_onp\<close>, (T --> HOLogic.boolT) --> T --> T --> HOLogic.boolT) $ P
end;
fun mk_pred name R =
Const (name, uncurry mk_pred2T (fastype_of R |> dest_pred2T) --> HOLogic.boolT) $ R;
-val mk_reflp = mk_pred @{const_name reflp};
-val mk_symp = mk_pred @{const_name symp};
-val mk_transp = mk_pred @{const_name transp};
+val mk_reflp = mk_pred \<^const_name>\<open>reflp\<close>;
+val mk_symp = mk_pred \<^const_name>\<open>symp\<close>;
+val mk_transp = mk_pred \<^const_name>\<open>transp\<close>;
fun mk_trans thm1 thm2 = trans OF [thm1, thm2];
fun mk_sym thm = thm RS sym;
--- a/src/HOL/Tools/Ctr_Sugar/case_translation.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Ctr_Sugar/case_translation.ML Fri Jan 04 23:22:53 2019 +0100
@@ -126,7 +126,7 @@
(* parse translation *)
-fun constrain_Abs tT t = Syntax.const @{syntax_const "_constrainAbs"} $ t $ tT;
+fun constrain_Abs tT t = Syntax.const \<^syntax_const>\<open>_constrainAbs\<close> $ t $ tT;
fun case_tr err ctxt [t, u] =
let
@@ -138,10 +138,10 @@
in if is_const x' then variant_free x' used' else (x', used') end;
fun abs p tTs t =
- Syntax.const @{const_syntax case_abs} $
+ Syntax.const \<^const_syntax>\<open>case_abs\<close> $
fold constrain_Abs tTs (absfree p t);
- fun abs_pat (Const (@{syntax_const "_constrain"}, _) $ t $ tT) tTs =
+ fun abs_pat (Const (\<^syntax_const>\<open>_constrain\<close>, _) $ t $ tT) tTs =
abs_pat t (tT :: tTs)
| abs_pat (Free (p as (x, _))) tTs =
if is_const x then I else abs p tTs
@@ -149,7 +149,7 @@
| abs_pat _ _ = I;
(* replace occurrences of dummy_pattern by distinct variables *)
- fun replace_dummies (Const (@{const_syntax Pure.dummy_pattern}, T)) used =
+ fun replace_dummies (Const (\<^const_syntax>\<open>Pure.dummy_pattern\<close>, T)) used =
let val (x, used') = variant_free "x" used
in (Free (x, T), used') end
| replace_dummies (t $ u) used =
@@ -159,54 +159,54 @@
in (t' $ u', used'') end
| replace_dummies t used = (t, used);
- fun dest_case1 (t as Const (@{syntax_const "_case1"}, _) $ l $ r) =
+ fun dest_case1 (t as Const (\<^syntax_const>\<open>_case1\<close>, _) $ l $ r) =
let val (l', _) = replace_dummies l (Term.declare_term_frees t Name.context) in
abs_pat l' []
- (Syntax.const @{const_syntax case_elem} $ Term_Position.strip_positions l' $ r)
+ (Syntax.const \<^const_syntax>\<open>case_elem\<close> $ Term_Position.strip_positions l' $ r)
end
| dest_case1 _ = case_error "dest_case1";
- fun dest_case2 (Const (@{syntax_const "_case2"}, _) $ t $ u) = t :: dest_case2 u
+ fun dest_case2 (Const (\<^syntax_const>\<open>_case2\<close>, _) $ t $ u) = t :: dest_case2 u
| dest_case2 t = [t];
- val errt = Syntax.const (if err then @{const_syntax True} else @{const_syntax False});
+ val errt = Syntax.const (if err then \<^const_syntax>\<open>True\<close> else \<^const_syntax>\<open>False\<close>);
in
- Syntax.const @{const_syntax case_guard} $ errt $ t $
+ Syntax.const \<^const_syntax>\<open>case_guard\<close> $ errt $ t $
(fold_rev
- (fn t => fn u => Syntax.const @{const_syntax case_cons} $ dest_case1 t $ u)
+ (fn t => fn u => Syntax.const \<^const_syntax>\<open>case_cons\<close> $ dest_case1 t $ u)
(dest_case2 u)
- (Syntax.const @{const_syntax case_nil}))
+ (Syntax.const \<^const_syntax>\<open>case_nil\<close>))
end
| case_tr _ _ _ = case_error "case_tr";
-val _ = Theory.setup (Sign.parse_translation [(@{syntax_const "_case_syntax"}, case_tr true)]);
+val _ = Theory.setup (Sign.parse_translation [(\<^syntax_const>\<open>_case_syntax\<close>, case_tr true)]);
(* print translation *)
fun case_tr' (_ :: x :: t :: ts) =
let
- fun mk_clause (Const (@{const_syntax case_abs}, _) $ Abs (s, T, t)) xs used =
+ fun mk_clause (Const (\<^const_syntax>\<open>case_abs\<close>, _) $ Abs (s, T, t)) xs used =
let val (s', used') = Name.variant s used
in mk_clause t ((s', T) :: xs) used' end
- | mk_clause (Const (@{const_syntax case_elem}, _) $ pat $ rhs) xs _ =
- Syntax.const @{syntax_const "_case1"} $
+ | mk_clause (Const (\<^const_syntax>\<open>case_elem\<close>, _) $ pat $ rhs) xs _ =
+ Syntax.const \<^syntax_const>\<open>_case1\<close> $
subst_bounds (map Syntax_Trans.mark_bound_abs xs, pat) $
subst_bounds (map Syntax_Trans.mark_bound_body xs, rhs)
| mk_clause _ _ _ = raise Match;
- fun mk_clauses (Const (@{const_syntax case_nil}, _)) = []
- | mk_clauses (Const (@{const_syntax case_cons}, _) $ t $ u) =
+ fun mk_clauses (Const (\<^const_syntax>\<open>case_nil\<close>, _)) = []
+ | mk_clauses (Const (\<^const_syntax>\<open>case_cons\<close>, _) $ t $ u) =
mk_clause t [] (Term.declare_term_frees t Name.context) :: mk_clauses u
| mk_clauses _ = raise Match;
in
- list_comb (Syntax.const @{syntax_const "_case_syntax"} $ x $
- foldr1 (fn (t, u) => Syntax.const @{syntax_const "_case2"} $ t $ u)
+ list_comb (Syntax.const \<^syntax_const>\<open>_case_syntax\<close> $ x $
+ foldr1 (fn (t, u) => Syntax.const \<^syntax_const>\<open>_case2\<close> $ t $ u)
(mk_clauses t), ts)
end
| case_tr' _ = raise Match;
-val _ = Theory.setup (Sign.print_translation [(@{const_syntax "case_guard"}, K case_tr')]);
+val _ = Theory.setup (Sign.print_translation [(\<^const_syntax>\<open>case_guard\<close>, K case_tr')]);
(* declarations *)
@@ -229,7 +229,7 @@
end;
val _ = Theory.setup
- (Attrib.setup @{binding case_translation}
+ (Attrib.setup \<^binding>\<open>case_translation\<close>
(Args.term -- Scan.repeat1 Args.term >>
(fn (t, ts) => Thm.declaration_attribute (K (register t ts))))
"declaration of case combinators and constructors");
@@ -310,7 +310,7 @@
(fold Term.declare_term_frees gvars used');
in
[((prfx, gvars @ map Free (xs ~~ Ts)),
- (Const (@{const_name undefined}, res_ty), ~1))]
+ (Const (\<^const_name>\<open>undefined\<close>, res_ty), ~1))]
end
else in_group;
in
@@ -398,7 +398,7 @@
let
fun string_of_clause (pat, rhs) =
Syntax.unparse_term ctxt
- (Term.list_comb (Syntax.const @{syntax_const "_case1"},
+ (Term.list_comb (Syntax.const \<^syntax_const>\<open>_case1\<close>,
Syntax.uncheck_terms ctxt [pat, rhs]))
|> Pretty.string_of;
@@ -431,23 +431,23 @@
(* term check *)
-fun decode_clause (Const (@{const_name case_abs}, _) $ Abs (s, T, t)) xs used =
+fun decode_clause (Const (\<^const_name>\<open>case_abs\<close>, _) $ Abs (s, T, t)) xs used =
let val (s', used') = Name.variant s used
in decode_clause t (Free (s', T) :: xs) used' end
- | decode_clause (Const (@{const_name case_elem}, _) $ t $ u) xs _ =
+ | decode_clause (Const (\<^const_name>\<open>case_elem\<close>, _) $ t $ u) xs _ =
(subst_bounds (xs, t), subst_bounds (xs, u))
| decode_clause _ _ _ = case_error "decode_clause";
-fun decode_cases (Const (@{const_name case_nil}, _)) = []
- | decode_cases (Const (@{const_name case_cons}, _) $ t $ u) =
+fun decode_cases (Const (\<^const_name>\<open>case_nil\<close>, _)) = []
+ | decode_cases (Const (\<^const_name>\<open>case_cons\<close>, _) $ t $ u) =
decode_clause t [] (Term.declare_term_frees t Name.context) ::
decode_cases u
| decode_cases _ = case_error "decode_cases";
fun check_case ctxt =
let
- fun decode_case (Const (@{const_name case_guard}, _) $ b $ u $ t) =
- make_case ctxt (if b = @{term True} then Error else Warning)
+ fun decode_case (Const (\<^const_name>\<open>case_guard\<close>, _) $ b $ u $ t) =
+ make_case ctxt (if b = \<^term>\<open>True\<close> then Error else Warning)
Name.context (decode_case u) (decode_cases t)
| decode_case (t $ u) = decode_case t $ decode_case u
| decode_case (Abs (x, T, u)) =
@@ -490,7 +490,7 @@
in k < 0 orelse exists (fn j => j >= k) (loose_bnos (strip_abs_body t)) end;
fun count_cases (_, _, true) = I
| count_cases (c, (_, body), false) = AList.map_default op aconv (body, []) (cons c);
- val is_undefined = name_of #> equal (SOME @{const_name undefined});
+ val is_undefined = name_of #> equal (SOME \<^const_name>\<open>undefined\<close>);
fun mk_case (c, (xs, body), _) = (list_comb (c, xs), body);
val get_info = lookup_by_case ctxt;
in
@@ -542,13 +542,13 @@
fun encode_clause recur S T (pat, rhs) =
fold (fn x as (_, U) => fn t =>
let val T = fastype_of t;
- in Const (@{const_name case_abs}, (U --> T) --> T) $ Term.absfree x t end)
+ in Const (\<^const_name>\<open>case_abs\<close>, (U --> T) --> T) $ Term.absfree x t end)
(Term.add_frees pat [])
- (Const (@{const_name case_elem}, S --> T --> S --> T) $ pat $ recur rhs);
+ (Const (\<^const_name>\<open>case_elem\<close>, S --> T --> S --> T) $ pat $ recur rhs);
-fun encode_cases _ S T [] = Const (@{const_name case_nil}, S --> T)
+fun encode_cases _ S T [] = Const (\<^const_name>\<open>case_nil\<close>, S --> T)
| encode_cases recur S T (p :: ps) =
- Const (@{const_name case_cons}, (S --> T) --> (S --> T) --> S --> T) $
+ Const (\<^const_name>\<open>case_cons\<close>, (S --> T) --> (S --> T) --> S --> T) $
encode_clause recur S T p $ encode_cases recur S T ps;
fun encode_case recur (t, ps as (pat, rhs) :: _) =
@@ -556,8 +556,8 @@
val tT = fastype_of t;
val T = fastype_of rhs;
in
- Const (@{const_name case_guard}, @{typ bool} --> tT --> (tT --> T) --> T) $
- @{term True} $ t $ (encode_cases recur (fastype_of pat) (fastype_of rhs) ps)
+ Const (\<^const_name>\<open>case_guard\<close>, \<^typ>\<open>bool\<close> --> tT --> (tT --> T) --> T) $
+ \<^term>\<open>True\<close> $ t $ (encode_cases recur (fastype_of pat) (fastype_of rhs) ps)
end
| encode_case _ _ = case_error "encode_case";
@@ -594,7 +594,7 @@
(* term uncheck *)
-val show_cases = Attrib.setup_config_bool @{binding show_cases} (K true);
+val show_cases = Attrib.setup_config_bool \<^binding>\<open>show_cases\<close> (K true);
fun uncheck_case ctxt ts =
if Config.get ctxt show_cases
@@ -631,7 +631,7 @@
end;
val _ =
- Outer_Syntax.command @{command_keyword print_case_translations}
+ Outer_Syntax.command \<^command_keyword>\<open>print_case_translations\<close>
"print registered case combinators and constructors"
(Scan.succeed (Toplevel.keep (print_case_translations o Toplevel.context_of)))
--- a/src/HOL/Tools/Ctr_Sugar/ctr_sugar.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Ctr_Sugar/ctr_sugar.ML Fri Jan 04 23:22:53 2019 +0100
@@ -280,7 +280,7 @@
map2 (map2 append) (Library.chop_groups n half_xss)
(transpose (Library.chop_groups n other_half_xss)));
-fun mk_undefined T = Const (@{const_name undefined}, T);
+fun mk_undefined T = Const (\<^const_name>\<open>undefined\<close>, T);
fun mk_ctr Ts t =
let val Type (_, Ts0) = body_type (fastype_of t) in
@@ -301,9 +301,9 @@
(case head_of t of
Abs (_, _, @{const Not} $ (t' $ Bound 0)) =>
Long_Name.map_base_name (prefix not_prefix) (name_of_disc t')
- | Abs (_, _, Const (@{const_name HOL.eq}, _) $ Bound 0 $ t') =>
+ | Abs (_, _, Const (\<^const_name>\<open>HOL.eq\<close>, _) $ Bound 0 $ t') =>
Long_Name.map_base_name (prefix is_prefix) (name_of_disc t')
- | Abs (_, _, @{const Not} $ (Const (@{const_name HOL.eq}, _) $ Bound 0 $ t')) =>
+ | Abs (_, _, @{const Not} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ Bound 0 $ t')) =>
Long_Name.map_base_name (prefix (not_prefix ^ is_prefix)) (name_of_disc t')
| t' => name_of_const "discriminator" (perhaps (try domain_type)) t');
@@ -380,7 +380,7 @@
fun ctr_of_ctr_spec ((_, ctr), _) = ctr;
fun args_of_ctr_spec (_, args) = args;
-val code_plugin = Plugin_Name.declare_setup @{binding code};
+val code_plugin = Plugin_Name.declare_setup \<^binding>\<open>code\<close>;
fun prepare_free_constructors kind prep_plugins prep_term
((((raw_plugins, discs_sels), raw_case_binding), ctr_specs), sel_default_eqs) no_defs_lthy =
@@ -431,7 +431,7 @@
can_definitely_rely_on_disc k orelse (k = 1 andalso not (can_definitely_rely_on_disc 2));
fun should_omit_disc_binding k = n = 1 orelse (n = 2 andalso can_rely_on_disc (3 - k));
- val equal_binding = @{binding "="};
+ val equal_binding = \<^binding>\<open>=\<close>;
fun is_disc_binding_valid b =
not (Binding.is_empty b orelse Binding.eq_name (b, equal_binding));
@@ -504,7 +504,7 @@
list_exists_free xs (HOLogic.mk_conj (HOLogic.mk_eq (u, xctr), HOLogic.mk_eq (w, xf)));
val case_rhs = fold_rev (fold_rev Term.lambda) [fs, [u]]
- (Const (@{const_name The}, (B --> HOLogic.boolT) --> B) $
+ (Const (\<^const_name>\<open>The\<close>, (B --> HOLogic.boolT) --> B) $
Term.lambda w (Library.foldr1 HOLogic.mk_disj (@{map 3} mk_case_disj xctrs xfs xss)));
val ((raw_case, (_, raw_case_def)), (lthy, lthy_old)) = no_defs_lthy
@@ -832,7 +832,7 @@
fun has_undefined_rhs thm =
(case snd (HOLogic.dest_eq (HOLogic.dest_Trueprop (Thm.prop_of thm))) of
- Const (@{const_name undefined}, _) => true
+ Const (\<^const_name>\<open>undefined\<close>, _) => true
| _ => false);
val all_sel_thms =
@@ -1158,7 +1158,7 @@
Proof.theorem NONE (snd oo after_qed) (map (map (rpair [])) goalss) lthy) oo
prepare_free_constructors kind Plugin_Name.make_filter Syntax.read_term;
-val parse_bound_term = Parse.binding --| @{keyword ":"} -- Parse.term;
+val parse_bound_term = Parse.binding --| \<^keyword>\<open>:\<close> -- Parse.term;
type ctr_options = Plugin_Name.filter * bool;
type ctr_options_cmd = (Proof.context -> Plugin_Name.filter) * bool;
@@ -1167,10 +1167,10 @@
val default_ctr_options_cmd : ctr_options_cmd = (K Plugin_Name.default_filter, false);
val parse_ctr_options =
- Scan.optional (@{keyword "("} |-- Parse.list1
+ Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.list1
(Plugin_Name.parse_filter >> (apfst o K)
|| Parse.reserved "discs_sels" >> (apsnd o K o K true)) --|
- @{keyword ")"}
+ \<^keyword>\<open>)\<close>
>> (fn fs => fold I fs default_ctr_options_cmd))
default_ctr_options_cmd;
@@ -1178,12 +1178,12 @@
parse_opt_binding_colon -- parse_ctr -- Scan.repeat parse_arg;
val parse_ctr_specs = Parse.enum1 "|" (parse_ctr_spec Parse.term Parse.binding);
-val parse_sel_default_eqs = Scan.optional (@{keyword "where"} |-- Parse.enum1 "|" Parse.prop) [];
+val parse_sel_default_eqs = Scan.optional (\<^keyword>\<open>where\<close> |-- Parse.enum1 "|" Parse.prop) [];
val _ =
- Outer_Syntax.local_theory_to_proof @{command_keyword free_constructors}
+ Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>free_constructors\<close>
"register an existing freely generated type's constructors"
- (parse_ctr_options -- Parse.binding --| @{keyword "for"} -- parse_ctr_specs
+ (parse_ctr_options -- Parse.binding --| \<^keyword>\<open>for\<close> -- parse_ctr_specs
-- parse_sel_default_eqs
>> free_constructors_cmd Unknown);
--- a/src/HOL/Tools/Ctr_Sugar/ctr_sugar_code.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Ctr_Sugar/ctr_sugar_code.ML Fri Jan 04 23:22:53 2019 +0100
@@ -49,9 +49,9 @@
fun mk_free_ctr_equations fcT ctrs inject_thms distinct_thms thy =
let
- fun mk_fcT_eq (t, u) = Const (@{const_name HOL.equal}, fcT --> fcT --> HOLogic.boolT) $ t $ u;
- fun true_eq tu = HOLogic.mk_eq (mk_fcT_eq tu, @{term True});
- fun false_eq tu = HOLogic.mk_eq (mk_fcT_eq tu, @{term False});
+ fun mk_fcT_eq (t, u) = Const (\<^const_name>\<open>HOL.equal\<close>, fcT --> fcT --> HOLogic.boolT) $ t $ u;
+ fun true_eq tu = HOLogic.mk_eq (mk_fcT_eq tu, \<^term>\<open>True\<close>);
+ fun false_eq tu = HOLogic.mk_eq (mk_fcT_eq tu, \<^term>\<open>False\<close>);
val monomorphic_prop_of = Thm.prop_of o Thm.unvarify_global thy o Drule.zero_var_indexes;
@@ -90,7 +90,7 @@
fun mk_side const_name =
Const (const_name, fcT --> fcT --> HOLogic.boolT) $ Free ("x", fcT) $ Free ("y", fcT);
val spec =
- mk_Trueprop_eq (mk_side @{const_name HOL.equal}, mk_side @{const_name HOL.eq})
+ mk_Trueprop_eq (mk_side \<^const_name>\<open>HOL.equal\<close>, mk_side \<^const_name>\<open>HOL.eq\<close>)
|> Syntax.check_term lthy;
val ((_, (_, raw_def)), lthy') =
Specification.definition NONE [] [] (Binding.empty_atts, spec) lthy;
--- a/src/HOL/Tools/Ctr_Sugar/ctr_sugar_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Ctr_Sugar/ctr_sugar_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -127,7 +127,7 @@
val mk_TFrees' = apfst (map TFree) oo Variable.invent_types;
-fun mk_TFrees n = mk_TFrees' (replicate n @{sort type});
+fun mk_TFrees n = mk_TFrees' (replicate n \<^sort>\<open>type\<close>);
fun mk_Frees' x Ts ctxt = mk_fresh_names ctxt (length Ts) x |>> (fn xs => `(map Free) (xs ~~ Ts));
fun mk_Freess' x Tss = @{fold_map 2} mk_Frees' (mk_names (length Tss) x) Tss #>> split_list;
@@ -154,7 +154,7 @@
fun variant_tfrees ss =
apfst (map TFree) o
- variant_types (map (ensure_prefix "'") ss) (replicate (length ss) @{sort type});
+ variant_types (map (ensure_prefix "'") ss) (replicate (length ss) \<^sort>\<open>type\<close>);
fun add_components_of_typ (Type (s, Ts)) =
cons (Long_Name.base_name s) #> fold_rev add_components_of_typ Ts
@@ -199,7 +199,7 @@
fun mk_IfN _ _ [t] = t
| mk_IfN T (c :: cs) (t :: ts) =
- Const (@{const_name If}, HOLogic.boolT --> T --> T --> T) $ c $ t $ mk_IfN T cs ts;
+ Const (\<^const_name>\<open>If\<close>, HOLogic.boolT --> T --> T --> T) $ c $ t $ mk_IfN T cs ts;
val mk_Trueprop_eq = HOLogic.mk_Trueprop o HOLogic.mk_eq;
val mk_Trueprop_mem = HOLogic.mk_Trueprop o HOLogic.mk_mem;
@@ -236,9 +236,9 @@
(* The standard binding stands for a name generated following the canonical convention (e.g.,
"is_Nil" from "Nil"). In contrast, the empty binding is either the standard binding or no
binding at all, depending on the context. *)
-val standard_binding = @{binding _};
+val standard_binding = \<^binding>\<open>_\<close>;
-val parse_binding_colon = Parse.binding --| @{keyword ":"};
+val parse_binding_colon = Parse.binding --| \<^keyword>\<open>:\<close>;
val parse_opt_binding_colon = Scan.optional parse_binding_colon Binding.empty;
fun ss_only thms ctxt = clear_simpset (put_simpset HOL_basic_ss ctxt) addsimps thms;
--- a/src/HOL/Tools/Function/function_lib.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Function/function_lib.ML Fri Jan 04 23:22:53 2019 +0100
@@ -35,7 +35,7 @@
structure Function_Lib: FUNCTION_LIB =
struct
-val function_internals = Attrib.setup_config_bool @{binding function_internals} (K false)
+val function_internals = Attrib.setup_config_bool \<^binding>\<open>function_internals\<close> (K false)
fun derived_name binding name =
Binding.reset_pos (Binding.qualify_name true binding name)
--- a/src/HOL/Tools/Function/lexicographic_order.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Function/lexicographic_order.ML Fri Jan 04 23:22:53 2019 +0100
@@ -211,7 +211,7 @@
fun lexicographic_order_tac quiet ctxt =
TRY (Function_Common.termination_rule_tac ctxt 1) THEN
lex_order_tac quiet ctxt
- (auto_tac (ctxt addsimps (Named_Theorems.get ctxt @{named_theorems termination_simp})))
+ (auto_tac (ctxt addsimps (Named_Theorems.get ctxt \<^named_theorems>\<open>termination_simp\<close>)))
val _ =
Theory.setup
--- a/src/HOL/Tools/Function/partial_function.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Function/partial_function.ML Fri Jan 04 23:22:53 2019 +0100
@@ -150,15 +150,15 @@
fun uncurry_n arity = funpow (arity - 1) HOLogic.mk_case_prod;
val curry_uncurry_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps [@{thm Product_Type.curry_case_prod}, @{thm Product_Type.case_prod_curry}])
val split_conv_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps [@{thm Product_Type.split_conv}]);
val curry_K_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps [@{thm Product_Type.curry_K}]);
(* instantiate generic fixpoint induction and eliminate the canonical assumptions;
--- a/src/HOL/Tools/Function/scnp_reconstruct.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Function/scnp_reconstruct.ML Fri Jan 04 23:22:53 2019 +0100
@@ -322,7 +322,7 @@
fun decomp_scnp_tac orders ctxt =
let
- val extra_simps = Named_Theorems.get ctxt @{named_theorems termination_simp}
+ val extra_simps = Named_Theorems.get ctxt \<^named_theorems>\<open>termination_simp\<close>
val autom_tac = auto_tac (ctxt addsimps extra_simps)
in
gen_sizechange_tac orders autom_tac ctxt
@@ -340,7 +340,7 @@
val _ =
Theory.setup
- (Method.setup @{binding size_change}
+ (Method.setup \<^binding>\<open>size_change\<close>
(Scan.lift orders --| Method.sections clasimp_modifiers >>
(fn orders => SIMPLE_METHOD o decomp_scnp_tac orders))
"termination prover with graph decomposition and the NP subset of size change termination")
--- a/src/HOL/Tools/Function/sum_tree.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Function/sum_tree.ML Fri Jan 04 23:22:53 2019 +0100
@@ -21,7 +21,7 @@
(* Theory dependencies *)
val sumcase_split_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps (@{thm Product_Type.split} :: @{thms sum.case}))
(* top-down access in balanced tree *)
--- a/src/HOL/Tools/Lifting/lifting_bnf.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Lifting/lifting_bnf.ML Fri Jan 04 23:22:53 2019 +0100
@@ -42,7 +42,7 @@
let
val argTs = map fastype_of args
in
- list_comb (Const (@{const_name Quotient}, argTs ---> HOLogic.boolT), args)
+ list_comb (Const (\<^const_name>\<open>Quotient\<close>, argTs ---> HOLogic.boolT), args)
end
fun prove_Quotient_map bnf ctxt =
@@ -106,7 +106,7 @@
lthy |> fold (perhaps o try o (snd oo Local_Theory.notes)) notess
end
-val lifting_plugin = Plugin_Name.declare_setup @{binding lifting}
+val lifting_plugin = Plugin_Name.declare_setup \<^binding>\<open>lifting\<close>
val _ =
Theory.setup
--- a/src/HOL/Tools/Lifting/lifting_def.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Lifting/lifting_def.ML Fri Jan 04 23:22:53 2019 +0100
@@ -149,8 +149,8 @@
let
val T = fastype_of x
in
- Const (@{const_name "less_eq"}, T --> T --> HOLogic.boolT) $
- (Const (@{const_name HOL.eq}, T)) $ x
+ Const (\<^const_name>\<open>less_eq\<close>, T --> T --> HOLogic.boolT) $
+ (Const (\<^const_name>\<open>HOL.eq\<close>, T)) $ x
end;
val goal = HOLogic.mk_Trueprop (mk_ge_eq rel);
in
@@ -223,7 +223,7 @@
fun zip_transfer_rules ctxt thm =
let
- fun mk_POS ty = Const (@{const_name POS}, ty --> ty --> HOLogic.boolT)
+ fun mk_POS ty = Const (\<^const_name>\<open>POS\<close>, ty --> ty --> HOLogic.boolT)
val rel = (Thm.dest_fun2 o Thm.dest_arg o Thm.cprop_of) thm
val typ = Thm.typ_of_cterm rel
val POS_const = Thm.cterm_of ctxt (mk_POS typ)
@@ -285,15 +285,15 @@
fun get_binder_types (Type ("fun", [T, U]), Type ("fun", [V, W])) = (T, V) :: get_binder_types (U, W)
| get_binder_types _ = []
-fun get_binder_types_by_rel (Const (@{const_name "rel_fun"}, _) $ _ $ S) (Type ("fun", [T, U]), Type ("fun", [V, W])) =
+fun get_binder_types_by_rel (Const (\<^const_name>\<open>rel_fun\<close>, _) $ _ $ S) (Type ("fun", [T, U]), Type ("fun", [V, W])) =
(T, V) :: get_binder_types_by_rel S (U, W)
| get_binder_types_by_rel _ _ = []
-fun get_body_type_by_rel (Const (@{const_name "rel_fun"}, _) $ _ $ S) (Type ("fun", [_, U]), Type ("fun", [_, V])) =
+fun get_body_type_by_rel (Const (\<^const_name>\<open>rel_fun\<close>, _) $ _ $ S) (Type ("fun", [_, U]), Type ("fun", [_, V])) =
get_body_type_by_rel S (U, V)
| get_body_type_by_rel _ (U, V) = (U, V)
-fun get_binder_rels (Const (@{const_name "rel_fun"}, _) $ R $ S) = R :: get_binder_rels S
+fun get_binder_rels (Const (\<^const_name>\<open>rel_fun\<close>, _) $ R $ S) = R :: get_binder_rels S
| get_binder_rels _ = []
fun force_rty_type ctxt rty rhs =
@@ -329,15 +329,15 @@
val map_fun_unfolded =
@{thm map_fun_def[abs_def]} |>
- unabs_def @{context} |>
- unabs_def @{context} |>
- Local_Defs.unfold0 @{context} [@{thm comp_def}]
+ unabs_def \<^context> |>
+ unabs_def \<^context> |>
+ Local_Defs.unfold0 \<^context> [@{thm comp_def}]
fun unfold_fun_maps ctm =
let
fun unfold_conv ctm =
case (Thm.term_of ctm) of
- Const (@{const_name "map_fun"}, _) $ _ $ _ =>
+ Const (\<^const_name>\<open>map_fun\<close>, _) $ _ $ _ =>
(Conv.arg_conv unfold_conv then_conv Conv.rewr_conv map_fun_unfolded) ctm
| _ => Conv.all_conv ctm
in
@@ -376,8 +376,8 @@
fun can_generate_code_cert quot_thm =
case quot_thm_rel quot_thm of
- Const (@{const_name HOL.eq}, _) => true
- | Const (@{const_name eq_onp}, _) $ _ => true
+ Const (\<^const_name>\<open>HOL.eq\<close>, _) => true
+ | Const (\<^const_name>\<open>eq_onp\<close>, _) $ _ => true
| _ => false
fun generate_rep_eq ctxt def_thm rsp_thm (rty, qty) =
--- a/src/HOL/Tools/Lifting/lifting_def_code_dt.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Lifting/lifting_def_code_dt.ML Fri Jan 04 23:22:53 2019 +0100
@@ -164,7 +164,7 @@
(** unique name for a type **)
-fun var_name name sort = if sort = @{sort "{type}"} orelse sort = [] then ["x" ^ name]
+fun var_name name sort = if sort = \<^sort>\<open>{type}\<close> orelse sort = [] then ["x" ^ name]
else "x" ^ name :: "x_" :: sort @ ["x_"];
fun concat_Tnames (Type (name, ts)) = name :: maps concat_Tnames ts
@@ -180,7 +180,7 @@
(** witnesses **)
-fun mk_undefined T = Const (@{const_name undefined}, T);
+fun mk_undefined T = Const (\<^const_name>\<open>undefined\<close>, T);
fun mk_witness quot_thm =
let
@@ -239,7 +239,7 @@
fun binop_conv2 cv1 cv2 = Conv.combination_conv (Conv.arg_conv cv1) cv2
fun ret_rel_conv conv ctm =
case (Thm.term_of ctm) of
- Const (@{const_name "rel_fun"}, _) $ _ $ _ =>
+ Const (\<^const_name>\<open>rel_fun\<close>, _) $ _ $ _ =>
binop_conv2 Conv.all_conv conv ctm
| _ => conv ctm
fun R_conv rel_eq_onps = Transfer.top_sweep_rewr_conv @{thms eq_onp_top_eq_eq[symmetric, THEN eq_reflection]}
@@ -437,7 +437,7 @@
fun mk_type_definition newT oldT RepC AbsC A =
let
val typedefC =
- Const (@{const_name type_definition},
+ Const (\<^const_name>\<open>type_definition\<close>,
(newT --> oldT) --> (oldT --> newT) --> HOLogic.mk_setT oldT --> HOLogic.boolT);
in typedefC $ RepC $ AbsC $ A end;
val typedef_goal = mk_type_definition qty_isom qty rep_isom abs_isom (HOLogic.mk_UNIV qty) |>
@@ -483,7 +483,7 @@
let
val rep = quot_isom_rep lthy (rty, qty)
in
- if is_Const rep andalso (rep |> dest_Const |> fst) = @{const_name id} then
+ if is_Const rep andalso (rep |> dest_Const |> fst) = \<^const_name>\<open>id\<close> then
t else rep $ t
end;
in
@@ -630,7 +630,7 @@
**)
local
- val eq_onp_assms_tac_fixed_rules = map (Transfer.prep_transfer_domain_thm @{context})
+ val eq_onp_assms_tac_fixed_rules = map (Transfer.prep_transfer_domain_thm \<^context>)
[@{thm pcr_Domainp_total}, @{thm pcr_Domainp_par_left_total}, @{thm pcr_Domainp_par},
@{thm pcr_Domainp}]
in
@@ -699,7 +699,7 @@
(K (Conv.try_conv (Conv.rewrs_conv (Transfer.get_relator_eq lthy)))) lthy
in
case (Thm.term_of ctm) of
- Const (@{const_name "rel_fun"}, _) $ _ $ _ =>
+ Const (\<^const_name>\<open>rel_fun\<close>, _) $ _ $ _ =>
(binop_conv2 simp_arrows_conv simp_arrows_conv then_conv unfold_conv) ctm
| _ => (relator_eq_onp_conv then_conv relator_eq_conv) ctm
end
@@ -722,11 +722,11 @@
fun rename_to_tnames ctxt term =
let
- fun all_typs (Const (@{const_name Pure.all}, _) $ Abs (_, T, t)) = T :: all_typs t
+ fun all_typs (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (_, T, t)) = T :: all_typs t
| all_typs _ = []
- fun rename (Const (@{const_name Pure.all}, T1) $ Abs (_, T2, t)) (new_name :: names) =
- (Const (@{const_name Pure.all}, T1) $ Abs (new_name, T2, rename t names))
+ fun rename (Const (\<^const_name>\<open>Pure.all\<close>, T1) $ Abs (_, T2, t)) (new_name :: names) =
+ (Const (\<^const_name>\<open>Pure.all\<close>, T1) $ Abs (new_name, T2, rename t names))
| rename t _ = t
val (fixed_def_t, _) = yield_singleton (Variable.importT_terms) term ctxt
@@ -821,13 +821,13 @@
(* command syntax *)
val _ =
- Outer_Syntax.local_theory_to_proof @{command_keyword lift_definition}
+ Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>lift_definition\<close>
"definition for constants over the quotient type"
(parse_params --
- (((Parse.binding -- (@{keyword "::"} |-- (Parse.typ >> SOME) -- Parse.opt_mixfix')
+ (((Parse.binding -- (\<^keyword>\<open>::\<close> |-- (Parse.typ >> SOME) -- Parse.opt_mixfix')
>> Scan.triple2) --
- (@{keyword "is"} |-- Parse.term) --
- Scan.optional (@{keyword "parametric"} |-- Parse.!!! Parse.thms1) []) >> Scan.triple1)
+ (\<^keyword>\<open>is\<close> |-- Parse.term) --
+ Scan.optional (\<^keyword>\<open>parametric\<close> |-- Parse.!!! Parse.thms1) []) >> Scan.triple1)
>> lift_def_cmd_with_err_handling);
end
--- a/src/HOL/Tools/Lifting/lifting_info.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Lifting/lifting_info.ML Fri Jan 04 23:22:53 2019 +0100
@@ -192,7 +192,7 @@
val _ =
Theory.setup
- (Attrib.setup @{binding quot_map} (Scan.succeed (Thm.declaration_attribute add_quot_map))
+ (Attrib.setup \<^binding>\<open>quot_map\<close> (Scan.succeed (Thm.declaration_attribute add_quot_map))
"declaration of the Quotient map theorem")
fun print_quot_maps ctxt =
@@ -264,7 +264,7 @@
val _ =
Theory.setup
- (Attrib.setup @{binding quot_del} (Scan.succeed (Thm.declaration_attribute delete_quotients))
+ (Attrib.setup \<^binding>\<open>quot_del\<close> (Scan.succeed (Thm.declaration_attribute delete_quotients))
"deletes the Quotient theorem")
(* data for restoring Transfer/Lifting context *)
@@ -288,7 +288,7 @@
(* theorems that a relator of an eq_onp is an eq_onp of the corresponding predicate *)
fun get_relator_eq_onp_rules ctxt =
- map safe_mk_meta_eq (rev (Named_Theorems.get ctxt @{named_theorems relator_eq_onp}))
+ map safe_mk_meta_eq (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>relator_eq_onp\<close>))
(* info about reflexivity rules *)
@@ -315,7 +315,7 @@
fun introduce_polarities rule =
let
- val dest_less_eq = HOLogic.dest_bin @{const_name "less_eq"} dummyT
+ val dest_less_eq = HOLogic.dest_bin \<^const_name>\<open>less_eq\<close> dummyT
val prems_pairs = map (dest_less_eq o HOLogic.dest_Trueprop) (Thm.prems_of rule)
val equal_prems = filter op= prems_pairs
val _ =
@@ -462,11 +462,11 @@
val concl = (perhaps (try HOLogic.dest_Trueprop)) (Thm.concl_of rule);
val (lhs, rhs) =
(case concl of
- Const (@{const_name less_eq}, _) $ (lhs as Const (@{const_name relcompp},_) $ _ $ _) $ rhs =>
+ Const (\<^const_name>\<open>less_eq\<close>, _) $ (lhs as Const (\<^const_name>\<open>relcompp\<close>,_) $ _ $ _) $ rhs =>
(lhs, rhs)
- | Const (@{const_name less_eq}, _) $ rhs $ (lhs as Const (@{const_name relcompp},_) $ _ $ _) =>
+ | Const (\<^const_name>\<open>less_eq\<close>, _) $ rhs $ (lhs as Const (\<^const_name>\<open>relcompp\<close>,_) $ _ $ _) =>
(lhs, rhs)
- | Const (@{const_name HOL.eq}, _) $ (lhs as Const (@{const_name relcompp},_) $ _ $ _) $ rhs =>
+ | Const (\<^const_name>\<open>HOL.eq\<close>, _) $ (lhs as Const (\<^const_name>\<open>relcompp\<close>,_) $ _ $ _) $ rhs =>
(lhs, rhs)
| _ => error "The rule has a wrong format.")
@@ -485,7 +485,7 @@
val rhs_args = (snd o strip_comb) rhs;
fun check_comp t =
(case t of
- Const (@{const_name relcompp}, _) $ Var _ $ Var _ => ()
+ Const (\<^const_name>\<open>relcompp\<close>, _) $ Var _ $ Var _ => ()
| _ => error "There is an argument on the rhs that is not a composition.")
val _ = map check_comp rhs_args
in () end
@@ -497,11 +497,11 @@
val concl = (perhaps (try HOLogic.dest_Trueprop)) (Thm.concl_of distr_rule)
in
(case concl of
- Const (@{const_name less_eq}, _) $ (Const (@{const_name relcompp},_) $ _ $ _) $ _ =>
+ Const (\<^const_name>\<open>less_eq\<close>, _) $ (Const (\<^const_name>\<open>relcompp\<close>,_) $ _ $ _) $ _ =>
add_pos_distr_rule distr_rule context
- | Const (@{const_name less_eq}, _) $ _ $ (Const (@{const_name relcompp},_) $ _ $ _) =>
+ | Const (\<^const_name>\<open>less_eq\<close>, _) $ _ $ (Const (\<^const_name>\<open>relcompp\<close>,_) $ _ $ _) =>
add_neg_distr_rule distr_rule context
- | Const (@{const_name HOL.eq}, _) $ (Const (@{const_name relcompp},_) $ _ $ _) $ _ =>
+ | Const (\<^const_name>\<open>HOL.eq\<close>, _) $ (Const (\<^const_name>\<open>relcompp\<close>,_) $ _ $ _) $ _ =>
add_eq_distr_rule distr_rule context)
end
end
@@ -518,14 +518,14 @@
val _ =
Theory.setup
- (Attrib.setup @{binding relator_mono} (Scan.succeed (Thm.declaration_attribute add_mono_rule))
+ (Attrib.setup \<^binding>\<open>relator_mono\<close> (Scan.succeed (Thm.declaration_attribute add_mono_rule))
"declaration of relator's monotonicity"
- #> Attrib.setup @{binding relator_distr} (Scan.succeed (Thm.declaration_attribute add_distr_rule))
+ #> Attrib.setup \<^binding>\<open>relator_distr\<close> (Scan.succeed (Thm.declaration_attribute add_distr_rule))
"declaration of relator's distributivity over OO"
#> Global_Theory.add_thms_dynamic
- (@{binding relator_distr_raw}, get_distr_rules_raw)
+ (\<^binding>\<open>relator_distr_raw\<close>, get_distr_rules_raw)
#> Global_Theory.add_thms_dynamic
- (@{binding relator_mono_raw}, get_mono_rules_raw))
+ (\<^binding>\<open>relator_mono_raw\<close>, get_mono_rules_raw))
(* no_code types *)
@@ -539,8 +539,8 @@
(* setup fixed eq_onp rules *)
val _ = Context.>>
- (fold (Named_Theorems.add_thm @{named_theorems relator_eq_onp} o
- Transfer.prep_transfer_domain_thm @{context})
+ (fold (Named_Theorems.add_thm \<^named_theorems>\<open>relator_eq_onp\<close> o
+ Transfer.prep_transfer_domain_thm \<^context>)
@{thms composed_equiv_rel_eq_onp composed_equiv_rel_eq_eq_onp})
@@ -554,11 +554,11 @@
(* outer syntax commands *)
val _ =
- Outer_Syntax.command @{command_keyword print_quot_maps} "print quotient map functions"
+ Outer_Syntax.command \<^command_keyword>\<open>print_quot_maps\<close> "print quotient map functions"
(Scan.succeed (Toplevel.keep (print_quot_maps o Toplevel.context_of)))
val _ =
- Outer_Syntax.command @{command_keyword print_quotients} "print quotients"
+ Outer_Syntax.command \<^command_keyword>\<open>print_quotients\<close> "print quotients"
(Scan.succeed (Toplevel.keep (print_quotients o Toplevel.context_of)))
end
--- a/src/HOL/Tools/Lifting/lifting_setup.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Lifting/lifting_setup.ML Fri Jan 04 23:22:53 2019 +0100
@@ -81,7 +81,7 @@
val args_fixed = (map (Term_Subst.instantiate (instT, []))) args_subst
val param_rel_fixed = Term_Subst.instantiate (instT, []) param_rel_subst
val rty = (domain_type o fastype_of) param_rel_fixed
- val relcomp_op = Const (@{const_name "relcompp"},
+ val relcomp_op = Const (\<^const_name>\<open>relcompp\<close>,
(rty --> rty' --> HOLogic.boolT) -->
(rty' --> qty --> HOLogic.boolT) -->
rty --> qty --> HOLogic.boolT)
@@ -117,7 +117,7 @@
fun print_generate_pcr_cr_eq_error ctxt term =
let
- val goal = Const (@{const_name HOL.eq}, dummyT) $ term $ Const (@{const_name HOL.eq}, dummyT)
+ val goal = Const (\<^const_name>\<open>HOL.eq\<close>, dummyT) $ term $ Const (\<^const_name>\<open>HOL.eq\<close>, dummyT)
val error_msg = cat_lines
["Generation of a pcr_cr_eq failed.",
(Pretty.string_of (Pretty.block
@@ -152,7 +152,7 @@
(Transfer.bottom_rewr_conv (Transfer.get_relator_eq lthy))))
in
case (Thm.term_of o Thm.rhs_of) pcr_cr_eq of
- Const (@{const_name "relcompp"}, _) $ Const (@{const_name HOL.eq}, _) $ _ =>
+ Const (\<^const_name>\<open>relcompp\<close>, _) $ Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ =>
let
val thm =
pcr_cr_eq
@@ -164,7 +164,7 @@
in
(thm, lthy)
end
- | Const (@{const_name "relcompp"}, _) $ t $ _ => print_generate_pcr_cr_eq_error lthy t
+ | Const (\<^const_name>\<open>relcompp\<close>, _) $ t $ _ => print_generate_pcr_cr_eq_error lthy t
| _ => error "generate_pcr_cr_eq: implementation error"
end
end
@@ -644,9 +644,9 @@
val T_def = Morphism.thm (Local_Theory.target_morphism lthy) T_def
(**)
val quot_thm = case typedef_set of
- Const (@{const_name top}, _) =>
+ Const (\<^const_name>\<open>top\<close>, _) =>
[typedef_thm, T_def] MRSL @{thm UNIV_typedef_to_Quotient}
- | Const (@{const_name "Collect"}, _) $ Abs (_, _, _) =>
+ | Const (\<^const_name>\<open>Collect\<close>, _) $ Abs (_, _, _) =>
[typedef_thm, T_def] MRSL @{thm open_typedef_to_Quotient}
| _ =>
[typedef_thm, T_def] MRSL @{thm typedef_to_Quotient}
@@ -656,7 +656,7 @@
val qualify = Binding.qualify_name true qty_name
val opt_reflp_thm =
case typedef_set of
- Const (@{const_name top}, _) =>
+ Const (\<^const_name>\<open>top\<close>, _) =>
SOME ((typedef_thm RS @{thm UNIV_typedef_to_equivp}) RS @{thm equivp_reflp2})
| _ => NONE
val dom_thm = get_Domainp_thm quot_thm
@@ -758,7 +758,7 @@
handle TERM _ => error "Invalid form of the reflexivity theorem. Use \"reflp R\"."
in
case reflp_tm of
- Const (@{const_name reflp}, _) $ _ => ()
+ Const (\<^const_name>\<open>reflp\<close>, _) $ _ => ()
| _ => error "Invalid form of the reflexivity theorem. Use \"reflp R\"."
end
@@ -791,16 +791,16 @@
end
in
case input_term of
- (Const (@{const_name Quotient}, _) $ _ $ _ $ _ $ _) => setup_quotient ()
- | (Const (@{const_name type_definition}, _) $ _ $ _ $ _) => setup_typedef ()
+ (Const (\<^const_name>\<open>Quotient\<close>, _) $ _ $ _ $ _ $ _) => setup_quotient ()
+ | (Const (\<^const_name>\<open>type_definition\<close>, _) $ _ $ _ $ _) => setup_typedef ()
| _ => error "Unsupported type of a theorem. Only Quotient or type_definition are supported."
end
val _ =
- Outer_Syntax.local_theory @{command_keyword setup_lifting}
+ Outer_Syntax.local_theory \<^command_keyword>\<open>setup_lifting\<close>
"setup lifting infrastructure"
(Parse.thm -- Scan.option Parse.thm
- -- Scan.option (@{keyword "parametric"} |-- Parse.!!! Parse.thm) >>
+ -- Scan.option (\<^keyword>\<open>parametric\<close> |-- Parse.!!! Parse.thm) >>
(fn ((xthm, opt_reflp_xthm), opt_par_xthm) =>
setup_lifting_cmd xthm opt_reflp_xthm opt_par_xthm))
@@ -832,7 +832,7 @@
Pretty.brk 1,
Thm.pretty_thm ctxt pcr_cr_eq]]
val (pcr_const_eq, eqs) = strip_comb eq_lhs
- fun is_eq (Const (@{const_name HOL.eq}, _)) = true
+ fun is_eq (Const (\<^const_name>\<open>HOL.eq\<close>, _)) = true
| is_eq _ = false
fun eq_Const (Const (name1, _)) (Const (name2, _)) = (name1 = name2)
| eq_Const _ _ = false
@@ -900,7 +900,7 @@
(fn (pcrel_def, pcr_cr_eq) => SOME {pcrel_def = pcrel_def, pcr_cr_eq = pcr_cr_eq})) NONE
val lifting_restore_attribute_setup =
- Attrib.setup @{binding lifting_restore}
+ Attrib.setup \<^binding>\<open>lifting_restore\<close>
((Attrib.thm -- parse_opt_pcr) >>
(fn (quot_thm, opt_pcr) =>
let val qinfo = { quot_thm = quot_thm, pcr_info = opt_pcr}
@@ -922,7 +922,7 @@
end
val lifting_restore_internal_attribute_setup =
- Attrib.setup @{binding lifting_restore_internal}
+ Attrib.setup \<^binding>\<open>lifting_restore_internal\<close>
(Scan.lift Parse.string >>
(fn name => Thm.declaration_attribute (K (lifting_restore_internal name))))
"restoring lifting infrastructure; internal attribute; not meant to be used directly by regular users"
@@ -931,15 +931,15 @@
(* lifting_forget *)
-val monotonicity_names = [@{const_name right_unique}, @{const_name left_unique}, @{const_name right_total},
- @{const_name left_total}, @{const_name bi_unique}, @{const_name bi_total}]
+val monotonicity_names = [\<^const_name>\<open>right_unique\<close>, \<^const_name>\<open>left_unique\<close>, \<^const_name>\<open>right_total\<close>,
+ \<^const_name>\<open>left_total\<close>, \<^const_name>\<open>bi_unique\<close>, \<^const_name>\<open>bi_total\<close>]
-fun fold_transfer_rel f (Const (@{const_name "Transfer.Rel"}, _) $ rel $ _ $ _) = f rel
- | fold_transfer_rel f (Const (@{const_name "HOL.eq"}, _) $
- (Const (@{const_name Domainp}, _) $ rel) $ _) = f rel
+fun fold_transfer_rel f (Const (\<^const_name>\<open>Transfer.Rel\<close>, _) $ rel $ _ $ _) = f rel
+ | fold_transfer_rel f (Const (\<^const_name>\<open>HOL.eq\<close>, _) $
+ (Const (\<^const_name>\<open>Domainp\<close>, _) $ rel) $ _) = f rel
| fold_transfer_rel f (Const (name, _) $ rel) =
- if member op= monotonicity_names name then f rel else f @{term undefined}
- | fold_transfer_rel f _ = f @{term undefined}
+ if member op= monotonicity_names name then f rel else f \<^term>\<open>undefined\<close>
+ | fold_transfer_rel f _ = f \<^term>\<open>undefined\<close>
fun filter_transfer_rules_by_rel transfer_rel transfer_rules =
let
@@ -1012,7 +1012,7 @@
val _ =
- Outer_Syntax.local_theory @{command_keyword lifting_forget}
+ Outer_Syntax.local_theory \<^command_keyword>\<open>lifting_forget\<close>
"unsetup Lifting and Transfer for the given lifting bundle"
(Parse.name_position >> lifting_forget_cmd)
@@ -1041,7 +1041,7 @@
update_transfer_rules (pointer_of_bundle_name bundle_name lthy) lthy
val _ =
- Outer_Syntax.local_theory @{command_keyword lifting_update}
+ Outer_Syntax.local_theory \<^command_keyword>\<open>lifting_update\<close>
"add newly introduced transfer rules to a bundle storing the state of Lifting and Transfer"
(Parse.name_position >> lifting_update_cmd)
--- a/src/HOL/Tools/Lifting/lifting_term.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Lifting/lifting_term.ML Fri Jan 04 23:22:53 2019 +0100
@@ -131,8 +131,8 @@
(case Lifting_Info.lookup_relator_distr_data ctxt s of
SOME rel_distr_thm => (
case tm of
- Const (@{const_name POS}, _) => map (Thm.transfer thy) (#pos_distr_rules rel_distr_thm)
- | Const (@{const_name NEG}, _) => map (Thm.transfer thy) (#neg_distr_rules rel_distr_thm)
+ Const (\<^const_name>\<open>POS\<close>, _) => map (Thm.transfer thy) (#pos_distr_rules rel_distr_thm)
+ | Const (\<^const_name>\<open>NEG\<close>, _) => map (Thm.transfer thy) (#neg_distr_rules rel_distr_thm)
)
| NONE => raise QUOT_THM_INTERNAL (Pretty.block
[Pretty.str ("No relator distr. data for the type " ^ quote s),
@@ -365,7 +365,7 @@
val get_fresh_Q_t =
let
- val Q_t = @{term "Trueprop (Quotient R Abs Rep T)"}
+ val Q_t = \<^term>\<open>Trueprop (Quotient R Abs Rep T)\<close>
val frees_Q_t = Term.add_free_names Q_t []
val tfrees_Q_t = rev (Term.add_tfree_names Q_t [])
in
@@ -503,8 +503,8 @@
fun is_POS_or_NEG ctm =
case (head_of o Thm.term_of o Thm.dest_arg) ctm of
- Const (@{const_name POS}, _) => true
- | Const (@{const_name NEG}, _) => true
+ Const (\<^const_name>\<open>POS\<close>, _) => true
+ | Const (\<^const_name>\<open>NEG\<close>, _) => true
| _ => false
val inst_distr_rule = rewr_imp distr_rule ctm
@@ -522,8 +522,8 @@
in
case get_args 2 rel of
- [Const (@{const_name "HOL.eq"}, _), _] => rewrs_imp @{thms neg_eq_OO pos_eq_OO} ctm
- | [_, Const (@{const_name "HOL.eq"}, _)] => rewrs_imp @{thms neg_OO_eq pos_OO_eq} ctm
+ [Const (\<^const_name>\<open>HOL.eq\<close>, _), _] => rewrs_imp @{thms neg_eq_OO pos_eq_OO} ctm
+ | [_, Const (\<^const_name>\<open>HOL.eq\<close>, _)] => rewrs_imp @{thms neg_OO_eq pos_OO_eq} ctm
| [_, trans_rel] =>
let
val (rty', qty) = (relation_types o fastype_of) trans_rel
--- a/src/HOL/Tools/Lifting/lifting_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Lifting/lifting_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -44,7 +44,7 @@
fun option_fold a _ NONE = a
| option_fold _ f (SOME x) = f x
-fun dest_Quotient (Const (@{const_name Quotient}, _) $ rel $ abs $ rep $ cr)
+fun dest_Quotient (Const (\<^const_name>\<open>Quotient\<close>, _) $ rel $ abs $ rep $ cr)
= (rel, abs, rep, cr)
| dest_Quotient t = raise TERM ("dest_Quotient", [t])
@@ -91,7 +91,7 @@
fun undisch_all thm = funpow (Thm.nprems_of thm) undisch thm
-fun is_fun_type (Type (@{type_name fun}, _)) = true
+fun is_fun_type (Type (\<^type_name>\<open>fun\<close>, _)) = true
| is_fun_type _ = false
fun get_args n = rev o fst o funpow_yield n (swap o dest_comb)
@@ -109,12 +109,12 @@
fun Tname (Type (name, _)) = name
| Tname _ = ""
-fun is_rel_fun (Const (@{const_name "rel_fun"}, _) $ _ $ _) = true
+fun is_rel_fun (Const (\<^const_name>\<open>rel_fun\<close>, _) $ _ $ _) = true
| is_rel_fun _ = false
fun relation_types typ =
case strip_type typ of
- ([typ1, typ2], @{typ bool}) => (typ1, typ2)
+ ([typ1, typ2], \<^typ>\<open>bool\<close>) => (typ1, typ2)
| _ => error "relation_types: not a relation"
fun map_interrupt f l =
--- a/src/HOL/Tools/Meson/meson.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Meson/meson.ML Fri Jan 04 23:22:53 2019 +0100
@@ -535,7 +535,7 @@
(* FIXME: "let_simp" is probably redundant now that we also rewrite with
"Let_def [abs_def]". *)
val nnf_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps nnf_extra_simps
addsimprocs [\<^simproc>\<open>defined_All\<close>, \<^simproc>\<open>defined_Ex\<close>, \<^simproc>\<open>neq\<close>, \<^simproc>\<open>let_simp\<close>])
--- a/src/HOL/Tools/Meson/meson_clausify.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Meson/meson_clausify.ML Fri Jan 04 23:22:53 2019 +0100
@@ -176,7 +176,7 @@
TrueI)
(*cterms are used throughout for efficiency*)
-val cTrueprop = Thm.cterm_of @{theory_context HOL} HOLogic.Trueprop;
+val cTrueprop = Thm.cterm_of \<^theory_context>\<open>HOL\<close> HOLogic.Trueprop;
(*Given an abstraction over n variables, replace the bound variables by free
ones. Return the body, along with the list of free variables.*)
@@ -294,7 +294,7 @@
val cheat_choice =
\<^prop>\<open>\<forall>x. \<exists>y. Q x y \<Longrightarrow> \<exists>f. \<forall>x. Q x (f x)\<close>
|> Logic.varify_global
- |> Skip_Proof.make_thm @{theory}
+ |> Skip_Proof.make_thm \<^theory>
(* Converts an Isabelle theorem into NNF. *)
fun nnf_axiom choice_ths new_skolem ax_no th ctxt =
--- a/src/HOL/Tools/Metis/metis_generate.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Metis/metis_generate.ML Fri Jan 04 23:22:53 2019 +0100
@@ -48,8 +48,8 @@
val metis_ad_hoc_type_tag = "**"
val metis_generated_var_prefix = "_"
-val trace = Attrib.setup_config_bool @{binding metis_trace} (K false)
-val verbose = Attrib.setup_config_bool @{binding metis_verbose} (K true)
+val trace = Attrib.setup_config_bool \<^binding>\<open>metis_trace\<close> (K false)
+val verbose = Attrib.setup_config_bool \<^binding>\<open>metis_verbose\<close> (K true)
fun trace_msg ctxt msg = if Config.get ctxt trace then tracing (msg ()) else ()
fun verbose_warning ctxt msg =
@@ -69,14 +69,14 @@
Long_Name.implode (old_skolem_const_prefix :: map string_of_int [i, j, num_T_args])
fun conceal_old_skolem_terms i old_skolems t =
- if exists_Const (curry (op =) @{const_name Meson.skolem} o fst) t then
+ if exists_Const (curry (op =) \<^const_name>\<open>Meson.skolem\<close> o fst) t then
let
fun aux old_skolems
- (t as (Const (@{const_name Meson.skolem}, Type (_, [_, T])) $ _)) =
+ (t as (Const (\<^const_name>\<open>Meson.skolem\<close>, Type (_, [_, T])) $ _)) =
let
val (old_skolems, s) =
if i = ~1 then
- (old_skolems, @{const_name undefined})
+ (old_skolems, \<^const_name>\<open>undefined\<close>)
else
(case AList.find (op aconv) old_skolems t of
s :: _ => (old_skolems, s)
@@ -114,7 +114,7 @@
if String.isPrefix lam_lifted_prefix s then
(case AList.lookup (op =) lifted s of
SOME t =>
- Const (@{const_name Metis.lambda}, dummyT)
+ Const (\<^const_name>\<open>Metis.lambda\<close>, dummyT)
$ map_types (map_type_tvar (K dummyT)) (reveal_lam_lifted lifted t)
| NONE => t)
else
@@ -190,7 +190,7 @@
end
| metis_axiom_of_atp _ _ _ _ = raise Fail "not CNF -- expected formula"
-fun eliminate_lam_wrappers (Const (@{const_name Metis.lambda}, _) $ t) = eliminate_lam_wrappers t
+fun eliminate_lam_wrappers (Const (\<^const_name>\<open>Metis.lambda\<close>, _) $ t) = eliminate_lam_wrappers t
| eliminate_lam_wrappers (t $ u) = eliminate_lam_wrappers t $ eliminate_lam_wrappers u
| eliminate_lam_wrappers (Abs (s, T, t)) = Abs (s, T, eliminate_lam_wrappers t)
| eliminate_lam_wrappers t = t
@@ -228,7 +228,7 @@
val lam_trans = if lam_trans = combsN then no_lamsN else lam_trans
val (atp_problem, _, lifted, sym_tab) =
generate_atp_problem ctxt true CNF Hypothesis type_enc Metis lam_trans false false false []
- @{prop False} props
+ \<^prop>\<open>False\<close> props
(*
val _ = tracing ("ATP PROBLEM: " ^
cat_lines (lines_of_atp_problem CNF atp_problem))
--- a/src/HOL/Tools/Metis/metis_reconstruct.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Metis/metis_reconstruct.ML Fri Jan 04 23:22:53 2019 +0100
@@ -256,7 +256,7 @@
don't use this trick in general because it makes the proof object uglier than
necessary. FIXME. *)
fun negate_head ctxt th =
- if exists (fn t => t aconv @{prop "\<not> False"}) (Thm.prems_of th) then
+ if exists (fn t => t aconv \<^prop>\<open>\<not> False\<close>) (Thm.prems_of th) then
(th RS @{thm select_FalseI})
|> fold (rewrite_rule ctxt o single) @{thms not_atomize_select atomize_not_select}
else
@@ -300,7 +300,7 @@
val REFL_THM = Thm.incr_indexes 2 @{lemma "t \<noteq> t \<Longrightarrow> False" by simp}
-val refl_x = Thm.cterm_of @{context} (Var (hd (Term.add_vars (Thm.prop_of REFL_THM) [])));
+val refl_x = Thm.cterm_of \<^context> (Var (hd (Term.add_vars (Thm.prop_of REFL_THM) [])));
val refl_idx = 1 + Thm.maxidx_of REFL_THM;
fun refl_inference ctxt type_enc concealed sym_tab t =
@@ -412,7 +412,7 @@
fun is_metis_literal_genuine (_, (s, _)) =
not (String.isPrefix class_prefix (Metis_Name.toString s))
fun is_isabelle_literal_genuine t =
- (case t of _ $ (Const (@{const_name Meson.skolem}, _) $ _) => false | _ => true)
+ (case t of _ $ (Const (\<^const_name>\<open>Meson.skolem\<close>, _) $ _) => false | _ => true)
fun count p xs = fold (fn x => if p x then Integer.add 1 else I) xs 0
@@ -449,7 +449,7 @@
fun replay_one_inference ctxt type_enc concealed sym_tab (fol_th, inf)
th_pairs =
- if not (null th_pairs) andalso Thm.prop_of (snd (hd th_pairs)) aconv @{prop False} then
+ if not (null th_pairs) andalso Thm.prop_of (snd (hd th_pairs)) aconv \<^prop>\<open>False\<close> then
(* Isabelle sometimes identifies literals (premises) that are distinct in
Metis (e.g., because of type variables). We give the Isabelle proof the
benefice of the doubt. *)
@@ -633,7 +633,7 @@
specified axioms. The axioms have leading "All" and "Ex" quantifiers, which
must be eliminated first. *)
fun discharge_skolem_premises ctxt axioms prems_imp_false =
- if Thm.prop_of prems_imp_false aconv @{prop False} then
+ if Thm.prop_of prems_imp_false aconv \<^prop>\<open>False\<close> then
prems_imp_false
else
let
@@ -655,7 +655,7 @@
fun subst_info_of_prem subgoal_no prem =
(case prem of
- _ $ (Const (@{const_name Meson.skolem}, _) $ (_ $ t $ num)) =>
+ _ $ (Const (\<^const_name>\<open>Meson.skolem\<close>, _) $ (_ $ t $ num)) =>
let val ax_no = HOLogic.dest_nat num in
(ax_no, (subgoal_no,
match_term (nth axioms ax_no |> the |> snd, t)))
@@ -734,7 +734,7 @@
fun rotation_of_subgoal i =
find_index (fn (_, (subgoal_no, _)) => subgoal_no = i) substs
in
- Goal.prove ctxt' [] [] @{prop False}
+ Goal.prove ctxt' [] [] \<^prop>\<open>False\<close>
(K (DETERM (EVERY (map (cut_and_ex_tac o fst o the o nth axioms o fst o fst) ax_counts)
THEN rename_tac outer_param_names 1
THEN copy_prems_tac ctxt' (map snd ax_counts) [] 1)
--- a/src/HOL/Tools/Metis/metis_tactic.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Metis/metis_tactic.ML Fri Jan 04 23:22:53 2019 +0100
@@ -30,8 +30,8 @@
open Metis_Generate
open Metis_Reconstruct
-val new_skolem = Attrib.setup_config_bool @{binding metis_new_skolem} (K false)
-val advisory_simp = Attrib.setup_config_bool @{binding metis_advisory_simp} (K true)
+val new_skolem = Attrib.setup_config_bool \<^binding>\<open>metis_new_skolem\<close> (K false)
+val advisory_simp = Attrib.setup_config_bool \<^binding>\<open>metis_advisory_simp\<close> (K true)
(* Designed to work also with monomorphic instances of polymorphic theorems. *)
fun have_common_thm ctxt ths1 ths2 =
@@ -48,12 +48,12 @@
"t => t". Type tag idempotence is also handled this way. *)
fun reflexive_or_trivial_of_metis ctxt type_enc sym_tab concealed mth =
(case hol_clause_of_metis ctxt type_enc sym_tab concealed mth of
- Const (@{const_name HOL.eq}, _) $ _ $ t =>
+ Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ t =>
let
val ct = Thm.cterm_of ctxt t
val cT = Thm.ctyp_of_cterm ct
in refl |> Thm.instantiate' [SOME cT] [SOME ct] end
- | Const (@{const_name disj}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>disj\<close>, _) $ t1 $ t2 =>
(if can HOLogic.dest_not t1 then t2 else t1)
|> HOLogic.mk_Trueprop |> Thm.cterm_of ctxt |> Thm.trivial
| _ => raise Fail "expected reflexive or trivial clause")
@@ -94,7 +94,7 @@
|> Conv.comb_conv (conv true ctxt))
else
Conv.abs_conv (conv false o snd) ctxt ct
- | Const (@{const_name Meson.skolem}, _) $ _ => Thm.reflexive ct
+ | Const (\<^const_name>\<open>Meson.skolem\<close>, _) $ _ => Thm.reflexive ct
| _ => Conv.comb_conv (conv true ctxt) ct)
val eq_th = conv true ctxt (Thm.cprop_of th)
(* We replace the equation's left-hand side with a beta-equivalent term
@@ -188,7 +188,7 @@
("Falling back on " ^ quote (metis_call (hd fallback_type_encs) lam_trans) ^ "...");
FOL_SOLVE unused fallback_type_encs lam_trans ctxt cls ths0)
in
- (case filter (fn t => Thm.prop_of t aconv @{prop False}) cls of
+ (case filter (fn t => Thm.prop_of t aconv \<^prop>\<open>False\<close>) cls of
false_th :: _ => [false_th RS @{thm FalseE}]
| [] =>
(case Metis_Resolution.loop (Metis_Resolution.new (resolution_params ordering)
@@ -288,7 +288,7 @@
val parse_metis_options =
Scan.optional
- (Args.parens (Args.name -- Scan.option (@{keyword ","} |-- Args.name))
+ (Args.parens (Args.name -- Scan.option (\<^keyword>\<open>,\<close> |-- Args.name))
>> (fn (s, s') =>
(NONE, NONE) |> consider_opt s
|> (case s' of SOME s' => consider_opt s' | _ => I)))
@@ -296,7 +296,7 @@
val _ =
Theory.setup
- (Method.setup @{binding metis}
+ (Method.setup \<^binding>\<open>metis\<close>
(Scan.lift parse_metis_options -- Attrib.thms >> (METHOD oo metis_method))
"Metis for FOL and HOL problems")
--- a/src/HOL/Tools/Nitpick/nitpick.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick.ML Fri Jan 04 23:22:53 2019 +0100
@@ -197,8 +197,8 @@
| has_lonely_bool_var _ = false
val syntactic_sorts =
- @{sort "{default,zero,one,plus,minus,uminus,times,inverse,abs,sgn,ord,equal}"} @
- @{sort numeral}
+ \<^sort>\<open>{default,zero,one,plus,minus,uminus,times,inverse,abs,sgn,ord,equal}\<close> @
+ \<^sort>\<open>numeral\<close>
fun has_tfree_syntactic_sort (TFree (_, S as _ :: _)) =
subset (op =) (S, syntactic_sorts)
@@ -267,10 +267,10 @@
"subgoal " ^ string_of_int i ^ " of " ^ string_of_int n
else
"goal")) [Logic.list_implies (nondef_assm_ts, orig_t)]))
- val _ = spying spy (fn () => (state, i, "starting " ^ @{make_string} mode ^ " mode"))
+ val _ = spying spy (fn () => (state, i, "starting " ^ \<^make_string> mode ^ " mode"))
val _ = print_v (prefix "Timestamp: " o Date.fmt "%H:%M:%S"
o Date.fromTimeLocal o Time.now)
- val neg_t = if falsify then Logic.mk_implies (orig_t, @{prop False})
+ val neg_t = if falsify then Logic.mk_implies (orig_t, \<^prop>\<open>False\<close>)
else orig_t
val conj_ts = neg_t :: def_assm_ts @ nondef_assm_ts @ evals @ these needs
val tfree_table =
@@ -392,14 +392,14 @@
is_type_actually_monotonic T
fun is_deep_data_type_finitizable T =
triple_lookup (type_match thy) finitizes T = SOME (SOME true)
- fun is_shallow_data_type_finitizable (T as Type (@{type_name fun_box}, _)) =
+ fun is_shallow_data_type_finitizable (T as Type (\<^type_name>\<open>fun_box\<close>, _)) =
is_type_kind_of_monotonic T
| is_shallow_data_type_finitizable T =
case triple_lookup (type_match thy) finitizes T of
SOME (SOME b) => b
| _ => is_type_kind_of_monotonic T
fun is_data_type_deep T =
- T = @{typ unit} orelse T = nat_T orelse is_word_type T orelse
+ T = \<^typ>\<open>unit\<close> orelse T = nat_T orelse is_word_type T orelse
exists (curry (op =) T o domain_type o type_of) sel_names
val all_Ts = ground_types_in_terms hol_ctxt binarize (nondef_ts @ def_ts)
|> sort Term_Ord.typ_ord
@@ -1008,7 +1008,7 @@
end
fun is_fixed_equation ctxt
- (Const (@{const_name Pure.eq}, _) $ Free (s, _) $ Const _) =
+ (Const (\<^const_name>\<open>Pure.eq\<close>, _) $ Free (s, _) $ Const _) =
Variable.is_fixed ctxt s
| is_fixed_equation _ _ = false
--- a/src/HOL/Tools/Nitpick/nitpick_commands.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_commands.ML Fri Jan 04 23:22:53 2019 +0100
@@ -297,10 +297,10 @@
Scan.repeats1 (Parse.minus >> single
|| Scan.repeat1 (Scan.unless Parse.minus
(Parse.name || Parse.float_number))
- || @{keyword ","} |-- Parse.number >> prefix "," >> single)
-val parse_param = parse_key -- Scan.optional (@{keyword "="} |-- parse_value) []
+ || \<^keyword>\<open>,\<close> |-- Parse.number >> prefix "," >> single)
+val parse_param = parse_key -- Scan.optional (\<^keyword>\<open>=\<close> |-- parse_value) []
val parse_params =
- Scan.optional (@{keyword "["} |-- Parse.list parse_param --| @{keyword "]"}) []
+ Scan.optional (\<^keyword>\<open>[\<close> |-- Parse.list parse_param --| \<^keyword>\<open>]\<close>) []
fun handle_exceptions ctxt f x =
f x
@@ -363,7 +363,7 @@
|> sort_strings |> cat_lines)))))
val _ =
- Outer_Syntax.command @{command_keyword nitpick}
+ Outer_Syntax.command \<^command_keyword>\<open>nitpick\<close>
"try to find a counterexample for a given subgoal using Nitpick"
(parse_params -- Scan.optional Parse.nat 1 >> (fn (params, i) =>
Toplevel.keep_proof (fn state =>
@@ -371,12 +371,12 @@
(Toplevel.proof_of state)))))
val _ =
- Outer_Syntax.command @{command_keyword nitpick_params}
+ Outer_Syntax.command \<^command_keyword>\<open>nitpick_params\<close>
"set and display the default parameters for Nitpick"
(parse_params #>> nitpick_params_trans)
fun try_nitpick auto = pick_nits [] (if auto then Auto_Try else Try) 1 0
-val _ = Try.tool_setup (nitpickN, (50, @{system_option auto_nitpick}, try_nitpick))
+val _ = Try.tool_setup (nitpickN, (50, \<^system_option>\<open>auto_nitpick\<close>, try_nitpick))
end;
--- a/src/HOL/Tools/Nitpick/nitpick_hol.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_hol.ML Fri Jan 04 23:22:53 2019 +0100
@@ -360,78 +360,78 @@
"Nitpick_Nut.nut_from_term", and perhaps in "Nitpick_Mono.consider_term" as
well. *)
val built_in_consts =
- [(@{const_name Pure.all}, 1),
- (@{const_name Pure.eq}, 2),
- (@{const_name Pure.imp}, 2),
- (@{const_name Pure.conjunction}, 2),
- (@{const_name Trueprop}, 1),
- (@{const_name Not}, 1),
- (@{const_name False}, 0),
- (@{const_name True}, 0),
- (@{const_name All}, 1),
- (@{const_name Ex}, 1),
- (@{const_name HOL.eq}, 1),
- (@{const_name HOL.conj}, 2),
- (@{const_name HOL.disj}, 2),
- (@{const_name HOL.implies}, 2),
- (@{const_name If}, 3),
- (@{const_name Let}, 2),
- (@{const_name Pair}, 2),
- (@{const_name fst}, 1),
- (@{const_name snd}, 1),
- (@{const_name Set.member}, 2),
- (@{const_name Collect}, 1),
- (@{const_name Id}, 0),
- (@{const_name converse}, 1),
- (@{const_name trancl}, 1),
- (@{const_name relcomp}, 2),
- (@{const_name finite}, 1),
- (@{const_name unknown}, 0),
- (@{const_name is_unknown}, 1),
- (@{const_name safe_The}, 1),
- (@{const_name Frac}, 0),
- (@{const_name norm_frac}, 0),
- (@{const_name Suc}, 0),
- (@{const_name nat}, 0),
- (@{const_name nat_gcd}, 0),
- (@{const_name nat_lcm}, 0)]
+ [(\<^const_name>\<open>Pure.all\<close>, 1),
+ (\<^const_name>\<open>Pure.eq\<close>, 2),
+ (\<^const_name>\<open>Pure.imp\<close>, 2),
+ (\<^const_name>\<open>Pure.conjunction\<close>, 2),
+ (\<^const_name>\<open>Trueprop\<close>, 1),
+ (\<^const_name>\<open>Not\<close>, 1),
+ (\<^const_name>\<open>False\<close>, 0),
+ (\<^const_name>\<open>True\<close>, 0),
+ (\<^const_name>\<open>All\<close>, 1),
+ (\<^const_name>\<open>Ex\<close>, 1),
+ (\<^const_name>\<open>HOL.eq\<close>, 1),
+ (\<^const_name>\<open>HOL.conj\<close>, 2),
+ (\<^const_name>\<open>HOL.disj\<close>, 2),
+ (\<^const_name>\<open>HOL.implies\<close>, 2),
+ (\<^const_name>\<open>If\<close>, 3),
+ (\<^const_name>\<open>Let\<close>, 2),
+ (\<^const_name>\<open>Pair\<close>, 2),
+ (\<^const_name>\<open>fst\<close>, 1),
+ (\<^const_name>\<open>snd\<close>, 1),
+ (\<^const_name>\<open>Set.member\<close>, 2),
+ (\<^const_name>\<open>Collect\<close>, 1),
+ (\<^const_name>\<open>Id\<close>, 0),
+ (\<^const_name>\<open>converse\<close>, 1),
+ (\<^const_name>\<open>trancl\<close>, 1),
+ (\<^const_name>\<open>relcomp\<close>, 2),
+ (\<^const_name>\<open>finite\<close>, 1),
+ (\<^const_name>\<open>unknown\<close>, 0),
+ (\<^const_name>\<open>is_unknown\<close>, 1),
+ (\<^const_name>\<open>safe_The\<close>, 1),
+ (\<^const_name>\<open>Frac\<close>, 0),
+ (\<^const_name>\<open>norm_frac\<close>, 0),
+ (\<^const_name>\<open>Suc\<close>, 0),
+ (\<^const_name>\<open>nat\<close>, 0),
+ (\<^const_name>\<open>nat_gcd\<close>, 0),
+ (\<^const_name>\<open>nat_lcm\<close>, 0)]
val built_in_typed_consts =
- [((@{const_name zero_class.zero}, nat_T), 0),
- ((@{const_name one_class.one}, nat_T), 0),
- ((@{const_name plus_class.plus}, nat_T --> nat_T --> nat_T), 0),
- ((@{const_name minus_class.minus}, nat_T --> nat_T --> nat_T), 0),
- ((@{const_name times_class.times}, nat_T --> nat_T --> nat_T), 0),
- ((@{const_name Rings.divide}, nat_T --> nat_T --> nat_T), 0),
- ((@{const_name ord_class.less}, nat_T --> nat_T --> bool_T), 2),
- ((@{const_name ord_class.less_eq}, nat_T --> nat_T --> bool_T), 2),
- ((@{const_name of_nat}, nat_T --> int_T), 0),
- ((@{const_name zero_class.zero}, int_T), 0),
- ((@{const_name one_class.one}, int_T), 0),
- ((@{const_name plus_class.plus}, int_T --> int_T --> int_T), 0),
- ((@{const_name minus_class.minus}, int_T --> int_T --> int_T), 0),
- ((@{const_name times_class.times}, int_T --> int_T --> int_T), 0),
- ((@{const_name Rings.divide}, int_T --> int_T --> int_T), 0),
- ((@{const_name uminus_class.uminus}, int_T --> int_T), 0),
- ((@{const_name ord_class.less}, int_T --> int_T --> bool_T), 2),
- ((@{const_name ord_class.less_eq}, int_T --> int_T --> bool_T), 2)]
+ [((\<^const_name>\<open>zero_class.zero\<close>, nat_T), 0),
+ ((\<^const_name>\<open>one_class.one\<close>, nat_T), 0),
+ ((\<^const_name>\<open>plus_class.plus\<close>, nat_T --> nat_T --> nat_T), 0),
+ ((\<^const_name>\<open>minus_class.minus\<close>, nat_T --> nat_T --> nat_T), 0),
+ ((\<^const_name>\<open>times_class.times\<close>, nat_T --> nat_T --> nat_T), 0),
+ ((\<^const_name>\<open>Rings.divide\<close>, nat_T --> nat_T --> nat_T), 0),
+ ((\<^const_name>\<open>ord_class.less\<close>, nat_T --> nat_T --> bool_T), 2),
+ ((\<^const_name>\<open>ord_class.less_eq\<close>, nat_T --> nat_T --> bool_T), 2),
+ ((\<^const_name>\<open>of_nat\<close>, nat_T --> int_T), 0),
+ ((\<^const_name>\<open>zero_class.zero\<close>, int_T), 0),
+ ((\<^const_name>\<open>one_class.one\<close>, int_T), 0),
+ ((\<^const_name>\<open>plus_class.plus\<close>, int_T --> int_T --> int_T), 0),
+ ((\<^const_name>\<open>minus_class.minus\<close>, int_T --> int_T --> int_T), 0),
+ ((\<^const_name>\<open>times_class.times\<close>, int_T --> int_T --> int_T), 0),
+ ((\<^const_name>\<open>Rings.divide\<close>, int_T --> int_T --> int_T), 0),
+ ((\<^const_name>\<open>uminus_class.uminus\<close>, int_T --> int_T), 0),
+ ((\<^const_name>\<open>ord_class.less\<close>, int_T --> int_T --> bool_T), 2),
+ ((\<^const_name>\<open>ord_class.less_eq\<close>, int_T --> int_T --> bool_T), 2)]
-fun unarize_type @{typ "unsigned_bit word"} = nat_T
- | unarize_type @{typ "signed_bit word"} = int_T
+fun unarize_type \<^typ>\<open>unsigned_bit word\<close> = nat_T
+ | unarize_type \<^typ>\<open>signed_bit word\<close> = int_T
| unarize_type (Type (s, Ts as _ :: _)) = Type (s, map unarize_type Ts)
| unarize_type T = T
-fun unarize_unbox_etc_type (Type (@{type_name fun_box}, Ts)) =
- unarize_unbox_etc_type (Type (@{type_name fun}, Ts))
- | unarize_unbox_etc_type (Type (@{type_name pair_box}, Ts)) =
- Type (@{type_name prod}, map unarize_unbox_etc_type Ts)
- | unarize_unbox_etc_type @{typ "unsigned_bit word"} = nat_T
- | unarize_unbox_etc_type @{typ "signed_bit word"} = int_T
+fun unarize_unbox_etc_type (Type (\<^type_name>\<open>fun_box\<close>, Ts)) =
+ unarize_unbox_etc_type (Type (\<^type_name>\<open>fun\<close>, Ts))
+ | unarize_unbox_etc_type (Type (\<^type_name>\<open>pair_box\<close>, Ts)) =
+ Type (\<^type_name>\<open>prod\<close>, map unarize_unbox_etc_type Ts)
+ | unarize_unbox_etc_type \<^typ>\<open>unsigned_bit word\<close> = nat_T
+ | unarize_unbox_etc_type \<^typ>\<open>signed_bit word\<close> = int_T
| unarize_unbox_etc_type (Type (s, Ts as _ :: _)) =
Type (s, map unarize_unbox_etc_type Ts)
| unarize_unbox_etc_type T = T
fun uniterize_type (Type (s, Ts as _ :: _)) = Type (s, map uniterize_type Ts)
- | uniterize_type @{typ bisim_iterator} = nat_T
+ | uniterize_type \<^typ>\<open>bisim_iterator\<close> = nat_T
| uniterize_type T = T
val uniterize_unarize_unbox_etc_type = uniterize_type o unarize_unbox_etc_type
@@ -474,23 +474,23 @@
0 => HOLogic.mk_number T 0
| n1 => case snd (HOLogic.dest_number t2) of
1 => HOLogic.mk_number T n1
- | n2 => Const (@{const_name divide}, T --> T --> T)
+ | n2 => Const (\<^const_name>\<open>divide\<close>, T --> T --> T)
$ HOLogic.mk_number T n1 $ HOLogic.mk_number T n2
-fun is_fun_type (Type (@{type_name fun}, _)) = true
+fun is_fun_type (Type (\<^type_name>\<open>fun\<close>, _)) = true
| is_fun_type _ = false
-fun is_set_type (Type (@{type_name set}, _)) = true
+fun is_set_type (Type (\<^type_name>\<open>set\<close>, _)) = true
| is_set_type _ = false
val is_fun_or_set_type = is_fun_type orf is_set_type
-fun is_set_like_type (Type (@{type_name fun}, [_, T'])) =
+fun is_set_like_type (Type (\<^type_name>\<open>fun\<close>, [_, T'])) =
(body_type T' = bool_T)
- | is_set_like_type (Type (@{type_name set}, _)) = true
+ | is_set_like_type (Type (\<^type_name>\<open>set\<close>, _)) = true
| is_set_like_type _ = false
-fun is_pair_type (Type (@{type_name prod}, _)) = true
+fun is_pair_type (Type (\<^type_name>\<open>prod\<close>, _)) = true
| is_pair_type _ = false
fun is_lfp_iterator_type (Type (s, _)) = String.isPrefix lfp_iterator_prefix s
@@ -502,15 +502,15 @@
val is_fp_iterator_type = is_lfp_iterator_type orf is_gfp_iterator_type
fun is_iterator_type T =
- (T = @{typ bisim_iterator} orelse is_fp_iterator_type T)
+ (T = \<^typ>\<open>bisim_iterator\<close> orelse is_fp_iterator_type T)
fun is_boolean_type T = (T = prop_T orelse T = bool_T)
fun is_integer_type T = (T = nat_T orelse T = int_T)
-fun is_bit_type T = (T = @{typ unsigned_bit} orelse T = @{typ signed_bit})
+fun is_bit_type T = (T = \<^typ>\<open>unsigned_bit\<close> orelse T = \<^typ>\<open>signed_bit\<close>)
-fun is_word_type (Type (@{type_name word}, _)) = true
+fun is_word_type (Type (\<^type_name>\<open>word\<close>, _)) = true
| is_word_type _ = false
val is_integer_like_type = is_iterator_type orf is_integer_type orf is_word_type
@@ -521,19 +521,19 @@
fun is_number_type ctxt = is_integer_like_type orf is_frac_type ctxt
-fun is_higher_order_type (Type (@{type_name fun}, _)) = true
- | is_higher_order_type (Type (@{type_name set}, _)) = true
+fun is_higher_order_type (Type (\<^type_name>\<open>fun\<close>, _)) = true
+ | is_higher_order_type (Type (\<^type_name>\<open>set\<close>, _)) = true
| is_higher_order_type (Type (_, Ts)) = exists is_higher_order_type Ts
| is_higher_order_type _ = false
-fun elem_type (Type (@{type_name set}, [T'])) = T'
+fun elem_type (Type (\<^type_name>\<open>set\<close>, [T'])) = T'
| elem_type T = raise TYPE ("Nitpick_HOL.elem_type", [T], [])
-fun pseudo_domain_type (Type (@{type_name fun}, [T1, _])) = T1
+fun pseudo_domain_type (Type (\<^type_name>\<open>fun\<close>, [T1, _])) = T1
| pseudo_domain_type T = elem_type T
-fun pseudo_range_type (Type (@{type_name fun}, [_, T2])) = T2
- | pseudo_range_type (Type (@{type_name set}, _)) = bool_T
+fun pseudo_range_type (Type (\<^type_name>\<open>fun\<close>, [_, T2])) = T2
+ | pseudo_range_type (Type (\<^type_name>\<open>set\<close>, _)) = bool_T
| pseudo_range_type T = raise TYPE ("Nitpick_HOL.pseudo_range_type", [T], [])
fun iterator_type_for_const gfp (s, T) =
@@ -546,15 +546,15 @@
raise TYPE ("Nitpick_HOL.const_for_iterator_type", [T], [])
fun strip_n_binders 0 T = ([], T)
- | strip_n_binders n (Type (@{type_name fun}, [T1, T2])) =
+ | strip_n_binders n (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
strip_n_binders (n - 1) T2 |>> cons T1
- | strip_n_binders n (Type (@{type_name fun_box}, Ts)) =
- strip_n_binders n (Type (@{type_name fun}, Ts))
+ | strip_n_binders n (Type (\<^type_name>\<open>fun_box\<close>, Ts)) =
+ strip_n_binders n (Type (\<^type_name>\<open>fun\<close>, Ts))
| strip_n_binders _ T = raise TYPE ("Nitpick_HOL.strip_n_binders", [T], [])
val nth_range_type = snd oo strip_n_binders
-fun num_factors_in_type (Type (@{type_name prod}, [T1, T2])) =
+fun num_factors_in_type (Type (\<^type_name>\<open>prod\<close>, [T1, T2])) =
fold (Integer.add o num_factors_in_type) [T1, T2] 0
| num_factors_in_type _ = 1
@@ -564,7 +564,7 @@
(if is_pair_type (body_type T) then binder_types else curried_binder_types) T
fun mk_flat_tuple _ [t] = t
- | mk_flat_tuple (Type (@{type_name prod}, [T1, T2])) (t :: ts) =
+ | mk_flat_tuple (Type (\<^type_name>\<open>prod\<close>, [T1, T2])) (t :: ts) =
HOLogic.pair_const T1 T2 $ t $ (mk_flat_tuple T2 ts)
| mk_flat_tuple T ts = raise TYPE ("Nitpick_HOL.mk_flat_tuple", [T], ts)
@@ -573,10 +573,10 @@
fun typedef_info ctxt s =
if is_frac_type ctxt (Type (s, [])) then
- SOME {abs_type = Type (s, []), rep_type = @{typ "int * int"},
- Abs_name = @{const_name Abs_Frac},
- Rep_name = @{const_name Rep_Frac},
- prop_of_Rep = @{prop "Rep_Frac x \<in> Collect Frac"}
+ SOME {abs_type = Type (s, []), rep_type = \<^typ>\<open>int * int\<close>,
+ Abs_name = \<^const_name>\<open>Abs_Frac\<close>,
+ Rep_name = \<^const_name>\<open>Rep_Frac\<close>,
+ prop_of_Rep = \<^prop>\<open>Rep_Frac x \<in> Collect Frac\<close>
|> Logic.varify_global,
Abs_inverse = NONE, Rep_inverse = NONE}
else case Typedef.get_info ctxt s of
@@ -597,9 +597,9 @@
val is_raw_free_datatype = is_some oo Ctr_Sugar.ctr_sugar_of
val is_interpreted_type =
- member (op =) [@{type_name prod}, @{type_name set}, @{type_name bool},
- @{type_name nat}, @{type_name int}, @{type_name natural},
- @{type_name integer}]
+ member (op =) [\<^type_name>\<open>prod\<close>, \<^type_name>\<open>set\<close>, \<^type_name>\<open>bool\<close>,
+ \<^type_name>\<open>nat\<close>, \<^type_name>\<open>int\<close>, \<^type_name>\<open>natural\<close>,
+ \<^type_name>\<open>integer\<close>]
fun repair_constr_type (Type (_, Ts)) T =
snd (dest_Const (Ctr_Sugar.mk_ctr Ts (Const (Name.uu, T))))
@@ -646,7 +646,7 @@
val (co_s, coTs) = dest_Type coT
val _ =
if forall is_TFree coTs andalso not (has_duplicates (op =) coTs) andalso
- co_s <> @{type_name fun} andalso not (is_interpreted_type co_s) then
+ co_s <> \<^type_name>\<open>fun\<close> andalso not (is_interpreted_type co_s) then
()
else
raise TYPE ("Nitpick_HOL.register_codatatype_generic", [coT], [])
@@ -692,7 +692,7 @@
fun is_quot_type ctxt T =
is_raw_quot_type ctxt T andalso not (is_registered_type ctxt T) andalso
- T <> @{typ int}
+ T <> \<^typ>\<open>int\<close>
fun is_pure_typedef ctxt (T as Type (s, _)) =
is_frac_type ctxt T orelse
@@ -709,14 +709,14 @@
try (snd o HOLogic.dest_mem o HOLogic.dest_Trueprop) prop_of_Rep
in
case t_opt of
- SOME (Const (@{const_name top}, _)) => true
+ SOME (Const (\<^const_name>\<open>top\<close>, _)) => true
(* "Multiset.multiset" FIXME unchecked *)
- | SOME (Const (@{const_name Collect}, _)
- $ Abs (_, _, Const (@{const_name finite}, _) $ _)) => true
+ | SOME (Const (\<^const_name>\<open>Collect\<close>, _)
+ $ Abs (_, _, Const (\<^const_name>\<open>finite\<close>, _) $ _)) => true
(* "FinFun.finfun" FIXME unchecked *)
- | SOME (Const (@{const_name Collect}, _) $ Abs (_, _,
- Const (@{const_name Ex}, _) $ Abs (_, _,
- Const (@{const_name finite}, _) $ _))) => true
+ | SOME (Const (\<^const_name>\<open>Collect\<close>, _) $ Abs (_, _,
+ Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (_, _,
+ Const (\<^const_name>\<open>finite\<close>, _) $ _))) => true
| _ => false
end
| NONE => false)
@@ -724,7 +724,7 @@
fun is_data_type ctxt (T as Type (s, _)) =
(is_raw_typedef ctxt s orelse is_registered_type ctxt T orelse
- T = @{typ ind} orelse is_raw_quot_type ctxt T) andalso
+ T = \<^typ>\<open>ind\<close> orelse is_raw_quot_type ctxt T) andalso
not (is_interpreted_type s)
| is_data_type _ _ = false
@@ -739,7 +739,7 @@
fun no_of_record_field thy s T1 =
find_index (curry (op =) s o fst) (Record.get_extT_fields thy T1 ||> single |> op @)
-fun is_record_get thy (s, Type (@{type_name fun}, [T1, _])) =
+fun is_record_get thy (s, Type (\<^type_name>\<open>fun\<close>, [T1, _])) =
exists (curry (op =) s o fst) (all_record_fields thy T1)
| is_record_get _ _ = false
@@ -748,25 +748,25 @@
exists (curry (op =) (unsuffix Record.updateN s) o fst) (all_record_fields thy (body_type T))
handle TYPE _ => false
-fun is_abs_fun ctxt (s, Type (@{type_name fun}, [_, Type (s', _)])) =
+fun is_abs_fun ctxt (s, Type (\<^type_name>\<open>fun\<close>, [_, Type (s', _)])) =
(case typedef_info ctxt s' of
SOME {Abs_name, ...} => s = Abs_name
| NONE => false)
| is_abs_fun _ _ = false
-fun is_rep_fun ctxt (s, Type (@{type_name fun}, [Type (s', _), _])) =
+fun is_rep_fun ctxt (s, Type (\<^type_name>\<open>fun\<close>, [Type (s', _), _])) =
(case typedef_info ctxt s' of
SOME {Rep_name, ...} => s = Rep_name
| NONE => false)
| is_rep_fun _ _ = false
-fun is_quot_abs_fun ctxt (x as (_, Type (@{type_name fun},
+fun is_quot_abs_fun ctxt (x as (_, Type (\<^type_name>\<open>fun\<close>,
[_, abs_T as Type (s', _)]))) =
try (Quotient_Term.absrep_const_chk ctxt Quotient_Term.AbsF) s'
= SOME (Const x) andalso not (is_registered_type ctxt abs_T)
| is_quot_abs_fun _ _ = false
-fun is_quot_rep_fun ctxt (s, Type (@{type_name fun},
+fun is_quot_rep_fun ctxt (s, Type (\<^type_name>\<open>fun\<close>,
[abs_T as Type (abs_s, _), _])) =
(case try (Quotient_Term.absrep_const_chk ctxt Quotient_Term.RepF) abs_s of
SOME (Const (s', _)) =>
@@ -774,10 +774,10 @@
| _ => false)
| is_quot_rep_fun _ _ = false
-fun mate_of_rep_fun ctxt (x as (_, Type (@{type_name fun},
+fun mate_of_rep_fun ctxt (x as (_, Type (\<^type_name>\<open>fun\<close>,
[T1 as Type (s', _), T2]))) =
(case typedef_info ctxt s' of
- SOME {Abs_name, ...} => (Abs_name, Type (@{type_name fun}, [T2, T1]))
+ SOME {Abs_name, ...} => (Abs_name, Type (\<^type_name>\<open>fun\<close>, [T2, T1]))
| NONE => raise TERM ("Nitpick_HOL.mate_of_rep_fun", [Const x]))
| mate_of_rep_fun _ x = raise TERM ("Nitpick_HOL.mate_of_rep_fun", [Const x])
@@ -797,8 +797,8 @@
the (Quotient_Info.lookup_quotients thy s)
val partial =
case Thm.prop_of equiv_thm of
- @{const Trueprop} $ (Const (@{const_name equivp}, _) $ _) => false
- | @{const Trueprop} $ (Const (@{const_name part_equivp}, _) $ _) => true
+ @{const Trueprop} $ (Const (\<^const_name>\<open>equivp\<close>, _) $ _) => false
+ | @{const Trueprop} $ (Const (\<^const_name>\<open>part_equivp\<close>, _) $ _) => true
| _ => raise NOT_SUPPORTED "Ill-formed quotient type equivalence \
\relation theorem"
val Ts' = qtyp |> dest_Type |> snd
@@ -833,9 +833,9 @@
| _ => false
fun is_nonfree_constr ctxt (s, T) =
- member (op =) [@{const_name FunBox}, @{const_name PairBox},
- @{const_name Quot}, @{const_name Zero_Rep},
- @{const_name Suc_Rep}] s orelse
+ member (op =) [\<^const_name>\<open>FunBox\<close>, \<^const_name>\<open>PairBox\<close>,
+ \<^const_name>\<open>Quot\<close>, \<^const_name>\<open>Zero_Rep\<close>,
+ \<^const_name>\<open>Suc_Rep\<close>] s orelse
let val (x as (_, T)) = (s, unarize_unbox_etc_type T) in
is_raw_free_datatype_constr ctxt x orelse
(is_abs_fun ctxt x andalso is_pure_typedef ctxt (range_type T)) orelse
@@ -850,7 +850,7 @@
fun is_stale_constr ctxt (x as (s, T)) =
is_registered_type ctxt (body_type T) andalso is_nonfree_constr ctxt x andalso
- not (s = @{const_name Abs_Frac} orelse is_registered_coconstr ctxt x)
+ not (s = \<^const_name>\<open>Abs_Frac\<close> orelse is_registered_coconstr ctxt x)
fun is_constr ctxt (x as (_, T)) =
is_nonfree_constr ctxt x andalso
@@ -860,7 +860,7 @@
val is_sel = String.isPrefix discr_prefix orf String.isPrefix sel_prefix
val is_sel_like_and_no_discr =
String.isPrefix sel_prefix orf
- (member (op =) [@{const_name fst}, @{const_name snd}])
+ (member (op =) [\<^const_name>\<open>fst\<close>, \<^const_name>\<open>snd\<close>])
fun in_fun_lhs_for InConstr = InSel
| in_fun_lhs_for _ = InFunLHS
@@ -872,10 +872,10 @@
fun is_boxing_worth_it (hol_ctxt : hol_context) boxy T =
case T of
- Type (@{type_name fun}, _) =>
+ Type (\<^type_name>\<open>fun\<close>, _) =>
(boxy = InPair orelse boxy = InFunLHS) andalso
not (is_boolean_type (body_type T))
- | Type (@{type_name prod}, Ts) =>
+ | Type (\<^type_name>\<open>prod\<close>, Ts) =>
boxy = InPair orelse boxy = InFunRHS1 orelse boxy = InFunRHS2 orelse
((boxy = InExpr orelse boxy = InFunLHS) andalso
exists (is_boxing_worth_it hol_ctxt InPair)
@@ -887,27 +887,27 @@
| _ => is_boxing_worth_it hol_ctxt boxy (Type z)
and box_type hol_ctxt boxy T =
case T of
- Type (z as (@{type_name fun}, [T1, T2])) =>
+ Type (z as (\<^type_name>\<open>fun\<close>, [T1, T2])) =>
if boxy <> InConstr andalso boxy <> InSel andalso
should_box_type hol_ctxt boxy z then
- Type (@{type_name fun_box},
+ Type (\<^type_name>\<open>fun_box\<close>,
[box_type hol_ctxt InFunLHS T1, box_type hol_ctxt InFunRHS1 T2])
else
box_type hol_ctxt (in_fun_lhs_for boxy) T1
--> box_type hol_ctxt (in_fun_rhs_for boxy) T2
- | Type (z as (@{type_name prod}, Ts)) =>
+ | Type (z as (\<^type_name>\<open>prod\<close>, Ts)) =>
if boxy <> InConstr andalso boxy <> InSel
andalso should_box_type hol_ctxt boxy z then
- Type (@{type_name pair_box}, map (box_type hol_ctxt InSel) Ts)
+ Type (\<^type_name>\<open>pair_box\<close>, map (box_type hol_ctxt InSel) Ts)
else
- Type (@{type_name prod},
+ Type (\<^type_name>\<open>prod\<close>,
map (box_type hol_ctxt
(if boxy = InConstr orelse boxy = InSel then boxy
else InPair)) Ts)
| _ => T
-fun binarize_nat_and_int_in_type @{typ nat} = @{typ "unsigned_bit word"}
- | binarize_nat_and_int_in_type @{typ int} = @{typ "signed_bit word"}
+fun binarize_nat_and_int_in_type \<^typ>\<open>nat\<close> = \<^typ>\<open>unsigned_bit word\<close>
+ | binarize_nat_and_int_in_type \<^typ>\<open>int\<close> = \<^typ>\<open>signed_bit word\<close>
| binarize_nat_and_int_in_type (Type (s, Ts)) =
Type (s, map binarize_nat_and_int_in_type Ts)
| binarize_nat_and_int_in_type T = T
@@ -918,8 +918,8 @@
fun num_sels_for_constr_type T = length (maybe_curried_binder_types T)
fun nth_sel_name_for_constr_name s n =
- if s = @{const_name Pair} then
- if n = 0 then @{const_name fst} else @{const_name snd}
+ if s = \<^const_name>\<open>Pair\<close> then
+ if n = 0 then \<^const_name>\<open>fst\<close> else \<^const_name>\<open>snd\<close>
else
sel_prefix_for n ^ s
@@ -937,7 +937,7 @@
~1
else if String.isPrefix sel_prefix s then
s |> unprefix sel_prefix |> Int.fromString |> the
- else if s = @{const_name snd} then
+ else if s = \<^const_name>\<open>snd\<close> then
1
else
0
@@ -960,8 +960,8 @@
#> map (fn (t1, t2) => @{const Not} $ (HOLogic.eq_const T $ t1 $ t2))
#> List.foldr (s_conj o swap) @{const True}
-fun zero_const T = Const (@{const_name zero_class.zero}, T)
-fun suc_const T = Const (@{const_name Suc}, T --> T)
+fun zero_const T = Const (\<^const_name>\<open>zero_class.zero\<close>, T)
+fun suc_const T = Const (\<^const_name>\<open>Suc\<close>, T --> T)
fun uncached_data_type_constrs ({ctxt, ...} : hol_context) (T as Type (s, _)) =
if is_interpreted_type s then
@@ -981,12 +981,12 @@
map (apsnd (repair_constr_type T) o dest_Const) ctrs
| NONE =>
if is_raw_quot_type ctxt T then
- [(@{const_name Quot}, rep_type_for_quot_type ctxt T --> T)]
+ [(\<^const_name>\<open>Quot\<close>, rep_type_for_quot_type ctxt T --> T)]
else case typedef_info ctxt s of
SOME {abs_type, rep_type, Abs_name, ...} =>
[(Abs_name, varify_and_instantiate_type ctxt abs_type T rep_type --> T)]
| NONE =>
- if T = @{typ ind} then [dest_Const @{const Zero_Rep}, dest_Const @{const Suc_Rep}]
+ if T = \<^typ>\<open>ind\<close> then [dest_Const @{const Zero_Rep}, dest_Const @{const Suc_Rep}]
else [])
| uncached_data_type_constrs _ _ = []
@@ -1002,8 +1002,8 @@
map (apsnd ((binarize ? binarize_nat_and_int_in_type)
o box_type hol_ctxt InConstr)) o data_type_constrs hol_ctxt
-fun constr_name_for_sel_like @{const_name fst} = @{const_name Pair}
- | constr_name_for_sel_like @{const_name snd} = @{const_name Pair}
+fun constr_name_for_sel_like \<^const_name>\<open>fst\<close> = \<^const_name>\<open>Pair\<close>
+ | constr_name_for_sel_like \<^const_name>\<open>snd\<close> = \<^const_name>\<open>Pair\<close>
| constr_name_for_sel_like s' = original_name s'
fun binarized_and_boxed_constr_for_sel hol_ctxt binarize (s', T') =
@@ -1014,23 +1014,23 @@
|> the |> pair s
end
-fun card_of_type assigns (Type (@{type_name fun}, [T1, T2])) =
+fun card_of_type assigns (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
reasonable_power (card_of_type assigns T2) (card_of_type assigns T1)
- | card_of_type assigns (Type (@{type_name prod}, [T1, T2])) =
+ | card_of_type assigns (Type (\<^type_name>\<open>prod\<close>, [T1, T2])) =
card_of_type assigns T1 * card_of_type assigns T2
- | card_of_type assigns (Type (@{type_name set}, [T'])) =
+ | card_of_type assigns (Type (\<^type_name>\<open>set\<close>, [T'])) =
reasonable_power 2 (card_of_type assigns T')
- | card_of_type _ (Type (@{type_name itself}, _)) = 1
- | card_of_type _ @{typ prop} = 2
- | card_of_type _ @{typ bool} = 2
+ | card_of_type _ (Type (\<^type_name>\<open>itself\<close>, _)) = 1
+ | card_of_type _ \<^typ>\<open>prop\<close> = 2
+ | card_of_type _ \<^typ>\<open>bool\<close> = 2
| card_of_type assigns T =
case AList.lookup (op =) assigns T of
SOME k => k
- | NONE => if T = @{typ bisim_iterator} then 0
+ | NONE => if T = \<^typ>\<open>bisim_iterator\<close> then 0
else raise TYPE ("Nitpick_HOL.card_of_type", [T], [])
fun bounded_card_of_type max default_card assigns
- (Type (@{type_name fun}, [T1, T2])) =
+ (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
let
val k1 = bounded_card_of_type max default_card assigns T1
val k2 = bounded_card_of_type max default_card assigns T2
@@ -1040,13 +1040,13 @@
handle TOO_LARGE _ => max
end
| bounded_card_of_type max default_card assigns
- (Type (@{type_name prod}, [T1, T2])) =
+ (Type (\<^type_name>\<open>prod\<close>, [T1, T2])) =
let
val k1 = bounded_card_of_type max default_card assigns T1
val k2 = bounded_card_of_type max default_card assigns T2
in if k1 = max orelse k2 = max then max else Int.min (max, k1 * k2) end
| bounded_card_of_type max default_card assigns
- (Type (@{type_name set}, [T'])) =
+ (Type (\<^type_name>\<open>set\<close>, [T'])) =
bounded_card_of_type max default_card assigns (T' --> bool_T)
| bounded_card_of_type max default_card assigns T =
Int.min (max, if default_card = ~1 then
@@ -1066,7 +1066,7 @@
else if member (op =) finitizable_dataTs T then
raise SAME ()
else case T of
- Type (@{type_name fun}, [T1, T2]) =>
+ Type (\<^type_name>\<open>fun\<close>, [T1, T2]) =>
(case (aux avoid T1, aux avoid T2) of
(_, 1) => 1
| (0, _) => 0
@@ -1074,17 +1074,17 @@
| (k1, k2) =>
if k1 >= max orelse k2 >= max then max
else Int.min (max, reasonable_power k2 k1))
- | Type (@{type_name prod}, [T1, T2]) =>
+ | Type (\<^type_name>\<open>prod\<close>, [T1, T2]) =>
(case (aux avoid T1, aux avoid T2) of
(0, _) => 0
| (_, 0) => 0
| (k1, k2) =>
if k1 >= max orelse k2 >= max then max
else Int.min (max, k1 * k2))
- | Type (@{type_name set}, [T']) => aux avoid (T' --> bool_T)
- | Type (@{type_name itself}, _) => 1
- | @{typ prop} => 2
- | @{typ bool} => 2
+ | Type (\<^type_name>\<open>set\<close>, [T']) => aux avoid (T' --> bool_T)
+ | Type (\<^type_name>\<open>itself\<close>, _) => 1
+ | \<^typ>\<open>prop\<close> => 2
+ | \<^typ>\<open>bool\<close> => 2
| Type _ =>
(case data_type_constrs hol_ctxt T of
[] => if is_integer_type T orelse is_bit_type T then 0
@@ -1131,7 +1131,7 @@
f t
else
let val z = (let_var s, abs_T) in
- Const (@{const_name Let}, abs_T --> (abs_T --> body_T) --> body_T)
+ Const (\<^const_name>\<open>Let\<close>, abs_T --> (abs_T --> body_T) --> body_T)
$ t $ abs_var z (incr_boundvars 1 (f (Var z)))
end
@@ -1141,17 +1141,17 @@
| loose_bvar1_count (Abs (_, _, t), k) = loose_bvar1_count (t, k + 1)
| loose_bvar1_count _ = 0
-fun s_betapply _ (t1 as Const (@{const_name Pure.eq}, _) $ t1', t2) =
- if t1' aconv t2 then @{prop True} else t1 $ t2
- | s_betapply _ (t1 as Const (@{const_name HOL.eq}, _) $ t1', t2) =
- if t1' aconv t2 then @{term True} else t1 $ t2
- | s_betapply _ (Const (@{const_name If}, _) $ @{const True} $ t1', _) = t1'
- | s_betapply _ (Const (@{const_name If}, _) $ @{const False} $ _, t2) = t2
- | s_betapply Ts (Const (@{const_name Let},
+fun s_betapply _ (t1 as Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t1', t2) =
+ if t1' aconv t2 then \<^prop>\<open>True\<close> else t1 $ t2
+ | s_betapply _ (t1 as Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1', t2) =
+ if t1' aconv t2 then \<^term>\<open>True\<close> else t1 $ t2
+ | s_betapply _ (Const (\<^const_name>\<open>If\<close>, _) $ @{const True} $ t1', _) = t1'
+ | s_betapply _ (Const (\<^const_name>\<open>If\<close>, _) $ @{const False} $ _, t2) = t2
+ | s_betapply Ts (Const (\<^const_name>\<open>Let\<close>,
Type (_, [bound_T, Type (_, [_, body_T])]))
$ t12 $ Abs (s, T, t13'), t2) =
let val body_T' = range_type body_T in
- Const (@{const_name Let}, bound_T --> (bound_T --> body_T') --> body_T')
+ Const (\<^const_name>\<open>Let\<close>, bound_T --> (bound_T --> body_T') --> body_T')
$ t12 $ Abs (s, T, s_betapply (T :: Ts) (t13', incr_boundvars 1 t2))
end
| s_betapply Ts (t1 as Abs (s1, T1, t1'), t2) =
@@ -1180,7 +1180,7 @@
fun discr_term_for_constr hol_ctxt (x as (s, T)) =
let val dataT = body_type T in
- if s = @{const_name Suc} then
+ if s = \<^const_name>\<open>Suc\<close> then
Abs (Name.uu, dataT, @{const Not} $ HOLogic.mk_eq (zero_const dataT, Bound 0))
else if length (data_type_constrs hol_ctxt dataT) >= 2 then
Const (discr_for_constr x)
@@ -1199,12 +1199,12 @@
fun nth_arg_sel_term_for_constr (x as (s, T)) n =
let val (arg_Ts, dataT) = strip_type T in
if dataT = nat_T then
- @{term "%n::nat. n - 1"}
+ \<^term>\<open>%n::nat. n - 1\<close>
else if is_pair_type dataT then
Const (nth_sel_for_constr x n)
else
let
- fun aux m (Type (@{type_name prod}, [T1, T2])) =
+ fun aux m (Type (\<^type_name>\<open>prod\<close>, [T1, T2])) =
let
val (m, t1) = aux m T1
val (m, t2) = aux m T2
@@ -1223,7 +1223,7 @@
if x = x' then
if is_free_constr ctxt x then nth args n else raise SAME ()
else if is_nonfree_constr ctxt x' then
- Const (@{const_name unknown}, res_T)
+ Const (\<^const_name>\<open>unknown\<close>, res_T)
else
raise SAME ()
| _ => raise SAME())
@@ -1253,7 +1253,7 @@
val x' as (_, T') =
if is_pair_type T then
let val (T1, T2) = HOLogic.dest_prodT T in
- (@{const_name Pair}, T1 --> T2 --> T)
+ (\<^const_name>\<open>Pair\<close>, T1 --> T2 --> T)
end
else
data_type_constrs hol_ctxt T |> hd
@@ -1278,36 +1278,36 @@
else
case (new_T, old_T) of
(Type (new_s, new_Ts as [new_T1, new_T2]),
- Type (@{type_name fun}, [old_T1, old_T2])) =>
+ Type (\<^type_name>\<open>fun\<close>, [old_T1, old_T2])) =>
(case eta_expand Ts t 1 of
Abs (s, _, t') =>
Abs (s, new_T1,
t' |> coerce_bound_0_in_term hol_ctxt new_T1 old_T1
|> coerce_term hol_ctxt (new_T1 :: Ts) new_T2 old_T2)
|> Envir.eta_contract
- |> new_s <> @{type_name fun}
+ |> new_s <> \<^type_name>\<open>fun\<close>
? construct_value ctxt
- (@{const_name FunBox},
- Type (@{type_name fun}, new_Ts) --> new_T)
+ (\<^const_name>\<open>FunBox\<close>,
+ Type (\<^type_name>\<open>fun\<close>, new_Ts) --> new_T)
o single
| t' => raise TERM ("Nitpick_HOL.coerce_term", [t']))
| (Type (new_s, new_Ts as [new_T1, new_T2]),
Type (old_s, old_Ts as [old_T1, old_T2])) =>
- if old_s = @{type_name fun_box} orelse
- old_s = @{type_name pair_box} orelse old_s = @{type_name prod} then
+ if old_s = \<^type_name>\<open>fun_box\<close> orelse
+ old_s = \<^type_name>\<open>pair_box\<close> orelse old_s = \<^type_name>\<open>prod\<close> then
case constr_expand hol_ctxt old_T t of
Const (old_s, _) $ t1 =>
- if new_s = @{type_name fun} then
- coerce_term hol_ctxt Ts new_T (Type (@{type_name fun}, old_Ts)) t1
+ if new_s = \<^type_name>\<open>fun\<close> then
+ coerce_term hol_ctxt Ts new_T (Type (\<^type_name>\<open>fun\<close>, old_Ts)) t1
else
construct_value ctxt
- (old_s, Type (@{type_name fun}, new_Ts) --> new_T)
- [coerce_term hol_ctxt Ts (Type (@{type_name fun}, new_Ts))
- (Type (@{type_name fun}, old_Ts)) t1]
+ (old_s, Type (\<^type_name>\<open>fun\<close>, new_Ts) --> new_T)
+ [coerce_term hol_ctxt Ts (Type (\<^type_name>\<open>fun\<close>, new_Ts))
+ (Type (\<^type_name>\<open>fun\<close>, old_Ts)) t1]
| Const _ $ t1 $ t2 =>
construct_value ctxt
- (if new_s = @{type_name prod} then @{const_name Pair}
- else @{const_name PairBox}, new_Ts ---> new_T)
+ (if new_s = \<^type_name>\<open>prod\<close> then \<^const_name>\<open>Pair\<close>
+ else \<^const_name>\<open>PairBox\<close>, new_Ts ---> new_T)
(@{map 3} (coerce_term hol_ctxt Ts) [new_T1, new_T2] [old_T1, old_T2]
[t1, t2])
| t' => raise TERM ("Nitpick_HOL.coerce_term", [t'])
@@ -1323,8 +1323,8 @@
fold Term.add_vars ts [] |> sort (Term_Ord.fast_indexname_ord o apply2 fst)
fun is_funky_typedef_name ctxt s =
- member (op =) [@{type_name unit}, @{type_name prod}, @{type_name set},
- @{type_name Sum_Type.sum}, @{type_name int}] s orelse
+ member (op =) [\<^type_name>\<open>unit\<close>, \<^type_name>\<open>prod\<close>, \<^type_name>\<open>set\<close>,
+ \<^type_name>\<open>Sum_Type.sum\<close>, \<^type_name>\<open>int\<close>] s orelse
is_frac_type ctxt (Type (s, []))
fun is_funky_typedef ctxt (Type (s, _)) = is_funky_typedef_name ctxt s
@@ -1350,7 +1350,7 @@
theory will do as long as it contains all the "axioms" and "axiomatization"
commands. *)
fun is_built_in_theory thy_id =
- Context.subthy_id (thy_id, Context.theory_id @{theory Hilbert_Choice})
+ Context.subthy_id (thy_id, Context.theory_id \<^theory>\<open>Hilbert_Choice\<close>)
fun all_nondefs_of ctxt subst =
ctxt |> Spec_Rules.get
@@ -1360,8 +1360,8 @@
|> map (subst_atomic subst o Thm.prop_of)
fun arity_of_built_in_const (s, T) =
- if s = @{const_name If} then
- if nth_range_type 3 T = @{typ bool} then NONE else SOME 3
+ if s = \<^const_name>\<open>If\<close> then
+ if nth_range_type 3 T = \<^typ>\<open>bool\<close> then NONE else SOME 3
else
case AList.lookup (op =) built_in_consts s of
SOME n => SOME n
@@ -1370,8 +1370,8 @@
SOME n => SOME n
| NONE =>
case s of
- @{const_name zero_class.zero} => if is_iterator_type T then SOME 0 else NONE
- | @{const_name Suc} => if is_iterator_type (domain_type T) then SOME 0 else NONE
+ \<^const_name>\<open>zero_class.zero\<close> => if is_iterator_type T then SOME 0 else NONE
+ | \<^const_name>\<open>Suc\<close> => if is_iterator_type (domain_type T) then SOME 0 else NONE
| _ => NONE
val is_built_in_const = is_some o arity_of_built_in_const
@@ -1381,9 +1381,9 @@
fun term_under_def t =
case t of
@{const Pure.imp} $ _ $ t2 => term_under_def t2
- | Const (@{const_name Pure.eq}, _) $ t1 $ _ => term_under_def t1
+ | Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t1 $ _ => term_under_def t1
| @{const Trueprop} $ t1 => term_under_def t1
- | Const (@{const_name HOL.eq}, _) $ t1 $ _ => term_under_def t1
+ | Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ _ => term_under_def t1
| Abs (_, _, t') => term_under_def t'
| t1 $ _ => term_under_def t1
| _ => t
@@ -1402,12 +1402,12 @@
fun normalized_rhs_of t =
let
fun aux (v as Var _) (SOME t) = SOME (lambda v t)
- | aux (c as Const (@{const_name Pure.type}, _)) (SOME t) = SOME (lambda c t)
+ | aux (c as Const (\<^const_name>\<open>Pure.type\<close>, _)) (SOME t) = SOME (lambda c t)
| aux _ _ = NONE
val (lhs, rhs) =
case t of
- Const (@{const_name Pure.eq}, _) $ t1 $ t2 => (t1, t2)
- | @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ t1 $ t2) =>
+ Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t1 $ t2 => (t1, t2)
+ | @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2) =>
(t1, t2)
| _ => raise TERM ("Nitpick_HOL.normalized_rhs_of", [t])
val args = strip_comb lhs |> snd
@@ -1429,16 +1429,16 @@
val def_of_const = Option.map snd ooo def_of_const_ext
fun fixpoint_kind_of_rhs (Abs (_, _, t)) = fixpoint_kind_of_rhs t
- | fixpoint_kind_of_rhs (Const (@{const_name lfp}, _) $ Abs _) = Lfp
- | fixpoint_kind_of_rhs (Const (@{const_name gfp}, _) $ Abs _) = Gfp
+ | fixpoint_kind_of_rhs (Const (\<^const_name>\<open>lfp\<close>, _) $ Abs _) = Lfp
+ | fixpoint_kind_of_rhs (Const (\<^const_name>\<open>gfp\<close>, _) $ Abs _) = Gfp
| fixpoint_kind_of_rhs _ = NoFp
fun is_mutually_inductive_pred_def thy table t =
let
fun is_good_arg (Bound _) = true
| is_good_arg (Const (s, _)) =
- s = @{const_name True} orelse s = @{const_name False} orelse
- s = @{const_name undefined}
+ s = \<^const_name>\<open>True\<close> orelse s = \<^const_name>\<open>False\<close> orelse
+ s = \<^const_name>\<open>undefined\<close>
| is_good_arg _ = false
in
case t |> strip_abs_body |> strip_comb of
@@ -1483,12 +1483,12 @@
fun lhs_of_equation t =
case t of
- Const (@{const_name Pure.all}, _) $ Abs (_, _, t1) => lhs_of_equation t1
- | Const (@{const_name Pure.eq}, _) $ t1 $ _ => SOME t1
+ Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (_, _, t1) => lhs_of_equation t1
+ | Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t1 $ _ => SOME t1
| @{const Pure.imp} $ _ $ t2 => lhs_of_equation t2
| @{const Trueprop} $ t1 => lhs_of_equation t1
- | Const (@{const_name All}, _) $ Abs (_, _, t1) => lhs_of_equation t1
- | Const (@{const_name HOL.eq}, _) $ t1 $ _ => SOME t1
+ | Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, _, t1) => lhs_of_equation t1
+ | Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ _ => SOME t1
| @{const HOL.implies} $ _ $ t2 => lhs_of_equation t2
| _ => NONE
@@ -1552,7 +1552,7 @@
case nondef_props_for_const thy true choice_spec_table x of
[] => false
| ts => case def_of_const thy def_tables x of
- SOME (Const (@{const_name Eps}, _) $ _) => true
+ SOME (Const (\<^const_name>\<open>Eps\<close>, _) $ _) => true
| SOME _ => false
| NONE =>
let val ts' = nondef_props_for_const thy true nondef_table x in
@@ -1586,7 +1586,7 @@
if res_T = bool_T then
s_conj (HOLogic.mk_imp (guard_t, body_t), res_t)
else
- Const (@{const_name If}, bool_T --> res_T --> res_T --> res_T)
+ Const (\<^const_name>\<open>If\<close>, bool_T --> res_T --> res_T --> res_T)
$ guard_t $ body_t $ res_t
fun optimized_case_def (hol_ctxt as {ctxt, ...}) Ts dataT res_T func_ts =
@@ -1680,7 +1680,7 @@
if is_integer_like_type T then
Const (s, T)
else
- do_term depth Ts (Const (@{const_name of_int}, int_T --> T)
+ do_term depth Ts (Const (\<^const_name>\<open>of_int\<close>, int_T --> T)
$ Const (s, int_T))
end
end
@@ -1691,35 +1691,35 @@
| SOME t0 => s_betapply [] (do_term depth Ts t0, s_betapply [] (do_term depth Ts t1, do_term depth Ts t2)))
and do_term depth Ts t =
case t of
- (t0 as Const (@{const_name uminus}, _) $ ((t1 as Const (@{const_name numeral},
- Type (@{type_name fun}, [_, ran_T]))) $ t2)) =>
+ (t0 as Const (\<^const_name>\<open>uminus\<close>, _) $ ((t1 as Const (\<^const_name>\<open>numeral\<close>,
+ Type (\<^type_name>\<open>fun\<close>, [_, ran_T]))) $ t2)) =>
do_numeral depth Ts ~1 ran_T (SOME t0) t1 t2
- | (t1 as Const (@{const_name numeral},
- Type (@{type_name fun}, [_, ran_T]))) $ t2 =>
+ | (t1 as Const (\<^const_name>\<open>numeral\<close>,
+ Type (\<^type_name>\<open>fun\<close>, [_, ran_T]))) $ t2 =>
do_numeral depth Ts 1 ran_T NONE t1 t2
- | Const (@{const_name refl_on}, T) $ Const (@{const_name top}, _) $ t2 =>
- do_const depth Ts t (@{const_name refl'}, range_type T) [t2]
- | (t0 as Const (@{const_name Sigma}, Type (_, [T1, Type (_, [T2, T3])])))
+ | Const (\<^const_name>\<open>refl_on\<close>, T) $ Const (\<^const_name>\<open>top\<close>, _) $ t2 =>
+ do_const depth Ts t (\<^const_name>\<open>refl'\<close>, range_type T) [t2]
+ | (t0 as Const (\<^const_name>\<open>Sigma\<close>, Type (_, [T1, Type (_, [T2, T3])])))
$ t1 $ (t2 as Abs (_, _, t2')) =>
if loose_bvar1 (t2', 0) then
s_betapplys Ts (do_term depth Ts t0, map (do_term depth Ts) [t1, t2])
else
do_term depth Ts
- (Const (@{const_name prod}, T1 --> range_type T2 --> T3)
+ (Const (\<^const_name>\<open>prod\<close>, T1 --> range_type T2 --> T3)
$ t1 $ incr_boundvars ~1 t2')
- | Const (x as (@{const_name distinct},
- Type (@{type_name fun}, [Type (@{type_name list}, [T']), _])))
+ | Const (x as (\<^const_name>\<open>distinct\<close>,
+ Type (\<^type_name>\<open>fun\<close>, [Type (\<^type_name>\<open>list\<close>, [T']), _])))
$ (t1 as _ $ _) =>
(t1 |> HOLogic.dest_list |> distinctness_formula T'
handle TERM _ => do_const depth Ts t x [t1])
- | Const (x as (@{const_name If}, _)) $ t1 $ t2 $ t3 =>
+ | Const (x as (\<^const_name>\<open>If\<close>, _)) $ t1 $ t2 $ t3 =>
if is_ground_term t1 andalso
exists (Pattern.matches thy o rpair t1)
(Inttab.lookup_list ground_thm_table (hash_term t1)) then
do_term depth Ts t2
else
do_const depth Ts t x [t1, t2, t3]
- | Const (@{const_name Let}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>Let\<close>, _) $ t1 $ t2 =>
s_betapply Ts (apply2 (do_term depth Ts) (t2, t1))
| Const x => do_const depth Ts t x []
| t1 $ t2 =>
@@ -1729,7 +1729,7 @@
| Bound _ => t
| Abs (s, T, body) => Abs (s, T, do_term depth (T :: Ts) body)
| _ => if member (term_match thy) whacks t then
- Const (@{const_name unknown}, fastype_of1 (Ts, t))
+ Const (\<^const_name>\<open>unknown\<close>, fastype_of1 (Ts, t))
else
t
and select_nth_constr_arg_with_args _ _ (x as (_, T)) [] n res_T =
@@ -1739,10 +1739,10 @@
(select_nth_constr_arg ctxt x (do_term depth Ts t) n res_T, ts)
and quot_rep_of depth Ts abs_T rep_T ts =
select_nth_constr_arg_with_args depth Ts
- (@{const_name Quot}, rep_T --> abs_T) ts 0 rep_T
+ (\<^const_name>\<open>Quot\<close>, rep_T --> abs_T) ts 0 rep_T
and do_const depth Ts t (x as (s, T)) ts =
if member (term_match thy) whacks (Const x) then
- Const (@{const_name unknown}, fastype_of1 (Ts, t))
+ Const (\<^const_name>\<open>unknown\<close>, fastype_of1 (Ts, t))
else case AList.lookup (op =) ersatz_table s of
SOME s' =>
do_const (depth + 1) Ts (list_comb (Const (s', T), ts)) (s', T) ts
@@ -1778,18 +1778,18 @@
\(\"" ^ s ^ "\")")
else if is_quot_abs_fun ctxt x then
case T of
- Type (@{type_name fun}, [rep_T, abs_T as Type (abs_s, _)]) =>
+ Type (\<^type_name>\<open>fun\<close>, [rep_T, abs_T as Type (abs_s, _)]) =>
if is_interpreted_type abs_s then
raise NOT_SUPPORTED ("abstraction function on " ^
quote abs_s)
else
(Abs (Name.uu, rep_T,
- Const (@{const_name Quot}, rep_T --> abs_T)
+ Const (\<^const_name>\<open>Quot\<close>, rep_T --> abs_T)
$ (Const (quot_normal_name_for_type ctxt abs_T,
rep_T --> rep_T) $ Bound 0)), ts)
else if is_quot_rep_fun ctxt x then
case T of
- Type (@{type_name fun}, [abs_T as Type (abs_s, _), rep_T]) =>
+ Type (\<^type_name>\<open>fun\<close>, [abs_T as Type (abs_s, _), rep_T]) =>
if is_interpreted_type abs_s then
raise NOT_SUPPORTED ("representation function on " ^
quote abs_s)
@@ -1812,15 +1812,15 @@
let
val abs_T = range_type T
val rep_T = elem_type (domain_type T)
- val eps_fun = Const (@{const_name Eps},
+ val eps_fun = Const (\<^const_name>\<open>Eps\<close>,
(rep_T --> bool_T) --> rep_T)
val normal_fun =
Const (quot_normal_name_for_type ctxt abs_T,
rep_T --> rep_T)
- val abs_fun = Const (@{const_name Quot}, rep_T --> abs_T)
+ val abs_fun = Const (\<^const_name>\<open>Quot\<close>, rep_T --> abs_T)
val pred =
Abs (Name.uu, rep_T,
- Const (@{const_name Set.member},
+ Const (\<^const_name>\<open>Set.member\<close>,
rep_T --> domain_type T --> bool_T)
$ Bound 0 $ Bound 1)
in
@@ -1859,7 +1859,7 @@
"too many nested definitions (" ^
string_of_int depth ^ ") while expanding " ^
quote s)
- else if s = @{const_name wfrec'} then
+ else if s = \<^const_name>\<open>wfrec'\<close> then
(do_term (depth + 1) Ts (s_betapplys Ts (def, ts)), [])
else if not unfold andalso
size_of_term def > def_inline_threshold () then
@@ -1886,7 +1886,7 @@
(betapply (t2, var_t))
end
else
- Const (@{const_name HOL.eq}, T --> T --> bool_T) $ t1 $ t2
+ Const (\<^const_name>\<open>HOL.eq\<close>, T --> T --> bool_T) $ t1 $ t2
(* FIXME: needed? *)
fun equationalize_term ctxt tag t =
@@ -1896,12 +1896,12 @@
in
Logic.list_implies (prems,
case concl of
- @{const Trueprop} $ (Const (@{const_name HOL.eq}, Type (_, [T, _]))
+ @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, Type (_, [T, _]))
$ t1 $ t2) =>
@{const Trueprop} $ extensional_equal j T t1 t2
| @{const Trueprop} $ t' =>
@{const Trueprop} $ HOLogic.mk_eq (t', @{const True})
- | Const (@{const_name Pure.eq}, Type (_, [T, _])) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>Pure.eq\<close>, Type (_, [T, _])) $ t1 $ t2 =>
@{const Trueprop} $ extensional_equal j T t1 t2
| _ => (warning ("Ignoring " ^ quote tag ^ " for non-equation " ^
quote (Syntax.string_of_term ctxt t));
@@ -1921,7 +1921,7 @@
fun const_def_tables ctxt subst ts =
(def_table_for
- (map Thm.prop_of (rev (Named_Theorems.get ctxt @{named_theorems nitpick_unfold}))) subst,
+ (map Thm.prop_of (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>nitpick_unfold\<close>))) subst,
fold (fn (s, t) => Symtab.map_default (s, []) (cons t))
(map pair_for_prop ts) Symtab.empty)
@@ -1932,15 +1932,15 @@
fun const_simp_table ctxt =
def_table_for (map_filter (equationalize_term ctxt "nitpick_simp" o Thm.prop_of)
- (rev (Named_Theorems.get ctxt @{named_theorems nitpick_simp})))
+ (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>nitpick_simp\<close>)))
fun const_psimp_table ctxt =
def_table_for (map_filter (equationalize_term ctxt "nitpick_psimp" o Thm.prop_of)
- (rev (Named_Theorems.get ctxt @{named_theorems nitpick_psimp})))
+ (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>nitpick_psimp\<close>)))
fun const_choice_spec_table ctxt subst =
map (subst_atomic subst o Thm.prop_of)
- (rev (Named_Theorems.get ctxt @{named_theorems nitpick_choice_spec}))
+ (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>nitpick_choice_spec\<close>))
|> const_nondef_table
fun inductive_intro_table ctxt subst def_tables =
@@ -2008,13 +2008,13 @@
val a_var = Var (("a", 0), abs_T)
val x_var = Var (("x", 0), rep_T)
val y_var = Var (("y", 0), rep_T)
- val x = (@{const_name Quot}, rep_T --> abs_T)
+ val x = (\<^const_name>\<open>Quot\<close>, rep_T --> abs_T)
val sel_a_t = select_nth_constr_arg ctxt x a_var 0 rep_T
val normal_fun =
Const (quot_normal_name_for_type ctxt abs_T, rep_T --> rep_T)
val normal_x = normal_fun $ x_var
val normal_y = normal_fun $ y_var
- val is_unknown_t = Const (@{const_name is_unknown}, rep_T --> bool_T)
+ val is_unknown_t = Const (\<^const_name>\<open>is_unknown\<close>, rep_T --> bool_T)
in
[Logic.mk_equals (normal_fun $ sel_a_t, sel_a_t),
Logic.list_implies
@@ -2033,15 +2033,15 @@
let
val xs = data_type_constrs hol_ctxt T
val pred_T = T --> bool_T
- val iter_T = @{typ bisim_iterator}
+ val iter_T = \<^typ>\<open>bisim_iterator\<close>
val bisim_max = @{const bisim_iterator_max}
val n_var = Var (("n", 0), iter_T)
val n_var_minus_1 =
- Const (@{const_name safe_The}, (iter_T --> bool_T) --> iter_T)
+ Const (\<^const_name>\<open>safe_The\<close>, (iter_T --> bool_T) --> iter_T)
$ Abs ("m", iter_T, HOLogic.eq_const iter_T $ (suc_const iter_T $ Bound 0) $ n_var)
val x_var = Var (("x", 0), T)
val y_var = Var (("y", 0), T)
- fun bisim_const T = Const (@{const_name bisim}, [iter_T, T, T] ---> bool_T)
+ fun bisim_const T = Const (\<^const_name>\<open>bisim\<close>, [iter_T, T, T] ---> bool_T)
fun nth_sub_bisim x n nth_T =
(if is_codatatype ctxt nth_T then bisim_const nth_T $ n_var_minus_1
else HOLogic.eq_const nth_T)
@@ -2124,7 +2124,7 @@
val rel_T = HOLogic.mk_setT (HOLogic.mk_prodT (binders_T, binders_T))
val j = fold Integer.max (map maxidx_of_term intro_ts) 0 + 1
val rel = (("R", j), rel_T)
- val prop = Const (@{const_name wf}, rel_T --> bool_T) $ Var rel ::
+ val prop = Const (\<^const_name>\<open>wf\<close>, rel_T --> bool_T) $ Var rel ::
map (wf_constraint_for_triple rel) triples
|> foldr1 s_conj |> HOLogic.mk_Trueprop
val _ = if debug then
@@ -2156,7 +2156,7 @@
(x as (s, _)) =
case triple_lookup (const_match thy) wfs x of
SOME (SOME b) => b
- | _ => s = @{const_name Nats} orelse s = @{const_name fold_graph'} orelse
+ | _ => s = \<^const_name>\<open>Nats\<close> orelse s = \<^const_name>\<open>fold_graph'\<close> orelse
case AList.lookup (op =) (!wf_cache) x of
SOME (_, wf) => wf
| NONE =>
@@ -2183,14 +2183,14 @@
val is_linear_inductive_pred_def =
let
- fun do_disjunct j (Const (@{const_name Ex}, _) $ Abs (_, _, t2)) =
+ fun do_disjunct j (Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (_, _, t2)) =
do_disjunct (j + 1) t2
| do_disjunct j t =
case num_occs_of_bound_in_term j t of
0 => true
| 1 => exists (curry (op =) (Bound j) o head_of) (conjuncts_of t)
| _ => false
- fun do_lfp_def (Const (@{const_name lfp}, _) $ t2) =
+ fun do_lfp_def (Const (\<^const_name>\<open>lfp\<close>, _) $ t2) =
let val (xs, body) = strip_abs t2 in
case length xs of
1 => false
@@ -2206,14 +2206,14 @@
val linear_pred_base_and_step_rhss =
let
- fun aux (Const (@{const_name lfp}, _) $ t2) =
+ fun aux (Const (\<^const_name>\<open>lfp\<close>, _) $ t2) =
let
val (xs, body) = strip_abs t2
val arg_Ts = map snd (tl xs)
val tuple_T = HOLogic.mk_tupleT arg_Ts
val j = length arg_Ts
- fun repair_rec j (Const (@{const_name Ex}, T1) $ Abs (s2, T2, t2')) =
- Const (@{const_name Ex}, T1)
+ fun repair_rec j (Const (\<^const_name>\<open>Ex\<close>, T1) $ Abs (s2, T2, t2')) =
+ Const (\<^const_name>\<open>Ex\<close>, T1)
$ Abs (s2, T2, repair_rec (j + 1) t2')
| repair_rec j (@{const HOL.conj} $ t1 $ t2) =
@{const HOL.conj} $ repair_rec j t1 $ repair_rec j t2
@@ -2244,7 +2244,7 @@
fun predicatify T t =
let val set_T = HOLogic.mk_setT T in
Abs (Name.uu, T,
- Const (@{const_name Set.member}, T --> set_T --> bool_T)
+ Const (\<^const_name>\<open>Set.member\<close>, T --> set_T --> bool_T)
$ Bound 0 $ incr_boundvars 1 t)
end
@@ -2273,13 +2273,13 @@
val step_eq = HOLogic.mk_eq (list_comb (Const step_x, outer_vars), step_rhs)
|> HOLogic.mk_Trueprop
val _ = add_simps simp_table step_s [step_eq]
- val image_const = Const (@{const_name Image}, rel_T --> set_T --> set_T)
- val rtrancl_const = Const (@{const_name rtrancl}, rel_T --> rel_T)
+ val image_const = Const (\<^const_name>\<open>Image\<close>, rel_T --> set_T --> set_T)
+ val rtrancl_const = Const (\<^const_name>\<open>rtrancl\<close>, rel_T --> rel_T)
val base_set =
HOLogic.Collect_const tuple_T $ list_comb (Const base_x, outer_bounds)
val step_set =
HOLogic.Collect_const prod_T
- $ (Const (@{const_name case_prod}, curried_T --> uncurried_T)
+ $ (Const (\<^const_name>\<open>case_prod\<close>, curried_T --> uncurried_T)
$ list_comb (Const step_x, outer_bounds))
val image_set =
image_const $ (rtrancl_const $ step_set) $ base_set
@@ -2289,7 +2289,7 @@
|> unfold_defs_in_term hol_ctxt
end
-fun is_good_starred_linear_pred_type (Type (@{type_name fun}, Ts)) =
+fun is_good_starred_linear_pred_type (Type (\<^type_name>\<open>fun\<close>, Ts)) =
forall (not o (is_fun_or_set_type orf is_pair_type)) Ts
| is_good_starred_linear_pred_type _ = false
@@ -2374,7 +2374,7 @@
fun is_equational_fun_surely_complete hol_ctxt x =
case equational_fun_axioms hol_ctxt x of
- [@{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ t1 $ _)] =>
+ [@{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ _)] =>
strip_comb t1 |> snd |> forall is_Var
| _ => false
@@ -2405,12 +2405,12 @@
let
fun aux T accum =
case T of
- Type (@{type_name fun}, Ts) => fold aux Ts accum
- | Type (@{type_name prod}, Ts) => fold aux Ts accum
- | Type (@{type_name set}, Ts) => fold aux Ts accum
- | Type (@{type_name itself}, [T1]) => aux T1 accum
+ Type (\<^type_name>\<open>fun\<close>, Ts) => fold aux Ts accum
+ | Type (\<^type_name>\<open>prod\<close>, Ts) => fold aux Ts accum
+ | Type (\<^type_name>\<open>set\<close>, Ts) => fold aux Ts accum
+ | Type (\<^type_name>\<open>itself\<close>, [T1]) => aux T1 accum
| Type (_, Ts) =>
- if member (op =) (@{typ prop} :: @{typ bool} :: accum) T then
+ if member (op =) (\<^typ>\<open>prop\<close> :: \<^typ>\<open>bool\<close> :: accum) T then
accum
else
T :: accum
--- a/src/HOL/Tools/Nitpick/nitpick_kodkod.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_kodkod.ML Fri Jan 04 23:22:53 2019 +0100
@@ -308,7 +308,7 @@
fun bound_for_plain_rel ctxt debug (u as FreeRel (x, T, R, nick)) =
([(x, bound_comment ctxt debug nick T R)],
- if nick = @{const_name bisim_iterator_max} then
+ if nick = \<^const_name>\<open>bisim_iterator_max\<close> then
case R of
Atom (k, j0) => [single_atom (k - 1 + j0)]
| _ => raise NUT ("Nitpick_Kodkod.bound_for_plain_rel", [u])
@@ -336,7 +336,7 @@
| is_sel_of_constr _ _ = false
fun bound_for_sel_rel ctxt debug need_vals dtypes
- (FreeRel (x, T as Type (@{type_name fun}, [T1, T2]),
+ (FreeRel (x, T as Type (\<^type_name>\<open>fun\<close>, [T1, T2]),
R as Func (Atom (_, j0), R2), nick)) =
let
val constr_s = original_name nick
@@ -738,7 +738,7 @@
and rel_expr_to_func kk R1 R2 = rel_expr_from_rel_expr kk (Func (R1, R2))
fun bit_set_from_atom ({kk_join, ...} : kodkod_constrs) T r =
- kk_join r (KK.Rel (if T = @{typ "unsigned_bit word"} then
+ kk_join r (KK.Rel (if T = \<^typ>\<open>unsigned_bit word\<close> then
unsigned_bit_word_sel_rel
else
signed_bit_word_sel_rel))
@@ -930,7 +930,7 @@
(rel_expr_from_rel_expr kk min_R R2 r2))
end
| Cst (Iden, _, Func (Atom (1, j0), Formula Neut)) => KK.Atom j0
- | Cst (Iden, T as Type (@{type_name set}, [T1]), R as Func (R1, _)) =>
+ | Cst (Iden, T as Type (\<^type_name>\<open>set\<close>, [T1]), R as Func (R1, _)) =>
to_rep R (Cst (Iden, T, Func (one_rep ofs T1 R1, Formula Neut)))
| Cst (Num j, T, R) =>
if is_word_type T then
@@ -946,57 +946,57 @@
else raise NUT ("Nitpick_Kodkod.to_r (Num)", [u])
| Cst (Unknown, _, R) => empty_rel_for_rep R
| Cst (Unrep, _, R) => empty_rel_for_rep R
- | Cst (Suc, T as @{typ "unsigned_bit word => unsigned_bit word"}, R) =>
+ | Cst (Suc, T as \<^typ>\<open>unsigned_bit word => unsigned_bit word\<close>, R) =>
to_bit_word_unary_op T R (curry KK.Add (KK.Num 1))
- | Cst (Suc, @{typ "nat => nat"}, Func (Atom x, _)) =>
+ | Cst (Suc, \<^typ>\<open>nat => nat\<close>, Func (Atom x, _)) =>
kk_intersect (KK.Rel suc_rel) (kk_product KK.Univ (KK.AtomSeq x))
| Cst (Suc, _, Func (Atom _, _)) => KK.Rel suc_rel
- | Cst (Add, Type (_, [@{typ nat}, _]), _) => KK.Rel nat_add_rel
- | Cst (Add, Type (_, [@{typ int}, _]), _) => KK.Rel int_add_rel
- | Cst (Add, T as Type (_, [@{typ "unsigned_bit word"}, _]), R) =>
+ | Cst (Add, Type (_, [\<^typ>\<open>nat\<close>, _]), _) => KK.Rel nat_add_rel
+ | Cst (Add, Type (_, [\<^typ>\<open>int\<close>, _]), _) => KK.Rel int_add_rel
+ | Cst (Add, T as Type (_, [\<^typ>\<open>unsigned_bit word\<close>, _]), R) =>
to_bit_word_binary_op T R NONE (SOME (curry KK.Add))
- | Cst (Add, T as Type (_, [@{typ "signed_bit word"}, _]), R) =>
+ | Cst (Add, T as Type (_, [\<^typ>\<open>signed_bit word\<close>, _]), R) =>
to_bit_word_binary_op T R
(SOME (fn i1 => fn i2 => fn i3 =>
kk_implies (KK.LE (KK.Num 0, KK.BitXor (i1, i2)))
(KK.LE (KK.Num 0, KK.BitXor (i2, i3)))))
(SOME (curry KK.Add))
- | Cst (Subtract, Type (_, [@{typ nat}, _]), _) =>
+ | Cst (Subtract, Type (_, [\<^typ>\<open>nat\<close>, _]), _) =>
KK.Rel nat_subtract_rel
- | Cst (Subtract, Type (_, [@{typ int}, _]), _) =>
+ | Cst (Subtract, Type (_, [\<^typ>\<open>int\<close>, _]), _) =>
KK.Rel int_subtract_rel
- | Cst (Subtract, T as Type (_, [@{typ "unsigned_bit word"}, _]), R) =>
+ | Cst (Subtract, T as Type (_, [\<^typ>\<open>unsigned_bit word\<close>, _]), R) =>
to_bit_word_binary_op T R NONE
(SOME (fn i1 => fn i2 =>
KK.IntIf (KK.LE (i1, i2), KK.Num 0, KK.Sub (i1, i2))))
- | Cst (Subtract, T as Type (_, [@{typ "signed_bit word"}, _]), R) =>
+ | Cst (Subtract, T as Type (_, [\<^typ>\<open>signed_bit word\<close>, _]), R) =>
to_bit_word_binary_op T R
(SOME (fn i1 => fn i2 => fn i3 =>
kk_implies (KK.LT (KK.BitXor (i1, i2), KK.Num 0))
(KK.LT (KK.BitXor (i2, i3), KK.Num 0))))
(SOME (curry KK.Sub))
- | Cst (Multiply, Type (_, [@{typ nat}, _]), _) =>
+ | Cst (Multiply, Type (_, [\<^typ>\<open>nat\<close>, _]), _) =>
KK.Rel nat_multiply_rel
- | Cst (Multiply, Type (_, [@{typ int}, _]), _) =>
+ | Cst (Multiply, Type (_, [\<^typ>\<open>int\<close>, _]), _) =>
KK.Rel int_multiply_rel
| Cst (Multiply,
- T as Type (_, [Type (@{type_name word}, [bit_T]), _]), R) =>
+ T as Type (_, [Type (\<^type_name>\<open>word\<close>, [bit_T]), _]), R) =>
to_bit_word_binary_op T R
(SOME (fn i1 => fn i2 => fn i3 =>
kk_or (KK.IntEq (i2, KK.Num 0))
(KK.IntEq (KK.Div (i3, i2), i1)
- |> bit_T = @{typ signed_bit}
+ |> bit_T = \<^typ>\<open>signed_bit\<close>
? kk_and (KK.LE (KK.Num 0,
foldl1 KK.BitAnd [i1, i2, i3])))))
(SOME (curry KK.Mult))
- | Cst (Divide, Type (_, [@{typ nat}, _]), _) => KK.Rel nat_divide_rel
- | Cst (Divide, Type (_, [@{typ int}, _]), _) => KK.Rel int_divide_rel
- | Cst (Divide, T as Type (_, [@{typ "unsigned_bit word"}, _]), R) =>
+ | Cst (Divide, Type (_, [\<^typ>\<open>nat\<close>, _]), _) => KK.Rel nat_divide_rel
+ | Cst (Divide, Type (_, [\<^typ>\<open>int\<close>, _]), _) => KK.Rel int_divide_rel
+ | Cst (Divide, T as Type (_, [\<^typ>\<open>unsigned_bit word\<close>, _]), R) =>
to_bit_word_binary_op T R NONE
(SOME (fn i1 => fn i2 =>
KK.IntIf (KK.IntEq (i2, KK.Num 0),
KK.Num 0, KK.Div (i1, i2))))
- | Cst (Divide, T as Type (_, [@{typ "signed_bit word"}, _]), R) =>
+ | Cst (Divide, T as Type (_, [\<^typ>\<open>signed_bit word\<close>, _]), R) =>
to_bit_word_binary_op T R
(SOME (fn i1 => fn i2 => fn i3 =>
KK.LE (KK.Num 0, foldl1 KK.BitAnd [i1, i2, i3])))
@@ -1015,9 +1015,9 @@
| Cst (Fracs, _, Func (Struct _, _)) =>
kk_project_seq (KK.Rel norm_frac_rel) 2 2
| Cst (NormFrac, _, _) => KK.Rel norm_frac_rel
- | Cst (NatToInt, Type (_, [@{typ nat}, _]), Func (Atom _, Atom _)) =>
+ | Cst (NatToInt, Type (_, [\<^typ>\<open>nat\<close>, _]), Func (Atom _, Atom _)) =>
KK.Iden
- | Cst (NatToInt, Type (_, [@{typ nat}, _]),
+ | Cst (NatToInt, Type (_, [\<^typ>\<open>nat\<close>, _]),
Func (Atom (_, nat_j0), Opt (Atom (int_k, int_j0)))) =>
if nat_j0 = int_j0 then
kk_intersect KK.Iden
@@ -1025,9 +1025,9 @@
KK.Univ)
else
raise BAD ("Nitpick_Kodkod.to_r (NatToInt)", "\"nat_j0 <> int_j0\"")
- | Cst (NatToInt, T as Type (_, [@{typ "unsigned_bit word"}, _]), R) =>
+ | Cst (NatToInt, T as Type (_, [\<^typ>\<open>unsigned_bit word\<close>, _]), R) =>
to_bit_word_unary_op T R I
- | Cst (IntToNat, Type (_, [@{typ int}, _]),
+ | Cst (IntToNat, Type (_, [\<^typ>\<open>int\<close>, _]),
Func (Atom (int_k, int_j0), nat_R)) =>
let
val abs_card = max_int_for_card int_k + 1
@@ -1043,7 +1043,7 @@
else
raise BAD ("Nitpick_Kodkod.to_r (IntToNat)", "\"nat_j0 <> int_j0\"")
end
- | Cst (IntToNat, T as Type (_, [@{typ "signed_bit word"}, _]), R) =>
+ | Cst (IntToNat, T as Type (_, [\<^typ>\<open>signed_bit word\<close>, _]), R) =>
to_bit_word_unary_op T R
(fn i => KK.IntIf (KK.LE (i, KK.Num 0), KK.Num 0, i))
| Op1 (Not, _, R, u1) => kk_not3 (to_rep R u1)
@@ -1147,11 +1147,11 @@
else kk_rel_if (to_f u1) (to_r u2) false_atom
| Op2 (Less, _, _, u1, u2) =>
(case type_of u1 of
- @{typ nat} =>
+ \<^typ>\<open>nat\<close> =>
if is_Cst Unrep u1 then to_compare_with_unrep u2 false_atom
else if is_Cst Unrep u2 then to_compare_with_unrep u1 true_atom
else kk_nat_less (to_integer u1) (to_integer u2)
- | @{typ int} => kk_int_less (to_integer u1) (to_integer u2)
+ | \<^typ>\<open>int\<close> => kk_int_less (to_integer u1) (to_integer u2)
| _ =>
let
val R1 = Opt (Atom (card_of_rep (rep_of u1),
@@ -1219,7 +1219,7 @@
| _ => raise NUT ("Nitpick_Kodkod.to_r (Composition)", [u]))
|> rel_expr_from_rel_expr kk R (Func (Struct [a_R, c_R], body_R))
end
- | Op2 (Apply, @{typ nat}, _,
+ | Op2 (Apply, \<^typ>\<open>nat\<close>, _,
Op2 (Apply, _, _, Cst (Subtract, _, _), u1), u2) =>
if is_Cst Unrep u2 andalso not (is_opt_rep (rep_of u1)) then
KK.Atom (offset_of_type ofs nat_T)
@@ -1452,7 +1452,7 @@
in to_f_with_polarity Pos u end
fun declarative_axiom_for_plain_rel kk (FreeRel (x, _, R as Func _, nick)) =
- kk_n_ary_function kk (R |> nick = @{const_name List.set} ? unopt_rep)
+ kk_n_ary_function kk (R |> nick = \<^const_name>\<open>List.set\<close> ? unopt_rep)
(KK.Rel x)
| declarative_axiom_for_plain_rel ({kk_lone, kk_one, ...} : kodkod_constrs)
(FreeRel (x, _, R, _)) =
--- a/src/HOL/Tools/Nitpick/nitpick_model.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_model.ML Fri Jan 04 23:22:53 2019 +0100
@@ -94,23 +94,23 @@
val name_of = fst o dest_Const
val thy = Proof_Context.theory_of ctxt
val (unrep_s, thy) = thy
- |> Sign.declare_const_global ((@{binding nitpick_unrep}, @{typ 'a}),
+ |> Sign.declare_const_global ((\<^binding>\<open>nitpick_unrep\<close>, \<^typ>\<open>'a\<close>),
mixfix (unrep_mixfix (), [], 1000))
|>> name_of
val (maybe_s, thy) = thy
- |> Sign.declare_const_global ((@{binding nitpick_maybe}, @{typ "'a => 'a"}),
+ |> Sign.declare_const_global ((\<^binding>\<open>nitpick_maybe\<close>, \<^typ>\<open>'a => 'a\<close>),
mixfix (maybe_mixfix (), [1000], 1000))
|>> name_of
val (abs_s, thy) = thy
- |> Sign.declare_const_global ((@{binding nitpick_abs}, @{typ "'a => 'b"}),
+ |> Sign.declare_const_global ((\<^binding>\<open>nitpick_abs\<close>, \<^typ>\<open>'a => 'b\<close>),
mixfix (abs_mixfix (), [40], 40))
|>> name_of
val (base_s, thy) = thy
- |> Sign.declare_const_global ((@{binding nitpick_base}, @{typ "'a => 'a"}),
+ |> Sign.declare_const_global ((\<^binding>\<open>nitpick_base\<close>, \<^typ>\<open>'a => 'a\<close>),
mixfix (base_mixfix (), [1000], 1000))
|>> name_of
val (step_s, thy) = thy
- |> Sign.declare_const_global ((@{binding nitpick_step}, @{typ "'a => 'a"}),
+ |> Sign.declare_const_global ((\<^binding>\<open>nitpick_step\<close>, \<^typ>\<open>'a => 'a\<close>),
mixfix (step_mixfix (), [1000], 1000))
|>> name_of
in
@@ -145,7 +145,7 @@
Type (s, _) =>
let val s' = shortest_name s in
prefix ^
- (if T = @{typ string} then "s"
+ (if T = \<^typ>\<open>string\<close> then "s"
else if String.isPrefix "\\" s' then s'
else substring (s', 0, 1)) ^ atom_suffix s m
end
@@ -156,7 +156,7 @@
fun nth_atom thy atomss pool T j =
Const (nth_atom_name thy atomss pool "" T j, T)
-fun extract_real_number (Const (@{const_name divide}, _) $ t1 $ t2) =
+fun extract_real_number (Const (\<^const_name>\<open>divide\<close>, _) $ t1 $ t2) =
real (snd (HOLogic.dest_number t1)) / real (snd (HOLogic.dest_number t2))
| extract_real_number t = real (snd (HOLogic.dest_number t))
@@ -192,14 +192,14 @@
fun tuple_list_for_name rel_table bounds name =
the (AList.lookup (op =) bounds (the_rel rel_table name)) handle NUT _ => [[]]
-fun unarize_unbox_etc_term (Const (@{const_name FunBox}, _) $ t1) =
+fun unarize_unbox_etc_term (Const (\<^const_name>\<open>FunBox\<close>, _) $ t1) =
unarize_unbox_etc_term t1
| unarize_unbox_etc_term
- (Const (@{const_name PairBox},
- Type (@{type_name fun}, [T1, Type (@{type_name fun}, [T2, _])]))
+ (Const (\<^const_name>\<open>PairBox\<close>,
+ Type (\<^type_name>\<open>fun\<close>, [T1, Type (\<^type_name>\<open>fun\<close>, [T2, _])]))
$ t1 $ t2) =
let val Ts = map uniterize_unarize_unbox_etc_type [T1, T2] in
- Const (@{const_name Pair}, Ts ---> Type (@{type_name prod}, Ts))
+ Const (\<^const_name>\<open>Pair\<close>, Ts ---> Type (\<^type_name>\<open>prod\<close>, Ts))
$ unarize_unbox_etc_term t1 $ unarize_unbox_etc_term t2
end
| unarize_unbox_etc_term (Const (s, T)) =
@@ -214,27 +214,27 @@
| unarize_unbox_etc_term (Abs (s, T, t')) =
Abs (s, uniterize_unarize_unbox_etc_type T, unarize_unbox_etc_term t')
-fun factor_out_types (T1 as Type (@{type_name prod}, [T11, T12]))
- (T2 as Type (@{type_name prod}, [T21, T22])) =
+fun factor_out_types (T1 as Type (\<^type_name>\<open>prod\<close>, [T11, T12]))
+ (T2 as Type (\<^type_name>\<open>prod\<close>, [T21, T22])) =
let val (n1, n2) = apply2 num_factors_in_type (T11, T21) in
if n1 = n2 then
let
val ((T11', opt_T12'), (T21', opt_T22')) = factor_out_types T12 T22
in
- ((Type (@{type_name prod}, [T11, T11']), opt_T12'),
- (Type (@{type_name prod}, [T21, T21']), opt_T22'))
+ ((Type (\<^type_name>\<open>prod\<close>, [T11, T11']), opt_T12'),
+ (Type (\<^type_name>\<open>prod\<close>, [T21, T21']), opt_T22'))
end
else if n1 < n2 then
case factor_out_types T1 T21 of
(p1, (T21', NONE)) => (p1, (T21', SOME T22))
| (p1, (T21', SOME T22')) =>
- (p1, (T21', SOME (Type (@{type_name prod}, [T22', T22]))))
+ (p1, (T21', SOME (Type (\<^type_name>\<open>prod\<close>, [T22', T22]))))
else
swap (factor_out_types T2 T1)
end
- | factor_out_types (Type (@{type_name prod}, [T11, T12])) T2 =
+ | factor_out_types (Type (\<^type_name>\<open>prod\<close>, [T11, T12])) T2 =
((T11, SOME T12), (T2, NONE))
- | factor_out_types T1 (Type (@{type_name prod}, [T21, T22])) =
+ | factor_out_types T1 (Type (\<^type_name>\<open>prod\<close>, [T21, T22])) =
((T1, NONE), (T21, SOME T22))
| factor_out_types T1 T2 = ((T1, NONE), (T2, NONE))
@@ -245,19 +245,19 @@
fun aux T1 T2 [] =
Const (if maybe_opt then opt_flag else non_opt_flag, T1 --> T2)
| aux T1 T2 ((t1, t2) :: tps) =
- Const (@{const_name fun_upd}, (T1 --> T2) --> T1 --> T2 --> T1 --> T2)
+ Const (\<^const_name>\<open>fun_upd\<close>, (T1 --> T2) --> T1 --> T2 --> T1 --> T2)
$ aux T1 T2 tps $ t1 $ t2
in aux T1 T2 o rev end
fun is_plain_fun (Const (s, _)) = (s = opt_flag orelse s = non_opt_flag)
- | is_plain_fun (Const (@{const_name fun_upd}, _) $ t0 $ _ $ _) =
+ | is_plain_fun (Const (\<^const_name>\<open>fun_upd\<close>, _) $ t0 $ _ $ _) =
is_plain_fun t0
| is_plain_fun _ = false
val dest_plain_fun =
let
fun aux (Abs (_, _, Const (s, _))) = (s <> irrelevant, ([], []))
| aux (Const (s, _)) = (s <> non_opt_flag, ([], []))
- | aux (Const (@{const_name fun_upd}, _) $ t0 $ t1 $ t2) =
+ | aux (Const (\<^const_name>\<open>fun_upd\<close>, _) $ t0 $ t1 $ t2) =
let val (maybe_opt, (ts1, ts2)) = aux t0 in
(maybe_opt, (t1 :: ts1, t2 :: ts2))
end
@@ -272,10 +272,10 @@
val (ts1, ts2) = t |> HOLogic.strip_ptuple ps |> chop cut
in (HOLogic.mk_ptuple ps1 T1 ts1, HOLogic.mk_ptuple ps2 T2 ts2) end
-fun pair_up (Type (@{type_name prod}, [T1', T2']))
- (t1 as Const (@{const_name Pair},
- Type (@{type_name fun},
- [_, Type (@{type_name fun}, [_, T1])]))
+fun pair_up (Type (\<^type_name>\<open>prod\<close>, [T1', T2']))
+ (t1 as Const (\<^const_name>\<open>Pair\<close>,
+ Type (\<^type_name>\<open>fun\<close>,
+ [_, Type (\<^type_name>\<open>fun\<close>, [_, T1])]))
$ t11 $ t12) t2 =
if T1 = T1' then HOLogic.mk_prod (t1, t2)
else HOLogic.mk_prod (t11, pair_up T2' t12 t2)
@@ -306,8 +306,8 @@
in make_plain_fun maybe_opt T1 T2 tps end
and do_arrow T1' T2' _ _ (Const (s, _)) = Const (s, T1' --> T2')
| do_arrow T1' T2' T1 T2
- (Const (@{const_name fun_upd}, _) $ t0 $ t1 $ t2) =
- Const (@{const_name fun_upd},
+ (Const (\<^const_name>\<open>fun_upd\<close>, _) $ t0 $ t1 $ t2) =
+ Const (\<^const_name>\<open>fun_upd\<close>,
(T1' --> T2') --> T1' --> T2' --> T1' --> T2')
$ do_arrow T1' T2' T1 T2 t0 $ do_term T1' T1 t1 $ do_term T2' T2 t2
| do_arrow _ _ _ _ t =
@@ -320,13 +320,13 @@
| ((T1a', SOME T1b'), (_, NONE)) =>
t |> do_arrow T1a' (T1b' --> T2') T1 T2 |> do_uncurry T1' T2'
| _ => raise TYPE ("Nitpick_Model.format_fun.do_fun", [T1, T1'], [])
- and do_term (Type (@{type_name fun}, [T1', T2']))
- (Type (@{type_name fun}, [T1, T2])) t =
+ and do_term (Type (\<^type_name>\<open>fun\<close>, [T1', T2']))
+ (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) t =
do_fun T1' T2' T1 T2 t
- | do_term (T' as Type (@{type_name prod}, Ts' as [T1', T2']))
- (Type (@{type_name prod}, [T1, T2]))
- (Const (@{const_name Pair}, _) $ t1 $ t2) =
- Const (@{const_name Pair}, Ts' ---> T')
+ | do_term (T' as Type (\<^type_name>\<open>prod\<close>, Ts' as [T1', T2']))
+ (Type (\<^type_name>\<open>prod\<close>, [T1, T2]))
+ (Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2) =
+ Const (\<^const_name>\<open>Pair\<close>, Ts' ---> T')
$ do_term T1' T1 t1 $ do_term T2' T2 t2
| do_term T' T t =
if T = T' then t
@@ -337,7 +337,7 @@
| truth_const_sort_key @{const False} = "2"
| truth_const_sort_key _ = "1"
-fun mk_tuple (Type (@{type_name prod}, [T1, T2])) ts =
+fun mk_tuple (Type (\<^type_name>\<open>prod\<close>, [T1, T2])) ts =
HOLogic.mk_prod (mk_tuple T1 ts,
mk_tuple T2 (List.drop (ts, length (HOLogic.flatten_tupleT T1))))
| mk_tuple _ (t :: _) = t
@@ -375,7 +375,7 @@
let
fun value_of_bits jss =
let
- val j0 = offset_of_type ofs @{typ unsigned_bit}
+ val j0 = offset_of_type ofs \<^typ>\<open>unsigned_bit\<close>
val js = map (Integer.add (~ j0) o the_single) jss
in
fold (fn j => Integer.add (reasonable_power 2 j |> j = bits ? op ~))
@@ -384,7 +384,7 @@
val all_values =
all_values_of_type pool wacky_names scope atomss sel_names rel_table
bounds 0
- fun postprocess_term (Type (@{type_name fun}, _)) = I
+ fun postprocess_term (Type (\<^type_name>\<open>fun\<close>, _)) = I
| postprocess_term T =
case Data.get (Context.Proof ctxt) of
[] => I
@@ -402,8 +402,8 @@
fun make_set maybe_opt T tps =
let
val set_T = HOLogic.mk_setT T
- val empty_const = Const (@{const_abbrev Set.empty}, set_T)
- val insert_const = Const (@{const_name insert}, T --> set_T --> set_T)
+ val empty_const = Const (\<^const_abbrev>\<open>Set.empty\<close>, set_T)
+ val insert_const = Const (\<^const_name>\<open>insert\<close>, T --> set_T --> set_T)
fun aux [] =
if maybe_opt andalso not (is_complete_type data_types false T) then
insert_const $ Const (unrep_name, T) $ empty_const
@@ -426,26 +426,26 @@
end
fun make_map maybe_opt T1 T2 T2' =
let
- val update_const = Const (@{const_name fun_upd},
+ val update_const = Const (\<^const_name>\<open>fun_upd\<close>,
(T1 --> T2) --> T1 --> T2 --> T1 --> T2)
- fun aux' [] = Const (@{const_abbrev Map.empty}, T1 --> T2)
+ fun aux' [] = Const (\<^const_abbrev>\<open>Map.empty\<close>, T1 --> T2)
| aux' ((t1, t2) :: tps) =
(case t2 of
- Const (@{const_name None}, _) => aux' tps
+ Const (\<^const_name>\<open>None\<close>, _) => aux' tps
| _ => update_const $ aux' tps $ t1 $ t2)
fun aux tps =
if maybe_opt andalso not (is_complete_type data_types false T1) then
update_const $ aux' tps $ Const (unrep_name, T1)
- $ (Const (@{const_name Some}, T2' --> T2) $ Const (unknown, T2'))
+ $ (Const (\<^const_name>\<open>Some\<close>, T2' --> T2) $ Const (unknown, T2'))
else
aux' tps
in aux end
fun polish_funs Ts t =
(case fastype_of1 (Ts, t) of
- Type (@{type_name fun}, [T1, T2]) =>
+ Type (\<^type_name>\<open>fun\<close>, [T1, T2]) =>
if is_plain_fun t then
case T2 of
- Type (@{type_name option}, [T2']) =>
+ Type (\<^type_name>\<open>option\<close>, [T2']) =>
let
val (maybe_opt, ts_pair) =
dest_plain_fun t ||> apply2 (map (polish_funs Ts))
@@ -456,13 +456,13 @@
| _ => raise SAME ())
handle SAME () =>
case t of
- (t1 as Const (@{const_name fun_upd}, _) $ t11 $ _)
+ (t1 as Const (\<^const_name>\<open>fun_upd\<close>, _) $ t11 $ _)
$ (t2 as Const (s, _)) =>
if s = unknown then polish_funs Ts t11
else polish_funs Ts t1 $ polish_funs Ts t2
| t1 $ t2 => polish_funs Ts t1 $ polish_funs Ts t2
| Abs (s, T, t') => Abs (s, T, polish_funs (T :: Ts) t')
- | Const (s, Type (@{type_name fun}, [T1, T2])) =>
+ | Const (s, Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =>
if s = opt_flag orelse s = non_opt_flag then
Abs ("x", T1,
Const (if is_complete_type data_types false T1 then
@@ -476,7 +476,7 @@
ts1 ~~ ts2
|> sort (nice_term_ord o apply2 fst)
|> (case T of
- Type (@{type_name set}, _) =>
+ Type (\<^type_name>\<open>set\<close>, _) =>
sort_by (truth_const_sort_key o snd)
#> make_set maybe_opt T'
| _ =>
@@ -499,11 +499,11 @@
signed_string_of_int j ^ " for " ^
string_for_rep (Vect (k1, Atom (k2, 0))))
end
- and term_for_atom seen (T as Type (@{type_name fun}, _)) T' j _ =
+ and term_for_atom seen (T as Type (\<^type_name>\<open>fun\<close>, _)) T' j _ =
term_for_fun_or_set seen T T' j
- | term_for_atom seen (T as Type (@{type_name set}, _)) T' j _ =
+ | term_for_atom seen (T as Type (\<^type_name>\<open>set\<close>, _)) T' j _ =
term_for_fun_or_set seen T T' j
- | term_for_atom seen (Type (@{type_name prod}, [T1, T2])) _ j k =
+ | term_for_atom seen (Type (\<^type_name>\<open>prod\<close>, [T1, T2])) _ j k =
let
val k1 = card_of_type card_assigns T1
val k2 = k div k1
@@ -513,9 +513,9 @@
(* ### k2 or k1? FIXME *)
[j div k2, j mod k2] [k1, k2])
end
- | term_for_atom seen @{typ prop} _ j k =
+ | term_for_atom seen \<^typ>\<open>prop\<close> _ j k =
HOLogic.mk_Trueprop (term_for_atom seen bool_T bool_T j k)
- | term_for_atom _ @{typ bool} _ j _ =
+ | term_for_atom _ \<^typ>\<open>bool\<close> _ j _ =
if j = 0 then @{const False} else @{const True}
| term_for_atom seen T _ j k =
if T = nat_T then
@@ -524,7 +524,7 @@
HOLogic.mk_number int_T (int_for_atom (k, 0) j)
else if is_fp_iterator_type T then
HOLogic.mk_number nat_T (k - j - 1)
- else if T = @{typ bisim_iterator} then
+ else if T = \<^typ>\<open>bisim_iterator\<close> then
HOLogic.mk_number nat_T j
else case data_type_spec data_types T of
NONE => nth_atom thy atomss pool T j
@@ -567,9 +567,9 @@
if co andalso not (null seen) andalso
member (op =) (seen |> unfold ? (fst o split_last)) (T, j) then
cyclic_var ()
- else if constr_s = @{const_name Word} then
+ else if constr_s = \<^const_name>\<open>Word\<close> then
HOLogic.mk_number
- (if T = @{typ "unsigned_bit word"} then nat_T else int_T)
+ (if T = \<^typ>\<open>unsigned_bit word\<close> then nat_T else int_T)
(value_of_bits (the_single arg_jsss))
else
let
@@ -583,14 +583,14 @@
|> mk_tuple (HOLogic.mk_tupleT uncur_arg_Ts)
|> dest_n_tuple (length uncur_arg_Ts)
val t =
- if constr_s = @{const_name Abs_Frac} then
+ if constr_s = \<^const_name>\<open>Abs_Frac\<close> then
case ts of
- [Const (@{const_name Pair}, _) $ t1 $ t2] =>
+ [Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2] =>
frac_from_term_pair (body_type T) t1 t2
| _ => raise TERM ("Nitpick_Model.reconstruct_term.\
\term_for_atom (Abs_Frac)", ts)
else if is_abs_fun ctxt constr_x orelse
- constr_s = @{const_name Quot} then
+ constr_s = \<^const_name>\<open>Quot\<close> then
Const (abs_name, constr_T) $ the_single ts
else
list_comb (Const constr_x, ts)
@@ -599,9 +599,9 @@
let val var = cyclic_var () in
if exists_subterm (curry (op =) var) t then
if co then
- Const (@{const_name The}, (T --> bool_T) --> T)
+ Const (\<^const_name>\<open>The\<close>, (T --> bool_T) --> T)
$ Abs (cyclic_co_val_name (), T,
- Const (@{const_name HOL.eq}, T --> T --> bool_T)
+ Const (\<^const_name>\<open>HOL.eq\<close>, T --> T --> bool_T)
$ Bound 0 $ abstract_over (var, t))
else
cyclic_atom ()
@@ -625,7 +625,7 @@
and term_for_rep _ seen T T' (R as Atom (k, j0)) [[j]] =
if j >= j0 andalso j < j0 + k then term_for_atom seen T T' (j - j0) k
else raise REP ("Nitpick_Model.reconstruct_term.term_for_rep", [R])
- | term_for_rep _ seen (Type (@{type_name prod}, [T1, T2])) _
+ | term_for_rep _ seen (Type (\<^type_name>\<open>prod\<close>, [T1, T2])) _
(Struct [R1, R2]) [js] =
let
val arity1 = arity_of_rep R1
@@ -857,8 +857,8 @@
(** Model reconstruction **)
-fun unfold_outer_the_binders (t as Const (@{const_name The}, _)
- $ Abs (s, T, Const (@{const_name HOL.eq}, _)
+fun unfold_outer_the_binders (t as Const (\<^const_name>\<open>The\<close>, _)
+ $ Abs (s, T, Const (\<^const_name>\<open>HOL.eq\<close>, _)
$ Bound 0 $ t')) =
betapply (Abs (s, T, t'), t) |> unfold_outer_the_binders
| unfold_outer_the_binders t = t
@@ -886,7 +886,7 @@
fun add_fake_const s =
Symbol_Pos.is_identifier s
- ? (#2 o Sign.declare_const_global ((Binding.name s, @{typ 'a}), NoSyn))
+ ? (#2 o Sign.declare_const_global ((Binding.name s, \<^typ>\<open>'a\<close>), NoSyn))
val globals = Term.add_const_names t []
|> filter_out (String.isSubstring Long_Name.separator)
@@ -961,7 +961,7 @@
| _ => raise NUT ("Nitpick_Model.reconstruct_hol_model.\
\pretty_for_assign", [name])
val t2 = if rep_of name = Any then
- Const (@{const_name undefined}, T')
+ Const (\<^const_name>\<open>undefined\<close>, T')
else
tuple_list_for_name rel_table bounds name
|> term_for_rep (not (is_fully_representable_set name)) false
@@ -975,8 +975,8 @@
Pretty.block (Pretty.breaks
(pretty_for_type ctxt typ ::
(case typ of
- Type (@{type_name fun_box}, _) => [Pretty.str "[boxed]"]
- | Type (@{type_name pair_box}, _) => [Pretty.str "[boxed]"]
+ Type (\<^type_name>\<open>fun_box\<close>, _) => [Pretty.str "[boxed]"]
+ | Type (\<^type_name>\<open>pair_box\<close>, _) => [Pretty.str "[boxed]"]
| _ => []) @
[Pretty.str "=",
Pretty.enum "," "{" "}"
@@ -1017,8 +1017,8 @@
val (eval_names, noneval_nonskolem_nonsel_names) =
List.partition (String.isPrefix eval_prefix o nickname_of)
nonskolem_nonsel_names
- ||> filter_out (member (op =) [@{const_name bisim},
- @{const_name bisim_iterator_max}]
+ ||> filter_out (member (op =) [\<^const_name>\<open>bisim\<close>,
+ \<^const_name>\<open>bisim_iterator_max\<close>]
o nickname_of)
||> append (map_filter (free_name_for_term false) pseudo_frees)
val real_free_names = map_filter (free_name_for_term true) real_frees
--- a/src/HOL/Tools/Nitpick/nitpick_mono.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_mono.ML Fri Jan 04 23:22:53 2019 +0100
@@ -77,7 +77,7 @@
string_for_var x ^ (case sn of Plus => " = " | Minus => " \<noteq> ") ^
string_for_annotation a
-val bool_M = MType (@{type_name bool}, [])
+val bool_M = MType (\<^type_name>\<open>bool\<close>, [])
val dummy_M = MType (nitpick_prefix ^ "dummy", [])
fun is_MRec (MRec _) = true
@@ -109,7 +109,7 @@
string_for_annotation_atom aa ^ "\<^esup> " ^ aux prec M2
| MPair (M1, M2) => aux (prec + 1) M1 ^ " \<times> " ^ aux prec M2
| MType (s, []) =>
- if s = @{type_name prop} orelse s = @{type_name bool} then "o"
+ if s = \<^type_name>\<open>prop\<close> orelse s = \<^type_name>\<open>bool\<close> then "o"
else s
| MType (s, Ms) => "(" ^ commas (map (aux 0) Ms) ^ ") " ^ s
| MRec (s, _) => "[" ^ s ^ "]") ^
@@ -184,25 +184,25 @@
(AList.update (op =) (x, repair_mtype dtype_cache [] M))
in List.app repair_one (!constr_mcache) end
-fun is_fin_fun_supported_type @{typ prop} = true
- | is_fin_fun_supported_type @{typ bool} = true
- | is_fin_fun_supported_type (Type (@{type_name option}, _)) = true
+fun is_fin_fun_supported_type \<^typ>\<open>prop\<close> = true
+ | is_fin_fun_supported_type \<^typ>\<open>bool\<close> = true
+ | is_fin_fun_supported_type (Type (\<^type_name>\<open>option\<close>, _)) = true
| is_fin_fun_supported_type _ = false
(* TODO: clean this up *)
-fun fin_fun_body _ _ (t as @{term False}) = SOME t
- | fin_fun_body _ _ (t as Const (@{const_name None}, _)) = SOME t
+fun fin_fun_body _ _ (t as \<^term>\<open>False\<close>) = SOME t
+ | fin_fun_body _ _ (t as Const (\<^const_name>\<open>None\<close>, _)) = SOME t
| fin_fun_body dom_T ran_T
- ((t0 as Const (@{const_name If}, _))
- $ (t1 as Const (@{const_name HOL.eq}, _) $ Bound 0 $ t1')
+ ((t0 as Const (\<^const_name>\<open>If\<close>, _))
+ $ (t1 as Const (\<^const_name>\<open>HOL.eq\<close>, _) $ Bound 0 $ t1')
$ t2 $ t3) =
(if loose_bvar1 (t1', 0) then
NONE
else case fin_fun_body dom_T ran_T t3 of
NONE => NONE
| SOME t3 =>
- SOME (t0 $ (Const (@{const_name is_unknown}, dom_T --> bool_T) $ t1')
- $ (Const (@{const_name unknown}, ran_T)) $ (t0 $ t1 $ t2 $ t3)))
+ SOME (t0 $ (Const (\<^const_name>\<open>is_unknown\<close>, dom_T --> bool_T) $ t1')
+ $ (Const (\<^const_name>\<open>unknown\<close>, ran_T)) $ (t0 $ t1 $ t2 $ t3)))
| fin_fun_body _ _ _ = NONE
(* FIXME: make sure well-annotated *)
@@ -226,10 +226,10 @@
if T = alpha_T then
MAlpha
else case T of
- Type (@{type_name fun}, [T1, T2]) =>
+ Type (\<^type_name>\<open>fun\<close>, [T1, T2]) =>
MFun (fresh_mfun_for_fun_type mdata all_minus T1 T2)
- | Type (@{type_name prod}, [T1, T2]) => MPair (apply2 do_type (T1, T2))
- | Type (@{type_name set}, [T']) => do_type (T' --> bool_T)
+ | Type (\<^type_name>\<open>prod\<close>, [T1, T2]) => MPair (apply2 do_type (T1, T2))
+ | Type (\<^type_name>\<open>set\<close>, [T']) => do_type (T' --> bool_T)
| Type (z as (s, _)) =>
if could_exist_alpha_sub_mtype ctxt alpha_T T then
case AList.lookup (op =) (!data_type_mcache) z of
@@ -800,10 +800,10 @@
let
val set_T = domain_type T
val set_M = mtype_for set_T
- fun custom_mtype_for (T as Type (@{type_name fun}, [T1, T2])) =
+ fun custom_mtype_for (T as Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
if T = set_T then set_M
else MFun (custom_mtype_for T1, A Gen, custom_mtype_for T2)
- | custom_mtype_for (Type (@{type_name set}, [T'])) =
+ | custom_mtype_for (Type (\<^type_name>\<open>set\<close>, [T'])) =
custom_mtype_for (T' --> bool_T)
| custom_mtype_for T = mtype_for T
in
@@ -830,12 +830,12 @@
" : _?");
case t of
@{const False} => (bool_M, accum ||> add_comp_frame (A Fls) Leq frame)
- | Const (@{const_name None}, T) =>
+ | Const (\<^const_name>\<open>None\<close>, T) =>
(mtype_for T, accum ||> add_comp_frame (A Fls) Leq frame)
| @{const True} => (bool_M, accum ||> add_comp_frame (A Tru) Leq frame)
- | (t0 as Const (@{const_name HOL.eq}, _)) $ Bound 0 $ t2 =>
+ | (t0 as Const (\<^const_name>\<open>HOL.eq\<close>, _)) $ Bound 0 $ t2 =>
(* hack to exploit symmetry of equality when typing "insert" *)
- (if t2 = Bound 0 then do_term @{term True}
+ (if t2 = Bound 0 then do_term \<^term>\<open>True\<close>
else do_term (t0 $ t2 $ Bound 0)) accum
| Const (x as (s, T)) =>
(case AList.lookup (op =) consts x of
@@ -844,10 +844,10 @@
if not (could_exist_alpha_subtype alpha_T T) then
(mtype_for T, accum)
else case s of
- @{const_name Pure.all} => do_all T accum
- | @{const_name Pure.eq} => do_equals T accum
- | @{const_name All} => do_all T accum
- | @{const_name Ex} =>
+ \<^const_name>\<open>Pure.all\<close> => do_all T accum
+ | \<^const_name>\<open>Pure.eq\<close> => do_equals T accum
+ | \<^const_name>\<open>All\<close> => do_all T accum
+ | \<^const_name>\<open>Ex\<close> =>
let val set_T = domain_type T in
do_term (Abs (Name.uu, set_T,
@{const Not} $ (HOLogic.mk_eq
@@ -855,20 +855,20 @@
@{const False}),
Bound 0)))) accum
end
- | @{const_name HOL.eq} => do_equals T accum
- | @{const_name The} =>
+ | \<^const_name>\<open>HOL.eq\<close> => do_equals T accum
+ | \<^const_name>\<open>The\<close> =>
(trace_msg (K "*** The"); raise UNSOLVABLE ())
- | @{const_name Eps} =>
+ | \<^const_name>\<open>Eps\<close> =>
(trace_msg (K "*** Eps"); raise UNSOLVABLE ())
- | @{const_name If} =>
+ | \<^const_name>\<open>If\<close> =>
do_robust_set_operation (range_type T) accum
|>> curry3 MFun bool_M (A Gen)
- | @{const_name Pair} => do_pair_constr T accum
- | @{const_name fst} => do_nth_pair_sel 0 T accum
- | @{const_name snd} => do_nth_pair_sel 1 T accum
- | @{const_name Id} =>
+ | \<^const_name>\<open>Pair\<close> => do_pair_constr T accum
+ | \<^const_name>\<open>fst\<close> => do_nth_pair_sel 0 T accum
+ | \<^const_name>\<open>snd\<close> => do_nth_pair_sel 1 T accum
+ | \<^const_name>\<open>Id\<close> =>
(MFun (mtype_for (elem_type T), A Gen, bool_M), accum)
- | @{const_name converse} =>
+ | \<^const_name>\<open>converse\<close> =>
let
val x = Unsynchronized.inc max_fresh
val ab_set_M = domain_type T |> mtype_for_set x
@@ -877,8 +877,8 @@
(MFun (ab_set_M, A Gen, ba_set_M),
accum ||> add_annotation_atom_comp Neq [] (V x) (A New))
end
- | @{const_name trancl} => do_fragile_set_operation T accum
- | @{const_name relcomp} =>
+ | \<^const_name>\<open>trancl\<close> => do_fragile_set_operation T accum
+ | \<^const_name>\<open>relcomp\<close> =>
let
val x = Unsynchronized.inc max_fresh
val bc_set_M = domain_type T |> mtype_for_set x
@@ -888,12 +888,12 @@
(MFun (bc_set_M, A Gen, MFun (ab_set_M, A Gen, ac_set_M)),
accum ||> add_annotation_atom_comp Neq [] (V x) (A New))
end
- | @{const_name finite} =>
+ | \<^const_name>\<open>finite\<close> =>
let
val M1 = mtype_for (elem_type (domain_type T))
val a = if exists_alpha_sub_mtype M1 then Fls else Gen
in (MFun (MFun (M1, A a, bool_M), A Gen, bool_M), accum) end
- | @{const_name prod} =>
+ | \<^const_name>\<open>prod\<close> =>
let
val x = Unsynchronized.inc max_fresh
val a_set_M = domain_type T |> mtype_for_set x
@@ -905,12 +905,12 @@
accum ||> add_annotation_atom_comp Neq [] (V x) (A New))
end
| _ =>
- if s = @{const_name safe_The} then
+ if s = \<^const_name>\<open>safe_The\<close> then
let
val a_set_M = mtype_for (domain_type T)
val a_M = dest_MFun a_set_M |> #1
in (MFun (a_set_M, A Gen, a_M), accum) end
- else if s = @{const_name ord_class.less_eq} andalso
+ else if s = \<^const_name>\<open>ord_class.less_eq\<close> andalso
is_set_like_type (domain_type T) then
do_fragile_set_operation T accum
else if is_sel s then
@@ -958,7 +958,7 @@
do_term (incr_boundvars ~1 t1') accum
else
raise SAME ()
- | (t11 as Const (@{const_name HOL.eq}, _)) $ Bound 0 $ t13 =>
+ | (t11 as Const (\<^const_name>\<open>HOL.eq\<close>, _)) $ Bound 0 $ t13 =>
if not (loose_bvar1 (t13, 0)) then
do_term (incr_boundvars ~1 (t11 $ t13)) accum
else
@@ -975,7 +975,7 @@
| @{const conj} $ t1 $ t2 => do_connect conj_spec t1 t2 accum
| @{const disj} $ t1 $ t2 => do_connect disj_spec t1 t2 accum
| @{const implies} $ t1 $ t2 => do_connect imp_spec t1 t2 accum
- | Const (@{const_name Let}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>Let\<close>, _) $ t1 $ t2 =>
do_term (betapply (t2, t1)) accum
| t1 $ t2 =>
let
@@ -1036,8 +1036,8 @@
let
val abs_M = mtype_for abs_T
val x = Unsynchronized.inc max_fresh
- val side_cond = ((sn = Minus) = (quant_s = @{const_name Ex}))
- fun ann () = if quant_s = @{const_name Ex} then Fls else Tru
+ val side_cond = ((sn = Minus) = (quant_s = \<^const_name>\<open>Ex\<close>))
+ fun ann () = if quant_s = \<^const_name>\<open>Ex\<close> then Fls else Tru
in
accum ||> side_cond
? add_mtype_is_complete [(x, (Plus, ann ()))] abs_M
@@ -1057,13 +1057,13 @@
" \<turnstile> " ^ Syntax.string_of_term ctxt t ^
" : o\<^sup>" ^ string_for_sign sn ^ "?");
case t of
- Const (s as @{const_name Pure.all}, _) $ Abs (_, T1, t1) =>
+ Const (s as \<^const_name>\<open>Pure.all\<close>, _) $ Abs (_, T1, t1) =>
do_quantifier s T1 t1
- | Const (@{const_name Pure.eq}, _) $ t1 $ t2 => do_equals t1 t2
+ | Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t1 $ t2 => do_equals t1 t2
| @{const Trueprop} $ t1 => do_formula sn t1 accum
- | Const (s as @{const_name All}, _) $ Abs (_, T1, t1) =>
+ | Const (s as \<^const_name>\<open>All\<close>, _) $ Abs (_, T1, t1) =>
do_quantifier s T1 t1
- | Const (s as @{const_name Ex}, T0) $ (t1 as Abs (_, T1, t1')) =>
+ | Const (s as \<^const_name>\<open>Ex\<close>, T0) $ (t1 as Abs (_, T1, t1')) =>
(case sn of
Plus => do_quantifier s T1 t1'
| Minus =>
@@ -1071,8 +1071,8 @@
do_term (@{const Not}
$ (HOLogic.eq_const (domain_type T0) $ t1
$ Abs (Name.uu, T1, @{const False}))) accum)
- | Const (@{const_name HOL.eq}, _) $ t1 $ t2 => do_equals t1 t2
- | Const (@{const_name Let}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2 => do_equals t1 t2
+ | Const (\<^const_name>\<open>Let\<close>, _) $ t1 $ t2 =>
do_formula sn (betapply (t2, t1)) accum
| @{const Pure.conjunction} $ t1 $ t2 =>
do_connect meta_conj_spec false t1 t2 accum
@@ -1093,8 +1093,8 @@
(* The harmless axiom optimization below is somewhat too aggressive in the face
of (rather peculiar) user-defined axioms. *)
val harmless_consts =
- [@{const_name ord_class.less}, @{const_name ord_class.less_eq}]
-val bounteous_consts = [@{const_name bisim}]
+ [\<^const_name>\<open>ord_class.less\<close>, \<^const_name>\<open>ord_class.less_eq\<close>]
+val bounteous_consts = [\<^const_name>\<open>bisim\<close>]
fun is_harmless_axiom t =
Term.add_consts t []
@@ -1122,15 +1122,15 @@
and do_implies t1 t2 = do_term t1 #> do_formula t2
and do_formula t accum =
case t of
- Const (@{const_name Pure.all}, _) $ Abs (_, T1, t1) => do_all T1 t1 accum
+ Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (_, T1, t1) => do_all T1 t1 accum
| @{const Trueprop} $ t1 => do_formula t1 accum
- | Const (@{const_name Pure.eq}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t1 $ t2 =>
consider_general_equals mdata true t1 t2 accum
| @{const Pure.imp} $ t1 $ t2 => do_implies t1 t2 accum
| @{const Pure.conjunction} $ t1 $ t2 =>
fold (do_formula) [t1, t2] accum
- | Const (@{const_name All}, _) $ Abs (_, T1, t1) => do_all T1 t1 accum
- | Const (@{const_name HOL.eq}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, T1, t1) => do_all T1 t1 accum
+ | Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2 =>
consider_general_equals mdata true t1 t2 accum
| @{const conj} $ t1 $ t2 => fold (do_formula) [t1, t2] accum
| @{const implies} $ t1 $ t2 => do_implies t1 t2 accum
--- a/src/HOL/Tools/Nitpick/nitpick_nut.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_nut.ML Fri Jan 04 23:22:53 2019 +0100
@@ -403,20 +403,20 @@
FreeRel (x, _, _, _) => x
| u => raise NUT ("Nitpick_Nut.the_rel", [u])
-fun mk_fst (_, Const (@{const_name Pair}, T) $ t1 $ _) = (domain_type T, t1)
+fun mk_fst (_, Const (\<^const_name>\<open>Pair\<close>, T) $ t1 $ _) = (domain_type T, t1)
| mk_fst (T, t) =
let val res_T = fst (HOLogic.dest_prodT T) in
- (res_T, Const (@{const_name fst}, T --> res_T) $ t)
+ (res_T, Const (\<^const_name>\<open>fst\<close>, T --> res_T) $ t)
end
-fun mk_snd (_, Const (@{const_name Pair}, T) $ _ $ t2) =
+fun mk_snd (_, Const (\<^const_name>\<open>Pair\<close>, T) $ _ $ t2) =
(domain_type (range_type T), t2)
| mk_snd (T, t) =
let val res_T = snd (HOLogic.dest_prodT T) in
- (res_T, Const (@{const_name snd}, T --> res_T) $ t)
+ (res_T, Const (\<^const_name>\<open>snd\<close>, T --> res_T) $ t)
end
-fun factorize (z as (Type (@{type_name prod}, _), _)) =
+fun factorize (z as (Type (\<^type_name>\<open>prod\<close>, _), _)) =
maps factorize [mk_fst z, mk_snd z]
| factorize z = [z]
@@ -437,12 +437,12 @@
val t1 = incr_boundvars n t1
val t2 = incr_boundvars n t2
val xs = map Bound (n - 1 downto 0)
- val equation = Const (@{const_name HOL.eq},
+ val equation = Const (\<^const_name>\<open>HOL.eq\<close>,
body_T --> body_T --> bool_T)
$ betapplys (t1, xs) $ betapplys (t2, xs)
val t =
fold_rev (fn T => fn (t, j) =>
- (Const (@{const_name All}, T --> bool_T)
+ (Const (\<^const_name>\<open>All\<close>, T --> bool_T)
$ Abs ("x" ^ nat_subscript j, T, t), j - 1))
binder_Ts (equation, n) |> fst
in sub' t end
@@ -471,107 +471,107 @@
| k => sub (eta_expand Ts t k)
in
case strip_comb t of
- (Const (@{const_name Pure.all}, _), [Abs (s, T, t1)]) =>
+ (Const (\<^const_name>\<open>Pure.all\<close>, _), [Abs (s, T, t1)]) =>
do_quantifier All s T t1
- | (t0 as Const (@{const_name Pure.all}, _), [t1]) =>
+ | (t0 as Const (\<^const_name>\<open>Pure.all\<close>, _), [t1]) =>
sub' (t0 $ eta_expand Ts t1 1)
- | (Const (@{const_name Pure.eq}, T), [t1, t2]) => sub_equals T t1 t2
- | (Const (@{const_name Pure.imp}, _), [t1, t2]) =>
+ | (Const (\<^const_name>\<open>Pure.eq\<close>, T), [t1, t2]) => sub_equals T t1 t2
+ | (Const (\<^const_name>\<open>Pure.imp\<close>, _), [t1, t2]) =>
Op2 (Or, prop_T, Any, Op1 (Not, prop_T, Any, sub t1), sub' t2)
- | (Const (@{const_name Pure.conjunction}, _), [t1, t2]) =>
+ | (Const (\<^const_name>\<open>Pure.conjunction\<close>, _), [t1, t2]) =>
Op2 (And, prop_T, Any, sub' t1, sub' t2)
- | (Const (@{const_name Trueprop}, _), [t1]) => sub' t1
- | (Const (@{const_name Not}, _), [t1]) =>
+ | (Const (\<^const_name>\<open>Trueprop\<close>, _), [t1]) => sub' t1
+ | (Const (\<^const_name>\<open>Not\<close>, _), [t1]) =>
(case sub t1 of
Op1 (Not, _, _, u11) => u11
| u1 => Op1 (Not, bool_T, Any, u1))
- | (Const (@{const_name False}, T), []) => Cst (False, T, Any)
- | (Const (@{const_name True}, T), []) => Cst (True, T, Any)
- | (Const (@{const_name All}, _), [Abs (s, T, t1)]) =>
+ | (Const (\<^const_name>\<open>False\<close>, T), []) => Cst (False, T, Any)
+ | (Const (\<^const_name>\<open>True\<close>, T), []) => Cst (True, T, Any)
+ | (Const (\<^const_name>\<open>All\<close>, _), [Abs (s, T, t1)]) =>
do_quantifier All s T t1
- | (t0 as Const (@{const_name All}, _), [t1]) =>
+ | (t0 as Const (\<^const_name>\<open>All\<close>, _), [t1]) =>
sub' (t0 $ eta_expand Ts t1 1)
- | (Const (@{const_name Ex}, _), [Abs (s, T, t1)]) =>
+ | (Const (\<^const_name>\<open>Ex\<close>, _), [Abs (s, T, t1)]) =>
do_quantifier Exist s T t1
- | (t0 as Const (@{const_name Ex}, _), [t1]) =>
+ | (t0 as Const (\<^const_name>\<open>Ex\<close>, _), [t1]) =>
sub' (t0 $ eta_expand Ts t1 1)
- | (Const (@{const_name HOL.eq}, T), [t1]) =>
+ | (Const (\<^const_name>\<open>HOL.eq\<close>, T), [t1]) =>
Op1 (SingletonSet, range_type T, Any, sub t1)
- | (Const (@{const_name HOL.eq}, T), [t1, t2]) => sub_equals T t1 t2
- | (Const (@{const_name HOL.conj}, _), [t1, t2]) =>
+ | (Const (\<^const_name>\<open>HOL.eq\<close>, T), [t1, t2]) => sub_equals T t1 t2
+ | (Const (\<^const_name>\<open>HOL.conj\<close>, _), [t1, t2]) =>
Op2 (And, bool_T, Any, sub' t1, sub' t2)
- | (Const (@{const_name HOL.disj}, _), [t1, t2]) =>
+ | (Const (\<^const_name>\<open>HOL.disj\<close>, _), [t1, t2]) =>
Op2 (Or, bool_T, Any, sub t1, sub t2)
- | (Const (@{const_name HOL.implies}, _), [t1, t2]) =>
+ | (Const (\<^const_name>\<open>HOL.implies\<close>, _), [t1, t2]) =>
Op2 (Or, bool_T, Any, Op1 (Not, bool_T, Any, sub t1), sub' t2)
- | (Const (@{const_name If}, T), [t1, t2, t3]) =>
+ | (Const (\<^const_name>\<open>If\<close>, T), [t1, t2, t3]) =>
Op3 (If, nth_range_type 3 T, Any, sub t1, sub t2, sub t3)
- | (Const (@{const_name Let}, T), [t1, Abs (s, T', t2)]) =>
+ | (Const (\<^const_name>\<open>Let\<close>, T), [t1, Abs (s, T', t2)]) =>
Op3 (Let, nth_range_type 2 T, Any, BoundName (length Ts, T', Any, s),
sub t1, sub_abs s T' t2)
- | (t0 as Const (@{const_name Let}, _), [t1, t2]) =>
+ | (t0 as Const (\<^const_name>\<open>Let\<close>, _), [t1, t2]) =>
sub (t0 $ t1 $ eta_expand Ts t2 1)
- | (Const (@{const_name Pair}, T), [t1, t2]) =>
+ | (Const (\<^const_name>\<open>Pair\<close>, T), [t1, t2]) =>
Tuple (nth_range_type 2 T, Any, map sub [t1, t2])
- | (Const (@{const_name fst}, T), [t1]) =>
+ | (Const (\<^const_name>\<open>fst\<close>, T), [t1]) =>
Op1 (First, range_type T, Any, sub t1)
- | (Const (@{const_name snd}, T), [t1]) =>
+ | (Const (\<^const_name>\<open>snd\<close>, T), [t1]) =>
Op1 (Second, range_type T, Any, sub t1)
- | (Const (@{const_name Set.member}, _), [t1, t2]) => do_apply t2 [t1]
- | (Const (@{const_name Collect}, _), [t1]) => sub t1
- | (Const (@{const_name Id}, T), []) => Cst (Iden, T, Any)
- | (Const (@{const_name converse}, T), [t1]) =>
+ | (Const (\<^const_name>\<open>Set.member\<close>, _), [t1, t2]) => do_apply t2 [t1]
+ | (Const (\<^const_name>\<open>Collect\<close>, _), [t1]) => sub t1
+ | (Const (\<^const_name>\<open>Id\<close>, T), []) => Cst (Iden, T, Any)
+ | (Const (\<^const_name>\<open>converse\<close>, T), [t1]) =>
Op1 (Converse, range_type T, Any, sub t1)
- | (Const (@{const_name trancl}, T), [t1]) =>
+ | (Const (\<^const_name>\<open>trancl\<close>, T), [t1]) =>
Op1 (Closure, range_type T, Any, sub t1)
- | (Const (@{const_name relcomp}, T), [t1, t2]) =>
+ | (Const (\<^const_name>\<open>relcomp\<close>, T), [t1, t2]) =>
Op2 (Composition, nth_range_type 2 T, Any, sub t1, sub t2)
- | (Const (x as (s as @{const_name Suc}, T)), []) =>
+ | (Const (x as (s as \<^const_name>\<open>Suc\<close>, T)), []) =>
if is_built_in_const x then Cst (Suc, T, Any)
else if is_constr ctxt x then do_construct x []
else ConstName (s, T, Any)
- | (Const (@{const_name finite}, T), [t1]) =>
+ | (Const (\<^const_name>\<open>finite\<close>, T), [t1]) =>
(if is_finite_type hol_ctxt (domain_type T) then
Cst (True, bool_T, Any)
else case t1 of
- Const (@{const_name top}, _) => Cst (False, bool_T, Any)
+ Const (\<^const_name>\<open>top\<close>, _) => Cst (False, bool_T, Any)
| _ => Op1 (Finite, bool_T, Any, sub t1))
- | (Const (@{const_name nat}, T), []) => Cst (IntToNat, T, Any)
- | (Const (x as (s as @{const_name zero_class.zero}, T)), []) =>
+ | (Const (\<^const_name>\<open>nat\<close>, T), []) => Cst (IntToNat, T, Any)
+ | (Const (x as (s as \<^const_name>\<open>zero_class.zero\<close>, T)), []) =>
if is_built_in_const x then Cst (Num 0, T, Any)
else if is_constr ctxt x then do_construct x []
else ConstName (s, T, Any)
- | (Const (x as (s as @{const_name one_class.one}, T)), []) =>
+ | (Const (x as (s as \<^const_name>\<open>one_class.one\<close>, T)), []) =>
if is_built_in_const x then Cst (Num 1, T, Any)
else ConstName (s, T, Any)
- | (Const (x as (s as @{const_name plus_class.plus}, T)), []) =>
+ | (Const (x as (s as \<^const_name>\<open>plus_class.plus\<close>, T)), []) =>
if is_built_in_const x then Cst (Add, T, Any)
else ConstName (s, T, Any)
- | (Const (x as (s as @{const_name minus_class.minus}, T)), []) =>
+ | (Const (x as (s as \<^const_name>\<open>minus_class.minus\<close>, T)), []) =>
if is_built_in_const x then Cst (Subtract, T, Any)
else ConstName (s, T, Any)
- | (Const (x as (s as @{const_name times_class.times}, T)), []) =>
+ | (Const (x as (s as \<^const_name>\<open>times_class.times\<close>, T)), []) =>
if is_built_in_const x then Cst (Multiply, T, Any)
else ConstName (s, T, Any)
- | (Const (x as (s as @{const_name Rings.divide}, T)), []) =>
+ | (Const (x as (s as \<^const_name>\<open>Rings.divide\<close>, T)), []) =>
if is_built_in_const x then Cst (Divide, T, Any)
else ConstName (s, T, Any)
- | (t0 as Const (x as (@{const_name ord_class.less}, _)),
+ | (t0 as Const (x as (\<^const_name>\<open>ord_class.less\<close>, _)),
ts as [t1, t2]) =>
if is_built_in_const x then
Op2 (Less, bool_T, Any, sub t1, sub t2)
else
do_apply t0 ts
- | (t0 as Const (x as (@{const_name ord_class.less_eq}, T)),
+ | (t0 as Const (x as (\<^const_name>\<open>ord_class.less_eq\<close>, T)),
ts as [t1, t2]) =>
if is_built_in_const x then
(* FIXME: find out if this case is necessary *)
Op1 (Not, bool_T, Any, Op2 (Less, bool_T, Any, sub t2, sub t1))
else
do_apply t0 ts
- | (Const (@{const_name nat_gcd}, T), []) => Cst (Gcd, T, Any)
- | (Const (@{const_name nat_lcm}, T), []) => Cst (Lcm, T, Any)
- | (Const (x as (s as @{const_name uminus_class.uminus}, T)), []) =>
+ | (Const (\<^const_name>\<open>nat_gcd\<close>, T), []) => Cst (Gcd, T, Any)
+ | (Const (\<^const_name>\<open>nat_lcm\<close>, T), []) => Cst (Lcm, T, Any)
+ | (Const (x as (s as \<^const_name>\<open>uminus_class.uminus\<close>, T)), []) =>
if is_built_in_const x then
let val num_T = domain_type T in
Op2 (Apply, num_T --> num_T, Any,
@@ -580,19 +580,19 @@
end
else
ConstName (s, T, Any)
- | (Const (@{const_name unknown}, T), []) => Cst (Unknown, T, Any)
- | (Const (@{const_name is_unknown}, _), [t1]) =>
+ | (Const (\<^const_name>\<open>unknown\<close>, T), []) => Cst (Unknown, T, Any)
+ | (Const (\<^const_name>\<open>is_unknown\<close>, _), [t1]) =>
Op1 (IsUnknown, bool_T, Any, sub t1)
- | (Const (@{const_name safe_The},
- Type (@{type_name fun}, [_, T2])), [t1]) =>
+ | (Const (\<^const_name>\<open>safe_The\<close>,
+ Type (\<^type_name>\<open>fun\<close>, [_, T2])), [t1]) =>
Op1 (SafeThe, T2, Any, sub t1)
- | (Const (@{const_name Frac}, T), []) => Cst (Fracs, T, Any)
- | (Const (@{const_name norm_frac}, T), []) =>
+ | (Const (\<^const_name>\<open>Frac\<close>, T), []) => Cst (Fracs, T, Any)
+ | (Const (\<^const_name>\<open>norm_frac\<close>, T), []) =>
Cst (NormFrac, T, Any)
- | (Const (@{const_name of_nat}, T as @{typ "nat => int"}), []) =>
+ | (Const (\<^const_name>\<open>of_nat\<close>, T as \<^typ>\<open>nat => int\<close>), []) =>
Cst (NatToInt, T, Any)
- | (Const (@{const_name of_nat},
- T as @{typ "unsigned_bit word => signed_bit word"}), []) =>
+ | (Const (\<^const_name>\<open>of_nat\<close>,
+ T as \<^typ>\<open>unsigned_bit word => signed_bit word\<close>), []) =>
Cst (NatToInt, T, Any)
| (t0 as Const (x as (s, T)), ts) =>
if is_constr ctxt x then
@@ -630,7 +630,7 @@
if oper = Apply then
case u1 of
ConstName (s, _, _) =>
- is_sel_like_and_no_discr s orelse s = @{const_name set}
+ is_sel_like_and_no_discr s orelse s = \<^const_name>\<open>set\<close>
| _ => false
else
false
@@ -659,13 +659,13 @@
else if is_rep_fun ctxt x then
Func oo best_non_opt_symmetric_reps_for_fun_type
else if total_consts orelse is_skolem_name v orelse
- member (op =) [@{const_name bisim},
- @{const_name bisim_iterator_max}]
+ member (op =) [\<^const_name>\<open>bisim\<close>,
+ \<^const_name>\<open>bisim_iterator_max\<close>]
(original_name s) then
best_non_opt_set_rep_for_type
- else if member (op =) [@{const_name set}, @{const_name distinct},
- @{const_name ord_class.less},
- @{const_name ord_class.less_eq}]
+ else if member (op =) [\<^const_name>\<open>set\<close>, \<^const_name>\<open>distinct\<close>,
+ \<^const_name>\<open>ord_class.less\<close>,
+ \<^const_name>\<open>ord_class.less_eq\<close>]
(original_name s) then
best_set_rep_for_type
else
@@ -784,7 +784,7 @@
else if is_constructive u1 then
Cst (Unrep, T, R)
else case u1 of
- Op2 (Apply, _, _, ConstName (@{const_name List.append}, _, _), _) =>
+ Op2 (Apply, _, _, ConstName (\<^const_name>\<open>List.append\<close>, _, _), _) =>
Cst (Unrep, T, R)
| _ => raise SAME ()
else
@@ -844,7 +844,7 @@
if ok then Cst (Num j, T, Atom (k, j0))
else Cst (Unrep, T, Opt (Atom (k, j0)))
end
- | Cst (Suc, T as Type (@{type_name fun}, [T1, _]), _) =>
+ | Cst (Suc, T as Type (\<^type_name>\<open>fun\<close>, [T1, _]), _) =>
let val R = Atom (spec_of_type scope T1) in
Cst (Suc, T, Func (R, Opt R))
end
@@ -946,7 +946,7 @@
val R2 = rep_of u2
val opt =
case (u1, is_opt_rep R2) of
- (ConstName (@{const_name set}, _, _), false) => false
+ (ConstName (\<^const_name>\<open>set\<close>, _, _), false) => false
| _ => exists is_opt_rep [R1, R2]
val ran_R =
if is_boolean_type T then
@@ -1100,7 +1100,7 @@
val w = constr (j, type_of v, rep_of v)
in (w :: ws, pool, NameTable.update (v, w) table) end
-fun shape_tuple (T as Type (@{type_name prod}, [T1, T2])) (R as Struct [R1, R2])
+fun shape_tuple (T as Type (\<^type_name>\<open>prod\<close>, [T1, T2])) (R as Struct [R1, R2])
us =
let val arity1 = arity_of_rep R1 in
Tuple (T, R, [shape_tuple T1 R1 (List.take (us, arity1)),
@@ -1143,9 +1143,9 @@
ConstName _ =>
if is_sel_like_and_no_discr nick then
case domain_type T of
- @{typ "unsigned_bit word"} =>
+ \<^typ>\<open>unsigned_bit word\<close> =>
(snd unsigned_bit_word_sel_rel, pool)
- | @{typ "signed_bit word"} => (snd signed_bit_word_sel_rel, pool)
+ | \<^typ>\<open>signed_bit word\<close> => (snd signed_bit_word_sel_rel, pool)
| _ => fresh arity pool
else
fresh arity pool
--- a/src/HOL/Tools/Nitpick/nitpick_preproc.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_preproc.ML Fri Jan 04 23:22:53 2019 +0100
@@ -21,11 +21,11 @@
open Nitpick_Mono
fun is_positive_existential polar quant_s =
- (polar = Pos andalso quant_s = @{const_name Ex}) orelse
- (polar = Neg andalso quant_s <> @{const_name Ex})
+ (polar = Pos andalso quant_s = \<^const_name>\<open>Ex\<close>) orelse
+ (polar = Neg andalso quant_s <> \<^const_name>\<open>Ex\<close>)
val is_descr =
- member (op =) [@{const_name The}, @{const_name Eps}, @{const_name safe_The}]
+ member (op =) [\<^const_name>\<open>The\<close>, \<^const_name>\<open>Eps\<close>, \<^const_name>\<open>safe_The\<close>]
(** Binary coding of integers **)
@@ -36,19 +36,19 @@
val may_use_binary_ints =
let
- fun aux def (Const (@{const_name Pure.eq}, _) $ t1 $ t2) =
+ fun aux def (Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t1 $ t2) =
aux def t1 andalso aux false t2
| aux def (@{const Pure.imp} $ t1 $ t2) = aux false t1 andalso aux def t2
- | aux def (Const (@{const_name HOL.eq}, _) $ t1 $ t2) =
+ | aux def (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2) =
aux def t1 andalso aux false t2
| aux def (@{const HOL.implies} $ t1 $ t2) = aux false t1 andalso aux def t2
| aux def (t1 $ t2) = aux def t1 andalso aux def t2
| aux def (t as Const (s, _)) =
(not def orelse t <> @{const Suc}) andalso
not (member (op =)
- [@{const_name Abs_Frac}, @{const_name Rep_Frac},
- @{const_name nat_gcd}, @{const_name nat_lcm},
- @{const_name Frac}, @{const_name norm_frac}] s)
+ [\<^const_name>\<open>Abs_Frac\<close>, \<^const_name>\<open>Rep_Frac\<close>,
+ \<^const_name>\<open>nat_gcd\<close>, \<^const_name>\<open>nat_lcm\<close>,
+ \<^const_name>\<open>Frac\<close>, \<^const_name>\<open>norm_frac\<close>] s)
| aux def (Abs (_, _, t')) = aux def t'
| aux _ _ = true
in aux end
@@ -56,7 +56,7 @@
let
fun aux (t1 $ t2) = aux t1 orelse aux t2
| aux (Const (s, T)) =
- ((s = @{const_name times} orelse s = @{const_name Rings.divide}) andalso
+ ((s = \<^const_name>\<open>times\<close> orelse s = \<^const_name>\<open>Rings.divide\<close>) andalso
is_integer_type (body_type T)) orelse
(String.isPrefix numeral_prefix s andalso
let val n = the (Int.fromString (unprefix numeral_prefix s)) in
@@ -75,7 +75,7 @@
| aux (Abs (_, _, t')) _ table = aux t' [] table
| aux (t as Const (x as (s, _))) args table =
if is_built_in_const x orelse is_nonfree_constr ctxt x orelse
- is_sel s orelse s = @{const_name Sigma} then
+ is_sel s orelse s = \<^const_name>\<open>Sigma\<close> then
table
else
Termtab.map_default (t, 65536) (Integer.min (length args)) table
@@ -126,15 +126,15 @@
fun box_fun_and_pair_in_term (hol_ctxt as {ctxt, ...}) def orig_t =
let
- fun box_relational_operator_type (Type (@{type_name fun}, Ts)) =
- Type (@{type_name fun}, map box_relational_operator_type Ts)
- | box_relational_operator_type (Type (@{type_name prod}, Ts)) =
- Type (@{type_name prod}, map (box_type hol_ctxt InPair) Ts)
+ fun box_relational_operator_type (Type (\<^type_name>\<open>fun\<close>, Ts)) =
+ Type (\<^type_name>\<open>fun\<close>, map box_relational_operator_type Ts)
+ | box_relational_operator_type (Type (\<^type_name>\<open>prod\<close>, Ts)) =
+ Type (\<^type_name>\<open>prod\<close>, map (box_type hol_ctxt InPair) Ts)
| box_relational_operator_type T = T
fun add_boxed_types_for_var (z as (_, T)) (T', t') =
case t' of
Var z' => z' = z ? insert (op =) T'
- | Const (@{const_name Pair}, _) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2 =>
(case T' of
Type (_, [T1, T2]) =>
fold (add_boxed_types_for_var z) [(T1, t1), (T2, t2)]
@@ -145,7 +145,7 @@
case t of
@{const Trueprop} $ t1 => box_var_in_def new_Ts old_Ts t1 z
| Const (s0, _) $ t1 $ _ =>
- if s0 = @{const_name Pure.eq} orelse s0 = @{const_name HOL.eq} then
+ if s0 = \<^const_name>\<open>Pure.eq\<close> orelse s0 = \<^const_name>\<open>HOL.eq\<close> then
let
val (t', args) = strip_comb t1
val T' = fastype_of1 (new_Ts, do_term new_Ts old_Ts Neut t')
@@ -186,9 +186,9 @@
end
and do_term new_Ts old_Ts polar t =
case t of
- Const (s0 as @{const_name Pure.all}, T0) $ Abs (s1, T1, t1) =>
+ Const (s0 as \<^const_name>\<open>Pure.all\<close>, T0) $ Abs (s1, T1, t1) =>
do_quantifier new_Ts old_Ts polar s0 T0 s1 T1 t1
- | Const (s0 as @{const_name Pure.eq}, T0) $ t1 $ t2 =>
+ | Const (s0 as \<^const_name>\<open>Pure.eq\<close>, T0) $ t1 $ t2 =>
do_equals new_Ts old_Ts s0 T0 t1 t2
| @{const Pure.imp} $ t1 $ t2 =>
@{const Pure.imp} $ do_term new_Ts old_Ts (flip_polarity polar) t1
@@ -200,11 +200,11 @@
@{const Trueprop} $ do_term new_Ts old_Ts polar t1
| @{const Not} $ t1 =>
@{const Not} $ do_term new_Ts old_Ts (flip_polarity polar) t1
- | Const (s0 as @{const_name All}, T0) $ Abs (s1, T1, t1) =>
+ | Const (s0 as \<^const_name>\<open>All\<close>, T0) $ Abs (s1, T1, t1) =>
do_quantifier new_Ts old_Ts polar s0 T0 s1 T1 t1
- | Const (s0 as @{const_name Ex}, T0) $ Abs (s1, T1, t1) =>
+ | Const (s0 as \<^const_name>\<open>Ex\<close>, T0) $ Abs (s1, T1, t1) =>
do_quantifier new_Ts old_Ts polar s0 T0 s1 T1 t1
- | Const (s0 as @{const_name HOL.eq}, T0) $ t1 $ t2 =>
+ | Const (s0 as \<^const_name>\<open>HOL.eq\<close>, T0) $ t1 $ t2 =>
do_equals new_Ts old_Ts s0 T0 t1 t2
| @{const HOL.conj} $ t1 $ t2 =>
@{const HOL.conj} $ do_term new_Ts old_Ts polar t1
@@ -219,15 +219,15 @@
if is_descr s then
do_descr s T
else
- Const (s, if s = @{const_name converse} orelse
- s = @{const_name trancl} then
+ Const (s, if s = \<^const_name>\<open>converse\<close> orelse
+ s = \<^const_name>\<open>trancl\<close> then
box_relational_operator_type T
else if String.isPrefix quot_normal_prefix s then
let val T' = box_type hol_ctxt InFunLHS (domain_type T) in
T' --> T'
end
else if is_built_in_const x orelse
- s = @{const_name Sigma} then
+ s = \<^const_name>\<open>Sigma\<close> then
T
else if is_nonfree_constr ctxt x then
box_type hol_ctxt InConstr T
@@ -245,13 +245,13 @@
val T2 = fastype_of1 (new_Ts, t2)
val t2 = coerce_term hol_ctxt new_Ts (hd Ts1) T2 t2
in
- s_betapply new_Ts (if s1 = @{type_name fun} then
+ s_betapply new_Ts (if s1 = \<^type_name>\<open>fun\<close> then
t1
else
select_nth_constr_arg ctxt
- (@{const_name FunBox},
- Type (@{type_name fun}, Ts1) --> T1) t1 0
- (Type (@{type_name fun}, Ts1)), t2)
+ (\<^const_name>\<open>FunBox\<close>,
+ Type (\<^type_name>\<open>fun\<close>, Ts1) --> T1) t1 0
+ (Type (\<^type_name>\<open>fun\<close>, Ts1)), t2)
end
| t1 $ t2 =>
let
@@ -262,13 +262,13 @@
val T2 = fastype_of1 (new_Ts, t2)
val t2 = coerce_term hol_ctxt new_Ts (hd Ts1) T2 t2
in
- s_betapply new_Ts (if s1 = @{type_name fun} then
+ s_betapply new_Ts (if s1 = \<^type_name>\<open>fun\<close> then
t1
else
select_nth_constr_arg ctxt
- (@{const_name FunBox},
- Type (@{type_name fun}, Ts1) --> T1) t1 0
- (Type (@{type_name fun}, Ts1)), t2)
+ (\<^const_name>\<open>FunBox\<close>,
+ Type (\<^type_name>\<open>fun\<close>, Ts1) --> T1) t1 0
+ (Type (\<^type_name>\<open>fun\<close>, Ts1)), t2)
end
| Free (s, T) => Free (s, box_type hol_ctxt InExpr T)
| Var (z as (x, T)) =>
@@ -281,8 +281,8 @@
(** Destruction of set membership and comprehensions **)
-fun destroy_set_Collect (Const (@{const_name Set.member}, _) $ t1
- $ (Const (@{const_name Collect}, _) $ t2)) =
+fun destroy_set_Collect (Const (\<^const_name>\<open>Set.member\<close>, _) $ t1
+ $ (Const (\<^const_name>\<open>Collect\<close>, _) $ t2)) =
destroy_set_Collect (t2 $ t1)
| destroy_set_Collect (t1 $ t2) =
destroy_set_Collect t1 $ destroy_set_Collect t2
@@ -333,11 +333,11 @@
val k = maxidx_of_term t + 1
fun do_term Ts def t args seen =
case t of
- (t0 as Const (@{const_name Pure.eq}, _)) $ t1 $ t2 =>
+ (t0 as Const (\<^const_name>\<open>Pure.eq\<close>, _)) $ t1 $ t2 =>
do_eq_or_imp Ts true def t0 t1 t2 seen
| (t0 as @{const Pure.imp}) $ t1 $ t2 =>
if def then (t, []) else do_eq_or_imp Ts false def t0 t1 t2 seen
- | (t0 as Const (@{const_name HOL.eq}, _)) $ t1 $ t2 =>
+ | (t0 as Const (\<^const_name>\<open>HOL.eq\<close>, _)) $ t1 $ t2 =>
do_eq_or_imp Ts true def t0 t1 t2 seen
| (t0 as @{const HOL.implies}) $ t1 $ t2 =>
do_eq_or_imp Ts false def t0 t1 t2 seen
@@ -370,7 +370,7 @@
val k = maxidx_of_term t + 1
fun aux Ts num_exists t args seen =
case t of
- (t0 as Const (@{const_name Ex}, _)) $ Abs (s1, T1, t1) =>
+ (t0 as Const (\<^const_name>\<open>Ex\<close>, _)) $ Abs (s1, T1, t1) =>
let
val (t1, seen') = aux (T1 :: Ts) (num_exists + 1) t1 [] []
val n = length seen'
@@ -400,11 +400,11 @@
val num_occs_of_var =
fold_aterms (fn Var z => (fn f => fn z' => f z' |> z = z' ? Integer.add 1)
| _ => I) t (K 0)
- fun aux Ts careful ((t0 as Const (@{const_name Pure.eq}, _)) $ t1 $ t2) =
+ fun aux Ts careful ((t0 as Const (\<^const_name>\<open>Pure.eq\<close>, _)) $ t1 $ t2) =
aux_eq Ts careful true t0 t1 t2
| aux Ts careful ((t0 as @{const Pure.imp}) $ t1 $ t2) =
t0 $ aux Ts false t1 $ aux Ts careful t2
- | aux Ts careful ((t0 as Const (@{const_name HOL.eq}, _)) $ t1 $ t2) =
+ | aux Ts careful ((t0 as Const (\<^const_name>\<open>HOL.eq\<close>, _)) $ t1 $ t2) =
aux_eq Ts careful true t0 t1 t2
| aux Ts careful ((t0 as @{const HOL.implies}) $ t1 $ t2) =
t0 $ aux Ts false t1 $ aux Ts careful t2
@@ -420,9 +420,9 @@
@{const True}
else case strip_comb t2 of
(* The first case is not as general as it could be. *)
- (Const (@{const_name PairBox}, _),
- [Const (@{const_name fst}, _) $ Var z1,
- Const (@{const_name snd}, _) $ Var z2]) =>
+ (Const (\<^const_name>\<open>PairBox\<close>, _),
+ [Const (\<^const_name>\<open>fst\<close>, _) $ Var z1,
+ Const (\<^const_name>\<open>snd\<close>, _) $ Var z2]) =>
if z1 = z2 andalso num_occs_of_var z1 = 2 then @{const True}
else raise SAME ()
| (Const (x as (s, T)), args) =>
@@ -431,8 +431,8 @@
val n = length arg_Ts
in
if length args = n andalso
- (is_constr ctxt x orelse s = @{const_name Pair} orelse
- x = (@{const_name Suc}, nat_T --> nat_T)) andalso
+ (is_constr ctxt x orelse s = \<^const_name>\<open>Pair\<close> orelse
+ x = (\<^const_name>\<open>Suc\<close>, nat_T --> nat_T)) andalso
(not careful orelse not (is_Var t1) orelse
String.isPrefix val_var_prefix (fst (fst (dest_Var t1)))) then
s_let Ts "l" (n + 1) dataT bool_T
@@ -469,10 +469,10 @@
| _ => Logic.list_implies (rev prems, t)
and aux_implies prems zs t1 t2 =
case t1 of
- Const (@{const_name Pure.eq}, _) $ Var z $ t' => aux_eq prems zs z t' t1 t2
- | @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ Var z $ t') =>
+ Const (\<^const_name>\<open>Pure.eq\<close>, _) $ Var z $ t' => aux_eq prems zs z t' t1 t2
+ | @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ Var z $ t') =>
aux_eq prems zs z t' t1 t2
- | @{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ t' $ Var z) =>
+ | @{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t' $ Var z) =>
aux_eq prems zs z t' t1 t2
| _ => aux (t1 :: prems) (Term.add_vars t1 zs) t2
and aux_eq prems zs z t' t1 t2 =
@@ -493,11 +493,11 @@
if pass1 then do_eq false t2 t1 else raise SAME ()
else case t1 of
Bound j' => if j' = j then SOME (t2, ts @ seen) else raise SAME ()
- | Const (s, Type (@{type_name fun}, [T1, T2])) $ Bound j' =>
+ | Const (s, Type (\<^type_name>\<open>fun\<close>, [T1, T2])) $ Bound j' =>
if j' = j andalso
- s = nth_sel_name_for_constr_name @{const_name FunBox} 0 then
+ s = nth_sel_name_for_constr_name \<^const_name>\<open>FunBox\<close> 0 then
SOME (construct_value ctxt
- (@{const_name FunBox}, T2 --> T1) [t2],
+ (\<^const_name>\<open>FunBox\<close>, T2 --> T1) [t2],
ts @ seen)
else
raise SAME ()
@@ -505,7 +505,7 @@
handle SAME () => do_term (t :: seen) ts
in
case t of
- Const (@{const_name HOL.eq}, _) $ t1 $ t2 => do_eq true t1 t2
+ Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2 => do_eq true t1 t2
| _ => do_term (t :: seen) ts
end
in do_term end
@@ -533,10 +533,10 @@
kill ss Ts (map (subst_one_bound (length ss)
(incr_bv (~1, length ss + 1, arg_t))) ts)
| NONE =>
- Const (@{const_name Ex}, (T --> bool_T) --> bool_T)
+ Const (\<^const_name>\<open>Ex\<close>, (T --> bool_T) --> bool_T)
$ Abs (s, T, kill ss Ts ts))
| kill _ _ _ = raise ListPair.UnequalLengths
- fun gather ss Ts (Const (@{const_name Ex}, _) $ Abs (s1, T1, t1)) =
+ fun gather ss Ts (Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (s1, T1, t1)) =
gather (ss @ [s1]) (Ts @ [T1]) t1
| gather [] [] (Abs (s, T, t1)) = Abs (s, T, gather [] [] t1)
| gather [] [] (t1 $ t2) = gather [] [] t1 $ gather [] [] t2
@@ -574,7 +574,7 @@
if null js then
s_betapply Ts (abs_t, sko_t)
else
- Const (@{const_name Let}, abs_T --> quant_T) $ sko_t
+ Const (\<^const_name>\<open>Let\<close>, abs_T --> quant_T) $ sko_t
$ abs_t
end
else
@@ -590,7 +590,7 @@
not (is_higher_order_type abs_T)) polar t)
in
case t of
- Const (s0 as @{const_name Pure.all}, T0) $ Abs (s1, T1, t1) =>
+ Const (s0 as \<^const_name>\<open>Pure.all\<close>, T0) $ Abs (s1, T1, t1) =>
do_quantifier s0 T0 s1 T1 t1
| @{const Pure.imp} $ t1 $ t2 =>
@{const Pure.imp} $ aux ss Ts js skolemizable (flip_polarity polar) t1
@@ -602,9 +602,9 @@
@{const Trueprop} $ aux ss Ts js skolemizable polar t1
| @{const Not} $ t1 =>
@{const Not} $ aux ss Ts js skolemizable (flip_polarity polar) t1
- | Const (s0 as @{const_name All}, T0) $ Abs (s1, T1, t1) =>
+ | Const (s0 as \<^const_name>\<open>All\<close>, T0) $ Abs (s1, T1, t1) =>
do_quantifier s0 T0 s1 T1 t1
- | Const (s0 as @{const_name Ex}, T0) $ Abs (s1, T1, t1) =>
+ | Const (s0 as \<^const_name>\<open>Ex\<close>, T0) $ Abs (s1, T1, t1) =>
do_quantifier s0 T0 s1 T1 t1
| @{const HOL.conj} $ t1 $ t2 =>
s_conj (apply2 (aux ss Ts js skolemizable polar) (t1, t2))
@@ -613,7 +613,7 @@
| @{const HOL.implies} $ t1 $ t2 =>
@{const HOL.implies} $ aux ss Ts js skolemizable (flip_polarity polar) t1
$ aux ss Ts js skolemizable polar t2
- | (t0 as Const (@{const_name Let}, _)) $ t1 $ t2 =>
+ | (t0 as Const (\<^const_name>\<open>Let\<close>, _)) $ t1 $ t2 =>
t0 $ t1 $ aux ss Ts js skolemizable polar t2
| Const (x as (s, T)) =>
if is_raw_inductive_pred hol_ctxt x andalso
@@ -655,7 +655,7 @@
fun params_in_equation (@{const Pure.imp} $ _ $ t2) = params_in_equation t2
| params_in_equation (@{const Trueprop} $ t1) = params_in_equation t1
- | params_in_equation (Const (@{const_name HOL.eq}, _) $ t1 $ _) =
+ | params_in_equation (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ _) =
snd (strip_comb t1)
| params_in_equation _ = []
@@ -865,9 +865,9 @@
if exists_subterm (curry (op aconv) u) def then NONE else SOME u
in
case t of
- Const (@{const_name Pure.eq}, _) $ (u as Free _) $ def => do_equals u def
+ Const (\<^const_name>\<open>Pure.eq\<close>, _) $ (u as Free _) $ def => do_equals u def
| @{const Trueprop}
- $ (Const (@{const_name HOL.eq}, _) $ (u as Free _) $ def) =>
+ $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ (u as Free _) $ def) =>
do_equals u def
| _ => NONE
end
@@ -978,7 +978,7 @@
(Const (mate_of_rep_fun ctxt x))
|> fold (add_def_axiom depth)
(inverse_axioms_for_rep_fun ctxt x)
- else if s = @{const_name Pure.type} then
+ else if s = \<^const_name>\<open>Pure.type\<close> then
accum
else case def_of_const thy def_tables x of
SOME _ =>
@@ -1003,11 +1003,11 @@
|> add_axioms_for_type depth T
and add_axioms_for_type depth T =
case T of
- Type (@{type_name fun}, Ts) => fold (add_axioms_for_type depth) Ts
- | Type (@{type_name prod}, Ts) => fold (add_axioms_for_type depth) Ts
- | Type (@{type_name set}, Ts) => fold (add_axioms_for_type depth) Ts
- | @{typ prop} => I
- | @{typ bool} => I
+ Type (\<^type_name>\<open>fun\<close>, Ts) => fold (add_axioms_for_type depth) Ts
+ | Type (\<^type_name>\<open>prod\<close>, Ts) => fold (add_axioms_for_type depth) Ts
+ | Type (\<^type_name>\<open>set\<close>, Ts) => fold (add_axioms_for_type depth) Ts
+ | \<^typ>\<open>prop\<close> => I
+ | \<^typ>\<open>bool\<close> => I
| TFree (_, S) => add_axioms_for_sort depth T S
| TVar (_, S) => add_axioms_for_sort depth T S
| Type (z as (_, Ts)) =>
@@ -1059,11 +1059,11 @@
(t = t' andalso is_sel_like_and_no_discr s andalso
constr_name_for_sel_like s = constr_s andalso sel_no_from_name s = n)
| is_nth_sel_on _ _ _ _ = false
- fun do_term (Const (@{const_name Rep_Frac}, _)
- $ (Const (@{const_name Abs_Frac}, _) $ t1)) [] =
+ fun do_term (Const (\<^const_name>\<open>Rep_Frac\<close>, _)
+ $ (Const (\<^const_name>\<open>Abs_Frac\<close>, _) $ t1)) [] =
do_term t1 []
- | do_term (Const (@{const_name Abs_Frac}, _)
- $ (Const (@{const_name Rep_Frac}, _) $ t1)) [] =
+ | do_term (Const (\<^const_name>\<open>Abs_Frac\<close>, _)
+ $ (Const (\<^const_name>\<open>Rep_Frac\<close>, _) $ t1)) [] =
do_term t1 []
| do_term (t1 $ t2) args = do_term t1 (do_term t2 [] :: args)
| do_term (t as Const (x as (s, T))) (args as _ :: _) =
@@ -1102,30 +1102,30 @@
fun distribute_quantifiers t =
case t of
- (t0 as Const (@{const_name All}, T0)) $ Abs (s, T1, t1) =>
+ (t0 as Const (\<^const_name>\<open>All\<close>, T0)) $ Abs (s, T1, t1) =>
(case t1 of
(t10 as @{const HOL.conj}) $ t11 $ t12 =>
t10 $ distribute_quantifiers (t0 $ Abs (s, T1, t11))
$ distribute_quantifiers (t0 $ Abs (s, T1, t12))
| (t10 as @{const Not}) $ t11 =>
- t10 $ distribute_quantifiers (Const (@{const_name Ex}, T0)
+ t10 $ distribute_quantifiers (Const (\<^const_name>\<open>Ex\<close>, T0)
$ Abs (s, T1, t11))
| t1 =>
if not (loose_bvar1 (t1, 0)) then
distribute_quantifiers (incr_boundvars ~1 t1)
else
t0 $ Abs (s, T1, distribute_quantifiers t1))
- | (t0 as Const (@{const_name Ex}, T0)) $ Abs (s, T1, t1) =>
+ | (t0 as Const (\<^const_name>\<open>Ex\<close>, T0)) $ Abs (s, T1, t1) =>
(case distribute_quantifiers t1 of
(t10 as @{const HOL.disj}) $ t11 $ t12 =>
t10 $ distribute_quantifiers (t0 $ Abs (s, T1, t11))
$ distribute_quantifiers (t0 $ Abs (s, T1, t12))
| (t10 as @{const HOL.implies}) $ t11 $ t12 =>
- t10 $ distribute_quantifiers (Const (@{const_name All}, T0)
+ t10 $ distribute_quantifiers (Const (\<^const_name>\<open>All\<close>, T0)
$ Abs (s, T1, t11))
$ distribute_quantifiers (t0 $ Abs (s, T1, t12))
| (t10 as @{const Not}) $ t11 =>
- t10 $ distribute_quantifiers (Const (@{const_name All}, T0)
+ t10 $ distribute_quantifiers (Const (\<^const_name>\<open>All\<close>, T0)
$ Abs (s, T1, t11))
| t1 =>
if not (loose_bvar1 (t1, 0)) then
@@ -1160,7 +1160,7 @@
if s0 = quant_s then
aux s0 (s1 :: ss) (T1 :: Ts) t1
else if quant_s = "" andalso
- (s0 = @{const_name All} orelse s0 = @{const_name Ex}) then
+ (s0 = \<^const_name>\<open>All\<close> orelse s0 = \<^const_name>\<open>Ex\<close>) then
aux s0 [s1] [T1] t1
else
raise SAME ()
--- a/src/HOL/Tools/Nitpick/nitpick_rep.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_rep.ML Fri Jan 04 23:22:53 2019 +0100
@@ -148,9 +148,9 @@
| lazy_range_rep _ _ _ (Func (_, R2)) = R2
| lazy_range_rep ofs T ran_card (Opt R) =
Opt (lazy_range_rep ofs T ran_card R)
- | lazy_range_rep ofs (Type (@{type_name fun}, [_, T2])) _ (Atom (1, _)) =
+ | lazy_range_rep ofs (Type (\<^type_name>\<open>fun\<close>, [_, T2])) _ (Atom (1, _)) =
Atom (1, offset_of_type ofs T2)
- | lazy_range_rep ofs (Type (@{type_name fun}, [_, T2])) ran_card (Atom _) =
+ | lazy_range_rep ofs (Type (\<^type_name>\<open>fun\<close>, [_, T2])) ran_card (Atom _) =
Atom (ran_card (), offset_of_type ofs T2)
| lazy_range_rep _ _ _ R = raise REP ("Nitpick_Rep.lazy_range_rep", [R])
@@ -171,15 +171,15 @@
| one_rep ofs T (Opt R) = one_rep ofs T R
| one_rep ofs T R = Atom (card_of_rep R, offset_of_type ofs T)
-fun optable_rep ofs (Type (@{type_name fun}, [_, T2])) (Func (R1, R2)) =
+fun optable_rep ofs (Type (\<^type_name>\<open>fun\<close>, [_, T2])) (Func (R1, R2)) =
Func (R1, optable_rep ofs T2 R2)
- | optable_rep ofs (Type (@{type_name set}, [T'])) R =
+ | optable_rep ofs (Type (\<^type_name>\<open>set\<close>, [T'])) R =
optable_rep ofs (T' --> bool_T) R
| optable_rep ofs T R = one_rep ofs T R
-fun opt_rep ofs (Type (@{type_name fun}, [_, T2])) (Func (R1, R2)) =
+fun opt_rep ofs (Type (\<^type_name>\<open>fun\<close>, [_, T2])) (Func (R1, R2)) =
Func (R1, opt_rep ofs T2 R2)
- | opt_rep ofs (Type (@{type_name set}, [T'])) R =
+ | opt_rep ofs (Type (\<^type_name>\<open>set\<close>, [T'])) R =
opt_rep ofs (T' --> bool_T) R
| opt_rep ofs T R = Opt (optable_rep ofs T R)
@@ -249,28 +249,28 @@
in Func (Struct [Atom (k, j0), Atom (k, j0)], Formula Neut) end
fun best_one_rep_for_type (scope as {card_assigns, ...} : scope)
- (Type (@{type_name fun}, [T1, T2])) =
+ (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
Vect (card_of_type card_assigns T1, (best_one_rep_for_type scope T2))
- | best_one_rep_for_type scope (Type (@{type_name set}, [T'])) =
+ | best_one_rep_for_type scope (Type (\<^type_name>\<open>set\<close>, [T'])) =
best_one_rep_for_type scope (T' --> bool_T)
- | best_one_rep_for_type scope (Type (@{type_name prod}, Ts)) =
+ | best_one_rep_for_type scope (Type (\<^type_name>\<open>prod\<close>, Ts)) =
Struct (map (best_one_rep_for_type scope) Ts)
| best_one_rep_for_type {card_assigns, ofs, ...} T =
Atom (card_of_type card_assigns T, offset_of_type ofs T)
-fun best_opt_set_rep_for_type scope (Type (@{type_name fun}, [T1, T2])) =
+fun best_opt_set_rep_for_type scope (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
Func (best_one_rep_for_type scope T1, best_opt_set_rep_for_type scope T2)
- | best_opt_set_rep_for_type scope (Type (@{type_name set}, [T'])) =
+ | best_opt_set_rep_for_type scope (Type (\<^type_name>\<open>set\<close>, [T'])) =
best_opt_set_rep_for_type scope (T' --> bool_T)
| best_opt_set_rep_for_type (scope as {ofs, ...}) T =
opt_rep ofs T (best_one_rep_for_type scope T)
-fun best_non_opt_set_rep_for_type scope (Type (@{type_name fun}, [T1, T2])) =
+fun best_non_opt_set_rep_for_type scope (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
(case (best_one_rep_for_type scope T1,
best_non_opt_set_rep_for_type scope T2) of
(R1, Atom (2, _)) => Func (R1, Formula Neut)
| z => Func z)
- | best_non_opt_set_rep_for_type scope (Type (@{type_name set}, [T'])) =
+ | best_non_opt_set_rep_for_type scope (Type (\<^type_name>\<open>set\<close>, [T'])) =
best_non_opt_set_rep_for_type scope (T' --> bool_T)
| best_non_opt_set_rep_for_type scope T = best_one_rep_for_type scope T
@@ -279,7 +279,7 @@
else best_opt_set_rep_for_type) scope T
fun best_non_opt_symmetric_reps_for_fun_type (scope as {ofs, ...})
- (Type (@{type_name fun}, [T1, T2])) =
+ (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
(optable_rep ofs T1 (best_one_rep_for_type scope T1),
optable_rep ofs T2 (best_one_rep_for_type scope T2))
| best_non_opt_symmetric_reps_for_fun_type _ T =
@@ -297,13 +297,13 @@
fun type_schema_of_rep _ (Formula _) = []
| type_schema_of_rep T (Atom _) = [T]
- | type_schema_of_rep (Type (@{type_name prod}, [T1, T2])) (Struct [R1, R2]) =
+ | type_schema_of_rep (Type (\<^type_name>\<open>prod\<close>, [T1, T2])) (Struct [R1, R2]) =
type_schema_of_reps [T1, T2] [R1, R2]
- | type_schema_of_rep (Type (@{type_name fun}, [_, T2])) (Vect (k, R)) =
+ | type_schema_of_rep (Type (\<^type_name>\<open>fun\<close>, [_, T2])) (Vect (k, R)) =
replicate_list k (type_schema_of_rep T2 R)
- | type_schema_of_rep (Type (@{type_name fun}, [T1, T2])) (Func (R1, R2)) =
+ | type_schema_of_rep (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) (Func (R1, R2)) =
type_schema_of_rep T1 R1 @ type_schema_of_rep T2 R2
- | type_schema_of_rep (Type (@{type_name set}, [T'])) R =
+ | type_schema_of_rep (Type (\<^type_name>\<open>set\<close>, [T'])) R =
type_schema_of_rep (T' --> bool_T) R
| type_schema_of_rep T (Opt R) = type_schema_of_rep T R
| type_schema_of_rep _ R = raise REP ("Nitpick_Rep.type_schema_of_rep", [R])
--- a/src/HOL/Tools/Nitpick/nitpick_scope.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_scope.ML Fri Jan 04 23:22:53 2019 +0100
@@ -107,21 +107,21 @@
SOME c => c
| NONE => constr_spec dtypes x
-fun is_complete_type dtypes facto (Type (@{type_name fun}, [T1, T2])) =
+fun is_complete_type dtypes facto (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
is_concrete_type dtypes facto T1 andalso is_complete_type dtypes facto T2
- | is_complete_type dtypes facto (Type (@{type_name prod}, Ts)) =
+ | is_complete_type dtypes facto (Type (\<^type_name>\<open>prod\<close>, Ts)) =
forall (is_complete_type dtypes facto) Ts
- | is_complete_type dtypes facto (Type (@{type_name set}, [T'])) =
+ | is_complete_type dtypes facto (Type (\<^type_name>\<open>set\<close>, [T'])) =
is_concrete_type dtypes facto T'
| is_complete_type dtypes facto T =
not (is_integer_like_type T) andalso not (is_bit_type T) andalso
fun_from_pair (#complete (the (data_type_spec dtypes T))) facto
handle Option.Option => true
-and is_concrete_type dtypes facto (Type (@{type_name fun}, [T1, T2])) =
+and is_concrete_type dtypes facto (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
is_complete_type dtypes facto T1 andalso is_concrete_type dtypes facto T2
- | is_concrete_type dtypes facto (Type (@{type_name prod}, Ts)) =
+ | is_concrete_type dtypes facto (Type (\<^type_name>\<open>prod\<close>, Ts)) =
forall (is_concrete_type dtypes facto) Ts
- | is_concrete_type dtypes facto (Type (@{type_name set}, [T'])) =
+ | is_concrete_type dtypes facto (Type (\<^type_name>\<open>set\<close>, [T'])) =
is_complete_type dtypes facto T'
| is_concrete_type dtypes facto T =
fun_from_pair (#concrete (the (data_type_spec dtypes T))) facto
@@ -142,8 +142,8 @@
({hol_ctxt = {ctxt, ...}, card_assigns, bits, bisim_depth,
data_types, ...} : scope) =
let
- val boring_Ts = [@{typ unsigned_bit}, @{typ signed_bit},
- @{typ bisim_iterator}]
+ val boring_Ts = [\<^typ>\<open>unsigned_bit\<close>, \<^typ>\<open>signed_bit\<close>,
+ \<^typ>\<open>bisim_iterator\<close>]
val (iter_assigns, card_assigns) =
card_assigns |> filter_out (member (op =) boring_Ts o fst)
|> List.partition (is_fp_iterator_type o fst)
@@ -249,15 +249,15 @@
fun block_for_type (hol_ctxt as {thy, ...}) binarize cards_assigns maxes_assigns
iters_assigns bitss bisim_depths T =
case T of
- @{typ unsigned_bit} =>
+ \<^typ>\<open>unsigned_bit\<close> =>
[(Card T, map (Integer.min max_bits o Integer.max 1) bitss)]
- | @{typ signed_bit} =>
+ | \<^typ>\<open>signed_bit\<close> =>
[(Card T, map (Integer.add 1 o Integer.min max_bits o Integer.max 1) bitss)]
- | @{typ "unsigned_bit word"} =>
+ | \<^typ>\<open>unsigned_bit word\<close> =>
[(Card T, lookup_type_ints_assign thy cards_assigns nat_T)]
- | @{typ "signed_bit word"} =>
+ | \<^typ>\<open>signed_bit word\<close> =>
[(Card T, lookup_type_ints_assign thy cards_assigns int_T)]
- | @{typ bisim_iterator} =>
+ | \<^typ>\<open>bisim_iterator\<close> =>
[(Card T, map (Integer.add 1 o Integer.max 0) bisim_depths)]
| _ =>
if is_fp_iterator_type T then
@@ -339,7 +339,7 @@
in aux [] (rev card_assigns) end
fun repair_iterator_assign ctxt assigns (T as Type (_, Ts), k) =
- (T, if T = @{typ bisim_iterator} then
+ (T, if T = \<^typ>\<open>bisim_iterator\<close> then
let
val co_cards = map snd (filter (is_codatatype ctxt o fst) assigns)
in Int.min (k, Integer.sum co_cards) end
@@ -480,11 +480,11 @@
map (data_type_spec_from_scope_descriptor hol_ctxt binarize deep_dataTs
finitizable_dataTs desc)
(filter (is_data_type ctxt o fst) card_assigns)
- val bits = card_of_type card_assigns @{typ signed_bit} - 1
+ val bits = card_of_type card_assigns \<^typ>\<open>signed_bit\<close> - 1
handle TYPE ("Nitpick_HOL.card_of_type", _, _) =>
- card_of_type card_assigns @{typ unsigned_bit}
+ card_of_type card_assigns \<^typ>\<open>unsigned_bit\<close>
handle TYPE ("Nitpick_HOL.card_of_type", _, _) => 0
- val bisim_depth = card_of_type card_assigns @{typ bisim_iterator} - 1
+ val bisim_depth = card_of_type card_assigns \<^typ>\<open>bisim_iterator\<close> - 1
in
{hol_ctxt = hol_ctxt, binarize = binarize, card_assigns = card_assigns,
data_types = data_types, bits = bits, bisim_depth = bisim_depth,
--- a/src/HOL/Tools/Nitpick/nitpick_tests.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_tests.ML Fri Jan 04 23:22:53 2019 +0100
@@ -23,7 +23,7 @@
fun cast_to_rep R u = Op1 (Cast, type_of u, R, u)
-val dummy_T = @{typ 'a}
+val dummy_T = \<^typ>\<open>'a\<close>
val atom1_v1 = FreeName ("atom1_v1", dummy_T, Atom (1, 0))
val atom2_v1 = FreeName ("atom2_v1", dummy_T, Atom (2, 0))
@@ -210,12 +210,12 @@
fun run_all_tests () =
let
- val {debug, overlord, timeout, ...} = Nitpick_Commands.default_params @{theory} []
+ val {debug, overlord, timeout, ...} = Nitpick_Commands.default_params \<^theory> []
val max_threads = 1
val max_solutions = 1
in
case Kodkod.solve_any_problem debug overlord timeout max_threads max_solutions
- (map (problem_for_nut @{context}) tests) of
+ (map (problem_for_nut \<^context>) tests) of
Kodkod.Normal ([], _, _) => ()
| _ => error "Tests failed"
end
--- a/src/HOL/Tools/Nitpick/nitpick_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nitpick/nitpick_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -242,10 +242,10 @@
| flip_polarity Neg = Pos
| flip_polarity Neut = Neut
-val prop_T = @{typ prop}
-val bool_T = @{typ bool}
-val nat_T = @{typ nat}
-val int_T = @{typ int}
+val prop_T = \<^typ>\<open>prop\<close>
+val bool_T = \<^typ>\<open>bool\<close>
+val nat_T = \<^typ>\<open>nat\<close>
+val int_T = \<^typ>\<open>int\<close>
fun simple_string_of_typ (Type (s, _)) = s
| simple_string_of_typ (TFree (s, _)) = s
--- a/src/HOL/Tools/Nunchaku/nunchaku.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nunchaku/nunchaku.ML Fri Jan 04 23:22:53 2019 +0100
@@ -135,7 +135,7 @@
| has_lonely_bool_var _ = false;
val syntactic_sorts =
- @{sort "{default,zero,one,plus,minus,uminus,times,inverse,abs,sgn,ord,equal}"} @ @{sort numeral};
+ \<^sort>\<open>{default,zero,one,plus,minus,uminus,times,inverse,abs,sgn,ord,equal}\<close> @ \<^sort>\<open>numeral\<close>;
fun has_tfree_syntactic_sort (TFree (_, S as _ :: _)) = subset (op =) (S, syntactic_sorts)
| has_tfree_syntactic_sort _ = false;
--- a/src/HOL/Tools/Nunchaku/nunchaku_collect.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nunchaku/nunchaku_collect.ML Fri Jan 04 23:22:53 2019 +0100
@@ -174,7 +174,7 @@
let
fun whk t =
if triple_lookup (term_match thy o swap) whacks t = SOME true then
- Const (@{const_name unreachable}, fastype_of t)
+ Const (\<^const_name>\<open>unreachable\<close>, fastype_of t)
else
(case t of
u $ v => whk u $ whk v
@@ -193,7 +193,7 @@
|> attach_typeS
|> whack_term thy whacks
|> Object_Logic.atomize_term ctxt
- |> tap (fn t' => fastype_of t' <> @{typ prop} orelse raise TOO_META t)
+ |> tap (fn t' => fastype_of t' <> \<^typ>\<open>prop\<close> orelse raise TOO_META t)
|> falsify ? HOLogic.mk_not
|> unfold_basic_def ctxt
end;
@@ -203,20 +203,20 @@
val preprocess_prop = close_form [] oooo preprocess_term_basic;
val preprocess_closed_term = check_closed ooo preprocess_term_basic false;
-val is_type_builtin = member (op =) [@{type_name bool}, @{type_name fun}];
+val is_type_builtin = member (op =) [\<^type_name>\<open>bool\<close>, \<^type_name>\<open>fun\<close>];
val is_const_builtin =
- member (op =) [@{const_name All}, @{const_name conj}, @{const_name disj}, @{const_name Eps},
- @{const_name HOL.eq}, @{const_name Ex}, @{const_name False}, @{const_name If},
- @{const_name implies}, @{const_name Not}, @{const_name The}, @{const_name The_unsafe},
- @{const_name True}];
+ member (op =) [\<^const_name>\<open>All\<close>, \<^const_name>\<open>conj\<close>, \<^const_name>\<open>disj\<close>, \<^const_name>\<open>Eps\<close>,
+ \<^const_name>\<open>HOL.eq\<close>, \<^const_name>\<open>Ex\<close>, \<^const_name>\<open>False\<close>, \<^const_name>\<open>If\<close>,
+ \<^const_name>\<open>implies\<close>, \<^const_name>\<open>Not\<close>, \<^const_name>\<open>The\<close>, \<^const_name>\<open>The_unsafe\<close>,
+ \<^const_name>\<open>True\<close>];
datatype type_classification = Builtin | TVal | Typedef | Quotient | Co_Datatype;
fun classify_type_name ctxt T_name =
if is_type_builtin T_name then
Builtin
- else if T_name = @{type_name itself} then
+ else if T_name = \<^type_name>\<open>itself\<close> then
Co_Datatype
else
(case BNF_FP_Def_Sugar.fp_sugar_of ctxt T_name of
@@ -228,7 +228,7 @@
(case Quotient_Info.lookup_quotients ctxt T_name of
SOME _ => Quotient
| NONE =>
- if T_name = @{type_name set} then
+ if T_name = \<^type_name>\<open>set\<close> then
Typedef
else
(case Typedef.get_info ctxt T_name of
@@ -239,8 +239,8 @@
| fp_kind_of_ctr_sugar_kind _ = BNF_Util.Least_FP;
fun mutual_co_datatypes_of ctxt (T_name, Ts) =
- (if T_name = @{type_name itself} then
- (BNF_Util.Least_FP, [@{typ "'a itself"}], [[@{const Pure.type ('a)}]])
+ (if T_name = \<^type_name>\<open>itself\<close> then
+ (BNF_Util.Least_FP, [\<^typ>\<open>'a itself\<close>], [[@{const Pure.type ('a)}]])
else
let
val (fp, ctr_sugars) =
@@ -264,14 +264,14 @@
|> @{apply 3(3)} (map (map (Ctr_Sugar.mk_ctr Ts)));
fun typedef_of ctxt T_name =
- if T_name = @{type_name set} then
+ if T_name = \<^type_name>\<open>set\<close> then
let
- val A = Logic.varifyT_global @{typ 'a};
- val absT = Type (@{type_name set}, [A]);
+ val A = Logic.varifyT_global \<^typ>\<open>'a\<close>;
+ val absT = Type (\<^type_name>\<open>set\<close>, [A]);
val repT = A --> HOLogic.boolT;
val pred = Abs (Name.uu, repT, @{const True});
- val abs = Const (@{const_name Collect}, repT --> absT);
- val rep = Const (@{const_name rmember}, absT --> repT);
+ val abs = Const (\<^const_name>\<open>Collect\<close>, repT --> absT);
+ val rep = Const (\<^const_name>\<open>rmember\<close>, absT --> repT);
in
(absT, repT, pred, abs, rep)
end
@@ -308,8 +308,8 @@
classify_type_name ctxt fpT_name = Co_Datatype andalso
let
val ctrs =
- if fpT_name = @{type_name itself} then
- [Const (@{const_name Pure.type}, @{typ "'a itself"})]
+ if fpT_name = \<^type_name>\<open>itself\<close> then
+ [Const (\<^const_name>\<open>Pure.type\<close>, \<^typ>\<open>'a itself\<close>)]
else
(case BNF_FP_Def_Sugar.fp_sugar_of ctxt fpT_name of
SOME {fp_ctr_sugar = {ctr_sugar = {ctrs, ...}, ...}, ...} => ctrs
@@ -330,7 +330,7 @@
(case strip_fun_type (Sign.the_const_type thy s) of
(gen_branch_Ts, gen_body_fun_T) =>
(case gen_body_fun_T of
- Type (@{type_name fun}, [Type (fpT_name, _), _]) =>
+ Type (\<^type_name>\<open>fun\<close>, [Type (fpT_name, _), _]) =>
if classify_type_name ctxt fpT_name = Co_Datatype then
let
val Type (_, fpTs) = domain_type (funpow (length gen_branch_Ts) range_type T);
@@ -352,7 +352,7 @@
fun is_quotient_abs ctxt (s, T) =
(case T of
- Type (@{type_name fun}, [_, Type (absT_name, _)]) =>
+ Type (\<^type_name>\<open>fun\<close>, [_, Type (absT_name, _)]) =>
classify_type_name ctxt absT_name = Quotient andalso
(case quotient_of ctxt absT_name of
(_, _, _, Const (s', _), _) => s' = s)
@@ -360,23 +360,23 @@
fun is_quotient_rep ctxt (s, T) =
(case T of
- Type (@{type_name fun}, [Type (absT_name, _), _]) =>
+ Type (\<^type_name>\<open>fun\<close>, [Type (absT_name, _), _]) =>
classify_type_name ctxt absT_name = Quotient andalso
(case quotient_of ctxt absT_name of
(_, _, _, _, Const (s', _)) => s' = s)
| _ => false);
fun is_maybe_typedef_abs ctxt absT_name s =
- if absT_name = @{type_name set} then
- s = @{const_name Collect}
+ if absT_name = \<^type_name>\<open>set\<close> then
+ s = \<^const_name>\<open>Collect\<close>
else
(case try (typedef_of ctxt) absT_name of
SOME (_, _, _, Const (s', _), _) => s' = s
| NONE => false);
fun is_maybe_typedef_rep ctxt absT_name s =
- if absT_name = @{type_name set} then
- s = @{const_name rmember}
+ if absT_name = \<^type_name>\<open>set\<close> then
+ s = \<^const_name>\<open>rmember\<close>
else
(case try (typedef_of ctxt) absT_name of
SOME (_, _, _, _, Const (s', _)) => s' = s
@@ -384,25 +384,25 @@
fun is_typedef_abs ctxt (s, T) =
(case T of
- Type (@{type_name fun}, [_, Type (absT_name, _)]) =>
+ Type (\<^type_name>\<open>fun\<close>, [_, Type (absT_name, _)]) =>
classify_type_name ctxt absT_name = Typedef andalso is_maybe_typedef_abs ctxt absT_name s
| _ => false);
fun is_typedef_rep ctxt (s, T) =
(case T of
- Type (@{type_name fun}, [Type (absT_name, _), _]) =>
+ Type (\<^type_name>\<open>fun\<close>, [Type (absT_name, _), _]) =>
classify_type_name ctxt absT_name = Typedef andalso is_maybe_typedef_rep ctxt absT_name s
| _ => false);
fun is_stale_typedef_abs ctxt (s, T) =
(case T of
- Type (@{type_name fun}, [_, Type (absT_name, _)]) =>
+ Type (\<^type_name>\<open>fun\<close>, [_, Type (absT_name, _)]) =>
classify_type_name ctxt absT_name <> Typedef andalso is_maybe_typedef_abs ctxt absT_name s
| _ => false);
fun is_stale_typedef_rep ctxt (s, T) =
(case T of
- Type (@{type_name fun}, [Type (absT_name, _), _]) =>
+ Type (\<^type_name>\<open>fun\<close>, [Type (absT_name, _), _]) =>
classify_type_name ctxt absT_name <> Typedef andalso is_maybe_typedef_rep ctxt absT_name s
| _ => false);
@@ -452,14 +452,14 @@
(case T of
TFree _ => Fin_or_Inf
| TVar _ => Inf
- | Type (@{type_name fun}, [T1, T2]) =>
+ | Type (\<^type_name>\<open>fun\<close>, [T1, T2]) =>
(case (card_of avoid T1, card_of avoid T2) of
(_, One) => One
| (k1, k2) => max_card k1 k2)
- | Type (@{type_name prod}, [T1, T2]) =>
+ | Type (\<^type_name>\<open>prod\<close>, [T1, T2]) =>
(case (card_of avoid T1, card_of avoid T2) of
(k1, k2) => max_card k1 k2)
- | Type (@{type_name set}, [T']) => card_of avoid (T' --> HOLogic.boolT)
+ | Type (\<^type_name>\<open>set\<close>, [T']) => card_of avoid (T' --> HOLogic.boolT)
| Type (T_name, Ts) =>
(case try (mutual_co_datatypes_of ctxt) (T_name, Ts) of
NONE => Inf
@@ -506,15 +506,15 @@
|> sort (classif_ord o apply2 fst);
val specs =
- if s = @{const_name The} then
- [(Spec_Rules.Unknown, ([Logic.varify_global @{term The}], [@{thm theI_unique}]))]
- else if s = @{const_name finite} then
+ if s = \<^const_name>\<open>The\<close> then
+ [(Spec_Rules.Unknown, ([Logic.varify_global \<^term>\<open>The\<close>], [@{thm theI_unique}]))]
+ else if s = \<^const_name>\<open>finite\<close> then
let val card = card_of_type ctxt T in
if card = Inf orelse card = Fin_or_Inf then
spec_rules ()
else
- [(Spec_Rules.Equational, ([Logic.varify_global @{term finite}],
- [Skip_Proof.make_thm thy (Logic.varify_global @{prop "finite A = True"})]))]
+ [(Spec_Rules.Equational, ([Logic.varify_global \<^term>\<open>finite\<close>],
+ [Skip_Proof.make_thm thy (Logic.varify_global \<^prop>\<open>finite A = True\<close>)]))]
end
else
spec_rules ();
@@ -522,8 +522,8 @@
fold process_spec specs NONE
end;
-fun lhs_of_equation (Const (@{const_name Pure.eq}, _) $ t $ _) = t
- | lhs_of_equation (@{const Trueprop} $ (Const (@{const_name HOL.eq}, _) $ t $ _)) = t;
+fun lhs_of_equation (Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t $ _) = t
+ | lhs_of_equation (@{const Trueprop} $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t $ _)) = t;
fun specialize_definition_type thy x def0 =
let
@@ -540,7 +540,7 @@
|> try hd;
fun is_builtin_theory thy_id =
- Context.subthy_id (thy_id, Context.theory_id @{theory Hilbert_Choice});
+ Context.subthy_id (thy_id, Context.theory_id \<^theory>\<open>Hilbert_Choice\<close>);
val orphan_axioms_of =
Spec_Rules.get
@@ -679,10 +679,10 @@
[cmd] :: (group :: groups)
end;
-fun defined_by (Const (@{const_name All}, _) $ t) = defined_by t
+fun defined_by (Const (\<^const_name>\<open>All\<close>, _) $ t) = defined_by t
| defined_by (Abs (_, _, t)) = defined_by t
| defined_by (@{const implies} $ _ $ u) = defined_by u
- | defined_by (Const (@{const_name HOL.eq}, _) $ t $ _) = head_of t
+ | defined_by (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t $ _) = head_of t
| defined_by t = head_of t;
fun partition_props [_] props = SOME [props]
@@ -694,14 +694,14 @@
else NONE
end;
-fun hol_concl_head (Const (@{const_name All}, _) $ Abs (_, _, t)) = hol_concl_head t
- | hol_concl_head (Const (@{const_name implies}, _) $ _ $ t) = hol_concl_head t
+fun hol_concl_head (Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, _, t)) = hol_concl_head t
+ | hol_concl_head (Const (\<^const_name>\<open>implies\<close>, _) $ _ $ t) = hol_concl_head t
| hol_concl_head (t $ _) = hol_concl_head t
| hol_concl_head t = t;
fun is_inductive_set_intro t =
(case hol_concl_head t of
- Const (@{const_name rmember}, _) => true
+ Const (\<^const_name>\<open>rmember\<close>, _) => true
| _ => false);
exception NO_TRIPLE of unit;
@@ -759,7 +759,7 @@
val j = fold (Integer.max o maxidx_of_term) intros 0 + 1;
val rel = (("R", j), rel_T);
val prop =
- Const (@{const_name wf}, rel_T --> HOLogic.boolT) $ Var rel ::
+ Const (\<^const_name>\<open>wf\<close>, rel_T --> HOLogic.boolT) $ Var rel ::
map (wf_constraint_for_triple rel) triples
|> foldr1 HOLogic.mk_conj
|> HOLogic.mk_Trueprop;
@@ -798,8 +798,8 @@
fun lhs_pat_of t =
(case t of
- Const (@{const_name All}, _) $ Abs (_, _, t) => lhs_pat_of t
- | Const (@{const_name HOL.eq}, _) $ u $ _ =>
+ Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, _, t) => lhs_pat_of t
+ | Const (\<^const_name>\<open>HOL.eq\<close>, _) $ u $ _ =>
(case filter_out is_Var_or_Bound (snd (strip_comb u)) of
[] => Only_Vars
| [v] =>
@@ -1016,9 +1016,9 @@
union (op aconv) (implicit_evals_of pol t) (implicit_evals_of pol u)
| implicit_evals_of pol (@{const disj} $ t $ u) =
union (op aconv) (implicit_evals_of pol t) (implicit_evals_of pol u)
- | implicit_evals_of false (Const (@{const_name HOL.eq}, _) $ t $ u) =
+ | implicit_evals_of false (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t $ u) =
distinct (op aconv) [t, u]
- | implicit_evals_of true (Const (@{const_name HOL.eq}, _) $ t $ _) = [t]
+ | implicit_evals_of true (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t $ _) = [t]
| implicit_evals_of _ _ = [];
val mono_axioms_and_some_assms =
--- a/src/HOL/Tools/Nunchaku/nunchaku_commands.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nunchaku/nunchaku_commands.ML Fri Jan 04 23:22:53 2019 +0100
@@ -240,10 +240,10 @@
val parse_value =
Scan.repeat1 (Parse.minus >> single
|| Scan.repeat1 (Scan.unless Parse.minus (Parse.name || Parse.float_number))
- || @{keyword ","} |-- Parse.number >> prefix "," >> single)
+ || \<^keyword>\<open>,\<close> |-- Parse.number >> prefix "," >> single)
>> flat;
-val parse_param = parse_key -- Scan.optional (@{keyword "="} |-- parse_value) [];
-val parse_params = Scan.optional (@{keyword "["} |-- Parse.list parse_param --| @{keyword "]"}) [];
+val parse_param = parse_key -- Scan.optional (\<^keyword>\<open>=\<close> |-- parse_value) [];
+val parse_params = Scan.optional (\<^keyword>\<open>[\<close> |-- Parse.list parse_param --| \<^keyword>\<open>]\<close>) [];
fun run_chaku override_params mode i state0 =
let
@@ -271,14 +271,14 @@
end));
val _ =
- Outer_Syntax.command @{command_keyword nunchaku}
+ Outer_Syntax.command \<^command_keyword>\<open>nunchaku\<close>
"try to find a countermodel using Nunchaku"
(parse_params -- Scan.optional Parse.nat 1 >> (fn (params, i) =>
Toplevel.keep_proof (fn state =>
ignore (run_chaku params Normal i (Toplevel.proof_of state)))));
val _ =
- Outer_Syntax.command @{command_keyword nunchaku_params}
+ Outer_Syntax.command \<^command_keyword>\<open>nunchaku_params\<close>
"set and display the default parameters for Nunchaku"
(parse_params #>> nunchaku_params_trans);
--- a/src/HOL/Tools/Nunchaku/nunchaku_reconstruct.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nunchaku/nunchaku_reconstruct.ML Fri Jan 04 23:22:53 2019 +0100
@@ -115,9 +115,9 @@
if id = nun_dummy then
dummyT
else if id = nun_prop then
- @{typ bool}
+ \<^typ>\<open>bool\<close>
else if id = nun_arrow then
- Type (@{type_name fun}, Ts)
+ Type (\<^type_name>\<open>fun\<close>, Ts)
else
(case try str_of_nun_tconst id of
SOME (args, s) =>
@@ -160,23 +160,23 @@
if id = nun_conj then
HOLogic.conj
else if id = nun_choice then
- Const (@{const_name Eps}, typ_of ty)
+ Const (\<^const_name>\<open>Eps\<close>, typ_of ty)
else if id = nun_disj then
HOLogic.disj
else if id = nun_equals then
- Const (@{const_name HOL.eq}, typ_of ty)
+ Const (\<^const_name>\<open>HOL.eq\<close>, typ_of ty)
else if id = nun_false then
@{const False}
else if id = nun_if then
- Const (@{const_name If}, typ_of ty)
+ Const (\<^const_name>\<open>If\<close>, typ_of ty)
else if id = nun_implies then
- @{term implies}
+ \<^term>\<open>implies\<close>
else if id = nun_not then
HOLogic.Not
else if id = nun_unique then
- Const (@{const_name The}, typ_of ty)
+ Const (\<^const_name>\<open>The\<close>, typ_of ty)
else if id = nun_unique_unsafe then
- Const (@{const_name The_unsafe}, typ_of ty)
+ Const (\<^const_name>\<open>The_unsafe\<close>, typ_of ty)
else if id = nun_true then
@{const True}
else if String.isPrefix nun_dollar_anon_fun_prefix id then
@@ -216,7 +216,7 @@
(NConst (id, _, _), NAbs _) =>
if id = nun_mu then
let val Abs (s, T, body) = term_of bounds arg in
- Const (@{const_name The}, (T --> HOLogic.boolT) --> T)
+ Const (\<^const_name>\<open>The\<close>, (T --> HOLogic.boolT) --> T)
$ Abs (s, T, HOLogic.eq_const T $ Bound 0 $ body)
end
else
@@ -227,10 +227,10 @@
fun rewrite_numbers (t as @{const Suc} $ _) =
(case try HOLogic.dest_nat t of
- SOME n => HOLogic.mk_number @{typ nat} n
+ SOME n => HOLogic.mk_number \<^typ>\<open>nat\<close> n
| NONE => t)
| rewrite_numbers (@{const Abs_Integ} $ (@{const Pair (nat, nat)} $ t $ u)) =
- HOLogic.mk_number @{typ int} (HOLogic.dest_nat t - HOLogic.dest_nat u)
+ HOLogic.mk_number \<^typ>\<open>int\<close> (HOLogic.dest_nat t - HOLogic.dest_nat u)
| rewrite_numbers (t $ u) = rewrite_numbers t $ rewrite_numbers u
| rewrite_numbers (Abs (s, T, t)) = Abs (s, T, rewrite_numbers t)
| rewrite_numbers t = t;
@@ -264,7 +264,7 @@
let
val pat_complete_model' = if Config.get ctxt show_consts then pat_complete_model else [];
val pat_incomplete_model' = pat_incomplete_model
- |> filter_out (can (fn Const (@{const_name unreachable}, _) => ()) o fst);
+ |> filter_out (can (fn Const (\<^const_name>\<open>unreachable\<close>, _) => ()) o fst);
val term_model = free_model @ pat_complete_model' @ pat_incomplete_model' @
skolem_model @ auxiliary_model;
--- a/src/HOL/Tools/Nunchaku/nunchaku_translate.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nunchaku/nunchaku_translate.ML Fri Jan 04 23:22:53 2019 +0100
@@ -48,8 +48,8 @@
fun ty_of_isa (Type (s, Ts)) =
let val tys = map ty_of_isa Ts in
(case s of
- @{type_name bool} => prop_ty
- | @{type_name fun} => NType (nun_arrow, tys)
+ \<^type_name>\<open>bool\<close> => prop_ty
+ | \<^type_name>\<open>fun\<close> => NType (nun_arrow, tys)
| _ =>
let
val args = map lowlevel_str_of_ty tys;
@@ -97,7 +97,7 @@
|> abs_tms vars
end
| NONE =>
- if s = @{const_name unreachable} andalso in_prop then
+ if s = \<^const_name>\<open>unreachable\<close> andalso in_prop then
let val ty = ty_of_isa T in
napps (NConst (nun_asserting, [ty], mk_arrows_ty ([ty, prop_ty], ty)),
[NConst (id_of_const x, [], ty), NConst (nun_false, [], prop_ty)])
@@ -106,19 +106,19 @@
let
val id =
(case s of
- @{const_name All} => nun_forall
- | @{const_name conj} => nun_conj
- | @{const_name disj} => nun_disj
- | @{const_name HOL.eq} => nun_equals
- | @{const_name Eps} => nun_choice
- | @{const_name Ex} => nun_exists
- | @{const_name False} => nun_false
- | @{const_name If} => nun_if
- | @{const_name implies} => nun_implies
- | @{const_name Not} => nun_not
- | @{const_name The} => nun_unique
- | @{const_name The_unsafe} => nun_unique_unsafe
- | @{const_name True} => nun_true
+ \<^const_name>\<open>All\<close> => nun_forall
+ | \<^const_name>\<open>conj\<close> => nun_conj
+ | \<^const_name>\<open>disj\<close> => nun_disj
+ | \<^const_name>\<open>HOL.eq\<close> => nun_equals
+ | \<^const_name>\<open>Eps\<close> => nun_choice
+ | \<^const_name>\<open>Ex\<close> => nun_exists
+ | \<^const_name>\<open>False\<close> => nun_false
+ | \<^const_name>\<open>If\<close> => nun_if
+ | \<^const_name>\<open>implies\<close> => nun_implies
+ | \<^const_name>\<open>Not\<close> => nun_not
+ | \<^const_name>\<open>The\<close> => nun_unique
+ | \<^const_name>\<open>The_unsafe\<close> => nun_unique_unsafe
+ | \<^const_name>\<open>True\<close> => nun_true
| _ => id_of_const x);
in
NConst (id, [], ty_of_isa T)
--- a/src/HOL/Tools/Nunchaku/nunchaku_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Nunchaku/nunchaku_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -61,8 +61,8 @@
(* Clone from "HOL/Tools/inductive_realizer.ML". *)
val attach_typeS =
map_types (map_atyps
- (fn TFree (s, []) => TFree (s, @{sort type})
- | TVar (ixn, []) => TVar (ixn, @{sort type})
+ (fn TFree (s, []) => TFree (s, \<^sort>\<open>type\<close>)
+ | TVar (ixn, []) => TVar (ixn, \<^sort>\<open>type\<close>)
| T => T));
val specialize_type = ATP_Util.specialize_type;
--- a/src/HOL/Tools/Old_Datatype/old_datatype_aux.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Old_Datatype/old_datatype_aux.ML Fri Jan 04 23:22:53 2019 +0100
@@ -115,8 +115,8 @@
fun split_conj_thm th =
((th RS conjunct1) :: split_conj_thm (th RS conjunct2)) handle THM _ => [th];
-val mk_conj = foldr1 (HOLogic.mk_binop @{const_name HOL.conj});
-val mk_disj = foldr1 (HOLogic.mk_binop @{const_name HOL.disj});
+val mk_conj = foldr1 (HOLogic.mk_binop \<^const_name>\<open>HOL.conj\<close>);
+val mk_disj = foldr1 (HOLogic.mk_binop \<^const_name>\<open>HOL.disj\<close>);
fun app_bnds t i = list_comb (t, map Bound (i - 1 downto 0));
--- a/src/HOL/Tools/Old_Datatype/old_datatype_data.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Old_Datatype/old_datatype_data.ML Fri Jan 04 23:22:53 2019 +0100
@@ -242,7 +242,7 @@
structure Old_Datatype_Plugin = Plugin(type T = Old_Datatype_Aux.config * string list);
-val old_datatype_plugin = Plugin_Name.declare_setup @{binding old_datatype};
+val old_datatype_plugin = Plugin_Name.declare_setup \<^binding>\<open>old_datatype\<close>;
fun interpretation f =
Old_Datatype_Plugin.interpretation old_datatype_plugin
--- a/src/HOL/Tools/Old_Datatype/old_datatype_prop.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Old_Datatype/old_datatype_prop.ML Fri Jan 04 23:22:53 2019 +0100
@@ -58,7 +58,7 @@
in
cons (HOLogic.mk_Trueprop (HOLogic.mk_eq
(HOLogic.mk_eq (list_comb (constr_t, frees), list_comb (constr_t, frees')),
- foldr1 (HOLogic.mk_binop @{const_name HOL.conj})
+ foldr1 (HOLogic.mk_binop \<^const_name>\<open>HOL.conj\<close>)
(map HOLogic.mk_eq (frees ~~ frees')))))
end;
in
@@ -140,7 +140,7 @@
maps (fn ((i, (_, _, constrs)), T) => map (make_ind_prem i T) constrs) (descr' ~~ recTs);
val tnames = make_tnames recTs;
val concl =
- HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop @{const_name HOL.conj})
+ HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop \<^const_name>\<open>HOL.conj\<close>)
(map (fn (((i, _), T), tname) => make_pred i T $ Free (tname, T))
(descr' ~~ recTs ~~ tnames)));
@@ -182,7 +182,7 @@
val rec_result_Ts =
map TFree
(Name.variant_list used (replicate (length descr') "'t") ~~
- replicate (length descr') @{sort type});
+ replicate (length descr') \<^sort>\<open>type\<close>);
val reccomb_fn_Ts = maps (fn (i, (_, _, constrs)) =>
map (fn (_, cargs) =>
@@ -252,7 +252,7 @@
val recTs = Old_Datatype_Aux.get_rec_types descr';
val used = fold Term.add_tfree_namesT recTs [];
val newTs = take (length (hd descr)) recTs;
- val T' = TFree (singleton (Name.variant_list used) "'t", @{sort type});
+ val T' = TFree (singleton (Name.variant_list used) "'t", \<^sort>\<open>type\<close>);
val case_fn_Ts = map (fn (i, (_, _, constrs)) =>
map (fn (_, cargs) =>
@@ -297,7 +297,7 @@
val recTs = Old_Datatype_Aux.get_rec_types descr';
val used' = fold Term.add_tfree_namesT recTs [];
val newTs = take (length (hd descr)) recTs;
- val T' = TFree (singleton (Name.variant_list used') "'t", @{sort type});
+ val T' = TFree (singleton (Name.variant_list used') "'t", \<^sort>\<open>type\<close>);
val P = Free ("P", T' --> HOLogic.boolT);
fun make_split (((_, (_, _, constrs)), T), comb_t) =
--- a/src/HOL/Tools/Old_Datatype/old_primrec.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Old_Datatype/old_primrec.ML Fri Jan 04 23:22:53 2019 +0100
@@ -34,8 +34,8 @@
fun process_eqn is_fixed spec rec_fns =
let
- val (vs, Ts) = split_list (strip_qnt_vars @{const_name Pure.all} spec);
- val body = strip_qnt_body @{const_name Pure.all} spec;
+ val (vs, Ts) = split_list (strip_qnt_vars \<^const_name>\<open>Pure.all\<close> spec);
+ val body = strip_qnt_body \<^const_name>\<open>Pure.all\<close> spec;
val (vs', _) = fold_map Name.variant vs (Name.make_context (fold_aterms
(fn Free (v, _) => insert (op =) v | _ => I) body []));
val eqn = curry subst_bounds (map2 (curry Free) vs' Ts |> rev) body;
@@ -142,7 +142,7 @@
(case AList.lookup (op =) eqns cname of
NONE => (warning ("No equation for constructor " ^ quote cname ^
"\nin definition of function " ^ quote fname);
- (fnames', fnss', (Const (@{const_name undefined}, dummyT)) :: fns))
+ (fnames', fnss', (Const (\<^const_name>\<open>undefined\<close>, dummyT)) :: fns))
| SOME (ls, cargs', rs, rhs, eq) =>
let
val recs = filter (Old_Datatype_Aux.is_rec_type o snd) (cargs' ~~ cargs);
@@ -181,7 +181,7 @@
(case AList.lookup (op =) fns i of
NONE =>
let
- val dummy_fns = map (fn (_, cargs) => Const (@{const_name undefined},
+ val dummy_fns = map (fn (_, cargs) => Const (\<^const_name>\<open>undefined\<close>,
replicate (length cargs + length (filter Old_Datatype_Aux.is_rec_type cargs))
dummyT ---> HOLogic.unitT)) constrs;
val _ = warning ("No function definition for datatype " ^ quote tname)
--- a/src/HOL/Tools/Old_Datatype/old_rep_datatype.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Old_Datatype/old_rep_datatype.ML Fri Jan 04 23:22:53 2019 +0100
@@ -41,7 +41,7 @@
fun prove_casedist_thm (i, (T, t)) =
let
val dummyPs = map (fn (Var (_, Type (_, [T', T'']))) =>
- Abs ("z", T', Const (@{const_name True}, T''))) induct_Ps;
+ Abs ("z", T', Const (\<^const_name>\<open>True\<close>, T''))) induct_Ps;
val P =
Abs ("z", T, HOLogic.imp $ HOLogic.mk_eq (Var (("a", maxidx + 1), T), Bound 0) $
Var (("P", 0), HOLogic.boolT));
@@ -203,7 +203,7 @@
let
val rec_unique_ts =
map (fn (((set_t, T1), T2), i) =>
- Const (@{const_name Ex1}, (T2 --> HOLogic.boolT) --> HOLogic.boolT) $
+ Const (\<^const_name>\<open>Ex1\<close>, (T2 --> HOLogic.boolT) --> HOLogic.boolT) $
absfree ("y", T2) (set_t $ Old_Datatype_Aux.mk_Free "x" T1 i $ Free ("y", T2)))
(rec_sets ~~ recTs ~~ rec_result_Ts ~~ (1 upto length recTs));
val insts =
@@ -247,7 +247,7 @@
(fn ((((name, comb), set), T), T') =>
(Binding.name (Thm.def_name (Long_Name.base_name name)),
Logic.mk_equals (comb, fold_rev lambda rec_fns (absfree ("x", T)
- (Const (@{const_name The}, (T' --> HOLogic.boolT) --> T') $ absfree ("y", T')
+ (Const (\<^const_name>\<open>The\<close>, (T' --> HOLogic.boolT) --> T') $ absfree ("y", T')
(set $ Free ("x", T) $ Free ("y", T')))))))
(reccomb_names ~~ reccombs ~~ rec_sets ~~ recTs ~~ rec_result_Ts))
||> Sign.parent_path;
@@ -272,7 +272,7 @@
thy2
|> Sign.add_path (space_implode "_" new_type_names)
|> Global_Theory.note_thms ""
- ((Binding.name "rec", [Named_Theorems.add @{named_theorems nitpick_simp}]), [(rec_thms, [])])
+ ((Binding.name "rec", [Named_Theorems.add \<^named_theorems>\<open>nitpick_simp\<close>]), [(rec_thms, [])])
||> Sign.parent_path
|-> (fn (_, thms) => pair (reccomb_names, thms))
end;
@@ -293,7 +293,7 @@
val recTs = Old_Datatype_Aux.get_rec_types descr';
val used = fold Term.add_tfree_namesT recTs [];
val newTs = take (length (hd descr)) recTs;
- val T' = TFree (singleton (Name.variant_list used) "'t", @{sort type});
+ val T' = TFree (singleton (Name.variant_list used) "'t", \<^sort>\<open>type\<close>);
fun mk_dummyT dt = binder_types (Old_Datatype_Aux.typ_of_dtyp descr' dt) ---> T';
@@ -302,7 +302,7 @@
let
val Ts = map (Old_Datatype_Aux.typ_of_dtyp descr') cargs;
val Ts' = map mk_dummyT (filter Old_Datatype_Aux.is_rec_type cargs)
- in Const (@{const_name undefined}, Ts @ Ts' ---> T') end) constrs) descr';
+ in Const (\<^const_name>\<open>undefined\<close>, Ts @ Ts' ---> T') end) constrs) descr';
val case_names0 = map (fn s => Sign.full_bname thy1 ("case_" ^ s)) new_type_names;
@@ -364,7 +364,7 @@
in
thy2
|> Context.theory_map
- ((fold o fold) (Named_Theorems.add_thm @{named_theorems nitpick_simp}) case_thms)
+ ((fold o fold) (Named_Theorems.add_thm \<^named_theorems>\<open>nitpick_simp\<close>) case_thms)
|> Sign.parent_path
|> Old_Datatype_Aux.store_thmss "case" new_type_names case_thms
|-> (fn thmss => pair (thmss, case_names))
@@ -454,8 +454,8 @@
let
fun prove_case_cong ((t, nchotomy), case_rewrites) =
let
- val Const (@{const_name Pure.imp}, _) $ tm $ _ = t;
- val Const (@{const_name Trueprop}, _) $ (Const (@{const_name HOL.eq}, _) $ _ $ Ma) = tm;
+ val Const (\<^const_name>\<open>Pure.imp\<close>, _) $ tm $ _ = t;
+ val Const (\<^const_name>\<open>Trueprop\<close>, _) $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ Ma) = tm;
val nchotomy' = nchotomy RS spec;
val [v] = Term.add_var_names (Thm.concl_of nchotomy') [];
in
@@ -686,7 +686,7 @@
(* outer syntax *)
val _ =
- Outer_Syntax.command @{command_keyword old_rep_datatype}
+ Outer_Syntax.command \<^command_keyword>\<open>old_rep_datatype\<close>
"register existing types as old-style datatypes"
(Scan.repeat1 Parse.term >> (fn ts =>
Toplevel.theory_to_proof (rep_datatype_cmd Old_Datatype_Aux.default_config (K I) ts)));
--- a/src/HOL/Tools/Predicate_Compile/code_prolog.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/code_prolog.ML Fri Jan 04 23:22:53 2019 +0100
@@ -123,7 +123,7 @@
fun string_of_system SWI_PROLOG = "swiprolog"
| string_of_system YAP = "yap"
-val prolog_system = Attrib.setup_config_string @{binding prolog_system} (K "swiprolog")
+val prolog_system = Attrib.setup_config_string \<^binding>\<open>prolog_system\<close> (K "swiprolog")
fun get_prolog_system ctxt =
(case Config.get ctxt prolog_system of
@@ -132,7 +132,7 @@
| name => error ("Bad prolog system: " ^ quote name ^ " (\"swiprolog\" or \"yap\" expected)"))
-val prolog_timeout = Attrib.setup_config_real @{binding prolog_timeout} (K 10.0)
+val prolog_timeout = Attrib.setup_config_real \<^binding>\<open>prolog_timeout\<close> (K 10.0)
fun get_prolog_timeout ctxt = seconds (Config.get ctxt prolog_timeout)
@@ -250,20 +250,20 @@
(** translation of terms, literals, premises, and clauses **)
-fun translate_arith_const @{const_name "Groups.plus_class.plus"} = SOME Plus
- | translate_arith_const @{const_name "Groups.minus_class.minus"} = SOME Minus
+fun translate_arith_const \<^const_name>\<open>Groups.plus_class.plus\<close> = SOME Plus
+ | translate_arith_const \<^const_name>\<open>Groups.minus_class.minus\<close> = SOME Minus
| translate_arith_const _ = NONE
fun mk_nat_term constant_table n =
let
- val zero = translate_const constant_table @{const_name "Groups.zero_class.zero"}
- val Suc = translate_const constant_table @{const_name "Suc"}
+ val zero = translate_const constant_table \<^const_name>\<open>Groups.zero_class.zero\<close>
+ val Suc = translate_const constant_table \<^const_name>\<open>Suc\<close>
in funpow n (fn t => AppF (Suc, [t])) (Cons zero) end
fun translate_term ctxt constant_table t =
(case try HOLogic.dest_number t of
- SOME (@{typ "int"}, n) => Number n
- | SOME (@{typ "nat"}, n) => mk_nat_term constant_table n
+ SOME (\<^typ>\<open>int\<close>, n) => Number n
+ | SOME (\<^typ>\<open>nat\<close>, n) => mk_nat_term constant_table n
| NONE =>
(case strip_comb t of
(Free (v, T), []) => Var v
@@ -277,7 +277,7 @@
fun translate_literal ctxt constant_table t =
(case strip_comb t of
- (Const (@{const_name HOL.eq}, _), [l, r]) =>
+ (Const (\<^const_name>\<open>HOL.eq\<close>, _), [l, r]) =>
let
val l' = translate_term ctxt constant_table l
val r' = translate_term ctxt constant_table r
@@ -306,7 +306,7 @@
fun imp_prems_conv cv ct =
(case Thm.term_of ct of
- Const (@{const_name Pure.imp}, _) $ _ $ _ =>
+ Const (\<^const_name>\<open>Pure.imp\<close>, _) $ _ $ _ =>
Conv.combination_conv (Conv.arg_conv cv) (imp_prems_conv cv) ct
| _ => Conv.all_conv ct)
@@ -493,7 +493,7 @@
val gr' = add_edges depending_preds_of const gr
val scc = strong_conn_of gr' [const]
val initial_constant_table =
- declare_consts [@{const_name "Groups.zero_class.zero"}, @{const_name "Suc"}] []
+ declare_consts [\<^const_name>\<open>Groups.zero_class.zero\<close>, \<^const_name>\<open>Suc\<close>] []
in
(case use_modes of
SOME mode =>
@@ -895,7 +895,7 @@
(* restoring types in terms *)
fun restore_term ctxt constant_table (Var s, T) = Free (s, T)
- | restore_term ctxt constant_table (Number n, @{typ "int"}) = HOLogic.mk_number @{typ "int"} n
+ | restore_term ctxt constant_table (Number n, \<^typ>\<open>int\<close>) = HOLogic.mk_number \<^typ>\<open>int\<close> n
| restore_term ctxt constant_table (Number n, _) = raise (Fail "unexpected type for number")
| restore_term ctxt constant_table (Cons s, T) = Const (restore_const constant_table s, T)
| restore_term ctxt constant_table (AppF (f, args), T) =
@@ -915,8 +915,8 @@
(* restore numerals in natural numbers *)
fun restore_nat_numerals t =
- if fastype_of t = @{typ nat} andalso is_some (try HOLogic.dest_nat t) then
- HOLogic.mk_number @{typ nat} (HOLogic.dest_nat t)
+ if fastype_of t = \<^typ>\<open>nat\<close> andalso is_some (try HOLogic.dest_nat t) then
+ HOLogic.mk_number \<^typ>\<open>nat\<close> (HOLogic.dest_nat t)
else
(case t of
t1 $ t2 => restore_nat_numerals t1 $ restore_nat_numerals t2
@@ -954,7 +954,7 @@
val options = code_options_of (Proof_Context.theory_of ctxt)
val split =
(case t_compr of
- (Const (@{const_name Collect}, _) $ t) => t
+ (Const (\<^const_name>\<open>Collect\<close>, _) $ t) => t
| _ => error ("Not a set comprehension: " ^ Syntax.string_of_term ctxt t_compr))
val (body, Ts, fp) = HOLogic.strip_ptupleabs split
val output_names = Name.variant_list (Term.add_free_names body [])
@@ -980,9 +980,9 @@
val _ = tracing "Running prolog program..."
val tss = run ctxt p (translate_const constant_table' name, args') output_names soln
val _ = tracing "Restoring terms..."
- val empty = Const(@{const_name bot}, fastype_of t_compr)
+ val empty = Const(\<^const_name>\<open>bot\<close>, fastype_of t_compr)
fun mk_insert x S =
- Const (@{const_name "Set.insert"}, fastype_of x --> fastype_of S --> fastype_of S) $ x $ S
+ Const (\<^const_name>\<open>Set.insert\<close>, fastype_of x --> fastype_of S --> fastype_of S) $ x $ S
fun mk_set_compr in_insert [] xs =
rev ((Free ("dots", fastype_of t_compr)) :: (* FIXME proper name!? *)
(if null in_insert then xs else (fold mk_insert in_insert empty) :: xs))
@@ -999,7 +999,7 @@
val set_compr =
HOLogic.mk_Collect (uuN, uuT,
fold (fn (s, T) => fn t => HOLogic.mk_exists (s, T, t))
- frees (HOLogic.mk_conj (HOLogic.mk_eq (Free uu, t), @{term "True"})))
+ frees (HOLogic.mk_conj (HOLogic.mk_eq (Free uu, t), \<^term>\<open>True\<close>)))
in
mk_set_compr [] ts
(set_compr ::
@@ -1007,7 +1007,7 @@
end
end
in
- foldl1 (HOLogic.mk_binop @{const_name sup}) (mk_set_compr []
+ foldl1 (HOLogic.mk_binop \<^const_name>\<open>sup\<close>) (mk_set_compr []
(map (fn ts => HOLogic.mk_tuple
(map (restore_nat_numerals o restore_term ctxt' constant_table) (ts ~~ Ts))) tss) [])
end
@@ -1030,10 +1030,10 @@
(* values command for Prolog queries *)
val opt_print_modes =
- Scan.optional (@{keyword "("} |-- Parse.!!! (Scan.repeat1 Parse.name --| @{keyword ")"})) []
+ Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.!!! (Scan.repeat1 Parse.name --| \<^keyword>\<open>)\<close>)) []
val _ =
- Outer_Syntax.command @{command_keyword values_prolog}
+ Outer_Syntax.command \<^command_keyword>\<open>values_prolog\<close>
"enumerate and print comprehensions"
(opt_print_modes -- Scan.optional (Parse.nat >> SOME) NONE -- Parse.term
>> (fn ((print_modes, soln), t) => Toplevel.keep (values_cmd print_modes soln t)))
@@ -1043,7 +1043,7 @@
(* FIXME: a small clone of Predicate_Compile_Quickcheck - maybe refactor out commons *)
-val active = Attrib.setup_config_bool @{binding quickcheck_prolog_active} (K true)
+val active = Attrib.setup_config_bool \<^binding>\<open>quickcheck_prolog_active\<close> (K true)
fun test_term ctxt (t, eval_terms) =
let
@@ -1053,7 +1053,7 @@
val ((((full_constname, constT), vs'), intro), thy1) =
Predicate_Compile_Aux.define_quickcheck_predicate t' thy
val thy2 =
- Context.theory_map (Named_Theorems.add_thm @{named_theorems code_pred_def} intro) thy1
+ Context.theory_map (Named_Theorems.add_thm \<^named_theorems>\<open>code_pred_def\<close> intro) thy1
val thy3 = Predicate_Compile.preprocess preprocess_options (Const (full_constname, constT)) thy2
val ctxt' = Proof_Context.init_global thy3
val _ = tracing "Generating prolog program..."
--- a/src/HOL/Tools/Predicate_Compile/core_data.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/core_data.ML Fri Jan 04 23:22:53 2019 +0100
@@ -301,8 +301,8 @@
in
fold Term.add_const_names intros []
|> (fn cs =>
- if member (op =) cs @{const_name "HOL.eq"} then
- insert (op =) @{const_name Predicate.eq} cs
+ if member (op =) cs \<^const_name>\<open>HOL.eq\<close> then
+ insert (op =) \<^const_name>\<open>Predicate.eq\<close> cs
else cs)
|> filter (fn c => (not (c = key)) andalso
(is_inductive_predicate ctxt c orelse is_registered ctxt c))
--- a/src/HOL/Tools/Predicate_Compile/mode_inference.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/mode_inference.ML Fri Jan 04 23:22:53 2019 +0100
@@ -151,7 +151,7 @@
fun all_input_of T =
let
val (Ts, U) = strip_type T
- fun input_of (Type (@{type_name Product_Type.prod}, [T1, T2])) = Pair (input_of T1, input_of T2)
+ fun input_of (Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) = Pair (input_of T1, input_of T2)
| input_of _ = Input
in
if U = HOLogic.boolT then
@@ -223,7 +223,7 @@
fun missing_vars vs t = subtract (op =) vs (term_vs t)
-fun output_terms (Const (@{const_name Pair}, _) $ t1 $ t2, Mode_Pair (d1, d2)) =
+fun output_terms (Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2, Mode_Pair (d1, d2)) =
output_terms (t1, d1) @ output_terms (t2, d2)
| output_terms (t1 $ t2, Mode_App (d1, d2)) =
output_terms (t1, d1) @ output_terms (t2, d2)
@@ -239,7 +239,7 @@
SOME ms => SOME (map (fn m => (Context m , [])) ms)
| NONE => NONE)
-fun derivations_of (ctxt : Proof.context) modes vs (Const (@{const_name Pair}, _) $ t1 $ t2) (Pair (m1, m2)) =
+fun derivations_of (ctxt : Proof.context) modes vs (Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2) (Pair (m1, m2)) =
map_product
(fn (m1, mvars1) => fn (m2, mvars2) => (Mode_Pair (m1, m2), union (op =) mvars1 mvars2))
(derivations_of ctxt modes vs t1 m1) (derivations_of ctxt modes vs t2 m2)
@@ -254,7 +254,7 @@
else if eq_mode (m, Output) then
(if is_possible_output ctxt vs t then [(Term Output, [])] else [])
else []
-and all_derivations_of ctxt modes vs (Const (@{const_name Pair}, _) $ t1 $ t2) =
+and all_derivations_of ctxt modes vs (Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2) =
let
val derivs1 = all_derivations_of ctxt modes vs t1
val derivs2 = all_derivations_of ctxt modes vs t2
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile.ML Fri Jan 04 23:22:53 2019 +0100
@@ -90,7 +90,7 @@
ts
val _ = print_step options ("Preprocessing scc of " ^
commas (map (Syntax.string_of_term_global thy) ts))
- val (prednames, funnames) = List.partition (fn t => body_type (fastype_of t) = @{typ bool}) ts
+ val (prednames, funnames) = List.partition (fn t => body_type (fastype_of t) = \<^typ>\<open>bool\<close>) ts
(* untangle recursion by defining predicates for all functions *)
val _ = print_step options
("Compiling functions (" ^ commas (map (Syntax.string_of_term_global thy) funnames) ^
@@ -228,15 +228,15 @@
val opt_modes =
- Scan.optional (@{keyword "("} |-- Args.$$$ "modes" |-- @{keyword ":"} |--
- (((Parse.enum1 "and" (Parse.name --| @{keyword ":"} --
+ Scan.optional (\<^keyword>\<open>(\<close> |-- Args.$$$ "modes" |-- \<^keyword>\<open>:\<close> |--
+ (((Parse.enum1 "and" (Parse.name --| \<^keyword>\<open>:\<close> --
(Parse.enum "," mode_and_opt_proposal))) >> Multiple_Preds)
|| ((Parse.enum "," mode_and_opt_proposal) >> Single_Pred))
- --| @{keyword ")"}) (Multiple_Preds [])
+ --| \<^keyword>\<open>)\<close>) (Multiple_Preds [])
val opt_expected_modes =
- Scan.optional (@{keyword "("} |-- Args.$$$ "expected_modes" |-- @{keyword ":"} |--
- Parse.enum "," parse_mode_expr --| @{keyword ")"} >> SOME) NONE
+ Scan.optional (\<^keyword>\<open>(\<close> |-- Args.$$$ "expected_modes" |-- \<^keyword>\<open>:\<close> |--
+ Parse.enum "," parse_mode_expr --| \<^keyword>\<open>)\<close> >> SOME) NONE
(* Parser for options *)
@@ -246,18 +246,18 @@
val scan_bool_option = foldl1 (op ||) (map Args.$$$ bool_options)
val scan_compilation = foldl1 (op ||) (map (fn (s, c) => Args.$$$ s >> K c) compilation_names)
in
- Scan.optional (@{keyword "["} |-- Scan.optional scan_compilation Pred
- -- Parse.enum "," scan_bool_option --| @{keyword "]"})
+ Scan.optional (\<^keyword>\<open>[\<close> |-- Scan.optional scan_compilation Pred
+ -- Parse.enum "," scan_bool_option --| \<^keyword>\<open>]\<close>)
(Pred, [])
end
val opt_print_modes =
- Scan.optional (@{keyword "("} |-- Parse.!!! (Scan.repeat1 Parse.name --| @{keyword ")"})) []
+ Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.!!! (Scan.repeat1 Parse.name --| \<^keyword>\<open>)\<close>)) []
val opt_mode = (Args.$$$ "_" >> K NONE) || (parse_mode_expr >> SOME)
-val opt_param_modes = Scan.optional (@{keyword "["} |-- Args.$$$ "mode" |-- @{keyword ":"} |--
- Parse.enum ", " opt_mode --| @{keyword "]"} >> SOME) NONE
+val opt_param_modes = Scan.optional (\<^keyword>\<open>[\<close> |-- Args.$$$ "mode" |-- \<^keyword>\<open>:\<close> |--
+ Parse.enum ", " opt_mode --| \<^keyword>\<open>]\<close> >> SOME) NONE
val stats = Scan.optional (Args.$$$ "stats" >> K true) false
@@ -272,7 +272,7 @@
(Pred, [])
in
Scan.optional
- (@{keyword "["} |-- (expected_values -- stats) -- scan_compilation --| @{keyword "]"})
+ (\<^keyword>\<open>[\<close> |-- (expected_values -- stats) -- scan_compilation --| \<^keyword>\<open>]\<close>)
((NONE, false), (Pred, []))
end
@@ -280,12 +280,12 @@
(* code_pred command and values command *)
val _ =
- Outer_Syntax.local_theory_to_proof @{command_keyword code_pred}
+ Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>code_pred\<close>
"prove equations for predicate specified by intro/elim rules"
(opt_expected_modes -- opt_modes -- scan_options -- Parse.term >> code_pred_cmd)
val _ =
- Outer_Syntax.command @{command_keyword values}
+ Outer_Syntax.command \<^command_keyword>\<open>values\<close>
"enumerate and print comprehensions"
(opt_print_modes -- opt_param_modes -- value_options -- Scan.optional Parse.nat ~1 -- Parse.term
>> (fn ((((print_modes, param_modes), options), k), t) => Toplevel.keep
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_aux.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_aux.ML Fri Jan 04 23:22:53 2019 +0100
@@ -229,7 +229,7 @@
else
[Input, Output]
end
- | all_modes_of_typ' (Type (@{type_name Product_Type.prod}, [T1, T2])) =
+ | all_modes_of_typ' (Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) =
map_product (curry Pair) (all_modes_of_typ' T1) (all_modes_of_typ' T2)
| all_modes_of_typ' _ = [Input, Output]
@@ -237,20 +237,20 @@
let
val (S, U) = strip_type T
in
- if U = @{typ bool} then
+ if U = \<^typ>\<open>bool\<close> then
fold_rev (fn m1 => fn m2 => map_product (curry Fun) m1 m2)
(map all_modes_of_typ' S) [Bool]
else
raise Fail "Invocation of all_modes_of_typ with a non-predicate type"
end
- | all_modes_of_typ @{typ bool} = [Bool]
+ | all_modes_of_typ \<^typ>\<open>bool\<close> = [Bool]
| all_modes_of_typ _ =
raise Fail "Invocation of all_modes_of_typ with a non-predicate type"
fun all_smodes_of_typ (T as Type ("fun", _)) =
let
val (S, U) = strip_type T
- fun all_smodes (Type (@{type_name Product_Type.prod}, [T1, T2])) =
+ fun all_smodes (Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) =
map_product (curry Pair) (all_smodes T1) (all_smodes T2)
| all_smodes _ = [Input, Output]
in
@@ -273,7 +273,7 @@
let
fun ho_arg (Fun _) (SOME t) = [t]
| ho_arg (Fun _) NONE = raise Fail "mode and term do not match"
- | ho_arg (Pair (m1, m2)) (SOME (Const (@{const_name Pair}, _) $ t1 $ t2)) =
+ | ho_arg (Pair (m1, m2)) (SOME (Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2)) =
ho_arg m1 (SOME t1) @ ho_arg m2 (SOME t2)
| ho_arg (Pair (m1, m2)) NONE = ho_arg m1 NONE @ ho_arg m2 NONE
| ho_arg _ _ = []
@@ -284,12 +284,12 @@
fun ho_args_of_typ T ts =
let
fun ho_arg (T as Type ("fun", [_, _])) (SOME t) =
- if body_type T = @{typ bool} then [t] else []
+ if body_type T = \<^typ>\<open>bool\<close> then [t] else []
| ho_arg (Type ("fun", [_, _])) NONE = raise Fail "mode and term do not match"
- | ho_arg (Type(@{type_name "Product_Type.prod"}, [T1, T2]))
- (SOME (Const (@{const_name Pair}, _) $ t1 $ t2)) =
+ | ho_arg (Type(\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2]))
+ (SOME (Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2)) =
ho_arg T1 (SOME t1) @ ho_arg T2 (SOME t2)
- | ho_arg (Type(@{type_name "Product_Type.prod"}, [T1, T2])) NONE =
+ | ho_arg (Type(\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) NONE =
ho_arg T1 NONE @ ho_arg T2 NONE
| ho_arg _ _ = []
in
@@ -298,8 +298,8 @@
fun ho_argsT_of_typ Ts =
let
- fun ho_arg (T as Type("fun", [_,_])) = if body_type T = @{typ bool} then [T] else []
- | ho_arg (Type (@{type_name "Product_Type.prod"}, [T1, T2])) =
+ fun ho_arg (T as Type("fun", [_,_])) = if body_type T = \<^typ>\<open>bool\<close> then [T] else []
+ | ho_arg (Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) =
ho_arg T1 @ ho_arg T2
| ho_arg _ = []
in
@@ -311,12 +311,12 @@
fun replace_ho_args mode hoargs ts =
let
fun replace (Fun _, _) (arg' :: hoargs') = (arg', hoargs')
- | replace (Pair (m1, m2), Const (@{const_name Pair}, T) $ t1 $ t2) hoargs =
+ | replace (Pair (m1, m2), Const (\<^const_name>\<open>Pair\<close>, T) $ t1 $ t2) hoargs =
let
val (t1', hoargs') = replace (m1, t1) hoargs
val (t2', hoargs'') = replace (m2, t2) hoargs'
in
- (Const (@{const_name Pair}, T) $ t1' $ t2', hoargs'')
+ (Const (\<^const_name>\<open>Pair\<close>, T) $ t1' $ t2', hoargs'')
end
| replace (_, t) hoargs = (t, hoargs)
in
@@ -326,7 +326,7 @@
fun ho_argsT_of mode Ts =
let
fun ho_arg (Fun _) T = [T]
- | ho_arg (Pair (m1, m2)) (Type (@{type_name Product_Type.prod}, [T1, T2])) =
+ | ho_arg (Pair (m1, m2)) (Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) =
ho_arg m1 T1 @ ho_arg m2 T2
| ho_arg _ _ = []
in
@@ -337,7 +337,7 @@
fun split_map_mode f mode ts =
let
fun split_arg_mode' (m as Fun _) t = f m t
- | split_arg_mode' (Pair (m1, m2)) (Const (@{const_name Pair}, _) $ t1 $ t2) =
+ | split_arg_mode' (Pair (m1, m2)) (Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2) =
let
val (i1, o1) = split_arg_mode' m1 t1
val (i2, o2) = split_arg_mode' m2 t2
@@ -356,7 +356,7 @@
fun split_map_modeT f mode Ts =
let
fun split_arg_mode' (m as Fun _) T = f m T
- | split_arg_mode' (Pair (m1, m2)) (Type (@{type_name Product_Type.prod}, [T1, T2])) =
+ | split_arg_mode' (Pair (m1, m2)) (Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) =
let
val (i1, o1) = split_arg_mode' m1 T1
val (i2, o2) = split_arg_mode' m2 T2
@@ -372,7 +372,7 @@
fun split_mode mode ts = split_map_mode (fn _ => fn _ => (NONE, NONE)) mode ts
-fun fold_map_aterms_prodT comb f (Type (@{type_name Product_Type.prod}, [T1, T2])) s =
+fun fold_map_aterms_prodT comb f (Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) s =
let
val (x1, s') = fold_map_aterms_prodT comb f T1 s
val (x2, s'') = fold_map_aterms_prodT comb f T2 s'
@@ -381,14 +381,14 @@
end
| fold_map_aterms_prodT _ f T s = f T s
-fun map_filter_prod f (Const (@{const_name Pair}, _) $ t1 $ t2) =
+fun map_filter_prod f (Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2) =
comb_option HOLogic.mk_prod (map_filter_prod f t1, map_filter_prod f t2)
| map_filter_prod f t = f t
fun split_modeT mode Ts =
let
fun split_arg_mode (Fun _) _ = ([], [])
- | split_arg_mode (Pair (m1, m2)) (Type (@{type_name Product_Type.prod}, [T1, T2])) =
+ | split_arg_mode (Pair (m1, m2)) (Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) =
let
val (i1, o1) = split_arg_mode m1 T1
val (i2, o2) = split_arg_mode m2 T2
@@ -451,15 +451,15 @@
(* general syntactic functions *)
-fun is_equationlike_term (Const (@{const_name Pure.eq}, _) $ _ $ _) = true
+fun is_equationlike_term (Const (\<^const_name>\<open>Pure.eq\<close>, _) $ _ $ _) = true
| is_equationlike_term
- (Const (@{const_name Trueprop}, _) $ (Const (@{const_name HOL.eq}, _) $ _ $ _)) = true
+ (Const (\<^const_name>\<open>Trueprop\<close>, _) $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ _)) = true
| is_equationlike_term _ = false
val is_equationlike = is_equationlike_term o Thm.prop_of
-fun is_pred_equation_term (Const (@{const_name Pure.eq}, _) $ u $ v) =
- (fastype_of u = @{typ bool}) andalso (fastype_of v = @{typ bool})
+fun is_pred_equation_term (Const (\<^const_name>\<open>Pure.eq\<close>, _) $ u $ v) =
+ (fastype_of u = \<^typ>\<open>bool\<close>) andalso (fastype_of v = \<^typ>\<open>bool\<close>)
| is_pred_equation_term _ = false
val is_pred_equation = is_pred_equation_term o Thm.prop_of
@@ -472,7 +472,7 @@
fun is_intro constname t = is_intro_term constname (Thm.prop_of t)
-fun is_predT (T as Type("fun", [_, _])) = (body_type T = @{typ bool})
+fun is_predT (T as Type("fun", [_, _])) = (body_type T = \<^typ>\<open>bool\<close>)
| is_predT _ = false
fun lookup_constr ctxt =
@@ -503,7 +503,7 @@
fun strip_all t = (Term.strip_all_vars t, Term.strip_all_body t)
-fun strip_ex (Const (@{const_name Ex}, _) $ Abs (x, T, t)) =
+fun strip_ex (Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (x, T, t)) =
let
val (xTs, t') = strip_ex t
in
@@ -531,7 +531,7 @@
val (literals, head) = Logic.strip_horn intro
fun appl t =
(case t of
- (@{term Not} $ t') => HOLogic.mk_not (f t')
+ (\<^term>\<open>Not\<close> $ t') => HOLogic.mk_not (f t')
| _ => f t)
in
Logic.list_implies
@@ -543,7 +543,7 @@
val (literals, _) = Logic.strip_horn intro
fun appl t s =
(case t of
- (@{term Not} $ t') => f t' s
+ (\<^term>\<open>Not\<close> $ t') => f t' s
| _ => f t s)
in fold appl (map HOLogic.dest_Trueprop literals) s end
@@ -552,7 +552,7 @@
val (literals, head) = Logic.strip_horn intro
fun appl t s =
(case t of
- (@{term Not} $ t') => apfst HOLogic.mk_not (f t' s)
+ (\<^term>\<open>Not\<close> $ t') => apfst HOLogic.mk_not (f t' s)
| _ => f t s)
val (literals', s') = fold_map appl (map HOLogic.dest_Trueprop literals) s
in
@@ -583,8 +583,8 @@
(* combinators to apply a function to all basic parts of nested products *)
-fun map_products f (Const (@{const_name Pair}, T) $ t1 $ t2) =
- Const (@{const_name Pair}, T) $ map_products f t1 $ map_products f t2
+fun map_products f (Const (\<^const_name>\<open>Pair\<close>, T) $ t1 $ t2) =
+ Const (\<^const_name>\<open>Pair\<close>, T) $ map_products f t1 $ map_products f t2
| map_products f t = f t
@@ -811,11 +811,11 @@
(_ :: _ :: _) =>
let
fun rewrite_arg'
- (Const (@{const_name Pair}, _) $ _ $ t2, Type (@{type_name Product_Type.prod}, [_, T2]))
+ (Const (\<^const_name>\<open>Pair\<close>, _) $ _ $ t2, Type (\<^type_name>\<open>Product_Type.prod\<close>, [_, T2]))
(args, (pats, intro_t, ctxt)) =
rewrite_arg' (t2, T2) (args, (pats, intro_t, ctxt))
| rewrite_arg'
- (t, Type (@{type_name Product_Type.prod}, [T1, T2])) (args, (pats, intro_t, ctxt)) =
+ (t, Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) (args, (pats, intro_t, ctxt)) =
let
val thy = Proof_Context.theory_of ctxt
val ([x, y], ctxt') = Variable.variant_fixes ["x", "y"] ctxt
@@ -854,7 +854,7 @@
fun dest_conjunct_prem th =
(case HOLogic.dest_Trueprop (Thm.prop_of th) of
- (Const (@{const_name HOL.conj}, _) $ _ $ _) =>
+ (Const (\<^const_name>\<open>HOL.conj\<close>, _) $ _ $ _) =>
dest_conjunct_prem (th RS @{thm conjunct1}) @
dest_conjunct_prem (th RS @{thm conjunct2})
| _ => [th])
@@ -908,7 +908,7 @@
val Type ("fun", [T, T']) = fastype_of comb;
val (Const (case_name, _), fs) = strip_comb comb
val used = Term.add_tfree_names comb []
- val U = TFree (singleton (Name.variant_list used) "'t", @{sort type})
+ val U = TFree (singleton (Name.variant_list used) "'t", \<^sort>\<open>type\<close>)
val x = Free ("x", T)
val f = Free ("f", T' --> U)
fun apply_f f' =
@@ -935,8 +935,8 @@
val f = fst (strip_comb (fst (HOLogic.dest_eq (HOLogic.dest_Trueprop (Thm.prop_of th)))))
val Type ("fun", [uninst_T, uninst_T']) = fastype_of f
val ([yname], ctxt') = Variable.add_fixes ["y"] ctxt
- val T' = TFree ("'t'", @{sort type})
- val U = TFree ("'u", @{sort type})
+ val T' = TFree ("'t'", \<^sort>\<open>type\<close>)
+ val U = TFree ("'u", \<^sort>\<open>type\<close>)
val y = Free (yname, U)
val f' = absdummy (U --> T') (Bound 0 $ y)
val th' =
@@ -963,7 +963,7 @@
fun imp_prems_conv cv ct =
(case Thm.term_of ct of
- Const (@{const_name Pure.imp}, _) $ _ $ _ =>
+ Const (\<^const_name>\<open>Pure.imp\<close>, _) $ _ $ _ =>
Conv.combination_conv (Conv.arg_conv cv) (imp_prems_conv cv) ct
| _ => Conv.all_conv ct)
@@ -1021,7 +1021,7 @@
(* Some last processing *)
fun remove_pointless_clauses intro =
- if Logic.strip_imp_prems (Thm.prop_of intro) = [@{prop "False"}] then
+ if Logic.strip_imp_prems (Thm.prop_of intro) = [\<^prop>\<open>False\<close>] then
[]
else [intro]
@@ -1032,12 +1032,12 @@
let
val ctxt = Proof_Context.init_global thy (* FIXME proper context!? *)
val process =
- rewrite_rule ctxt (Named_Theorems.get ctxt @{named_theorems code_pred_simp})
+ rewrite_rule ctxt (Named_Theorems.get ctxt \<^named_theorems>\<open>code_pred_simp\<close>)
fun process_False intro_t =
- if member (op =) (Logic.strip_imp_prems intro_t) @{prop "False"}
+ if member (op =) (Logic.strip_imp_prems intro_t) \<^prop>\<open>False\<close>
then NONE else SOME intro_t
fun process_True intro_t =
- map_filter_premises (fn p => if p = @{prop True} then NONE else SOME p) intro_t
+ map_filter_premises (fn p => if p = \<^prop>\<open>True\<close> then NONE else SOME p) intro_t
in
Option.map (Skip_Proof.make_thm thy)
(process_False (process_True (Thm.prop_of (process intro))))
@@ -1098,7 +1098,7 @@
(* generation of case rules from user-given introduction rules *)
-fun mk_args2 (Type (@{type_name Product_Type.prod}, [T1, T2])) st =
+fun mk_args2 (Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) st =
let
val (t1, st') = mk_args2 T1 st
val (t2, st'') = mk_args2 T2 st'
@@ -1186,10 +1186,10 @@
(* defining a quickcheck predicate *)
-fun strip_imp_prems (Const(@{const_name HOL.implies}, _) $ A $ B) = A :: strip_imp_prems B
+fun strip_imp_prems (Const(\<^const_name>\<open>HOL.implies\<close>, _) $ A $ B) = A :: strip_imp_prems B
| strip_imp_prems _ = [];
-fun strip_imp_concl (Const(@{const_name HOL.implies}, _) $ _ $ B) = strip_imp_concl B
+fun strip_imp_concl (Const(\<^const_name>\<open>HOL.implies\<close>, _) $ _ $ B) = strip_imp_concl B
| strip_imp_concl A = A;
fun strip_horn A = (strip_imp_prems A, strip_imp_concl A)
@@ -1202,7 +1202,7 @@
val (prems, concl) = strip_horn t''
val constname = "quickcheck"
val full_constname = Sign.full_bname thy constname
- val constT = map snd vs' ---> @{typ bool}
+ val constT = map snd vs' ---> \<^typ>\<open>bool\<close>
val thy1 = Sign.add_consts [(Binding.name constname, constT, NoSyn)] thy
val const = Const (full_constname, constT)
val t =
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_compilations.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_compilations.ML Fri Jan 04 23:22:53 2019 +0100
@@ -7,54 +7,54 @@
structure Predicate_Comp_Funs = (* FIXME proper signature *)
struct
-fun mk_monadT T = Type (@{type_name Predicate.pred}, [T])
+fun mk_monadT T = Type (\<^type_name>\<open>Predicate.pred\<close>, [T])
-fun dest_monadT (Type (@{type_name Predicate.pred}, [T])) = T
+fun dest_monadT (Type (\<^type_name>\<open>Predicate.pred\<close>, [T])) = T
| dest_monadT T = raise TYPE ("dest_monadT", [T], [])
-fun mk_empty T = Const (@{const_name Orderings.bot}, mk_monadT T)
+fun mk_empty T = Const (\<^const_name>\<open>Orderings.bot\<close>, mk_monadT T)
fun mk_single t =
let val T = fastype_of t
- in Const(@{const_name Predicate.single}, T --> mk_monadT T) $ t end
+ in Const(\<^const_name>\<open>Predicate.single\<close>, T --> mk_monadT T) $ t end
fun mk_bind (x, f) =
let val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Predicate.bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Predicate.bind\<close>, fastype_of x --> T --> U) $ x $ f
end
-val mk_plus = HOLogic.mk_binop @{const_name sup}
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>sup\<close>
-fun mk_if cond = Const (@{const_name Predicate.if_pred},
+fun mk_if cond = Const (\<^const_name>\<open>Predicate.if_pred\<close>,
HOLogic.boolT --> mk_monadT HOLogic.unitT) $ cond
fun mk_iterate_upto T (f, from, to) =
- list_comb (Const (@{const_name Predicate.iterate_upto},
- [@{typ natural} --> T, @{typ natural}, @{typ natural}] ---> mk_monadT T),
+ list_comb (Const (\<^const_name>\<open>Predicate.iterate_upto\<close>,
+ [\<^typ>\<open>natural\<close> --> T, \<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>] ---> mk_monadT T),
[f, from, to])
fun mk_not t =
let
val T = mk_monadT HOLogic.unitT
- in Const (@{const_name Predicate.not_pred}, T --> T) $ t end
+ in Const (\<^const_name>\<open>Predicate.not_pred\<close>, T --> T) $ t end
fun mk_Enum f =
let val T as Type ("fun", [T', _]) = fastype_of f
in
- Const (@{const_name Predicate.Pred}, T --> mk_monadT T') $ f
+ Const (\<^const_name>\<open>Predicate.Pred\<close>, T --> mk_monadT T') $ f
end;
fun mk_Eval (f, x) =
let
val T = dest_monadT (fastype_of f)
in
- Const (@{const_name Predicate.eval}, mk_monadT T --> T --> HOLogic.boolT) $ f $ x
+ Const (\<^const_name>\<open>Predicate.eval\<close>, mk_monadT T --> T --> HOLogic.boolT) $ f $ x
end
-fun dest_Eval (Const (@{const_name Predicate.eval}, _) $ f $ x) = (f, x)
+fun dest_Eval (Const (\<^const_name>\<open>Predicate.eval\<close>, _) $ f $ x) = (f, x)
-fun mk_map T1 T2 tf tp = Const (@{const_name Predicate.map},
+fun mk_map T1 T2 tf tp = Const (\<^const_name>\<open>Predicate.map\<close>,
(T1 --> T2) --> mk_monadT T1 --> mk_monadT T2) $ tf $ tp
val compfuns =
@@ -70,27 +70,27 @@
struct
fun mk_monadT T =
- (T --> @{typ "Code_Evaluation.term list option"}) --> @{typ "Code_Evaluation.term list option"}
+ (T --> \<^typ>\<open>Code_Evaluation.term list option\<close>) --> \<^typ>\<open>Code_Evaluation.term list option\<close>
fun dest_monadT
- (Type ("fun", [Type ("fun", [T, @{typ "term list option"}]), @{typ "term list option"}])) = T
+ (Type ("fun", [Type ("fun", [T, \<^typ>\<open>term list option\<close>]), \<^typ>\<open>term list option\<close>])) = T
| dest_monadT T = raise TYPE ("dest_monadT", [T], []);
-fun mk_empty T = Const (@{const_name Quickcheck_Exhaustive.cps_empty}, mk_monadT T)
+fun mk_empty T = Const (\<^const_name>\<open>Quickcheck_Exhaustive.cps_empty\<close>, mk_monadT T)
fun mk_single t =
let val T = fastype_of t
- in Const(@{const_name Quickcheck_Exhaustive.cps_single}, T --> mk_monadT T) $ t end
+ in Const(\<^const_name>\<open>Quickcheck_Exhaustive.cps_single\<close>, T --> mk_monadT T) $ t end
fun mk_bind (x, f) =
let val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Quickcheck_Exhaustive.cps_bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Quickcheck_Exhaustive.cps_bind\<close>, fastype_of x --> T --> U) $ x $ f
end
-val mk_plus = HOLogic.mk_binop @{const_name Quickcheck_Exhaustive.cps_plus}
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>Quickcheck_Exhaustive.cps_plus\<close>
-fun mk_if cond = Const (@{const_name Quickcheck_Exhaustive.cps_if},
+fun mk_if cond = Const (\<^const_name>\<open>Quickcheck_Exhaustive.cps_if\<close>,
HOLogic.boolT --> mk_monadT HOLogic.unitT) $ cond
fun mk_iterate_upto _ _ = error "not implemented yet"
@@ -98,7 +98,7 @@
fun mk_not t =
let
val T = mk_monadT HOLogic.unitT
- in Const (@{const_name Quickcheck_Exhaustive.cps_not}, T --> T) $ t end
+ in Const (\<^const_name>\<open>Quickcheck_Exhaustive.cps_not\<close>, T --> T) $ t end
fun mk_Enum _ = error "not implemented"
@@ -120,40 +120,40 @@
structure Pos_Bounded_CPS_Comp_Funs = (* FIXME proper signature *)
struct
-val resultT = @{typ "(bool * Code_Evaluation.term list) option"}
-fun mk_monadT T = (T --> resultT) --> @{typ "natural"} --> resultT
+val resultT = \<^typ>\<open>(bool * Code_Evaluation.term list) option\<close>
+fun mk_monadT T = (T --> resultT) --> \<^typ>\<open>natural\<close> --> resultT
-fun dest_monadT (Type ("fun", [Type ("fun", [T, @{typ "(bool * term list) option"}]),
- @{typ "natural => (bool * term list) option"}])) = T
+fun dest_monadT (Type ("fun", [Type ("fun", [T, \<^typ>\<open>(bool * term list) option\<close>]),
+ \<^typ>\<open>natural => (bool * term list) option\<close>])) = T
| dest_monadT T = raise TYPE ("dest_monadT", [T], [])
-fun mk_empty T = Const (@{const_name Quickcheck_Exhaustive.pos_bound_cps_empty}, mk_monadT T)
+fun mk_empty T = Const (\<^const_name>\<open>Quickcheck_Exhaustive.pos_bound_cps_empty\<close>, mk_monadT T)
fun mk_single t =
let val T = fastype_of t
- in Const(@{const_name Quickcheck_Exhaustive.pos_bound_cps_single}, T --> mk_monadT T) $ t end
+ in Const(\<^const_name>\<open>Quickcheck_Exhaustive.pos_bound_cps_single\<close>, T --> mk_monadT T) $ t end
fun mk_bind (x, f) =
let val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Quickcheck_Exhaustive.pos_bound_cps_bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Quickcheck_Exhaustive.pos_bound_cps_bind\<close>, fastype_of x --> T --> U) $ x $ f
end;
-val mk_plus = HOLogic.mk_binop @{const_name Quickcheck_Exhaustive.pos_bound_cps_plus}
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>Quickcheck_Exhaustive.pos_bound_cps_plus\<close>
fun mk_if cond =
- Const (@{const_name Quickcheck_Exhaustive.pos_bound_cps_if},
+ Const (\<^const_name>\<open>Quickcheck_Exhaustive.pos_bound_cps_if\<close>,
HOLogic.boolT --> mk_monadT HOLogic.unitT) $ cond
fun mk_iterate_upto _ _ = error "not implemented yet"
fun mk_not t =
let
- val nT = @{typ "(unit Quickcheck_Exhaustive.unknown =>
+ val nT = \<^typ>\<open>(unit Quickcheck_Exhaustive.unknown =>
Code_Evaluation.term list Quickcheck_Exhaustive.three_valued) => natural =>
- Code_Evaluation.term list Quickcheck_Exhaustive.three_valued"}
+ Code_Evaluation.term list Quickcheck_Exhaustive.three_valued\<close>
val T = mk_monadT HOLogic.unitT
- in Const (@{const_name Quickcheck_Exhaustive.pos_bound_cps_not}, nT --> T) $ t end
+ in Const (\<^const_name>\<open>Quickcheck_Exhaustive.pos_bound_cps_not\<close>, nT --> T) $ t end
fun mk_Enum _ = error "not implemented"
@@ -176,31 +176,31 @@
struct
fun mk_monadT T =
- (Type (@{type_name "Quickcheck_Exhaustive.unknown"}, [T])
- --> @{typ "Code_Evaluation.term list Quickcheck_Exhaustive.three_valued"})
- --> @{typ "natural => Code_Evaluation.term list Quickcheck_Exhaustive.three_valued"}
+ (Type (\<^type_name>\<open>Quickcheck_Exhaustive.unknown\<close>, [T])
+ --> \<^typ>\<open>Code_Evaluation.term list Quickcheck_Exhaustive.three_valued\<close>)
+ --> \<^typ>\<open>natural => Code_Evaluation.term list Quickcheck_Exhaustive.three_valued\<close>
fun dest_monadT
- (Type ("fun", [Type ("fun", [Type (@{type_name "Quickcheck_Exhaustive.unknown"}, [T]),
- @{typ "term list Quickcheck_Exhaustive.three_valued"}]),
- @{typ "natural => term list Quickcheck_Exhaustive.three_valued"}])) = T
+ (Type ("fun", [Type ("fun", [Type (\<^type_name>\<open>Quickcheck_Exhaustive.unknown\<close>, [T]),
+ \<^typ>\<open>term list Quickcheck_Exhaustive.three_valued\<close>]),
+ \<^typ>\<open>natural => term list Quickcheck_Exhaustive.three_valued\<close>])) = T
| dest_monadT T = raise TYPE ("dest_monadT", [T], []);
-fun mk_empty T = Const (@{const_name Quickcheck_Exhaustive.neg_bound_cps_empty}, mk_monadT T)
+fun mk_empty T = Const (\<^const_name>\<open>Quickcheck_Exhaustive.neg_bound_cps_empty\<close>, mk_monadT T)
fun mk_single t =
let val T = fastype_of t
- in Const(@{const_name Quickcheck_Exhaustive.neg_bound_cps_single}, T --> mk_monadT T) $ t end
+ in Const(\<^const_name>\<open>Quickcheck_Exhaustive.neg_bound_cps_single\<close>, T --> mk_monadT T) $ t end
fun mk_bind (x, f) =
let val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Quickcheck_Exhaustive.neg_bound_cps_bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Quickcheck_Exhaustive.neg_bound_cps_bind\<close>, fastype_of x --> T --> U) $ x $ f
end;
-val mk_plus = HOLogic.mk_binop @{const_name Quickcheck_Exhaustive.neg_bound_cps_plus}
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>Quickcheck_Exhaustive.neg_bound_cps_plus\<close>
-fun mk_if cond = Const (@{const_name Quickcheck_Exhaustive.neg_bound_cps_if},
+fun mk_if cond = Const (\<^const_name>\<open>Quickcheck_Exhaustive.neg_bound_cps_if\<close>,
HOLogic.boolT --> mk_monadT HOLogic.unitT) $ cond
fun mk_iterate_upto _ _ = error "not implemented"
@@ -208,9 +208,9 @@
fun mk_not t =
let
val T = mk_monadT HOLogic.unitT
- val pT = @{typ "(unit => (bool * Code_Evaluation.term list) option)"}
- --> @{typ "natural => (bool * Code_Evaluation.term list) option"}
- in Const (@{const_name Quickcheck_Exhaustive.neg_bound_cps_not}, pT --> T) $ t end
+ val pT = \<^typ>\<open>(unit => (bool * Code_Evaluation.term list) option)\<close>
+ --> \<^typ>\<open>natural => (bool * Code_Evaluation.term list) option\<close>
+ in Const (\<^const_name>\<open>Quickcheck_Exhaustive.neg_bound_cps_not\<close>, pT --> T) $ t end
fun mk_Enum _ = error "not implemented"
@@ -233,44 +233,44 @@
struct
fun mk_randompredT T =
- @{typ Random.seed} --> HOLogic.mk_prodT (Predicate_Comp_Funs.mk_monadT T, @{typ Random.seed})
+ \<^typ>\<open>Random.seed\<close> --> HOLogic.mk_prodT (Predicate_Comp_Funs.mk_monadT T, \<^typ>\<open>Random.seed\<close>)
-fun dest_randompredT (Type ("fun", [@{typ Random.seed}, Type (@{type_name Product_Type.prod},
- [Type (@{type_name Predicate.pred}, [T]), @{typ Random.seed}])])) = T
+fun dest_randompredT (Type ("fun", [\<^typ>\<open>Random.seed\<close>, Type (\<^type_name>\<open>Product_Type.prod\<close>,
+ [Type (\<^type_name>\<open>Predicate.pred\<close>, [T]), \<^typ>\<open>Random.seed\<close>])])) = T
| dest_randompredT T = raise TYPE ("dest_randompredT", [T], [])
-fun mk_empty T = Const(@{const_name Random_Pred.empty}, mk_randompredT T)
+fun mk_empty T = Const(\<^const_name>\<open>Random_Pred.empty\<close>, mk_randompredT T)
fun mk_single t =
let
val T = fastype_of t
in
- Const (@{const_name Random_Pred.single}, T --> mk_randompredT T) $ t
+ Const (\<^const_name>\<open>Random_Pred.single\<close>, T --> mk_randompredT T) $ t
end
fun mk_bind (x, f) =
let
val T as (Type ("fun", [_, U])) = fastype_of f
in
- Const (@{const_name Random_Pred.bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Random_Pred.bind\<close>, fastype_of x --> T --> U) $ x $ f
end
-val mk_plus = HOLogic.mk_binop @{const_name Random_Pred.union}
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>Random_Pred.union\<close>
-fun mk_if cond = Const (@{const_name Random_Pred.if_randompred},
+fun mk_if cond = Const (\<^const_name>\<open>Random_Pred.if_randompred\<close>,
HOLogic.boolT --> mk_randompredT HOLogic.unitT) $ cond;
fun mk_iterate_upto T (f, from, to) =
- list_comb (Const (@{const_name Random_Pred.iterate_upto},
- [@{typ natural} --> T, @{typ natural}, @{typ natural}] ---> mk_randompredT T),
+ list_comb (Const (\<^const_name>\<open>Random_Pred.iterate_upto\<close>,
+ [\<^typ>\<open>natural\<close> --> T, \<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>] ---> mk_randompredT T),
[f, from, to])
fun mk_not t =
let
val T = mk_randompredT HOLogic.unitT
- in Const (@{const_name Random_Pred.not_randompred}, T --> T) $ t end
+ in Const (\<^const_name>\<open>Random_Pred.not_randompred\<close>, T --> T) $ t end
-fun mk_map T1 T2 tf tp = Const (@{const_name Random_Pred.map},
+fun mk_map T1 T2 tf tp = Const (\<^const_name>\<open>Random_Pred.map\<close>,
(T1 --> T2) --> mk_randompredT T1 --> mk_randompredT T2) $ tf $ tp
val compfuns =
@@ -285,36 +285,36 @@
structure DSequence_CompFuns = (* FIXME proper signature *)
struct
-fun mk_dseqT T = Type ("fun", [@{typ natural}, Type ("fun", [@{typ bool},
- Type (@{type_name Option.option}, [Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])])])])
+fun mk_dseqT T = Type ("fun", [\<^typ>\<open>natural\<close>, Type ("fun", [\<^typ>\<open>bool\<close>,
+ Type (\<^type_name>\<open>Option.option\<close>, [Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>, [T])])])])
-fun dest_dseqT (Type ("fun", [@{typ natural}, Type ("fun", [@{typ bool},
- Type (@{type_name Option.option}, [Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])])])])) = T
+fun dest_dseqT (Type ("fun", [\<^typ>\<open>natural\<close>, Type ("fun", [\<^typ>\<open>bool\<close>,
+ Type (\<^type_name>\<open>Option.option\<close>, [Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>, [T])])])])) = T
| dest_dseqT T = raise TYPE ("dest_dseqT", [T], []);
-fun mk_empty T = Const (@{const_name Limited_Sequence.empty}, mk_dseqT T);
+fun mk_empty T = Const (\<^const_name>\<open>Limited_Sequence.empty\<close>, mk_dseqT T);
fun mk_single t =
let val T = fastype_of t
- in Const(@{const_name Limited_Sequence.single}, T --> mk_dseqT T) $ t end;
+ in Const(\<^const_name>\<open>Limited_Sequence.single\<close>, T --> mk_dseqT T) $ t end;
fun mk_bind (x, f) =
let val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Limited_Sequence.bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Limited_Sequence.bind\<close>, fastype_of x --> T --> U) $ x $ f
end;
-val mk_plus = HOLogic.mk_binop @{const_name Limited_Sequence.union};
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>Limited_Sequence.union\<close>;
-fun mk_if cond = Const (@{const_name Limited_Sequence.if_seq},
+fun mk_if cond = Const (\<^const_name>\<open>Limited_Sequence.if_seq\<close>,
HOLogic.boolT --> mk_dseqT HOLogic.unitT) $ cond;
fun mk_iterate_upto _ _ = raise Fail "No iterate_upto compilation"
fun mk_not t = let val T = mk_dseqT HOLogic.unitT
- in Const (@{const_name Limited_Sequence.not_seq}, T --> T) $ t end
+ in Const (\<^const_name>\<open>Limited_Sequence.not_seq\<close>, T --> T) $ t end
-fun mk_map T1 T2 tf tp = Const (@{const_name Limited_Sequence.map},
+fun mk_map T1 T2 tf tp = Const (\<^const_name>\<open>Limited_Sequence.map\<close>,
(T1 --> T2) --> mk_dseqT T1 --> mk_dseqT T2) $ tf $ tp
val compfuns =
@@ -330,37 +330,37 @@
struct
fun mk_pos_dseqT T =
- @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])
+ \<^typ>\<open>natural\<close> --> Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>, [T])
fun dest_pos_dseqT
- (Type ("fun", [@{typ natural}, Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])])) = T
+ (Type ("fun", [\<^typ>\<open>natural\<close>, Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>, [T])])) = T
| dest_pos_dseqT T = raise TYPE ("dest_pos_dseqT", [T], [])
-fun mk_empty T = Const (@{const_name Limited_Sequence.pos_empty}, mk_pos_dseqT T)
+fun mk_empty T = Const (\<^const_name>\<open>Limited_Sequence.pos_empty\<close>, mk_pos_dseqT T)
fun mk_single t =
let
val T = fastype_of t
- in Const(@{const_name Limited_Sequence.pos_single}, T --> mk_pos_dseqT T) $ t end
+ in Const(\<^const_name>\<open>Limited_Sequence.pos_single\<close>, T --> mk_pos_dseqT T) $ t end
fun mk_bind (x, f) =
let
val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Limited_Sequence.pos_bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Limited_Sequence.pos_bind\<close>, fastype_of x --> T --> U) $ x $ f
end
fun mk_decr_bind (x, f) =
let
val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Limited_Sequence.pos_decr_bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Limited_Sequence.pos_decr_bind\<close>, fastype_of x --> T --> U) $ x $ f
end
-val mk_plus = HOLogic.mk_binop @{const_name Limited_Sequence.pos_union}
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>Limited_Sequence.pos_union\<close>
fun mk_if cond =
- Const (@{const_name Limited_Sequence.pos_if_seq},
+ Const (\<^const_name>\<open>Limited_Sequence.pos_if_seq\<close>,
HOLogic.boolT --> mk_pos_dseqT HOLogic.unitT) $ cond
fun mk_iterate_upto _ _ = raise Fail "No iterate_upto compilation"
@@ -369,12 +369,12 @@
let
val pT = mk_pos_dseqT HOLogic.unitT
val nT =
- @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence},
- [Type (@{type_name Option.option}, [@{typ unit}])])
- in Const (@{const_name Limited_Sequence.pos_not_seq}, nT --> pT) $ t end
+ \<^typ>\<open>natural\<close> --> Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>,
+ [Type (\<^type_name>\<open>Option.option\<close>, [\<^typ>\<open>unit\<close>])])
+ in Const (\<^const_name>\<open>Limited_Sequence.pos_not_seq\<close>, nT --> pT) $ t end
fun mk_map T1 T2 tf tp =
- Const (@{const_name Limited_Sequence.pos_map},
+ Const (\<^const_name>\<open>Limited_Sequence.pos_map\<close>,
(T1 --> T2) --> mk_pos_dseqT T1 --> mk_pos_dseqT T2) $ tf $ tp
val depth_limited_compfuns =
@@ -395,40 +395,40 @@
structure New_Neg_DSequence_CompFuns = (* FIXME proper signature *)
struct
-fun mk_neg_dseqT T = @{typ natural} -->
- Type (@{type_name Lazy_Sequence.lazy_sequence}, [Type (@{type_name Option.option}, [T])])
+fun mk_neg_dseqT T = \<^typ>\<open>natural\<close> -->
+ Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>, [Type (\<^type_name>\<open>Option.option\<close>, [T])])
fun dest_neg_dseqT
- (Type ("fun", [@{typ natural},
- Type (@{type_name Lazy_Sequence.lazy_sequence}, [Type (@{type_name Option.option}, [T])])])) =
+ (Type ("fun", [\<^typ>\<open>natural\<close>,
+ Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>, [Type (\<^type_name>\<open>Option.option\<close>, [T])])])) =
T
| dest_neg_dseqT T = raise TYPE ("dest_neg_dseqT", [T], [])
-fun mk_empty T = Const (@{const_name Limited_Sequence.neg_empty}, mk_neg_dseqT T)
+fun mk_empty T = Const (\<^const_name>\<open>Limited_Sequence.neg_empty\<close>, mk_neg_dseqT T)
fun mk_single t =
let
val T = fastype_of t
- in Const(@{const_name Limited_Sequence.neg_single}, T --> mk_neg_dseqT T) $ t end
+ in Const(\<^const_name>\<open>Limited_Sequence.neg_single\<close>, T --> mk_neg_dseqT T) $ t end
fun mk_bind (x, f) =
let
val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Limited_Sequence.neg_bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Limited_Sequence.neg_bind\<close>, fastype_of x --> T --> U) $ x $ f
end
fun mk_decr_bind (x, f) =
let
val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Limited_Sequence.neg_decr_bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Limited_Sequence.neg_decr_bind\<close>, fastype_of x --> T --> U) $ x $ f
end
-val mk_plus = HOLogic.mk_binop @{const_name Limited_Sequence.neg_union}
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>Limited_Sequence.neg_union\<close>
fun mk_if cond =
- Const (@{const_name Limited_Sequence.neg_if_seq},
+ Const (\<^const_name>\<open>Limited_Sequence.neg_if_seq\<close>,
HOLogic.boolT --> mk_neg_dseqT HOLogic.unitT) $ cond
fun mk_iterate_upto _ _ = raise Fail "No iterate_upto compilation"
@@ -437,12 +437,12 @@
let
val nT = mk_neg_dseqT HOLogic.unitT
val pT =
- @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence},
- [@{typ unit}])
- in Const (@{const_name Limited_Sequence.neg_not_seq}, pT --> nT) $ t end
+ \<^typ>\<open>natural\<close> --> Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>,
+ [\<^typ>\<open>unit\<close>])
+ in Const (\<^const_name>\<open>Limited_Sequence.neg_not_seq\<close>, pT --> nT) $ t end
fun mk_map T1 T2 tf tp =
- Const (@{const_name Limited_Sequence.neg_map},
+ Const (\<^const_name>\<open>Limited_Sequence.neg_map\<close>,
(T1 --> T2) --> mk_neg_dseqT T1 --> mk_neg_dseqT T2) $ tf $ tp
val depth_limited_compfuns =
@@ -464,58 +464,58 @@
struct
fun mk_pos_random_dseqT T =
- @{typ natural} --> @{typ natural} --> @{typ Random.seed} -->
- @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])
+ \<^typ>\<open>natural\<close> --> \<^typ>\<open>natural\<close> --> \<^typ>\<open>Random.seed\<close> -->
+ \<^typ>\<open>natural\<close> --> Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>, [T])
fun dest_pos_random_dseqT
- (Type ("fun", [@{typ natural}, Type ("fun", [@{typ natural},
- Type ("fun", [@{typ Random.seed}, Type ("fun", [@{typ natural},
- Type (@{type_name Lazy_Sequence.lazy_sequence}, [T])])])])])) = T
+ (Type ("fun", [\<^typ>\<open>natural\<close>, Type ("fun", [\<^typ>\<open>natural\<close>,
+ Type ("fun", [\<^typ>\<open>Random.seed\<close>, Type ("fun", [\<^typ>\<open>natural\<close>,
+ Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>, [T])])])])])) = T
| dest_pos_random_dseqT T = raise TYPE ("dest_random_dseqT", [T], [])
-fun mk_empty T = Const (@{const_name Random_Sequence.pos_empty}, mk_pos_random_dseqT T)
+fun mk_empty T = Const (\<^const_name>\<open>Random_Sequence.pos_empty\<close>, mk_pos_random_dseqT T)
fun mk_single t =
let
val T = fastype_of t
- in Const(@{const_name Random_Sequence.pos_single}, T --> mk_pos_random_dseqT T) $ t end
+ in Const(\<^const_name>\<open>Random_Sequence.pos_single\<close>, T --> mk_pos_random_dseqT T) $ t end
fun mk_bind (x, f) =
let
val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Random_Sequence.pos_bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Random_Sequence.pos_bind\<close>, fastype_of x --> T --> U) $ x $ f
end
fun mk_decr_bind (x, f) =
let
val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Random_Sequence.pos_decr_bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Random_Sequence.pos_decr_bind\<close>, fastype_of x --> T --> U) $ x $ f
end
-val mk_plus = HOLogic.mk_binop @{const_name Random_Sequence.pos_union};
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>Random_Sequence.pos_union\<close>;
-fun mk_if cond = Const (@{const_name Random_Sequence.pos_if_random_dseq},
+fun mk_if cond = Const (\<^const_name>\<open>Random_Sequence.pos_if_random_dseq\<close>,
HOLogic.boolT --> mk_pos_random_dseqT HOLogic.unitT) $ cond;
fun mk_iterate_upto T (f, from, to) =
- list_comb (Const (@{const_name Random_Sequence.pos_iterate_upto},
- [@{typ natural} --> T, @{typ natural}, @{typ natural}]
+ list_comb (Const (\<^const_name>\<open>Random_Sequence.pos_iterate_upto\<close>,
+ [\<^typ>\<open>natural\<close> --> T, \<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>]
---> mk_pos_random_dseqT T),
[f, from, to])
fun mk_not t =
let
val pT = mk_pos_random_dseqT HOLogic.unitT
- val nT = @{typ natural} --> @{typ natural} --> @{typ Random.seed} -->
- @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence},
- [Type (@{type_name Option.option}, [@{typ unit}])])
+ val nT = \<^typ>\<open>natural\<close> --> \<^typ>\<open>natural\<close> --> \<^typ>\<open>Random.seed\<close> -->
+ \<^typ>\<open>natural\<close> --> Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>,
+ [Type (\<^type_name>\<open>Option.option\<close>, [\<^typ>\<open>unit\<close>])])
- in Const (@{const_name Random_Sequence.pos_not_random_dseq}, nT --> pT) $ t end
+ in Const (\<^const_name>\<open>Random_Sequence.pos_not_random_dseq\<close>, nT --> pT) $ t end
fun mk_map T1 T2 tf tp =
- Const (@{const_name Random_Sequence.pos_map},
+ Const (\<^const_name>\<open>Random_Sequence.pos_map\<close>,
(T1 --> T2) --> mk_pos_random_dseqT T1 --> mk_pos_random_dseqT T2) $ tf $ tp
val depth_limited_compfuns =
@@ -537,59 +537,59 @@
struct
fun mk_neg_random_dseqT T =
- @{typ natural} --> @{typ natural} --> @{typ Random.seed} -->
- @{typ natural} -->
- Type (@{type_name Lazy_Sequence.lazy_sequence}, [Type (@{type_name Option.option}, [T])])
+ \<^typ>\<open>natural\<close> --> \<^typ>\<open>natural\<close> --> \<^typ>\<open>Random.seed\<close> -->
+ \<^typ>\<open>natural\<close> -->
+ Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>, [Type (\<^type_name>\<open>Option.option\<close>, [T])])
fun dest_neg_random_dseqT
- (Type ("fun", [@{typ natural}, Type ("fun", [@{typ natural},
- Type ("fun", [@{typ Random.seed}, Type ("fun", [@{typ natural},
- Type (@{type_name Lazy_Sequence.lazy_sequence},
- [Type (@{type_name Option.option}, [T])])])])])])) = T
+ (Type ("fun", [\<^typ>\<open>natural\<close>, Type ("fun", [\<^typ>\<open>natural\<close>,
+ Type ("fun", [\<^typ>\<open>Random.seed\<close>, Type ("fun", [\<^typ>\<open>natural\<close>,
+ Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>,
+ [Type (\<^type_name>\<open>Option.option\<close>, [T])])])])])])) = T
| dest_neg_random_dseqT T = raise TYPE ("dest_random_dseqT", [T], [])
-fun mk_empty T = Const (@{const_name Random_Sequence.neg_empty}, mk_neg_random_dseqT T)
+fun mk_empty T = Const (\<^const_name>\<open>Random_Sequence.neg_empty\<close>, mk_neg_random_dseqT T)
fun mk_single t =
let
val T = fastype_of t
- in Const(@{const_name Random_Sequence.neg_single}, T --> mk_neg_random_dseqT T) $ t end
+ in Const(\<^const_name>\<open>Random_Sequence.neg_single\<close>, T --> mk_neg_random_dseqT T) $ t end
fun mk_bind (x, f) =
let
val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Random_Sequence.neg_bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Random_Sequence.neg_bind\<close>, fastype_of x --> T --> U) $ x $ f
end
fun mk_decr_bind (x, f) =
let
val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Random_Sequence.neg_decr_bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Random_Sequence.neg_decr_bind\<close>, fastype_of x --> T --> U) $ x $ f
end
-val mk_plus = HOLogic.mk_binop @{const_name Random_Sequence.neg_union}
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>Random_Sequence.neg_union\<close>
fun mk_if cond =
- Const (@{const_name Random_Sequence.neg_if_random_dseq},
+ Const (\<^const_name>\<open>Random_Sequence.neg_if_random_dseq\<close>,
HOLogic.boolT --> mk_neg_random_dseqT HOLogic.unitT) $ cond
fun mk_iterate_upto T (f, from, to) =
- list_comb (Const (@{const_name Random_Sequence.neg_iterate_upto},
- [@{typ natural} --> T, @{typ natural}, @{typ natural}]
+ list_comb (Const (\<^const_name>\<open>Random_Sequence.neg_iterate_upto\<close>,
+ [\<^typ>\<open>natural\<close> --> T, \<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>]
---> mk_neg_random_dseqT T),
[f, from, to])
fun mk_not t =
let
val nT = mk_neg_random_dseqT HOLogic.unitT
- val pT = @{typ natural} --> @{typ natural} --> @{typ Random.seed} -->
- @{typ natural} --> Type (@{type_name Lazy_Sequence.lazy_sequence}, [@{typ unit}])
- in Const (@{const_name Random_Sequence.neg_not_random_dseq}, pT --> nT) $ t end
+ val pT = \<^typ>\<open>natural\<close> --> \<^typ>\<open>natural\<close> --> \<^typ>\<open>Random.seed\<close> -->
+ \<^typ>\<open>natural\<close> --> Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>, [\<^typ>\<open>unit\<close>])
+ in Const (\<^const_name>\<open>Random_Sequence.neg_not_random_dseq\<close>, pT --> nT) $ t end
fun mk_map T1 T2 tf tp =
- Const (@{const_name Random_Sequence.neg_map},
+ Const (\<^const_name>\<open>Random_Sequence.neg_map\<close>,
(T1 --> T2) --> mk_neg_random_dseqT T1 --> mk_neg_random_dseqT T2) $ tf $ tp
val depth_limited_compfuns =
@@ -611,34 +611,34 @@
struct
fun mk_random_dseqT T =
- @{typ natural} --> @{typ natural} --> @{typ Random.seed} -->
- HOLogic.mk_prodT (DSequence_CompFuns.mk_dseqT T, @{typ Random.seed})
+ \<^typ>\<open>natural\<close> --> \<^typ>\<open>natural\<close> --> \<^typ>\<open>Random.seed\<close> -->
+ HOLogic.mk_prodT (DSequence_CompFuns.mk_dseqT T, \<^typ>\<open>Random.seed\<close>)
fun dest_random_dseqT
- (Type ("fun", [@{typ natural}, Type ("fun", [@{typ natural},
- Type ("fun", [@{typ Random.seed},
- Type (@{type_name Product_Type.prod}, [T, @{typ Random.seed}])])])])) =
+ (Type ("fun", [\<^typ>\<open>natural\<close>, Type ("fun", [\<^typ>\<open>natural\<close>,
+ Type ("fun", [\<^typ>\<open>Random.seed\<close>,
+ Type (\<^type_name>\<open>Product_Type.prod\<close>, [T, \<^typ>\<open>Random.seed\<close>])])])])) =
DSequence_CompFuns.dest_dseqT T
| dest_random_dseqT T = raise TYPE ("dest_random_dseqT", [T], [])
-fun mk_empty T = Const (@{const_name Random_Sequence.empty}, mk_random_dseqT T)
+fun mk_empty T = Const (\<^const_name>\<open>Random_Sequence.empty\<close>, mk_random_dseqT T)
fun mk_single t =
let
val T = fastype_of t
- in Const(@{const_name Random_Sequence.single}, T --> mk_random_dseqT T) $ t end
+ in Const(\<^const_name>\<open>Random_Sequence.single\<close>, T --> mk_random_dseqT T) $ t end
fun mk_bind (x, f) =
let
val T as Type ("fun", [_, U]) = fastype_of f
in
- Const (@{const_name Random_Sequence.bind}, fastype_of x --> T --> U) $ x $ f
+ Const (\<^const_name>\<open>Random_Sequence.bind\<close>, fastype_of x --> T --> U) $ x $ f
end
-val mk_plus = HOLogic.mk_binop @{const_name Random_Sequence.union}
+val mk_plus = HOLogic.mk_binop \<^const_name>\<open>Random_Sequence.union\<close>
fun mk_if cond =
- Const (@{const_name Random_Sequence.if_random_dseq},
+ Const (\<^const_name>\<open>Random_Sequence.if_random_dseq\<close>,
HOLogic.boolT --> mk_random_dseqT HOLogic.unitT) $ cond
fun mk_iterate_upto _ _ = raise Fail "No iterate_upto compilation"
@@ -646,9 +646,9 @@
fun mk_not t =
let
val T = mk_random_dseqT HOLogic.unitT
- in Const (@{const_name Random_Sequence.not_random_dseq}, T --> T) $ t end
+ in Const (\<^const_name>\<open>Random_Sequence.not_random_dseq\<close>, T --> T) $ t end
-fun mk_map T1 T2 tf tp = Const (@{const_name Random_Sequence.map},
+fun mk_map T1 T2 tf tp = Const (\<^const_name>\<open>Random_Sequence.map\<close>,
(T1 --> T2) --> mk_random_dseqT T1 --> mk_random_dseqT T2) $ tf $ tp
val compfuns =
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_core.ML Fri Jan 04 23:22:53 2019 +0100
@@ -89,8 +89,8 @@
in mk_eqs x xs end;
fun mk_tracing s t =
- Const(@{const_name Code_Evaluation.tracing},
- @{typ String.literal} --> (fastype_of t) --> (fastype_of t)) $ (HOLogic.mk_literal s) $ t
+ Const(\<^const_name>\<open>Code_Evaluation.tracing\<close>,
+ \<^typ>\<open>String.literal\<close> --> (fastype_of t) --> (fastype_of t)) $ (HOLogic.mk_literal s) $ t
(* representation of inferred clauses with modes *)
@@ -202,11 +202,11 @@
let
fun check (Fun (m1, m2)) (Type("fun", [T1,T2])) = check m1 T1 andalso check m2 T2
| check m (Type("fun", _)) = (m = Input orelse m = Output)
- | check (Pair (m1, m2)) (Type (@{type_name Product_Type.prod}, [T1, T2])) =
+ | check (Pair (m1, m2)) (Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) =
check m1 T1 andalso check m2 T2
| check Input _ = true
| check Output _ = true
- | check Bool @{typ bool} = true
+ | check Bool \<^typ>\<open>bool\<close> = true
| check _ _ = false
fun check_consistent_modes ms =
if forall (fn Fun _ => true | _ => false) ms then
@@ -306,18 +306,18 @@
additional_arguments = fn names =>
let
val depth_name = singleton (Name.variant_list names) "depth"
- in [Free (depth_name, @{typ natural})] end,
+ in [Free (depth_name, \<^typ>\<open>natural\<close>)] end,
modify_funT = (fn T => let val (Ts, U) = strip_type T
- val Ts' = [@{typ natural}] in (Ts @ Ts') ---> U end),
+ val Ts' = [\<^typ>\<open>natural\<close>] in (Ts @ Ts') ---> U end),
wrap_compilation =
fn compfuns => fn s => fn T => fn mode => fn additional_arguments => fn compilation =>
let
val [depth] = additional_arguments
val (_, Ts) = split_modeT mode (binder_types T)
val T' = mk_monadT compfuns (HOLogic.mk_tupleT Ts)
- val if_const = Const (@{const_name "If"}, @{typ bool} --> T' --> T' --> T')
+ val if_const = Const (\<^const_name>\<open>If\<close>, \<^typ>\<open>bool\<close> --> T' --> T' --> T')
in
- if_const $ HOLogic.mk_eq (depth, @{term "0 :: natural"})
+ if_const $ HOLogic.mk_eq (depth, \<^term>\<open>0 :: natural\<close>)
$ mk_empty compfuns (dest_monadT compfuns T')
$ compilation
end,
@@ -326,8 +326,8 @@
let
val [depth] = additional_arguments
val depth' =
- Const (@{const_name Groups.minus}, @{typ "natural => natural => natural"})
- $ depth $ Const (@{const_name Groups.one}, @{typ "natural"})
+ Const (\<^const_name>\<open>Groups.minus\<close>, \<^typ>\<open>natural => natural => natural\<close>)
+ $ depth $ Const (\<^const_name>\<open>Groups.one\<close>, \<^typ>\<open>natural\<close>)
in [depth'] end
}
@@ -337,20 +337,20 @@
function_name_prefix = "random_",
compfuns = Predicate_Comp_Funs.compfuns,
mk_random = (fn T => fn additional_arguments =>
- list_comb (Const(@{const_name Random_Pred.iter},
- [@{typ natural}, @{typ natural}, @{typ Random.seed}] --->
+ list_comb (Const(\<^const_name>\<open>Random_Pred.iter\<close>,
+ [\<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>, \<^typ>\<open>Random.seed\<close>] --->
Predicate_Comp_Funs.mk_monadT T), additional_arguments)),
modify_funT = (fn T =>
let
val (Ts, U) = strip_type T
- val Ts' = [@{typ natural}, @{typ natural}, @{typ Random.seed}]
+ val Ts' = [\<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>, \<^typ>\<open>Random.seed\<close>]
in (Ts @ Ts') ---> U end),
additional_arguments = (fn names =>
let
val [nrandom, size, seed] = Name.variant_list names ["nrandom", "size", "seed"]
in
- [Free (nrandom, @{typ natural}), Free (size, @{typ natural}),
- Free (seed, @{typ Random.seed})]
+ [Free (nrandom, \<^typ>\<open>natural\<close>), Free (size, \<^typ>\<open>natural\<close>),
+ Free (seed, \<^typ>\<open>Random.seed\<close>)]
end),
wrap_compilation = K (K (K (K (K I))))
: (compilation_funs -> string -> typ -> mode -> term list -> term -> term),
@@ -363,21 +363,21 @@
function_name_prefix = "depth_limited_random_",
compfuns = Predicate_Comp_Funs.compfuns,
mk_random = (fn T => fn additional_arguments =>
- list_comb (Const(@{const_name Random_Pred.iter},
- [@{typ natural}, @{typ natural}, @{typ Random.seed}] --->
+ list_comb (Const(\<^const_name>\<open>Random_Pred.iter\<close>,
+ [\<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>, \<^typ>\<open>Random.seed\<close>] --->
Predicate_Comp_Funs.mk_monadT T), tl additional_arguments)),
modify_funT = (fn T =>
let
val (Ts, U) = strip_type T
- val Ts' = [@{typ natural}, @{typ natural}, @{typ natural},
- @{typ Random.seed}]
+ val Ts' = [\<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>,
+ \<^typ>\<open>Random.seed\<close>]
in (Ts @ Ts') ---> U end),
additional_arguments = (fn names =>
let
val [depth, nrandom, size, seed] = Name.variant_list names ["depth", "nrandom", "size", "seed"]
in
- [Free (depth, @{typ natural}), Free (nrandom, @{typ natural}),
- Free (size, @{typ natural}), Free (seed, @{typ Random.seed})]
+ [Free (depth, \<^typ>\<open>natural\<close>), Free (nrandom, \<^typ>\<open>natural\<close>),
+ Free (size, \<^typ>\<open>natural\<close>), Free (seed, \<^typ>\<open>Random.seed\<close>)]
end),
wrap_compilation =
fn compfuns => fn _ => fn T => fn mode => fn additional_arguments => fn compilation =>
@@ -386,9 +386,9 @@
val (_, Ts) = split_map_modeT (fn m => fn T => (SOME (funT_of compfuns m T), NONE))
mode (binder_types T)
val T' = mk_monadT compfuns (HOLogic.mk_tupleT Ts)
- val if_const = Const (@{const_name "If"}, @{typ bool} --> T' --> T' --> T')
+ val if_const = Const (\<^const_name>\<open>If\<close>, \<^typ>\<open>bool\<close> --> T' --> T' --> T')
in
- if_const $ HOLogic.mk_eq (depth, @{term "0 :: natural"})
+ if_const $ HOLogic.mk_eq (depth, \<^term>\<open>0 :: natural\<close>)
$ mk_empty compfuns (dest_monadT compfuns T')
$ compilation
end,
@@ -397,8 +397,8 @@
let
val [depth, nrandom, size, seed] = additional_arguments
val depth' =
- Const (@{const_name Groups.minus}, @{typ "natural => natural => natural"})
- $ depth $ Const (@{const_name Groups.one}, @{typ "natural"})
+ Const (\<^const_name>\<open>Groups.minus\<close>, \<^typ>\<open>natural => natural => natural\<close>)
+ $ depth $ Const (\<^const_name>\<open>Groups.one\<close>, \<^typ>\<open>natural\<close>)
in [depth', nrandom, size, seed] end
}
@@ -435,12 +435,12 @@
compfuns = Random_Sequence_CompFuns.compfuns,
mk_random = (fn T => fn _ =>
let
- val random = Const (@{const_name Quickcheck_Random.random},
- @{typ natural} --> @{typ Random.seed} -->
- HOLogic.mk_prodT (HOLogic.mk_prodT (T, @{typ "unit => term"}), @{typ Random.seed}))
+ val random = Const (\<^const_name>\<open>Quickcheck_Random.random\<close>,
+ \<^typ>\<open>natural\<close> --> \<^typ>\<open>Random.seed\<close> -->
+ HOLogic.mk_prodT (HOLogic.mk_prodT (T, \<^typ>\<open>unit => term\<close>), \<^typ>\<open>Random.seed\<close>))
in
- Const (@{const_name Random_Sequence.Random}, (@{typ natural} --> @{typ Random.seed} -->
- HOLogic.mk_prodT (HOLogic.mk_prodT (T, @{typ "unit => term"}), @{typ Random.seed})) -->
+ Const (\<^const_name>\<open>Random_Sequence.Random\<close>, (\<^typ>\<open>natural\<close> --> \<^typ>\<open>Random.seed\<close> -->
+ HOLogic.mk_prodT (HOLogic.mk_prodT (T, \<^typ>\<open>unit => term\<close>), \<^typ>\<open>Random.seed\<close>)) -->
Random_Sequence_CompFuns.mk_random_dseqT T) $ random
end),
@@ -472,12 +472,12 @@
compfuns = New_Pos_Random_Sequence_CompFuns.depth_limited_compfuns,
mk_random = (fn T => fn _ =>
let
- val random = Const (@{const_name Quickcheck_Random.random},
- @{typ natural} --> @{typ Random.seed} -->
- HOLogic.mk_prodT (HOLogic.mk_prodT (T, @{typ "unit => term"}), @{typ Random.seed}))
+ val random = Const (\<^const_name>\<open>Quickcheck_Random.random\<close>,
+ \<^typ>\<open>natural\<close> --> \<^typ>\<open>Random.seed\<close> -->
+ HOLogic.mk_prodT (HOLogic.mk_prodT (T, \<^typ>\<open>unit => term\<close>), \<^typ>\<open>Random.seed\<close>))
in
- Const (@{const_name Random_Sequence.pos_Random}, (@{typ natural} --> @{typ Random.seed} -->
- HOLogic.mk_prodT (HOLogic.mk_prodT (T, @{typ "unit => term"}), @{typ Random.seed})) -->
+ Const (\<^const_name>\<open>Random_Sequence.pos_Random\<close>, (\<^typ>\<open>natural\<close> --> \<^typ>\<open>Random.seed\<close> -->
+ HOLogic.mk_prodT (HOLogic.mk_prodT (T, \<^typ>\<open>unit => term\<close>), \<^typ>\<open>Random.seed\<close>)) -->
New_Pos_Random_Sequence_CompFuns.mk_pos_random_dseqT T) $ random
end),
modify_funT = I,
@@ -507,8 +507,8 @@
compfuns = New_Pos_DSequence_CompFuns.depth_limited_compfuns,
mk_random =
(fn T => fn _ =>
- Const (@{const_name "Lazy_Sequence.small_lazy_class.small_lazy"},
- @{typ "natural"} --> Type (@{type_name "Lazy_Sequence.lazy_sequence"}, [T]))),
+ Const (\<^const_name>\<open>Lazy_Sequence.small_lazy_class.small_lazy\<close>,
+ \<^typ>\<open>natural\<close> --> Type (\<^type_name>\<open>Lazy_Sequence.lazy_sequence\<close>, [T]))),
modify_funT = I,
additional_arguments = K [],
wrap_compilation = K (K (K (K (K I))))
@@ -536,9 +536,9 @@
compfuns = Pos_Bounded_CPS_Comp_Funs.compfuns,
mk_random =
(fn T => fn _ =>
- Const (@{const_name "Quickcheck_Exhaustive.exhaustive"},
- (T --> @{typ "(bool * term list) option"}) -->
- @{typ "natural => (bool * term list) option"})),
+ Const (\<^const_name>\<open>Quickcheck_Exhaustive.exhaustive\<close>,
+ (T --> \<^typ>\<open>(bool * term list) option\<close>) -->
+ \<^typ>\<open>natural => (bool * term list) option\<close>)),
modify_funT = I,
additional_arguments = K [],
wrap_compilation = K (K (K (K (K I))))
@@ -597,7 +597,7 @@
(** specific rpred functions -- move them to the correct place in this file *)
fun mk_Eval_of (P as (Free _), T) mode =
let
- fun mk_bounds (Type (@{type_name Product_Type.prod}, [T1, T2])) i =
+ fun mk_bounds (Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) i =
let
val (bs2, i') = mk_bounds T2 i
val (bs1, i'') = mk_bounds T1 i'
@@ -608,9 +608,9 @@
fun mk_prod ((t1, T1), (t2, T2)) = (HOLogic.pair_const T1 T2 $ t1 $ t2, HOLogic.mk_prodT (T1, T2))
fun mk_tuple [] = (HOLogic.unit, HOLogic.unitT)
| mk_tuple tTs = foldr1 mk_prod tTs
- fun mk_split_abs (T as Type (@{type_name Product_Type.prod}, [T1, T2])) t =
+ fun mk_split_abs (T as Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) t =
absdummy T
- (HOLogic.case_prod_const (T1, T2, @{typ bool}) $ (mk_split_abs T1 (mk_split_abs T2 t)))
+ (HOLogic.case_prod_const (T1, T2, \<^typ>\<open>bool\<close>) $ (mk_split_abs T1 (mk_split_abs T2 t)))
| mk_split_abs T t = absdummy T t
val args = rev (fst (fold_map mk_bounds (rev (binder_types T)) 0))
val (inargs, outargs) = split_mode mode args
@@ -655,7 +655,7 @@
lambda v (Case_Translation.make_case ctxt Case_Translation.Quiet Name.context v
[(HOLogic.mk_tuple out_ts,
if null eqs'' then success_t
- else Const (@{const_name HOL.If}, HOLogic.boolT --> U --> U --> U) $
+ else Const (\<^const_name>\<open>HOL.If\<close>, HOLogic.boolT --> U --> U --> U) $
foldr1 HOLogic.mk_conj eqs'' $ success_t $
mk_empty compfuns U'),
(v', mk_empty compfuns U')])
@@ -689,7 +689,7 @@
val bs = map (pair "x") (binder_types (fastype_of t))
val bounds = map Bound (rev (0 upto (length bs) - 1))
in SOME (fold_rev Term.abs bs (mk_if compfuns (list_comb (t, bounds)))) end
- | (Const (@{const_name Pair}, _) $ t1 $ t2, Mode_Pair (d1, d2)) =>
+ | (Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2, Mode_Pair (d1, d2)) =>
(case (expr_of (t1, d1), expr_of (t2, d2)) of
(NONE, NONE) => NONE
| (NONE, SOME t) => SOME t
@@ -820,8 +820,8 @@
argument_position_pair (nth (strip_fun_mode mode) i) is)
fun nth_pair [] t = t
- | nth_pair (1 :: is) (Const (@{const_name Pair}, _) $ t1 $ _) = nth_pair is t1
- | nth_pair (2 :: is) (Const (@{const_name Pair}, _) $ _ $ t2) = nth_pair is t2
+ | nth_pair (1 :: is) (Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ _) = nth_pair is t1
+ | nth_pair (2 :: is) (Const (\<^const_name>\<open>Pair\<close>, _) $ _ $ t2) = nth_pair is t2
| nth_pair _ _ = raise Fail "unexpected input for nth_tuple"
@@ -1023,11 +1023,11 @@
(* Definition of executable functions and their intro and elim rules *)
-fun strip_split_abs (Const (@{const_name case_prod}, _) $ t) = strip_split_abs t
+fun strip_split_abs (Const (\<^const_name>\<open>case_prod\<close>, _) $ t) = strip_split_abs t
| strip_split_abs (Abs (_, _, t)) = strip_split_abs t
| strip_split_abs t = t
-fun mk_args is_eval (m as Pair (m1, m2), T as Type (@{type_name Product_Type.prod}, [T1, T2])) names =
+fun mk_args is_eval (m as Pair (m1, m2), T as Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) names =
if eq_mode (m, Input) orelse eq_mode (m, Output) then
let
val x = singleton (Name.variant_list names) "x"
@@ -1213,7 +1213,7 @@
fun dest_prem ctxt params t =
(case strip_comb t of
(v as Free _, _) => if member (op =) params v then Prem t else Sidecond t
- | (c as Const (@{const_name Not}, _), [t]) =>
+ | (c as Const (\<^const_name>\<open>Not\<close>, _), [t]) =>
(case dest_prem ctxt params t of
Prem t => Negprem t
| Negprem _ => error ("Double negation not allowed in premise: " ^
@@ -1341,8 +1341,8 @@
(map (fn i => "x" ^ string_of_int i) (1 upto length Ts))
val args = map2 (curry Free) arg_names Ts
val predfun = Const (Core_Data.function_name_of Pred ctxt predname full_mode,
- Ts ---> Predicate_Comp_Funs.mk_monadT @{typ unit})
- val rhs = @{term Predicate.holds} $ (list_comb (predfun, args))
+ Ts ---> Predicate_Comp_Funs.mk_monadT \<^typ>\<open>unit\<close>)
+ val rhs = \<^term>\<open>Predicate.holds\<close> $ (list_comb (predfun, args))
val eq_term = HOLogic.mk_Trueprop
(HOLogic.mk_eq (list_comb (Const (predname, T), args), rhs))
val def = Core_Data.predfun_definition_of ctxt predname full_mode
@@ -1610,12 +1610,12 @@
(* values_timeout configuration *)
val values_timeout =
- Attrib.setup_config_real @{binding values_timeout} (K 40.0)
+ Attrib.setup_config_real \<^binding>\<open>values_timeout\<close> (K 40.0)
val _ =
Theory.setup
(Core_Data.PredData.put (Graph.empty) #>
- Attrib.setup @{binding code_pred_intro}
+ Attrib.setup \<^binding>\<open>code_pred_intro\<close>
(Scan.lift (Scan.option Args.name) >> attrib' Core_Data.add_intro)
"adding alternative introduction rules for code generation of inductive predicates")
@@ -1723,7 +1723,7 @@
let
val (inner_t, T_compr) =
(case t of
- (Const (@{const_name Collect}, _) $ Abs (_, T, t)) => (t, T)
+ (Const (\<^const_name>\<open>Collect\<close>, _) $ Abs (_, T, t)) => (t, T)
| _ => raise TERM ("dest_special_compr", [t]))
val (Ts, conj) = apfst (map snd) (Predicate_Compile_Aux.strip_ex inner_t)
val [eq, body] = HOLogic.dest_conj conj
@@ -1744,7 +1744,7 @@
let
val inner_t =
(case t_compr of
- (Const (@{const_name Collect}, _) $ t) => t
+ (Const (\<^const_name>\<open>Collect\<close>, _) $ t) => t
| _ => error ("Not a set comprehension: " ^ Syntax.string_of_term ctxt t_compr))
val (body, Ts, fp) = HOLogic.strip_ptupleabs inner_t;
val output_names = Name.variant_list (Term.add_free_names body [])
@@ -1774,7 +1774,7 @@
in
if Core_Data.defined_functions compilation ctxt name then
let
- fun extract_mode (Const (@{const_name Pair}, _) $ t1 $ t2) =
+ fun extract_mode (Const (\<^const_name>\<open>Pair\<close>, _) $ t1 $ t2) =
Pair (extract_mode t1, extract_mode t2)
| extract_mode (Free (x, _)) =
if member (op =) output_names x then Output else Input
@@ -1857,13 +1857,13 @@
(case compilation of
Pred => []
| Random =>
- map (HOLogic.mk_number @{typ "natural"}) arguments @
- [@{term "(1, 1) :: natural * natural"}]
+ map (HOLogic.mk_number \<^typ>\<open>natural\<close>) arguments @
+ [\<^term>\<open>(1, 1) :: natural * natural\<close>]
| Annotated => []
- | Depth_Limited => [HOLogic.mk_number @{typ "natural"} (hd arguments)]
+ | Depth_Limited => [HOLogic.mk_number \<^typ>\<open>natural\<close> (hd arguments)]
| Depth_Limited_Random =>
- map (HOLogic.mk_number @{typ "natural"}) arguments @
- [@{term "(1, 1) :: natural * natural"}]
+ map (HOLogic.mk_number \<^typ>\<open>natural\<close>) arguments @
+ [\<^term>\<open>(1, 1) :: natural * natural\<close>]
| DSeq => []
| Pos_Random_DSeq => []
| New_Pos_Random_DSeq => []
@@ -1873,9 +1873,9 @@
val T = dest_monadT compfuns (fastype_of t)
val t' =
if stats andalso compilation = New_Pos_Random_DSeq then
- mk_map compfuns T (HOLogic.mk_prodT (HOLogic.termT, @{typ natural}))
+ mk_map compfuns T (HOLogic.mk_prodT (HOLogic.termT, \<^typ>\<open>natural\<close>))
(absdummy T (HOLogic.mk_prod (HOLogic.term_of_const T $ Bound 0,
- @{term natural_of_nat} $ (HOLogic.size_const T $ Bound 0)))) t
+ \<^term>\<open>natural_of_nat\<close> $ (HOLogic.size_const T $ Bound 0)))) t
else
mk_map compfuns T HOLogic.termT (HOLogic.term_of_const T) t
val time_limit = seconds (Config.get ctxt values_timeout)
@@ -1962,7 +1962,7 @@
val ([dots], ctxt') = ctxt
|> Proof_Context.add_fixes [(Binding.name "dots", SOME setT, Mixfix.mixfix "...")]
(* check expected values *)
- val union = Const (@{const_abbrev Set.union}, setT --> setT --> setT)
+ val union = Const (\<^const_abbrev>\<open>Set.union\<close>, setT --> setT --> setT)
val () =
(case raw_expected of
NONE => ()
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML Fri Jan 04 23:22:53 2019 +0100
@@ -84,7 +84,7 @@
val is_introlike = is_introlike_term o Thm.prop_of
-fun check_equation_format_term (t as (Const (@{const_name Pure.eq}, _) $ u $ _)) =
+fun check_equation_format_term (t as (Const (\<^const_name>\<open>Pure.eq\<close>, _) $ u $ _)) =
(case strip_comb u of
(Const (_, T), args) =>
if (length (binder_types T) = length args) then
@@ -98,7 +98,7 @@
val check_equation_format = check_equation_format_term o Thm.prop_of
-fun defining_term_of_equation_term (Const (@{const_name Pure.eq}, _) $ u $ _) = fst (strip_comb u)
+fun defining_term_of_equation_term (Const (\<^const_name>\<open>Pure.eq\<close>, _) $ u $ _) = fst (strip_comb u)
| defining_term_of_equation_term t =
raise TERM ("defining_const_of_equation_term failed: Not an equation", [t])
@@ -116,7 +116,7 @@
fun mk_meta_equation th =
(case Thm.prop_of th of
- Const (@{const_name Trueprop}, _) $ (Const (@{const_name HOL.eq}, _) $ _ $ _) =>
+ Const (\<^const_name>\<open>Trueprop\<close>, _) $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ _) =>
th RS @{thm eq_reflection}
| _ => th)
@@ -161,7 +161,7 @@
fun inline_equations thy th =
let
val ctxt = Proof_Context.init_global thy
- val inline_defs = Named_Theorems.get ctxt @{named_theorems code_pred_inline}
+ val inline_defs = Named_Theorems.get ctxt \<^named_theorems>\<open>code_pred_inline\<close>
val th' = Simplifier.full_simplify (put_simpset HOL_basic_ss ctxt addsimps inline_defs) th
(*val _ = print_step options
("Inlining " ^ (Syntax.string_of_term_global thy (prop_of th))
@@ -208,7 +208,7 @@
NONE
fun filter_defs ths = map_filter filtering (map (normalize thy o Thm.transfer thy) ths)
val spec =
- (case filter_defs (Named_Theorems.get ctxt @{named_theorems code_pred_def}) of
+ (case filter_defs (Named_Theorems.get ctxt \<^named_theorems>\<open>code_pred_def\<close>) of
[] =>
(case Spec_Rules.retrieve ctxt t of
[] => error ("No specification for " ^ Syntax.string_of_term_global thy t)
@@ -224,38 +224,38 @@
end
val logic_operator_names =
- [@{const_name Pure.eq},
- @{const_name Pure.imp},
- @{const_name Trueprop},
- @{const_name Not},
- @{const_name HOL.eq},
- @{const_name HOL.implies},
- @{const_name All},
- @{const_name Ex},
- @{const_name HOL.conj},
- @{const_name HOL.disj}]
+ [\<^const_name>\<open>Pure.eq\<close>,
+ \<^const_name>\<open>Pure.imp\<close>,
+ \<^const_name>\<open>Trueprop\<close>,
+ \<^const_name>\<open>Not\<close>,
+ \<^const_name>\<open>HOL.eq\<close>,
+ \<^const_name>\<open>HOL.implies\<close>,
+ \<^const_name>\<open>All\<close>,
+ \<^const_name>\<open>Ex\<close>,
+ \<^const_name>\<open>HOL.conj\<close>,
+ \<^const_name>\<open>HOL.disj\<close>]
fun special_cases (c, _) =
member (op =)
- [@{const_name Product_Type.Unity},
- @{const_name False},
- @{const_name Suc}, @{const_name Nat.zero_nat_inst.zero_nat},
- @{const_name Nat.one_nat_inst.one_nat},
- @{const_name Orderings.less}, @{const_name Orderings.less_eq},
- @{const_name Groups.zero},
- @{const_name Groups.one}, @{const_name Groups.plus},
- @{const_name Nat.ord_nat_inst.less_eq_nat},
- @{const_name Nat.ord_nat_inst.less_nat},
+ [\<^const_name>\<open>Product_Type.Unity\<close>,
+ \<^const_name>\<open>False\<close>,
+ \<^const_name>\<open>Suc\<close>, \<^const_name>\<open>Nat.zero_nat_inst.zero_nat\<close>,
+ \<^const_name>\<open>Nat.one_nat_inst.one_nat\<close>,
+ \<^const_name>\<open>Orderings.less\<close>, \<^const_name>\<open>Orderings.less_eq\<close>,
+ \<^const_name>\<open>Groups.zero\<close>,
+ \<^const_name>\<open>Groups.one\<close>, \<^const_name>\<open>Groups.plus\<close>,
+ \<^const_name>\<open>Nat.ord_nat_inst.less_eq_nat\<close>,
+ \<^const_name>\<open>Nat.ord_nat_inst.less_nat\<close>,
(* FIXME
@{const_name number_nat_inst.number_of_nat},
*)
- @{const_name Num.Bit0},
- @{const_name Num.Bit1},
- @{const_name Num.One},
- @{const_name Int.zero_int_inst.zero_int},
- @{const_name List.filter},
- @{const_name HOL.If},
- @{const_name Groups.minus}] c
+ \<^const_name>\<open>Num.Bit0\<close>,
+ \<^const_name>\<open>Num.Bit1\<close>,
+ \<^const_name>\<open>Num.One\<close>,
+ \<^const_name>\<open>Int.zero_int_inst.zero_int\<close>,
+ \<^const_name>\<open>List.filter\<close>,
+ \<^const_name>\<open>HOL.If\<close>,
+ \<^const_name>\<open>Groups.minus\<close>] c
fun obtain_specification_graph options thy t =
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_fun.ML Fri Jan 04 23:22:53 2019 +0100
@@ -101,7 +101,7 @@
| NONE =>
let
val (vars, body) = strip_abs t
- val _ = @{assert} (fastype_of body = body_type (fastype_of body))
+ val _ = \<^assert> (fastype_of body = body_type (fastype_of body))
val absnames = Name.variant_list names (map fst vars)
val frees = map2 (curry Free) absnames (map snd vars)
val body' = subst_bounds (rev frees, body)
@@ -144,7 +144,7 @@
[(t, (names, prems))]
else
case (fst (strip_comb t)) of
- Const (@{const_name "If"}, _) =>
+ Const (\<^const_name>\<open>If\<close>, _) =>
(let
val (_, [B, x, y]) = strip_comb t
in
@@ -157,7 +157,7 @@
(* in general unsound! *)
(res, (names, (HOLogic.mk_Trueprop (HOLogic.mk_not B')) :: prems)))))
end)
- | Const (@{const_name "Let"}, _) =>
+ | Const (\<^const_name>\<open>Let\<close>, _) =>
(let
val (_, [f, g]) = strip_comb t
in
@@ -198,7 +198,7 @@
let
val (f, args) = strip_comb t
val args = map (Envir.eta_long []) args
- val _ = @{assert} (fastype_of t = body_type (fastype_of t))
+ val _ = \<^assert> (fastype_of t = body_type (fastype_of t))
val f' = lookup_pred f
val Ts =
(case f' of
@@ -216,16 +216,16 @@
if (fastype_of t) = T then t
else
let
- val _ = @{assert} (T =
- (binder_types (fastype_of t) @ [@{typ bool}] ---> @{typ bool}))
+ val _ = \<^assert> (T =
+ (binder_types (fastype_of t) @ [\<^typ>\<open>bool\<close>] ---> \<^typ>\<open>bool\<close>))
fun mk_if T (b, t, e) =
- Const (@{const_name If}, @{typ bool} --> T --> T --> T) $ b $ t $ e
+ Const (\<^const_name>\<open>If\<close>, \<^typ>\<open>bool\<close> --> T --> T --> T) $ b $ t $ e
val Ts = binder_types (fastype_of t)
in
- fold_rev Term.abs (map (pair "x") Ts @ [("b", @{typ bool})])
- (mk_if @{typ bool} (list_comb (t, map Bound (length Ts downto 1)),
- HOLogic.mk_eq (@{term True}, Bound 0),
- HOLogic.mk_eq (@{term False}, Bound 0)))
+ fold_rev Term.abs (map (pair "x") Ts @ [("b", \<^typ>\<open>bool\<close>)])
+ (mk_if \<^typ>\<open>bool\<close> (list_comb (t, map Bound (length Ts downto 1)),
+ HOLogic.mk_eq (\<^term>\<open>True\<close>, Bound 0),
+ HOLogic.mk_eq (\<^term>\<open>False\<close>, Bound 0)))
end
val argvs' = map2 lift_arg Ts argvs
val resname = singleton (Name.variant_list names') "res"
@@ -243,7 +243,7 @@
val (name, T) = dest_Const f
val base_name' = (Long_Name.base_name name ^ "P")
val name' = Sign.full_bname thy base_name'
- val T' = if (body_type T = @{typ bool}) then T else pred_type T
+ val T' = if (body_type T = \<^typ>\<open>bool\<close>) then T else pred_type T
in
(name', Const (name', T'))
end
@@ -272,7 +272,7 @@
fun lookup_pred t = lookup thy net t
(* create intro rules *)
fun mk_intros ((func, pred), (args, rhs)) =
- if (body_type (fastype_of func) = @{typ bool}) then
+ if (body_type (fastype_of func) = \<^typ>\<open>bool\<close>) then
(* TODO: preprocess predicate definition of rhs *)
[Logic.list_implies
([HOLogic.mk_Trueprop rhs], HOLogic.mk_Trueprop (list_comb (pred, args)))]
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_pred.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_pred.ML Fri Jan 04 23:22:53 2019 +0100
@@ -19,11 +19,11 @@
open Predicate_Compile_Aux
-fun is_compound ((Const (@{const_name Not}, _)) $ _) =
+fun is_compound ((Const (\<^const_name>\<open>Not\<close>, _)) $ _) =
error "is_compound: Negation should not occur; preprocessing is defect"
- | is_compound ((Const (@{const_name Ex}, _)) $ _) = true
- | is_compound ((Const (@{const_name HOL.disj}, _)) $ _ $ _) = true
- | is_compound ((Const (@{const_name HOL.conj}, _)) $ _ $ _) =
+ | is_compound ((Const (\<^const_name>\<open>Ex\<close>, _)) $ _) = true
+ | is_compound ((Const (\<^const_name>\<open>HOL.disj\<close>, _)) $ _ $ _) = true
+ | is_compound ((Const (\<^const_name>\<open>HOL.conj\<close>, _)) $ _ $ _) =
error "is_compound: Conjunction should not occur; preprocessing is defect"
| is_compound _ = false
@@ -94,12 +94,12 @@
end
else
(case (fst (strip_comb atom)) of
- (Const (@{const_name If}, _)) =>
+ (Const (\<^const_name>\<open>If\<close>, _)) =>
let
val if_beta = @{lemma "(if c then x else y) z = (if c then x z else y z)" by simp}
val atom' = Raw_Simplifier.rewrite_term thy
(map (fn th => th RS @{thm eq_reflection}) [@{thm if_bool_eq_disj}, if_beta]) [] atom
- val _ = @{assert} (not (atom = atom'))
+ val _ = \<^assert> (not (atom = atom'))
in
flatten constname atom' (defs, thy)
end
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_proof.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_proof.ML Fri Jan 04 23:22:53 2019 +0100
@@ -34,7 +34,7 @@
(** special setup for simpset **)
val HOL_basic_ss' =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps @{thms simp_thms prod.inject}
setSolver (mk_solver "all_tac_solver" (fn _ => fn _ => all_tac))
setSolver (mk_solver "True_solver" (fn ctxt => resolve_tac ctxt @{thms TrueI})))
@@ -46,7 +46,7 @@
(* which then consequently would be splitted *)
fun is_constructor ctxt t =
(case fastype_of t of
- Type (s, _) => s <> @{type_name fun} andalso can (Ctr_Sugar.dest_ctr ctxt s) t
+ Type (s, _) => s <> \<^type_name>\<open>fun\<close> andalso can (Ctr_Sugar.dest_ctr ctxt s) t
| _ => false)
(* MAJOR FIXME: prove_params should be simple
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_quickcheck.ML Fri Jan 04 23:22:53 2019 +0100
@@ -221,7 +221,7 @@
val ((((full_constname, constT), vs'), intro), thy1) =
Predicate_Compile_Aux.define_quickcheck_predicate t' thy
val thy2 =
- Context.theory_map (Named_Theorems.add_thm @{named_theorems code_pred_def} intro) thy1
+ Context.theory_map (Named_Theorems.add_thm \<^named_theorems>\<open>code_pred_def\<close> intro) thy1
val (thy3, _) = cpu_time "predicate preprocessing"
(fn () => Predicate_Compile.preprocess options (Const (full_constname, constT)) thy2)
val (thy4, _) = cpu_time "random_dseq core compilation"
@@ -251,34 +251,34 @@
| New_Pos_Random_DSeq => mk_new_randompredT (HOLogic.mk_tupleT (map snd vs'))
| Pos_Generator_DSeq => mk_new_dseqT (HOLogic.mk_tupleT (map snd vs'))
| Depth_Limited_Random =>
- [@{typ natural}, @{typ natural}, @{typ natural},
- @{typ Random.seed}] ---> mk_predT (HOLogic.mk_tupleT (map snd vs'))
+ [\<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>,
+ \<^typ>\<open>Random.seed\<close>] ---> mk_predT (HOLogic.mk_tupleT (map snd vs'))
| Pos_Generator_CPS => mk_cpsT (HOLogic.mk_tupleT (map snd vs')))
in
Const (name, T)
end
else error ("Predicate Compile Quickcheck failed: " ^ commas (map string_of_mode modes))
- fun mk_Some T = Const (@{const_name "Option.Some"}, T --> Type (@{type_name "Option.option"}, [T]))
+ fun mk_Some T = Const (\<^const_name>\<open>Option.Some\<close>, T --> Type (\<^type_name>\<open>Option.option\<close>, [T]))
val qc_term =
(case compilation of
Pos_Random_DSeq => mk_bind (prog,
- mk_split_lambda (map Free vs') (mk_return (HOLogic.mk_list @{typ term}
+ mk_split_lambda (map Free vs') (mk_return (HOLogic.mk_list \<^typ>\<open>term\<close>
(map2 HOLogic.mk_term_of (map snd vs') (map Free vs')))))
| New_Pos_Random_DSeq => mk_new_bind (prog,
- mk_split_lambda (map Free vs') (mk_new_return (HOLogic.mk_list @{typ term}
+ mk_split_lambda (map Free vs') (mk_new_return (HOLogic.mk_list \<^typ>\<open>term\<close>
(map2 HOLogic.mk_term_of (map snd vs') (map Free vs')))))
| Pos_Generator_DSeq => mk_gen_bind (prog,
- mk_split_lambda (map Free vs') (mk_gen_return (HOLogic.mk_list @{typ term}
+ mk_split_lambda (map Free vs') (mk_gen_return (HOLogic.mk_list \<^typ>\<open>term\<close>
(map2 HOLogic.mk_term_of (map snd vs') (map Free vs')))))
| Pos_Generator_CPS => prog $
- mk_split_lambda (map Free vs') (mk_Some @{typ "bool * term list"} $
- HOLogic.mk_prod (@{term "True"}, HOLogic.mk_list @{typ term}
+ mk_split_lambda (map Free vs') (mk_Some \<^typ>\<open>bool * term list\<close> $
+ HOLogic.mk_prod (\<^term>\<open>True\<close>, HOLogic.mk_list \<^typ>\<open>term\<close>
(map2 HOLogic.mk_term_of (map snd vs') (map Free vs'))))
| Depth_Limited_Random => fold_rev absdummy
- [@{typ natural}, @{typ natural}, @{typ natural},
- @{typ Random.seed}]
+ [\<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>, \<^typ>\<open>natural\<close>,
+ \<^typ>\<open>Random.seed\<close>]
(mk_bind' (list_comb (prog, map Bound (3 downto 0)),
- mk_split_lambda (map Free vs') (mk_return' (HOLogic.mk_list @{typ term}
+ mk_split_lambda (map Free vs') (mk_return' (HOLogic.mk_list \<^typ>\<open>term\<close>
(map2 HOLogic.mk_term_of (map snd vs') (map Free vs')))))))
val prog =
case compilation of
@@ -413,9 +413,9 @@
end
val smart_exhaustive_active =
- Attrib.setup_config_bool @{binding quickcheck_smart_exhaustive_active} (K true)
+ Attrib.setup_config_bool \<^binding>\<open>quickcheck_smart_exhaustive_active\<close> (K true)
val smart_slow_exhaustive_active =
- Attrib.setup_config_bool @{binding quickcheck_slow_smart_exhaustive_active} (K false)
+ Attrib.setup_config_bool \<^binding>\<open>quickcheck_slow_smart_exhaustive_active\<close> (K false)
val _ =
Theory.setup
--- a/src/HOL/Tools/Predicate_Compile/predicate_compile_specialisation.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Predicate_Compile/predicate_compile_specialisation.ML Fri Jan 04 23:22:53 2019 +0100
@@ -48,7 +48,7 @@
(case strip_comb t of
(Var _, []) => (true, true)
| (Free _, []) => (true, true)
- | (Const (@{const_name Pair}, _), ts) =>
+ | (Const (\<^const_name>\<open>Pair\<close>, _), ts) =>
apply2 (forall I) (split_list (map check ts))
| (Const cT, ts) =>
(case lookup_constr cT of
@@ -78,7 +78,7 @@
bname
end
val constname = mk_fresh_name []
- val constT = map fastype_of result_pats ---> @{typ bool}
+ val constT = map fastype_of result_pats ---> \<^typ>\<open>bool\<close>
val specialised_const = Const (constname, constT)
fun specialise_intro intro =
(let
--- a/src/HOL/Tools/Qelim/cooper.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Qelim/cooper.ML Fri Jan 04 23:22:53 2019 +0100
@@ -21,28 +21,28 @@
type entry = simpset * term list;
val allowed_consts =
- [@{term "(+) :: int => _"}, @{term "(+) :: nat => _"},
- @{term "(-) :: int => _"}, @{term "(-) :: nat => _"},
- @{term "(*) :: int => _"}, @{term "(*) :: nat => _"},
- @{term "(div) :: int => _"}, @{term "(div) :: nat => _"},
- @{term "(mod) :: int => _"}, @{term "(mod) :: nat => _"},
- @{term HOL.conj}, @{term HOL.disj}, @{term HOL.implies},
- @{term "(=) :: int => _"}, @{term "(=) :: nat => _"}, @{term "(=) :: bool => _"},
- @{term "(<) :: int => _"}, @{term "(<) :: nat => _"},
- @{term "(<=) :: int => _"}, @{term "(<=) :: nat => _"},
- @{term "(dvd) :: int => _"}, @{term "(dvd) :: nat => _"},
- @{term "abs :: int => _"},
- @{term "max :: int => _"}, @{term "max :: nat => _"},
- @{term "min :: int => _"}, @{term "min :: nat => _"},
- @{term "uminus :: int => _"}, (*@ {term "uminus :: nat => _"},*)
- @{term "Not"}, @{term Suc},
- @{term "Ex :: (int => _) => _"}, @{term "Ex :: (nat => _) => _"},
- @{term "All :: (int => _) => _"}, @{term "All :: (nat => _) => _"},
- @{term "nat"}, @{term "int"},
- @{term "Num.One"}, @{term "Num.Bit0"}, @{term "Num.Bit1"},
- @{term "Num.numeral :: num => int"}, @{term "Num.numeral :: num => nat"},
- @{term "0::int"}, @{term "1::int"}, @{term "0::nat"}, @{term "1::nat"},
- @{term "True"}, @{term "False"}];
+ [\<^term>\<open>(+) :: int => _\<close>, \<^term>\<open>(+) :: nat => _\<close>,
+ \<^term>\<open>(-) :: int => _\<close>, \<^term>\<open>(-) :: nat => _\<close>,
+ \<^term>\<open>(*) :: int => _\<close>, \<^term>\<open>(*) :: nat => _\<close>,
+ \<^term>\<open>(div) :: int => _\<close>, \<^term>\<open>(div) :: nat => _\<close>,
+ \<^term>\<open>(mod) :: int => _\<close>, \<^term>\<open>(mod) :: nat => _\<close>,
+ \<^term>\<open>HOL.conj\<close>, \<^term>\<open>HOL.disj\<close>, \<^term>\<open>HOL.implies\<close>,
+ \<^term>\<open>(=) :: int => _\<close>, \<^term>\<open>(=) :: nat => _\<close>, \<^term>\<open>(=) :: bool => _\<close>,
+ \<^term>\<open>(<) :: int => _\<close>, \<^term>\<open>(<) :: nat => _\<close>,
+ \<^term>\<open>(<=) :: int => _\<close>, \<^term>\<open>(<=) :: nat => _\<close>,
+ \<^term>\<open>(dvd) :: int => _\<close>, \<^term>\<open>(dvd) :: nat => _\<close>,
+ \<^term>\<open>abs :: int => _\<close>,
+ \<^term>\<open>max :: int => _\<close>, \<^term>\<open>max :: nat => _\<close>,
+ \<^term>\<open>min :: int => _\<close>, \<^term>\<open>min :: nat => _\<close>,
+ \<^term>\<open>uminus :: int => _\<close>, (*@ {term "uminus :: nat => _"},*)
+ \<^term>\<open>Not\<close>, \<^term>\<open>Suc\<close>,
+ \<^term>\<open>Ex :: (int => _) => _\<close>, \<^term>\<open>Ex :: (nat => _) => _\<close>,
+ \<^term>\<open>All :: (int => _) => _\<close>, \<^term>\<open>All :: (nat => _) => _\<close>,
+ \<^term>\<open>nat\<close>, \<^term>\<open>int\<close>,
+ \<^term>\<open>Num.One\<close>, \<^term>\<open>Num.Bit0\<close>, \<^term>\<open>Num.Bit1\<close>,
+ \<^term>\<open>Num.numeral :: num => int\<close>, \<^term>\<open>Num.numeral :: num => nat\<close>,
+ \<^term>\<open>0::int\<close>, \<^term>\<open>1::int\<close>, \<^term>\<open>0::nat\<close>, \<^term>\<open>1::nat\<close>,
+ \<^term>\<open>True\<close>, \<^term>\<open>False\<close>];
structure Data = Generic_Data
(
@@ -69,12 +69,12 @@
Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms simp_thms});
val FWD = Drule.implies_elim_list;
-val true_tm = @{cterm "True"};
-val false_tm = @{cterm "False"};
+val true_tm = \<^cterm>\<open>True\<close>;
+val false_tm = \<^cterm>\<open>False\<close>;
val zdvd1_eq = @{thm "zdvd1_eq"};
-val presburger_ss = simpset_of (@{context} addsimps [zdvd1_eq]);
+val presburger_ss = simpset_of (\<^context> addsimps [zdvd1_eq]);
val lin_ss =
- simpset_of (put_simpset presburger_ss @{context}
+ simpset_of (put_simpset presburger_ss \<^context>
addsimps (@{thm dvd_eq_mod_eq_0} :: zdvd1_eq :: @{thms ac_simps [where 'a=int]}));
val iT = HOLogic.intT
@@ -84,17 +84,17 @@
val is_number = can dest_number;
val [miconj, midisj, mieq, mineq, milt, mile, migt, mige, midvd, mindvd, miP] =
- map (Thm.instantiate' [SOME @{ctyp "int"}] []) @{thms "minf"};
+ map (Thm.instantiate' [SOME \<^ctyp>\<open>int\<close>] []) @{thms "minf"};
val [infDconj, infDdisj, infDdvd,infDndvd,infDP] =
- map (Thm.instantiate' [SOME @{ctyp "int"}] []) @{thms "inf_period"};
+ map (Thm.instantiate' [SOME \<^ctyp>\<open>int\<close>] []) @{thms "inf_period"};
val [piconj, pidisj, pieq,pineq,pilt,pile,pigt,pige,pidvd,pindvd,piP] =
- map (Thm.instantiate' [SOME @{ctyp "int"}] []) @{thms "pinf"};
+ map (Thm.instantiate' [SOME \<^ctyp>\<open>int\<close>] []) @{thms "pinf"};
-val [miP, piP] = map (Thm.instantiate' [SOME @{ctyp "bool"}] []) [miP, piP];
+val [miP, piP] = map (Thm.instantiate' [SOME \<^ctyp>\<open>bool\<close>] []) [miP, piP];
-val infDP = Thm.instantiate' (map SOME [@{ctyp "int"}, @{ctyp "bool"}]) [] infDP;
+val infDP = Thm.instantiate' (map SOME [\<^ctyp>\<open>int\<close>, \<^ctyp>\<open>bool\<close>]) [] infDP;
val [[asetconj, asetdisj, aseteq, asetneq, asetlt, asetle,
asetgt, asetge, asetdvd, asetndvd,asetP],
@@ -103,7 +103,7 @@
val [cpmi, cppi] = [@{thm "cpmi"}, @{thm "cppi"}];
-val unity_coeff_ex = Thm.instantiate' [SOME @{ctyp "int"}] [] @{thm "unity_coeff_ex"};
+val unity_coeff_ex = Thm.instantiate' [SOME \<^ctyp>\<open>int\<close>] [] @{thm "unity_coeff_ex"};
val [zdvd_mono,simp_from_to,all_not_ex] =
[@{thm "zdvd_mono"}, @{thm "simp_from_to"}, @{thm "all_not_ex"}];
@@ -111,7 +111,7 @@
val [dvd_uminus, dvd_uminus'] = @{thms "uminus_dvd_conv"};
val eval_ss =
- simpset_of (put_simpset presburger_ss @{context}
+ simpset_of (put_simpset presburger_ss \<^context>
addsimps [simp_from_to] delsimps [insert_iff, bex_triv]);
fun eval_conv ctxt = Simplifier.rewrite (put_simpset eval_ss ctxt);
@@ -123,20 +123,20 @@
fun whatis x ct =
( case Thm.term_of ct of
- Const(@{const_name HOL.conj},_)$_$_ => And (Thm.dest_binop ct)
-| Const (@{const_name HOL.disj},_)$_$_ => Or (Thm.dest_binop ct)
-| Const (@{const_name HOL.eq},_)$y$_ => if Thm.term_of x aconv y then Eq (Thm.dest_arg ct) else Nox
-| Const (@{const_name Not},_) $ (Const (@{const_name HOL.eq},_)$y$_) =>
+ Const(\<^const_name>\<open>HOL.conj\<close>,_)$_$_ => And (Thm.dest_binop ct)
+| Const (\<^const_name>\<open>HOL.disj\<close>,_)$_$_ => Or (Thm.dest_binop ct)
+| Const (\<^const_name>\<open>HOL.eq\<close>,_)$y$_ => if Thm.term_of x aconv y then Eq (Thm.dest_arg ct) else Nox
+| Const (\<^const_name>\<open>Not\<close>,_) $ (Const (\<^const_name>\<open>HOL.eq\<close>,_)$y$_) =>
if Thm.term_of x aconv y then NEq (funpow 2 Thm.dest_arg ct) else Nox
-| Const (@{const_name Orderings.less}, _) $ y$ z =>
+| Const (\<^const_name>\<open>Orderings.less\<close>, _) $ y$ z =>
if Thm.term_of x aconv y then Lt (Thm.dest_arg ct)
else if Thm.term_of x aconv z then Gt (Thm.dest_arg1 ct) else Nox
-| Const (@{const_name Orderings.less_eq}, _) $ y $ z =>
+| Const (\<^const_name>\<open>Orderings.less_eq\<close>, _) $ y $ z =>
if Thm.term_of x aconv y then Le (Thm.dest_arg ct)
else if Thm.term_of x aconv z then Ge (Thm.dest_arg1 ct) else Nox
-| Const (@{const_name Rings.dvd},_)$_$(Const(@{const_name Groups.plus},_)$y$_) =>
+| Const (\<^const_name>\<open>Rings.dvd\<close>,_)$_$(Const(\<^const_name>\<open>Groups.plus\<close>,_)$y$_) =>
if Thm.term_of x aconv y then Dvd (Thm.dest_binop ct ||> Thm.dest_arg) else Nox
-| Const (@{const_name Not},_) $ (Const (@{const_name Rings.dvd},_)$_$(Const(@{const_name Groups.plus},_)$y$_)) =>
+| Const (\<^const_name>\<open>Not\<close>,_) $ (Const (\<^const_name>\<open>Rings.dvd\<close>,_)$_$(Const(\<^const_name>\<open>Groups.plus\<close>,_)$y$_)) =>
if Thm.term_of x aconv y then
NDvd (Thm.dest_binop (Thm.dest_arg ct) ||> Thm.dest_arg) else Nox
| _ => Nox)
@@ -150,10 +150,10 @@
val get_pmi = get_pmi_term o Thm.cprop_of;
-val p_v' = (("P'", 0), @{typ "int \<Rightarrow> bool"});
-val q_v' = (("Q'", 0), @{typ "int \<Rightarrow> bool"});
-val p_v = (("P", 0), @{typ "int \<Rightarrow> bool"});
-val q_v = (("Q", 0), @{typ "int \<Rightarrow> bool"});
+val p_v' = (("P'", 0), \<^typ>\<open>int \<Rightarrow> bool\<close>);
+val q_v' = (("Q'", 0), \<^typ>\<open>int \<Rightarrow> bool\<close>);
+val p_v = (("P", 0), \<^typ>\<open>int \<Rightarrow> bool\<close>);
+val q_v = (("Q", 0), \<^typ>\<open>int \<Rightarrow> bool\<close>);
fun myfwd (th1, th2, th3) p q
[(th_1,th_2,th_3), (th_1',th_2',th_3')] =
@@ -170,12 +170,12 @@
val infDTrue = Thm.instantiate' [] [SOME true_tm] infDP;
val infDFalse = Thm.instantiate' [] [SOME false_tm] infDP;
-val cadd = @{cterm "(+) :: int => _"}
-val cmulC = @{cterm "(*) :: int => _"}
-val cminus = @{cterm "(-) :: int => _"}
-val cone = @{cterm "1 :: int"}
+val cadd = \<^cterm>\<open>(+) :: int => _\<close>
+val cmulC = \<^cterm>\<open>(*) :: int => _\<close>
+val cminus = \<^cterm>\<open>(-) :: int => _\<close>
+val cone = \<^cterm>\<open>1 :: int\<close>
val [addC, mulC, subC] = map Thm.term_of [cadd, cmulC, cminus]
-val [zero, one] = [@{term "0 :: int"}, @{term "1 :: int"}];
+val [zero, one] = [\<^term>\<open>0 :: int\<close>, \<^term>\<open>1 :: int\<close>];
fun numeral1 f n = HOLogic.mk_number iT (f (dest_number n));
fun numeral2 f m n = HOLogic.mk_number iT (f (dest_number m) (dest_number n));
@@ -227,18 +227,18 @@
(fn _ => EVERY [simp_tac (put_simpset lin_ss ctxt) 1, TRY (Lin_Arith.tac ctxt 1)]);
fun linear_cmul 0 tm = zero
| linear_cmul n tm = case tm of
- Const (@{const_name Groups.plus}, _) $ a $ b => addC $ linear_cmul n a $ linear_cmul n b
- | Const (@{const_name Groups.times}, _) $ c $ x => mulC $ numeral1 (fn m => n * m) c $ x
- | Const (@{const_name Groups.minus}, _) $ a $ b => subC $ linear_cmul n a $ linear_cmul n b
- | (m as Const (@{const_name Groups.uminus}, _)) $ a => m $ linear_cmul n a
+ Const (\<^const_name>\<open>Groups.plus\<close>, _) $ a $ b => addC $ linear_cmul n a $ linear_cmul n b
+ | Const (\<^const_name>\<open>Groups.times\<close>, _) $ c $ x => mulC $ numeral1 (fn m => n * m) c $ x
+ | Const (\<^const_name>\<open>Groups.minus\<close>, _) $ a $ b => subC $ linear_cmul n a $ linear_cmul n b
+ | (m as Const (\<^const_name>\<open>Groups.uminus\<close>, _)) $ a => m $ linear_cmul n a
| _ => numeral1 (fn m => n * m) tm;
fun earlier [] x y = false
| earlier (h::t) x y =
if h aconv y then false else if h aconv x then true else earlier t x y;
fun linear_add vars tm1 tm2 = case (tm1, tm2) of
- (Const (@{const_name Groups.plus}, _) $ (Const (@{const_name Groups.times}, _) $ c1 $ x1) $ r1,
- Const (@{const_name Groups.plus}, _) $ (Const (@{const_name Groups.times}, _) $ c2 $ x2) $ r2) =>
+ (Const (\<^const_name>\<open>Groups.plus\<close>, _) $ (Const (\<^const_name>\<open>Groups.times\<close>, _) $ c1 $ x1) $ r1,
+ Const (\<^const_name>\<open>Groups.plus\<close>, _) $ (Const (\<^const_name>\<open>Groups.times\<close>, _) $ c2 $ x2) $ r2) =>
if x1 = x2 then
let val c = numeral2 Integer.add c1 c2
in if c = zero then linear_add vars r1 r2
@@ -246,9 +246,9 @@
end
else if earlier vars x1 x2 then addC $ (mulC $ c1 $ x1) $ linear_add vars r1 tm2
else addC $ (mulC $ c2 $ x2) $ linear_add vars tm1 r2
- | (Const (@{const_name Groups.plus}, _) $ (Const (@{const_name Groups.times}, _) $ c1 $ x1) $ r1, _) =>
+ | (Const (\<^const_name>\<open>Groups.plus\<close>, _) $ (Const (\<^const_name>\<open>Groups.times\<close>, _) $ c1 $ x1) $ r1, _) =>
addC $ (mulC $ c1 $ x1) $ linear_add vars r1 tm2
- | (_, Const (@{const_name Groups.plus}, _) $ (Const (@{const_name Groups.times}, _) $ c2 $ x2) $ r2) =>
+ | (_, Const (\<^const_name>\<open>Groups.plus\<close>, _) $ (Const (\<^const_name>\<open>Groups.times\<close>, _) $ c2 $ x2) $ r2) =>
addC $ (mulC $ c2 $ x2) $ linear_add vars tm1 r2
| (_, _) => numeral2 Integer.add tm1 tm2;
@@ -258,10 +258,10 @@
exception COOPER of string;
fun lint vars tm = if is_number tm then tm else case tm of
- Const (@{const_name Groups.uminus}, _) $ t => linear_neg (lint vars t)
-| Const (@{const_name Groups.plus}, _) $ s $ t => linear_add vars (lint vars s) (lint vars t)
-| Const (@{const_name Groups.minus}, _) $ s $ t => linear_sub vars (lint vars s) (lint vars t)
-| Const (@{const_name Groups.times}, _) $ s $ t =>
+ Const (\<^const_name>\<open>Groups.uminus\<close>, _) $ t => linear_neg (lint vars t)
+| Const (\<^const_name>\<open>Groups.plus\<close>, _) $ s $ t => linear_add vars (lint vars s) (lint vars t)
+| Const (\<^const_name>\<open>Groups.minus\<close>, _) $ s $ t => linear_sub vars (lint vars s) (lint vars t)
+| Const (\<^const_name>\<open>Groups.times\<close>, _) $ s $ t =>
let val s' = lint vars s
val t' = lint vars t
in case perhaps_number s' of SOME n => linear_cmul n t'
@@ -270,14 +270,14 @@
end
| _ => addC $ (mulC $ one $ tm) $ zero;
-fun lin (vs as _::_) (Const (@{const_name Not}, _) $ (Const (@{const_name Orderings.less}, T) $ s $ t)) =
- lin vs (Const (@{const_name Orderings.less_eq}, T) $ t $ s)
- | lin (vs as _::_) (Const (@{const_name Not},_) $ (Const(@{const_name Orderings.less_eq}, T) $ s $ t)) =
- lin vs (Const (@{const_name Orderings.less}, T) $ t $ s)
- | lin vs (Const (@{const_name Not},T)$t) = Const (@{const_name Not},T)$ (lin vs t)
- | lin (vs as _::_) (Const(@{const_name Rings.dvd},_)$d$t) =
- HOLogic.mk_binrel @{const_name Rings.dvd} (numeral1 abs d, lint vs t)
- | lin (vs as x::_) ((b as Const(@{const_name HOL.eq},_))$s$t) =
+fun lin (vs as _::_) (Const (\<^const_name>\<open>Not\<close>, _) $ (Const (\<^const_name>\<open>Orderings.less\<close>, T) $ s $ t)) =
+ lin vs (Const (\<^const_name>\<open>Orderings.less_eq\<close>, T) $ t $ s)
+ | lin (vs as _::_) (Const (\<^const_name>\<open>Not\<close>,_) $ (Const(\<^const_name>\<open>Orderings.less_eq\<close>, T) $ s $ t)) =
+ lin vs (Const (\<^const_name>\<open>Orderings.less\<close>, T) $ t $ s)
+ | lin vs (Const (\<^const_name>\<open>Not\<close>,T)$t) = Const (\<^const_name>\<open>Not\<close>,T)$ (lin vs t)
+ | lin (vs as _::_) (Const(\<^const_name>\<open>Rings.dvd\<close>,_)$d$t) =
+ HOLogic.mk_binrel \<^const_name>\<open>Rings.dvd\<close> (numeral1 abs d, lint vs t)
+ | lin (vs as x::_) ((b as Const(\<^const_name>\<open>HOL.eq\<close>,_))$s$t) =
(case lint vs (subC$t$s) of
(t as _$(m$c$y)$r) =>
if x <> y then b$zero$t
@@ -299,14 +299,14 @@
RS eq_reflection
end;
-fun is_intrel_type T = T = @{typ "int => int => bool"};
+fun is_intrel_type T = T = \<^typ>\<open>int => int => bool\<close>;
fun is_intrel (b$_$_) = is_intrel_type (fastype_of b)
- | is_intrel (@{term "Not"}$(b$_$_)) = is_intrel_type (fastype_of b)
+ | is_intrel (\<^term>\<open>Not\<close>$(b$_$_)) = is_intrel_type (fastype_of b)
| is_intrel _ = false;
fun linearize_conv ctxt vs ct = case Thm.term_of ct of
- Const(@{const_name Rings.dvd},_)$_$_ =>
+ Const(\<^const_name>\<open>Rings.dvd\<close>,_)$_$_ =>
let
val th = Conv.binop_conv (lint_conv ctxt vs) ct
val (d',t') = Thm.dest_binop (Thm.rhs_of th)
@@ -326,7 +326,7 @@
val d'' = Thm.rhs_of dth |> Thm.dest_arg1
in
case tt' of
- Const(@{const_name Groups.plus},_)$(Const(@{const_name Groups.times},_)$c$_)$_ =>
+ Const(\<^const_name>\<open>Groups.plus\<close>,_)$(Const(\<^const_name>\<open>Groups.times\<close>,_)$c$_)$_ =>
let val x = dest_number c
in if x < 0 then Conv.fconv_rule (Conv.arg_conv (Conv.arg_conv (lint_conv ctxt vs)))
(Thm.transitive dth (inst' [d'',t'] dvd_uminus'))
@@ -334,13 +334,13 @@
| _ => dth
end
end
-| Const (@{const_name Not},_)$(Const(@{const_name Rings.dvd},_)$_$_) => Conv.arg_conv (linearize_conv ctxt vs) ct
+| Const (\<^const_name>\<open>Not\<close>,_)$(Const(\<^const_name>\<open>Rings.dvd\<close>,_)$_$_) => Conv.arg_conv (linearize_conv ctxt vs) ct
| t => if is_intrel t
then (provelin ctxt ((HOLogic.eq_const bT)$t$(lin vs t) |> HOLogic.mk_Trueprop))
RS eq_reflection
else Thm.reflexive ct;
-val dvdc = @{cterm "(dvd) :: int => _"};
+val dvdc = \<^cterm>\<open>(dvd) :: int => _\<close>;
fun unify ctxt q =
let
@@ -349,19 +349,19 @@
val ins = insert (op = : int * int -> bool)
fun h (acc,dacc) t =
case Thm.term_of t of
- Const(s,_)$(Const(@{const_name Groups.times},_)$c$y)$ _ =>
+ Const(s,_)$(Const(\<^const_name>\<open>Groups.times\<close>,_)$c$y)$ _ =>
if x aconv y andalso member (op =)
- [@{const_name HOL.eq}, @{const_name Orderings.less}, @{const_name Orderings.less_eq}] s
+ [\<^const_name>\<open>HOL.eq\<close>, \<^const_name>\<open>Orderings.less\<close>, \<^const_name>\<open>Orderings.less_eq\<close>] s
then (ins (dest_number c) acc,dacc) else (acc,dacc)
- | Const(s,_)$_$(Const(@{const_name Groups.times},_)$c$y) =>
+ | Const(s,_)$_$(Const(\<^const_name>\<open>Groups.times\<close>,_)$c$y) =>
if x aconv y andalso member (op =)
- [@{const_name Orderings.less}, @{const_name Orderings.less_eq}] s
+ [\<^const_name>\<open>Orderings.less\<close>, \<^const_name>\<open>Orderings.less_eq\<close>] s
then (ins (dest_number c) acc, dacc) else (acc,dacc)
- | Const(@{const_name Rings.dvd},_)$_$(Const(@{const_name Groups.plus},_)$(Const(@{const_name Groups.times},_)$c$y)$_) =>
+ | Const(\<^const_name>\<open>Rings.dvd\<close>,_)$_$(Const(\<^const_name>\<open>Groups.plus\<close>,_)$(Const(\<^const_name>\<open>Groups.times\<close>,_)$c$y)$_) =>
if x aconv y then (acc,ins (dest_number c) dacc) else (acc,dacc)
- | Const(@{const_name HOL.conj},_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
- | Const(@{const_name HOL.disj},_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
- | Const (@{const_name Not},_)$_ => h (acc,dacc) (Thm.dest_arg t)
+ | Const(\<^const_name>\<open>HOL.conj\<close>,_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
+ | Const(\<^const_name>\<open>HOL.disj\<close>,_)$_$_ => h (h (acc,dacc) (Thm.dest_arg1 t)) (Thm.dest_arg t)
+ | Const (\<^const_name>\<open>Not\<close>,_)$_ => h (acc,dacc) (Thm.dest_arg t)
| _ => (acc, dacc)
val (cs,ds) = h ([],[]) p
val l = Integer.lcms (union (op =) cs ds)
@@ -373,9 +373,9 @@
let
val th =
Simplifier.rewrite (put_simpset lin_ss ctxt)
- (Thm.apply @{cterm Trueprop} (Thm.apply @{cterm "Not"}
- (Thm.apply (Thm.apply @{cterm "(=) :: int => _"} (Numeral.mk_cnumber @{ctyp "int"} x))
- @{cterm "0::int"})))
+ (Thm.apply \<^cterm>\<open>Trueprop\<close> (Thm.apply \<^cterm>\<open>Not\<close>
+ (Thm.apply (Thm.apply \<^cterm>\<open>(=) :: int => _\<close> (Numeral.mk_cnumber \<^ctyp>\<open>int\<close> x))
+ \<^cterm>\<open>0::int\<close>)))
in Thm.equal_elim (Thm.symmetric th) TrueI end;
val notz =
let val tab = fold Inttab.update
@@ -388,18 +388,18 @@
end
fun unit_conv t =
case Thm.term_of t of
- Const(@{const_name HOL.conj},_)$_$_ => Conv.binop_conv unit_conv t
- | Const(@{const_name HOL.disj},_)$_$_ => Conv.binop_conv unit_conv t
- | Const (@{const_name Not},_)$_ => Conv.arg_conv unit_conv t
- | Const(s,_)$(Const(@{const_name Groups.times},_)$c$y)$ _ =>
+ Const(\<^const_name>\<open>HOL.conj\<close>,_)$_$_ => Conv.binop_conv unit_conv t
+ | Const(\<^const_name>\<open>HOL.disj\<close>,_)$_$_ => Conv.binop_conv unit_conv t
+ | Const (\<^const_name>\<open>Not\<close>,_)$_ => Conv.arg_conv unit_conv t
+ | Const(s,_)$(Const(\<^const_name>\<open>Groups.times\<close>,_)$c$y)$ _ =>
if x=y andalso member (op =)
- [@{const_name HOL.eq}, @{const_name Orderings.less}, @{const_name Orderings.less_eq}] s
+ [\<^const_name>\<open>HOL.eq\<close>, \<^const_name>\<open>Orderings.less\<close>, \<^const_name>\<open>Orderings.less_eq\<close>] s
then cv (l div dest_number c) t else Thm.reflexive t
- | Const(s,_)$_$(Const(@{const_name Groups.times},_)$c$y) =>
+ | Const(s,_)$_$(Const(\<^const_name>\<open>Groups.times\<close>,_)$c$y) =>
if x=y andalso member (op =)
- [@{const_name Orderings.less}, @{const_name Orderings.less_eq}] s
+ [\<^const_name>\<open>Orderings.less\<close>, \<^const_name>\<open>Orderings.less_eq\<close>] s
then cv (l div dest_number c) t else Thm.reflexive t
- | Const(@{const_name Rings.dvd},_)$d$(r as (Const(@{const_name Groups.plus},_)$(Const(@{const_name Groups.times},_)$c$y)$_)) =>
+ | Const(\<^const_name>\<open>Rings.dvd\<close>,_)$d$(r as (Const(\<^const_name>\<open>Groups.plus\<close>,_)$(Const(\<^const_name>\<open>Groups.times\<close>,_)$c$y)$_)) =>
if x=y then
let
val k = l div dest_number c
@@ -415,7 +415,7 @@
else Thm.reflexive t
| _ => Thm.reflexive t
val uth = unit_conv p
- val clt = Numeral.mk_cnumber @{ctyp "int"} l
+ val clt = Numeral.mk_cnumber \<^ctyp>\<open>int\<close> l
val ltx = Thm.apply (Thm.apply cmulC clt) cx
val th = Drule.arg_cong_rule e (Thm.abstract_rule (fst (dest_Free x )) cx uth)
val th' = inst' [Thm.lambda ltx (Thm.rhs_of uth), clt] unity_coeff_ex
@@ -426,8 +426,8 @@
in Thm.transitive (Thm.transitive lth thf) rth end;
-val emptyIS = @{cterm "{}::int set"};
-val insert_tm = @{cterm "insert :: int => _"};
+val emptyIS = \<^cterm>\<open>{}::int set\<close>;
+val insert_tm = \<^cterm>\<open>insert :: int => _\<close>;
fun mkISet cts = fold_rev (Thm.apply insert_tm #> Thm.apply) cts emptyIS;
val eqelem_imp_imp = @{thm eqelem_imp_iff} RS iffD1;
val [A_v,B_v] =
@@ -436,7 +436,7 @@
|> Thm.dest_abs NONE |> snd |> Thm.dest_fun |> Thm.dest_arg
|> Thm.term_of |> dest_Var) [asetP, bsetP];
-val D_v = (("D", 0), @{typ int});
+val D_v = (("D", 0), \<^typ>\<open>int\<close>);
fun cooperex_conv ctxt vs q =
let
@@ -461,13 +461,13 @@
| _ => (bacc, aacc, dacc)
val (b0,a0,ds) = h p ([],[],[])
val d = Integer.lcms ds
- val cd = Numeral.mk_cnumber @{ctyp "int"} d
+ val cd = Numeral.mk_cnumber \<^ctyp>\<open>int\<close> d
fun divprop x =
let
val th =
Simplifier.rewrite (put_simpset lin_ss ctxt)
- (Thm.apply @{cterm Trueprop}
- (Thm.apply (Thm.apply dvdc (Numeral.mk_cnumber @{ctyp "int"} x)) cd))
+ (Thm.apply \<^cterm>\<open>Trueprop\<close>
+ (Thm.apply (Thm.apply dvdc (Numeral.mk_cnumber \<^ctyp>\<open>int\<close> x)) cd))
in Thm.equal_elim (Thm.symmetric th) TrueI end;
val dvd =
let val tab = fold Inttab.update (ds ~~ (map divprop ds)) Inttab.empty in
@@ -478,18 +478,18 @@
end
val dp =
let val th = Simplifier.rewrite (put_simpset lin_ss ctxt)
- (Thm.apply @{cterm Trueprop}
- (Thm.apply (Thm.apply @{cterm "(<) :: int => _"} @{cterm "0::int"}) cd))
+ (Thm.apply \<^cterm>\<open>Trueprop\<close>
+ (Thm.apply (Thm.apply \<^cterm>\<open>(<) :: int => _\<close> \<^cterm>\<open>0::int\<close>) cd))
in Thm.equal_elim (Thm.symmetric th) TrueI end;
(* A and B set *)
local
- val insI1 = Thm.instantiate' [SOME @{ctyp "int"}] [] @{thm "insertI1"}
- val insI2 = Thm.instantiate' [SOME @{ctyp "int"}] [] @{thm "insertI2"}
+ val insI1 = Thm.instantiate' [SOME \<^ctyp>\<open>int\<close>] [] @{thm "insertI1"}
+ val insI2 = Thm.instantiate' [SOME \<^ctyp>\<open>int\<close>] [] @{thm "insertI2"}
in
fun provein x S =
case Thm.term_of S of
- Const(@{const_name Orderings.bot}, _) => error "Unexpected error in Cooper, please email Amine Chaieb"
- | Const(@{const_name insert}, _) $ y $ _ =>
+ Const(\<^const_name>\<open>Orderings.bot\<close>, _) => error "Unexpected error in Cooper, please email Amine Chaieb"
+ | Const(\<^const_name>\<open>insert\<close>, _) $ y $ _ =>
let val (cy,S') = Thm.dest_binop S
in if Thm.term_of x aconv y then Thm.instantiate' [] [SOME x, SOME S'] insI1
else Thm.implies_elim (Thm.instantiate' [] [SOME x, SOME S', SOME cy] insI2)
@@ -519,7 +519,7 @@
let
val sths = map (fn (tl,t0) =>
if tl = Thm.term_of t0
- then Thm.instantiate' [SOME @{ctyp "int"}] [SOME t0] refl
+ then Thm.instantiate' [SOME \<^ctyp>\<open>int\<close>] [SOME t0] refl
else provelin ctxt ((HOLogic.eq_const iT)$tl$(Thm.term_of t0)
|> HOLogic.mk_Trueprop))
(sl ~~ s0)
@@ -527,7 +527,7 @@
val S = mkISet csl
val inStab = fold (fn ct => fn tab => Termtab.update (Thm.term_of ct, provein ct S) tab)
csl Termtab.empty
- val eqelem_th = Thm.instantiate' [SOME @{ctyp "int"}] [NONE,NONE, SOME S] eqelem_imp_imp
+ val eqelem_th = Thm.instantiate' [SOME \<^ctyp>\<open>int\<close>] [NONE,NONE, SOME S] eqelem_imp_imp
val inS =
let
val tab = fold Termtab.update
@@ -564,7 +564,7 @@
nnf_conv ctxt then_conv literals_conv [HOLogic.conj, HOLogic.disj] [] env (linearize_conv ctxt);
val conv_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps (@{thms simp_thms} @ take 4 @{thms ex_simps} @
[not_all, all_not_ex, @{thm ex_disj_distrib}]));
@@ -582,10 +582,10 @@
fun add_bools t =
let
- val ops = [@{term "(=) :: int => _"}, @{term "(<) :: int => _"}, @{term "(<=) :: int => _"},
- @{term HOL.conj}, @{term HOL.disj}, @{term HOL.implies}, @{term "(=) :: bool => _"},
- @{term "Not"}, @{term "All :: (int => _) => _"},
- @{term "Ex :: (int => _) => _"}, @{term "True"}, @{term "False"}];
+ val ops = [\<^term>\<open>(=) :: int => _\<close>, \<^term>\<open>(<) :: int => _\<close>, \<^term>\<open>(<=) :: int => _\<close>,
+ \<^term>\<open>HOL.conj\<close>, \<^term>\<open>HOL.disj\<close>, \<^term>\<open>HOL.implies\<close>, \<^term>\<open>(=) :: bool => _\<close>,
+ \<^term>\<open>Not\<close>, \<^term>\<open>All :: (int => _) => _\<close>,
+ \<^term>\<open>Ex :: (int => _) => _\<close>, \<^term>\<open>True\<close>, \<^term>\<open>False\<close>];
val is_op = member (op =) ops;
val skip = not (fastype_of t = HOLogic.boolT)
in case t of
@@ -606,17 +606,17 @@
fun num_of_term vs (Free vT) = Proc.Bound (Proc.nat_of_integer (find_index (fn vT' => vT' = vT) vs))
| num_of_term vs (Term.Bound i) = Proc.Bound (Proc.nat_of_integer i)
- | num_of_term vs @{term "0::int"} = Proc.C (Proc.Int_of_integer 0)
- | num_of_term vs @{term "1::int"} = Proc.C (Proc.Int_of_integer 1)
- | num_of_term vs (t as Const (@{const_name numeral}, _) $ _) =
+ | num_of_term vs \<^term>\<open>0::int\<close> = Proc.C (Proc.Int_of_integer 0)
+ | num_of_term vs \<^term>\<open>1::int\<close> = Proc.C (Proc.Int_of_integer 1)
+ | num_of_term vs (t as Const (\<^const_name>\<open>numeral\<close>, _) $ _) =
Proc.C (Proc.Int_of_integer (dest_number t))
- | num_of_term vs (Const (@{const_name Groups.uminus}, _) $ t') =
+ | num_of_term vs (Const (\<^const_name>\<open>Groups.uminus\<close>, _) $ t') =
Proc.Neg (num_of_term vs t')
- | num_of_term vs (Const (@{const_name Groups.plus}, _) $ t1 $ t2) =
+ | num_of_term vs (Const (\<^const_name>\<open>Groups.plus\<close>, _) $ t1 $ t2) =
Proc.Add (num_of_term vs t1, num_of_term vs t2)
- | num_of_term vs (Const (@{const_name Groups.minus}, _) $ t1 $ t2) =
+ | num_of_term vs (Const (\<^const_name>\<open>Groups.minus\<close>, _) $ t1 $ t2) =
Proc.Sub (num_of_term vs t1, num_of_term vs t2)
- | num_of_term vs (Const (@{const_name Groups.times}, _) $ t1 $ t2) =
+ | num_of_term vs (Const (\<^const_name>\<open>Groups.times\<close>, _) $ t1 $ t2) =
(case perhaps_number t1
of SOME n => Proc.Mul (Proc.Int_of_integer n, num_of_term vs t2)
| NONE => (case perhaps_number t2
@@ -624,29 +624,29 @@
| NONE => raise COOPER "reification: unsupported kind of multiplication"))
| num_of_term _ _ = raise COOPER "reification: bad term";
-fun fm_of_term ps vs (Const (@{const_name True}, _)) = Proc.T
- | fm_of_term ps vs (Const (@{const_name False}, _)) = Proc.F
- | fm_of_term ps vs (Const (@{const_name HOL.conj}, _) $ t1 $ t2) =
+fun fm_of_term ps vs (Const (\<^const_name>\<open>True\<close>, _)) = Proc.T
+ | fm_of_term ps vs (Const (\<^const_name>\<open>False\<close>, _)) = Proc.F
+ | fm_of_term ps vs (Const (\<^const_name>\<open>HOL.conj\<close>, _) $ t1 $ t2) =
Proc.And (fm_of_term ps vs t1, fm_of_term ps vs t2)
- | fm_of_term ps vs (Const (@{const_name HOL.disj}, _) $ t1 $ t2) =
+ | fm_of_term ps vs (Const (\<^const_name>\<open>HOL.disj\<close>, _) $ t1 $ t2) =
Proc.Or (fm_of_term ps vs t1, fm_of_term ps vs t2)
- | fm_of_term ps vs (Const (@{const_name HOL.implies}, _) $ t1 $ t2) =
+ | fm_of_term ps vs (Const (\<^const_name>\<open>HOL.implies\<close>, _) $ t1 $ t2) =
Proc.Imp (fm_of_term ps vs t1, fm_of_term ps vs t2)
- | fm_of_term ps vs (@{term "(=) :: bool => _ "} $ t1 $ t2) =
+ | fm_of_term ps vs (\<^term>\<open>(=) :: bool => _ \<close> $ t1 $ t2) =
Proc.Iff (fm_of_term ps vs t1, fm_of_term ps vs t2)
- | fm_of_term ps vs (Const (@{const_name Not}, _) $ t') =
+ | fm_of_term ps vs (Const (\<^const_name>\<open>Not\<close>, _) $ t') =
Proc.NOT (fm_of_term ps vs t')
- | fm_of_term ps vs (Const (@{const_name Ex}, _) $ Abs abs) =
+ | fm_of_term ps vs (Const (\<^const_name>\<open>Ex\<close>, _) $ Abs abs) =
Proc.E (uncurry (fm_of_term ps) (descend vs abs))
- | fm_of_term ps vs (Const (@{const_name All}, _) $ Abs abs) =
+ | fm_of_term ps vs (Const (\<^const_name>\<open>All\<close>, _) $ Abs abs) =
Proc.A (uncurry (fm_of_term ps) (descend vs abs))
- | fm_of_term ps vs (@{term "(=) :: int => _"} $ t1 $ t2) =
+ | fm_of_term ps vs (\<^term>\<open>(=) :: int => _\<close> $ t1 $ t2) =
Proc.Eq (Proc.Sub (num_of_term vs t1, num_of_term vs t2))
- | fm_of_term ps vs (Const (@{const_name Orderings.less_eq}, _) $ t1 $ t2) =
+ | fm_of_term ps vs (Const (\<^const_name>\<open>Orderings.less_eq\<close>, _) $ t1 $ t2) =
Proc.Le (Proc.Sub (num_of_term vs t1, num_of_term vs t2))
- | fm_of_term ps vs (Const (@{const_name Orderings.less}, _) $ t1 $ t2) =
+ | fm_of_term ps vs (Const (\<^const_name>\<open>Orderings.less\<close>, _) $ t1 $ t2) =
Proc.Lt (Proc.Sub (num_of_term vs t1, num_of_term vs t2))
- | fm_of_term ps vs (Const (@{const_name Rings.dvd}, _) $ t1 $ t2) =
+ | fm_of_term ps vs (Const (\<^const_name>\<open>Rings.dvd\<close>, _) $ t1 $ t2) =
(case perhaps_number t1
of SOME n => Proc.Dvd (Proc.Int_of_integer n, num_of_term vs t2)
| NONE => raise COOPER "reification: unsupported dvd")
@@ -656,30 +656,30 @@
fun term_of_num vs (Proc.C i) = HOLogic.mk_number HOLogic.intT (Proc.integer_of_int i)
| term_of_num vs (Proc.Bound n) = Free (nth vs (Proc.integer_of_nat n))
| term_of_num vs (Proc.Neg t') =
- @{term "uminus :: int => _"} $ term_of_num vs t'
+ \<^term>\<open>uminus :: int => _\<close> $ term_of_num vs t'
| term_of_num vs (Proc.Add (t1, t2)) =
- @{term "(+) :: int => _"} $ term_of_num vs t1 $ term_of_num vs t2
+ \<^term>\<open>(+) :: int => _\<close> $ term_of_num vs t1 $ term_of_num vs t2
| term_of_num vs (Proc.Sub (t1, t2)) =
- @{term "(-) :: int => _"} $ term_of_num vs t1 $ term_of_num vs t2
+ \<^term>\<open>(-) :: int => _\<close> $ term_of_num vs t1 $ term_of_num vs t2
| term_of_num vs (Proc.Mul (i, t2)) =
- @{term "(*) :: int => _"} $ HOLogic.mk_number HOLogic.intT (Proc.integer_of_int i) $ term_of_num vs t2
+ \<^term>\<open>(*) :: int => _\<close> $ HOLogic.mk_number HOLogic.intT (Proc.integer_of_int i) $ term_of_num vs t2
| term_of_num vs (Proc.CN (n, i, t')) =
term_of_num vs (Proc.Add (Proc.Mul (i, Proc.Bound n), t'));
-fun term_of_fm ps vs Proc.T = @{term True}
- | term_of_fm ps vs Proc.F = @{term False}
+fun term_of_fm ps vs Proc.T = \<^term>\<open>True\<close>
+ | term_of_fm ps vs Proc.F = \<^term>\<open>False\<close>
| term_of_fm ps vs (Proc.And (t1, t2)) = HOLogic.conj $ term_of_fm ps vs t1 $ term_of_fm ps vs t2
| term_of_fm ps vs (Proc.Or (t1, t2)) = HOLogic.disj $ term_of_fm ps vs t1 $ term_of_fm ps vs t2
| term_of_fm ps vs (Proc.Imp (t1, t2)) = HOLogic.imp $ term_of_fm ps vs t1 $ term_of_fm ps vs t2
- | term_of_fm ps vs (Proc.Iff (t1, t2)) = @{term "(=) :: bool => _"} $ term_of_fm ps vs t1 $ term_of_fm ps vs t2
+ | term_of_fm ps vs (Proc.Iff (t1, t2)) = \<^term>\<open>(=) :: bool => _\<close> $ term_of_fm ps vs t1 $ term_of_fm ps vs t2
| term_of_fm ps vs (Proc.NOT t') = HOLogic.Not $ term_of_fm ps vs t'
- | term_of_fm ps vs (Proc.Eq t') = @{term "(=) :: int => _ "} $ term_of_num vs t'$ @{term "0::int"}
+ | term_of_fm ps vs (Proc.Eq t') = \<^term>\<open>(=) :: int => _ \<close> $ term_of_num vs t'$ \<^term>\<open>0::int\<close>
| term_of_fm ps vs (Proc.NEq t') = term_of_fm ps vs (Proc.NOT (Proc.Eq t'))
- | term_of_fm ps vs (Proc.Lt t') = @{term "(<) :: int => _ "} $ term_of_num vs t' $ @{term "0::int"}
- | term_of_fm ps vs (Proc.Le t') = @{term "(<=) :: int => _ "} $ term_of_num vs t' $ @{term "0::int"}
- | term_of_fm ps vs (Proc.Gt t') = @{term "(<) :: int => _ "} $ @{term "0::int"} $ term_of_num vs t'
- | term_of_fm ps vs (Proc.Ge t') = @{term "(<=) :: int => _ "} $ @{term "0::int"} $ term_of_num vs t'
- | term_of_fm ps vs (Proc.Dvd (i, t')) = @{term "(dvd) :: int => _ "} $
+ | term_of_fm ps vs (Proc.Lt t') = \<^term>\<open>(<) :: int => _ \<close> $ term_of_num vs t' $ \<^term>\<open>0::int\<close>
+ | term_of_fm ps vs (Proc.Le t') = \<^term>\<open>(<=) :: int => _ \<close> $ term_of_num vs t' $ \<^term>\<open>0::int\<close>
+ | term_of_fm ps vs (Proc.Gt t') = \<^term>\<open>(<) :: int => _ \<close> $ \<^term>\<open>0::int\<close> $ term_of_num vs t'
+ | term_of_fm ps vs (Proc.Ge t') = \<^term>\<open>(<=) :: int => _ \<close> $ \<^term>\<open>0::int\<close> $ term_of_num vs t'
+ | term_of_fm ps vs (Proc.Dvd (i, t')) = \<^term>\<open>(dvd) :: int => _ \<close> $
HOLogic.mk_number HOLogic.intT (Proc.integer_of_int i) $ term_of_num vs t'
| term_of_fm ps vs (Proc.NDvd (i, t')) = term_of_fm ps vs (Proc.NOT (Proc.Dvd (i, t')))
| term_of_fm ps vs (Proc.Closed n) = nth ps (Proc.integer_of_nat n)
@@ -694,24 +694,24 @@
end;
val (_, oracle) = Context.>>> (Context.map_theory_result
- (Thm.add_oracle (@{binding cooper},
+ (Thm.add_oracle (\<^binding>\<open>cooper\<close>,
(fn (ctxt, t) =>
(Thm.cterm_of ctxt o Logic.mk_equals o apply2 HOLogic.mk_Trueprop)
(t, procedure t)))));
val comp_ss =
- simpset_of (put_simpset HOL_ss @{context} addsimps @{thms semiring_norm});
+ simpset_of (put_simpset HOL_ss \<^context> addsimps @{thms semiring_norm});
fun strip_objimp ct =
(case Thm.term_of ct of
- Const (@{const_name HOL.implies}, _) $ _ $ _ =>
+ Const (\<^const_name>\<open>HOL.implies\<close>, _) $ _ $ _ =>
let val (A, B) = Thm.dest_binop ct
in A :: strip_objimp B end
| _ => [ct]);
fun strip_objall ct =
case Thm.term_of ct of
- Const (@{const_name All}, _) $ Abs (xn,_,_) =>
+ Const (\<^const_name>\<open>All\<close>, _) $ Abs (xn,_,_) =>
let val (a,(v,t')) = (apsnd (Thm.dest_abs (SOME xn)) o Thm.dest_comb) ct
in apfst (cons (a,v)) (strip_objall t')
end
@@ -719,7 +719,7 @@
local
val all_maxscope_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps map (fn th => th RS sym) @{thms "all_simps"})
in
fun thin_prems_tac ctxt P =
@@ -729,11 +729,11 @@
val (qvs, p) = strip_objall (Thm.dest_arg p')
val (ps, c) = split_last (strip_objimp p)
val qs = filter P ps
- val q = if P c then c else @{cterm "False"}
+ val q = if P c then c else \<^cterm>\<open>False\<close>
val ng = fold_rev (fn (a,v) => fn t => Thm.apply a (Thm.lambda v t)) qvs
- (fold_rev (fn p => fn q => Thm.apply (Thm.apply @{cterm HOL.implies} p) q) qs q)
- val g = Thm.apply (Thm.apply @{cterm "(==>)"} (Thm.apply @{cterm "Trueprop"} ng)) p'
- val ntac = (case qs of [] => q aconvc @{cterm "False"}
+ (fold_rev (fn p => fn q => Thm.apply (Thm.apply \<^cterm>\<open>HOL.implies\<close> p) q) qs q)
+ val g = Thm.apply (Thm.apply \<^cterm>\<open>(==>)\<close> (Thm.apply \<^cterm>\<open>Trueprop\<close> ng)) p'
+ val ntac = (case qs of [] => q aconvc \<^cterm>\<open>False\<close>
| _ => false)
in
if ntac then no_tac
@@ -747,25 +747,25 @@
local
fun isnum t = case t of
- Const(@{const_name Groups.zero},_) => true
- | Const(@{const_name Groups.one},_) => true
- | @{term Suc}$s => isnum s
- | @{term "nat"}$s => isnum s
- | @{term "int"}$s => isnum s
- | Const(@{const_name Groups.uminus},_)$s => isnum s
- | Const(@{const_name Groups.plus},_)$l$r => isnum l andalso isnum r
- | Const(@{const_name Groups.times},_)$l$r => isnum l andalso isnum r
- | Const(@{const_name Groups.minus},_)$l$r => isnum l andalso isnum r
- | Const(@{const_name Power.power},_)$l$r => isnum l andalso isnum r
- | Const(@{const_name Rings.modulo},_)$l$r => isnum l andalso isnum r
- | Const(@{const_name Rings.divide},_)$l$r => isnum l andalso isnum r
+ Const(\<^const_name>\<open>Groups.zero\<close>,_) => true
+ | Const(\<^const_name>\<open>Groups.one\<close>,_) => true
+ | \<^term>\<open>Suc\<close>$s => isnum s
+ | \<^term>\<open>nat\<close>$s => isnum s
+ | \<^term>\<open>int\<close>$s => isnum s
+ | Const(\<^const_name>\<open>Groups.uminus\<close>,_)$s => isnum s
+ | Const(\<^const_name>\<open>Groups.plus\<close>,_)$l$r => isnum l andalso isnum r
+ | Const(\<^const_name>\<open>Groups.times\<close>,_)$l$r => isnum l andalso isnum r
+ | Const(\<^const_name>\<open>Groups.minus\<close>,_)$l$r => isnum l andalso isnum r
+ | Const(\<^const_name>\<open>Power.power\<close>,_)$l$r => isnum l andalso isnum r
+ | Const(\<^const_name>\<open>Rings.modulo\<close>,_)$l$r => isnum l andalso isnum r
+ | Const(\<^const_name>\<open>Rings.divide\<close>,_)$l$r => isnum l andalso isnum r
| _ => is_number t orelse can HOLogic.dest_nat t
fun ty cts t =
if not (member (op =) [HOLogic.intT, HOLogic.natT, HOLogic.boolT] (Thm.typ_of_cterm t))
then false
else case Thm.term_of t of
- c$l$r => if member (op =) [@{term"(*)::int => _"}, @{term"(*)::nat => _"}] c
+ c$l$r => if member (op =) [\<^term>\<open>(*)::int => _\<close>, \<^term>\<open>(*)::nat => _\<close>] c
then not (isnum l orelse isnum r)
else not (member (op aconv) cts c)
| c$_ => not (member (op aconv) cts c)
@@ -782,10 +782,10 @@
fun is_relevant ctxt ct =
subset (op aconv) (term_constants (Thm.term_of ct), snd (get ctxt))
andalso
- forall (fn Free (_, T) => member (op =) [@{typ int}, @{typ nat}] T)
+ forall (fn Free (_, T) => member (op =) [\<^typ>\<open>int\<close>, \<^typ>\<open>nat\<close>] T)
(Misc_Legacy.term_frees (Thm.term_of ct))
andalso
- forall (fn Var (_, T) => member (op =) [@{typ int}, @{typ nat}] T)
+ forall (fn Var (_, T) => member (op =) [\<^typ>\<open>int\<close>, \<^typ>\<open>nat\<close>] T)
(Misc_Legacy.term_vars (Thm.term_of ct));
fun int_nat_terms ctxt ct =
@@ -809,20 +809,20 @@
local
val ss1 =
- simpset_of (put_simpset comp_ss @{context}
+ simpset_of (put_simpset comp_ss \<^context>
addsimps @{thms simp_thms} @
[@{thm "nat_numeral"} RS sym, @{thm int_dvd_int_iff [symmetric]}, @{thm "of_nat_add"}, @{thm "of_nat_mult"}]
@ map (fn r => r RS sym) [@{thm "int_int_eq"}, @{thm "zle_int"}, @{thm "of_nat_less_iff" [where ?'a = int]}]
|> Splitter.add_split @{thm "zdiff_int_split"})
val ss2 =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps [@{thm "nat_0_le"}, @{thm "of_nat_numeral"},
@{thm "all_nat"}, @{thm "ex_nat"}, @{thm "zero_le_numeral"},
@{thm "le_numeral_extra"(3)}, @{thm "of_nat_0"}, @{thm "of_nat_1"}, @{thm "Suc_eq_plus1"}]
|> fold Simplifier.add_cong [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}])
val div_mod_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps @{thms simp_thms
mod_eq_0_iff_dvd mod_add_left_eq mod_add_right_eq
mod_add_eq div_add1_eq [symmetric] div_add1_eq [symmetric]
@@ -830,9 +830,9 @@
div_0 mod_0 div_by_1 mod_by_1
div_by_Suc_0 mod_by_Suc_0 Suc_eq_plus1
ac_simps}
- addsimprocs [@{simproc cancel_div_mod_nat}, @{simproc cancel_div_mod_int}])
+ addsimprocs [\<^simproc>\<open>cancel_div_mod_nat\<close>, \<^simproc>\<open>cancel_div_mod_int\<close>])
val splits_ss =
- simpset_of (put_simpset comp_ss @{context}
+ simpset_of (put_simpset comp_ss \<^context>
addsimps [@{thm minus_div_mult_eq_mod [symmetric]}]
|> fold Splitter.add_split
[@{thm "split_zdiv"}, @{thm "split_zmod"}, @{thm "split_div'"},
@@ -868,7 +868,7 @@
val simpset_ctxt =
put_simpset (fst (get ctxt)) ctxt delsimps del_ths addsimps add_ths
in
- Method.insert_tac ctxt (rev (Named_Theorems.get ctxt @{named_theorems arith}))
+ Method.insert_tac ctxt (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>arith\<close>))
THEN_ALL_NEW Object_Logic.full_atomize_tac ctxt
THEN_ALL_NEW CONVERSION Thm.eta_long_conversion
THEN_ALL_NEW simp_tac simpset_ctxt
@@ -903,7 +903,7 @@
val _ =
Theory.setup
- (Attrib.setup @{binding presburger}
+ (Attrib.setup \<^binding>\<open>presburger\<close>
((Scan.lift (Args.$$$ "del") |-- optional (keyword constsN |-- terms)) >> del ||
optional (keyword constsN |-- terms) >> add) "data for Cooper's algorithm"
#> Arith_Data.add_tactic "Presburger arithmetic" (tac true [] []));
--- a/src/HOL/Tools/Qelim/qelim.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Qelim/qelim.ML Fri Jan 04 23:22:53 2019 +0100
@@ -24,12 +24,12 @@
case Thm.term_of p of
Const(s,T)$_$_ =>
if domain_type T = HOLogic.boolT
- andalso member (op =) [@{const_name HOL.conj}, @{const_name HOL.disj},
- @{const_name HOL.implies}, @{const_name HOL.eq}] s
+ andalso member (op =) [\<^const_name>\<open>HOL.conj\<close>, \<^const_name>\<open>HOL.disj\<close>,
+ \<^const_name>\<open>HOL.implies\<close>, \<^const_name>\<open>HOL.eq\<close>] s
then Conv.binop_conv (conv env) p
else atcv env p
- | Const(@{const_name Not},_)$_ => Conv.arg_conv (conv env) p
- | Const(@{const_name Ex},_)$Abs(s,_,_) =>
+ | Const(\<^const_name>\<open>Not\<close>,_)$_ => Conv.arg_conv (conv env) p
+ | Const(\<^const_name>\<open>Ex\<close>,_)$Abs(s,_,_) =>
let
val (e,p0) = Thm.dest_comb p
val (x,p') = Thm.dest_abs (SOME s) p0
@@ -40,8 +40,8 @@
val (_, r) = Thm.dest_equals (Thm.cprop_of th')
in if Thm.is_reflexive th' then Thm.transitive th (qcv env (Thm.rhs_of th))
else Thm.transitive (Thm.transitive th th') (conv env r) end
- | Const(@{const_name Ex},_)$ _ => (Thm.eta_long_conversion then_conv conv env) p
- | Const(@{const_name All}, allT)$_ =>
+ | Const(\<^const_name>\<open>Ex\<close>,_)$ _ => (Thm.eta_long_conversion then_conv conv env) p
+ | Const(\<^const_name>\<open>All\<close>, allT)$_ =>
let
val T = Thm.ctyp_of ctxt (#1 (Term.dest_funT (#1 (Term.dest_funT allT))))
val p = Thm.dest_arg p
@@ -57,7 +57,7 @@
val ss =
simpset_of
- (put_simpset HOL_basic_ss @{context}
+ (put_simpset HOL_basic_ss \<^context>
addsimps @{thms simp_thms ex_simps all_simps all_not_ex not_all ex_disj_distrib});
fun pcv ctxt = Simplifier.rewrite (put_simpset ss ctxt)
--- a/src/HOL/Tools/Quickcheck/random_generators.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Quickcheck/random_generators.ML Fri Jan 04 23:22:53 2019 +0100
@@ -82,7 +82,7 @@
val rew_thms = map mk_meta_eq [@{thm natural_zero_minus_one},
@{thm Suc_natural_minus_one}, @{thm select_weight_cons_zero}, @{thm beyond_zero}];
val rew_ts = map (Logic.dest_equals o Thm.prop_of) rew_thms;
-val rew_ss = simpset_of (put_simpset HOL_ss @{context} addsimps rew_thms);
+val rew_ss = simpset_of (put_simpset HOL_ss \<^context> addsimps rew_thms);
in
--- a/src/HOL/Tools/Quotient/quotient_def.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Quotient/quotient_def.ML Fri Jan 04 23:22:53 2019 +0100
@@ -95,7 +95,7 @@
fun abs_conv2 cv = Conv.abs_conv (K (Conv.abs_conv (K cv) lthy)) lthy
fun erase_quants ctm' =
case (Thm.term_of ctm') of
- Const (@{const_name HOL.eq}, _) $ _ $ _ => Conv.all_conv ctm'
+ Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ _ => Conv.all_conv ctm'
| _ => (Conv.binder_conv (K erase_quants) lthy then_conv
Conv.rewr_conv @{thm fun_eq_iff[symmetric, THEN eq_reflection]}) ctm'
in
@@ -111,7 +111,7 @@
fun binop_conv2 cv1 cv2 = Conv.combination_conv (Conv.arg_conv cv1) cv2
in
case (Thm.term_of ctm) of
- Const (@{const_name rel_fun}, _) $ _ $ _ =>
+ Const (\<^const_name>\<open>rel_fun\<close>, _) $ _ $ _ =>
(binop_conv2 left_conv simp_arrows_conv then_conv unfold_conv) ctm
| _ => Conv.all_conv ctm
end
@@ -163,7 +163,7 @@
|> try HOLogic.dest_Trueprop
in
case lhs_eq of
- SOME (Const (@{const_name HOL.eq}, _) $ _ $ _) => SOME (@{thm refl} RS thm)
+ SOME (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ _) => SOME (@{thm refl} RS thm)
| SOME _ => (case body_type (fastype_of lhs) of
Type (typ_name, _) =>
try (fn () =>
@@ -205,10 +205,10 @@
(* command syntax *)
val _ =
- Outer_Syntax.local_theory_to_proof @{command_keyword quotient_definition}
+ Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>quotient_definition\<close>
"definition for constants over the quotient type"
(Scan.option Parse_Spec.constdecl --
- Parse.!!! (Parse_Spec.opt_thm_name ":" -- (Parse.term -- (@{keyword "is"} |-- Parse.term)))
+ Parse.!!! (Parse_Spec.opt_thm_name ":" -- (Parse.term -- (\<^keyword>\<open>is\<close> |-- Parse.term)))
>> quotient_def_cmd);
end;
--- a/src/HOL/Tools/Quotient/quotient_info.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Quotient/quotient_info.ML Fri Jan 04 23:22:53 2019 +0100
@@ -116,11 +116,11 @@
val _ =
Theory.setup
- (Attrib.setup @{binding mapQ3}
- ((Args.type_name {proper = true, strict = true} --| Scan.lift @{keyword "="}) --
- (Scan.lift @{keyword "("} |--
- Args.const {proper = true, strict = true} --| Scan.lift @{keyword ","} --
- Attrib.thm --| Scan.lift @{keyword ")"}) >>
+ (Attrib.setup \<^binding>\<open>mapQ3\<close>
+ ((Args.type_name {proper = true, strict = true} --| Scan.lift \<^keyword>\<open>=\<close>) --
+ (Scan.lift \<^keyword>\<open>(\<close> |--
+ Args.const {proper = true, strict = true} --| Scan.lift \<^keyword>\<open>,\<close> --
+ Attrib.thm --| Scan.lift \<^keyword>\<open>)\<close>) >>
(fn (tyname, (relmap, quot_thm)) =>
Thm.declaration_attribute
(K (update_quotmaps (tyname, {relmap = relmap, quot_thm = quot_thm})))))
@@ -246,15 +246,15 @@
(* outer syntax commands *)
val _ =
- Outer_Syntax.command @{command_keyword print_quotmapsQ3} "print quotient map functions"
+ Outer_Syntax.command \<^command_keyword>\<open>print_quotmapsQ3\<close> "print quotient map functions"
(Scan.succeed (Toplevel.keep (print_quotmaps o Toplevel.context_of)))
val _ =
- Outer_Syntax.command @{command_keyword print_quotientsQ3} "print quotients"
+ Outer_Syntax.command \<^command_keyword>\<open>print_quotientsQ3\<close> "print quotients"
(Scan.succeed (Toplevel.keep (print_quotients o Toplevel.context_of)))
val _ =
- Outer_Syntax.command @{command_keyword print_quotconsts} "print quotient constants"
+ Outer_Syntax.command \<^command_keyword>\<open>print_quotconsts\<close> "print quotient constants"
(Scan.succeed (Toplevel.keep (print_quotconsts o Toplevel.context_of)))
end
--- a/src/HOL/Tools/Quotient/quotient_tacs.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Quotient/quotient_tacs.ML Fri Jan 04 23:22:53 2019 +0100
@@ -55,14 +55,14 @@
(** solvers for equivp and quotient assumptions **)
fun equiv_tac ctxt =
- REPEAT_ALL_NEW (resolve_tac ctxt (rev (Named_Theorems.get ctxt @{named_theorems quot_equiv})))
+ REPEAT_ALL_NEW (resolve_tac ctxt (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>quot_equiv\<close>)))
val equiv_solver = mk_solver "Equivalence goal solver" equiv_tac
fun quotient_tac ctxt =
(REPEAT_ALL_NEW (FIRST'
[resolve_tac ctxt @{thms identity_quotient3},
- resolve_tac ctxt (rev (Named_Theorems.get ctxt @{named_theorems quot_thm}))]))
+ resolve_tac ctxt (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>quot_thm\<close>))]))
val quotient_solver = mk_solver "Quotient goal solver" quotient_tac
@@ -109,12 +109,12 @@
fun ball_bex_range_simproc ctxt redex =
(case Thm.term_of redex of
- (Const (@{const_name "Ball"}, _) $ (Const (@{const_name "Respects"}, _) $
- (Const (@{const_name "rel_fun"}, _) $ R1 $ R2)) $ _) =>
+ (Const (\<^const_name>\<open>Ball\<close>, _) $ (Const (\<^const_name>\<open>Respects\<close>, _) $
+ (Const (\<^const_name>\<open>rel_fun\<close>, _) $ R1 $ R2)) $ _) =>
calculate_inst ctxt @{thm ball_reg_eqv_range[THEN eq_reflection]} redex R1 R2
- | (Const (@{const_name "Bex"}, _) $ (Const (@{const_name "Respects"}, _) $
- (Const (@{const_name "rel_fun"}, _) $ R1 $ R2)) $ _) =>
+ | (Const (\<^const_name>\<open>Bex\<close>, _) $ (Const (\<^const_name>\<open>Respects\<close>, _) $
+ (Const (\<^const_name>\<open>rel_fun\<close>, _) $ R1 $ R2)) $ _) =>
calculate_inst ctxt @{thm bex_reg_eqv_range[THEN eq_reflection]} redex R1 R2
| _ => NONE)
@@ -140,16 +140,16 @@
fun reflp_get ctxt =
map_filter (fn th => if Thm.no_prems th then SOME (OF1 @{thm equivp_reflp} th) else NONE
- handle THM _ => NONE) (rev (Named_Theorems.get ctxt @{named_theorems quot_equiv}))
+ handle THM _ => NONE) (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>quot_equiv\<close>))
val eq_imp_rel = @{lemma "equivp R \<Longrightarrow> a = b \<longrightarrow> R a b" by (simp add: equivp_reflp)}
fun eq_imp_rel_get ctxt =
- map (OF1 eq_imp_rel) (rev (Named_Theorems.get ctxt @{named_theorems quot_equiv}))
+ map (OF1 eq_imp_rel) (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>quot_equiv\<close>))
val regularize_simproc =
- Simplifier.make_simproc @{context} "regularize"
- {lhss = [@{term "Ball (Respects (R1 ===> R2)) P"}, @{term "Bex (Respects (R1 ===> R2)) P"}],
+ Simplifier.make_simproc \<^context> "regularize"
+ {lhss = [\<^term>\<open>Ball (Respects (R1 ===> R2)) P\<close>, \<^term>\<open>Bex (Respects (R1 ===> R2)) P\<close>],
proc = K ball_bex_range_simproc};
fun regularize_tac ctxt =
@@ -181,7 +181,7 @@
let
fun find_fun trm =
(case trm of
- (Const (@{const_name Trueprop}, _) $ (Const (@{const_name Quot_True}, _) $ _)) => true
+ (Const (\<^const_name>\<open>Trueprop\<close>, _) $ (Const (\<^const_name>\<open>Quot_True\<close>, _) $ _)) => true
| _ => false)
in
(case find_first find_fun asms of
@@ -191,7 +191,7 @@
fun quot_true_simple_conv ctxt fnctn ctrm =
(case Thm.term_of ctrm of
- (Const (@{const_name Quot_True}, _) $ x) =>
+ (Const (\<^const_name>\<open>Quot_True\<close>, _) $ x) =>
let
val fx = fnctn x;
val cx = Thm.cterm_of ctxt x;
@@ -205,7 +205,7 @@
fun quot_true_conv ctxt fnctn ctrm =
(case Thm.term_of ctrm of
- (Const (@{const_name Quot_True}, _) $ _) =>
+ (Const (\<^const_name>\<open>Quot_True\<close>, _) $ _) =>
quot_true_simple_conv ctxt fnctn ctrm
| _ $ _ => Conv.comb_conv (quot_true_conv ctxt fnctn) ctrm
| Abs _ => Conv.abs_conv (fn (_, ctxt) => quot_true_conv ctxt fnctn) ctxt ctrm
@@ -314,53 +314,53 @@
fun injection_match_tac ctxt = SUBGOAL (fn (goal, i) =>
(case bare_concl goal of
(* (R1 ===> R2) (%x...) (%x...) ----> [|R1 x y|] ==> R2 (...x) (...y) *)
- (Const (@{const_name rel_fun}, _) $ _ $ _) $ (Abs _) $ (Abs _)
+ (Const (\<^const_name>\<open>rel_fun\<close>, _) $ _ $ _) $ (Abs _) $ (Abs _)
=> resolve_tac ctxt @{thms rel_funI} THEN' quot_true_tac ctxt unlam
(* (op =) (Ball...) (Ball...) ----> (op =) (...) (...) *)
- | (Const (@{const_name HOL.eq},_) $
- (Const(@{const_name Ball},_) $ (Const (@{const_name Respects}, _) $ _) $ _) $
- (Const(@{const_name Ball},_) $ (Const (@{const_name Respects}, _) $ _) $ _))
+ | (Const (\<^const_name>\<open>HOL.eq\<close>,_) $
+ (Const(\<^const_name>\<open>Ball\<close>,_) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ _) $ _) $
+ (Const(\<^const_name>\<open>Ball\<close>,_) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ _) $ _))
=> resolve_tac ctxt @{thms ball_rsp} THEN' dresolve_tac ctxt @{thms QT_all}
(* (R1 ===> op =) (Ball...) (Ball...) ----> [|R1 x y|] ==> (Ball...x) = (Ball...y) *)
- | (Const (@{const_name rel_fun}, _) $ _ $ _) $
- (Const(@{const_name Ball},_) $ (Const (@{const_name Respects}, _) $ _) $ _) $
- (Const(@{const_name Ball},_) $ (Const (@{const_name Respects}, _) $ _) $ _)
+ | (Const (\<^const_name>\<open>rel_fun\<close>, _) $ _ $ _) $
+ (Const(\<^const_name>\<open>Ball\<close>,_) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ _) $ _) $
+ (Const(\<^const_name>\<open>Ball\<close>,_) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ _) $ _)
=> resolve_tac ctxt @{thms rel_funI} THEN' quot_true_tac ctxt unlam
(* (op =) (Bex...) (Bex...) ----> (op =) (...) (...) *)
- | Const (@{const_name HOL.eq},_) $
- (Const(@{const_name Bex},_) $ (Const (@{const_name Respects}, _) $ _) $ _) $
- (Const(@{const_name Bex},_) $ (Const (@{const_name Respects}, _) $ _) $ _)
+ | Const (\<^const_name>\<open>HOL.eq\<close>,_) $
+ (Const(\<^const_name>\<open>Bex\<close>,_) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ _) $ _) $
+ (Const(\<^const_name>\<open>Bex\<close>,_) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ _) $ _)
=> resolve_tac ctxt @{thms bex_rsp} THEN' dresolve_tac ctxt @{thms QT_ex}
(* (R1 ===> op =) (Bex...) (Bex...) ----> [|R1 x y|] ==> (Bex...x) = (Bex...y) *)
- | (Const (@{const_name rel_fun}, _) $ _ $ _) $
- (Const(@{const_name Bex},_) $ (Const (@{const_name Respects}, _) $ _) $ _) $
- (Const(@{const_name Bex},_) $ (Const (@{const_name Respects}, _) $ _) $ _)
+ | (Const (\<^const_name>\<open>rel_fun\<close>, _) $ _ $ _) $
+ (Const(\<^const_name>\<open>Bex\<close>,_) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ _) $ _) $
+ (Const(\<^const_name>\<open>Bex\<close>,_) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ _) $ _)
=> resolve_tac ctxt @{thms rel_funI} THEN' quot_true_tac ctxt unlam
- | (Const (@{const_name rel_fun}, _) $ _ $ _) $
- (Const(@{const_name Bex1_rel},_) $ _) $ (Const(@{const_name Bex1_rel},_) $ _)
+ | (Const (\<^const_name>\<open>rel_fun\<close>, _) $ _ $ _) $
+ (Const(\<^const_name>\<open>Bex1_rel\<close>,_) $ _) $ (Const(\<^const_name>\<open>Bex1_rel\<close>,_) $ _)
=> resolve_tac ctxt @{thms bex1_rel_rsp} THEN' quotient_tac ctxt
| (_ $
- (Const(@{const_name Babs},_) $ (Const (@{const_name Respects}, _) $ _) $ _) $
- (Const(@{const_name Babs},_) $ (Const (@{const_name Respects}, _) $ _) $ _))
+ (Const(\<^const_name>\<open>Babs\<close>,_) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ _) $ _) $
+ (Const(\<^const_name>\<open>Babs\<close>,_) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ _) $ _))
=> resolve_tac ctxt @{thms babs_rsp} THEN' quotient_tac ctxt
- | Const (@{const_name HOL.eq},_) $ (R $ _ $ _) $ (_ $ _ $ _) =>
+ | Const (\<^const_name>\<open>HOL.eq\<close>,_) $ (R $ _ $ _) $ (_ $ _ $ _) =>
(resolve_tac ctxt @{thms refl} ORELSE'
(equals_rsp_tac R ctxt THEN' RANGE [
quot_true_tac ctxt (fst o dest_bcomb), quot_true_tac ctxt (snd o dest_bcomb)]))
(* reflexivity of operators arising from Cong_tac *)
- | Const (@{const_name HOL.eq},_) $ _ $ _ => resolve_tac ctxt @{thms refl}
+ | Const (\<^const_name>\<open>HOL.eq\<close>,_) $ _ $ _ => resolve_tac ctxt @{thms refl}
(* respectfulness of constants; in particular of a simple relation *)
| _ $ (Const _) $ (Const _) (* rel_fun, list_rel, etc but not equality *)
- => resolve_tac ctxt (rev (Named_Theorems.get ctxt @{named_theorems quot_respect}))
+ => resolve_tac ctxt (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>quot_respect\<close>))
THEN_ALL_NEW quotient_tac ctxt
(* R (...) (Rep (Abs ...)) ----> R (...) (...) *)
@@ -411,7 +411,7 @@
(* expands all map_funs, except in front of the (bound) variables listed in xs *)
fun map_fun_simple_conv xs ctrm =
(case Thm.term_of ctrm of
- ((Const (@{const_name "map_fun"}, _) $ _ $ _) $ h $ _) =>
+ ((Const (\<^const_name>\<open>map_fun\<close>, _) $ _ $ _) $ h $ _) =>
if member (op=) xs h
then Conv.all_conv ctrm
else Conv.rewr_conv @{thm map_fun_apply [THEN eq_reflection]} ctrm
@@ -462,7 +462,7 @@
*)
fun lambda_prs_simple_conv ctxt ctrm =
(case Thm.term_of ctrm of
- (Const (@{const_name map_fun}, _) $ r1 $ a2) $ (Abs _) =>
+ (Const (\<^const_name>\<open>map_fun\<close>, _) $ r1 $ a2) $ (Abs _) =>
let
val (ty_b, ty_a) = dest_funT (fastype_of r1)
val (ty_c, ty_d) = dest_funT (fastype_of a2)
@@ -511,8 +511,8 @@
let
val thy = Proof_Context.theory_of ctxt
val defs = map (Thm.symmetric o #def) (Quotient_Info.dest_quotconsts_global thy)
- val prs = rev (Named_Theorems.get ctxt @{named_theorems quot_preserve})
- val ids = rev (Named_Theorems.get ctxt @{named_theorems id_simps})
+ val prs = rev (Named_Theorems.get ctxt \<^named_theorems>\<open>quot_preserve\<close>)
+ val ids = rev (Named_Theorems.get ctxt \<^named_theorems>\<open>id_simps\<close>)
val thms =
@{thms Quotient3_abs_rep Quotient3_rel_rep babs_prs all_prs ex_prs ex1_prs} @ ids @ prs @ defs
--- a/src/HOL/Tools/Quotient/quotient_term.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Quotient/quotient_term.ML Fri Jan 04 23:22:53 2019 +0100
@@ -55,15 +55,15 @@
fun negF AbsF = RepF
| negF RepF = AbsF
-fun is_identity (Const (@{const_name id}, _)) = true
+fun is_identity (Const (\<^const_name>\<open>id\<close>, _)) = true
| is_identity _ = false
-fun mk_identity ty = Const (@{const_name id}, ty --> ty)
+fun mk_identity ty = Const (\<^const_name>\<open>id\<close>, ty --> ty)
fun mk_fun_compose flag (trm1, trm2) =
case flag of
- AbsF => Const (@{const_name comp}, dummyT) $ trm1 $ trm2
- | RepF => Const (@{const_name comp}, dummyT) $ trm2 $ trm1
+ AbsF => Const (\<^const_name>\<open>comp\<close>, dummyT) $ trm1 $ trm2
+ | RepF => Const (\<^const_name>\<open>comp\<close>, dummyT) $ trm2 $ trm1
fun get_mapfun_data ctxt s =
(case Symtab.lookup (Functor.entries ctxt) s of
@@ -264,11 +264,11 @@
map_types (Envir.subst_type ty_inst) trm
end
-fun is_eq (Const (@{const_name HOL.eq}, _)) = true
+fun is_eq (Const (\<^const_name>\<open>HOL.eq\<close>, _)) = true
| is_eq _ = false
fun mk_rel_compose (trm1, trm2) =
- Const (@{const_abbrev "rel_conj"}, dummyT) $ trm1 $ trm2
+ Const (\<^const_abbrev>\<open>rel_conj\<close>, dummyT) $ trm1 $ trm2
fun get_relmap ctxt s =
(case Quotient_Info.lookup_quotmaps ctxt s of
@@ -312,7 +312,7 @@
val rtys' = map (Envir.subst_type qtyenv) rtys
val args = map (equiv_relation ctxt) (tys ~~ rtys')
val eqv_rel = get_equiv_rel ctxt s'
- val eqv_rel' = force_typ ctxt eqv_rel ([rty, rty] ---> @{typ bool})
+ val eqv_rel' = force_typ ctxt eqv_rel ([rty, rty] ---> \<^typ>\<open>bool\<close>)
in
if forall is_eq args
then eqv_rel'
@@ -442,11 +442,11 @@
*)
-val mk_babs = Const (@{const_name Babs}, dummyT)
-val mk_ball = Const (@{const_name Ball}, dummyT)
-val mk_bex = Const (@{const_name Bex}, dummyT)
-val mk_bex1_rel = Const (@{const_name Bex1_rel}, dummyT)
-val mk_resp = Const (@{const_name Respects}, dummyT)
+val mk_babs = Const (\<^const_name>\<open>Babs\<close>, dummyT)
+val mk_ball = Const (\<^const_name>\<open>Ball\<close>, dummyT)
+val mk_bex = Const (\<^const_name>\<open>Bex\<close>, dummyT)
+val mk_bex1_rel = Const (\<^const_name>\<open>Bex1_rel\<close>, dummyT)
+val mk_resp = Const (\<^const_name>\<open>Respects\<close>, dummyT)
(* - applies f to the subterm of an abstraction,
otherwise to the given term,
@@ -509,7 +509,7 @@
else mk_babs $ (mk_resp $ equiv_relation ctxt (ty, ty')) $ subtrm
end
- | (Const (@{const_name Babs}, T) $ resrel $ (t as (Abs (_, ty, _))), t' as (Abs (_, ty', _))) =>
+ | (Const (\<^const_name>\<open>Babs\<close>, T) $ resrel $ (t as (Abs (_, ty, _))), t' as (Abs (_, ty', _))) =>
let
val subtrm = regularize_trm ctxt (t, t')
val needres = mk_resp $ equiv_relation_chk ctxt (ty, ty')
@@ -519,26 +519,26 @@
else mk_babs $ resrel $ subtrm
end
- | (Const (@{const_name All}, ty) $ t, Const (@{const_name All}, ty') $ t') =>
+ | (Const (\<^const_name>\<open>All\<close>, ty) $ t, Const (\<^const_name>\<open>All\<close>, ty') $ t') =>
let
val subtrm = apply_subt (regularize_trm ctxt) (t, t')
in
- if ty = ty' then Const (@{const_name All}, ty) $ subtrm
+ if ty = ty' then Const (\<^const_name>\<open>All\<close>, ty) $ subtrm
else mk_ball $ (mk_resp $ equiv_relation ctxt (qnt_typ ty, qnt_typ ty')) $ subtrm
end
- | (Const (@{const_name Ex}, ty) $ t, Const (@{const_name Ex}, ty') $ t') =>
+ | (Const (\<^const_name>\<open>Ex\<close>, ty) $ t, Const (\<^const_name>\<open>Ex\<close>, ty') $ t') =>
let
val subtrm = apply_subt (regularize_trm ctxt) (t, t')
in
- if ty = ty' then Const (@{const_name Ex}, ty) $ subtrm
+ if ty = ty' then Const (\<^const_name>\<open>Ex\<close>, ty) $ subtrm
else mk_bex $ (mk_resp $ equiv_relation ctxt (qnt_typ ty, qnt_typ ty')) $ subtrm
end
- | (Const (@{const_name Ex1}, ty) $ (Abs (_, _,
- (Const (@{const_name HOL.conj}, _) $ (Const (@{const_name Set.member}, _) $ _ $
- (Const (@{const_name Respects}, _) $ resrel)) $ (t $ _)))),
- Const (@{const_name Ex1}, ty') $ t') =>
+ | (Const (\<^const_name>\<open>Ex1\<close>, ty) $ (Abs (_, _,
+ (Const (\<^const_name>\<open>HOL.conj\<close>, _) $ (Const (\<^const_name>\<open>Set.member\<close>, _) $ _ $
+ (Const (\<^const_name>\<open>Respects\<close>, _) $ resrel)) $ (t $ _)))),
+ Const (\<^const_name>\<open>Ex1\<close>, ty') $ t') =>
let
val t_ = incr_boundvars (~1) t
val subtrm = apply_subt (regularize_trm ctxt) (t_, t')
@@ -549,16 +549,16 @@
else mk_bex1_rel $ resrel $ subtrm
end
- | (Const (@{const_name Ex1}, ty) $ t, Const (@{const_name Ex1}, ty') $ t') =>
+ | (Const (\<^const_name>\<open>Ex1\<close>, ty) $ t, Const (\<^const_name>\<open>Ex1\<close>, ty') $ t') =>
let
val subtrm = apply_subt (regularize_trm ctxt) (t, t')
in
- if ty = ty' then Const (@{const_name Ex1}, ty) $ subtrm
+ if ty = ty' then Const (\<^const_name>\<open>Ex1\<close>, ty) $ subtrm
else mk_bex1_rel $ (equiv_relation ctxt (qnt_typ ty, qnt_typ ty')) $ subtrm
end
- | (Const (@{const_name Ball}, ty) $ (Const (@{const_name Respects}, _) $ resrel) $ t,
- Const (@{const_name All}, ty') $ t') =>
+ | (Const (\<^const_name>\<open>Ball\<close>, ty) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ resrel) $ t,
+ Const (\<^const_name>\<open>All\<close>, ty') $ t') =>
let
val subtrm = apply_subt (regularize_trm ctxt) (t, t')
val needrel = equiv_relation_chk ctxt (qnt_typ ty, qnt_typ ty')
@@ -568,8 +568,8 @@
else mk_ball $ (mk_resp $ resrel) $ subtrm
end
- | (Const (@{const_name Bex}, ty) $ (Const (@{const_name Respects}, _) $ resrel) $ t,
- Const (@{const_name Ex}, ty') $ t') =>
+ | (Const (\<^const_name>\<open>Bex\<close>, ty) $ (Const (\<^const_name>\<open>Respects\<close>, _) $ resrel) $ t,
+ Const (\<^const_name>\<open>Ex\<close>, ty') $ t') =>
let
val subtrm = apply_subt (regularize_trm ctxt) (t, t')
val needrel = equiv_relation_chk ctxt (qnt_typ ty, qnt_typ ty')
@@ -579,7 +579,7 @@
else mk_bex $ (mk_resp $ resrel) $ subtrm
end
- | (Const (@{const_name Bex1_rel}, ty) $ resrel $ t, Const (@{const_name Ex1}, ty') $ t') =>
+ | (Const (\<^const_name>\<open>Bex1_rel\<close>, ty) $ resrel $ t, Const (\<^const_name>\<open>Ex1\<close>, ty') $ t') =>
let
val subtrm = apply_subt (regularize_trm ctxt) (t, t')
val needrel = equiv_relation_chk ctxt (qnt_typ ty, qnt_typ ty')
@@ -590,12 +590,12 @@
end
| (* equalities need to be replaced by appropriate equivalence relations *)
- (Const (@{const_name HOL.eq}, ty), Const (@{const_name HOL.eq}, ty')) =>
+ (Const (\<^const_name>\<open>HOL.eq\<close>, ty), Const (\<^const_name>\<open>HOL.eq\<close>, ty')) =>
if ty = ty' then rtrm
else equiv_relation ctxt (domain_type ty, domain_type ty')
| (* in this case we just check whether the given equivalence relation is correct *)
- (rel, Const (@{const_name HOL.eq}, ty')) =>
+ (rel, Const (\<^const_name>\<open>HOL.eq\<close>, ty')) =>
let
val rel_ty = fastype_of rel
val rel' = equiv_relation_chk ctxt (domain_type rel_ty, domain_type ty')
@@ -623,12 +623,12 @@
end
end
- | (((t1 as Const (@{const_name case_prod}, _)) $ Abs (v1, ty, Abs(v1', ty', s1))),
- ((t2 as Const (@{const_name case_prod}, _)) $ Abs (v2, _ , Abs(v2', _ , s2)))) =>
+ | (((t1 as Const (\<^const_name>\<open>case_prod\<close>, _)) $ Abs (v1, ty, Abs(v1', ty', s1))),
+ ((t2 as Const (\<^const_name>\<open>case_prod\<close>, _)) $ Abs (v2, _ , Abs(v2', _ , s2)))) =>
regularize_trm ctxt (t1, t2) $ Abs (v1, ty, Abs (v1', ty', regularize_trm ctxt (s1, s2)))
- | (((t1 as Const (@{const_name case_prod}, _)) $ Abs (v1, ty, s1)),
- ((t2 as Const (@{const_name case_prod}, _)) $ Abs (v2, _ , s2))) =>
+ | (((t1 as Const (\<^const_name>\<open>case_prod\<close>, _)) $ Abs (v1, ty, s1)),
+ ((t2 as Const (\<^const_name>\<open>case_prod\<close>, _)) $ Abs (v2, _ , s2))) =>
regularize_trm ctxt (t1, t2) $ Abs (v1, ty, regularize_trm ctxt (s1, s2))
| (t1 $ t2, t1' $ t2') =>
@@ -699,18 +699,18 @@
as the type of subterms needs to be calculated *)
fun inj_repabs_trm ctxt (rtrm, qtrm) =
case (rtrm, qtrm) of
- (Const (@{const_name Ball}, T) $ r $ t, Const (@{const_name All}, _) $ t') =>
- Const (@{const_name Ball}, T) $ r $ (inj_repabs_trm ctxt (t, t'))
+ (Const (\<^const_name>\<open>Ball\<close>, T) $ r $ t, Const (\<^const_name>\<open>All\<close>, _) $ t') =>
+ Const (\<^const_name>\<open>Ball\<close>, T) $ r $ (inj_repabs_trm ctxt (t, t'))
- | (Const (@{const_name Bex}, T) $ r $ t, Const (@{const_name Ex}, _) $ t') =>
- Const (@{const_name Bex}, T) $ r $ (inj_repabs_trm ctxt (t, t'))
+ | (Const (\<^const_name>\<open>Bex\<close>, T) $ r $ t, Const (\<^const_name>\<open>Ex\<close>, _) $ t') =>
+ Const (\<^const_name>\<open>Bex\<close>, T) $ r $ (inj_repabs_trm ctxt (t, t'))
- | (Const (@{const_name Babs}, T) $ r $ t, t' as (Abs _)) =>
+ | (Const (\<^const_name>\<open>Babs\<close>, T) $ r $ t, t' as (Abs _)) =>
let
val rty = fastype_of rtrm
val qty = fastype_of qtrm
in
- mk_repabs ctxt (rty, qty) (Const (@{const_name Babs}, T) $ r $ (inj_repabs_trm ctxt (t, t')))
+ mk_repabs ctxt (rty, qty) (Const (\<^const_name>\<open>Babs\<close>, T) $ r $ (inj_repabs_trm ctxt (t, t')))
end
| (Abs (x, T, t), Abs (x', T', t')) =>
@@ -733,7 +733,7 @@
if T = T' then rtrm
else mk_repabs ctxt (T, T') rtrm
- | (_, Const (@{const_name HOL.eq}, _)) => rtrm
+ | (_, Const (\<^const_name>\<open>HOL.eq\<close>, _)) => rtrm
| (_, Const (_, T')) =>
let
--- a/src/HOL/Tools/Quotient/quotient_type.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Quotient/quotient_type.ML Fri Jan 04 23:22:53 2019 +0100
@@ -72,8 +72,8 @@
(* proves the quot_type theorem for the new type *)
fun typedef_quot_type_thm (rel, abs, rep, equiv_thm, typedef_info) lthy =
let
- val quot_type_const = Const (@{const_name "quot_type"},
- fastype_of rel --> fastype_of abs --> fastype_of rep --> @{typ bool})
+ val quot_type_const = Const (\<^const_name>\<open>quot_type\<close>,
+ fastype_of rel --> fastype_of abs --> fastype_of rep --> \<^typ>\<open>bool\<close>)
val goal = HOLogic.mk_Trueprop (quot_type_const $ rel $ abs $ rep)
in
Goal.prove lthy [] [] goal
@@ -98,8 +98,8 @@
val (rty, qty) = (dest_funT o fastype_of) abs_fun
val abs_fun_graph = HOLogic.mk_eq(abs_fun $ Bound 1, Bound 0)
val Abs_body = (case (HOLogic.dest_Trueprop o Thm.prop_of) equiv_thm of
- Const (@{const_name equivp}, _) $ _ => abs_fun_graph
- | Const (@{const_name part_equivp}, _) $ rel =>
+ Const (\<^const_name>\<open>equivp\<close>, _) $ _ => abs_fun_graph
+ | Const (\<^const_name>\<open>part_equivp\<close>, _) $ rel =>
HOLogic.mk_conj (force_type_of_rel rel rty $ Bound 1 $ Bound 1, abs_fun_graph)
| _ => error "unsupported equivalence theorem"
)
@@ -122,10 +122,10 @@
val quotient_thm_name = Binding.prefix_name "Quotient_" qty_name
val (reflp_thm, quot_thm) =
(case (HOLogic.dest_Trueprop o Thm.prop_of) equiv_thm of
- Const (@{const_name equivp}, _) $ _ =>
+ Const (\<^const_name>\<open>equivp\<close>, _) $ _ =>
(SOME (equiv_thm RS @{thm equivp_reflp2}),
[quot3_thm, T_def, equiv_thm] MRSL @{thm Quotient3_to_Quotient_equivp})
- | Const (@{const_name part_equivp}, _) $ _ =>
+ | Const (\<^const_name>\<open>part_equivp\<close>, _) $ _ =>
(NONE, [quot3_thm, T_def] MRSL @{thm Quotient3_to_Quotient})
| _ => error "unsupported equivalence theorem")
val config = { notes = true }
@@ -177,9 +177,9 @@
val Rep_const = Const (Rep_name, Abs_ty --> Rep_ty)
(* more useful abs and rep definitions *)
- val abs_const = Const (@{const_name quot_type.abs},
- (rty --> rty --> @{typ bool}) --> (Rep_ty --> Abs_ty) --> rty --> Abs_ty)
- val rep_const = Const (@{const_name quot_type.rep}, (Abs_ty --> Rep_ty) --> Abs_ty --> rty)
+ val abs_const = Const (\<^const_name>\<open>quot_type.abs\<close>,
+ (rty --> rty --> \<^typ>\<open>bool\<close>) --> (Rep_ty --> Abs_ty) --> rty --> Abs_ty)
+ val rep_const = Const (\<^const_name>\<open>quot_type.rep\<close>, (Abs_ty --> Rep_ty) --> Abs_ty --> rty)
val abs_trm = abs_const $ rel $ Abs_const
val rep_trm = rep_const $ Rep_const
val (rep_name, abs_name) =
@@ -303,9 +303,9 @@
fun mk_goal (rty, rel, partial) =
let
- val equivp_ty = ([rty, rty] ---> @{typ bool}) --> @{typ bool}
+ val equivp_ty = ([rty, rty] ---> \<^typ>\<open>bool\<close>) --> \<^typ>\<open>bool\<close>
val const =
- if partial then @{const_name part_equivp} else @{const_name equivp}
+ if partial then \<^const_name>\<open>part_equivp\<close> else \<^const_name>\<open>equivp\<close>
in
HOLogic.mk_Trueprop (Const (const, equivp_ty) $ rel)
end
@@ -325,7 +325,7 @@
val tmp_lthy1 = Variable.declare_typ rty lthy
val rel =
Syntax.parse_term tmp_lthy1 rel_str
- |> Type.constraint (rty --> rty --> @{typ bool})
+ |> Type.constraint (rty --> rty --> \<^typ>\<open>bool\<close>)
|> Syntax.check_term tmp_lthy1
val tmp_lthy2 = Variable.declare_term rel tmp_lthy1
val opt_par_thm = Option.map (singleton (Attrib.eval_thms lthy)) opt_par_xthm
@@ -342,14 +342,14 @@
(* command syntax *)
val _ =
- Outer_Syntax.local_theory_to_proof @{command_keyword quotient_type}
+ Outer_Syntax.local_theory_to_proof \<^command_keyword>\<open>quotient_type\<close>
"quotient type definitions (require equivalence proofs)"
(* FIXME Parse.type_args_constrained and standard treatment of sort constraints *)
(Parse_Spec.overloaded -- (Parse.type_args -- Parse.binding --
- Parse.opt_mixfix -- (@{keyword "="} |-- Parse.typ) -- (@{keyword "/"} |--
- Scan.optional (Parse.reserved "partial" -- @{keyword ":"} >> K true) false -- Parse.term) --
- Scan.option (@{keyword "morphisms"} |-- Parse.!!! (Parse.binding -- Parse.binding)) --
- Scan.option (@{keyword "parametric"} |-- Parse.!!! Parse.thm))
+ Parse.opt_mixfix -- (\<^keyword>\<open>=\<close> |-- Parse.typ) -- (\<^keyword>\<open>/\<close> |--
+ Scan.optional (Parse.reserved "partial" -- \<^keyword>\<open>:\<close> >> K true) false -- Parse.term) --
+ Scan.option (\<^keyword>\<open>morphisms\<close> |-- Parse.!!! (Parse.binding -- Parse.binding)) --
+ Scan.option (\<^keyword>\<open>parametric\<close> |-- Parse.!!! Parse.thm))
>> (fn (overloaded, spec) => quotient_type_cmd {overloaded = overloaded} spec))
end
--- a/src/HOL/Tools/SMT/conj_disj_perm.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/conj_disj_perm.ML Fri Jan 04 23:22:53 2019 +0100
@@ -95,7 +95,7 @@
in eq_from_impls thm1 thm2 end
val contrapos_rule = @{lemma "(\<not>P) = (\<not>Q) \<Longrightarrow> P = Q" by auto}
-fun contrapos prove cp = contrapos_rule OF [prove (apply2 (Thm.apply @{cterm HOL.Not}) cp)]
+fun contrapos prove cp = contrapos_rule OF [prove (apply2 (Thm.apply \<^cterm>\<open>HOL.Not\<close>) cp)]
datatype kind = True | False | Conj | Disj | Other
--- a/src/HOL/Tools/SMT/smt_normalize.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/smt_normalize.ML Fri Jan 04 23:22:53 2019 +0100
@@ -31,7 +31,7 @@
(** instantiate elimination rules **)
local
- val (cpfalse, cfalse) = `SMT_Util.mk_cprop (Thm.cterm_of @{context} \<^const>\<open>False\<close>)
+ val (cpfalse, cfalse) = `SMT_Util.mk_cprop (Thm.cterm_of \<^context> \<^const>\<open>False\<close>)
fun inst f ct thm =
let val cv = f (Drule.strip_imp_concl (Thm.cprop_of thm))
@@ -186,11 +186,11 @@
Pattern.matches thy (t', u) andalso not (t aconv u))
in not (Term.exists_subterm some_match u) end
- val pat = SMT_Util.mk_const_pat @{theory} \<^const_name>\<open>pat\<close> SMT_Util.destT1
+ val pat = SMT_Util.mk_const_pat \<^theory> \<^const_name>\<open>pat\<close> SMT_Util.destT1
fun mk_pat ct = Thm.apply (SMT_Util.instT' ct pat) ct
fun mk_clist T =
- apply2 (Thm.cterm_of @{context}) (SMT_Util.symb_cons_const T, SMT_Util.symb_nil_const T)
+ apply2 (Thm.cterm_of \<^context>) (SMT_Util.symb_cons_const T, SMT_Util.symb_nil_const T)
fun mk_list (ccons, cnil) f cts = fold_rev (Thm.mk_binop ccons o f) cts cnil
val mk_pat_list = mk_list (mk_clist \<^typ>\<open>pattern\<close>)
val mk_mpat_list = mk_list (mk_clist \<^typ>\<open>pattern symb_list\<close>)
@@ -349,7 +349,7 @@
fun int_ops_conv cv ctxt ct =
(case Thm.term_of ct of
- @{const of_nat (int)} $ (Const (@{const_name If}, _) $ _ $ _ $ _) =>
+ @{const of_nat (int)} $ (Const (\<^const_name>\<open>If\<close>, _) $ _ $ _ $ _) =>
Conv.rewr_conv int_if_thm then_conv
if_conv (cv ctxt) (int_ops_conv cv ctxt)
| @{const of_nat (int)} $ _ =>
@@ -430,7 +430,7 @@
fun is_strange_number ctxt t = is_irregular_number t andalso SMT_Builtin.is_builtin_num ctxt t
val proper_num_ss =
- simpset_of (put_simpset HOL_ss @{context} addsimps @{thms Num.numeral_One minus_zero})
+ simpset_of (put_simpset HOL_ss \<^context> addsimps @{thms Num.numeral_One minus_zero})
fun norm_num_conv ctxt =
SMT_Util.if_conv (is_strange_number ctxt) (Simplifier.rewrite (put_simpset proper_num_ss ctxt))
--- a/src/HOL/Tools/SMT/smt_real.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/smt_real.ML Fri Jan 04 23:22:53 2019 +0100
@@ -11,7 +11,7 @@
(* SMT-LIB logic *)
fun smtlib_logic ts =
- if exists (Term.exists_type (Term.exists_subtype (equal @{typ real}))) ts
+ if exists (Term.exists_type (Term.exists_subtype (equal \<^typ>\<open>real\<close>))) ts
then SOME "AUFLIRA"
else NONE
@@ -32,7 +32,7 @@
val setup_builtins =
SMT_Builtin.add_builtin_typ SMTLIB_Interface.smtlibC
- (@{typ real}, K (SOME ("Real", [])), real_num) #>
+ (\<^typ>\<open>real\<close>, K (SOME ("Real", [])), real_num) #>
fold (SMT_Builtin.add_builtin_fun' SMTLIB_Interface.smtlibC) [
(@{const less (real)}, "<"),
(@{const less_eq (real)}, "<="),
@@ -52,26 +52,26 @@
(* Z3 constructors *)
local
- fun z3_mk_builtin_typ (Z3_Interface.Sym ("Real", _)) = SOME @{typ real}
- | z3_mk_builtin_typ (Z3_Interface.Sym ("real", _)) = SOME @{typ real}
+ fun z3_mk_builtin_typ (Z3_Interface.Sym ("Real", _)) = SOME \<^typ>\<open>real\<close>
+ | z3_mk_builtin_typ (Z3_Interface.Sym ("real", _)) = SOME \<^typ>\<open>real\<close>
(*FIXME: delete*)
| z3_mk_builtin_typ _ = NONE
fun z3_mk_builtin_num _ i T =
- if T = @{typ real} then SOME (Numeral.mk_cnumber @{ctyp real} i)
+ if T = \<^typ>\<open>real\<close> then SOME (Numeral.mk_cnumber \<^ctyp>\<open>real\<close> i)
else NONE
fun mk_nary _ cu [] = cu
| mk_nary ct _ cts = uncurry (fold_rev (Thm.mk_binop ct)) (split_last cts)
- val mk_uminus = Thm.apply (Thm.cterm_of @{context} @{const uminus (real)})
- val add = Thm.cterm_of @{context} @{const plus (real)}
- val real0 = Numeral.mk_cnumber @{ctyp real} 0
- val mk_sub = Thm.mk_binop (Thm.cterm_of @{context} @{const minus (real)})
- val mk_mul = Thm.mk_binop (Thm.cterm_of @{context} @{const times (real)})
- val mk_div = Thm.mk_binop (Thm.cterm_of @{context} @{const divide (real)})
- val mk_lt = Thm.mk_binop (Thm.cterm_of @{context} @{const less (real)})
- val mk_le = Thm.mk_binop (Thm.cterm_of @{context} @{const less_eq (real)})
+ val mk_uminus = Thm.apply (Thm.cterm_of \<^context> @{const uminus (real)})
+ val add = Thm.cterm_of \<^context> @{const plus (real)}
+ val real0 = Numeral.mk_cnumber \<^ctyp>\<open>real\<close> 0
+ val mk_sub = Thm.mk_binop (Thm.cterm_of \<^context> @{const minus (real)})
+ val mk_mul = Thm.mk_binop (Thm.cterm_of \<^context> @{const times (real)})
+ val mk_div = Thm.mk_binop (Thm.cterm_of \<^context> @{const divide (real)})
+ val mk_lt = Thm.mk_binop (Thm.cterm_of \<^context> @{const less (real)})
+ val mk_le = Thm.mk_binop (Thm.cterm_of \<^context> @{const less_eq (real)})
fun z3_mk_builtin_fun (Z3_Interface.Sym ("-", _)) [ct] = SOME (mk_uminus ct)
| z3_mk_builtin_fun (Z3_Interface.Sym ("+", _)) cts = SOME (mk_nary add real0 cts)
@@ -90,7 +90,7 @@
mk_builtin_num = z3_mk_builtin_num,
mk_builtin_fun = (fn _ => fn sym => fn cts =>
(case try (Thm.typ_of_cterm o hd) cts of
- SOME @{typ real} => z3_mk_builtin_fun sym cts
+ SOME \<^typ>\<open>real\<close> => z3_mk_builtin_fun sym cts
| _ => NONE)) }
end
@@ -99,8 +99,8 @@
(* Z3 proof replay *)
val real_linarith_proc =
- Simplifier.make_simproc @{context} "fast_real_arith"
- {lhss = [@{term "(m::real) < n"}, @{term "(m::real) \<le> n"}, @{term "(m::real) = n"}],
+ Simplifier.make_simproc \<^context> "fast_real_arith"
+ {lhss = [\<^term>\<open>(m::real) < n\<close>, \<^term>\<open>(m::real) \<le> n\<close>, \<^term>\<open>(m::real) = n\<close>],
proc = K Lin_Arith.simproc}
--- a/src/HOL/Tools/SMT/smt_replay.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/smt_replay.ML Fri Jan 04 23:22:53 2019 +0100
@@ -110,7 +110,7 @@
fun prove_antisym_le ctxt ct =
let
val (le, r, s) = dest_binop (Thm.term_of ct)
- val less = Const (@{const_name less}, Term.fastype_of le)
+ val less = Const (\<^const_name>\<open>less\<close>, Term.fastype_of le)
val prems = Simplifier.prems_of ctxt
in
(case find_first (eq_prop (le $ s $ r)) prems of
@@ -124,7 +124,7 @@
fun prove_antisym_less ctxt ct =
let
val (less, r, s) = dest_binop (HOLogic.dest_not (Thm.term_of ct))
- val le = Const (@{const_name less_eq}, Term.fastype_of less)
+ val le = Const (\<^const_name>\<open>less_eq\<close>, Term.fastype_of less)
val prems = Simplifier.prems_of ctxt
in
(case find_first (eq_prop (le $ r $ s)) prems of
@@ -136,18 +136,18 @@
handle THM _ => NONE
val basic_simpset =
- simpset_of (put_simpset HOL_ss @{context}
+ simpset_of (put_simpset HOL_ss \<^context>
addsimps @{thms field_simps times_divide_eq_right times_divide_eq_left arith_special
arith_simps rel_simps array_rules z3div_def z3mod_def NO_MATCH_def}
- addsimprocs [@{simproc numeral_divmod},
- Simplifier.make_simproc @{context} "fast_int_arith"
- {lhss = [@{term "(m::int) < n"}, @{term "(m::int) \<le> n"}, @{term "(m::int) = n"}],
+ addsimprocs [\<^simproc>\<open>numeral_divmod\<close>,
+ Simplifier.make_simproc \<^context> "fast_int_arith"
+ {lhss = [\<^term>\<open>(m::int) < n\<close>, \<^term>\<open>(m::int) \<le> n\<close>, \<^term>\<open>(m::int) = n\<close>],
proc = K Lin_Arith.simproc},
- Simplifier.make_simproc @{context} "antisym_le"
- {lhss = [@{term "(x::'a::order) \<le> y"}],
+ Simplifier.make_simproc \<^context> "antisym_le"
+ {lhss = [\<^term>\<open>(x::'a::order) \<le> y\<close>],
proc = K prove_antisym_le},
- Simplifier.make_simproc @{context} "antisym_less"
- {lhss = [@{term "\<not> (x::'a::linorder) < y"}],
+ Simplifier.make_simproc \<^context> "antisym_less"
+ {lhss = [\<^term>\<open>\<not> (x::'a::linorder) < y\<close>],
proc = K prove_antisym_less}])
structure Simpset = Generic_Data
@@ -233,7 +233,7 @@
end
-fun params_of t = Term.strip_qnt_vars @{const_name Pure.all} t
+fun params_of t = Term.strip_qnt_vars \<^const_name>\<open>Pure.all\<close> t
fun varify ctxt thm =
let
--- a/src/HOL/Tools/SMT/smt_replay_methods.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/smt_replay_methods.ML Fri Jan 04 23:22:53 2019 +0100
@@ -82,10 +82,10 @@
fun trace_goal ctxt rule thms t =
trace ctxt (fn () => Pretty.string_of (pretty_goal ctxt "Goal" rule thms t))
-fun as_prop (t as Const (@{const_name Trueprop}, _) $ _) = t
+fun as_prop (t as Const (\<^const_name>\<open>Trueprop\<close>, _) $ _) = t
| as_prop t = HOLogic.mk_Trueprop t
-fun dest_prop (Const (@{const_name Trueprop}, _) $ t) = t
+fun dest_prop (Const (\<^const_name>\<open>Trueprop\<close>, _) $ t) = t
| dest_prop t = t
fun dest_thm thm = dest_prop (Thm.concl_of thm)
@@ -215,7 +215,7 @@
abstract_bin abstract_prop HOLogic.mk_conj t t1 t2
| abstract_prop (t as @{const HOL.implies} $ t1 $ t2) =
abstract_bin abstract_prop HOLogic.mk_imp t t1 t2
- | abstract_prop (t as @{term "HOL.eq :: bool => _"} $ t1 $ t2) =
+ | abstract_prop (t as \<^term>\<open>HOL.eq :: bool => _\<close> $ t1 $ t2) =
abstract_bin abstract_prop HOLogic.mk_eq t t1 t2
| abstract_prop t = abstract_not abstract_prop t
@@ -225,28 +225,28 @@
abstract_sub t (abstract_term t)
| abs (t as (c as Const _) $ Abs (s, T, t')) =
abstract_sub t (abs t' #>> (fn u' => c $ Abs (s, T, u')))
- | abs (t as (c as Const (@{const_name If}, _)) $ t1 $ t2 $ t3) =
+ | abs (t as (c as Const (\<^const_name>\<open>If\<close>, _)) $ t1 $ t2 $ t3) =
abstract_ter abs (fn (t1, t2, t3) => c $ t1 $ t2 $ t3) t t1 t2 t3
| abs (t as @{const HOL.Not} $ t1) = abstract_sub t (abs t1 #>> HOLogic.mk_not)
| abs (t as @{const HOL.disj} $ t1 $ t2) =
abstract_sub t (abs t1 ##>> abs t2 #>> HOLogic.mk_disj)
- | abs (t as (c as Const (@{const_name uminus_class.uminus}, _)) $ t1) =
+ | abs (t as (c as Const (\<^const_name>\<open>uminus_class.uminus\<close>, _)) $ t1) =
abstract_sub t (abs t1 #>> (fn u => c $ u))
- | abs (t as (c as Const (@{const_name plus_class.plus}, _)) $ t1 $ t2) =
+ | abs (t as (c as Const (\<^const_name>\<open>plus_class.plus\<close>, _)) $ t1 $ t2) =
abstract_sub t (abs t1 ##>> abs t2 #>> (fn (u1, u2) => c $ u1 $ u2))
- | abs (t as (c as Const (@{const_name minus_class.minus}, _)) $ t1 $ t2) =
+ | abs (t as (c as Const (\<^const_name>\<open>minus_class.minus\<close>, _)) $ t1 $ t2) =
abstract_sub t (abs t1 ##>> abs t2 #>> (fn (u1, u2) => c $ u1 $ u2))
- | abs (t as (c as Const (@{const_name times_class.times}, _)) $ t1 $ t2) =
+ | abs (t as (c as Const (\<^const_name>\<open>times_class.times\<close>, _)) $ t1 $ t2) =
abstract_sub t (abs t1 ##>> abs t2 #>> (fn (u1, u2) => c $ u1 $ u2))
- | abs (t as (c as Const (@{const_name z3div}, _)) $ t1 $ t2) =
+ | abs (t as (c as Const (\<^const_name>\<open>z3div\<close>, _)) $ t1 $ t2) =
abstract_sub t (abs t1 ##>> abs t2 #>> (fn (u1, u2) => c $ u1 $ u2))
- | abs (t as (c as Const (@{const_name z3mod}, _)) $ t1 $ t2) =
+ | abs (t as (c as Const (\<^const_name>\<open>z3mod\<close>, _)) $ t1 $ t2) =
abstract_sub t (abs t1 ##>> abs t2 #>> (fn (u1, u2) => c $ u1 $ u2))
- | abs (t as (c as Const (@{const_name HOL.eq}, _)) $ t1 $ t2) =
+ | abs (t as (c as Const (\<^const_name>\<open>HOL.eq\<close>, _)) $ t1 $ t2) =
abstract_sub t (abs t1 ##>> abs t2 #>> (fn (u1, u2) => c $ u1 $ u2))
- | abs (t as (c as Const (@{const_name ord_class.less}, _)) $ t1 $ t2) =
+ | abs (t as (c as Const (\<^const_name>\<open>ord_class.less\<close>, _)) $ t1 $ t2) =
abstract_sub t (abs t1 ##>> abs t2 #>> (fn (u1, u2) => c $ u1 $ u2))
- | abs (t as (c as Const (@{const_name ord_class.less_eq}, _)) $ t1 $ t2) =
+ | abs (t as (c as Const (\<^const_name>\<open>ord_class.less_eq\<close>, _)) $ t1 $ t2) =
abstract_sub t (abs t1 ##>> abs t2 #>> (fn (u1, u2) => c $ u1 $ u2))
| abs t = abstract_sub t (fn cx =>
if can HOLogic.dest_number t then (t, cx)
@@ -262,13 +262,13 @@
| abstract_unit (t as (@{const HOL.disj} $ t1 $ t2)) =
abstract_sub t (abstract_unit t1 ##>> abstract_unit t2 #>>
HOLogic.mk_disj)
- | abstract_unit (t as (Const(@{const_name HOL.eq}, _) $ t1 $ t2)) =
- if fastype_of t1 = @{typ bool} then
+ | abstract_unit (t as (Const(\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2)) =
+ if fastype_of t1 = \<^typ>\<open>bool\<close> then
abstract_sub t (abstract_unit t1 ##>> abstract_unit t2 #>>
HOLogic.mk_eq)
else abstract_lit t
- | abstract_unit (t as (@{const HOL.Not} $ Const(@{const_name HOL.eq}, _) $ t1 $ t2)) =
- if fastype_of t1 = @{typ bool} then
+ | abstract_unit (t as (@{const HOL.Not} $ Const(\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2)) =
+ if fastype_of t1 = \<^typ>\<open>bool\<close> then
abstract_sub t (abstract_unit t1 ##>> abstract_unit t2 #>>
HOLogic.mk_eq #>> HOLogic.mk_not)
else abstract_lit t
--- a/src/HOL/Tools/SMT/smt_solver.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/smt_solver.ML Fri Jan 04 23:22:53 2019 +0100
@@ -96,8 +96,8 @@
val output = drop_suffix (equal "") res
val _ = SMT_Config.trace_msg ctxt (pretty "Result:") output
- val _ = SMT_Config.trace_msg ctxt (pretty "Time (ms):") [@{make_string} (Time.toMilliseconds elapsed)]
- val _ = SMT_Config.statistics_msg ctxt (pretty "Time (ms):") [@{make_string} (Time.toMilliseconds elapsed)]
+ val _ = SMT_Config.trace_msg ctxt (pretty "Time (ms):") [\<^make_string> (Time.toMilliseconds elapsed)]
+ val _ = SMT_Config.statistics_msg ctxt (pretty "Time (ms):") [\<^make_string> (Time.toMilliseconds elapsed)]
val _ = member (op =) normal_return_codes return_code orelse
raise SMT_Failure.SMT (SMT_Failure.Abnormal_Termination return_code)
@@ -213,7 +213,7 @@
\declare [[smt_oracle]] to allow oracle")
| (result, _) => raise SMT_Failure.SMT (SMT_Failure.Counterexample (result = Sat)))
- val cfalse = Thm.cterm_of @{context} @{prop False}
+ val cfalse = Thm.cterm_of \<^context> \<^prop>\<open>False\<close>
in
fun add_solver ({name, class, avail, command, options, smt_options, default_max_relevant, outcome,
@@ -259,7 +259,7 @@
val ctxt = ctxt0 |> Config.put SMT_Config.timeout (Time.toReal time_limit)
val ({context = ctxt, prems, concl, ...}, _) = Subgoal.focus ctxt i NONE goal
- fun negate ct = Thm.dest_comb ct ||> Thm.apply @{cterm Not} |-> Thm.apply
+ fun negate ct = Thm.dest_comb ct ||> Thm.apply \<^cterm>\<open>Not\<close> |-> Thm.apply
val cprop =
(case try negate (Thm.rhs_of (SMT_Normalize.atomize_conv ctxt concl)) of
SOME ct => ct
--- a/src/HOL/Tools/SMT/smt_systems.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/smt_systems.ML Fri Jan 04 23:22:53 2019 +0100
@@ -65,7 +65,7 @@
(* CVC4 *)
-val cvc4_extensions = Attrib.setup_config_bool @{binding cvc4_extensions} (K false)
+val cvc4_extensions = Attrib.setup_config_bool \<^binding>\<open>cvc4_extensions\<close> (K false)
local
fun cvc4_options ctxt = [
@@ -136,7 +136,7 @@
(* Z3 *)
-val z3_extensions = Attrib.setup_config_bool @{binding z3_extensions} (K false)
+val z3_extensions = Attrib.setup_config_bool \<^binding>\<open>z3_extensions\<close> (K false)
local
fun z3_options ctxt =
--- a/src/HOL/Tools/SMT/smt_util.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/smt_util.ML Fri Jan 04 23:22:53 2019 +0100
@@ -141,13 +141,13 @@
fun under_quant f t =
(case t of
- Const (@{const_name All}, _) $ Abs (_, _, u) => under_quant f u
- | Const (@{const_name Ex}, _) $ Abs (_, _, u) => under_quant f u
+ Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, _, u) => under_quant f u
+ | Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (_, _, u) => under_quant f u
| _ => f t)
val is_number =
let
- fun is_num env (Const (@{const_name Let}, _) $ t $ Abs (_, _, u)) = is_num (t :: env) u
+ fun is_num env (Const (\<^const_name>\<open>Let\<close>, _) $ t $ Abs (_, _, u)) = is_num (t :: env) u
| is_num env (Bound i) = i < length env andalso is_num env (nth env i)
| is_num _ t = can HOLogic.dest_number t
in is_num [] end
@@ -155,18 +155,18 @@
(* symbolic lists *)
-fun symb_listT T = Type (@{type_name symb_list}, [T])
+fun symb_listT T = Type (\<^type_name>\<open>symb_list\<close>, [T])
-fun symb_nil_const T = Const (@{const_name Symb_Nil}, symb_listT T)
+fun symb_nil_const T = Const (\<^const_name>\<open>Symb_Nil\<close>, symb_listT T)
fun symb_cons_const T =
- let val listT = symb_listT T in Const (@{const_name Symb_Cons}, T --> listT --> listT) end
+ let val listT = symb_listT T in Const (\<^const_name>\<open>Symb_Cons\<close>, T --> listT --> listT) end
fun mk_symb_list T ts =
fold_rev (fn t => fn u => symb_cons_const T $ t $ u) ts (symb_nil_const T)
-fun dest_symb_list (Const (@{const_name Symb_Nil}, _)) = []
- | dest_symb_list (Const (@{const_name Symb_Cons}, _) $ t $ u) = t :: dest_symb_list u
+fun dest_symb_list (Const (\<^const_name>\<open>Symb_Nil\<close>, _)) = []
+ | dest_symb_list (Const (\<^const_name>\<open>Symb_Cons\<close>, _) $ t $ u) = t :: dest_symb_list u
(* patterns and instantiations *)
@@ -201,14 +201,14 @@
val dest_all_cbinders = repeat_yield (try o dest_cbinder)
-val mk_cprop = Thm.apply (Thm.cterm_of @{context} @{const Trueprop})
+val mk_cprop = Thm.apply (Thm.cterm_of \<^context> @{const Trueprop})
fun dest_cprop ct =
(case Thm.term_of ct of
@{const Trueprop} $ _ => Thm.dest_arg ct
| _ => raise CTERM ("not a property", [ct]))
-val equals = mk_const_pat @{theory} @{const_name Pure.eq} destT1
+val equals = mk_const_pat \<^theory> \<^const_name>\<open>Pure.eq\<close> destT1
fun mk_cequals ct cu = Thm.mk_binop (instT' ct equals) ct cu
val dest_prop = (fn @{const Trueprop} $ t => t | t => t)
@@ -231,9 +231,9 @@
let
fun quant_conv inside ctxt cvs ct =
(case Thm.term_of ct of
- Const (@{const_name All}, _) $ Abs _ =>
+ Const (\<^const_name>\<open>All\<close>, _) $ Abs _ =>
Conv.binder_conv (under_conv cvs) ctxt
- | Const (@{const_name Ex}, _) $ Abs _ =>
+ | Const (\<^const_name>\<open>Ex\<close>, _) $ Abs _ =>
Conv.binder_conv (under_conv cvs) ctxt
| _ => if inside then cv (ctxt, cvs) else Conv.all_conv) ct
and under_conv cvs (cv, ctxt) = quant_conv true ctxt (cv :: cvs)
--- a/src/HOL/Tools/SMT/smtlib_interface.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/smtlib_interface.ML Fri Jan 04 23:22:53 2019 +0100
@@ -41,10 +41,10 @@
val setup_builtins =
SMT_Builtin.add_builtin_typ hosmtlibC
- (@{typ "'a => 'b"}, fn Type (@{type_name fun}, Ts) => SOME ("->", Ts), K (K NONE)) #>
+ (\<^typ>\<open>'a => 'b\<close>, fn Type (\<^type_name>\<open>fun\<close>, Ts) => SOME ("->", Ts), K (K NONE)) #>
fold (SMT_Builtin.add_builtin_typ smtlibC) [
- (@{typ bool}, K (SOME ("Bool", [])), K (K NONE)),
- (@{typ int}, K (SOME ("Int", [])), int_num)] #>
+ (\<^typ>\<open>bool\<close>, K (SOME ("Bool", [])), K (K NONE)),
+ (\<^typ>\<open>int\<close>, K (SOME ("Int", [])), int_num)] #>
fold (SMT_Builtin.add_builtin_fun' smtlibC) [
(@{const True}, "true"),
(@{const False}, "false"),
--- a/src/HOL/Tools/SMT/smtlib_proof.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/smtlib_proof.ML Fri Jan 04 23:22:53 2019 +0100
@@ -105,8 +105,8 @@
(* core type and term parser *)
-fun core_type_parser (SMTLIB.Sym "Bool", []) = SOME @{typ HOL.bool}
- | core_type_parser (SMTLIB.Sym "Int", []) = SOME @{typ Int.int}
+fun core_type_parser (SMTLIB.Sym "Bool", []) = SOME \<^typ>\<open>HOL.bool\<close>
+ | core_type_parser (SMTLIB.Sym "Int", []) = SOME \<^typ>\<open>Int.int\<close>
| core_type_parser _ = NONE
fun mk_unary n t =
@@ -135,10 +135,10 @@
if T1 <> Term.dummyT then T1
else if T2 <> Term.dummyT then T2
else TVar (("?a", serial ()), S)
- in mk_binary' n T @{typ HOL.bool} t1 t2 end
+ in mk_binary' n T \<^typ>\<open>HOL.bool\<close> t1 t2 end
-fun mk_less t1 t2 = mk_binary_pred @{const_name ord_class.less} @{sort linorder} t1 t2
-fun mk_less_eq t1 t2 = mk_binary_pred @{const_name ord_class.less_eq} @{sort linorder} t1 t2
+fun mk_less t1 t2 = mk_binary_pred \<^const_name>\<open>ord_class.less\<close> \<^sort>\<open>linorder\<close> t1 t2
+fun mk_less_eq t1 t2 = mk_binary_pred \<^const_name>\<open>ord_class.less_eq\<close> \<^sort>\<open>linorder\<close> t1 t2
fun core_term_parser (SMTLIB.Sym "true", _) = SOME @{const HOL.True}
| core_term_parser (SMTLIB.Sym "false", _) = SOME @{const HOL.False}
@@ -152,19 +152,19 @@
| core_term_parser (SMTLIB.Sym "ite", [t1, t2, t3]) =
let
val T = fastype_of t2
- val c = Const (@{const_name HOL.If}, [@{typ HOL.bool}, T, T] ---> T)
+ val c = Const (\<^const_name>\<open>HOL.If\<close>, [\<^typ>\<open>HOL.bool\<close>, T, T] ---> T)
in SOME (c $ t1 $ t2 $ t3) end
- | core_term_parser (SMTLIB.Num i, []) = SOME (HOLogic.mk_number @{typ Int.int} i)
- | core_term_parser (SMTLIB.Sym "-", [t]) = SOME (mk_unary @{const_name uminus_class.uminus} t)
- | core_term_parser (SMTLIB.Sym "~", [t]) = SOME (mk_unary @{const_name uminus_class.uminus} t)
+ | core_term_parser (SMTLIB.Num i, []) = SOME (HOLogic.mk_number \<^typ>\<open>Int.int\<close> i)
+ | core_term_parser (SMTLIB.Sym "-", [t]) = SOME (mk_unary \<^const_name>\<open>uminus_class.uminus\<close> t)
+ | core_term_parser (SMTLIB.Sym "~", [t]) = SOME (mk_unary \<^const_name>\<open>uminus_class.uminus\<close> t)
| core_term_parser (SMTLIB.Sym "+", t :: ts) =
- SOME (mk_lassoc' @{const_name plus_class.plus} t ts)
+ SOME (mk_lassoc' \<^const_name>\<open>plus_class.plus\<close> t ts)
| core_term_parser (SMTLIB.Sym "-", t :: ts) =
- SOME (mk_lassoc' @{const_name minus_class.minus} t ts)
+ SOME (mk_lassoc' \<^const_name>\<open>minus_class.minus\<close> t ts)
| core_term_parser (SMTLIB.Sym "*", t :: ts) =
- SOME (mk_lassoc' @{const_name times_class.times} t ts)
- | core_term_parser (SMTLIB.Sym "div", [t1, t2]) = SOME (mk_binary @{const_name z3div} t1 t2)
- | core_term_parser (SMTLIB.Sym "mod", [t1, t2]) = SOME (mk_binary @{const_name z3mod} t1 t2)
+ SOME (mk_lassoc' \<^const_name>\<open>times_class.times\<close> t ts)
+ | core_term_parser (SMTLIB.Sym "div", [t1, t2]) = SOME (mk_binary \<^const_name>\<open>z3div\<close> t1 t2)
+ | core_term_parser (SMTLIB.Sym "mod", [t1, t2]) = SOME (mk_binary \<^const_name>\<open>z3mod\<close> t1 t2)
| core_term_parser (SMTLIB.Sym "<", [t1, t2]) = SOME (mk_less t1 t2)
| core_term_parser (SMTLIB.Sym ">", [t1, t2]) = SOME (mk_less t2 t1)
| core_term_parser (SMTLIB.Sym "<=", [t1, t2]) = SOME (mk_less_eq t1 t2)
--- a/src/HOL/Tools/SMT/verit_proof.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/verit_proof.ML Fri Jan 04 23:22:53 2019 +0100
@@ -198,7 +198,7 @@
let
fun rotate_pair (a, (b, c)) = ((a, b), c)
fun get_id (SMTLIB.S [SMTLIB.Sym "set", SMTLIB.Sym id, SMTLIB.S l]) = (id, l)
- | get_id t = raise Fail ("unrecognized VeriT proof " ^ @{make_string} t)
+ | get_id t = raise Fail ("unrecognized VeriT proof " ^ \<^make_string> t)
fun parse_source (SMTLIB.Key "clauses" :: SMTLIB.S source ::l) =
(SOME (map (fn (SMTLIB.Sym id) => id) source), l)
| parse_source l = (NONE, l)
@@ -286,8 +286,8 @@
val new_global_bounds = global_bound_vars_by_rule rule args
val concl = SMTLIB_Isar.unskolemize_names ctxt concl
- val _ = (SMT_Config.veriT_msg ctxt) (fn () => @{print} ("id =", id, "concl =", concl))
- val _ = (SMT_Config.veriT_msg ctxt) (fn () => @{print} ("id =", id, "cx' =", cx',
+ val _ = (SMT_Config.veriT_msg ctxt) (fn () => \<^print> ("id =", id, "concl =", concl))
+ val _ = (SMT_Config.veriT_msg ctxt) (fn () => \<^print> ("id =", id, "cx' =", cx',
"bound_vars =", bound_vars))
val bound_vars = filter_out (member ((op =)) new_global_bounds) bound_vars
val bound_tvars =
@@ -377,7 +377,7 @@
proof_ctxt = proof_ctxt, concl = concl, bounds = bounds, subproof = (_, _, subproof)}) =
let
fun mk_prop_of_term concl =
- concl |> fastype_of concl = @{typ bool} ? curry (op $) @{term Trueprop}
+ concl |> fastype_of concl = \<^typ>\<open>bool\<close> ? curry (op $) \<^term>\<open>Trueprop\<close>
fun remove_assumption_id assumption_id prems =
filter_out (curry (op =) assumption_id) prems
fun inline_assumption assumption assumption_id
@@ -423,7 +423,7 @@
fun parse_replay typs funs lines ctxt =
let
val (u, env) = import_proof_and_post_process typs funs lines ctxt
- val _ = (SMT_Config.veriT_msg ctxt) (fn () => @{print} u)
+ val _ = (SMT_Config.veriT_msg ctxt) (fn () => \<^print> u)
in
(u, ctxt_of env)
end
--- a/src/HOL/Tools/SMT/verit_replay.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/verit_replay.ML Fri Jan 04 23:22:53 2019 +0100
@@ -15,12 +15,12 @@
fun under_fixes f unchanged_prems (prems, nthms) names args (concl, ctxt) =
let
val thms1 = unchanged_prems @ map (SMT_Replay.varify ctxt) prems
- val _ = SMT_Config.veriT_msg ctxt (fn () => @{print} ("names =", names))
+ val _ = SMT_Config.veriT_msg ctxt (fn () => \<^print> ("names =", names))
val thms2 = map snd nthms
- val _ = SMT_Config.veriT_msg ctxt (fn () => @{print} ("prems=", prems))
- val _ = SMT_Config.veriT_msg ctxt (fn () => @{print} ("nthms=", nthms))
- val _ = SMT_Config.veriT_msg ctxt (fn () => @{print} ("thms1=", thms1))
- val _ = SMT_Config.veriT_msg ctxt (fn () => @{print} ("thms2=", thms2))
+ val _ = SMT_Config.veriT_msg ctxt (fn () => \<^print> ("prems=", prems))
+ val _ = SMT_Config.veriT_msg ctxt (fn () => \<^print> ("nthms=", nthms))
+ val _ = SMT_Config.veriT_msg ctxt (fn () => \<^print> ("thms1=", thms1))
+ val _ = SMT_Config.veriT_msg ctxt (fn () => \<^print> ("thms2=", thms2))
in (f ctxt (thms1 @ thms2) args concl) end
@@ -30,7 +30,7 @@
concl_transformation global_transformation args
(VeriT_Proof.VeriT_Replay_Node {id, rule, concl, bounds, ...}) =
let
- val _ = SMT_Config.veriT_msg ctxt (fn () => @{print} id)
+ val _ = SMT_Config.veriT_msg ctxt (fn () => \<^print> id)
val rewrite = let val thy = Proof_Context.theory_of (empty_simpset ctxt) in
Raw_Simplifier.rewrite_term thy rewrite_rules []
#> not (null ll_defs) ? SMTLIB_Isar.unlift_term ll_defs
--- a/src/HOL/Tools/SMT/verit_replay_methods.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/verit_replay_methods.ML Fri Jan 04 23:22:53 2019 +0100
@@ -200,7 +200,7 @@
| string_of_verit_rule Normalized_Input = VeriT_Proof.veriT_normalized_input_rule
| string_of_verit_rule Local_Input = VeriT_Proof.veriT_normalized_input_rule
| string_of_verit_rule Subproof = "subproof"
- | string_of_verit_rule r = "Unsupported rule: " ^ @{make_string} r
+ | string_of_verit_rule r = "Unsupported rule: " ^ \<^make_string> r
(*** Methods to Replay Normal steps ***)
(* sko_forall requires the assumptions to be able to SMT_Replay_Methods.prove the equivalence in case of double
@@ -247,9 +247,9 @@
| SOME thm => thm))
local
- fun equiv_pos_neg_term ctxt thm (@{term Trueprop} $
- (@{term HOL.disj} $ (_) $
- ((@{term HOL.disj} $ a $ b)))) =
+ fun equiv_pos_neg_term ctxt thm (\<^term>\<open>Trueprop\<close> $
+ (\<^term>\<open>HOL.disj\<close> $ (_) $
+ ((\<^term>\<open>HOL.disj\<close> $ a $ b)))) =
Drule.infer_instantiate' ctxt (map (SOME o Thm.cterm_of ctxt) [a, b]) thm
fun prove_equiv_pos_neg thm ctxt _ t =
@@ -341,7 +341,7 @@
let
fun is_rewrite_rule thm =
(case Thm.prop_of thm of
- @{term Trueprop} $ (Const(@{const_name HOL.eq}, _) $ Free(_, _) $ _) => true
+ \<^term>\<open>Trueprop\<close> $ (Const(\<^const_name>\<open>HOL.eq\<close>, _) $ Free(_, _) $ _) => true
| _ => false)
in
thms
@@ -399,8 +399,8 @@
@{lemma "P = Q \<Longrightarrow> Q \<Longrightarrow> P" by blast}
fun trans _ [thm1, thm2] _ =
(case (Thm.full_prop_of thm1, Thm.full_prop_of thm2) of
- (@{term Trueprop} $ (Const(@{const_name HOL.eq}, _) $ _ $ t2),
- @{term Trueprop} $ (Const(@{const_name HOL.eq}, _) $ t3 $ _)) =>
+ (\<^term>\<open>Trueprop\<close> $ (Const(\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ t2),
+ \<^term>\<open>Trueprop\<close> $ (Const(\<^const_name>\<open>HOL.eq\<close>, _) $ t3 $ _)) =>
if t2 = t3 then thm1 RSN (1, thm2 RSN (2, @{thm trans}))
else thm1 RSN (1, (thm2 RS sym) RSN (2, @{thm trans}))
| _ => trans_bool_thm OF [thm1, thm2])
@@ -518,8 +518,8 @@
local
- fun implies_pos_neg_term ctxt thm (@{term Trueprop} $
- (@{term HOL.disj} $ (@{term HOL.implies} $ a $ b) $ _)) =
+ fun implies_pos_neg_term ctxt thm (\<^term>\<open>Trueprop\<close> $
+ (\<^term>\<open>HOL.disj\<close> $ (\<^term>\<open>HOL.implies\<close> $ a $ b) $ _)) =
Drule.infer_instantiate' ctxt (map (SOME o Thm.cterm_of ctxt) [a, b]) thm
fun prove_implies_pos_neg thm ctxt _ t =
--- a/src/HOL/Tools/SMT/z3_interface.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/z3_interface.ML Fri Jan 04 23:22:53 2019 +0100
@@ -106,52 +106,52 @@
(** basic and additional constructors **)
-fun mk_builtin_typ _ (Sym ("Bool", _)) = SOME @{typ bool}
- | mk_builtin_typ _ (Sym ("Int", _)) = SOME @{typ int}
- | mk_builtin_typ _ (Sym ("bool", _)) = SOME @{typ bool} (*FIXME: legacy*)
- | mk_builtin_typ _ (Sym ("int", _)) = SOME @{typ int} (*FIXME: legacy*)
+fun mk_builtin_typ _ (Sym ("Bool", _)) = SOME \<^typ>\<open>bool\<close>
+ | mk_builtin_typ _ (Sym ("Int", _)) = SOME \<^typ>\<open>int\<close>
+ | mk_builtin_typ _ (Sym ("bool", _)) = SOME \<^typ>\<open>bool\<close> (*FIXME: legacy*)
+ | mk_builtin_typ _ (Sym ("int", _)) = SOME \<^typ>\<open>int\<close> (*FIXME: legacy*)
| mk_builtin_typ ctxt sym = chained_mk_builtin_typ (get_mk_builtins ctxt) sym
-fun mk_builtin_num _ i @{typ int} = SOME (Numeral.mk_cnumber @{ctyp int} i)
+fun mk_builtin_num _ i \<^typ>\<open>int\<close> = SOME (Numeral.mk_cnumber \<^ctyp>\<open>int\<close> i)
| mk_builtin_num ctxt i T =
chained_mk_builtin_num ctxt (get_mk_builtins ctxt) i T
-val mk_true = Thm.cterm_of @{context} (@{const Not} $ @{const False})
-val mk_false = Thm.cterm_of @{context} @{const False}
-val mk_not = Thm.apply (Thm.cterm_of @{context} @{const Not})
-val mk_implies = Thm.mk_binop (Thm.cterm_of @{context} @{const HOL.implies})
-val mk_iff = Thm.mk_binop (Thm.cterm_of @{context} @{const HOL.eq (bool)})
-val conj = Thm.cterm_of @{context} @{const HOL.conj}
-val disj = Thm.cterm_of @{context} @{const HOL.disj}
+val mk_true = Thm.cterm_of \<^context> (@{const Not} $ @{const False})
+val mk_false = Thm.cterm_of \<^context> @{const False}
+val mk_not = Thm.apply (Thm.cterm_of \<^context> @{const Not})
+val mk_implies = Thm.mk_binop (Thm.cterm_of \<^context> @{const HOL.implies})
+val mk_iff = Thm.mk_binop (Thm.cterm_of \<^context> @{const HOL.eq (bool)})
+val conj = Thm.cterm_of \<^context> @{const HOL.conj}
+val disj = Thm.cterm_of \<^context> @{const HOL.disj}
fun mk_nary _ cu [] = cu
| mk_nary ct _ cts = uncurry (fold_rev (Thm.mk_binop ct)) (split_last cts)
-val eq = SMT_Util.mk_const_pat @{theory} @{const_name HOL.eq} SMT_Util.destT1
+val eq = SMT_Util.mk_const_pat \<^theory> \<^const_name>\<open>HOL.eq\<close> SMT_Util.destT1
fun mk_eq ct cu = Thm.mk_binop (SMT_Util.instT' ct eq) ct cu
val if_term =
- SMT_Util.mk_const_pat @{theory} @{const_name If} (SMT_Util.destT1 o SMT_Util.destT2)
+ SMT_Util.mk_const_pat \<^theory> \<^const_name>\<open>If\<close> (SMT_Util.destT1 o SMT_Util.destT2)
fun mk_if cc ct = Thm.mk_binop (Thm.apply (SMT_Util.instT' ct if_term) cc) ct
-val access = SMT_Util.mk_const_pat @{theory} @{const_name fun_app} SMT_Util.destT1
+val access = SMT_Util.mk_const_pat \<^theory> \<^const_name>\<open>fun_app\<close> SMT_Util.destT1
fun mk_access array = Thm.apply (SMT_Util.instT' array access) array
val update =
- SMT_Util.mk_const_pat @{theory} @{const_name fun_upd} (Thm.dest_ctyp o SMT_Util.destT1)
+ SMT_Util.mk_const_pat \<^theory> \<^const_name>\<open>fun_upd\<close> (Thm.dest_ctyp o SMT_Util.destT1)
fun mk_update array index value =
let val cTs = Thm.dest_ctyp (Thm.ctyp_of_cterm array)
in Thm.apply (Thm.mk_binop (SMT_Util.instTs cTs update) array index) value end
-val mk_uminus = Thm.apply (Thm.cterm_of @{context} @{const uminus (int)})
-val add = Thm.cterm_of @{context} @{const plus (int)}
-val int0 = Numeral.mk_cnumber @{ctyp int} 0
-val mk_sub = Thm.mk_binop (Thm.cterm_of @{context} @{const minus (int)})
-val mk_mul = Thm.mk_binop (Thm.cterm_of @{context} @{const times (int)})
-val mk_div = Thm.mk_binop (Thm.cterm_of @{context} @{const z3div})
-val mk_mod = Thm.mk_binop (Thm.cterm_of @{context} @{const z3mod})
-val mk_lt = Thm.mk_binop (Thm.cterm_of @{context} @{const less (int)})
-val mk_le = Thm.mk_binop (Thm.cterm_of @{context} @{const less_eq (int)})
+val mk_uminus = Thm.apply (Thm.cterm_of \<^context> @{const uminus (int)})
+val add = Thm.cterm_of \<^context> @{const plus (int)}
+val int0 = Numeral.mk_cnumber \<^ctyp>\<open>int\<close> 0
+val mk_sub = Thm.mk_binop (Thm.cterm_of \<^context> @{const minus (int)})
+val mk_mul = Thm.mk_binop (Thm.cterm_of \<^context> @{const times (int)})
+val mk_div = Thm.mk_binop (Thm.cterm_of \<^context> @{const z3div})
+val mk_mod = Thm.mk_binop (Thm.cterm_of \<^context> @{const z3mod})
+val mk_lt = Thm.mk_binop (Thm.cterm_of \<^context> @{const less (int)})
+val mk_le = Thm.mk_binop (Thm.cterm_of \<^context> @{const less_eq (int)})
fun mk_builtin_fun ctxt sym cts =
(case (sym, cts) of
@@ -171,16 +171,16 @@
| (Sym ("store", _), [ca, ck, cv]) => SOME (mk_update ca ck cv)
| _ =>
(case (sym, try (Thm.typ_of_cterm o hd) cts, cts) of
- (Sym ("+", _), SOME @{typ int}, _) => SOME (mk_nary add int0 cts)
- | (Sym ("-", _), SOME @{typ int}, [ct]) => SOME (mk_uminus ct)
- | (Sym ("-", _), SOME @{typ int}, [ct, cu]) => SOME (mk_sub ct cu)
- | (Sym ("*", _), SOME @{typ int}, [ct, cu]) => SOME (mk_mul ct cu)
- | (Sym ("div", _), SOME @{typ int}, [ct, cu]) => SOME (mk_div ct cu)
- | (Sym ("mod", _), SOME @{typ int}, [ct, cu]) => SOME (mk_mod ct cu)
- | (Sym ("<", _), SOME @{typ int}, [ct, cu]) => SOME (mk_lt ct cu)
- | (Sym ("<=", _), SOME @{typ int}, [ct, cu]) => SOME (mk_le ct cu)
- | (Sym (">", _), SOME @{typ int}, [ct, cu]) => SOME (mk_lt cu ct)
- | (Sym (">=", _), SOME @{typ int}, [ct, cu]) => SOME (mk_le cu ct)
+ (Sym ("+", _), SOME \<^typ>\<open>int\<close>, _) => SOME (mk_nary add int0 cts)
+ | (Sym ("-", _), SOME \<^typ>\<open>int\<close>, [ct]) => SOME (mk_uminus ct)
+ | (Sym ("-", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_sub ct cu)
+ | (Sym ("*", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_mul ct cu)
+ | (Sym ("div", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_div ct cu)
+ | (Sym ("mod", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_mod ct cu)
+ | (Sym ("<", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_lt ct cu)
+ | (Sym ("<=", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_le ct cu)
+ | (Sym (">", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_lt cu ct)
+ | (Sym (">=", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_le cu ct)
| _ => chained_mk_builtin_fun ctxt (get_mk_builtins ctxt) sym cts))
--- a/src/HOL/Tools/SMT/z3_isar.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/z3_isar.ML Fri Jan 04 23:22:53 2019 +0100
@@ -62,7 +62,7 @@
end
end
-fun dest_alls (Const (@{const_name Pure.all}, _) $ Abs (abs as (_, T, _))) =
+fun dest_alls (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (abs as (_, T, _))) =
let val (s', t') = Term.dest_abs abs in
dest_alls t' |>> cons (s', T)
end
--- a/src/HOL/Tools/SMT/z3_proof.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/z3_proof.ML Fri Jan 04 23:22:53 2019 +0100
@@ -223,17 +223,17 @@
"the bound " ^ quote bound ^ " is undeclared; this indicates a bug in Z3"))
val t' = singleton (Variable.polymorphic ctxt) t
- val patTs = map snd (Term.strip_qnt_vars @{const_name Pure.all} t')
+ val patTs = map snd (Term.strip_qnt_vars \<^const_name>\<open>Pure.all\<close> t')
val objTs = map objT_of bounds
val subst = subst_of (fold match (patTs ~~ objTs) Vartab.empty)
in Same.commit (Term_Subst.map_types_same (substTs_same subst)) t' end
-fun eq_quant (@{const_name HOL.All}, _) (@{const_name HOL.All}, _) = true
- | eq_quant (@{const_name HOL.Ex}, _) (@{const_name HOL.Ex}, _) = true
+fun eq_quant (\<^const_name>\<open>HOL.All\<close>, _) (\<^const_name>\<open>HOL.All\<close>, _) = true
+ | eq_quant (\<^const_name>\<open>HOL.Ex\<close>, _) (\<^const_name>\<open>HOL.Ex\<close>, _) = true
| eq_quant _ _ = false
-fun opp_quant (@{const_name HOL.All}, _) (@{const_name HOL.Ex}, _) = true
- | opp_quant (@{const_name HOL.Ex}, _) (@{const_name HOL.All}, _) = true
+fun opp_quant (\<^const_name>\<open>HOL.All\<close>, _) (\<^const_name>\<open>HOL.Ex\<close>, _) = true
+ | opp_quant (\<^const_name>\<open>HOL.Ex\<close>, _) (\<^const_name>\<open>HOL.All\<close>, _) = true
| opp_quant _ _ = false
fun with_quant pred i (Const q1 $ Abs (_, T1, t1), Const q2 $ Abs (_, T2, t2)) =
@@ -243,7 +243,7 @@
else NONE
| with_quant _ _ _ = NONE
-fun dest_quant_pair i (@{term HOL.Not} $ t1, t2) =
+fun dest_quant_pair i (\<^term>\<open>HOL.Not\<close> $ t1, t2) =
Option.map (apfst HOLogic.mk_not) (with_quant opp_quant i (t1, t2))
| dest_quant_pair i (t1, t2) = with_quant eq_quant i (t1, t2)
@@ -261,7 +261,7 @@
SOME (tyenv, _) => subst_of tyenv
| NONE => strip_match ctxt pat (i + 1) (dest_quant i obj))
-fun dest_all i (Const (@{const_name Pure.all}, _) $ (a as Abs (_, T, _))) =
+fun dest_all i (Const (\<^const_name>\<open>Pure.all\<close>, _) $ (a as Abs (_, T, _))) =
dest_all (i + 1) (Term.betapply (a, Var (("", i), T)))
| dest_all i t = (i, t)
@@ -277,7 +277,7 @@
| SOME subst =>
let
val applyT = Same.commit (substTs_same subst)
- val patTs = map snd (Term.strip_qnt_vars @{const_name Pure.all} t'')
+ val patTs = map snd (Term.strip_qnt_vars \<^const_name>\<open>Pure.all\<close> t'')
in SOME (Symtab.make (bs' ~~ map applyT patTs)) end)
end
--- a/src/HOL/Tools/SMT/z3_real.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/z3_real.ML Fri Jan 04 23:22:53 2019 +0100
@@ -7,20 +7,20 @@
structure Z3_Real: sig end =
struct
-fun real_type_parser (SMTLIB.Sym "Real", []) = SOME @{typ Real.real}
+fun real_type_parser (SMTLIB.Sym "Real", []) = SOME \<^typ>\<open>Real.real\<close>
| real_type_parser _ = NONE
-fun real_term_parser (SMTLIB.Dec (i, 0), []) = SOME (HOLogic.mk_number @{typ Real.real} i)
+fun real_term_parser (SMTLIB.Dec (i, 0), []) = SOME (HOLogic.mk_number \<^typ>\<open>Real.real\<close> i)
| real_term_parser (SMTLIB.Sym "/", [t1, t2]) =
- SOME (@{term "Rings.divide :: real => _"} $ t1 $ t2)
- | real_term_parser (SMTLIB.Sym "to_real", [t]) = SOME (@{term "Int.of_int :: int => _"} $ t)
+ SOME (\<^term>\<open>Rings.divide :: real => _\<close> $ t1 $ t2)
+ | real_term_parser (SMTLIB.Sym "to_real", [t]) = SOME (\<^term>\<open>Int.of_int :: int => _\<close> $ t)
| real_term_parser _ = NONE
fun abstract abs t =
(case t of
- (c as @{term "Rings.divide :: real => _"}) $ t1 $ t2 =>
+ (c as \<^term>\<open>Rings.divide :: real => _\<close>) $ t1 $ t2 =>
abs t1 ##>> abs t2 #>> (fn (u1, u2) => SOME (c $ u1 $ u2))
- | (c as @{term "Int.of_int :: int => _"}) $ t =>
+ | (c as \<^term>\<open>Int.of_int :: int => _\<close>) $ t =>
abs t #>> (fn u => SOME (c $ u))
| _ => pair NONE)
--- a/src/HOL/Tools/SMT/z3_replay.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/z3_replay.ML Fri Jan 04 23:22:53 2019 +0100
@@ -34,7 +34,7 @@
fun mk (n, T) n' = (n, Thm.cterm_of ctxt' (Free (n', T)))
in (ctxt', Symtab.make (map2 mk nTs ns)) end
-fun forall_elim_term ct (Const (@{const_name Pure.all}, _) $ (a as Abs _)) =
+fun forall_elim_term ct (Const (\<^const_name>\<open>Pure.all\<close>, _) $ (a as Abs _)) =
Term.betapply (a, Thm.term_of ct)
| forall_elim_term _ qt = raise TERM ("forall_elim'", [qt])
--- a/src/HOL/Tools/SMT/z3_replay_methods.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/SMT/z3_replay_methods.ML Fri Jan 04 23:22:53 2019 +0100
@@ -60,10 +60,10 @@
fun trace_goal ctxt rule thms t =
SMT_Replay_Methods.trace_goal ctxt (Z3_Proof.string_of_rule rule) thms t
-fun as_prop (t as Const (@{const_name Trueprop}, _) $ _) = t
+fun as_prop (t as Const (\<^const_name>\<open>Trueprop\<close>, _) $ _) = t
| as_prop t = HOLogic.mk_Trueprop t
-fun dest_prop (Const (@{const_name Trueprop}, _) $ t) = t
+fun dest_prop (Const (\<^const_name>\<open>Trueprop\<close>, _) $ t) = t
| dest_prop t = t
fun dest_thm thm = dest_prop (Thm.concl_of thm)
@@ -189,7 +189,7 @@
local
-fun dest_all (Const (@{const_name HOL.All}, _) $ Abs (_, T, t)) nctxt =
+fun dest_all (Const (\<^const_name>\<open>HOL.All\<close>, _) $ Abs (_, T, t)) nctxt =
let
val (n, nctxt') = Name.variant "" nctxt
val f = Free (n, T)
@@ -221,7 +221,7 @@
end
-fun abstract_eq f (Const (@{const_name HOL.eq}, _) $ t1 $ t2) =
+fun abstract_eq f (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2) =
f t1 ##>> f t2 #>> HOLogic.mk_eq
| abstract_eq _ t = SMT_Replay_Methods.abstract_term t
@@ -245,9 +245,9 @@
fun if_context_conv ctxt ct =
(case Thm.term_of ct of
- Const (@{const_name HOL.If}, _) $ _ $ _ $ _ =>
+ Const (\<^const_name>\<open>HOL.If\<close>, _) $ _ $ _ $ _ =>
ternary_conv (if_context_conv ctxt)
- | _ $ (Const (@{const_name HOL.If}, _) $ _ $ _ $ _) =>
+ | _ $ (Const (\<^const_name>\<open>HOL.If\<close>, _) $ _ $ _ $ _) =>
Conv.rewr_conv lift_ite_thm then_conv ternary_conv (if_context_conv ctxt)
| _ => Conv.sub_conv (Conv.top_sweep_conv if_context_conv) ctxt) ct
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_commands.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_commands.ML Fri Jan 04 23:22:53 2019 +0100
@@ -194,7 +194,7 @@
|> fold (AList.default (op =))
[("provers", [(case !provers of "" => default_provers_param_value mode ctxt | s => s)]),
("timeout",
- let val timeout = Options.default_int @{system_option sledgehammer_timeout} in
+ let val timeout = Options.default_int \<^system_option>\<open>sledgehammer_timeout\<close> in
[if timeout <= 0 then "none" else string_of_int timeout]
end)]
end
@@ -349,10 +349,10 @@
fun string_of_raw_param (key, values) =
key ^ (case implode_param values of "" => "" | value => " = " ^ value)
-val parse_query_bang = @{keyword "?"} || @{keyword "!"} || @{keyword "!!"}
+val parse_query_bang = \<^keyword>\<open>?\<close> || \<^keyword>\<open>!\<close> || \<^keyword>\<open>!!\<close>
val parse_key = Scan.repeat1 (Parse.embedded || parse_query_bang) >> implode_param
val parse_value = Scan.repeat1 (Parse.name || Parse.float_number || parse_query_bang)
-val parse_param = parse_key -- Scan.optional (@{keyword "="} |-- parse_value) []
+val parse_param = parse_key -- Scan.optional (\<^keyword>\<open>=\<close> |-- parse_value) []
val parse_params = Scan.optional (Args.bracks (Parse.list parse_param)) []
val parse_fact_refs = Scan.repeat1 (Scan.unless (Parse.name -- Args.colon) Parse.thm)
val parse_fact_override_chunk =
@@ -364,7 +364,7 @@
no_fact_override
val _ =
- Outer_Syntax.command @{command_keyword sledgehammer}
+ Outer_Syntax.command \<^command_keyword>\<open>sledgehammer\<close>
"search for first-order proof using automatic theorem provers"
(Scan.optional Parse.name runN -- parse_params
-- parse_fact_override -- Scan.option Parse.nat >>
@@ -372,7 +372,7 @@
Toplevel.keep_proof
(hammer_away params NONE subcommand opt_i fact_override o Toplevel.proof_of)))
val _ =
- Outer_Syntax.command @{command_keyword sledgehammer_params}
+ Outer_Syntax.command \<^command_keyword>\<open>sledgehammer_params\<close>
"set and display the default parameters for Sledgehammer"
(parse_params >> (fn params =>
Toplevel.theory (fold set_default_raw_param params #> tap (fn thy =>
@@ -390,7 +390,7 @@
run_sledgehammer (get_params mode thy []) mode NONE i no_fact_override (silence_state state)
end
-val _ = Try.tool_setup (sledgehammerN, (40, @{system_option auto_sledgehammer}, try_sledgehammer))
+val _ = Try.tool_setup (sledgehammerN, (40, \<^system_option>\<open>auto_sledgehammer\<close>, try_sledgehammer))
val _ =
Query_Operation.register {name = sledgehammerN, pri = 0}
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_fact.ML Fri Jan 04 23:22:53 2019 +0100
@@ -65,7 +65,7 @@
(* experimental feature *)
val instantiate_inducts =
- Attrib.setup_config_bool @{binding sledgehammer_instantiate_inducts} (K false)
+ Attrib.setup_config_bool \<^binding>\<open>sledgehammer_instantiate_inducts\<close> (K false)
val no_fact_override = {add = [], del = [], only = false}
@@ -85,8 +85,8 @@
fun is_rec_def (@{const Trueprop} $ t) = is_rec_def t
| is_rec_def (@{const Pure.imp} $ _ $ t2) = is_rec_def t2
- | is_rec_def (Const (@{const_name Pure.eq}, _) $ t1 $ t2) = is_rec_eq t1 t2
- | is_rec_def (Const (@{const_name HOL.eq}, _) $ t1 $ t2) = is_rec_eq t1 t2
+ | is_rec_def (Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t1 $ t2) = is_rec_eq t1 t2
+ | is_rec_def (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2) = is_rec_eq t1 t2
| is_rec_def _ = false
fun is_assum assms th = exists (fn ct => Thm.prop_of th aconv Thm.term_of ct) assms
@@ -99,7 +99,7 @@
else Local
val may_be_induction =
- exists_subterm (fn Var (_, Type (@{type_name fun}, [_, T])) => body_type T = @{typ bool}
+ exists_subterm (fn Var (_, Type (\<^type_name>\<open>fun\<close>, [_, T])) => body_type T = \<^typ>\<open>bool\<close>
| _ => false)
(* TODO: get rid of *)
@@ -217,7 +217,7 @@
val sep_class_sep = Long_Name.separator ^ "class" ^ Long_Name.separator
fun is_low_level_class_const s =
- s = @{const_name equal_class.equal} orelse String.isSubstring sep_class_sep s
+ s = \<^const_name>\<open>equal_class.equal\<close> orelse String.isSubstring sep_class_sep s
val sep_that = Long_Name.separator ^ Auto_Bind.thatN
val skolem_thesis = Name.skolem Auto_Bind.thesisN
@@ -248,7 +248,7 @@
if exists_Const ((is_technical_const o fst) orf (is_low_level_class_const o fst) orf
type_has_top_sort o snd) t then
Deal_Breaker
- else if exists_type (exists_subtype (curry (op =) @{typ prop})) t orelse
+ else if exists_type (exists_subtype (curry (op =) \<^typ>\<open>prop\<close>)) t orelse
not (exists_subterm is_interesting_subterm t) then
Boring
else
@@ -257,11 +257,11 @@
fun interest_of_prop _ (@{const Trueprop} $ t) = interest_of_bool t
| interest_of_prop Ts (@{const Pure.imp} $ t $ u) =
combine_interests (interest_of_prop Ts t) (interest_of_prop Ts u)
- | interest_of_prop Ts (Const (@{const_name Pure.all}, _) $ Abs (_, T, t)) =
+ | interest_of_prop Ts (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (_, T, t)) =
if type_has_top_sort T then Deal_Breaker else interest_of_prop (T :: Ts) t
- | interest_of_prop Ts ((t as Const (@{const_name Pure.all}, _)) $ u) =
+ | interest_of_prop Ts ((t as Const (\<^const_name>\<open>Pure.all\<close>, _)) $ u) =
interest_of_prop Ts (t $ eta_expand Ts u 1)
- | interest_of_prop _ (Const (@{const_name Pure.eq}, _) $ t $ u) =
+ | interest_of_prop _ (Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t $ u) =
combine_interests (interest_of_bool t) (interest_of_bool u)
| interest_of_prop _ _ = Deal_Breaker
@@ -336,12 +336,12 @@
end
end
-fun normalize_eq (@{const Trueprop} $ (t as (t0 as Const (@{const_name HOL.eq}, _)) $ t1 $ t2)) =
+fun normalize_eq (@{const Trueprop} $ (t as (t0 as Const (\<^const_name>\<open>HOL.eq\<close>, _)) $ t1 $ t2)) =
if is_less_equal (Term_Ord.fast_term_ord (t1, t2)) then t else t0 $ t2 $ t1
| normalize_eq (@{const Trueprop} $ (t as @{const Not}
- $ ((t0 as Const (@{const_name HOL.eq}, _)) $ t1 $ t2))) =
+ $ ((t0 as Const (\<^const_name>\<open>HOL.eq\<close>, _)) $ t1 $ t2))) =
if is_less_equal (Term_Ord.fast_term_ord (t1, t2)) then t else HOLogic.mk_not (t0 $ t2 $ t1)
- | normalize_eq (Const (@{const_name Pure.eq}, Type (_, [T, _])) $ t1 $ t2) =
+ | normalize_eq (Const (\<^const_name>\<open>Pure.eq\<close>, Type (_, [T, _])) $ t1 $ t2) =
(if is_less_equal (Term_Ord.fast_term_ord (t1, t2)) then (t1, t2) else (t2, t1))
|> (fn (t1, t2) => HOLogic.eq_const T $ t1 $ t2)
| normalize_eq t = t
@@ -551,7 +551,7 @@
val facts =
all_facts ctxt false ho_atp keywords add chained css
|> filter_out ((member Thm.eq_thm_prop del orf
- (Named_Theorems.member ctxt @{named_theorems no_atp} andf
+ (Named_Theorems.member ctxt \<^named_theorems>\<open>no_atp\<close> andf
not o member Thm.eq_thm_prop add)) o snd)
in
facts
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_isar.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_isar.ML Fri Jan 04 23:22:53 2019 +0100
@@ -45,7 +45,7 @@
open String_Redirect
-val trace = Attrib.setup_config_bool @{binding sledgehammer_isar_trace} (K false)
+val trace = Attrib.setup_config_bool \<^binding>\<open>sledgehammer_isar_trace\<close> (K false)
val e_definition_rule = "definition"
val e_skolemize_rule = "skolemize"
@@ -89,7 +89,7 @@
definitions. *)
if role = Conjecture orelse role = Negated_Conjecture then
line :: lines
- else if t aconv @{prop True} then
+ else if t aconv \<^prop>\<open>True\<close> then
map (replace_dependencies_in_line (name, [])) lines
else if role = Lemma orelse role = Hypothesis orelse is_arith_rule rule then
line :: lines
@@ -113,7 +113,7 @@
Term.aconv_untyped (normalize prev_role prev_t, norm_t)))
res
- fun looks_boring () = t aconv @{prop False} orelse length deps < 2
+ fun looks_boring () = t aconv \<^prop>\<open>False\<close> orelse length deps < 2
fun is_skolemizing_line (_, _, _, rule', deps') =
is_skolemize_rule rule' andalso member (op =) deps' name
@@ -280,7 +280,7 @@
(negs as _ :: _, pos as _ :: _) =>
s_imp (Library.foldr1 s_conj (map HOLogic.dest_not negs),
Library.foldr1 s_disj pos)
- | _ => fold (curry s_disj) lits @{term False})
+ | _ => fold (curry s_disj) lits \<^term>\<open>False\<close>)
end
|> HOLogic.mk_Trueprop |> finish_off
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_isar_preplay.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_isar_preplay.ML Fri Jan 04 23:22:53 2019 +0100
@@ -40,7 +40,7 @@
open Sledgehammer_Proof_Methods
open Sledgehammer_Isar_Proof
-val trace = Attrib.setup_config_bool @{binding sledgehammer_preplay_trace} (K false)
+val trace = Attrib.setup_config_bool \<^binding>\<open>sledgehammer_preplay_trace\<close> (K false)
fun peek_at_outcome outcome =
if Lazy.is_finished outcome then Lazy.force outcome else Play_Timed_Out Time.zeroTime
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_mash.ML Fri Jan 04 23:22:53 2019 +0100
@@ -97,8 +97,8 @@
val anonymous_proof_prefix = "."
-val trace = Attrib.setup_config_bool @{binding sledgehammer_mash_trace} (K false)
-val duplicates = Attrib.setup_config_bool @{binding sledgehammer_fact_duplicates} (K false)
+val trace = Attrib.setup_config_bool \<^binding>\<open>sledgehammer_mash_trace\<close> (K false)
+val duplicates = Attrib.setup_config_bool \<^binding>\<open>sledgehammer_fact_duplicates\<close> (K false)
fun trace_msg ctxt msg = if Config.get ctxt trace then tracing (msg ()) else ()
@@ -140,7 +140,7 @@
| MaSh_kNN_Ext
fun mash_algorithm () =
- (case Options.default_string @{system_option MaSh} of
+ (case Options.default_string \<^system_option>\<open>MaSh\<close> of
"yes" => SOME MaSh_NB_kNN
| "sml" => SOME MaSh_NB_kNN
| "nb" => SOME MaSh_NB
@@ -874,9 +874,9 @@
get_minimizing_prover ctxt MaSh (K ()) prover params problem
end
-val bad_types = [@{type_name prop}, @{type_name bool}, @{type_name fun}]
+val bad_types = [\<^type_name>\<open>prop\<close>, \<^type_name>\<open>bool\<close>, \<^type_name>\<open>fun\<close>]
-val crude_str_of_sort = space_implode "," o map Long_Name.base_name o subtract (op =) @{sort type}
+val crude_str_of_sort = space_implode "," o map Long_Name.base_name o subtract (op =) \<^sort>\<open>type\<close>
fun crude_str_of_typ (Type (s, [])) = Long_Name.base_name s
| crude_str_of_typ (Type (s, Ts)) = Long_Name.base_name s ^ implode (map crude_str_of_typ Ts)
@@ -895,11 +895,11 @@
val fixes = map snd (Variable.dest_fixes ctxt)
val classes = Sign.classes_of thy
- fun add_classes @{sort type} = I
+ fun add_classes \<^sort>\<open>type\<close> = I
| add_classes S =
fold (`(Sorts.super_classes classes)
#> swap #> op ::
- #> subtract (op =) @{sort type}
+ #> subtract (op =) \<^sort>\<open>type\<close>
#> map class_feature_of
#> union (op =)) S
@@ -1547,7 +1547,7 @@
val css = Sledgehammer_Fact.clasimpset_rule_table_of ctxt
val ctxt = ctxt |> Config.put instantiate_inducts false
val facts =
- nearly_all_facts ctxt false fact_override Keyword.empty_keywords css chained [] @{prop True}
+ nearly_all_facts ctxt false fact_override Keyword.empty_keywords css chained [] \<^prop>\<open>True\<close>
|> sort (crude_thm_ord ctxt o apply2 snd o swap)
val num_facts = length facts
val prover = hd provers
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_mepo.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_mepo.ML Fri Jan 04 23:22:53 2019 +0100
@@ -47,7 +47,7 @@
open Sledgehammer_Fact
open Sledgehammer_Prover
-val trace = Attrib.setup_config_bool @{binding sledgehammer_mepo_trace} (K false)
+val trace = Attrib.setup_config_bool \<^binding>\<open>sledgehammer_mepo_trace\<close> (K false)
fun trace_msg ctxt msg = if Config.get ctxt trace then tracing (msg ()) else ()
@@ -96,7 +96,7 @@
threshold_divisor = 2.0,
ridiculous_threshold = 0.1}
-fun order_of_type (Type (@{type_name fun}, [T1, T2])) =
+fun order_of_type (Type (\<^type_name>\<open>fun\<close>, [T1, T2])) =
Int.max (order_of_type T1 + 1, order_of_type T2)
| order_of_type (Type (_, Ts)) = fold (Integer.max o order_of_type) Ts 0
| order_of_type _ = 0
@@ -151,7 +151,7 @@
(* Set constants tend to pull in too many irrelevant facts. We limit the damage by treating them
more or less as if they were built-in but add their axiomatization at the end. *)
-val set_consts = [@{const_name Collect}, @{const_name Set.member}]
+val set_consts = [\<^const_name>\<open>Collect\<close>, \<^const_name>\<open>Set.member\<close>]
val set_thms = @{thms Collect_mem_eq mem_Collect_eq Collect_cong}
fun add_pconsts_in_term thy =
@@ -177,29 +177,29 @@
if T = HOLogic.boolT then do_formula else do_term ext_arg
and do_formula t =
(case t of
- Const (@{const_name Pure.all}, _) $ Abs (_, _, t') => do_formula t'
+ Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (_, _, t') => do_formula t'
| @{const Pure.imp} $ t1 $ t2 => do_formula t1 #> do_formula t2
- | Const (@{const_name Pure.eq}, Type (_, [T, _])) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>Pure.eq\<close>, Type (_, [T, _])) $ t1 $ t2 =>
do_term_or_formula false T t1 #> do_term_or_formula true T t2
| @{const Trueprop} $ t1 => do_formula t1
| @{const False} => I
| @{const True} => I
| @{const Not} $ t1 => do_formula t1
- | Const (@{const_name All}, _) $ Abs (_, _, t') => do_formula t'
- | Const (@{const_name Ex}, _) $ Abs (_, _, t') => do_formula t'
+ | Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, _, t') => do_formula t'
+ | Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (_, _, t') => do_formula t'
| @{const HOL.conj} $ t1 $ t2 => do_formula t1 #> do_formula t2
| @{const HOL.disj} $ t1 $ t2 => do_formula t1 #> do_formula t2
| @{const HOL.implies} $ t1 $ t2 => do_formula t1 #> do_formula t2
- | Const (@{const_name HOL.eq}, Type (_, [T, _])) $ t1 $ t2 =>
+ | Const (\<^const_name>\<open>HOL.eq\<close>, Type (_, [T, _])) $ t1 $ t2 =>
do_term_or_formula false T t1 #> do_term_or_formula true T t2
- | Const (@{const_name If}, Type (_, [_, Type (_, [T, _])])) $ t1 $ t2 $ t3 =>
+ | Const (\<^const_name>\<open>If\<close>, Type (_, [_, Type (_, [T, _])])) $ t1 $ t2 $ t3 =>
do_formula t1 #> fold (do_term_or_formula false T) [t2, t3]
- | Const (@{const_name Ex1}, _) $ Abs (_, _, t') => do_formula t'
- | Const (@{const_name Ball}, _) $ t1 $ Abs (_, _, t') =>
+ | Const (\<^const_name>\<open>Ex1\<close>, _) $ Abs (_, _, t') => do_formula t'
+ | Const (\<^const_name>\<open>Ball\<close>, _) $ t1 $ Abs (_, _, t') =>
do_formula (t1 $ Bound ~1) #> do_formula t'
- | Const (@{const_name Bex}, _) $ t1 $ Abs (_, _, t') =>
+ | Const (\<^const_name>\<open>Bex\<close>, _) $ t1 $ Abs (_, _, t') =>
do_formula (t1 $ Bound ~1) #> do_formula t'
- | (t0 as Const (_, @{typ bool})) $ t1 =>
+ | (t0 as Const (_, \<^typ>\<open>bool\<close>)) $ t1 =>
do_term false t0 #> do_formula t1 (* theory constant *)
| _ => do_term false t)
in
@@ -215,7 +215,7 @@
fun theory_constify ({theory_const_rel_weight, theory_const_irrel_weight, ...} : relevance_fudge)
thy_name t =
if exists (curry (op <) 0.0) [theory_const_rel_weight, theory_const_irrel_weight] then
- Const (thy_name ^ theory_const_suffix, @{typ bool}) $ t
+ Const (thy_name ^ theory_const_suffix, \<^typ>\<open>bool\<close>) $ t
else
t
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_prover_atp.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_prover_atp.ML Fri Jan 04 23:22:53 2019 +0100
@@ -38,14 +38,14 @@
open Sledgehammer_Prover
(* Empty string means create files in Isabelle's temporary files directory. *)
-val atp_dest_dir = Attrib.setup_config_string @{binding sledgehammer_atp_dest_dir} (K "")
+val atp_dest_dir = Attrib.setup_config_string \<^binding>\<open>sledgehammer_atp_dest_dir\<close> (K "")
val atp_problem_prefix =
- Attrib.setup_config_string @{binding sledgehammer_atp_problem_prefix} (K "prob")
-val atp_completish = Attrib.setup_config_int @{binding sledgehammer_atp_completish} (K 0)
+ Attrib.setup_config_string \<^binding>\<open>sledgehammer_atp_problem_prefix\<close> (K "prob")
+val atp_completish = Attrib.setup_config_int \<^binding>\<open>sledgehammer_atp_completish\<close> (K 0)
(* In addition to being easier to read, readable names are often much shorter, especially if types
are mangled in names. This makes a difference for some provers (e.g., E). For these reason, short
names are enabled by default. *)
-val atp_full_names = Attrib.setup_config_bool @{binding sledgehammer_atp_full_names} (K false)
+val atp_full_names = Attrib.setup_config_bool \<^binding>\<open>sledgehammer_atp_full_names\<close> (K false)
fun is_atp_of_format is_format ctxt name =
let val thy = Proof_Context.theory_of ctxt in
@@ -79,18 +79,18 @@
fun do_formula pos t =
(case (pos, t) of
(_, @{const Trueprop} $ t1) => do_formula pos t1
- | (true, Const (@{const_name Pure.all}, _) $ Abs (_, _, t')) => do_formula pos t'
- | (true, Const (@{const_name All}, _) $ Abs (_, _, t')) => do_formula pos t'
- | (false, Const (@{const_name Ex}, _) $ Abs (_, _, t')) => do_formula pos t'
+ | (true, Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (_, _, t')) => do_formula pos t'
+ | (true, Const (\<^const_name>\<open>All\<close>, _) $ Abs (_, _, t')) => do_formula pos t'
+ | (false, Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (_, _, t')) => do_formula pos t'
| (_, @{const Pure.imp} $ t1 $ t2) =>
- do_formula (not pos) t1 andalso (t2 = @{prop False} orelse do_formula pos t2)
+ do_formula (not pos) t1 andalso (t2 = \<^prop>\<open>False\<close> orelse do_formula pos t2)
| (_, @{const HOL.implies} $ t1 $ t2) =>
do_formula (not pos) t1 andalso (t2 = @{const False} orelse do_formula pos t2)
| (_, @{const Not} $ t1) => do_formula (not pos) t1
| (true, @{const HOL.disj} $ t1 $ t2) => forall (do_formula pos) [t1, t2]
| (false, @{const HOL.conj} $ t1 $ t2) => forall (do_formula pos) [t1, t2]
- | (true, Const (@{const_name HOL.eq}, _) $ t1 $ t2) => do_equals t1 t2
- | (true, Const (@{const_name Pure.eq}, _) $ t1 $ t2) => do_equals t1 t2
+ | (true, Const (\<^const_name>\<open>HOL.eq\<close>, _) $ t1 $ t2) => do_equals t1 t2
+ | (true, Const (\<^const_name>\<open>Pure.eq\<close>, _) $ t1 $ t2) => do_equals t1 t2
| _ => false)
in do_formula true end
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_prover_minimize.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_prover_minimize.ML Fri Jan 04 23:22:53 2019 +0100
@@ -137,7 +137,7 @@
returns all facts as used. Since we cannot know in advance how many facts are
actually needed, we heuristically set the threshold to 10 facts. *)
val binary_min_facts =
- Attrib.setup_config_int @{binding sledgehammer_minimize_binary_min_facts} (K 20)
+ Attrib.setup_config_int \<^binding>\<open>sledgehammer_minimize_binary_min_facts\<close> (K 20)
fun linear_minimize test timeout result xs =
let
--- a/src/HOL/Tools/Sledgehammer/sledgehammer_prover_smt.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer_prover_smt.ML Fri Jan 04 23:22:53 2019 +0100
@@ -36,8 +36,8 @@
open Sledgehammer_Isar
open Sledgehammer_Prover
-val smt_builtins = Attrib.setup_config_bool @{binding sledgehammer_smt_builtins} (K true)
-val smt_triggers = Attrib.setup_config_bool @{binding sledgehammer_smt_triggers} (K true)
+val smt_builtins = Attrib.setup_config_bool \<^binding>\<open>sledgehammer_smt_builtins\<close> (K true)
+val smt_triggers = Attrib.setup_config_bool \<^binding>\<open>sledgehammer_smt_triggers\<close> (K true)
val is_smt_prover = member (op =) o SMT_Config.available_solvers_of
@@ -65,15 +65,15 @@
| failure_of_smt_failure (SMT_Failure.Other_Failure s) = UnknownError s
(* FUDGE *)
-val smt_max_slices = Attrib.setup_config_int @{binding sledgehammer_smt_max_slices} (K 8)
+val smt_max_slices = Attrib.setup_config_int \<^binding>\<open>sledgehammer_smt_max_slices\<close> (K 8)
val smt_slice_fact_frac =
- Attrib.setup_config_real @{binding sledgehammer_smt_slice_fact_frac} (K 0.667)
+ Attrib.setup_config_real \<^binding>\<open>sledgehammer_smt_slice_fact_frac\<close> (K 0.667)
val smt_slice_time_frac =
- Attrib.setup_config_real @{binding sledgehammer_smt_slice_time_frac} (K 0.333)
-val smt_slice_min_secs = Attrib.setup_config_int @{binding sledgehammer_smt_slice_min_secs} (K 3)
+ Attrib.setup_config_real \<^binding>\<open>sledgehammer_smt_slice_time_frac\<close> (K 0.333)
+val smt_slice_min_secs = Attrib.setup_config_int \<^binding>\<open>sledgehammer_smt_slice_min_secs\<close> (K 3)
val is_boring_builtin_typ =
- not o exists_subtype (member (op =) [@{typ nat}, @{typ int}, HOLogic.realT])
+ not o exists_subtype (member (op =) [\<^typ>\<open>nat\<close>, \<^typ>\<open>int\<close>, HOLogic.realT])
fun smt_filter_loop name ({debug, overlord, max_mono_iters, max_new_mono_instances, timeout, slice,
...} : params) state goal i =
--- a/src/HOL/Tools/Transfer/transfer.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Transfer/transfer.ML Fri Jan 04 23:22:53 2019 +0100
@@ -57,9 +57,9 @@
structure Transfer : TRANSFER =
struct
-fun bottom_rewr_conv rewrs = Conv.bottom_conv (K (Conv.try_conv (Conv.rewrs_conv rewrs))) @{context}
-fun top_rewr_conv rewrs = Conv.top_conv (K (Conv.try_conv (Conv.rewrs_conv rewrs))) @{context}
-fun top_sweep_rewr_conv rewrs = Conv.top_sweep_conv (K (Conv.rewrs_conv rewrs)) @{context}
+fun bottom_rewr_conv rewrs = Conv.bottom_conv (K (Conv.try_conv (Conv.rewrs_conv rewrs))) \<^context>
+fun top_rewr_conv rewrs = Conv.top_conv (K (Conv.try_conv (Conv.rewrs_conv rewrs))) \<^context>
+fun top_sweep_rewr_conv rewrs = Conv.top_sweep_conv (K (Conv.rewrs_conv rewrs)) \<^context>
(** Theory Data **)
@@ -180,12 +180,12 @@
(map_transfer_raw (Item_Net.update thm) o
map_compound_lhs
(case HOLogic.dest_Trueprop (Thm.concl_of thm) of
- Const (@{const_name Rel}, _) $ _ $ (lhs as (_ $ _)) $ _ =>
+ Const (\<^const_name>\<open>Rel\<close>, _) $ _ $ (lhs as (_ $ _)) $ _ =>
Item_Net.update (lhs, thm)
| _ => I) o
map_compound_rhs
(case HOLogic.dest_Trueprop (Thm.concl_of thm) of
- Const (@{const_name Rel}, _) $ _ $ _ $ (rhs as (_ $ _)) =>
+ Const (\<^const_name>\<open>Rel\<close>, _) $ _ $ _ $ (rhs as (_ $ _)) =>
Item_Net.update (rhs, thm)
| _ => I) o
map_known_frees (Term.add_frees (Thm.concl_of thm)))
@@ -194,12 +194,12 @@
(map_transfer_raw (Item_Net.remove thm) o
map_compound_lhs
(case HOLogic.dest_Trueprop (Thm.concl_of thm) of
- Const (@{const_name Rel}, _) $ _ $ (lhs as (_ $ _)) $ _ =>
+ Const (\<^const_name>\<open>Rel\<close>, _) $ _ $ (lhs as (_ $ _)) $ _ =>
Item_Net.remove (lhs, thm)
| _ => I) o
map_compound_rhs
(case HOLogic.dest_Trueprop (Thm.concl_of thm) of
- Const (@{const_name Rel}, _) $ _ $ _ $ (rhs as (_ $ _)) =>
+ Const (\<^const_name>\<open>Rel\<close>, _) $ _ $ _ $ (rhs as (_ $ _)) =>
Item_Net.remove (rhs, thm)
| _ => I))
@@ -240,7 +240,7 @@
(** Replacing explicit equalities with is_equality premises **)
fun mk_is_equality t =
- Const (@{const_name is_equality}, Term.fastype_of t --> HOLogic.boolT) $ t
+ Const (\<^const_name>\<open>is_equality\<close>, Term.fastype_of t --> HOLogic.boolT) $ t
val is_equality_lemma =
@{lemma "(!!R. is_equality R ==> PROP (P R)) == PROP (P (=))"
@@ -252,7 +252,7 @@
val prop = Thm.prop_of thm
val (t, mk_prop') = dest prop
(* Only consider "(=)" at non-base types *)
- fun is_eq (Const (@{const_name HOL.eq}, Type ("fun", [T, _]))) =
+ fun is_eq (Const (\<^const_name>\<open>HOL.eq\<close>, Type ("fun", [T, _]))) =
(case T of Type (_, []) => false | _ => true)
| is_eq _ = false
val add_eqs = Term.fold_aterms (fn t => if is_eq t then insert (op =) t else I)
@@ -316,14 +316,14 @@
(** Replacing explicit Domainp predicates with Domainp assumptions **)
fun mk_Domainp_assm (T, R) =
- HOLogic.mk_eq ((Const (@{const_name Domainp}, Term.fastype_of T --> Term.fastype_of R) $ T), R)
+ HOLogic.mk_eq ((Const (\<^const_name>\<open>Domainp\<close>, Term.fastype_of T --> Term.fastype_of R) $ T), R)
val Domainp_lemma =
@{lemma "(!!R. Domainp T = R ==> PROP (P R)) == PROP (P (Domainp T))"
by (rule, drule meta_spec,
erule meta_mp, rule refl, simp)}
-fun fold_Domainp f (t as Const (@{const_name Domainp},_) $ (Var (_,_))) = f t
+fun fold_Domainp f (t as Const (\<^const_name>\<open>Domainp\<close>,_) $ (Var (_,_))) = f t
| fold_Domainp f (t $ u) = fold_Domainp f t #> fold_Domainp f u
| fold_Domainp f (Abs (_, _, t)) = fold_Domainp f t
| fold_Domainp _ _ = I
@@ -397,7 +397,7 @@
fun detect_transfer_rules thm =
let
fun is_transfer_rule tm = case (HOLogic.dest_Trueprop tm) of
- (Const (@{const_name HOL.eq}, _)) $ ((Const (@{const_name Domainp}, _)) $ _) $ _ => false
+ (Const (\<^const_name>\<open>HOL.eq\<close>, _)) $ ((Const (\<^const_name>\<open>Domainp\<close>, _)) $ _) $ _ => false
| _ $ _ $ _ => true
| _ => false
fun safe_transfer_rule_conv ctm =
@@ -436,7 +436,7 @@
fun mk_Rel t =
let val T = fastype_of t
- in Const (@{const_name Transfer.Rel}, T --> T) $ t end
+ in Const (\<^const_name>\<open>Transfer.Rel\<close>, T --> T) $ t end
fun transfer_rule_of_terms (prj : typ * typ -> typ) ctxt tab t u =
let
@@ -447,7 +447,7 @@
val r2 = rel T2 U2
val rT = fastype_of r1 --> fastype_of r2 --> mk_relT (T, U)
in
- Const (@{const_name rel_fun}, rT) $ r1 $ r2
+ Const (\<^const_name>\<open>rel_fun\<close>, rT) $ r1 $ r2
end
| rel T U =
let
@@ -532,8 +532,8 @@
(* TODO: Put extensible table in theory data *)
val monotab =
Symtab.make
- [(@{const_name transfer_implies}, [~1, 1]),
- (@{const_name transfer_forall}, [1])(*,
+ [(\<^const_name>\<open>transfer_implies\<close>, [~1, 1]),
+ (\<^const_name>\<open>transfer_forall\<close>, [1])(*,
(@{const_name implies}, [~1, 1]),
(@{const_name All}, [1])*)]
@@ -598,9 +598,9 @@
val thm = transfer_rule_of_terms fst ctxt' tab s t
val binsts = bool_insts (if equiv then 0 else 1) (s, t)
val idx = Thm.maxidx_of thm + 1
- fun tinst (a, _) = (((a, idx), @{sort type}), @{ctyp bool})
+ fun tinst (a, _) = (((a, idx), \<^sort>\<open>type\<close>), \<^ctyp>\<open>bool\<close>)
fun inst (a, t) =
- ((Name.clean_index (prep a, idx), @{typ "bool \<Rightarrow> bool \<Rightarrow> bool"}), Thm.cterm_of ctxt' t)
+ ((Name.clean_index (prep a, idx), \<^typ>\<open>bool \<Rightarrow> bool \<Rightarrow> bool\<close>), Thm.cterm_of ctxt' t)
in
thm
|> Thm.generalize (tfrees, rnames @ frees) idx
@@ -621,9 +621,9 @@
val thm = transfer_rule_of_terms snd ctxt' tab t s
val binsts = bool_insts 1 (s, t)
val idx = Thm.maxidx_of thm + 1
- fun tinst (a, _) = (((a, idx), @{sort type}), @{ctyp bool})
+ fun tinst (a, _) = (((a, idx), \<^sort>\<open>type\<close>), \<^ctyp>\<open>bool\<close>)
fun inst (a, t) =
- ((Name.clean_index (prep a, idx), @{typ "bool \<Rightarrow> bool \<Rightarrow> bool"}), Thm.cterm_of ctxt' t)
+ ((Name.clean_index (prep a, idx), \<^typ>\<open>bool \<Rightarrow> bool \<Rightarrow> bool\<close>), Thm.cterm_of ctxt' t)
in
thm
|> Thm.generalize (tfrees, rnames @ frees) idx
@@ -746,7 +746,7 @@
(SOLVED' (REPEAT_ALL_NEW (resolve_tac ctxt' rules)
THEN_ALL_NEW (DETERM o eq_rules_tac ctxt' eq_rules)))) 1
handle TERM (_, ts) => raise TERM (err_msg, ts)
- val goal = Thm.cterm_of ctxt' (HOLogic.mk_Trueprop (Var (("P", 0), @{typ bool})))
+ val goal = Thm.cterm_of ctxt' (HOLogic.mk_Trueprop (Var (("P", 0), \<^typ>\<open>bool\<close>)))
val thm3 = Goal.prove_internal ctxt' [] goal (K tac)
val tnames = map (fst o dest_TFree o Thm.typ_of o snd) instT
in
@@ -784,7 +784,7 @@
(SOLVED' (REPEAT_ALL_NEW (resolve_tac ctxt' rules)
THEN_ALL_NEW (DETERM o eq_rules_tac ctxt' eq_rules)))) 1
handle TERM (_, ts) => raise TERM (err_msg, ts)
- val goal = Thm.cterm_of ctxt' (HOLogic.mk_Trueprop (Var (("P", 0), @{typ bool})))
+ val goal = Thm.cterm_of ctxt' (HOLogic.mk_Trueprop (Var (("P", 0), \<^typ>\<open>bool\<close>)))
val thm3 = Goal.prove_internal ctxt' [] goal (K tac)
val tnames = map (fst o dest_TFree o Thm.typ_of o snd) instT
in
@@ -878,7 +878,7 @@
val _ =
Theory.setup
let
- val name = @{binding relator_eq}
+ val name = \<^binding>\<open>relator_eq\<close>
fun add_thm thm context = context
|> Data.map (map_relator_eq (Item_Net.update thm))
|> Data.map (map_relator_eq_raw
@@ -899,7 +899,7 @@
val _ =
Theory.setup
let
- val name = @{binding relator_domain}
+ val name = \<^binding>\<open>relator_domain\<close>
fun add_thm thm context =
let
val thm = abstract_domains_relator_domain (Context.proof_of context) thm
@@ -923,37 +923,37 @@
val _ =
Theory.setup
- (Attrib.setup @{binding transfer_rule} transfer_attribute
+ (Attrib.setup \<^binding>\<open>transfer_rule\<close> transfer_attribute
"transfer rule for transfer method"
#> Global_Theory.add_thms_dynamic
- (@{binding transfer_raw}, Item_Net.content o #transfer_raw o Data.get)
- #> Attrib.setup @{binding transfer_domain_rule} transfer_domain_attribute
+ (\<^binding>\<open>transfer_raw\<close>, Item_Net.content o #transfer_raw o Data.get)
+ #> Attrib.setup \<^binding>\<open>transfer_domain_rule\<close> transfer_domain_attribute
"transfer domain rule for transfer method"
- #> Attrib.setup @{binding transferred} transferred_attribute_parser
+ #> Attrib.setup \<^binding>\<open>transferred\<close> transferred_attribute_parser
"raw theorem transferred to abstract theorem using transfer rules"
- #> Attrib.setup @{binding untransferred} untransferred_attribute_parser
+ #> Attrib.setup \<^binding>\<open>untransferred\<close> untransferred_attribute_parser
"abstract theorem transferred to raw theorem using transfer rules"
#> Global_Theory.add_thms_dynamic
- (@{binding relator_eq_raw}, Item_Net.content o #relator_eq_raw o Data.get)
- #> Method.setup @{binding transfer_start} (transfer_start_method true)
+ (\<^binding>\<open>relator_eq_raw\<close>, Item_Net.content o #relator_eq_raw o Data.get)
+ #> Method.setup \<^binding>\<open>transfer_start\<close> (transfer_start_method true)
"firtst step in the transfer algorithm (for debugging transfer)"
- #> Method.setup @{binding transfer_start'} (transfer_start_method false)
+ #> Method.setup \<^binding>\<open>transfer_start'\<close> (transfer_start_method false)
"firtst step in the transfer algorithm (for debugging transfer)"
- #> Method.setup @{binding transfer_prover_start} transfer_prover_start_method
+ #> Method.setup \<^binding>\<open>transfer_prover_start\<close> transfer_prover_start_method
"firtst step in the transfer_prover algorithm (for debugging transfer_prover)"
- #> Method.setup @{binding transfer_step}
+ #> Method.setup \<^binding>\<open>transfer_step\<close>
(Scan.succeed (fn ctxt => SIMPLE_METHOD' (transfer_step_tac ctxt)))
"step in the search for transfer rules (for debugging transfer and transfer_prover)"
- #> Method.setup @{binding transfer_end}
+ #> Method.setup \<^binding>\<open>transfer_end\<close>
(Scan.succeed (fn ctxt => SIMPLE_METHOD' (transfer_end_tac ctxt)))
"last step in the transfer algorithm (for debugging transfer)"
- #> Method.setup @{binding transfer_prover_end}
+ #> Method.setup \<^binding>\<open>transfer_prover_end\<close>
(Scan.succeed (fn ctxt => SIMPLE_METHOD' (transfer_prover_end_tac ctxt)))
"last step in the transfer_prover algorithm (for debugging transfer_prover)"
- #> Method.setup @{binding transfer} (transfer_method true)
+ #> Method.setup \<^binding>\<open>transfer\<close> (transfer_method true)
"generic theorem transfer method"
- #> Method.setup @{binding transfer'} (transfer_method false)
+ #> Method.setup \<^binding>\<open>transfer'\<close> (transfer_method false)
"generic theorem transfer method"
- #> Method.setup @{binding transfer_prover} transfer_prover_method
+ #> Method.setup \<^binding>\<open>transfer_prover\<close> transfer_prover_method
"for proving transfer rules")
end
--- a/src/HOL/Tools/Transfer/transfer_bnf.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/Transfer/transfer_bnf.ML Fri Jan 04 23:22:53 2019 +0100
@@ -33,7 +33,7 @@
val PT = fastype_of P
val argT = hd (binder_types PT)
in
- Const (@{const_name Domainp}, PT --> argT --> HOLogic.boolT) $ P
+ Const (\<^const_name>\<open>Domainp\<close>, PT --> argT --> HOLogic.boolT) $ P
end
fun type_name_of_bnf bnf = T_of_bnf bnf |> dest_Type |> fst
--- a/src/HOL/Tools/datatype_realizer.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/datatype_realizer.ML Fri Jan 04 23:22:53 2019 +0100
@@ -34,7 +34,7 @@
else map (fn i => "P" ^ string_of_int i) (1 upto length descr);
val rec_result_Ts = map (fn ((i, _), P) =>
- if member (op =) is i then TFree ("'" ^ P, @{sort type}) else HOLogic.unitT)
+ if member (op =) is i then TFree ("'" ^ P, \<^sort>\<open>type\<close>) else HOLogic.unitT)
(descr ~~ pnames);
fun make_pred i T U r x =
@@ -101,7 +101,7 @@
(list_comb (Const (s, fTs ---> T --> U), rec_fns) $ Free (tname, T))
else NONE) (descr ~~ recTs ~~ rec_result_Ts ~~ rec_names ~~ tnames));
val concl =
- HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop @{const_name HOL.conj})
+ HOLogic.mk_Trueprop (foldr1 (HOLogic.mk_binop \<^const_name>\<open>HOL.conj\<close>)
(map (fn ((((i, _), T), U), tname) =>
make_pred i U T (mk_proj i is r) (Free (tname, T)))
(descr ~~ recTs ~~ rec_result_Ts ~~ tnames)));
@@ -133,7 +133,7 @@
val ivs = rev (Term.add_vars (Logic.varify_global (Old_Datatype_Prop.make_ind [descr])) []);
val rvs = rev (Thm.fold_terms Term.add_vars thm' []);
- val ivs1 = map Var (filter_out (fn (_, T) => @{type_name bool} = tname_of (body_type T)) ivs);
+ val ivs1 = map Var (filter_out (fn (_, T) => \<^type_name>\<open>bool\<close> = tname_of (body_type T)) ivs);
val ivs2 = map (fn (ixn, _) => Var (ixn, the (AList.lookup (op =) rvs ixn))) ivs;
val prf =
@@ -162,8 +162,8 @@
fun make_casedists ({index, descr, case_name, case_rewrites, exhaust, ...} : Old_Datatype_Aux.info) thy =
let
val ctxt = Proof_Context.init_global thy;
- val rT = TFree ("'P", @{sort type});
- val rT' = TVar (("'P", 0), @{sort type});
+ val rT = TFree ("'P", \<^sort>\<open>type\<close>);
+ val rT' = TVar (("'P", 0), \<^sort>\<open>type\<close>);
fun make_casedist_prem T (cname, cargs) =
let
@@ -241,6 +241,6 @@
|> fold_rev (perhaps o try o make_casedists) infos
end;
-val _ = Theory.setup (BNF_LFP_Compat.interpretation @{plugin extraction} [] add_dt_realizers);
+val _ = Theory.setup (BNF_LFP_Compat.interpretation \<^plugin>\<open>extraction\<close> [] add_dt_realizers);
end;
--- a/src/HOL/Tools/functor.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/functor.ML Fri Jan 04 23:22:53 2019 +0100
@@ -82,7 +82,7 @@
(* mapper properties *)
val compositionality_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps [Simpdata.mk_eq @{thm comp_def}]);
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps [Simpdata.mk_eq @{thm comp_def}]);
fun make_comp_prop ctxt variances (tyco, mapper) =
let
@@ -136,7 +136,7 @@
in (comp_prop, prove_compositionality) end;
val identity_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps [Simpdata.mk_eq @{thm id_def}]);
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps [Simpdata.mk_eq @{thm id_def}]);
fun make_id_prop ctxt variances (tyco, mapper) =
let
--- a/src/HOL/Tools/groebner.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/groebner.ML Fri Jan 04 23:22:53 2019 +0100
@@ -402,7 +402,7 @@
Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms weak_dnf_simps});
val initial_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps nnf_simps
addsimps [not_all, not_ex]
addsimps map (fn th => th RS sym) (@{thms ex_simps} @ @{thms all_simps}));
@@ -786,7 +786,7 @@
end;
val poly_eq_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps @{thms simp_thms}
addsimprocs [poly_eq_simproc])
@@ -946,7 +946,7 @@
| exitac ctxt (SOME y) =
resolve_tac ctxt [Thm.instantiate' [SOME (Thm.ctyp_of_cterm y)] [NONE,SOME y] exI] 1
- val claset = claset_of @{context}
+ val claset = claset_of \<^context>
in
fun ideal_tac add_ths del_ths ctxt =
presimplify ctxt add_ths del_ths
--- a/src/HOL/Tools/hologic.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/hologic.ML Fri Jan 04 23:22:53 2019 +0100
@@ -591,14 +591,14 @@
(* booleans as bits *)
-fun mk_bit b = if b = 0 then @{term False}
- else if b = 1 then @{term True}
+fun mk_bit b = if b = 0 then \<^term>\<open>False\<close>
+ else if b = 1 then \<^term>\<open>True\<close>
else raise TERM ("mk_bit", []);
fun mk_bits len = map mk_bit o Integer.radicify 2 len;
-fun dest_bit @{term False} = 0
- | dest_bit @{term True} = 1
+fun dest_bit \<^term>\<open>False\<close> = 0
+ | dest_bit \<^term>\<open>True\<close> = 1
| dest_bit _ = raise TERM ("dest_bit", []);
val dest_bits = Integer.eval_radix 2 o map dest_bit;
--- a/src/HOL/Tools/inductive.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/inductive.ML Fri Jan 04 23:22:53 2019 +0100
@@ -575,7 +575,7 @@
local
(*delete needless equality assumptions*)
-val refl_thin = Goal.prove_global @{theory HOL} [] [] \<^prop>\<open>\<And>P. a = a \<Longrightarrow> P \<Longrightarrow> P\<close>
+val refl_thin = Goal.prove_global \<^theory>\<open>HOL\<close> [] [] \<^prop>\<open>\<And>P. a = a \<Longrightarrow> P \<Longrightarrow> P\<close>
(fn {context = ctxt, ...} => assume_tac ctxt 1);
val elim_rls = [asm_rl, FalseE, refl_thin, conjE, exE];
fun elim_tac ctxt = REPEAT o eresolve_tac ctxt elim_rls;
--- a/src/HOL/Tools/inductive_realizer.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/inductive_realizer.ML Fri Jan 04 23:22:53 2019 +0100
@@ -30,30 +30,30 @@
val pred_of = fst o dest_Const o head_of;
-fun strip_all' used names (Const (@{const_name Pure.all}, _) $ Abs (s, T, t)) =
+fun strip_all' used names (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (s, T, t)) =
let val (s', names') = (case names of
[] => (singleton (Name.variant_list used) s, [])
| name :: names' => (name, names'))
in strip_all' (s'::used) names' (subst_bound (Free (s', T), t)) end
- | strip_all' used names ((t as Const (@{const_name Pure.imp}, _) $ P) $ Q) =
+ | strip_all' used names ((t as Const (\<^const_name>\<open>Pure.imp\<close>, _) $ P) $ Q) =
t $ strip_all' used names Q
| strip_all' _ _ t = t;
fun strip_all t = strip_all' (Term.add_free_names t []) [] t;
fun strip_one name
- (Const (@{const_name Pure.all}, _) $ Abs (s, T, Const (@{const_name Pure.imp}, _) $ P $ Q)) =
+ (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (s, T, Const (\<^const_name>\<open>Pure.imp\<close>, _) $ P $ Q)) =
(subst_bound (Free (name, T), P), subst_bound (Free (name, T), Q))
- | strip_one _ (Const (@{const_name Pure.imp}, _) $ P $ Q) = (P, Q);
+ | strip_one _ (Const (\<^const_name>\<open>Pure.imp\<close>, _) $ P $ Q) = (P, Q);
fun relevant_vars prop = fold (fn ((a, i), T) => fn vs =>
(case strip_type T of
- (_, Type (s, _)) => if s = @{type_name bool} then (a, T) :: vs else vs
+ (_, Type (s, _)) => if s = \<^type_name>\<open>bool\<close> then (a, T) :: vs else vs
| _ => vs)) (Term.add_vars prop []) [];
val attach_typeS = map_types (map_atyps
- (fn TFree (s, []) => TFree (s, @{sort type})
- | TVar (ixn, []) => TVar (ixn, @{sort type})
+ (fn TFree (s, []) => TFree (s, \<^sort>\<open>type\<close>)
+ | TVar (ixn, []) => TVar (ixn, \<^sort>\<open>type\<close>)
| T => T));
fun dt_of_intrs thy vs nparms intrs =
@@ -145,9 +145,9 @@
val is_rec = exists_Const (fn (c, _) => member (op =) rsets c);
- fun is_meta (Const (@{const_name Pure.all}, _) $ Abs (s, _, P)) = is_meta P
- | is_meta (Const (@{const_name Pure.imp}, _) $ _ $ Q) = is_meta Q
- | is_meta (Const (@{const_name Trueprop}, _) $ t) =
+ fun is_meta (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (s, _, P)) = is_meta P
+ | is_meta (Const (\<^const_name>\<open>Pure.imp\<close>, _) $ _ $ Q) = is_meta Q
+ | is_meta (Const (\<^const_name>\<open>Trueprop\<close>, _) $ t) =
(case head_of t of
Const (s, _) => can (Inductive.the_inductive_global ctxt) s
| _ => true)
@@ -174,7 +174,7 @@
end
else
(case strip_type T of
- (Ts, Type (@{type_name Product_Type.prod}, [T1, T2])) =>
+ (Ts, Type (\<^type_name>\<open>Product_Type.prod\<close>, [T1, T2])) =>
let
val fx = Free (x, Ts ---> T1);
val fr = Free (r, Ts ---> T2);
@@ -212,7 +212,7 @@
val fs = map (fn (rule, (ivs, intr)) =>
fun_of_prem thy rsets vs params rule ivs intr) (prems ~~ intrs)
in
- if dummy then Const (@{const_name default},
+ if dummy then Const (\<^const_name>\<open>default\<close>,
HOLogic.unitT --> body_type (fastype_of (hd fs))) :: fs
else fs
end) (premss ~~ dummies);
@@ -447,7 +447,7 @@
fold_rev (Term.abs o pair "x") Ts
(list_comb (Const (case_name, T),
(if dummy then
- [Abs ("x", HOLogic.unitT, Const (@{const_name default}, body_type T))]
+ [Abs ("x", HOLogic.unitT, Const (\<^const_name>\<open>default\<close>, body_type T))]
else []) @
map reorder2 (intrs ~~ (length prems - 1 downto 0)) @
[Bound (length prems)]));
--- a/src/HOL/Tools/inductive_set.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/inductive_set.ML Fri Jan 04 23:22:53 2019 +0100
@@ -38,7 +38,7 @@
val anyt = Free ("t", TFree ("'t", []));
fun strong_ind_simproc tab =
- Simplifier.make_simproc @{context} "strong_ind"
+ Simplifier.make_simproc \<^context> "strong_ind"
{lhss = [\<^term>\<open>x::'a::{}\<close>],
proc = fn _ => fn ctxt => fn ct =>
let
@@ -319,7 +319,7 @@
fun to_pred_simproc rules =
let val rules' = map mk_meta_eq rules
in
- Simplifier.make_simproc @{context} "to_pred"
+ Simplifier.make_simproc \<^context> "to_pred"
{lhss = [anyt],
proc = fn _ => fn ctxt => fn ct =>
lookup_rule (Proof_Context.theory_of ctxt)
--- a/src/HOL/Tools/int_arith.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/int_arith.ML Fri Jan 04 23:22:53 2019 +0100
@@ -23,7 +23,7 @@
val zeroth = Thm.symmetric (mk_meta_eq @{thm of_int_0});
val zero_to_of_int_zero_simproc =
- Simplifier.make_simproc @{context} "zero_to_of_int_zero_simproc"
+ Simplifier.make_simproc \<^context> "zero_to_of_int_zero_simproc"
{lhss = [\<^term>\<open>0::'a::ring\<close>],
proc = fn _ => fn ctxt => fn ct =>
let val T = Thm.ctyp_of_cterm ct in
@@ -34,7 +34,7 @@
val oneth = Thm.symmetric (mk_meta_eq @{thm of_int_1});
val one_to_of_int_one_simproc =
- Simplifier.make_simproc @{context} "one_to_of_int_one_simproc"
+ Simplifier.make_simproc \<^context> "one_to_of_int_one_simproc"
{lhss = [\<^term>\<open>1::'a::ring_1\<close>],
proc = fn _ => fn ctxt => fn ct =>
let val T = Thm.ctyp_of_cterm ct in
@@ -53,7 +53,7 @@
| check _ = false;
val conv_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps
((map (fn th => th RS sym) [@{thm of_int_add}, @{thm of_int_mult},
@{thm of_int_diff}, @{thm of_int_minus}])@
@@ -61,7 +61,7 @@
addsimprocs [zero_to_of_int_zero_simproc,one_to_of_int_one_simproc]);
val zero_one_idom_simproc =
- Simplifier.make_simproc @{context} "zero_one_idom_simproc"
+ Simplifier.make_simproc \<^context> "zero_one_idom_simproc"
{lhss =
[\<^term>\<open>(x::'a::ring_char_0) = y\<close>,
\<^term>\<open>(x::'a::linordered_idom) < y\<close>,
--- a/src/HOL/Tools/lambda_lifting.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/lambda_lifting.ML Fri Jan 04 23:22:53 2019 +0100
@@ -60,8 +60,8 @@
fun init ctxt = (Termtab.empty, ctxt)
-fun is_quantifier (Const (@{const_name All}, _)) = true
- | is_quantifier (Const (@{const_name Ex}, _)) = true
+fun is_quantifier (Const (\<^const_name>\<open>All\<close>, _)) = true
+ | is_quantifier (Const (\<^const_name>\<open>Ex\<close>, _)) = true
| is_quantifier _ = false
fun lift_lambdas1 is_binder basename =
--- a/src/HOL/Tools/lin_arith.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/lin_arith.ML Fri Jan 04 23:22:53 2019 +0100
@@ -869,12 +869,12 @@
lessD = lessD,
neqE = map Thm.trim_context @{thms linorder_neqE_nat linorder_neqE_linordered_idom} @ neqE,
simpset =
- put_simpset HOL_basic_ss @{context} |> Simplifier.add_cong @{thm if_weak_cong} |> simpset_of,
+ put_simpset HOL_basic_ss \<^context> |> Simplifier.add_cong @{thm if_weak_cong} |> simpset_of,
number_of = number_of});
(* FIXME !?? *)
fun add_arith_facts ctxt =
- Simplifier.add_prems (rev (Named_Theorems.get ctxt @{named_theorems arith})) ctxt;
+ Simplifier.add_prems (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>arith\<close>)) ctxt;
val simproc = add_arith_facts #> Fast_Arith.lin_arith_simproc;
@@ -969,7 +969,7 @@
METHOD (fn facts =>
HEADGOAL
(Method.insert_tac ctxt
- (rev (Named_Theorems.get ctxt @{named_theorems arith}) @ facts)
+ (rev (Named_Theorems.get ctxt \<^named_theorems>\<open>arith\<close>) @ facts)
THEN' tac ctxt)))) "linear arithmetic" #>
Arith_Data.add_tactic "linear arithmetic" tac;
--- a/src/HOL/Tools/literal.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/literal.ML Fri Jan 04 23:22:53 2019 +0100
@@ -14,35 +14,35 @@
datatype character = datatype String_Syntax.character;
-fun mk_literal_syntax [] = Syntax.const @{const_syntax String.empty_literal}
+fun mk_literal_syntax [] = Syntax.const \<^const_syntax>\<open>String.empty_literal\<close>
| mk_literal_syntax (c :: cs) =
- list_comb (Syntax.const @{const_syntax String.Literal}, String_Syntax.mk_bits_syntax 7 c)
+ list_comb (Syntax.const \<^const_syntax>\<open>String.Literal\<close>, String_Syntax.mk_bits_syntax 7 c)
$ mk_literal_syntax cs;
val dest_literal_syntax =
let
- fun dest (Const (@{const_syntax String.empty_literal}, _)) = []
- | dest (Const (@{const_syntax String.Literal}, _) $ b0 $ b1 $ b2 $ b3 $ b4 $ b5 $ b6 $ t) =
+ fun dest (Const (\<^const_syntax>\<open>String.empty_literal\<close>, _)) = []
+ | dest (Const (\<^const_syntax>\<open>String.Literal\<close>, _) $ b0 $ b1 $ b2 $ b3 $ b4 $ b5 $ b6 $ t) =
String_Syntax.classify_character (String_Syntax.dest_bits_syntax [b0, b1, b2, b3, b4, b5, b6]) :: dest t
| dest t = raise Match;
in dest end;
-fun ascii_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] =
+fun ascii_tr [(c as Const (\<^syntax_const>\<open>_constrain\<close>, _)) $ t $ u] =
c $ ascii_tr [t] $ u
| ascii_tr [Const (num, _)] =
(mk_literal_syntax o single o (fn n => n mod 128) o #value o Lexicon.read_num) num
| ascii_tr ts = raise TERM ("ascii_tr", ts);
-fun literal_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] =
+fun literal_tr [(c as Const (\<^syntax_const>\<open>_constrain\<close>, _)) $ t $ u] =
c $ literal_tr [t] $ u
| literal_tr [Free (str, _)] =
(mk_literal_syntax o map String_Syntax.ascii_ord_of o String_Syntax.plain_strings_of) str
| literal_tr ts = raise TERM ("literal_tr", ts);
-fun ascii k = Syntax.const @{syntax_const "_Ascii"}
+fun ascii k = Syntax.const \<^syntax_const>\<open>_Ascii\<close>
$ Syntax.free (String_Syntax.hex k);
-fun literal cs = Syntax.const @{syntax_const "_Literal"}
+fun literal cs = Syntax.const \<^syntax_const>\<open>_Literal\<close>
$ Syntax.const (Lexicon.implode_str cs);
fun empty_literal_tr' _ = literal [];
@@ -50,7 +50,7 @@
fun literal_tr' [b0, b1, b2, b3, b4, b5, b6, t] =
let
val cs =
- dest_literal_syntax (list_comb (Syntax.const @{const_syntax String.Literal}, [b0, b1, b2, b3, b4, b5, b6, t]))
+ dest_literal_syntax (list_comb (Syntax.const \<^const_syntax>\<open>String.Literal\<close>, [b0, b1, b2, b3, b4, b5, b6, t]))
fun is_printable (Char _) = true
| is_printable (Ord _) = false;
fun the_char (Char c) = c;
@@ -78,8 +78,8 @@
| SOME ys => SOME (y :: ys)))
in Option.map g o mapp end;
-fun implode_bit (IConst { sym = Code_Symbol.Constant @{const_name False}, ... }) = SOME 0
- | implode_bit (IConst { sym = Code_Symbol.Constant @{const_name True}, ... }) = SOME 1
+fun implode_bit (IConst { sym = Code_Symbol.Constant \<^const_name>\<open>False\<close>, ... }) = SOME 0
+ | implode_bit (IConst { sym = Code_Symbol.Constant \<^const_name>\<open>True\<close>, ... }) = SOME 1
| implode_bit _ = NONE
fun implode_ascii (b0, b1, b2, b3, b4, b5, b6) =
@@ -87,14 +87,14 @@
fun implode_literal b0 b1 b2 b3 b4 b5 b6 t =
let
- fun dest_literal (IConst { sym = Code_Symbol.Constant @{const_name String.Literal}, ... }
+ fun dest_literal (IConst { sym = Code_Symbol.Constant \<^const_name>\<open>String.Literal\<close>, ... }
`$ b0 `$ b1 `$ b2 `$ b3 `$ b4 `$ b5 `$ b6 `$ t) = SOME ((b0, b1, b2, b3, b4, b5, b6), t)
| dest_literal _ = NONE;
val (bss', t') = Code_Thingol.unfoldr dest_literal t;
val bss = (b0, b1, b2, b3, b4, b5, b6) :: bss';
in
case t' of
- IConst { sym = Code_Symbol.Constant @{const_name String.zero_literal_inst.zero_literal}, ... }
+ IConst { sym = Code_Symbol.Constant \<^const_name>\<open>String.zero_literal_inst.zero_literal\<close>, ... }
=> map_partial implode implode_ascii bss
| _ => NONE
end;
@@ -107,17 +107,17 @@
| NONE => Code_Printer.eqn_error thy thm "Illegal string literal expression";
in
thy
- |> Code_Target.set_printings (Code_Symbol.Constant (@{const_name String.Literal},
+ |> Code_Target.set_printings (Code_Symbol.Constant (\<^const_name>\<open>String.Literal\<close>,
[(target, SOME (Code_Printer.complex_const_syntax (8, pretty)))]))
end;
val _ =
Theory.setup
(Sign.parse_translation
- [(@{syntax_const "_Ascii"}, K ascii_tr),
- (@{syntax_const "_Literal"}, K literal_tr)] #>
+ [(\<^syntax_const>\<open>_Ascii\<close>, K ascii_tr),
+ (\<^syntax_const>\<open>_Literal\<close>, K literal_tr)] #>
Sign.print_translation
- [(@{const_syntax String.Literal}, K literal_tr'),
- (@{const_syntax String.empty_literal}, K empty_literal_tr')]);
+ [(\<^const_syntax>\<open>String.Literal\<close>, K literal_tr'),
+ (\<^const_syntax>\<open>String.empty_literal\<close>, K empty_literal_tr')]);
end
--- a/src/HOL/Tools/nat_numeral_simprocs.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/nat_numeral_simprocs.ML Fri Jan 04 23:22:53 2019 +0100
@@ -28,7 +28,7 @@
(*Maps n to #n for n = 1, 2*)
val numeral_syms = [@{thm numeral_One} RS sym, @{thm numeral_2_eq_2} RS sym];
val numeral_sym_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps numeral_syms);
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps numeral_syms);
(*Utilities*)
@@ -45,7 +45,7 @@
val long_mk_sum = Arith_Data.long_mk_sum HOLogic.natT;
-val dest_plus = HOLogic.dest_bin @{const_name Groups.plus} HOLogic.natT;
+val dest_plus = HOLogic.dest_bin \<^const_name>\<open>Groups.plus\<close> HOLogic.natT;
(** Other simproc items **)
@@ -63,14 +63,14 @@
(*** CancelNumerals simprocs ***)
val one = mk_number 1;
-val mk_times = HOLogic.mk_binop @{const_name Groups.times};
+val mk_times = HOLogic.mk_binop \<^const_name>\<open>Groups.times\<close>;
fun mk_prod [] = one
| mk_prod [t] = t
| mk_prod (t :: ts) = if t = one then mk_prod ts
else mk_times (t, mk_prod ts);
-val dest_times = HOLogic.dest_bin @{const_name Groups.times} HOLogic.natT;
+val dest_times = HOLogic.dest_bin \<^const_name>\<open>Groups.times\<close> HOLogic.natT;
fun dest_prod t =
let val (t,u) = dest_times t
@@ -99,14 +99,14 @@
(*Split up a sum into the list of its constituent terms, on the way removing any
Sucs and counting them.*)
-fun dest_Suc_sum (Const (@{const_name Suc}, _) $ t, (k,ts)) = dest_Suc_sum (t, (k+1,ts))
+fun dest_Suc_sum (Const (\<^const_name>\<open>Suc\<close>, _) $ t, (k,ts)) = dest_Suc_sum (t, (k+1,ts))
| dest_Suc_sum (t, (k,ts)) =
let val (t1,t2) = dest_plus t
in dest_Suc_sum (t1, dest_Suc_sum (t2, (k,ts))) end
handle TERM _ => (k, t::ts);
(*Code for testing whether numerals are already used in the goal*)
-fun is_numeral (Const(@{const_name Num.numeral}, _) $ w) = true
+fun is_numeral (Const(\<^const_name>\<open>Num.numeral\<close>, _) $ w) = true
| is_numeral _ = false;
fun prod_has_numeral t = exists is_numeral (dest_prod t);
@@ -126,7 +126,7 @@
(* FIXME !? *)
-val rename_numerals = simplify (put_simpset numeral_sym_ss @{context}) o Thm.transfer @{theory};
+val rename_numerals = simplify (put_simpset numeral_sym_ss \<^context>) o Thm.transfer \<^theory>;
(*Simplify 1*n and n*1 to n*)
val add_0s = map rename_numerals [@{thm Nat.add_0}, @{thm Nat.add_0_right}];
@@ -157,18 +157,18 @@
val trans_tac = Numeral_Simprocs.trans_tac
val norm_ss1 =
- simpset_of (put_simpset Numeral_Simprocs.num_ss @{context}
+ simpset_of (put_simpset Numeral_Simprocs.num_ss \<^context>
addsimps numeral_syms @ add_0s @ mult_1s @
[@{thm Suc_eq_plus1_left}] @ @{thms ac_simps})
val norm_ss2 =
- simpset_of (put_simpset Numeral_Simprocs.num_ss @{context}
+ simpset_of (put_simpset Numeral_Simprocs.num_ss \<^context>
addsimps bin_simps @ @{thms ac_simps} @ @{thms ac_simps})
fun norm_tac ctxt =
ALLGOALS (simp_tac (put_simpset norm_ss1 ctxt))
THEN ALLGOALS (simp_tac (put_simpset norm_ss2 ctxt))
val numeral_simp_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps add_0s @ bin_simps);
fun numeral_simp_tac ctxt =
ALLGOALS (simp_tac (put_simpset numeral_simp_ss ctxt));
@@ -179,31 +179,31 @@
structure EqCancelNumerals = CancelNumeralsFun
(open CancelNumeralsCommon
val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin @{const_name HOL.eq} HOLogic.natT
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>HOL.eq\<close> HOLogic.natT
val bal_add1 = @{thm nat_eq_add_iff1} RS trans
val bal_add2 = @{thm nat_eq_add_iff2} RS trans
);
structure LessCancelNumerals = CancelNumeralsFun
(open CancelNumeralsCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} HOLogic.natT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less\<close> HOLogic.natT
val bal_add1 = @{thm nat_less_add_iff1} RS trans
val bal_add2 = @{thm nat_less_add_iff2} RS trans
);
structure LeCancelNumerals = CancelNumeralsFun
(open CancelNumeralsCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} HOLogic.natT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less_eq\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less_eq\<close> HOLogic.natT
val bal_add1 = @{thm nat_le_add_iff1} RS trans
val bal_add2 = @{thm nat_le_add_iff2} RS trans
);
structure DiffCancelNumerals = CancelNumeralsFun
(open CancelNumeralsCommon
- val mk_bal = HOLogic.mk_binop @{const_name Groups.minus}
- val dest_bal = HOLogic.dest_bin @{const_name Groups.minus} HOLogic.natT
+ val mk_bal = HOLogic.mk_binop \<^const_name>\<open>Groups.minus\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Groups.minus\<close> HOLogic.natT
val bal_add1 = @{thm nat_diff_add_eq1} RS trans
val bal_add2 = @{thm nat_diff_add_eq2} RS trans
);
@@ -230,17 +230,17 @@
val trans_tac = Numeral_Simprocs.trans_tac
val norm_ss1 =
- simpset_of (put_simpset Numeral_Simprocs.num_ss @{context}
+ simpset_of (put_simpset Numeral_Simprocs.num_ss \<^context>
addsimps numeral_syms @ add_0s @ mult_1s @ [@{thm Suc_eq_plus1}] @ @{thms ac_simps})
val norm_ss2 =
- simpset_of (put_simpset Numeral_Simprocs.num_ss @{context}
+ simpset_of (put_simpset Numeral_Simprocs.num_ss \<^context>
addsimps bin_simps @ @{thms ac_simps} @ @{thms ac_simps})
fun norm_tac ctxt =
ALLGOALS (simp_tac (put_simpset norm_ss1 ctxt))
THEN ALLGOALS (simp_tac (put_simpset norm_ss2 ctxt))
val numeral_simp_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps add_0s @ bin_simps);
fun numeral_simp_tac ctxt =
ALLGOALS (simp_tac (put_simpset numeral_simp_ss ctxt))
@@ -261,17 +261,17 @@
val trans_tac = Numeral_Simprocs.trans_tac
val norm_ss1 =
- simpset_of (put_simpset Numeral_Simprocs.num_ss @{context}
+ simpset_of (put_simpset Numeral_Simprocs.num_ss \<^context>
addsimps numeral_syms @ add_0s @ mult_1s @ [@{thm Suc_eq_plus1_left}] @ @{thms ac_simps})
val norm_ss2 =
- simpset_of (put_simpset Numeral_Simprocs.num_ss @{context}
+ simpset_of (put_simpset Numeral_Simprocs.num_ss \<^context>
addsimps bin_simps @ @{thms ac_simps} @ @{thms ac_simps})
fun norm_tac ctxt =
ALLGOALS (simp_tac (put_simpset norm_ss1 ctxt))
THEN ALLGOALS (simp_tac (put_simpset norm_ss2 ctxt))
val numeral_simp_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps bin_simps)
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps bin_simps)
fun numeral_simp_tac ctxt =
ALLGOALS (simp_tac (put_simpset numeral_simp_ss ctxt))
val simplify_meta_eq = simplify_meta_eq
@@ -280,16 +280,16 @@
structure DivCancelNumeralFactor = CancelNumeralFactorFun
(open CancelNumeralFactorCommon
- val mk_bal = HOLogic.mk_binop @{const_name Rings.divide}
- val dest_bal = HOLogic.dest_bin @{const_name Rings.divide} HOLogic.natT
+ val mk_bal = HOLogic.mk_binop \<^const_name>\<open>Rings.divide\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Rings.divide\<close> HOLogic.natT
val cancel = @{thm nat_mult_div_cancel1} RS trans
val neg_exchanges = false
);
structure DvdCancelNumeralFactor = CancelNumeralFactorFun
(open CancelNumeralFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Rings.dvd}
- val dest_bal = HOLogic.dest_bin @{const_name Rings.dvd} HOLogic.natT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Rings.dvd\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Rings.dvd\<close> HOLogic.natT
val cancel = @{thm nat_mult_dvd_cancel1} RS trans
val neg_exchanges = false
);
@@ -297,7 +297,7 @@
structure EqCancelNumeralFactor = CancelNumeralFactorFun
(open CancelNumeralFactorCommon
val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin @{const_name HOL.eq} HOLogic.natT
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>HOL.eq\<close> HOLogic.natT
val cancel = @{thm nat_mult_eq_cancel1} RS trans
val neg_exchanges = false
);
@@ -305,8 +305,8 @@
structure LessCancelNumeralFactor = CancelNumeralFactorFun
(
open CancelNumeralFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} HOLogic.natT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less\<close> HOLogic.natT
val cancel = @{thm nat_mult_less_cancel1} RS trans
val neg_exchanges = true
);
@@ -314,8 +314,8 @@
structure LeCancelNumeralFactor = CancelNumeralFactorFun
(
open CancelNumeralFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} HOLogic.natT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less_eq\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less_eq\<close> HOLogic.natT
val cancel = @{thm nat_mult_le_cancel1} RS trans
val neg_exchanges = true
)
@@ -356,7 +356,7 @@
val find_first = find_first_t []
val trans_tac = Numeral_Simprocs.trans_tac
val norm_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps mult_1s @ @{thms ac_simps})
fun norm_tac ctxt =
ALLGOALS (simp_tac (put_simpset norm_ss ctxt))
@@ -367,35 +367,35 @@
structure EqCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin @{const_name HOL.eq} HOLogic.natT
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>HOL.eq\<close> HOLogic.natT
fun simp_conv _ _ = SOME @{thm nat_mult_eq_cancel_disj}
);
structure LeCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} HOLogic.natT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less_eq\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less_eq\<close> HOLogic.natT
fun simp_conv _ _ = SOME @{thm nat_mult_le_cancel_disj}
);
structure LessCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} HOLogic.natT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less\<close> HOLogic.natT
fun simp_conv _ _ = SOME @{thm nat_mult_less_cancel_disj}
);
structure DivideCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
- val mk_bal = HOLogic.mk_binop @{const_name Rings.divide}
- val dest_bal = HOLogic.dest_bin @{const_name Rings.divide} HOLogic.natT
+ val mk_bal = HOLogic.mk_binop \<^const_name>\<open>Rings.divide\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Rings.divide\<close> HOLogic.natT
fun simp_conv _ _ = SOME @{thm nat_mult_div_cancel_disj}
);
structure DvdCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Rings.dvd}
- val dest_bal = HOLogic.dest_bin @{const_name Rings.dvd} HOLogic.natT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Rings.dvd\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Rings.dvd\<close> HOLogic.natT
fun simp_conv _ _ = SOME @{thm nat_mult_dvd_cancel_disj}
);
--- a/src/HOL/Tools/numeral.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/numeral.ML Fri Jan 04 23:22:53 2019 +0100
@@ -17,25 +17,25 @@
(* numeral *)
-fun dest_num_syntax (Const (@{const_syntax Num.Bit0}, _) $ t) = 2 * dest_num_syntax t
- | dest_num_syntax (Const (@{const_syntax Num.Bit1}, _) $ t) = 2 * dest_num_syntax t + 1
- | dest_num_syntax (Const (@{const_syntax Num.One}, _)) = 1;
+fun dest_num_syntax (Const (\<^const_syntax>\<open>Num.Bit0\<close>, _) $ t) = 2 * dest_num_syntax t
+ | dest_num_syntax (Const (\<^const_syntax>\<open>Num.Bit1\<close>, _) $ t) = 2 * dest_num_syntax t + 1
+ | dest_num_syntax (Const (\<^const_syntax>\<open>Num.One\<close>, _)) = 1;
fun mk_num_syntax n =
if n > 0 then
(case IntInf.quotRem (n, 2) of
- (0, 1) => Syntax.const @{const_syntax One}
- | (n, 0) => Syntax.const @{const_syntax Bit0} $ mk_num_syntax n
- | (n, 1) => Syntax.const @{const_syntax Bit1} $ mk_num_syntax n)
+ (0, 1) => Syntax.const \<^const_syntax>\<open>One\<close>
+ | (n, 0) => Syntax.const \<^const_syntax>\<open>Bit0\<close> $ mk_num_syntax n
+ | (n, 1) => Syntax.const \<^const_syntax>\<open>Bit1\<close> $ mk_num_syntax n)
else raise Match
-fun mk_cbit 0 = @{cterm "Num.Bit0"}
- | mk_cbit 1 = @{cterm "Num.Bit1"}
+fun mk_cbit 0 = \<^cterm>\<open>Num.Bit0\<close>
+ | mk_cbit 1 = \<^cterm>\<open>Num.Bit1\<close>
| mk_cbit _ = raise CTERM ("mk_cbit", []);
fun mk_cnumeral i =
let
- fun mk 1 = @{cterm "Num.One"}
+ fun mk 1 = \<^cterm>\<open>Num.One\<close>
| mk i =
let val (q, r) = Integer.div_mod i 2 in
Thm.apply (mk_cbit r) (mk q)
@@ -49,20 +49,20 @@
local
-val cterm_of = Thm.cterm_of @{context};
+val cterm_of = Thm.cterm_of \<^context>;
fun tvar S = (("'a", 0), S);
-val zero_tvar = tvar @{sort zero};
-val zero = cterm_of (Const (@{const_name zero_class.zero}, TVar zero_tvar));
+val zero_tvar = tvar \<^sort>\<open>zero\<close>;
+val zero = cterm_of (Const (\<^const_name>\<open>zero_class.zero\<close>, TVar zero_tvar));
-val one_tvar = tvar @{sort one};
-val one = cterm_of (Const (@{const_name one_class.one}, TVar one_tvar));
+val one_tvar = tvar \<^sort>\<open>one\<close>;
+val one = cterm_of (Const (\<^const_name>\<open>one_class.one\<close>, TVar one_tvar));
-val numeral_tvar = tvar @{sort numeral};
-val numeral = cterm_of (Const (@{const_name numeral}, @{typ num} --> TVar numeral_tvar));
+val numeral_tvar = tvar \<^sort>\<open>numeral\<close>;
+val numeral = cterm_of (Const (\<^const_name>\<open>numeral\<close>, \<^typ>\<open>num\<close> --> TVar numeral_tvar));
-val uminus_tvar = tvar @{sort uminus};
-val uminus = cterm_of (Const (@{const_name uminus}, TVar uminus_tvar --> TVar uminus_tvar));
+val uminus_tvar = tvar \<^sort>\<open>uminus\<close>;
+val uminus = cterm_of (Const (\<^const_name>\<open>uminus\<close>, TVar uminus_tvar --> TVar uminus_tvar));
fun instT T v = Thm.instantiate_cterm ([(v, T)], []);
@@ -80,21 +80,21 @@
end;
fun mk_number_syntax n =
- if n = 0 then Syntax.const @{const_syntax Groups.zero}
- else if n = 1 then Syntax.const @{const_syntax Groups.one}
- else Syntax.const @{const_syntax numeral} $ mk_num_syntax n;
+ if n = 0 then Syntax.const \<^const_syntax>\<open>Groups.zero\<close>
+ else if n = 1 then Syntax.const \<^const_syntax>\<open>Groups.one\<close>
+ else Syntax.const \<^const_syntax>\<open>numeral\<close> $ mk_num_syntax n;
(* code generator *)
local open Basic_Code_Thingol in
-fun dest_num_code (IConst { sym = Code_Symbol.Constant @{const_name Num.One}, ... }) = SOME 1
- | dest_num_code (IConst { sym = Code_Symbol.Constant @{const_name Num.Bit0}, ... } `$ t) =
+fun dest_num_code (IConst { sym = Code_Symbol.Constant \<^const_name>\<open>Num.One\<close>, ... }) = SOME 1
+ | dest_num_code (IConst { sym = Code_Symbol.Constant \<^const_name>\<open>Num.Bit0\<close>, ... } `$ t) =
(case dest_num_code t of
SOME n => SOME (2 * n)
| _ => NONE)
- | dest_num_code (IConst { sym = Code_Symbol.Constant @{const_name Num.Bit1}, ... } `$ t) =
+ | dest_num_code (IConst { sym = Code_Symbol.Constant \<^const_name>\<open>Num.Bit1\<close>, ... } `$ t) =
(case dest_num_code t of
SOME n => SOME (2 * n + 1)
| _ => NONE)
--- a/src/HOL/Tools/numeral_simprocs.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/numeral_simprocs.ML Fri Jan 04 23:22:53 2019 +0100
@@ -51,9 +51,9 @@
val long_mk_sum = Arith_Data.long_mk_sum;
val dest_sum = Arith_Data.dest_sum;
-val mk_times = HOLogic.mk_binop @{const_name Groups.times};
+val mk_times = HOLogic.mk_binop \<^const_name>\<open>Groups.times\<close>;
-fun one_of T = Const(@{const_name Groups.one}, T);
+fun one_of T = Const(\<^const_name>\<open>Groups.one\<close>, T);
(* build product with trailing 1 rather than Numeral 1 in order to avoid the
unnecessary restriction to type class number_ring
@@ -71,7 +71,7 @@
fun long_mk_prod T [] = one_of T
| long_mk_prod T (t :: ts) = mk_times (t, mk_prod T ts);
-val dest_times = HOLogic.dest_bin @{const_name Groups.times} dummyT;
+val dest_times = HOLogic.dest_bin \<^const_name>\<open>Groups.times\<close> dummyT;
fun dest_prod t =
let val (t,u) = dest_times t
@@ -87,7 +87,7 @@
fun mk_coeff (k, t) = mk_times (mk_number (Term.fastype_of t) k, t);
(*Express t as a product of (possibly) a numeral with other sorted terms*)
-fun dest_coeff sign (Const (@{const_name Groups.uminus}, _) $ t) = dest_coeff (~sign) t
+fun dest_coeff sign (Const (\<^const_name>\<open>Groups.uminus\<close>, _) $ t) = dest_coeff (~sign) t
| dest_coeff sign t =
let val ts = sort Term_Ord.term_ord (dest_prod t)
val (n, ts') = find_first_numeral [] ts
@@ -111,7 +111,7 @@
Fractions are reduced later by the cancel_numeral_factor simproc.*)
fun add_frac ((p1, q1), (p2, q2)) = (p1 * q2 + p2 * q1, q1 * q2);
-val mk_divide = HOLogic.mk_binop @{const_name Rings.divide};
+val mk_divide = HOLogic.mk_binop \<^const_name>\<open>Rings.divide\<close>;
(*Build term (p / q) * t*)
fun mk_fcoeff ((p, q), t) =
@@ -119,8 +119,8 @@
in mk_times (mk_divide (mk_number T p, mk_number T q), t) end;
(*Express t as a product of a fraction with other sorted terms*)
-fun dest_fcoeff sign (Const (@{const_name Groups.uminus}, _) $ t) = dest_fcoeff (~sign) t
- | dest_fcoeff sign (Const (@{const_name Rings.divide}, _) $ t $ u) =
+fun dest_fcoeff sign (Const (\<^const_name>\<open>Groups.uminus\<close>, _) $ t) = dest_fcoeff (~sign) t
+ | dest_fcoeff sign (Const (\<^const_name>\<open>Rings.divide\<close>, _) $ t $ u) =
let val (p, t') = dest_coeff sign t
val (q, u') = dest_coeff 1 u
in (mk_frac (p, q), mk_divide (t', u')) end
@@ -163,7 +163,7 @@
end;
val num_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} |> Simplifier.set_term_ord numterm_ord);
+ simpset_of (put_simpset HOL_basic_ss \<^context> |> Simplifier.set_term_ord numterm_ord);
(*Maps 1 to Numeral1 so that arithmetic isn't complicated by the abstract 1.*)
val numeral_syms = [@{thm numeral_One} RS sym];
@@ -222,16 +222,16 @@
[@{thm mult.assoc}, @{thm minus_mult_right}, @{thm minus_mult_commute}, @{thm numeral_times_minus_swap}];
val norm_ss1 =
- simpset_of (put_simpset num_ss @{context}
+ simpset_of (put_simpset num_ss \<^context>
addsimps numeral_syms @ add_0s @ mult_1s @
diff_simps @ minus_simps @ @{thms ac_simps})
val norm_ss2 =
- simpset_of (put_simpset num_ss @{context}
+ simpset_of (put_simpset num_ss \<^context>
addsimps non_add_simps @ mult_minus_simps)
val norm_ss3 =
- simpset_of (put_simpset num_ss @{context}
+ simpset_of (put_simpset num_ss \<^context>
addsimps minus_from_mult_simps @ @{thms ac_simps} @ @{thms ac_simps minus_mult_commute})
structure CancelNumeralsCommon =
@@ -249,7 +249,7 @@
THEN ALLGOALS (simp_tac (put_simpset norm_ss3 ctxt))
val numeral_simp_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps add_0s @ simps)
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps add_0s @ simps)
fun numeral_simp_tac ctxt =
ALLGOALS (simp_tac (put_simpset numeral_simp_ss ctxt))
val simplify_meta_eq = Arith_Data.simplify_meta_eq post_simps
@@ -259,23 +259,23 @@
structure EqCancelNumerals = CancelNumeralsFun
(open CancelNumeralsCommon
val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin @{const_name HOL.eq} dummyT
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>HOL.eq\<close> dummyT
val bal_add1 = @{thm eq_add_iff1} RS trans
val bal_add2 = @{thm eq_add_iff2} RS trans
);
structure LessCancelNumerals = CancelNumeralsFun
(open CancelNumeralsCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} dummyT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less\<close> dummyT
val bal_add1 = @{thm less_add_iff1} RS trans
val bal_add2 = @{thm less_add_iff2} RS trans
);
structure LeCancelNumerals = CancelNumeralsFun
(open CancelNumeralsCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} dummyT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less_eq\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less_eq\<close> dummyT
val bal_add1 = @{thm le_add_iff1} RS trans
val bal_add2 = @{thm le_add_iff2} RS trans
);
@@ -303,7 +303,7 @@
THEN ALLGOALS (simp_tac (put_simpset norm_ss3 ctxt))
val numeral_simp_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps add_0s @ simps)
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps add_0s @ simps)
fun numeral_simp_tac ctxt =
ALLGOALS (simp_tac (put_simpset numeral_simp_ss ctxt))
val simplify_meta_eq = Arith_Data.simplify_meta_eq post_simps
@@ -326,14 +326,14 @@
val trans_tac = trans_tac
val norm_ss1a =
- simpset_of (put_simpset norm_ss1 @{context} addsimps inverse_1s @ divide_simps)
+ simpset_of (put_simpset norm_ss1 \<^context> addsimps inverse_1s @ divide_simps)
fun norm_tac ctxt =
ALLGOALS (simp_tac (put_simpset norm_ss1a ctxt))
THEN ALLGOALS (simp_tac (put_simpset norm_ss2 ctxt))
THEN ALLGOALS (simp_tac (put_simpset norm_ss3 ctxt))
val numeral_simp_ss =
- simpset_of (put_simpset HOL_basic_ss @{context}
+ simpset_of (put_simpset HOL_basic_ss \<^context>
addsimps add_0s @ simps @ [@{thm add_frac_eq}, @{thm not_False_eq_True}])
fun numeral_simp_tac ctxt =
ALLGOALS (simp_tac (put_simpset numeral_simp_ss ctxt))
@@ -353,7 +353,7 @@
structure Semiring_Times_Assoc_Data : ASSOC_FOLD_DATA =
struct
- val assoc_ss = simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms ac_simps minus_mult_commute})
+ val assoc_ss = simpset_of (put_simpset HOL_basic_ss \<^context> addsimps @{thms ac_simps minus_mult_commute})
val eq_reflection = eq_reflection
val is_numeral = can HOLogic.dest_number
end;
@@ -369,11 +369,11 @@
val trans_tac = trans_tac
val norm_ss1 =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps minus_from_mult_simps @ mult_1s)
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps minus_from_mult_simps @ mult_1s)
val norm_ss2 =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps simps @ mult_minus_simps)
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps simps @ mult_minus_simps)
val norm_ss3 =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms ac_simps minus_mult_commute numeral_times_minus_swap})
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps @{thms ac_simps minus_mult_commute numeral_times_minus_swap})
fun norm_tac ctxt =
ALLGOALS (simp_tac (put_simpset norm_ss1 ctxt))
THEN ALLGOALS (simp_tac (put_simpset norm_ss2 ctxt))
@@ -382,7 +382,7 @@
(* simp_thms are necessary because some of the cancellation rules below
(e.g. mult_less_cancel_left) introduce various logical connectives *)
val numeral_simp_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps simps @ @{thms simp_thms})
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps simps @ @{thms simp_thms})
fun numeral_simp_tac ctxt =
ALLGOALS (simp_tac (put_simpset numeral_simp_ss ctxt))
val simplify_meta_eq = Arith_Data.simplify_meta_eq
@@ -393,8 +393,8 @@
(*Version for semiring_div*)
structure DivCancelNumeralFactor = CancelNumeralFactorFun
(open CancelNumeralFactorCommon
- val mk_bal = HOLogic.mk_binop @{const_name Rings.divide}
- val dest_bal = HOLogic.dest_bin @{const_name Rings.divide} dummyT
+ val mk_bal = HOLogic.mk_binop \<^const_name>\<open>Rings.divide\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Rings.divide\<close> dummyT
val cancel = @{thm div_mult_mult1} RS trans
val neg_exchanges = false
)
@@ -402,8 +402,8 @@
(*Version for fields*)
structure DivideCancelNumeralFactor = CancelNumeralFactorFun
(open CancelNumeralFactorCommon
- val mk_bal = HOLogic.mk_binop @{const_name Rings.divide}
- val dest_bal = HOLogic.dest_bin @{const_name Rings.divide} dummyT
+ val mk_bal = HOLogic.mk_binop \<^const_name>\<open>Rings.divide\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Rings.divide\<close> dummyT
val cancel = @{thm mult_divide_mult_cancel_left} RS trans
val neg_exchanges = false
)
@@ -411,15 +411,15 @@
structure EqCancelNumeralFactor = CancelNumeralFactorFun
(open CancelNumeralFactorCommon
val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin @{const_name HOL.eq} dummyT
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>HOL.eq\<close> dummyT
val cancel = @{thm mult_cancel_left} RS trans
val neg_exchanges = false
)
structure LessCancelNumeralFactor = CancelNumeralFactorFun
(open CancelNumeralFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} dummyT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less\<close> dummyT
val cancel = @{thm mult_less_cancel_left} RS trans
val neg_exchanges = true
)
@@ -427,8 +427,8 @@
structure LeCancelNumeralFactor = CancelNumeralFactorFun
(
open CancelNumeralFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} dummyT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less_eq\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less_eq\<close> dummyT
val cancel = @{thm mult_le_cancel_left} RS trans
val neg_exchanges = true
)
@@ -440,21 +440,21 @@
val divide_cancel_numeral_factor = DivideCancelNumeralFactor.proc
val field_divide_cancel_numeral_factor =
- Simplifier.make_simproc @{context} "field_divide_cancel_numeral_factor"
+ Simplifier.make_simproc \<^context> "field_divide_cancel_numeral_factor"
{lhss =
- [@{term "((l::'a::field) * m) / n"},
- @{term "(l::'a::field) / (m * n)"},
- @{term "((numeral v)::'a::field) / (numeral w)"},
- @{term "((numeral v)::'a::field) / (- numeral w)"},
- @{term "((- numeral v)::'a::field) / (numeral w)"},
- @{term "((- numeral v)::'a::field) / (- numeral w)"}],
+ [\<^term>\<open>((l::'a::field) * m) / n\<close>,
+ \<^term>\<open>(l::'a::field) / (m * n)\<close>,
+ \<^term>\<open>((numeral v)::'a::field) / (numeral w)\<close>,
+ \<^term>\<open>((numeral v)::'a::field) / (- numeral w)\<close>,
+ \<^term>\<open>((- numeral v)::'a::field) / (numeral w)\<close>,
+ \<^term>\<open>((- numeral v)::'a::field) / (- numeral w)\<close>],
proc = K DivideCancelNumeralFactor.proc}
val field_cancel_numeral_factors =
- [Simplifier.make_simproc @{context} "field_eq_cancel_numeral_factor"
+ [Simplifier.make_simproc \<^context> "field_eq_cancel_numeral_factor"
{lhss =
- [@{term "(l::'a::field) * m = n"},
- @{term "(l::'a::field) = m * n"}],
+ [\<^term>\<open>(l::'a::field) * m = n\<close>,
+ \<^term>\<open>(l::'a::field) = m * n\<close>],
proc = K EqCancelNumeralFactor.proc},
field_divide_cancel_numeral_factor]
@@ -476,14 +476,14 @@
simplify_one ctxt (([th, cancel_th]) MRS trans);
local
- val Tp_Eq = Thm.reflexive (Thm.cterm_of @{theory_context HOL} HOLogic.Trueprop)
+ val Tp_Eq = Thm.reflexive (Thm.cterm_of \<^theory_context>\<open>HOL\<close> HOLogic.Trueprop)
fun Eq_True_elim Eq =
Thm.equal_elim (Thm.combination Tp_Eq (Thm.symmetric Eq)) @{thm TrueI}
in
fun sign_conv pos_th neg_th ctxt t =
let val T = fastype_of t;
- val zero = Const(@{const_name Groups.zero}, T);
- val less = Const(@{const_name Orderings.less}, [T,T] ---> HOLogic.boolT);
+ val zero = Const(\<^const_name>\<open>Groups.zero\<close>, T);
+ val less = Const(\<^const_name>\<open>Orderings.less\<close>, [T,T] ---> HOLogic.boolT);
val pos = less $ zero $ t and neg = less $ t $ zero
fun prove p =
SOME (Eq_True_elim (Simplifier.asm_rewrite ctxt (Thm.cterm_of ctxt p)))
@@ -505,7 +505,7 @@
val find_first = find_first_t []
val trans_tac = trans_tac
val norm_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps mult_1s @ @{thms ac_simps minus_mult_commute})
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps mult_1s @ @{thms ac_simps minus_mult_commute})
fun norm_tac ctxt =
ALLGOALS (simp_tac (put_simpset norm_ss ctxt))
val simplify_meta_eq = cancel_simplify_meta_eq
@@ -516,15 +516,15 @@
structure EqCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
val mk_bal = HOLogic.mk_eq
- val dest_bal = HOLogic.dest_bin @{const_name HOL.eq} dummyT
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>HOL.eq\<close> dummyT
fun simp_conv _ _ = SOME @{thm mult_cancel_left}
);
(*for ordered rings*)
structure LeCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less_eq}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less_eq} dummyT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less_eq\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less_eq\<close> dummyT
val simp_conv = sign_conv
@{thm mult_le_cancel_left_pos} @{thm mult_le_cancel_left_neg}
);
@@ -532,8 +532,8 @@
(*for ordered rings*)
structure LessCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Orderings.less}
- val dest_bal = HOLogic.dest_bin @{const_name Orderings.less} dummyT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Orderings.less\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Orderings.less\<close> dummyT
val simp_conv = sign_conv
@{thm mult_less_cancel_left_pos} @{thm mult_less_cancel_left_neg}
);
@@ -541,31 +541,31 @@
(*for semirings with division*)
structure DivCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
- val mk_bal = HOLogic.mk_binop @{const_name Rings.divide}
- val dest_bal = HOLogic.dest_bin @{const_name Rings.divide} dummyT
+ val mk_bal = HOLogic.mk_binop \<^const_name>\<open>Rings.divide\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Rings.divide\<close> dummyT
fun simp_conv _ _ = SOME @{thm div_mult_mult1_if}
);
structure ModCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
- val mk_bal = HOLogic.mk_binop @{const_name modulo}
- val dest_bal = HOLogic.dest_bin @{const_name modulo} dummyT
+ val mk_bal = HOLogic.mk_binop \<^const_name>\<open>modulo\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>modulo\<close> dummyT
fun simp_conv _ _ = SOME @{thm mod_mult_mult1}
);
(*for idoms*)
structure DvdCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
- val mk_bal = HOLogic.mk_binrel @{const_name Rings.dvd}
- val dest_bal = HOLogic.dest_bin @{const_name Rings.dvd} dummyT
+ val mk_bal = HOLogic.mk_binrel \<^const_name>\<open>Rings.dvd\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Rings.dvd\<close> dummyT
fun simp_conv _ _ = SOME @{thm dvd_mult_cancel_left}
);
(*Version for all fields, including unordered ones (type complex).*)
structure DivideCancelFactor = ExtractCommonTermFun
(open CancelFactorCommon
- val mk_bal = HOLogic.mk_binop @{const_name Rings.divide}
- val dest_bal = HOLogic.dest_bin @{const_name Rings.divide} dummyT
+ val mk_bal = HOLogic.mk_binop \<^const_name>\<open>Rings.divide\<close>
+ val dest_bal = HOLogic.dest_bin \<^const_name>\<open>Rings.divide\<close> dummyT
fun simp_conv _ _ = SOME @{thm mult_divide_mult_cancel_left_if}
);
@@ -579,14 +579,14 @@
local
-val cterm_of = Thm.cterm_of @{context};
+val cterm_of = Thm.cterm_of \<^context>;
fun tvar S = (("'a", 0), S);
-val zero_tvar = tvar @{sort zero};
-val zero = cterm_of (Const (@{const_name zero_class.zero}, TVar zero_tvar));
+val zero_tvar = tvar \<^sort>\<open>zero\<close>;
+val zero = cterm_of (Const (\<^const_name>\<open>zero_class.zero\<close>, TVar zero_tvar));
-val type_tvar = tvar @{sort type};
-val geq = cterm_of (Const (@{const_name HOL.eq}, TVar type_tvar --> TVar type_tvar --> @{typ bool}));
+val type_tvar = tvar \<^sort>\<open>type\<close>;
+val geq = cterm_of (Const (\<^const_name>\<open>HOL.eq\<close>, TVar type_tvar --> TVar type_tvar --> \<^typ>\<open>bool\<close>));
val add_frac_eq = mk_meta_eq @{thm "add_frac_eq"}
val add_frac_num = mk_meta_eq @{thm "add_frac_num"}
@@ -598,7 +598,7 @@
val eq = Thm.instantiate_cterm ([(type_tvar, T)], []) geq
val th =
Simplifier.rewrite (ctxt addsimps @{thms simp_thms})
- (Thm.apply @{cterm "Trueprop"} (Thm.apply @{cterm "Not"}
+ (Thm.apply \<^cterm>\<open>Trueprop\<close> (Thm.apply \<^cterm>\<open>Not\<close>
(Thm.apply (Thm.apply eq t) z)))
in Thm.equal_elim (Thm.symmetric th) TrueI end
@@ -618,13 +618,13 @@
val (l,r) = Thm.dest_binop ct
val T = Thm.ctyp_of_cterm l
in (case (Thm.term_of l, Thm.term_of r) of
- (Const(@{const_name Rings.divide},_)$_$_, _) =>
+ (Const(\<^const_name>\<open>Rings.divide\<close>,_)$_$_, _) =>
let val (x,y) = Thm.dest_binop l val z = r
val _ = map (HOLogic.dest_number o Thm.term_of) [x,y,z]
val ynz = prove_nz ctxt T y
in SOME (Thm.implies_elim (Thm.instantiate' [SOME T] (map SOME [y,x,z]) add_frac_num) ynz)
end
- | (_, Const (@{const_name Rings.divide},_)$_$_) =>
+ | (_, Const (\<^const_name>\<open>Rings.divide\<close>,_)$_$_) =>
let val (x,y) = Thm.dest_binop r val z = l
val _ = map (HOLogic.dest_number o Thm.term_of) [x,y,z]
val ynz = prove_nz ctxt T y
@@ -634,49 +634,49 @@
end
handle CTERM _ => NONE | TERM _ => NONE | THM _ => NONE
-fun is_number (Const(@{const_name Rings.divide},_)$a$b) = is_number a andalso is_number b
+fun is_number (Const(\<^const_name>\<open>Rings.divide\<close>,_)$a$b) = is_number a andalso is_number b
| is_number t = can HOLogic.dest_number t
val is_number = is_number o Thm.term_of
fun proc3 ctxt ct =
(case Thm.term_of ct of
- Const(@{const_name Orderings.less},_)$(Const(@{const_name Rings.divide},_)$_$_)$_ =>
+ Const(\<^const_name>\<open>Orderings.less\<close>,_)$(Const(\<^const_name>\<open>Rings.divide\<close>,_)$_$_)$_ =>
let
val ((a,b),c) = Thm.dest_binop ct |>> Thm.dest_binop
val _ = map is_number [a,b,c]
val T = Thm.ctyp_of_cterm c
val th = Thm.instantiate' [SOME T] (map SOME [a,b,c]) @{thm "divide_less_eq"}
in SOME (mk_meta_eq th) end
- | Const(@{const_name Orderings.less_eq},_)$(Const(@{const_name Rings.divide},_)$_$_)$_ =>
+ | Const(\<^const_name>\<open>Orderings.less_eq\<close>,_)$(Const(\<^const_name>\<open>Rings.divide\<close>,_)$_$_)$_ =>
let
val ((a,b),c) = Thm.dest_binop ct |>> Thm.dest_binop
val _ = map is_number [a,b,c]
val T = Thm.ctyp_of_cterm c
val th = Thm.instantiate' [SOME T] (map SOME [a,b,c]) @{thm "divide_le_eq"}
in SOME (mk_meta_eq th) end
- | Const(@{const_name HOL.eq},_)$(Const(@{const_name Rings.divide},_)$_$_)$_ =>
+ | Const(\<^const_name>\<open>HOL.eq\<close>,_)$(Const(\<^const_name>\<open>Rings.divide\<close>,_)$_$_)$_ =>
let
val ((a,b),c) = Thm.dest_binop ct |>> Thm.dest_binop
val _ = map is_number [a,b,c]
val T = Thm.ctyp_of_cterm c
val th = Thm.instantiate' [SOME T] (map SOME [a,b,c]) @{thm "divide_eq_eq"}
in SOME (mk_meta_eq th) end
- | Const(@{const_name Orderings.less},_)$_$(Const(@{const_name Rings.divide},_)$_$_) =>
+ | Const(\<^const_name>\<open>Orderings.less\<close>,_)$_$(Const(\<^const_name>\<open>Rings.divide\<close>,_)$_$_) =>
let
val (a,(b,c)) = Thm.dest_binop ct ||> Thm.dest_binop
val _ = map is_number [a,b,c]
val T = Thm.ctyp_of_cterm c
val th = Thm.instantiate' [SOME T] (map SOME [a,b,c]) @{thm "less_divide_eq"}
in SOME (mk_meta_eq th) end
- | Const(@{const_name Orderings.less_eq},_)$_$(Const(@{const_name Rings.divide},_)$_$_) =>
+ | Const(\<^const_name>\<open>Orderings.less_eq\<close>,_)$_$(Const(\<^const_name>\<open>Rings.divide\<close>,_)$_$_) =>
let
val (a,(b,c)) = Thm.dest_binop ct ||> Thm.dest_binop
val _ = map is_number [a,b,c]
val T = Thm.ctyp_of_cterm c
val th = Thm.instantiate' [SOME T] (map SOME [a,b,c]) @{thm "le_divide_eq"}
in SOME (mk_meta_eq th) end
- | Const(@{const_name HOL.eq},_)$_$(Const(@{const_name Rings.divide},_)$_$_) =>
+ | Const(\<^const_name>\<open>HOL.eq\<close>,_)$_$(Const(\<^const_name>\<open>Rings.divide\<close>,_)$_$_) =>
let
val (a,(b,c)) = Thm.dest_binop ct ||> Thm.dest_binop
val _ = map is_number [a,b,c]
@@ -686,24 +686,24 @@
| _ => NONE) handle TERM _ => NONE | CTERM _ => NONE | THM _ => NONE
val add_frac_frac_simproc =
- Simplifier.make_simproc @{context} "add_frac_frac_simproc"
- {lhss = [@{term "(x::'a::field) / y + (w::'a::field) / z"}],
+ Simplifier.make_simproc \<^context> "add_frac_frac_simproc"
+ {lhss = [\<^term>\<open>(x::'a::field) / y + (w::'a::field) / z\<close>],
proc = K proc}
val add_frac_num_simproc =
- Simplifier.make_simproc @{context} "add_frac_num_simproc"
- {lhss = [@{term "(x::'a::field) / y + z"}, @{term "z + (x::'a::field) / y"}],
+ Simplifier.make_simproc \<^context> "add_frac_num_simproc"
+ {lhss = [\<^term>\<open>(x::'a::field) / y + z\<close>, \<^term>\<open>z + (x::'a::field) / y\<close>],
proc = K proc2}
val ord_frac_simproc =
- Simplifier.make_simproc @{context} "ord_frac_simproc"
+ Simplifier.make_simproc \<^context> "ord_frac_simproc"
{lhss =
- [@{term "(a::'a::{field,ord}) / b < c"},
- @{term "(a::'a::{field,ord}) / b \<le> c"},
- @{term "c < (a::'a::{field,ord}) / b"},
- @{term "c \<le> (a::'a::{field,ord}) / b"},
- @{term "c = (a::'a::{field,ord}) / b"},
- @{term "(a::'a::{field, ord}) / b = c"}],
+ [\<^term>\<open>(a::'a::{field,ord}) / b < c\<close>,
+ \<^term>\<open>(a::'a::{field,ord}) / b \<le> c\<close>,
+ \<^term>\<open>c < (a::'a::{field,ord}) / b\<close>,
+ \<^term>\<open>c \<le> (a::'a::{field,ord}) / b\<close>,
+ \<^term>\<open>c = (a::'a::{field,ord}) / b\<close>,
+ \<^term>\<open>(a::'a::{field, ord}) / b = c\<close>],
proc = K proc3}
val ths =
@@ -722,7 +722,7 @@
val field_comp_ss =
simpset_of
- (put_simpset HOL_basic_ss @{context}
+ (put_simpset HOL_basic_ss \<^context>
addsimps @{thms "semiring_norm"}
addsimps ths addsimps @{thms simp_thms}
addsimprocs field_cancel_numeral_factors
--- a/src/HOL/Tools/prop_logic.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/prop_logic.ML Fri Jan 04 23:22:53 2019 +0100
@@ -350,17 +350,17 @@
next_idx_is_valid := true;
Unsynchronized.inc next_idx
)
- fun aux (Const (@{const_name True}, _)) table = (True, table)
- | aux (Const (@{const_name False}, _)) table = (False, table)
- | aux (Const (@{const_name Not}, _) $ x) table = apfst Not (aux x table)
- | aux (Const (@{const_name HOL.disj}, _) $ x $ y) table =
+ fun aux (Const (\<^const_name>\<open>True\<close>, _)) table = (True, table)
+ | aux (Const (\<^const_name>\<open>False\<close>, _)) table = (False, table)
+ | aux (Const (\<^const_name>\<open>Not\<close>, _) $ x) table = apfst Not (aux x table)
+ | aux (Const (\<^const_name>\<open>HOL.disj\<close>, _) $ x $ y) table =
let
val (fm1, table1) = aux x table
val (fm2, table2) = aux y table1
in
(Or (fm1, fm2), table2)
end
- | aux (Const (@{const_name HOL.conj}, _) $ x $ y) table =
+ | aux (Const (\<^const_name>\<open>HOL.conj\<close>, _) $ x $ y) table =
let
val (fm1, table1) = aux x table
val (fm2, table2) = aux y table1
@@ -390,8 +390,8 @@
(* Boolean variables in the formula, similar to 'prop_formula_of_term' *)
(* (but the other way round). *)
-fun term_of_prop_formula True = @{term True}
- | term_of_prop_formula False = @{term False}
+fun term_of_prop_formula True = \<^term>\<open>True\<close>
+ | term_of_prop_formula False = \<^term>\<open>False\<close>
| term_of_prop_formula (BoolVar i) = Free ("v" ^ string_of_int i, HOLogic.boolT)
| term_of_prop_formula (Not fm) = HOLogic.mk_not (term_of_prop_formula fm)
| term_of_prop_formula (Or (fm1, fm2)) =
--- a/src/HOL/Tools/record.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/record.ML Fri Jan 04 23:22:53 2019 +0100
@@ -1062,7 +1062,7 @@
subrecord.
*)
val simproc =
- Simplifier.make_simproc @{context} "record"
+ Simplifier.make_simproc \<^context> "record"
{lhss = [\<^term>\<open>x::'a::{}\<close>],
proc = fn _ => fn ctxt => fn ct =>
let
@@ -1146,7 +1146,7 @@
we omit considering further updates if doing so would introduce
both a more update and an update to a field within it.*)
val upd_simproc =
- Simplifier.make_simproc @{context} "record_upd"
+ Simplifier.make_simproc \<^context> "record_upd"
{lhss = [\<^term>\<open>x::'a::{}\<close>],
proc = fn _ => fn ctxt => fn ct =>
let
@@ -1269,7 +1269,7 @@
Complexity: #components * #updates #updates
*)
val eq_simproc =
- Simplifier.make_simproc @{context} "record_eq"
+ Simplifier.make_simproc \<^context> "record_eq"
{lhss = [\<^term>\<open>r = s\<close>],
proc = fn _ => fn ctxt => fn ct =>
(case Thm.term_of ct of
@@ -1291,7 +1291,7 @@
P t = ~1: completely split
P t > 0: split up to given bound of record extensions.*)
fun split_simproc P =
- Simplifier.make_simproc @{context} "record_split"
+ Simplifier.make_simproc \<^context> "record_split"
{lhss = [\<^term>\<open>x::'a::{}\<close>],
proc = fn _ => fn ctxt => fn ct =>
(case Thm.term_of ct of
@@ -1320,7 +1320,7 @@
| _ => NONE)};
val ex_sel_eq_simproc =
- Simplifier.make_simproc @{context} "ex_sel_eq"
+ Simplifier.make_simproc \<^context> "ex_sel_eq"
{lhss = [\<^term>\<open>Ex t\<close>],
proc = fn _ => fn ctxt => fn ct =>
let
--- a/src/HOL/Tools/reflection.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/reflection.ML Fri Jan 04 23:22:53 2019 +0100
@@ -66,10 +66,10 @@
val del_correctness_thm = Thm.declaration_attribute (Data.map o apsnd o Thm.del_thm);
val _ = Theory.setup
- (Attrib.setup @{binding reify}
+ (Attrib.setup \<^binding>\<open>reify\<close>
(Attrib.add_del add_reification_eq del_reification_eq)
"declare reification equations" #>
- Attrib.setup @{binding reflection}
+ Attrib.setup \<^binding>\<open>reflection\<close>
(Attrib.add_del add_correctness_thm del_correctness_thm)
"declare reflection correctness theorems");
--- a/src/HOL/Tools/reification.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/reification.ML Fri Jan 04 23:22:53 2019 +0100
@@ -15,7 +15,7 @@
structure Reification : REIFICATION =
struct
-fun dest_listT (Type (@{type_name "list"}, [T])) = T;
+fun dest_listT (Type (\<^type_name>\<open>list\<close>, [T])) = T;
val FWD = curry (op OF);
@@ -95,7 +95,7 @@
fun rearrange congs =
let
fun P (_, th) =
- let val @{term "Trueprop"} $ (Const (@{const_name HOL.eq}, _) $ l $ _) = Thm.concl_of th
+ let val \<^term>\<open>Trueprop\<close> $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ l $ _) = Thm.concl_of th
in can dest_Var l end;
val (yes, no) = List.partition P congs;
in no @ yes end;
@@ -180,7 +180,7 @@
end handle Pattern.MATCH => decomp_reify da congs (ct, ctxt) bds))
end;
-fun get_nths (t as (Const (@{const_name "List.nth"}, _) $ vs $ n)) =
+fun get_nths (t as (Const (\<^const_name>\<open>List.nth\<close>, _) $ vs $ n)) =
AList.update (op aconv) (t, (vs, n))
| get_nths (t1 $ t2) = get_nths t1 #> get_nths t2
| get_nths (Abs (_, _, t')) = get_nths t'
@@ -216,7 +216,7 @@
let
fun h (Const _ $ (vs as Var (_, lT)) $ _, Var (_, T)) =
let
- val cns = sbst (Const (@{const_name "List.Cons"}, T --> lT --> lT));
+ val cns = sbst (Const (\<^const_name>\<open>List.Cons\<close>, T --> lT --> lT));
val lT' = sbsT lT;
val (bsT, _) = the (AList.lookup Type.could_unify bds lT);
val vsn = the (AList.lookup (op =) vsns_map vs);
@@ -246,7 +246,7 @@
let
val rhs = eq |> Thm.prop_of |> HOLogic.dest_Trueprop |> HOLogic.dest_eq |> snd;
in exists_Const
- (fn (n, ty) => n = @{const_name "List.nth"}
+ (fn (n, ty) => n = \<^const_name>\<open>List.nth\<close>
andalso AList.defined Type.could_unify bds (domain_type ty)) rhs
andalso Type.could_unify (fastype_of rhs, tT)
end;
--- a/src/HOL/Tools/rewrite_hol_proof.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/rewrite_hol_proof.ML Fri Jan 04 23:22:53 2019 +0100
@@ -14,8 +14,8 @@
struct
val rews =
- map (apply2 (Proof_Syntax.proof_of_term @{theory} true) o Logic.dest_equals o
- Logic.varify_global o Proof_Syntax.read_term @{theory} true propT o Syntax.implode_input)
+ map (apply2 (Proof_Syntax.proof_of_term \<^theory> true) o Logic.dest_equals o
+ Logic.varify_global o Proof_Syntax.read_term \<^theory> true propT o Syntax.implode_input)
(** eliminate meta-equality rules **)
--- a/src/HOL/Tools/sat.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/sat.ML Fri Jan 04 23:22:53 2019 +0100
@@ -382,7 +382,7 @@
val msg =
"SAT solver found a countermodel:\n" ^
(commas o map (fn (term, idx) =>
- Syntax.string_of_term_global @{theory} term ^ ": " ^
+ Syntax.string_of_term_global \<^theory> term ^ ": " ^
(case assignment idx of NONE => "arbitrary"
| SOME true => "true" | SOME false => "false")))
(Termtab.dest atom_table)
--- a/src/HOL/Tools/semiring_normalizer.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/semiring_normalizer.ML Fri Jan 04 23:22:53 2019 +0100
@@ -110,7 +110,7 @@
(* extra-logical functions *)
val semiring_norm_ss =
- simpset_of (put_simpset HOL_basic_ss @{context} addsimps @{thms semiring_norm});
+ simpset_of (put_simpset HOL_basic_ss \<^context> addsimps @{thms semiring_norm});
val semiring_funs =
{is_const = can HOLogic.dest_number o Thm.term_of,
@@ -124,21 +124,21 @@
Simplifier.rewrite (put_simpset semiring_norm_ss ctxt)
then_conv Simplifier.rewrite (put_simpset HOL_basic_ss ctxt addsimps @{thms numeral_One}))};
-val divide_const = Thm.cterm_of @{context} (Logic.varify_global @{term "(/)"});
+val divide_const = Thm.cterm_of \<^context> (Logic.varify_global \<^term>\<open>(/)\<close>);
val [divide_tvar] = Term.add_tvars (Thm.term_of divide_const) [];
val field_funs =
let
fun numeral_is_const ct =
case Thm.term_of ct of
- Const (@{const_name Rings.divide},_) $ a $ b =>
+ Const (\<^const_name>\<open>Rings.divide\<close>,_) $ a $ b =>
can HOLogic.dest_number a andalso can HOLogic.dest_number b
- | Const (@{const_name Fields.inverse},_)$t => can HOLogic.dest_number t
+ | Const (\<^const_name>\<open>Fields.inverse\<close>,_)$t => can HOLogic.dest_number t
| t => can HOLogic.dest_number t
fun dest_const ct = ((case Thm.term_of ct of
- Const (@{const_name Rings.divide},_) $ a $ b=>
+ Const (\<^const_name>\<open>Rings.divide\<close>,_) $ a $ b=>
Rat.make (snd (HOLogic.dest_number a), snd (HOLogic.dest_number b))
- | Const (@{const_name Fields.inverse},_)$t =>
+ | Const (\<^const_name>\<open>Fields.inverse\<close>,_)$t =>
Rat.inv (Rat.of_int (snd (HOLogic.dest_number t)))
| t => Rat.of_int (snd (HOLogic.dest_number t)))
handle TERM _ => error "ring_dest_const")
@@ -266,7 +266,7 @@
zero1_numeral_conv ctxt then_conv cv then_conv numeral01_conv ctxt;
val nat_add_ss = simpset_of
- (put_simpset HOL_basic_ss @{context}
+ (put_simpset HOL_basic_ss \<^context>
addsimps @{thms arith_simps} @ @{thms diff_nat_numeral} @ @{thms rel_simps}
@ @{thms if_False if_True Nat.add_0 add_Suc add_numeral_left Suc_eq_plus1}
@ map (fn th => th RS sym) @{thms numerals});
@@ -274,9 +274,9 @@
fun nat_add_conv ctxt =
zerone_conv ctxt (Simplifier.rewrite (put_simpset nat_add_ss ctxt));
-val zeron_tm = @{cterm "0::nat"};
-val onen_tm = @{cterm "1::nat"};
-val true_tm = @{cterm "True"};
+val zeron_tm = \<^cterm>\<open>0::nat\<close>;
+val onen_tm = \<^cterm>\<open>1::nat\<close>;
+val true_tm = \<^cterm>\<open>True\<close>;
(** normalizing conversions **)
@@ -746,7 +746,7 @@
(* Power of polynomial (optimized for the monomial and trivial cases). *)
fun num_conv ctxt n =
- nat_add_conv ctxt (Thm.apply @{cterm Suc} (Numeral.mk_cnumber @{ctyp nat} (dest_number n - 1)))
+ nat_add_conv ctxt (Thm.apply \<^cterm>\<open>Suc\<close> (Numeral.mk_cnumber \<^ctyp>\<open>nat\<close> (dest_number n - 1)))
|> Thm.symmetric;
@@ -849,7 +849,7 @@
val nat_exp_ss =
simpset_of
- (put_simpset HOL_basic_ss @{context}
+ (put_simpset HOL_basic_ss \<^context>
addsimps (@{thms eval_nat_numeral} @ @{thms diff_nat_numeral} @ @{thms arith_simps} @ @{thms rel_simps})
addsimps [@{thm Let_def}, @{thm if_False}, @{thm if_True}, @{thm Nat.add_0}, @{thm add_Suc}]);
--- a/src/HOL/Tools/set_comprehension_pointfree.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/set_comprehension_pointfree.ML Fri Jan 04 23:22:53 2019 +0100
@@ -21,28 +21,28 @@
let
val T = fastype_of t1
in
- Const (@{const_name Lattices.inf_class.inf}, T --> T --> T) $ t1 $ t2
+ Const (\<^const_name>\<open>Lattices.inf_class.inf\<close>, T --> T --> T) $ t1 $ t2
end
fun mk_sup (t1, t2) =
let
val T = fastype_of t1
in
- Const (@{const_name Lattices.sup_class.sup}, T --> T --> T) $ t1 $ t2
+ Const (\<^const_name>\<open>Lattices.sup_class.sup\<close>, T --> T --> T) $ t1 $ t2
end
fun mk_Compl t =
let
val T = fastype_of t
in
- Const (@{const_name "Groups.uminus_class.uminus"}, T --> T) $ t
+ Const (\<^const_name>\<open>Groups.uminus_class.uminus\<close>, T --> T) $ t
end
fun mk_image t1 t2 =
let
- val T as Type (@{type_name fun}, [_ , R]) = fastype_of t1
+ val T as Type (\<^type_name>\<open>fun\<close>, [_ , R]) = fastype_of t1
in
- Const (@{const_name image},
+ Const (\<^const_name>\<open>image\<close>,
T --> fastype_of t2 --> HOLogic.mk_setT R) $ t1 $ t2
end;
@@ -53,22 +53,22 @@
val setT = HOLogic.dest_setT T1
val resT = HOLogic.mk_setT (HOLogic.mk_prodT (setT, HOLogic.dest_setT T2))
in
- Const (@{const_name Sigma},
+ Const (\<^const_name>\<open>Sigma\<close>,
T1 --> (setT --> T2) --> resT) $ t1 $ absdummy setT t2
end;
fun mk_vimage f s =
let
- val T as Type (@{type_name fun}, [T1, T2]) = fastype_of f
+ val T as Type (\<^type_name>\<open>fun\<close>, [T1, T2]) = fastype_of f
in
- Const (@{const_name vimage}, T --> HOLogic.mk_setT T2 --> HOLogic.mk_setT T1) $ f $ s
+ Const (\<^const_name>\<open>vimage\<close>, T --> HOLogic.mk_setT T2 --> HOLogic.mk_setT T1) $ f $ s
end;
-fun dest_Collect (Const (@{const_name Collect}, _) $ Abs (x, T, t)) = ((x, T), t)
+fun dest_Collect (Const (\<^const_name>\<open>Collect\<close>, _) $ Abs (x, T, t)) = ((x, T), t)
| dest_Collect t = raise TERM ("dest_Collect", [t])
(* Copied from predicate_compile_aux.ML *)
-fun strip_ex (Const (@{const_name Ex}, _) $ Abs (x, T, t)) =
+fun strip_ex (Const (\<^const_name>\<open>Ex\<close>, _) $ Abs (x, T, t)) =
let
val (xTs, t') = strip_ex t
in
@@ -84,7 +84,7 @@
end;
fun mk_split_abs vs (Bound i) t = let val (x, T) = nth vs i in Abs (x, T, t) end
- | mk_split_abs vs (Const (@{const_name Product_Type.Pair}, _) $ u $ v) t =
+ | mk_split_abs vs (Const (\<^const_name>\<open>Product_Type.Pair\<close>, _) $ u $ v) t =
HOLogic.mk_case_prod (mk_split_abs vs u (mk_split_abs vs v t))
| mk_split_abs _ t _ = raise TERM ("mk_split_abs: bad term", [t]);
@@ -92,7 +92,7 @@
val strip_ptupleabs =
let
fun strip [] qs vs t = (t, rev vs, qs)
- | strip (p :: ps) qs vs (Const (@{const_name case_prod}, _) $ t) =
+ | strip (p :: ps) qs vs (Const (\<^const_name>\<open>case_prod\<close>, _) $ t) =
strip ((1 :: p) :: (2 :: p) :: ps) (p :: qs) vs t
| strip (_ :: ps) qs vs (Abs (s, T, t)) = strip ps qs ((s, T) :: vs) t
| strip (_ :: ps) qs vs t = strip ps qs
@@ -125,8 +125,8 @@
fun map_atom f (Atom a) = Atom (f a)
| map_atom _ x = x
-fun is_collect_atom (Atom (_, Const(@{const_name Collect}, _) $ _)) = true
- | is_collect_atom (Atom (_, Const (@{const_name "Groups.uminus_class.uminus"}, _) $ (Const(@{const_name Collect}, _) $ _))) = true
+fun is_collect_atom (Atom (_, Const(\<^const_name>\<open>Collect\<close>, _) $ _)) = true
+ | is_collect_atom (Atom (_, Const (\<^const_name>\<open>Groups.uminus_class.uminus\<close>, _) $ (Const(\<^const_name>\<open>Collect\<close>, _) $ _))) = true
| is_collect_atom _ = false
fun mk_case_prod _ [(x, T)] t = (T, Abs (x, T, t))
@@ -151,12 +151,12 @@
let
val (tuple, (vs', t')) = mk_term vs t
val T = HOLogic.mk_tupleT (map snd vs')
- val s = HOLogic.Collect_const T $ (snd (mk_case_prod @{typ bool} vs' t'))
+ val s = HOLogic.Collect_const T $ (snd (mk_case_prod \<^typ>\<open>bool\<close> vs' t'))
in
(tuple, Atom (tuple, s))
end
-fun mk_atom vs (t as Const (@{const_name "Set.member"}, _) $ x $ s) =
+fun mk_atom vs (t as Const (\<^const_name>\<open>Set.member\<close>, _) $ x $ s) =
if not (null (loose_bnos s)) then
default_atom vs t
else
@@ -168,7 +168,7 @@
val rT = HOLogic.dest_setT (fastype_of s)
val s = mk_vimage (snd (mk_case_prod rT vs' x')) s
in (tuple, Atom (tuple, s)) end)
- | mk_atom vs (Const (@{const_name "HOL.Not"}, _) $ t) = apsnd (map_atom (apsnd mk_Compl)) (mk_atom vs t)
+ | mk_atom vs (Const (\<^const_name>\<open>HOL.Not\<close>, _) $ t) = apsnd (map_atom (apsnd mk_Compl)) (mk_atom vs t)
| mk_atom vs t = default_atom vs t
fun merge' [] (pats1, pats2) = ([], (pats1, pats2))
@@ -415,7 +415,7 @@
fun comprehension_conv ctxt ct =
let
- fun dest_Collect (Const (@{const_name Collect}, T) $ t) = (HOLogic.dest_setT (body_type T), t)
+ fun dest_Collect (Const (\<^const_name>\<open>Collect\<close>, T) $ t) = (HOLogic.dest_setT (body_type T), t)
| dest_Collect t = raise TERM ("dest_Collect", [t])
fun list_ex vs t = fold_rev (fn (x, T) => fn t => HOLogic.exists_const T $ Abs (x, T, t)) vs t
fun mk_term t =
--- a/src/HOL/Tools/simpdata.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/simpdata.ML Fri Jan 04 23:22:53 2019 +0100
@@ -10,11 +10,11 @@
structure Quantifier1 = Quantifier1
(
(*abstract syntax*)
- fun dest_eq (Const(@{const_name HOL.eq},_) $ s $ t) = SOME (s, t)
+ fun dest_eq (Const(\<^const_name>\<open>HOL.eq\<close>,_) $ s $ t) = SOME (s, t)
| dest_eq _ = NONE;
- fun dest_conj (Const(@{const_name HOL.conj},_) $ s $ t) = SOME (s, t)
+ fun dest_conj (Const(\<^const_name>\<open>HOL.conj\<close>,_) $ s $ t) = SOME (s, t)
| dest_conj _ = NONE;
- fun dest_imp (Const(@{const_name HOL.implies},_) $ s $ t) = SOME (s, t)
+ fun dest_imp (Const(\<^const_name>\<open>HOL.implies\<close>,_) $ s $ t) = SOME (s, t)
| dest_imp _ = NONE;
val conj = HOLogic.conj
val imp = HOLogic.imp
@@ -44,9 +44,9 @@
fun mk_eq th =
(case Thm.concl_of th of
(*expects Trueprop if not == *)
- Const (@{const_name Pure.eq},_) $ _ $ _ => th
- | _ $ (Const (@{const_name HOL.eq}, _) $ _ $ _) => mk_meta_eq th
- | _ $ (Const (@{const_name Not}, _) $ _) => th RS @{thm Eq_FalseI}
+ Const (\<^const_name>\<open>Pure.eq\<close>,_) $ _ $ _ => th
+ | _ $ (Const (\<^const_name>\<open>HOL.eq\<close>, _) $ _ $ _) => mk_meta_eq th
+ | _ $ (Const (\<^const_name>\<open>Not\<close>, _) $ _) => th RS @{thm Eq_FalseI}
| _ => th RS @{thm Eq_TrueI})
fun mk_eq_True (_: Proof.context) r =
@@ -58,7 +58,7 @@
fun lift_meta_eq_to_obj_eq ctxt i st =
let
- fun count_imp (Const (@{const_name HOL.simp_implies}, _) $ _ $ P) = 1 + count_imp P
+ fun count_imp (Const (\<^const_name>\<open>HOL.simp_implies\<close>, _) $ _ $ P) = 1 + count_imp P
| count_imp _ = 0;
val j = count_imp (Logic.strip_assums_concl (Thm.term_of (Thm.cprem_of st i)))
in
@@ -67,11 +67,11 @@
let
val Ps = map (fn k => Free ("P" ^ string_of_int k, propT)) (1 upto j);
val mk_simp_implies = fold_rev (fn R => fn S =>
- Const (@{const_name HOL.simp_implies}, propT --> propT --> propT) $ R $ S) Ps;
+ Const (\<^const_name>\<open>HOL.simp_implies\<close>, propT --> propT --> propT) $ R $ S) Ps;
in
Goal.prove_global (Proof_Context.theory_of ctxt) []
- [mk_simp_implies @{prop "(x::'a) == y"}]
- (mk_simp_implies @{prop "(x::'a) = y"})
+ [mk_simp_implies \<^prop>\<open>(x::'a) == y\<close>]
+ (mk_simp_implies \<^prop>\<open>(x::'a) = y\<close>)
(fn {context = ctxt, prems} => EVERY
[rewrite_goals_tac ctxt @{thms simp_implies_def},
REPEAT (assume_tac ctxt 1 ORELSE
@@ -103,7 +103,7 @@
else Variable.trade (K (fn [thm'] => res thm' rls)) thm_ctxt [thm];
in
case Thm.concl_of thm
- of Const (@{const_name Trueprop}, _) $ p => (case head_of p
+ of Const (\<^const_name>\<open>Trueprop\<close>, _) $ p => (case head_of p
of Const (a, _) => (case AList.lookup (op =) pairs a
of SOME rls => (maps atoms (res_fixed rls) handle THM _ => [thm])
| NONE => [thm])
@@ -142,7 +142,7 @@
structure Splitter = Splitter
(
- val context = @{context}
+ val context = \<^context>
val mk_eq = mk_eq
val meta_eq_to_iff = @{thm meta_eq_to_obj_eq}
val iffD = @{thm iffD2}
@@ -174,15 +174,15 @@
open Clasimp;
val mksimps_pairs =
- [(@{const_name HOL.implies}, [@{thm mp}]),
- (@{const_name HOL.conj}, [@{thm conjunct1}, @{thm conjunct2}]),
- (@{const_name All}, [@{thm spec}]),
- (@{const_name True}, []),
- (@{const_name False}, []),
- (@{const_name If}, [@{thm if_bool_eq_conj} RS @{thm iffD1}])];
+ [(\<^const_name>\<open>HOL.implies\<close>, [@{thm mp}]),
+ (\<^const_name>\<open>HOL.conj\<close>, [@{thm conjunct1}, @{thm conjunct2}]),
+ (\<^const_name>\<open>All\<close>, [@{thm spec}]),
+ (\<^const_name>\<open>True\<close>, []),
+ (\<^const_name>\<open>False\<close>, []),
+ (\<^const_name>\<open>If\<close>, [@{thm if_bool_eq_conj} RS @{thm iffD1}])];
val HOL_basic_ss =
- empty_simpset @{context}
+ empty_simpset \<^context>
setSSolver safe_solver
setSolver unsafe_solver
|> Simplifier.set_subgoaler asm_simp_tac
--- a/src/HOL/Tools/string_syntax.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/string_syntax.ML Fri Jan 04 23:22:53 2019 +0100
@@ -35,12 +35,12 @@
(* booleans as bits *)
fun mk_bit_syntax b =
- Syntax.const (if b = 1 then @{const_syntax True} else @{const_syntax False});
+ Syntax.const (if b = 1 then \<^const_syntax>\<open>True\<close> else \<^const_syntax>\<open>False\<close>);
fun mk_bits_syntax len = map mk_bit_syntax o Integer.radicify 2 len;
-fun dest_bit_syntax (Const (@{const_syntax True}, _)) = 1
- | dest_bit_syntax (Const (@{const_syntax False}, _)) = 0
+fun dest_bit_syntax (Const (\<^const_syntax>\<open>True\<close>, _)) = 1
+ | dest_bit_syntax (Const (\<^const_syntax>\<open>False\<close>, _)) = 0
| dest_bit_syntax _ = raise Match;
val dest_bits_syntax = Integer.eval_radix 2 o map dest_bit_syntax;
@@ -54,7 +54,7 @@
else error ("Bad character: " ^ quote c);
fun mk_char_syntax i =
- list_comb (Syntax.const @{const_syntax Char}, mk_bits_syntax 8 i);
+ list_comb (Syntax.const \<^const_syntax>\<open>Char\<close>, mk_bits_syntax 8 i);
fun plain_strings_of str =
map fst (Lexicon.explode_str (str, Position.none));
@@ -77,11 +77,11 @@
fun dest_char_syntax b0 b1 b2 b3 b4 b5 b6 b7 =
classify_character (dest_bits_syntax [b0, b1, b2, b3, b4, b5, b6, b7])
-fun dest_char_ast (Ast.Appl [Ast.Constant @{syntax_const "_Char"}, Ast.Constant s]) =
+fun dest_char_ast (Ast.Appl [Ast.Constant \<^syntax_const>\<open>_Char\<close>, Ast.Constant s]) =
plain_strings_of s
| dest_char_ast _ = raise Match;
-fun char_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] =
+fun char_tr [(c as Const (\<^syntax_const>\<open>_constrain\<close>, _)) $ t $ u] =
c $ char_tr [t] $ u
| char_tr [Free (str, _)] =
(case plain_strings_of str of
@@ -89,7 +89,7 @@
| _ => error ("Single character expected: " ^ str))
| char_tr ts = raise TERM ("char_tr", ts);
-fun char_ord_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] =
+fun char_ord_tr [(c as Const (\<^syntax_const>\<open>_constrain\<close>, _)) $ t $ u] =
c $ char_ord_tr [t] $ u
| char_ord_tr [Const (num, _)] =
(mk_char_syntax o #value o Lexicon.read_num) num
@@ -97,33 +97,33 @@
fun char_tr' [b1, b2, b3, b4, b5, b6, b7, b8] =
(case dest_char_syntax b1 b2 b3 b4 b5 b6 b7 b8 of
- Char s => Syntax.const @{syntax_const "_Char"} $
+ Char s => Syntax.const \<^syntax_const>\<open>_Char\<close> $
Syntax.const (Lexicon.implode_str [s])
- | Ord n => Syntax.const @{syntax_const "_Char_ord"} $
+ | Ord n => Syntax.const \<^syntax_const>\<open>_Char_ord\<close> $
Syntax.free (hex n))
| char_tr' _ = raise Match;
(* string *)
-fun mk_string_syntax [] = Syntax.const @{const_syntax Nil}
+fun mk_string_syntax [] = Syntax.const \<^const_syntax>\<open>Nil\<close>
| mk_string_syntax (c :: cs) =
- Syntax.const @{const_syntax Cons} $ mk_char_syntax (ascii_ord_of c)
+ Syntax.const \<^const_syntax>\<open>Cons\<close> $ mk_char_syntax (ascii_ord_of c)
$ mk_string_syntax cs;
fun mk_string_ast ss =
- Ast.Appl [Ast.Constant @{syntax_const "_inner_string"},
+ Ast.Appl [Ast.Constant \<^syntax_const>\<open>_inner_string\<close>,
Ast.Variable (Lexicon.implode_str ss)];
-fun string_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] =
+fun string_tr [(c as Const (\<^syntax_const>\<open>_constrain\<close>, _)) $ t $ u] =
c $ string_tr [t] $ u
| string_tr [Free (str, _)] =
mk_string_syntax (plain_strings_of str)
| string_tr ts = raise TERM ("string_tr", ts);
fun list_ast_tr' [args] =
- Ast.Appl [Ast.Constant @{syntax_const "_String"},
- (mk_string_ast o maps dest_char_ast o Ast.unfold_ast @{syntax_const "_args"}) args]
+ Ast.Appl [Ast.Constant \<^syntax_const>\<open>_String\<close>,
+ (mk_string_ast o maps dest_char_ast o Ast.unfold_ast \<^syntax_const>\<open>_args\<close>) args]
| list_ast_tr' _ = raise Match;
@@ -132,12 +132,12 @@
val _ =
Theory.setup
(Sign.parse_translation
- [(@{syntax_const "_Char"}, K char_tr),
- (@{syntax_const "_Char_ord"}, K char_ord_tr),
- (@{syntax_const "_String"}, K string_tr)] #>
+ [(\<^syntax_const>\<open>_Char\<close>, K char_tr),
+ (\<^syntax_const>\<open>_Char_ord\<close>, K char_ord_tr),
+ (\<^syntax_const>\<open>_String\<close>, K string_tr)] #>
Sign.print_translation
- [(@{const_syntax Char}, K char_tr')] #>
+ [(\<^const_syntax>\<open>Char\<close>, K char_tr')] #>
Sign.print_ast_translation
- [(@{syntax_const "_list"}, K list_ast_tr')]);
+ [(\<^syntax_const>\<open>_list\<close>, K list_ast_tr')]);
end
--- a/src/HOL/Tools/try0.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Tools/try0.ML Fri Jan 04 23:22:53 2019 +0100
@@ -172,7 +172,7 @@
fun string_of_xthm (xref, args) =
Facts.string_of_ref xref ^
- implode (map (enclose "[" "]" o Pretty.unformatted_string_of o Token.pretty_src @{context}) args);
+ implode (map (enclose "[" "]" o Pretty.unformatted_string_of o Token.pretty_src \<^context>) args);
val parse_fact_refs =
Scan.repeat1 (Scan.unless (Parse.name -- Args.colon) (Parse.thm >> string_of_xthm));
--- a/src/HOL/Topological_Spaces.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Topological_Spaces.thy Fri Jan 04 23:22:53 2019 +0100
@@ -725,7 +725,7 @@
setup \<open>
Global_Theory.add_thms_dynamic (\<^binding>\<open>tendsto_eq_intros\<close>,
fn context =>
- Named_Theorems.get (Context.proof_of context) @{named_theorems tendsto_intros}
+ Named_Theorems.get (Context.proof_of context) \<^named_theorems>\<open>tendsto_intros\<close>
|> map_filter (try (fn thm => @{thm tendsto_eq_rhs} OF [thm])))
\<close>
@@ -1027,7 +1027,7 @@
using UV by auto
qed
-subsubsection \<open>Rules about @{const Lim}\<close>
+subsubsection \<open>Rules about \<^const>\<open>Lim\<close>\<close>
lemma tendsto_Lim: "\<not> trivial_limit net \<Longrightarrow> (f \<longlongrightarrow> l) net \<Longrightarrow> Lim net f = l"
unfolding Lim_def using tendsto_unique [of net f] by auto
--- a/src/HOL/Transcendental.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Transcendental.thy Fri Jan 04 23:22:53 2019 +0100
@@ -233,7 +233,7 @@
text \<open>
Power series has a circle or radius of convergence: if it sums for \<open>x\<close>,
- then it sums absolutely for \<open>z\<close> with @{term "\<bar>z\<bar> < \<bar>x\<bar>"}.\<close>
+ then it sums absolutely for \<open>z\<close> with \<^term>\<open>\<bar>z\<bar> < \<bar>x\<bar>\<close>.\<close>
lemma powser_insidea:
fixes x z :: "'a::real_normed_div_algebra"
@@ -1549,7 +1549,7 @@
subsubsection \<open>Properties of the Exponential Function on Reals\<close>
-text \<open>Comparisons of @{term "exp x"} with zero.\<close>
+text \<open>Comparisons of \<^term>\<open>exp x\<close> with zero.\<close>
text \<open>Proof: because every exponential can be seen as a square.\<close>
lemma exp_ge_zero [simp]: "0 \<le> exp x"
@@ -1635,7 +1635,7 @@
for x y :: real
by (simp add: order_eq_iff)
-text \<open>Comparisons of @{term "exp x"} with one.\<close>
+text \<open>Comparisons of \<^term>\<open>exp x\<close> with one.\<close>
lemma one_less_exp_iff [simp]: "1 < exp x \<longleftrightarrow> 0 < x"
for x :: real
@@ -2394,7 +2394,7 @@
subsection\<open>The general logarithm\<close>
definition log :: "real \<Rightarrow> real \<Rightarrow> real"
- \<comment> \<open>logarithm of @{term x} to base @{term a}\<close>
+ \<comment> \<open>logarithm of \<^term>\<open>x\<close> to base \<^term>\<open>a\<close>\<close>
where "log a x = ln x / ln a"
lemma tendsto_log [tendsto_intros]:
@@ -3596,7 +3596,7 @@
definition pi :: real
where "pi = 2 * (THE x. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0)"
-text \<open>Show that there's a least positive @{term x} with @{term "cos x = 0"};
+text \<open>Show that there's a least positive \<^term>\<open>x\<close> with \<^term>\<open>cos x = 0\<close>;
hence define pi.\<close>
lemma sin_paired: "(\<lambda>n. (- 1) ^ n / (fact (2 * n + 1)) * x ^ (2 * n + 1)) sums sin x"
@@ -4009,7 +4009,7 @@
shows "0 < sin (pi / real n)"
by (rule sin_gt_zero) (use assms in \<open>simp_all add: divide_simps\<close>)
-text\<open>Proof resembles that of \<open>cos_is_zero\<close> but with @{term pi} for the upper bound\<close>
+text\<open>Proof resembles that of \<open>cos_is_zero\<close> but with \<^term>\<open>pi\<close> for the upper bound\<close>
lemma cos_total:
assumes y: "-1 \<le> y" "y \<le> 1"
shows "\<exists>!x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y"
--- a/src/HOL/Transfer.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Transfer.thy Fri Jan 04 23:22:53 2019 +0100
@@ -621,7 +621,7 @@
end
-subsection \<open>@{const of_nat}\<close>
+subsection \<open>\<^const>\<open>of_nat\<close>\<close>
lemma transfer_rule_of_nat:
fixes R :: "'a::semiring_1 \<Rightarrow> 'b::semiring_1 \<Rightarrow> bool"
--- a/src/HOL/Transitive_Closure.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Transitive_Closure.thy Fri Jan 04 23:22:53 2019 +0100
@@ -173,7 +173,7 @@
lemmas converse_rtrancl_into_rtrancl = converse_rtranclp_into_rtranclp [to_set]
-text \<open>\<^medskip> More @{term "r\<^sup>*"} equations and inclusions.\<close>
+text \<open>\<^medskip> More \<^term>\<open>r\<^sup>*\<close> equations and inclusions.\<close>
lemma rtranclp_idemp [simp]: "(r\<^sup>*\<^sup>*)\<^sup>*\<^sup>* = r\<^sup>*\<^sup>*"
apply (auto intro!: order_antisym)
@@ -391,7 +391,7 @@
lemma trancl_unfold: "r\<^sup>+ = r \<union> r\<^sup>+ O r"
by (auto intro: trancl_into_trancl elim: tranclE)
-text \<open>Transitivity of @{term "r\<^sup>+"}\<close>
+text \<open>Transitivity of \<^term>\<open>r\<^sup>+\<close>\<close>
lemma trans_trancl [simp]: "trans (r\<^sup>+)"
proof (rule transI)
fix x y z
@@ -1226,10 +1226,10 @@
fun decomp (@{const Trueprop} $ t) =
let
- fun dec (Const (@{const_name Set.member}, _) $ (Const (@{const_name Pair}, _) $ a $ b) $ rel) =
+ fun dec (Const (\<^const_name>\<open>Set.member\<close>, _) $ (Const (\<^const_name>\<open>Pair\<close>, _) $ a $ b) $ rel) =
let
- fun decr (Const (@{const_name rtrancl}, _ ) $ r) = (r,"r*")
- | decr (Const (@{const_name trancl}, _ ) $ r) = (r,"r+")
+ fun decr (Const (\<^const_name>\<open>rtrancl\<close>, _ ) $ r) = (r,"r*")
+ | decr (Const (\<^const_name>\<open>trancl\<close>, _ ) $ r) = (r,"r+")
| decr r = (r,"r");
val (rel,r) = decr (Envir.beta_eta_contract rel);
in SOME (a,b,rel,r) end
@@ -1253,8 +1253,8 @@
let
fun dec (rel $ a $ b) =
let
- fun decr (Const (@{const_name rtranclp}, _ ) $ r) = (r,"r*")
- | decr (Const (@{const_name tranclp}, _ ) $ r) = (r,"r+")
+ fun decr (Const (\<^const_name>\<open>rtranclp\<close>, _ ) $ r) = (r,"r*")
+ | decr (Const (\<^const_name>\<open>tranclp\<close>, _ ) $ r) = (r,"r+")
| decr r = (r,"r");
val (rel,r) = decr rel;
in SOME (a, b, rel, r) end
--- a/src/HOL/Typerep.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Typerep.thy Fri Jan 04 23:22:53 2019 +0100
@@ -23,22 +23,22 @@
parse_translation \<open>
let
fun typerep_tr (*"_TYPEREP"*) [ty] =
- Syntax.const @{const_syntax typerep} $
- (Syntax.const @{syntax_const "_constrain"} $ Syntax.const @{const_syntax Pure.type} $
- (Syntax.const @{type_syntax itself} $ ty))
+ Syntax.const \<^const_syntax>\<open>typerep\<close> $
+ (Syntax.const \<^syntax_const>\<open>_constrain\<close> $ Syntax.const \<^const_syntax>\<open>Pure.type\<close> $
+ (Syntax.const \<^type_syntax>\<open>itself\<close> $ ty))
| typerep_tr (*"_TYPEREP"*) ts = raise TERM ("typerep_tr", ts);
- in [(@{syntax_const "_TYPEREP"}, K typerep_tr)] end
+ in [(\<^syntax_const>\<open>_TYPEREP\<close>, K typerep_tr)] end
\<close>
typed_print_translation \<open>
let
fun typerep_tr' ctxt (*"typerep"*)
- (Type (@{type_name fun}, [Type (@{type_name itself}, [T]), _]))
- (Const (@{const_syntax Pure.type}, _) :: ts) =
+ (Type (\<^type_name>\<open>fun\<close>, [Type (\<^type_name>\<open>itself\<close>, [T]), _]))
+ (Const (\<^const_syntax>\<open>Pure.type\<close>, _) :: ts) =
Term.list_comb
- (Syntax.const @{syntax_const "_TYPEREP"} $ Syntax_Phases.term_of_typ ctxt T, ts)
+ (Syntax.const \<^syntax_const>\<open>_TYPEREP\<close> $ Syntax_Phases.term_of_typ ctxt T, ts)
| typerep_tr' _ T ts = raise Match;
- in [(@{const_syntax typerep}, typerep_tr')] end
+ in [(\<^const_syntax>\<open>typerep\<close>, typerep_tr')] end
\<close>
setup \<open>
@@ -46,17 +46,17 @@
fun add_typerep tyco thy =
let
- val sorts = replicate (Sign.arity_number thy tyco) @{sort typerep};
+ val sorts = replicate (Sign.arity_number thy tyco) \<^sort>\<open>typerep\<close>;
val vs = Name.invent_names Name.context "'a" sorts;
val ty = Type (tyco, map TFree vs);
- val lhs = Const (@{const_name typerep}, Term.itselfT ty --> @{typ typerep})
+ val lhs = Const (\<^const_name>\<open>typerep\<close>, Term.itselfT ty --> \<^typ>\<open>typerep\<close>)
$ Free ("T", Term.itselfT ty);
- val rhs = @{term Typerep} $ HOLogic.mk_literal tyco
- $ HOLogic.mk_list @{typ typerep} (map (HOLogic.mk_typerep o TFree) vs);
+ val rhs = \<^term>\<open>Typerep\<close> $ HOLogic.mk_literal tyco
+ $ HOLogic.mk_list \<^typ>\<open>typerep\<close> (map (HOLogic.mk_typerep o TFree) vs);
val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (lhs, rhs));
in
thy
- |> Class.instantiation ([tyco], vs, @{sort typerep})
+ |> Class.instantiation ([tyco], vs, \<^sort>\<open>typerep\<close>)
|> `(fn lthy => Syntax.check_term lthy eq)
|-> (fn eq => Specification.definition NONE [] [] (Binding.empty_atts, eq))
|> snd
@@ -64,13 +64,13 @@
end;
fun ensure_typerep tyco thy =
- if not (Sorts.has_instance (Sign.classes_of thy) tyco @{sort typerep})
- andalso Sorts.has_instance (Sign.classes_of thy) tyco @{sort type}
+ if not (Sorts.has_instance (Sign.classes_of thy) tyco \<^sort>\<open>typerep\<close>)
+ andalso Sorts.has_instance (Sign.classes_of thy) tyco \<^sort>\<open>type\<close>
then add_typerep tyco thy else thy;
in
-add_typerep @{type_name fun}
+add_typerep \<^type_name>\<open>fun\<close>
#> Typedef.interpretation (Local_Theory.background_theory o ensure_typerep)
#> Code.type_interpretation ensure_typerep
--- a/src/HOL/Vector_Spaces.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Vector_Spaces.thy Fri Jan 04 23:22:53 2019 +0100
@@ -826,7 +826,7 @@
by (auto simp: that construct_in_span in_span_in_range_construct)
lemma linear_independent_extend_subspace:
- \<comment> \<open>legacy: use @{term construct} instead\<close>
+ \<comment> \<open>legacy: use \<^term>\<open>construct\<close> instead\<close>
assumes "vs1.independent B"
shows "\<exists>g. linear s1 s2 g \<and> (\<forall>x\<in>B. g x = f x) \<and> range g = vs2.span (f`B)"
by (rule exI[where x="construct B f"])
--- a/src/HOL/Wellfounded.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Wellfounded.thy Fri Jan 04 23:22:53 2019 +0100
@@ -536,7 +536,7 @@
by (blast intro: finite_acyclic_wf wf_acyclic)
-subsection \<open>@{typ nat} is well-founded\<close>
+subsection \<open>\<^typ>\<open>nat\<close> is well-founded\<close>
lemma less_nat_rel: "(<) = (\<lambda>m n. n = Suc m)\<^sup>+\<^sup>+"
proof (rule ext, rule ext, rule iffI)
@@ -736,7 +736,7 @@
apply blast
done
-text \<open>Measure functions into @{typ nat}\<close>
+text \<open>Measure functions into \<^typ>\<open>nat\<close>\<close>
definition measure :: "('a \<Rightarrow> nat) \<Rightarrow> ('a \<times> 'a) set"
where "measure = inv_image less_than"
--- a/src/HOL/Wfrec.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Wfrec.thy Fri Jan 04 23:22:53 2019 +0100
@@ -89,7 +89,7 @@
definition same_fst :: "('a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> ('b \<times> 'b) set) \<Rightarrow> (('a \<times> 'b) \<times> ('a \<times> 'b)) set"
where "same_fst P R = {((x', y'), (x, y)) . x' = x \<and> P x \<and> (y',y) \<in> R x}"
- \<comment> \<open>For @{const wfrec} declarations where the first n parameters
+ \<comment> \<open>For \<^const>\<open>wfrec\<close> declarations where the first n parameters
stay unchanged in the recursive call.\<close>
lemma same_fstI [intro!]: "P x \<Longrightarrow> (y', y) \<in> R x \<Longrightarrow> ((x, y'), (x, y)) \<in> same_fst P R"
--- a/src/HOL/Zorn.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/HOL/Zorn.thy Fri Jan 04 23:22:53 2019 +0100
@@ -78,8 +78,8 @@
using assms by (rule subset_trans) (rule suc_subset)
text \<open>
- We build a set @{term \<C>} that is closed under applications
- of @{term suc} and contains the union of all its subsets.
+ We build a set \<^term>\<open>\<C>\<close> that is closed under applications
+ of \<^term>\<open>suc\<close> and contains the union of all its subsets.
\<close>
inductive_set suc_Union_closed ("\<C>")
where
@@ -88,14 +88,14 @@
text \<open>
Since the empty set as well as the set itself is a subset of
- every set, @{term \<C>} contains at least @{term "{} \<in> \<C>"} and
- @{term "\<Union>\<C> \<in> \<C>"}.
+ every set, \<^term>\<open>\<C>\<close> contains at least \<^term>\<open>{} \<in> \<C>\<close> and
+ \<^term>\<open>\<Union>\<C> \<in> \<C>\<close>.
\<close>
lemma suc_Union_closed_empty: "{} \<in> \<C>"
and suc_Union_closed_Union: "\<Union>\<C> \<in> \<C>"
using Union [of "{}"] and Union [of "\<C>"] by simp_all
-text \<open>Thus closure under @{term suc} will hit a maximal chain
+text \<open>Thus closure under \<^term>\<open>suc\<close> will hit a maximal chain
eventually, as is shown below.\<close>
lemma suc_Union_closed_induct [consumes 1, case_names suc Union, induct pred: suc_Union_closed]:
@@ -112,7 +112,7 @@
shows "Q"
using assms by cases simp_all
-text \<open>On chains, @{term suc} yields a chain.\<close>
+text \<open>On chains, \<^term>\<open>suc\<close> yields a chain.\<close>
lemma chain_suc:
assumes "chain X"
shows "chain (suc X)"
@@ -204,7 +204,7 @@
qed
qed
-text \<open>The elements of @{term \<C>} are totally ordered by the subset relation.\<close>
+text \<open>The elements of \<^term>\<open>\<C>\<close> are totally ordered by the subset relation.\<close>
lemma suc_Union_closed_total:
assumes "X \<in> \<C>" and "Y \<in> \<C>"
shows "X \<subseteq> Y \<or> Y \<subseteq> X"
@@ -221,8 +221,8 @@
by blast
qed
-text \<open>Once we hit a fixed point w.r.t. @{term suc}, all other elements
- of @{term \<C>} are subsets of this fixed point.\<close>
+text \<open>Once we hit a fixed point w.r.t. \<^term>\<open>suc\<close>, all other elements
+ of \<^term>\<open>\<C>\<close> are subsets of this fixed point.\<close>
lemma suc_Union_closed_suc:
assumes "X \<in> \<C>" and "Y \<in> \<C>" and "suc Y = Y"
shows "X \<subseteq> Y"
@@ -269,7 +269,7 @@
using assms
by induct (auto dest: suc_in_carrier)
-text \<open>All elements of @{term \<C>} are chains.\<close>
+text \<open>All elements of \<^term>\<open>\<C>\<close> are chains.\<close>
lemma suc_Union_closed_chain:
assumes "X \<in> \<C>"
shows "chain X"
@@ -332,7 +332,7 @@
then show ?thesis by blast
qed
-text \<open>Make notation @{term \<C>} available again.\<close>
+text \<open>Make notation \<^term>\<open>\<C>\<close> available again.\<close>
no_notation suc_Union_closed ("\<C>")
lemma chain_extend: "chain C \<Longrightarrow> z \<in> A \<Longrightarrow> \<forall>x\<in>C. x \<sqsubseteq> z \<Longrightarrow> chain ({z} \<union> C)"
@@ -343,7 +343,7 @@
end
-text \<open>Hide constant @{const pred_on.suc_Union_closed}, which was just needed
+text \<open>Hide constant \<^const>\<open>pred_on.suc_Union_closed\<close>, which was just needed
for the proof of Hausforff's maximum principle.\<close>
hide_const pred_on.suc_Union_closed
--- a/src/Provers/Arith/cancel_div_mod.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Provers/Arith/cancel_div_mod.ML Fri Jan 04 23:22:53 2019 +0100
@@ -34,12 +34,12 @@
functor Cancel_Div_Mod(Data: CANCEL_DIV_MOD_DATA): CANCEL_DIV_MOD =
struct
-fun coll_div_mod (Const (@{const_name Groups.plus}, _) $ s $ t) dms =
+fun coll_div_mod (Const (\<^const_name>\<open>Groups.plus\<close>, _) $ s $ t) dms =
coll_div_mod t (coll_div_mod s dms)
- | coll_div_mod (Const (@{const_name Groups.times}, _) $ m $ (Const (d, _) $ s $ n))
+ | coll_div_mod (Const (\<^const_name>\<open>Groups.times\<close>, _) $ m $ (Const (d, _) $ s $ n))
(dms as (divs, mods)) =
if d = Data.div_name andalso m = n then ((s, n) :: divs, mods) else dms
- | coll_div_mod (Const (@{const_name Groups.times}, _) $ (Const (d, _) $ s $ n) $ m)
+ | coll_div_mod (Const (\<^const_name>\<open>Groups.times\<close>, _) $ (Const (d, _) $ s $ n) $ m)
(dms as (divs, mods)) =
if d = Data.div_name andalso m = n then ((s, n) :: divs, mods) else dms
| coll_div_mod (Const (m, _) $ s $ n) (dms as (divs, mods)) =
@@ -55,8 +55,8 @@
==> thesis by transitivity
*)
-val mk_plus = Data.mk_binop @{const_name Groups.plus};
-val mk_times = Data.mk_binop @{const_name Groups.times};
+val mk_plus = Data.mk_binop \<^const_name>\<open>Groups.plus\<close>;
+val mk_times = Data.mk_binop \<^const_name>\<open>Groups.times\<close>;
fun rearrange T t pq =
let
--- a/src/Provers/blast.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Provers/blast.ML Fri Jan 04 23:22:53 2019 +0100
@@ -76,9 +76,9 @@
(* options *)
-val depth_limit = Attrib.setup_config_int @{binding blast_depth_limit} (K 20);
-val (trace, _) = Attrib.config_bool @{binding blast_trace} (K false);
-val (stats, _) = Attrib.config_bool @{binding blast_stats} (K false);
+val depth_limit = Attrib.setup_config_int \<^binding>\<open>blast_depth_limit\<close> (K 20);
+val (trace, _) = Attrib.config_bool \<^binding>\<open>blast_trace\<close> (K false);
+val (stats, _) = Attrib.config_bool \<^binding>\<open>blast_stats\<close> (K false);
datatype term =
@@ -418,12 +418,12 @@
(* A1==>...An==>B goes to [A1,...,An], where B is not an implication *)
-fun strip_imp_prems (Const (@{const_name Pure.imp}, _) $ A $ B) =
+fun strip_imp_prems (Const (\<^const_name>\<open>Pure.imp\<close>, _) $ A $ B) =
strip_Trueprop A :: strip_imp_prems B
| strip_imp_prems _ = [];
(* A1==>...An==>B goes to B, where B is not an implication *)
-fun strip_imp_concl (Const (@{const_name Pure.imp}, _) $ A $ B) = strip_imp_concl B
+fun strip_imp_concl (Const (\<^const_name>\<open>Pure.imp\<close>, _) $ A $ B) = strip_imp_concl B
| strip_imp_concl A = strip_Trueprop A;
@@ -443,7 +443,7 @@
else P :: delete_concl Ps
| _ => P :: delete_concl Ps);
-fun skoPrem state vars (Const (@{const_name Pure.all}, _) $ Abs (_, P)) =
+fun skoPrem state vars (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (_, P)) =
skoPrem state vars (subst_bound (Skolem (gensym state "S", vars), P))
| skoPrem _ _ P = P;
@@ -1188,7 +1188,7 @@
(*Make a list of all the parameters in a subgoal, even if nested*)
local open Term
in
-fun discard_foralls (Const(@{const_name Pure.all},_)$Abs(a,T,t)) = discard_foralls t
+fun discard_foralls (Const(\<^const_name>\<open>Pure.all\<close>,_)$Abs(a,T,t)) = discard_foralls t
| discard_foralls t = t;
end;
@@ -1311,7 +1311,7 @@
val _ =
Theory.setup
- (Method.setup @{binding blast}
+ (Method.setup \<^binding>\<open>blast\<close>
(Scan.lift (Scan.option Parse.nat) --| Method.sections Classical.cla_modifiers >>
(fn NONE => SIMPLE_METHOD' o blast_tac
| SOME lim => (fn ctxt => SIMPLE_METHOD' (depth_tac ctxt lim))))
--- a/src/Provers/clasimp.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Provers/clasimp.ML Fri Jan 04 23:22:53 2019 +0100
@@ -180,7 +180,7 @@
val _ =
Theory.setup
- (Attrib.setup @{binding iff}
+ (Attrib.setup \<^binding>\<open>iff\<close>
(Scan.lift
(Args.del >> K iff_del ||
Scan.option Args.add -- Args.query >> K iff_add' ||
@@ -215,12 +215,12 @@
val _ =
Theory.setup
- (Method.setup @{binding fastforce} (clasimp_method' fast_force_tac) "combined fast and simp" #>
- Method.setup @{binding slowsimp} (clasimp_method' slow_simp_tac) "combined slow and simp" #>
- Method.setup @{binding bestsimp} (clasimp_method' best_simp_tac) "combined best and simp" #>
- Method.setup @{binding force} (clasimp_method' force_tac) "force" #>
- Method.setup @{binding auto} auto_method "auto" #>
- Method.setup @{binding clarsimp} (clasimp_method' (CHANGED_PROP oo clarsimp_tac))
+ (Method.setup \<^binding>\<open>fastforce\<close> (clasimp_method' fast_force_tac) "combined fast and simp" #>
+ Method.setup \<^binding>\<open>slowsimp\<close> (clasimp_method' slow_simp_tac) "combined slow and simp" #>
+ Method.setup \<^binding>\<open>bestsimp\<close> (clasimp_method' best_simp_tac) "combined best and simp" #>
+ Method.setup \<^binding>\<open>force\<close> (clasimp_method' force_tac) "force" #>
+ Method.setup \<^binding>\<open>auto\<close> auto_method "auto" #>
+ Method.setup \<^binding>\<open>clarsimp\<close> (clasimp_method' (CHANGED_PROP oo clarsimp_tac))
"clarify simplified goal");
end;
--- a/src/Provers/classical.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Provers/classical.ML Fri Jan 04 23:22:53 2019 +0100
@@ -902,15 +902,15 @@
val _ =
Theory.setup
- (Attrib.setup @{binding swapped} (Scan.succeed swapped)
+ (Attrib.setup \<^binding>\<open>swapped\<close> (Scan.succeed swapped)
"classical swap of introduction rule" #>
- Attrib.setup @{binding dest} (Context_Rules.add safe_dest unsafe_dest Context_Rules.dest_query)
+ Attrib.setup \<^binding>\<open>dest\<close> (Context_Rules.add safe_dest unsafe_dest Context_Rules.dest_query)
"declaration of Classical destruction rule" #>
- Attrib.setup @{binding elim} (Context_Rules.add safe_elim unsafe_elim Context_Rules.elim_query)
+ Attrib.setup \<^binding>\<open>elim\<close> (Context_Rules.add safe_elim unsafe_elim Context_Rules.elim_query)
"declaration of Classical elimination rule" #>
- Attrib.setup @{binding intro} (Context_Rules.add safe_intro unsafe_intro Context_Rules.intro_query)
+ Attrib.setup \<^binding>\<open>intro\<close> (Context_Rules.add safe_intro unsafe_intro Context_Rules.intro_query)
"declaration of Classical introduction rule" #>
- Attrib.setup @{binding rule} (Scan.lift Args.del >> K rule_del)
+ Attrib.setup \<^binding>\<open>rule\<close> (Scan.lift Args.del >> K rule_del)
"remove declaration of intro/elim/dest rule");
@@ -964,41 +964,41 @@
val _ =
Theory.setup
- (Method.setup @{binding standard} (Scan.succeed (METHOD o standard_tac))
+ (Method.setup \<^binding>\<open>standard\<close> (Scan.succeed (METHOD o standard_tac))
"standard proof step: classical intro/elim rule or class introduction" #>
- Method.setup @{binding rule}
+ Method.setup \<^binding>\<open>rule\<close>
(Attrib.thms >> (fn rules => fn ctxt => METHOD (HEADGOAL o rule_tac ctxt rules)))
"apply some intro/elim rule (potentially classical)" #>
- Method.setup @{binding contradiction}
+ Method.setup \<^binding>\<open>contradiction\<close>
(Scan.succeed (fn ctxt => Method.rule ctxt [Data.not_elim, Drule.rotate_prems 1 Data.not_elim]))
"proof by contradiction" #>
- Method.setup @{binding clarify} (cla_method' (CHANGED_PROP oo clarify_tac))
+ Method.setup \<^binding>\<open>clarify\<close> (cla_method' (CHANGED_PROP oo clarify_tac))
"repeatedly apply safe steps" #>
- Method.setup @{binding fast} (cla_method' fast_tac) "classical prover (depth-first)" #>
- Method.setup @{binding slow} (cla_method' slow_tac) "classical prover (slow depth-first)" #>
- Method.setup @{binding best} (cla_method' best_tac) "classical prover (best-first)" #>
- Method.setup @{binding deepen}
+ Method.setup \<^binding>\<open>fast\<close> (cla_method' fast_tac) "classical prover (depth-first)" #>
+ Method.setup \<^binding>\<open>slow\<close> (cla_method' slow_tac) "classical prover (slow depth-first)" #>
+ Method.setup \<^binding>\<open>best\<close> (cla_method' best_tac) "classical prover (best-first)" #>
+ Method.setup \<^binding>\<open>deepen\<close>
(Scan.lift (Scan.optional Parse.nat 4) --| Method.sections cla_modifiers
>> (fn n => fn ctxt => SIMPLE_METHOD' (deepen_tac ctxt n)))
"classical prover (iterative deepening)" #>
- Method.setup @{binding safe} (cla_method (CHANGED_PROP o safe_tac))
+ Method.setup \<^binding>\<open>safe\<close> (cla_method (CHANGED_PROP o safe_tac))
"classical prover (apply safe rules)" #>
- Method.setup @{binding safe_step} (cla_method' safe_step_tac)
+ Method.setup \<^binding>\<open>safe_step\<close> (cla_method' safe_step_tac)
"single classical step (safe rules)" #>
- Method.setup @{binding inst_step} (cla_method' inst_step_tac)
+ Method.setup \<^binding>\<open>inst_step\<close> (cla_method' inst_step_tac)
"single classical step (safe rules, allow instantiations)" #>
- Method.setup @{binding step} (cla_method' step_tac)
+ Method.setup \<^binding>\<open>step\<close> (cla_method' step_tac)
"single classical step (safe and unsafe rules)" #>
- Method.setup @{binding slow_step} (cla_method' slow_step_tac)
+ Method.setup \<^binding>\<open>slow_step\<close> (cla_method' slow_step_tac)
"single classical step (safe and unsafe rules, allow backtracking)" #>
- Method.setup @{binding clarify_step} (cla_method' clarify_step_tac)
+ Method.setup \<^binding>\<open>clarify_step\<close> (cla_method' clarify_step_tac)
"single classical step (safe rules, without splitting)");
(** outer syntax **)
val _ =
- Outer_Syntax.command @{command_keyword print_claset} "print context of Classical Reasoner"
+ Outer_Syntax.command \<^command_keyword>\<open>print_claset\<close> "print context of Classical Reasoner"
(Scan.succeed (Toplevel.keep (print_claset o Toplevel.context_of)));
end;
--- a/src/Provers/hypsubst.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Provers/hypsubst.ML Fri Jan 04 23:22:53 2019 +0100
@@ -112,8 +112,8 @@
orelse exists (curry Logic.occs (Free f)) ts
then (orient, true) else raise Match
| check_free ts (orient, _) = (orient, false)
- fun eq_var_aux k (Const(@{const_name Pure.all},_) $ Abs(_,_,t)) hs = eq_var_aux k t hs
- | eq_var_aux k (Const(@{const_name Pure.imp},_) $ A $ B) hs =
+ fun eq_var_aux k (Const(\<^const_name>\<open>Pure.all\<close>,_) $ Abs(_,_,t)) hs = eq_var_aux k t hs
+ | eq_var_aux k (Const(\<^const_name>\<open>Pure.imp\<close>,_) $ A $ B) hs =
((k, check_free (B :: hs) (inspect_pair bnd novars
(Data.dest_eq (Data.dest_Trueprop A))))
handle TERM _ => eq_var_aux (k+1) B (A :: hs)
@@ -227,7 +227,7 @@
gen_hyp_subst_tac ctxt false, vars_gen_hyp_subst_tac ctxt false,
if thin then thin_free_eq_tac ctxt else K no_tac];
-val hyp_subst_thin = Attrib.setup_config_bool @{binding hypsubst_thin} (K false);
+val hyp_subst_thin = Attrib.setup_config_bool \<^binding>\<open>hypsubst_thin\<close> (K false);
fun hyp_subst_tac ctxt =
hyp_subst_tac_thin (Config.get ctxt hyp_subst_thin) ctxt;
@@ -299,14 +299,14 @@
val _ =
Theory.setup
- (Method.setup @{binding hypsubst}
+ (Method.setup \<^binding>\<open>hypsubst\<close>
(Scan.succeed (fn ctxt => SIMPLE_METHOD' (CHANGED_PROP o hyp_subst_tac ctxt)))
"substitution using an assumption (improper)" #>
- Method.setup @{binding hypsubst_thin}
+ Method.setup \<^binding>\<open>hypsubst_thin\<close>
(Scan.succeed (fn ctxt => SIMPLE_METHOD'
(CHANGED_PROP o hyp_subst_tac_thin true ctxt)))
"substitution using an assumption, eliminating assumptions" #>
- Method.setup @{binding simplesubst}
+ Method.setup \<^binding>\<open>simplesubst\<close>
(Attrib.thm >> (fn th => fn ctxt => SIMPLE_METHOD' (stac ctxt th)))
"simple substitution");
--- a/src/Provers/splitter.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Provers/splitter.ML Fri Jan 04 23:22:53 2019 +0100
@@ -57,7 +57,7 @@
fun split_thm_info thm =
(case Thm.concl_of (Data.mk_eq thm) of
- Const(@{const_name Pure.eq}, _) $ (Var _ $ t) $ c =>
+ Const(\<^const_name>\<open>Pure.eq\<close>, _) $ (Var _ $ t) $ c =>
(case strip_comb t of
(Const p, _) => (p, case c of (Const (s, _) $ _) => s = const_not | _ => false)
| _ => split_format_err ())
@@ -98,9 +98,9 @@
val meta_iffD = Data.meta_eq_to_iff RS Data.iffD; (* (P == Q) ==> Q ==> P *)
-val lift = Goal.prove_global @{theory Pure} ["P", "Q", "R"]
- [Syntax.read_prop_global @{theory Pure} "!!x :: 'b. Q(x) == R(x) :: 'c"]
- (Syntax.read_prop_global @{theory Pure} "P(%x. Q(x)) == P(%x. R(x))")
+val lift = Goal.prove_global \<^theory>\<open>Pure\<close> ["P", "Q", "R"]
+ [Syntax.read_prop_global \<^theory>\<open>Pure\<close> "!!x :: 'b. Q(x) == R(x) :: 'c"]
+ (Syntax.read_prop_global \<^theory>\<open>Pure\<close> "P(%x. Q(x)) == P(%x. R(x))")
(fn {context = ctxt, prems} =>
rewrite_goals_tac ctxt prems THEN resolve_tac ctxt [reflexive_thm] 1)
@@ -393,9 +393,9 @@
fun tac (t,i) =
let val n = find_index (exists_Const (member (op =) cname_list o #1))
(Logic.strip_assums_hyp t);
- fun first_prem_is_disj (Const (@{const_name Pure.imp}, _) $ (Const (c, _)
+ fun first_prem_is_disj (Const (\<^const_name>\<open>Pure.imp\<close>, _) $ (Const (c, _)
$ (Const (s, _) $ _ $ _ )) $ _ ) = c = const_Trueprop andalso s = const_or
- | first_prem_is_disj (Const(@{const_name Pure.all},_)$Abs(_,_,t)) =
+ | first_prem_is_disj (Const(\<^const_name>\<open>Pure.all\<close>,_)$Abs(_,_,t)) =
first_prem_is_disj t
| first_prem_is_disj _ = false;
(* does not work properly if the split variable is bound by a quantifier *)
@@ -470,7 +470,7 @@
|| Scan.succeed (split_add false));
val _ = Theory.setup
- (Attrib.setup @{binding split} add_del "declare case split rule");
+ (Attrib.setup \<^binding>\<open>split\<close> add_del "declare case split rule");
(* methods *)
@@ -482,7 +482,7 @@
val _ =
Theory.setup
- (Method.setup @{binding split}
+ (Method.setup \<^binding>\<open>split\<close>
(Attrib.thms >> (fn ths => fn ctxt => SIMPLE_METHOD' (CHANGED_PROP o gen_split_tac ctxt ths)))
"apply case split rule");
--- a/src/Sequents/ILL.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Sequents/ILL.thy Fri Jan 04 23:22:53 2019 +0100
@@ -34,15 +34,15 @@
"_PromAux" :: "three_seqe" ("promaux {_||_||_}")
parse_translation \<open>
- [(@{syntax_const "_Trueprop"}, K (single_tr @{const_syntax Trueprop})),
- (@{syntax_const "_Context"}, K (two_seq_tr @{const_syntax Context})),
- (@{syntax_const "_PromAux"}, K (three_seq_tr @{const_syntax PromAux}))]
+ [(\<^syntax_const>\<open>_Trueprop\<close>, K (single_tr \<^const_syntax>\<open>Trueprop\<close>)),
+ (\<^syntax_const>\<open>_Context\<close>, K (two_seq_tr \<^const_syntax>\<open>Context\<close>)),
+ (\<^syntax_const>\<open>_PromAux\<close>, K (three_seq_tr \<^const_syntax>\<open>PromAux\<close>))]
\<close>
print_translation \<open>
- [(@{const_syntax Trueprop}, K (single_tr' @{syntax_const "_Trueprop"})),
- (@{const_syntax Context}, K (two_seq_tr' @{syntax_const "_Context"})),
- (@{const_syntax PromAux}, K (three_seq_tr' @{syntax_const "_PromAux"}))]
+ [(\<^const_syntax>\<open>Trueprop\<close>, K (single_tr' \<^syntax_const>\<open>_Trueprop\<close>)),
+ (\<^const_syntax>\<open>Context\<close>, K (two_seq_tr' \<^syntax_const>\<open>_Context\<close>)),
+ (\<^const_syntax>\<open>PromAux\<close>, K (three_seq_tr' \<^syntax_const>\<open>_PromAux\<close>))]
\<close>
definition liff :: "[o, o] \<Rightarrow> o" (infixr "o-o" 45)
@@ -271,14 +271,14 @@
ML \<open>
val safe_pack =
- @{context}
+ \<^context>
|> fold_rev Cla.add_safe @{thms conj_lemma ll_mp contrad1
contrad2 mp_rule1 mp_rule2 o_a_rule a_not_a_rule}
|> Cla.add_unsafe @{thm aux_impl}
|> Cla.get_pack;
val power_pack =
- Cla.put_pack safe_pack @{context}
+ Cla.put_pack safe_pack \<^context>
|> Cla.add_unsafe @{thm impr_contr_der}
|> Cla.get_pack;
\<close>
--- a/src/Sequents/LK.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Sequents/LK.thy Fri Jan 04 23:22:53 2019 +0100
@@ -178,10 +178,10 @@
apply (lem p1)
apply safe
apply (tactic \<open>
- REPEAT (resolve_tac @{context} @{thms cut} 1 THEN
+ REPEAT (resolve_tac \<^context> @{thms cut} 1 THEN
DEPTH_SOLVE_1
- (resolve_tac @{context} [@{thm thinL}, @{thm thinR}, @{thm p2} COMP @{thm monotonic}] 1) THEN
- Cla.safe_tac @{context} 1)\<close>)
+ (resolve_tac \<^context> [@{thm thinL}, @{thm thinR}, @{thm p2} COMP @{thm monotonic}] 1) THEN
+ Cla.safe_tac \<^context> 1)\<close>)
done
lemma conj_cong:
@@ -191,10 +191,10 @@
apply (lem p1)
apply safe
apply (tactic \<open>
- REPEAT (resolve_tac @{context} @{thms cut} 1 THEN
+ REPEAT (resolve_tac \<^context> @{thms cut} 1 THEN
DEPTH_SOLVE_1
- (resolve_tac @{context} [@{thm thinL}, @{thm thinR}, @{thm p2} COMP @{thm monotonic}] 1) THEN
- Cla.safe_tac @{context} 1)\<close>)
+ (resolve_tac \<^context> [@{thm thinL}, @{thm thinR}, @{thm p2} COMP @{thm monotonic}] 1) THEN
+ Cla.safe_tac \<^context> 1)\<close>)
done
lemma eq_sym_conv: "\<turnstile> x = y \<longleftrightarrow> y = x"
--- a/src/Sequents/LK0.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Sequents/LK0.thy Fri Jan 04 23:22:53 2019 +0100
@@ -34,8 +34,8 @@
syntax
"_Trueprop" :: "two_seqe" ("((_)/ \<turnstile> (_))" [6,6] 5)
-parse_translation \<open>[(@{syntax_const "_Trueprop"}, K (two_seq_tr @{const_syntax Trueprop}))]\<close>
-print_translation \<open>[(@{const_syntax Trueprop}, K (two_seq_tr' @{syntax_const "_Trueprop"}))]\<close>
+parse_translation \<open>[(\<^syntax_const>\<open>_Trueprop\<close>, K (two_seq_tr \<^const_syntax>\<open>Trueprop\<close>))]\<close>
+print_translation \<open>[(\<^const_syntax>\<open>Trueprop\<close>, K (two_seq_tr' \<^syntax_const>\<open>_Trueprop\<close>))]\<close>
abbreviation
not_equal (infixl "\<noteq>" 50) where
@@ -200,15 +200,15 @@
conjR conjL
FalseL TrueR
refl basic
-ML \<open>val prop_pack = Cla.get_pack @{context}\<close>
+ML \<open>val prop_pack = Cla.get_pack \<^context>\<close>
lemmas [safe] = exL allR
lemmas [unsafe] = the_equality exR_thin allL_thin
-ML \<open>val LK_pack = Cla.get_pack @{context}\<close>
+ML \<open>val LK_pack = Cla.get_pack \<^context>\<close>
ML \<open>
val LK_dup_pack =
- Cla.put_pack prop_pack @{context}
+ Cla.put_pack prop_pack \<^context>
|> fold_rev Cla.add_safe @{thms allR exL}
|> fold_rev Cla.add_unsafe @{thms allL exR the_equality}
|> Cla.get_pack;
--- a/src/Sequents/Modal0.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Sequents/Modal0.thy Fri Jan 04 23:22:53 2019 +0100
@@ -25,13 +25,13 @@
\<close>
parse_translation \<open>
- [(@{syntax_const "_Lstar"}, K (star_tr @{const_syntax Lstar})),
- (@{syntax_const "_Rstar"}, K (star_tr @{const_syntax Rstar}))]
+ [(\<^syntax_const>\<open>_Lstar\<close>, K (star_tr \<^const_syntax>\<open>Lstar\<close>)),
+ (\<^syntax_const>\<open>_Rstar\<close>, K (star_tr \<^const_syntax>\<open>Rstar\<close>))]
\<close>
print_translation \<open>
- [(@{const_syntax Lstar}, K (star_tr' @{syntax_const "_Lstar"})),
- (@{const_syntax Rstar}, K (star_tr' @{syntax_const "_Rstar"}))]
+ [(\<^const_syntax>\<open>Lstar\<close>, K (star_tr' \<^syntax_const>\<open>_Lstar\<close>)),
+ (\<^const_syntax>\<open>Rstar\<close>, K (star_tr' \<^syntax_const>\<open>_Rstar\<close>))]
\<close>
definition strimp :: "[o,o]\<Rightarrow>o" (infixr "--<" 25)
--- a/src/Sequents/S43.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Sequents/S43.thy Fri Jan 04 23:22:53 2019 +0100
@@ -20,16 +20,16 @@
let
val tr = seq_tr;
fun s43pi_tr [s1, s2, s3, s4, s5, s6] =
- Const (@{const_syntax S43pi}, dummyT) $ tr s1 $ tr s2 $ tr s3 $ tr s4 $ tr s5 $ tr s6;
- in [(@{syntax_const "_S43pi"}, K s43pi_tr)] end
+ Const (\<^const_syntax>\<open>S43pi\<close>, dummyT) $ tr s1 $ tr s2 $ tr s3 $ tr s4 $ tr s5 $ tr s6;
+ in [(\<^syntax_const>\<open>_S43pi\<close>, K s43pi_tr)] end
\<close>
print_translation \<open>
let
val tr' = seq_tr';
fun s43pi_tr' [s1, s2, s3, s4, s5, s6] =
- Const(@{syntax_const "_S43pi"}, dummyT) $ tr' s1 $ tr' s2 $ tr' s3 $ tr' s4 $ tr' s5 $ tr' s6;
-in [(@{const_syntax S43pi}, K s43pi_tr')] end
+ Const(\<^syntax_const>\<open>_S43pi\<close>, dummyT) $ tr' s1 $ tr' s2 $ tr' s3 $ tr' s4 $ tr' s5 $ tr' s6;
+in [(\<^const_syntax>\<open>S43pi\<close>, K s43pi_tr')] end
\<close>
axiomatization where
--- a/src/Sequents/Sequents.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Sequents/Sequents.thy Fri Jan 04 23:22:53 2019 +0100
@@ -58,44 +58,44 @@
(* parse translation for sequences *)
-fun abs_seq' t = Abs ("s", Type (@{type_name seq'}, []), t);
+fun abs_seq' t = Abs ("s", Type (\<^type_name>\<open>seq'\<close>, []), t);
-fun seqobj_tr (Const (@{syntax_const "_SeqO"}, _) $ f) =
- Const (@{const_syntax SeqO'}, dummyT) $ f
+fun seqobj_tr (Const (\<^syntax_const>\<open>_SeqO\<close>, _) $ f) =
+ Const (\<^const_syntax>\<open>SeqO'\<close>, dummyT) $ f
| seqobj_tr (_ $ i) = i;
-fun seqcont_tr (Const (@{syntax_const "_SeqContEmp"}, _)) = Bound 0
- | seqcont_tr (Const (@{syntax_const "_SeqContApp"}, _) $ so $ sc) =
+fun seqcont_tr (Const (\<^syntax_const>\<open>_SeqContEmp\<close>, _)) = Bound 0
+ | seqcont_tr (Const (\<^syntax_const>\<open>_SeqContApp\<close>, _) $ so $ sc) =
seqobj_tr so $ seqcont_tr sc;
-fun seq_tr (Const (@{syntax_const "_SeqEmp"}, _)) = abs_seq' (Bound 0)
- | seq_tr (Const (@{syntax_const "_SeqApp"}, _) $ so $ sc) =
+fun seq_tr (Const (\<^syntax_const>\<open>_SeqEmp\<close>, _)) = abs_seq' (Bound 0)
+ | seq_tr (Const (\<^syntax_const>\<open>_SeqApp\<close>, _) $ so $ sc) =
abs_seq'(seqobj_tr so $ seqcont_tr sc);
-fun singlobj_tr (Const (@{syntax_const "_SeqO"},_) $ f) =
- abs_seq' ((Const (@{const_syntax SeqO'}, dummyT) $ f) $ Bound 0);
+fun singlobj_tr (Const (\<^syntax_const>\<open>_SeqO\<close>,_) $ f) =
+ abs_seq' ((Const (\<^const_syntax>\<open>SeqO'\<close>, dummyT) $ f) $ Bound 0);
(* print translation for sequences *)
fun seqcont_tr' (Bound 0) =
- Const (@{syntax_const "_SeqContEmp"}, dummyT)
- | seqcont_tr' (Const (@{const_syntax SeqO'}, _) $ f $ s) =
- Const (@{syntax_const "_SeqContApp"}, dummyT) $
- (Const (@{syntax_const "_SeqO"}, dummyT) $ f) $ seqcont_tr' s
+ Const (\<^syntax_const>\<open>_SeqContEmp\<close>, dummyT)
+ | seqcont_tr' (Const (\<^const_syntax>\<open>SeqO'\<close>, _) $ f $ s) =
+ Const (\<^syntax_const>\<open>_SeqContApp\<close>, dummyT) $
+ (Const (\<^syntax_const>\<open>_SeqO\<close>, dummyT) $ f) $ seqcont_tr' s
| seqcont_tr' (i $ s) =
- Const (@{syntax_const "_SeqContApp"}, dummyT) $
- (Const (@{syntax_const "_SeqId"}, dummyT) $ i) $ seqcont_tr' s;
+ Const (\<^syntax_const>\<open>_SeqContApp\<close>, dummyT) $
+ (Const (\<^syntax_const>\<open>_SeqId\<close>, dummyT) $ i) $ seqcont_tr' s;
fun seq_tr' s =
let
- fun seq_itr' (Bound 0) = Const (@{syntax_const "_SeqEmp"}, dummyT)
- | seq_itr' (Const (@{const_syntax SeqO'}, _) $ f $ s) =
- Const (@{syntax_const "_SeqApp"}, dummyT) $
- (Const (@{syntax_const "_SeqO"}, dummyT) $ f) $ seqcont_tr' s
+ fun seq_itr' (Bound 0) = Const (\<^syntax_const>\<open>_SeqEmp\<close>, dummyT)
+ | seq_itr' (Const (\<^const_syntax>\<open>SeqO'\<close>, _) $ f $ s) =
+ Const (\<^syntax_const>\<open>_SeqApp\<close>, dummyT) $
+ (Const (\<^syntax_const>\<open>_SeqO\<close>, dummyT) $ f) $ seqcont_tr' s
| seq_itr' (i $ s) =
- Const (@{syntax_const "_SeqApp"}, dummyT) $
- (Const (@{syntax_const "_SeqId"}, dummyT) $ i) $ seqcont_tr' s
+ Const (\<^syntax_const>\<open>_SeqApp\<close>, dummyT) $
+ (Const (\<^syntax_const>\<open>_SeqId\<close>, dummyT) $ i) $ seqcont_tr' s
in
case s of
Abs (_, _, t) => seq_itr' t
@@ -116,8 +116,8 @@
Const (c, dummyT) $ seq_tr s1 $ seq_tr s2 $ seq_tr s3 $ seq_tr s4;
-fun singlobj_tr' (Const (@{const_syntax SeqO'},_) $ fm) = fm
- | singlobj_tr' id = Const (@{syntax_const "_SeqId"}, dummyT) $ id;
+fun singlobj_tr' (Const (\<^const_syntax>\<open>SeqO'\<close>,_) $ fm) = fm
+ | singlobj_tr' id = Const (\<^syntax_const>\<open>_SeqId\<close>, dummyT) $ id;
fun single_tr' c [s1, s2] =
@@ -139,7 +139,7 @@
fun side_tr [s1] = seq_tr s1;
\<close>
-parse_translation \<open>[(@{syntax_const "_Side"}, K side_tr)]\<close>
+parse_translation \<open>[(\<^syntax_const>\<open>_Side\<close>, K side_tr)]\<close>
subsection \<open>Proof tools\<close>
--- a/src/Sequents/modal.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Sequents/modal.ML Fri Jan 04 23:22:53 2019 +0100
@@ -26,7 +26,7 @@
struct
(*Returns the list of all formulas in the sequent*)
-fun forms_of_seq (Const(@{const_name SeqO'},_) $ P $ u) = P :: forms_of_seq u
+fun forms_of_seq (Const(\<^const_name>\<open>SeqO'\<close>,_) $ P $ u) = P :: forms_of_seq u
| forms_of_seq (H $ u) = forms_of_seq u
| forms_of_seq _ = [];
--- a/src/Sequents/prover.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Sequents/prover.ML Fri Jan 04 23:22:53 2019 +0100
@@ -68,7 +68,7 @@
end;
val _ =
- Outer_Syntax.command @{command_keyword print_pack} "print pack of classical rules"
+ Outer_Syntax.command \<^command_keyword>\<open>print_pack\<close> "print pack of classical rules"
(Scan.succeed (Toplevel.keep (Pretty.writeln o pretty_pack o Toplevel.context_of)));
@@ -98,8 +98,8 @@
val unsafe_add = Thm.declaration_attribute (add_rule apsnd);
val _ = Theory.setup
- (Attrib.setup @{binding safe} (Scan.succeed safe_add) "" #>
- Attrib.setup @{binding unsafe} (Scan.succeed unsafe_add) "");
+ (Attrib.setup \<^binding>\<open>safe\<close> (Scan.succeed safe_add) "" #>
+ Attrib.setup \<^binding>\<open>unsafe\<close> (Scan.succeed unsafe_add) "");
(* proof method syntax *)
@@ -113,11 +113,11 @@
(** tactics **)
-val trace = Attrib.setup_config_bool @{binding cla_trace} (K false);
+val trace = Attrib.setup_config_bool \<^binding>\<open>cla_trace\<close> (K false);
(*Returns the list of all formulas in the sequent*)
-fun forms_of_seq (Const(@{const_name "SeqO'"},_) $ P $ u) = P :: forms_of_seq u
+fun forms_of_seq (Const(\<^const_name>\<open>SeqO'\<close>,_) $ P $ u) = P :: forms_of_seq u
| forms_of_seq (H $ u) = forms_of_seq u
| forms_of_seq _ = [];
@@ -227,11 +227,11 @@
SELECT_GOAL (BEST_FIRST (has_fewer_prems 1, size_of_thm) (step_tac ctxt 1));
val _ = Theory.setup
- (Method.setup @{binding safe} (method safe_tac) "" #>
- Method.setup @{binding step} (method step_tac) "" #>
- Method.setup @{binding pc} (method pc_tac) "" #>
- Method.setup @{binding fast} (method fast_tac) "" #>
- Method.setup @{binding best} (method best_tac) "");
+ (Method.setup \<^binding>\<open>safe\<close> (method safe_tac) "" #>
+ Method.setup \<^binding>\<open>step\<close> (method step_tac) "" #>
+ Method.setup \<^binding>\<open>pc\<close> (method pc_tac) "" #>
+ Method.setup \<^binding>\<open>fast\<close> (method fast_tac) "" #>
+ Method.setup \<^binding>\<open>best\<close> (method best_tac) "");
end;
--- a/src/Sequents/simpdata.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Sequents/simpdata.ML Fri Jan 04 23:22:53 2019 +0100
@@ -13,30 +13,30 @@
(*Make atomic rewrite rules*)
fun atomize r =
case Thm.concl_of r of
- Const(@{const_name Trueprop},_) $ Abs(_,_,a) $ Abs(_,_,c) =>
+ Const(\<^const_name>\<open>Trueprop\<close>,_) $ Abs(_,_,a) $ Abs(_,_,c) =>
(case (Cla.forms_of_seq a, Cla.forms_of_seq c) of
([], [p]) =>
(case p of
- Const(@{const_name imp},_)$_$_ => atomize(r RS @{thm mp_R})
- | Const(@{const_name conj},_)$_$_ => atomize(r RS @{thm conjunct1}) @
+ Const(\<^const_name>\<open>imp\<close>,_)$_$_ => atomize(r RS @{thm mp_R})
+ | Const(\<^const_name>\<open>conj\<close>,_)$_$_ => atomize(r RS @{thm conjunct1}) @
atomize(r RS @{thm conjunct2})
- | Const(@{const_name All},_)$_ => atomize(r RS @{thm spec})
- | Const(@{const_name True},_) => [] (*True is DELETED*)
- | Const(@{const_name False},_) => [] (*should False do something?*)
+ | Const(\<^const_name>\<open>All\<close>,_)$_ => atomize(r RS @{thm spec})
+ | Const(\<^const_name>\<open>True\<close>,_) => [] (*True is DELETED*)
+ | Const(\<^const_name>\<open>False\<close>,_) => [] (*should False do something?*)
| _ => [r])
| _ => []) (*ignore theorem unless it has precisely one conclusion*)
| _ => [r];
(*Make meta-equalities.*)
fun mk_meta_eq ctxt th = case Thm.concl_of th of
- Const(@{const_name Pure.eq},_)$_$_ => th
- | Const(@{const_name Trueprop},_) $ Abs(_,_,a) $ Abs(_,_,c) =>
+ Const(\<^const_name>\<open>Pure.eq\<close>,_)$_$_ => th
+ | Const(\<^const_name>\<open>Trueprop\<close>,_) $ Abs(_,_,a) $ Abs(_,_,c) =>
(case (Cla.forms_of_seq a, Cla.forms_of_seq c) of
([], [p]) =>
(case p of
- (Const(@{const_name equal},_)$_$_) => th RS @{thm eq_reflection}
- | (Const(@{const_name iff},_)$_$_) => th RS @{thm iff_reflection}
- | (Const(@{const_name Not},_)$_) => th RS @{thm iff_reflection_F}
+ (Const(\<^const_name>\<open>equal\<close>,_)$_$_) => th RS @{thm eq_reflection}
+ | (Const(\<^const_name>\<open>iff\<close>,_)$_$_) => th RS @{thm iff_reflection}
+ | (Const(\<^const_name>\<open>Not\<close>,_)$_) => th RS @{thm iff_reflection_F}
| _ => th RS @{thm iff_reflection_T})
| _ => error ("addsimps: unable to use theorem\n" ^ Thm.string_of_thm ctxt th));
@@ -67,7 +67,7 @@
(*No simprules, but basic infrastructure for simplification*)
val LK_basic_ss =
- empty_simpset @{context}
+ empty_simpset \<^context>
setSSolver (mk_solver "safe" safe_solver)
setSolver (mk_solver "unsafe" unsafe_solver)
|> Simplifier.set_subgoaler asm_simp_tac
@@ -85,7 +85,7 @@
@{thms LK_extra_simps};
val LK_ss =
- put_simpset LK_basic_ss @{context} addsimps LK_simps
+ put_simpset LK_basic_ss \<^context> addsimps LK_simps
|> Simplifier.add_eqcong @{thm left_cong}
|> Simplifier.add_cong @{thm imp_cong}
|> simpset_of;
--- a/src/Tools/Code/code_haskell.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/Code/code_haskell.ML Fri Jan 04 23:22:53 2019 +0100
@@ -516,7 +516,7 @@
#> fold (fold (Code_Target.add_reserved target) o snd) prelude_import_unqualified_constr);
val _ =
- Outer_Syntax.command @{command_keyword code_monad} "define code syntax for monads"
+ Outer_Syntax.command \<^command_keyword>\<open>code_monad\<close> "define code syntax for monads"
(Parse.term -- Parse.name >> (fn (raw_bind, target) =>
Toplevel.theory (add_monad target raw_bind)));
--- a/src/Tools/Code/code_preproc.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/Code/code_preproc.ML Fri Jan 04 23:22:53 2019 +0100
@@ -51,7 +51,7 @@
(** timing **)
-val timing = Attrib.setup_config_bool @{binding code_timing} (K false);
+val timing = Attrib.setup_config_bool \<^binding>\<open>code_timing\<close> (K false);
fun timed msg ctxt_of f x =
if Config.get (ctxt_of x) timing
@@ -147,8 +147,8 @@
fun trans_comb eq1 eq2 =
(*explicit assertions: evaluation conversion stacks are error-prone*)
- if Thm.is_reflexive eq1 then (@{assert} (matches_transitive eq1 eq2); eq2)
- else if Thm.is_reflexive eq2 then (@{assert} (matches_transitive eq1 eq2); eq1)
+ if Thm.is_reflexive eq1 then (\<^assert> (matches_transitive eq1 eq2); eq2)
+ else if Thm.is_reflexive eq2 then (\<^assert> (matches_transitive eq1 eq2); eq1)
else Thm.transitive eq1 eq2;
fun trans_conv_rule conv eq = trans_comb eq (conv (Thm.rhs_of eq));
@@ -629,13 +629,13 @@
Attrib.add_del (mk_attribute (process Simplifier.add_simp))
(mk_attribute (process Simplifier.del_simp));
in
- Attrib.setup @{binding code_unfold} (add_del_attribute_parser process_unfold)
+ Attrib.setup \<^binding>\<open>code_unfold\<close> (add_del_attribute_parser process_unfold)
"preprocessing equations for code generator"
- #> Attrib.setup @{binding code_post} (add_del_attribute_parser process_post)
+ #> Attrib.setup \<^binding>\<open>code_post\<close> (add_del_attribute_parser process_post)
"postprocessing equations for code generator"
- #> Attrib.setup @{binding code_abbrev} (add_del_attribute_parser process_abbrev)
+ #> Attrib.setup \<^binding>\<open>code_abbrev\<close> (add_del_attribute_parser process_abbrev)
"post- and preprocessing equations for code generator"
- #> Attrib.setup @{binding code_preproc_trace}
+ #> Attrib.setup \<^binding>\<open>code_preproc_trace\<close>
((Scan.lift (Args.$$$ "off" >> K trace_none)
|| (Scan.lift (Args.$$$ "only" |-- Args.colon |-- Scan.repeat1 Parse.term))
>> trace_only_ext
@@ -644,7 +644,7 @@
end);
val _ =
- Outer_Syntax.command @{command_keyword print_codeproc} "print code preprocessor setup"
+ Outer_Syntax.command \<^command_keyword>\<open>print_codeproc\<close> "print code preprocessor setup"
(Scan.succeed (Toplevel.keep (print_codeproc o Toplevel.context_of)));
end; (*struct*)
--- a/src/Tools/Code/code_printer.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/Code/code_printer.ML Fri Jan 04 23:22:53 2019 +0100
@@ -400,7 +400,7 @@
end;
val parse_fixity =
- (@{keyword "infix"} >> K X) || (@{keyword "infixl"} >> K L) || (@{keyword "infixr"} >> K R)
+ (\<^keyword>\<open>infix\<close> >> K X) || (\<^keyword>\<open>infixl\<close> >> K L) || (\<^keyword>\<open>infixr\<close> >> K R)
fun parse_mixfix x =
(Parse.string >> read_mixfix
--- a/src/Tools/Code/code_runtime.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/Code/code_runtime.ML Fri Jan 04 23:22:53 2019 +0100
@@ -52,15 +52,15 @@
val _ = Theory.setup
(Code_Target.add_derived_target (target, [(Code_ML.target_SML, I)])
- #> Code_Target.set_printings (Type_Constructor (@{type_name prop},
+ #> Code_Target.set_printings (Type_Constructor (\<^type_name>\<open>prop\<close>,
[(target, SOME (0, (K o K o K) (Code_Printer.str truthN)))]))
- #> Code_Target.set_printings (Constant (@{const_name Code_Generator.holds},
+ #> Code_Target.set_printings (Constant (\<^const_name>\<open>Code_Generator.holds\<close>,
[(target, SOME (Code_Printer.plain_const_syntax HoldsN))]))
#> Code_Target.add_reserved target thisN
#> fold (Code_Target.add_reserved target) ["oo", "ooo", "oooo", "upto", "downto", "orf", "andf"]);
(*avoid further pervasive infix names*)
-val trace = Attrib.setup_config_bool @{binding "code_runtime_trace"} (K false);
+val trace = Attrib.setup_config_bool \<^binding>\<open>code_runtime_trace\<close> (K false);
fun compile_ML verbose code context =
(if Config.get_generic context trace then tracing code else ();
@@ -142,16 +142,16 @@
val _ = if fastype_of t <> propT
then error ("Not a proposition: " ^ Syntax.string_of_term ctxt t)
else ();
- val iff = Thm.cterm_of ctxt (Term.Const (@{const_name Pure.eq}, propT --> propT --> propT));
+ val iff = Thm.cterm_of ctxt (Term.Const (\<^const_name>\<open>Pure.eq\<close>, propT --> propT --> propT));
val result = case partiality_as_none (run_compilation_text truth_cookie ctxt evaluator vs_t [])
of SOME Holds => true
| _ => false;
in
- Thm.mk_binop iff ct (if result then @{cprop "PROP Code_Generator.holds"} else ct)
+ Thm.mk_binop iff ct (if result then \<^cprop>\<open>PROP Code_Generator.holds\<close> else ct)
end;
val (_, raw_check_holds_oracle) = Context.>>> (Context.map_theory_result
- (Thm.add_oracle (@{binding holds_by_evaluation},
+ (Thm.add_oracle (\<^binding>\<open>holds_by_evaluation\<close>,
fn (ctxt, evaluator, vs_t, ct) => check_holds ctxt evaluator vs_t ct)));
fun check_holds_oracle ctxt evaluator vs_ty_t ct =
@@ -369,7 +369,7 @@
in fn ctxt' => Pattern.rewrite_term (Proof_Context.theory_of ctxt') rules [] end;
val _ = Theory.setup
- (Attrib.setup @{binding code_computation_unfold}
+ (Attrib.setup \<^binding>\<open>code_computation_unfold\<close>
(Scan.succeed (Thm.declaration_attribute (fn thm => Context.mapping (add thm) I)))
"preprocessing equations for computation");
@@ -413,16 +413,16 @@
local
-fun holds ct = Thm.mk_binop @{cterm "Pure.eq :: prop \<Rightarrow> prop \<Rightarrow> prop"}
- ct @{cprop "PROP Code_Generator.holds"};
+fun holds ct = Thm.mk_binop \<^cterm>\<open>Pure.eq :: prop \<Rightarrow> prop \<Rightarrow> prop\<close>
+ ct \<^cprop>\<open>PROP Code_Generator.holds\<close>;
val (_, holds_oracle) = Context.>>> (Context.map_theory_result
- (Thm.add_oracle (@{binding holds}, holds)));
+ (Thm.add_oracle (\<^binding>\<open>holds\<close>, holds)));
in
fun mount_computation_check ctxt cTs raw_computation =
- mount_computation_conv ctxt cTs @{typ prop} raw_computation
+ mount_computation_conv ctxt cTs \<^typ>\<open>prop\<close> raw_computation
((K o K) holds_oracle);
end;
@@ -595,7 +595,7 @@
mount_computation_checkN,
"(Context.proof_of (Context.the_generic_context ()))",
Long_Name.implode [prfx, generated_computationN, covered_constsN],
- Long_Name.append prfx (of_term_for_typ @{typ prop})
+ Long_Name.append prfx (of_term_for_typ \<^typ>\<open>prop\<close>)
]) ctxt;
@@ -652,7 +652,7 @@
fun ml_computation_check_antiq raw_spec ctxt =
let
val cTs = insert (op =) (dest_Const @{const holds}) (prep_spec ctxt raw_spec);
- in (print_computation_check ctxt, register_computation cTs @{typ prop} ctxt) end;
+ in (print_computation_check ctxt, register_computation cTs \<^typ>\<open>prop\<close> ctxt) end;
end; (*local*)
@@ -755,13 +755,13 @@
in
val _ = Theory.setup
- (ML_Antiquotation.declaration @{binding code}
+ (ML_Antiquotation.declaration \<^binding>\<open>code\<close>
Args.term (K ml_code_antiq)
- #> ML_Antiquotation.declaration @{binding computation}
+ #> ML_Antiquotation.declaration \<^binding>\<open>computation\<close>
(Args.typ -- parse_consts_spec) (K ml_computation_antiq)
- #> ML_Antiquotation.declaration @{binding computation_conv}
+ #> ML_Antiquotation.declaration \<^binding>\<open>computation_conv\<close>
(Args.typ -- parse_consts_spec) (K ml_computation_conv_antiq)
- #> ML_Antiquotation.declaration @{binding computation_check}
+ #> ML_Antiquotation.declaration \<^binding>\<open>computation_check\<close>
parse_consts_spec (K ml_computation_check_antiq));
end;
@@ -769,19 +769,19 @@
local
val parse_datatype =
- Parse.name -- Scan.optional (@{keyword "="} |--
+ Parse.name -- Scan.optional (\<^keyword>\<open>=\<close> |--
(((Parse.sym_ident || Parse.string) >> (fn "_" => NONE | _ => Scan.fail ()))
- || ((Parse.term ::: (Scan.repeat (@{keyword "|"} |-- Parse.term))) >> SOME))) (SOME []);
+ || ((Parse.term ::: (Scan.repeat (\<^keyword>\<open>|\<close> |-- Parse.term))) >> SOME))) (SOME []);
in
val _ =
- Outer_Syntax.command @{command_keyword code_reflect}
+ Outer_Syntax.command \<^command_keyword>\<open>code_reflect\<close>
"enrich runtime environment with generated code"
- (Parse.name -- Scan.optional (@{keyword "datatypes"} |-- Parse.!!! (parse_datatype
- ::: Scan.repeat (@{keyword "and"} |-- parse_datatype))) []
- -- Scan.optional (@{keyword "functions"} |-- Parse.!!! (Scan.repeat1 Parse.name)) []
- -- Scan.option (@{keyword "file"} |-- Parse.!!! Parse.name)
+ (Parse.name -- Scan.optional (\<^keyword>\<open>datatypes\<close> |-- Parse.!!! (parse_datatype
+ ::: Scan.repeat (\<^keyword>\<open>and\<close> |-- parse_datatype))) []
+ -- Scan.optional (\<^keyword>\<open>functions\<close> |-- Parse.!!! (Scan.repeat1 Parse.name)) []
+ -- Scan.option (\<^keyword>\<open>file\<close> |-- Parse.!!! Parse.name)
>> (fn (((module_name, raw_datatypes), raw_functions), some_file) => Toplevel.theory
(code_reflect_cmd raw_datatypes raw_functions module_name some_file)));
--- a/src/Tools/Code/code_simp.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/Code/code_simp.ML Fri Jan 04 23:22:53 2019 +0100
@@ -39,7 +39,7 @@
(* diagnostic *)
-val trace = Attrib.setup_config_bool @{binding "code_simp_trace"} (K false);
+val trace = Attrib.setup_config_bool \<^binding>\<open>code_simp_trace\<close> (K false);
fun set_trace ctxt =
let
@@ -93,7 +93,7 @@
snd o Logic.dest_equals o Thm.prop_of o dynamic_conv ctxt o Thm.cterm_of ctxt;
val _ = Theory.setup
- (Method.setup @{binding code_simp}
+ (Method.setup \<^binding>\<open>code_simp\<close>
(Scan.succeed (SIMPLE_METHOD' o (CHANGED_PROP oo dynamic_tac)))
"simplification with code equations");
--- a/src/Tools/Code/code_target.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/Code/code_target.ML Fri Jan 04 23:22:53 2019 +0100
@@ -99,7 +99,7 @@
val _ = Axclass.get_info (Proof_Context.theory_of ctxt) class;
in class end;
-val parse_classrel_ident = Parse.class --| @{keyword "<"} -- Parse.class;
+val parse_classrel_ident = Parse.class --| \<^keyword>\<open><\<close> -- Parse.class;
fun cert_inst ctxt (class, tyco) =
(cert_class ctxt class, cert_tyco ctxt tyco);
@@ -107,7 +107,7 @@
fun read_inst ctxt (raw_tyco, raw_class) =
(read_tyco ctxt raw_tyco, Proof_Context.read_class ctxt raw_class);
-val parse_inst_ident = Parse.name --| @{keyword "::"} -- Parse.class;
+val parse_inst_ident = Parse.name --| \<^keyword>\<open>::\<close> -- Parse.class;
fun cert_syms ctxt =
Code_Symbol.map_attr (cert_const ctxt) (cert_tyco ctxt)
@@ -285,7 +285,7 @@
(* technical aside: pretty printing width *)
-val default_code_width = Attrib.setup_config_int @{binding "default_code_width"} (K 80);
+val default_code_width = Attrib.setup_config_int \<^binding>\<open>default_code_width\<close> (K 80);
(* montage *)
@@ -519,7 +519,7 @@
in
val _ = Theory.setup
- (Thy_Output.antiquotation_raw @{binding code_stmts}
+ (Thy_Output.antiquotation_raw \<^binding>\<open>code_stmts\<close>
(parse_const_terms --
Scan.repeat (parse_consts || parse_types || parse_classes || parse_instances)
-- Scan.lift (Args.parens (Args.name -- Scan.option Parse.int)))
@@ -625,8 +625,8 @@
(** Isar setup **)
val (constantK, type_constructorK, type_classK, class_relationK, class_instanceK, code_moduleK) =
- (@{keyword "constant"}, @{keyword "type_constructor"}, @{keyword "type_class"},
- @{keyword "class_relation"}, @{keyword "class_instance"}, @{keyword "code_module"});
+ (\<^keyword>\<open>constant\<close>, \<^keyword>\<open>type_constructor\<close>, \<^keyword>\<open>type_class\<close>,
+ \<^keyword>\<open>class_relation\<close>, \<^keyword>\<open>class_instance\<close>, \<^keyword>\<open>code_module\<close>);
local
@@ -648,8 +648,8 @@
end;
fun parse_single_symbol_pragma parse_keyword parse_isa parse_target =
- parse_keyword |-- Parse.!!! (parse_isa --| (@{keyword "\<rightharpoonup>"} || @{keyword "=>"})
- -- Parse.and_list1 (@{keyword "("} |-- (Parse.name --| @{keyword ")"} -- Scan.option parse_target)));
+ parse_keyword |-- Parse.!!! (parse_isa --| (\<^keyword>\<open>\<rightharpoonup>\<close> || \<^keyword>\<open>=>\<close>)
+ -- Parse.and_list1 (\<^keyword>\<open>(\<close> |-- (Parse.name --| \<^keyword>\<open>)\<close> -- Scan.option parse_target)));
fun parse_symbol_pragma parse_const parse_tyco parse_class parse_classrel parse_inst parse_module =
parse_single_symbol_pragma constantK Parse.term parse_const
@@ -669,45 +669,45 @@
Parse.enum1 "|" (Parse.group (fn () => "code symbol pragma")
(parse_symbol_pragma parse_const parse_tyco parse_class parse_classrel parse_inst parse_module));
-val code_expr_argsP = Scan.optional (@{keyword "("} |-- Parse.args --| @{keyword ")"}) [];
+val code_expr_argsP = Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.args --| \<^keyword>\<open>)\<close>) [];
fun code_expr_inP all_public raw_cs =
- Scan.repeat (@{keyword "in"} |-- Parse.!!! (Parse.name
- -- Scan.optional (@{keyword "module_name"} |-- Parse.name) ""
- -- Scan.optional (@{keyword "file"} |-- Parse.position Parse.path) ("", Position.none)
+ Scan.repeat (\<^keyword>\<open>in\<close> |-- Parse.!!! (Parse.name
+ -- Scan.optional (\<^keyword>\<open>module_name\<close> |-- Parse.name) ""
+ -- Scan.optional (\<^keyword>\<open>file\<close> |-- Parse.position Parse.path) ("", Position.none)
-- code_expr_argsP))
>> (fn seri_args => export_code_cmd all_public raw_cs seri_args);
fun code_expr_checkingP all_public raw_cs =
- (@{keyword "checking"} |-- Parse.!!!
- (Scan.repeat (Parse.name -- ((@{keyword "?"} |-- Scan.succeed false) || Scan.succeed true)
+ (\<^keyword>\<open>checking\<close> |-- Parse.!!!
+ (Scan.repeat (Parse.name -- ((\<^keyword>\<open>?\<close> |-- Scan.succeed false) || Scan.succeed true)
-- code_expr_argsP)))
>> (fn seri_args => check_code_cmd all_public raw_cs seri_args);
-val code_exprP = (Scan.optional (@{keyword "open"} |-- Scan.succeed true) false
+val code_exprP = (Scan.optional (\<^keyword>\<open>open\<close> |-- Scan.succeed true) false
-- Scan.repeat1 Parse.term)
:|-- (fn (all_public, raw_cs) => (code_expr_checkingP all_public raw_cs || code_expr_inP all_public raw_cs));
val _ =
- Outer_Syntax.command @{command_keyword code_reserved}
+ Outer_Syntax.command \<^command_keyword>\<open>code_reserved\<close>
"declare words as reserved for target language"
(Parse.name -- Scan.repeat1 Parse.name
>> (fn (target, reserveds) => (Toplevel.theory o fold (add_reserved target)) reserveds));
val _ =
- Outer_Syntax.command @{command_keyword code_identifier} "declare mandatory names for code symbols"
+ Outer_Syntax.command \<^command_keyword>\<open>code_identifier\<close> "declare mandatory names for code symbols"
(parse_symbol_pragmas Parse.name Parse.name Parse.name Parse.name Parse.name Parse.name
>> (Toplevel.theory o fold set_identifiers_cmd));
val _ =
- Outer_Syntax.command @{command_keyword code_printing} "declare dedicated printing for code symbols"
+ Outer_Syntax.command \<^command_keyword>\<open>code_printing\<close> "declare dedicated printing for code symbols"
(parse_symbol_pragmas (Code_Printer.parse_const_syntax) (Code_Printer.parse_tyco_syntax)
Parse.string (Parse.minus >> K ()) (Parse.minus >> K ())
- (Parse.text -- Scan.optional (@{keyword for} |-- parse_symbols) [])
+ (Parse.text -- Scan.optional (\<^keyword>\<open>for\<close> |-- parse_symbols) [])
>> (Toplevel.theory o fold set_printings_cmd));
val _ =
- Outer_Syntax.command @{command_keyword export_code} "generate executable code for constants"
+ Outer_Syntax.command \<^command_keyword>\<open>export_code\<close> "generate executable code for constants"
(Parse.!!! code_exprP >> (fn f => Toplevel.keep (f o Toplevel.context_of)));
end; (*struct*)
--- a/src/Tools/Code/code_thingol.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/Code/code_thingol.ML Fri Jan 04 23:22:53 2019 +0100
@@ -856,8 +856,8 @@
val ty = fastype_of t;
val vs = fold_term_types (K (fold_atyps (insert (eq_fst op =)
o dest_TFree))) t [];
- val t' = annotate ctxt algbr eqngr (@{const_name Pure.dummy_pattern}, ty) [] t;
- val dummy_constant = Constant @{const_name Pure.dummy_pattern};
+ val t' = annotate ctxt algbr eqngr (\<^const_name>\<open>Pure.dummy_pattern\<close>, ty) [] t;
+ val dummy_constant = Constant \<^const_name>\<open>Pure.dummy_pattern\<close>;
val stmt_value =
fold_map (translate_tyvar_sort ctxt algbr eqngr false) vs
##>> translate_typ ctxt algbr eqngr false ty
@@ -874,7 +874,7 @@
val program3 = Code_Symbol.Graph.restrict (member (op =) deps_all) program2;
in ((program3, ((vs_ty, t), deps')), (deps', program2)) end;
in
- ensure_stmt Constant stmt_value @{const_name Pure.dummy_pattern}
+ ensure_stmt Constant stmt_value \<^const_name>\<open>Pure.dummy_pattern\<close>
#> snd
#> term_value
end;
@@ -1024,13 +1024,13 @@
in
val _ =
- Outer_Syntax.command @{command_keyword code_thms}
+ Outer_Syntax.command \<^command_keyword>\<open>code_thms\<close>
"print system of code equations for code"
(Scan.repeat1 Parse.term >> (fn cs =>
Toplevel.keep (fn st => code_thms_cmd (Toplevel.context_of st) cs)));
val _ =
- Outer_Syntax.command @{command_keyword code_deps}
+ Outer_Syntax.command \<^command_keyword>\<open>code_deps\<close>
"visualize dependencies of code equations for code"
(Scan.repeat1 Parse.term >> (fn cs =>
Toplevel.keep (fn st => code_deps_cmd (Toplevel.context_of st) cs)));
--- a/src/Tools/Spec_Check/Examples.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/Spec_Check/Examples.thy Fri Jan 04 23:22:53 2019 +0100
@@ -76,7 +76,7 @@
ML_command \<open>
-val thy = @{theory};
+val thy = \<^theory>;
check_property "ALL t u. if Pattern.matches thy (t, u) then Term.could_unify (t, u) else true"
\<close>
--- a/src/Tools/Spec_Check/spec_check.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/Spec_Check/spec_check.ML Fri Jan 04 23:22:53 2019 +0100
@@ -32,14 +32,14 @@
(* configurations *)
-val gen_target = Attrib.setup_config_int @{binding spec_check_gen_target} (K 100)
-val gen_max = Attrib.setup_config_int @{binding spec_check_gen_max} (K 400)
-val examples = Attrib.setup_config_int @{binding spec_check_examples} (K 5)
+val gen_target = Attrib.setup_config_int \<^binding>\<open>spec_check_gen_target\<close> (K 100)
+val gen_max = Attrib.setup_config_int \<^binding>\<open>spec_check_gen_max\<close> (K 400)
+val examples = Attrib.setup_config_int \<^binding>\<open>spec_check_examples\<close> (K 5)
-val sort_examples = Attrib.setup_config_bool @{binding spec_check_sort_examples} (K true)
-val show_stats = Attrib.setup_config_bool @{binding spec_check_show_stats} (K true)
-val column_width = Attrib.setup_config_int @{binding spec_check_column_width} (K 22)
-val style = Attrib.setup_config_string @{binding spec_check_style} (K "Perl")
+val sort_examples = Attrib.setup_config_bool \<^binding>\<open>spec_check_sort_examples\<close> (K true)
+val show_stats = Attrib.setup_config_bool \<^binding>\<open>spec_check_show_stats\<close> (K true)
+val column_width = Attrib.setup_config_int \<^binding>\<open>spec_check_column_width\<close> (K 22)
+val style = Attrib.setup_config_string \<^binding>\<open>spec_check_style\<close> (K "Perl")
type ('a, 'b) reader = 'b -> ('a * 'b) option
type 'a rep = ('a -> string) option
--- a/src/Tools/induct.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/induct.ML Fri Jan 04 23:22:53 2019 +0100
@@ -171,8 +171,8 @@
| SOME (i, k, j) => SOME (swap_params_conv ctxt k j (K (swap_prems_conv i)) ct));
val rearrange_eqs_simproc =
- Simplifier.make_simproc @{context} "rearrange_eqs"
- {lhss = [@{term \<open>Pure.all (t :: 'a::{} \<Rightarrow> prop)\<close>}],
+ Simplifier.make_simproc \<^context> "rearrange_eqs"
+ {lhss = [\<^term>\<open>Pure.all (t :: 'a::{} \<Rightarrow> prop)\<close>],
proc = fn _ => fn ctxt => fn ct => mk_swap_rrule ctxt ct};
@@ -231,7 +231,7 @@
((init_rules (left_var_prem o #2), init_rules (Thm.major_prem_of o #2)),
(init_rules (right_var_concl o #2), init_rules (Thm.major_prem_of o #2)),
(init_rules (left_var_concl o #2), init_rules (Thm.concl_of o #2)),
- simpset_of (empty_simpset @{context}
+ simpset_of (empty_simpset \<^context>
addsimprocs [rearrange_eqs_simproc] addsimps [Drule.norm_hhf_eq]));
val extend = I;
fun merge (((casesT1, casesP1), (inductT1, inductP1), (coinductT1, coinductP1), simpset1),
@@ -662,16 +662,16 @@
local
-fun goal_prefix k ((c as Const (@{const_name Pure.all}, _)) $ Abs (a, T, B)) =
+fun goal_prefix k ((c as Const (\<^const_name>\<open>Pure.all\<close>, _)) $ Abs (a, T, B)) =
c $ Abs (a, T, goal_prefix k B)
| goal_prefix 0 _ = Term.dummy_prop
- | goal_prefix k ((c as Const (@{const_name Pure.imp}, _)) $ A $ B) =
+ | goal_prefix k ((c as Const (\<^const_name>\<open>Pure.imp\<close>, _)) $ A $ B) =
c $ A $ goal_prefix (k - 1) B
| goal_prefix _ _ = Term.dummy_prop;
-fun goal_params k (Const (@{const_name Pure.all}, _) $ Abs (_, _, B)) = goal_params k B + 1
+fun goal_params k (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (_, _, B)) = goal_params k B + 1
| goal_params 0 _ = 0
- | goal_params k (Const (@{const_name Pure.imp}, _) $ _ $ B) = goal_params (k - 1) B
+ | goal_params k (Const (\<^const_name>\<open>Pure.imp\<close>, _) $ _ $ B) = goal_params (k - 1) B
| goal_params _ _ = 0;
fun meta_spec_tac ctxt n (x, T) = SUBGOAL (fn (goal, i) =>
@@ -687,12 +687,12 @@
[(#1 (dest_Var (head_of pred)), Thm.cterm_of ctxt (Logic.rlist_abs (xs, body))),
(#1 (dest_Var (head_of arg)), Thm.cterm_of ctxt (Logic.rlist_abs (xs, v)))]);
- fun goal_concl k xs (Const (@{const_name Pure.all}, _) $ Abs (a, T, B)) =
+ fun goal_concl k xs (Const (\<^const_name>\<open>Pure.all\<close>, _) $ Abs (a, T, B)) =
goal_concl k ((a, T) :: xs) B
| goal_concl 0 xs B =
if not (Term.exists_subterm (fn t => t aconv v) B) then NONE
else SOME (xs, absfree (x, T) (Term.incr_boundvars 1 B))
- | goal_concl k xs (Const (@{const_name Pure.imp}, _) $ _ $ B) =
+ | goal_concl k xs (Const (\<^const_name>\<open>Pure.imp\<close>, _) $ _ $ B) =
goal_concl (k - 1) xs B
| goal_concl _ _ _ = NONE;
in
--- a/src/Tools/misc_legacy.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/misc_legacy.ML Fri Jan 04 23:22:53 2019 +0100
@@ -124,9 +124,9 @@
H1,...,Hn are the hypotheses; x1...xm are variants of the parameters.
Main difference from strip_assums concerns parameters:
it replaces the bound variables by free variables. *)
-fun strip_context_aux (params, Hs, Const (@{const_name Pure.imp}, _) $ H $ B) =
+fun strip_context_aux (params, Hs, Const (\<^const_name>\<open>Pure.imp\<close>, _) $ H $ B) =
strip_context_aux (params, H :: Hs, B)
- | strip_context_aux (params, Hs, Const (@{const_name Pure.all},_) $ Abs (a, T, t)) =
+ | strip_context_aux (params, Hs, Const (\<^const_name>\<open>Pure.all\<close>,_) $ Abs (a, T, t)) =
let val (b, u) = Syntax_Trans.variant_abs (a, T, t)
in strip_context_aux ((b, T) :: params, Hs, u) end
| strip_context_aux (params, Hs, B) = (rev params, rev Hs, B);
--- a/src/Tools/nbe.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/nbe.ML Fri Jan 04 23:22:53 2019 +0100
@@ -589,7 +589,7 @@
fun mk_equals ctxt lhs raw_rhs =
let
val ty = Thm.typ_of_cterm lhs;
- val eq = Thm.cterm_of ctxt (Term.Const (@{const_name Pure.eq}, ty --> ty --> propT));
+ val eq = Thm.cterm_of ctxt (Term.Const (\<^const_name>\<open>Pure.eq\<close>, ty --> ty --> propT));
val rhs = Thm.cterm_of ctxt raw_rhs;
in Thm.mk_binop eq lhs rhs end;
--- a/src/Tools/solve_direct.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/solve_direct.ML Fri Jan 04 23:22:53 2019 +0100
@@ -100,6 +100,6 @@
fun try_solve_direct auto = do_solve_direct (if auto then Auto_Try else Try)
val _ =
- Try.tool_setup (solve_directN, (10, @{system_option auto_solve_direct}, try_solve_direct));
+ Try.tool_setup (solve_directN, (10, \<^system_option>\<open>auto_solve_direct\<close>, try_solve_direct));
end;
--- a/src/Tools/try.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/Tools/try.ML Fri Jan 04 23:22:53 2019 +0100
@@ -97,7 +97,7 @@
(fn {keywords, command_name, ...} =>
if Keyword.is_theory_goal keywords command_name andalso Options.default_bool auto then
SOME
- {delay = SOME (seconds (Options.default_real @{system_option auto_time_start})),
+ {delay = SOME (seconds (Options.default_real \<^system_option>\<open>auto_time_start\<close>)),
pri = ~ weight,
persistent = true,
strict = true,
@@ -105,7 +105,7 @@
let
val state = Toplevel.proof_of st
|> Proof.map_context (Context_Position.set_visible false)
- val auto_time_limit = Options.default_real @{system_option auto_time_limit}
+ val auto_time_limit = Options.default_real \<^system_option>\<open>auto_time_limit\<close>
in
if auto_time_limit > 0.0 then
(case Timeout.apply (seconds auto_time_limit) (fn () => tool true state) () of
--- a/src/ZF/Arith.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Arith.thy Fri Jan 04 23:22:53 2019 +0100
@@ -85,7 +85,7 @@
lemmas zero_lt_natE = zero_lt_lemma [THEN bexE]
-subsection\<open>\<open>natify\<close>, the Coercion to @{term nat}\<close>
+subsection\<open>\<open>natify\<close>, the Coercion to \<^term>\<open>nat\<close>\<close>
lemma pred_succ_eq [simp]: "pred(succ(y)) = y"
by (unfold pred_def, auto)
@@ -427,7 +427,7 @@
"[|i\<in>nat; j\<in>nat|] ==> (i \<union> j) #- k = (i#-k) \<union> (j#-k)"
by (insert nat_diff_Un_distrib [of i j "natify(k)"], simp)
-text\<open>We actually prove @{term "i #- j #- k = i #- (j #+ k)"}\<close>
+text\<open>We actually prove \<^term>\<open>i #- j #- k = i #- (j #+ k)\<close>\<close>
lemma diff_diff_left [simplified]:
"natify(i)#-natify(j)#-k = natify(i) #- (natify(j)#+k)"
by (rule_tac m="natify(i)" and n="natify(j)" in diff_induct, auto)
--- a/src/ZF/ArithSimp.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/ArithSimp.thy Fri Jan 04 23:22:53 2019 +0100
@@ -185,7 +185,7 @@
apply (case_tac "x<n")
txt\<open>case x<n\<close>
apply (simp (no_asm_simp))
-txt\<open>case @{term"n \<le> x"}\<close>
+txt\<open>case \<^term>\<open>n \<le> x\<close>\<close>
apply (simp add: not_lt_iff_le add_assoc mod_geq div_termination [THEN ltD] add_diff_inverse)
done
@@ -212,7 +212,7 @@
txt\<open>case succ(x) < n\<close>
apply (simp (no_asm_simp) add: nat_le_refl [THEN lt_trans] succ_neq_self)
apply (simp add: ltD [THEN mem_imp_not_eq])
-txt\<open>case @{term"n \<le> succ(x)"}\<close>
+txt\<open>case \<^term>\<open>n \<le> succ(x)\<close>\<close>
apply (simp add: mod_geq not_lt_iff_le)
apply (erule leE)
apply (simp (no_asm_simp) add: mod_geq div_termination [THEN ltD] diff_succ)
@@ -235,7 +235,7 @@
apply (subgoal_tac "natify (m) mod n < n")
apply (rule_tac [2] i = "natify (m) " in complete_induct)
apply (case_tac [3] "x<n", auto)
-txt\<open>case @{term"n \<le> x"}\<close>
+txt\<open>case \<^term>\<open>n \<le> x\<close>\<close>
apply (simp add: mod_geq not_lt_iff_le div_termination [THEN ltD])
done
--- a/src/ZF/Bin.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Bin.thy Fri Jan 04 23:22:53 2019 +0100
@@ -177,7 +177,7 @@
subsubsection\<open>The Carry and Borrow Functions,
- @{term bin_succ} and @{term bin_pred}\<close>
+ \<^term>\<open>bin_succ\<close> and \<^term>\<open>bin_pred\<close>\<close>
(*NCons preserves the integer value of its argument*)
lemma integ_of_NCons [simp]:
@@ -199,7 +199,7 @@
done
-subsubsection\<open>@{term bin_minus}: Unary Negation of Binary Integers\<close>
+subsubsection\<open>\<^term>\<open>bin_minus\<close>: Unary Negation of Binary Integers\<close>
lemma integ_of_minus: "w \<in> bin ==> integ_of(bin_minus(w)) = $- integ_of(w)"
apply (erule bin.induct)
@@ -207,7 +207,7 @@
done
-subsubsection\<open>@{term bin_add}: Binary Addition\<close>
+subsubsection\<open>\<^term>\<open>bin_add\<close>: Binary Addition\<close>
lemma bin_add_Pls [simp]: "w \<in> bin ==> bin_add(Pls,w) = w"
by (unfold bin_add_def, simp)
@@ -255,7 +255,7 @@
done
-subsubsection\<open>@{term bin_mult}: Binary Multiplication\<close>
+subsubsection\<open>\<^term>\<open>bin_mult\<close>: Binary Multiplication\<close>
lemma integ_of_mult:
"[| v \<in> bin; w \<in> bin |]
--- a/src/ZF/Cardinal.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Cardinal.thy Fri Jan 04 23:22:53 2019 +0100
@@ -442,7 +442,7 @@
case False thus ?thesis \<comment> \<open>degenerate case\<close>
by (simp add: Least_0 Card_0)
next
- case True \<comment> \<open>real case: @{term A} is isomorphic to some ordinal\<close>
+ case True \<comment> \<open>real case: \<^term>\<open>A\<close> is isomorphic to some ordinal\<close>
then obtain i where i: "Ord(i)" "i \<approx> A" by blast
show ?thesis
proof (rule CardI [OF Ord_Least], rule notI)
@@ -490,7 +490,7 @@
thus ?thesis by simp
qed
-text\<open>Since we have @{term"|succ(nat)| \<le> |nat|"}, the converse of \<open>cardinal_mono\<close> fails!\<close>
+text\<open>Since we have \<^term>\<open>|succ(nat)| \<le> |nat|\<close>, the converse of \<open>cardinal_mono\<close> fails!\<close>
lemma cardinal_lt_imp_lt: "[| |i| < |j|; Ord(i); Ord(j) |] ==> i < j"
apply (rule Ord_linear2 [of i j], assumption+)
apply (erule lt_trans2 [THEN lt_irrefl])
@@ -811,8 +811,8 @@
(*New proofs using cons_lepoll_cons. Could generalise from succ to cons.*)
-text\<open>If @{term A} has at most @{term"n+1"} elements and @{term"a \<in> A"}
- then @{term"A-{a}"} has at most @{term n}.\<close>
+text\<open>If \<^term>\<open>A\<close> has at most \<^term>\<open>n+1\<close> elements and \<^term>\<open>a \<in> A\<close>
+ then \<^term>\<open>A-{a}\<close> has at most \<^term>\<open>n\<close>.\<close>
lemma Diff_sing_lepoll:
"[| a \<in> A; A \<lesssim> succ(n) |] ==> A - {a} \<lesssim> n"
apply (unfold succ_def)
@@ -821,7 +821,7 @@
apply (erule cons_Diff [THEN ssubst], safe)
done
-text\<open>If @{term A} has at least @{term"n+1"} elements then @{term"A-{a}"} has at least @{term n}.\<close>
+text\<open>If \<^term>\<open>A\<close> has at least \<^term>\<open>n+1\<close> elements then \<^term>\<open>A-{a}\<close> has at least \<^term>\<open>n\<close>.\<close>
lemma lepoll_Diff_sing:
assumes A: "succ(n) \<lesssim> A" shows "n \<lesssim> A - {a}"
proof -
@@ -1109,7 +1109,7 @@
next
case (succ x)
hence wfx: "\<And>Z. Z = 0 \<or> (\<exists>z\<in>Z. \<forall>y. z \<in> y \<and> z \<in> x \<and> y \<in> x \<and> z \<in> x \<longrightarrow> y \<notin> Z)"
- by (simp add: wf_on_def wf_def) \<comment> \<open>not easy to erase the duplicate @{term"z \<in> x"}!\<close>
+ by (simp add: wf_on_def wf_def) \<comment> \<open>not easy to erase the duplicate \<^term>\<open>z \<in> x\<close>!\<close>
show ?case
proof (rule wf_onI)
fix Z u
--- a/src/ZF/CardinalArith.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/CardinalArith.thy Fri Jan 04 23:22:53 2019 +0100
@@ -35,8 +35,8 @@
definition
csucc :: "i=>i" where
- \<comment> \<open>needed because @{term "jump_cardinal(K)"} might not be the successor
- of @{term K}\<close>
+ \<comment> \<open>needed because \<^term>\<open>jump_cardinal(K)\<close> might not be the successor
+ of \<^term>\<open>K\<close>\<close>
"csucc(K) == \<mu> L. Card(L) & K<L"
@@ -543,7 +543,7 @@
apply (blast intro!: Un_upper1_le Un_upper2_le Ord_ordermap elim!: ltE)+
done
-text\<open>Kunen: "each @{term"\<langle>x,y\<rangle> \<in> K \<times> K"} has no more than @{term"z \<times> z"} predecessors..." (page 29)\<close>
+text\<open>Kunen: "each \<^term>\<open>\<langle>x,y\<rangle> \<in> K \<times> K\<close> has no more than \<^term>\<open>z \<times> z\<close> predecessors..." (page 29)\<close>
lemma ordermap_csquare_le:
assumes K: "Limit(K)" and x: "x<K" and y: " y<K"
defines "z \<equiv> succ(x \<union> y)"
--- a/src/ZF/Cardinal_AC.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Cardinal_AC.thy Fri Jan 04 23:22:53 2019 +0100
@@ -16,7 +16,7 @@
apply (erule well_ord_cardinal_eqpoll)
done
-text\<open>The theorem @{term "||A|| = |A|"}\<close>
+text\<open>The theorem \<^term>\<open>||A|| = |A|\<close>\<close>
lemmas cardinal_idem = cardinal_eqpoll [THEN cardinal_cong, simp]
lemma cardinal_eqE: "|X| = |Y| ==> X \<approx> Y"
@@ -171,7 +171,7 @@
finally show "(\<Union>i\<in>K. X(i)) \<lesssim> K" .
qed
-text\<open>The same again, using @{term csucc}\<close>
+text\<open>The same again, using \<^term>\<open>csucc\<close>\<close>
lemma cardinal_UN_lt_csucc:
"[| InfCard(K); \<And>i. i\<in>K \<Longrightarrow> |X(i)| < csucc(K) |]
==> |\<Union>i\<in>K. X(i)| < csucc(K)"
@@ -192,8 +192,8 @@
subsection\<open>The Main Result for Infinite-Branching Datatypes\<close>
text\<open>As above, but the index set need not be a cardinal. Work
-backwards along the injection from @{term W} into @{term K}, given
-that @{term"W\<noteq>0"}.\<close>
+backwards along the injection from \<^term>\<open>W\<close> into \<^term>\<open>K\<close>, given
+that \<^term>\<open>W\<noteq>0\<close>.\<close>
lemma inj_UN_subset:
assumes f: "f \<in> inj(A,B)" and a: "a \<in> A"
--- a/src/ZF/Constructible/AC_in_L.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/AC_in_L.thy Fri Jan 04 23:22:53 2019 +0100
@@ -141,8 +141,7 @@
subsection\<open>An Injection from Formulas into the Natural Numbers\<close>
-text\<open>There is a well-known bijection between @{term "nat*nat"} and @{term
-nat} given by the expression f(m,n) = triangle(m+n) + m, where triangle(k)
+text\<open>There is a well-known bijection between \<^term>\<open>nat*nat\<close> and \<^term>\<open>nat\<close> given by the expression f(m,n) = triangle(m+n) + m, where triangle(k)
enumerates the triangular numbers and can be defined by triangle(0)=0,
triangle(succ(k)) = succ(k + triangle(k)). Some small amount of effort is
needed to show that f is a bijection. We already know that such a bijection exists by the theorem \<open>well_ord_InfCard_square_eq\<close>:
@@ -153,8 +152,8 @@
conduct the proofs under the assumption that a bijection exists. The simplest
way to organize this is to use a locale.\<close>
-text\<open>Locale for any arbitrary injection between @{term "nat*nat"}
- and @{term nat}\<close>
+text\<open>Locale for any arbitrary injection between \<^term>\<open>nat*nat\<close>
+ and \<^term>\<open>nat\<close>\<close>
locale Nat_Times_Nat =
fixes fn
assumes fn_inj: "fn \<in> inj(nat*nat, nat)"
@@ -222,14 +221,13 @@
done
-subsection\<open>Defining the Wellordering on @{term "DPow(A)"}\<close>
+subsection\<open>Defining the Wellordering on \<^term>\<open>DPow(A)\<close>\<close>
-text\<open>The objective is to build a wellordering on @{term "DPow(A)"} from a
-given one on @{term A}. We first introduce wellorderings for environments,
-which are lists built over @{term "A"}. We combine it with the enumeration of
+text\<open>The objective is to build a wellordering on \<^term>\<open>DPow(A)\<close> from a
+given one on \<^term>\<open>A\<close>. We first introduce wellorderings for environments,
+which are lists built over \<^term>\<open>A\<close>. We combine it with the enumeration of
formulas. The order type of the resulting wellordering gives us a map from
-(environment, formula) pairs into the ordinals. For each member of @{term
-"DPow(A)"}, we take the minimum such ordinal.\<close>
+(environment, formula) pairs into the ordinals. For each member of \<^term>\<open>DPow(A)\<close>, we take the minimum such ordinal.\<close>
definition
env_form_r :: "[i,i,i]=>i" where
@@ -246,7 +244,7 @@
definition
DPow_ord :: "[i,i,i,i,i]=>o" where
- \<comment> \<open>predicate that holds if @{term k} is a valid index for @{term X}\<close>
+ \<comment> \<open>predicate that holds if \<^term>\<open>k\<close> is a valid index for \<^term>\<open>X\<close>\<close>
"DPow_ord(f,r,A,X,k) ==
\<exists>env \<in> list(A). \<exists>p \<in> formula.
arity(p) \<le> succ(length(env)) &
@@ -255,12 +253,12 @@
definition
DPow_least :: "[i,i,i,i]=>i" where
- \<comment> \<open>function yielding the smallest index for @{term X}\<close>
+ \<comment> \<open>function yielding the smallest index for \<^term>\<open>X\<close>\<close>
"DPow_least(f,r,A,X) == \<mu> k. DPow_ord(f,r,A,X,k)"
definition
DPow_r :: "[i,i,i]=>i" where
- \<comment> \<open>a wellordering on @{term "DPow(A)"}\<close>
+ \<comment> \<open>a wellordering on \<^term>\<open>DPow(A)\<close>\<close>
"DPow_r(f,r,A) == measure(DPow(A), DPow_least(f,r,A))"
@@ -327,13 +325,13 @@
subsection\<open>Limit Construction for Well-Orderings\<close>
text\<open>Now we work towards the transfinite definition of wellorderings for
-@{term "Lset(i)"}. We assume as an inductive hypothesis that there is a family
+\<^term>\<open>Lset(i)\<close>. We assume as an inductive hypothesis that there is a family
of wellorderings for smaller ordinals.\<close>
definition
rlimit :: "[i,i=>i]=>i" where
\<comment> \<open>Expresses the wellordering at limit ordinals. The conditional
- lets us remove the premise @{term "Limit(i)"} from some theorems.\<close>
+ lets us remove the premise \<^term>\<open>Limit(i)\<close> from some theorems.\<close>
"rlimit(i,r) ==
if Limit(i) then
{z: Lset(i) * Lset(i).
@@ -345,7 +343,7 @@
definition
Lset_new :: "i=>i" where
\<comment> \<open>This constant denotes the set of elements introduced at level
- @{term "succ(i)"}\<close>
+ \<^term>\<open>succ(i)\<close>\<close>
"Lset_new(i) == {x \<in> Lset(succ(i)). lrank(x) = i}"
lemma Limit_Lset_eq2:
@@ -412,7 +410,7 @@
done
-subsection\<open>Transfinite Definition of the Wellordering on @{term "L"}\<close>
+subsection\<open>Transfinite Definition of the Wellordering on \<^term>\<open>L\<close>\<close>
definition
L_r :: "[i, i] => i" where
@@ -455,7 +453,7 @@
text\<open>Every constructible set is well-ordered! Therefore the Wellordering Theorem and
- the Axiom of Choice hold in @{term L}!!\<close>
+ the Axiom of Choice hold in \<^term>\<open>L\<close>!!\<close>
theorem L_implies_AC: assumes x: "L(x)" shows "\<exists>r. well_ord(x,r)"
using Transset_Lset x
apply (simp add: Transset_def L_def)
@@ -474,8 +472,8 @@
by (blast intro: well_ord_imp_relativized)
qed
-text\<open>In order to prove @{term" \<exists>r[L]. wellordered(L,x,r)"}, it's necessary to know
-that @{term r} is actually constructible. It follows from the assumption ``@{term V} equals @{term L''},
+text\<open>In order to prove \<^term>\<open> \<exists>r[L]. wellordered(L,x,r)\<close>, it's necessary to know
+that \<^term>\<open>r\<close> is actually constructible. It follows from the assumption ``\<^term>\<open>V\<close> equals \<^term>\<open>L''\<close>,
but this reasoning doesn't appear to work in Isabelle.\<close>
end
--- a/src/ZF/Constructible/DPow_absolute.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/DPow_absolute.thy Fri Jan 04 23:22:53 2019 +0100
@@ -10,9 +10,9 @@
subsection\<open>Preliminary Internalizations\<close>
-subsubsection\<open>The Operator @{term is_formula_rec}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_formula_rec\<close>\<close>
-text\<open>The three arguments of @{term p} are always 2, 1, 0. It is buried
+text\<open>The three arguments of \<^term>\<open>p\<close> are always 2, 1, 0. It is buried
within 11 quantifiers!!\<close>
(* is_formula_rec :: "[i=>o, [i,i,i]=>o, i, i] => o"
@@ -77,7 +77,7 @@
done
-subsubsection\<open>The Operator @{term is_satisfies}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_satisfies\<close>\<close>
(* is_satisfies(M,A,p,z) == is_formula_rec (M, satisfies_MH(M,A), p, z) *)
definition
@@ -109,7 +109,7 @@
done
-subsection \<open>Relativization of the Operator @{term DPow'}\<close>
+subsection \<open>Relativization of the Operator \<^term>\<open>DPow'\<close>\<close>
lemma DPow'_eq:
"DPow'(A) = {z . ep \<in> list(A) * formula,
@@ -118,7 +118,7 @@
by (simp add: DPow'_def, blast)
-text\<open>Relativize the use of @{term sats} within @{term DPow'}
+text\<open>Relativize the use of \<^term>\<open>sats\<close> within \<^term>\<open>DPow'\<close>
(the comprehension).\<close>
definition
is_DPow_sats :: "[i=>o,i,i,i,i] => o" where
@@ -142,7 +142,7 @@
by (simp add: DPow_sats_abs transM [of _ A])
-subsubsection\<open>The Operator @{term is_DPow_sats}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_DPow_sats\<close>, Internalized\<close>
(* is_DPow_sats(M,A,env,p,x) ==
\<forall>n1[M]. \<forall>e[M]. \<forall>sp[M].
@@ -184,7 +184,7 @@
done
-subsection\<open>A Locale for Relativizing the Operator @{term DPow'}\<close>
+subsection\<open>A Locale for Relativizing the Operator \<^term>\<open>DPow'\<close>\<close>
locale M_DPow = M_satisfies +
assumes sep:
@@ -219,7 +219,7 @@
apply (fast intro: rep' sep' univalent_pair_eq)
done
-text\<open>Relativization of the Operator @{term DPow'}\<close>
+text\<open>Relativization of the Operator \<^term>\<open>DPow'\<close>\<close>
definition
is_DPow' :: "[i=>o,i,i] => o" where
"is_DPow'(M,A,Z) ==
@@ -304,9 +304,9 @@
and DPow'_abs [intro, simp] = M_DPow.DPow'_abs [OF M_DPow_L]
-subsubsection\<open>The Operator @{term is_Collect}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_Collect\<close>\<close>
-text\<open>The formula @{term is_P} has one free variable, 0, and it is
+text\<open>The formula \<^term>\<open>is_P\<close> has one free variable, 0, and it is
enclosed within a single quantifier.\<close>
(* is_Collect :: "[i=>o,i,i=>o,i] => o"
@@ -342,7 +342,7 @@
by (simp add: sats_Collect_fm [OF is_P_iff_sats])
-text\<open>The second argument of @{term is_P} gives it direct access to @{term x},
+text\<open>The second argument of \<^term>\<open>is_P\<close> gives it direct access to \<^term>\<open>x\<close>,
which is essential for handling free variable references.\<close>
theorem Collect_reflection:
assumes is_P_reflection:
@@ -355,9 +355,9 @@
done
-subsubsection\<open>The Operator @{term is_Replace}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_Replace\<close>\<close>
-text\<open>BEWARE! The formula @{term is_P} has free variables 0, 1
+text\<open>BEWARE! The formula \<^term>\<open>is_P\<close> has free variables 0, 1
and not the usual 1, 0! It is enclosed within two quantifiers.\<close>
(* is_Replace :: "[i=>o,i,[i,i]=>o,i] => o"
@@ -395,7 +395,7 @@
by (simp add: sats_Replace_fm [OF is_P_iff_sats])
-text\<open>The second argument of @{term is_P} gives it direct access to @{term x},
+text\<open>The second argument of \<^term>\<open>is_P\<close> gives it direct access to \<^term>\<open>x\<close>,
which is essential for handling free variable references.\<close>
theorem Replace_reflection:
assumes is_P_reflection:
@@ -409,7 +409,7 @@
-subsubsection\<open>The Operator @{term is_DPow'}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_DPow'\<close>, Internalized\<close>
(* "is_DPow'(M,A,Z) ==
\<forall>X[M]. X \<in> Z \<longleftrightarrow>
@@ -454,7 +454,7 @@
done
-subsection\<open>A Locale for Relativizing the Operator @{term Lset}\<close>
+subsection\<open>A Locale for Relativizing the Operator \<^term>\<open>Lset\<close>\<close>
definition
transrec_body :: "[i=>o,i,i,i,i] => o" where
@@ -506,11 +506,11 @@
done
-text\<open>Relativization of the Operator @{term Lset}\<close>
+text\<open>Relativization of the Operator \<^term>\<open>Lset\<close>\<close>
definition
is_Lset :: "[i=>o, i, i] => o" where
- \<comment> \<open>We can use the term language below because @{term is_Lset} will
+ \<comment> \<open>We can use the term language below because \<^term>\<open>is_Lset\<close> will
not have to be internalized: it isn't used in any instance of
separation.\<close>
"is_Lset(M,a,z) == is_transrec(M, %x f u. u = (\<Union>y\<in>x. DPow'(f`y)), a, z)"
@@ -571,7 +571,7 @@
big_union(##Lset(i),r,u), mr, v, y))]"
apply (simp only: rex_setclass_is_bex [symmetric])
\<comment> \<open>Convert \<open>\<exists>y\<in>Lset(i)\<close> to \<open>\<exists>y[##Lset(i)]\<close> within the body
- of the @{term is_wfrec} application.\<close>
+ of the \<^term>\<open>is_wfrec\<close> application.\<close>
apply (intro FOL_reflections function_reflections
is_wfrec_reflection Replace_reflection DPow'_reflection)
done
--- a/src/ZF/Constructible/Datatype_absolute.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Datatype_absolute.thy Fri Jan 04 23:22:53 2019 +0100
@@ -277,7 +277,7 @@
by (simp add: is_formula_functor_def)
-subsection\<open>@{term M} Contains the List and Formula Datatypes\<close>
+subsection\<open>\<^term>\<open>M\<close> Contains the List and Formula Datatypes\<close>
definition
list_N :: "[i,i] => i" where
@@ -325,7 +325,7 @@
apply (blast intro: list_imp_list_N)
done
-text\<open>Express @{term list_rec} without using @{term rank} or @{term Vset},
+text\<open>Express \<^term>\<open>list_rec\<close> without using \<^term>\<open>rank\<close> or \<^term>\<open>Vset\<close>,
neither of which is absolute.\<close>
lemma (in M_trivial) list_rec_eq:
"l \<in> list(A) ==>
@@ -356,7 +356,7 @@
is_list :: "[i=>o,i,i] => o" where
"is_list(M,A,Z) == \<forall>l[M]. l \<in> Z \<longleftrightarrow> mem_list(M,A,l)"
-subsubsection\<open>Towards Absoluteness of @{term formula_rec}\<close>
+subsubsection\<open>Towards Absoluteness of \<^term>\<open>formula_rec\<close>\<close>
consts depth :: "i=>i"
primrec
@@ -574,7 +574,7 @@
done
-subsection\<open>Absoluteness for \<open>\<epsilon>\<close>-Closure: the @{term eclose} Operator\<close>
+subsection\<open>Absoluteness for \<open>\<epsilon>\<close>-Closure: the \<^term>\<open>eclose\<close> Operator\<close>
text\<open>Re-expresses eclose using "iterates"\<close>
lemma eclose_eq_Union:
@@ -645,9 +645,9 @@
done
-subsection \<open>Absoluteness for @{term transrec}\<close>
+subsection \<open>Absoluteness for \<^term>\<open>transrec\<close>\<close>
-text\<open>@{prop "transrec(a,H) \<equiv> wfrec(Memrel(eclose({a})), a, H)"}\<close>
+text\<open>\<^prop>\<open>transrec(a,H) \<equiv> wfrec(Memrel(eclose({a})), a, H)\<close>\<close>
definition
is_transrec :: "[i=>o, [i,i,i]=>o, i, i] => o" where
@@ -663,7 +663,7 @@
upair(M,a,a,sa) & is_eclose(M,sa,esa) & membership(M,esa,mesa) &
wfrec_replacement(M,MH,mesa)"
-text\<open>The condition @{term "Ord(i)"} lets us use the simpler
+text\<open>The condition \<^term>\<open>Ord(i)\<close> lets us use the simpler
\<open>trans_wfrec_abs\<close> rather than \<open>trans_wfrec_abs\<close>,
which I haven't even proved yet.\<close>
theorem (in M_eclose) transrec_abs:
@@ -684,7 +684,7 @@
transrec_def eclose_sing_Ord_eq wf_Memrel trans_Memrel relation_Memrel)
-text\<open>Helps to prove instances of @{term transrec_replacement}\<close>
+text\<open>Helps to prove instances of \<^term>\<open>transrec_replacement\<close>\<close>
lemma (in M_eclose) transrec_replacementI:
"[|M(a);
strong_replacement (M,
@@ -694,7 +694,7 @@
by (simp add: transrec_replacement_def wfrec_replacement_def)
-subsection\<open>Absoluteness for the List Operator @{term length}\<close>
+subsection\<open>Absoluteness for the List Operator \<^term>\<open>length\<close>\<close>
text\<open>But it is never used.\<close>
definition
@@ -714,13 +714,13 @@
dest: list_N_imp_length_lt)
done
-text\<open>Proof is trivial since @{term length} returns natural numbers.\<close>
+text\<open>Proof is trivial since \<^term>\<open>length\<close> returns natural numbers.\<close>
lemma (in M_trivial) length_closed [intro,simp]:
"l \<in> list(A) ==> M(length(l))"
by (simp add: nat_into_M)
-subsection \<open>Absoluteness for the List Operator @{term nth}\<close>
+subsection \<open>Absoluteness for the List Operator \<^term>\<open>nth\<close>\<close>
lemma nth_eq_hd_iterates_tl [rule_format]:
"xs \<in> list(A) ==> \<forall>n \<in> nat. nth(n,xs) = hd' (tl'^n (xs))"
@@ -761,11 +761,11 @@
done
-subsection\<open>Relativization and Absoluteness for the @{term formula} Constructors\<close>
+subsection\<open>Relativization and Absoluteness for the \<^term>\<open>formula\<close> Constructors\<close>
definition
is_Member :: "[i=>o,i,i,i] => o" where
- \<comment> \<open>because @{term "Member(x,y) \<equiv> Inl(Inl(\<langle>x,y\<rangle>))"}\<close>
+ \<comment> \<open>because \<^term>\<open>Member(x,y) \<equiv> Inl(Inl(\<langle>x,y\<rangle>))\<close>\<close>
"is_Member(M,x,y,Z) ==
\<exists>p[M]. \<exists>u[M]. pair(M,x,y,p) & is_Inl(M,p,u) & is_Inl(M,u,Z)"
@@ -779,7 +779,7 @@
definition
is_Equal :: "[i=>o,i,i,i] => o" where
- \<comment> \<open>because @{term "Equal(x,y) \<equiv> Inl(Inr(\<langle>x,y\<rangle>))"}\<close>
+ \<comment> \<open>because \<^term>\<open>Equal(x,y) \<equiv> Inl(Inr(\<langle>x,y\<rangle>))\<close>\<close>
"is_Equal(M,x,y,Z) ==
\<exists>p[M]. \<exists>u[M]. pair(M,x,y,p) & is_Inr(M,p,u) & is_Inl(M,u,Z)"
@@ -792,7 +792,7 @@
definition
is_Nand :: "[i=>o,i,i,i] => o" where
- \<comment> \<open>because @{term "Nand(x,y) \<equiv> Inr(Inl(\<langle>x,y\<rangle>))"}\<close>
+ \<comment> \<open>because \<^term>\<open>Nand(x,y) \<equiv> Inr(Inl(\<langle>x,y\<rangle>))\<close>\<close>
"is_Nand(M,x,y,Z) ==
\<exists>p[M]. \<exists>u[M]. pair(M,x,y,p) & is_Inl(M,p,u) & is_Inr(M,u,Z)"
@@ -805,7 +805,7 @@
definition
is_Forall :: "[i=>o,i,i] => o" where
- \<comment> \<open>because @{term "Forall(x) \<equiv> Inr(Inr(p))"}\<close>
+ \<comment> \<open>because \<^term>\<open>Forall(x) \<equiv> Inr(Inr(p))\<close>\<close>
"is_Forall(M,p,Z) == \<exists>u[M]. is_Inr(M,p,u) & is_Inr(M,u,Z)"
lemma (in M_trivial) Forall_abs [simp]:
@@ -817,19 +817,19 @@
-subsection \<open>Absoluteness for @{term formula_rec}\<close>
+subsection \<open>Absoluteness for \<^term>\<open>formula_rec\<close>\<close>
definition
formula_rec_case :: "[[i,i]=>i, [i,i]=>i, [i,i,i,i]=>i, [i,i]=>i, i, i] => i" where
- \<comment> \<open>the instance of @{term formula_case} in @{term formula_rec}\<close>
+ \<comment> \<open>the instance of \<^term>\<open>formula_case\<close> in \<^term>\<open>formula_rec\<close>\<close>
"formula_rec_case(a,b,c,d,h) ==
formula_case (a, b,
\<lambda>u v. c(u, v, h ` succ(depth(u)) ` u,
h ` succ(depth(v)) ` v),
\<lambda>u. d(u, h ` succ(depth(u)) ` u))"
-text\<open>Unfold @{term formula_rec} to @{term formula_rec_case}.
- Express @{term formula_rec} without using @{term rank} or @{term Vset},
+text\<open>Unfold \<^term>\<open>formula_rec\<close> to \<^term>\<open>formula_rec_case\<close>.
+ Express \<^term>\<open>formula_rec\<close> without using \<^term>\<open>rank\<close> or \<^term>\<open>Vset\<close>,
neither of which is absolute.\<close>
lemma (in M_trivial) formula_rec_eq:
"p \<in> formula ==>
@@ -838,20 +838,20 @@
\<lambda>x h. Lambda (formula, formula_rec_case(a,b,c,d,h))) ` p"
apply (simp add: formula_rec_case_def)
apply (induct_tac p)
- txt\<open>Base case for @{term Member}\<close>
+ txt\<open>Base case for \<^term>\<open>Member\<close>\<close>
apply (subst transrec, simp add: formula.intros)
- txt\<open>Base case for @{term Equal}\<close>
+ txt\<open>Base case for \<^term>\<open>Equal\<close>\<close>
apply (subst transrec, simp add: formula.intros)
- txt\<open>Inductive step for @{term Nand}\<close>
+ txt\<open>Inductive step for \<^term>\<open>Nand\<close>\<close>
apply (subst transrec)
apply (simp add: succ_Un_distrib formula.intros)
-txt\<open>Inductive step for @{term Forall}\<close>
+txt\<open>Inductive step for \<^term>\<open>Forall\<close>\<close>
apply (subst transrec)
apply (simp add: formula_imp_formula_N formula.intros)
done
-subsubsection\<open>Absoluteness for the Formula Operator @{term depth}\<close>
+subsubsection\<open>Absoluteness for the Formula Operator \<^term>\<open>depth\<close>\<close>
definition
is_depth :: "[i=>o,i,i] => o" where
@@ -870,13 +870,13 @@
dest: formula_N_imp_depth_lt)
done
-text\<open>Proof is trivial since @{term depth} returns natural numbers.\<close>
+text\<open>Proof is trivial since \<^term>\<open>depth\<close> returns natural numbers.\<close>
lemma (in M_trivial) depth_closed [intro,simp]:
"p \<in> formula ==> M(depth(p))"
by (simp add: nat_into_M)
-subsubsection\<open>@{term is_formula_case}: relativization of @{term formula_case}\<close>
+subsubsection\<open>\<^term>\<open>is_formula_case\<close>: relativization of \<^term>\<open>formula_case\<close>\<close>
definition
is_formula_case ::
@@ -911,18 +911,18 @@
by (erule formula.cases, simp_all)
-subsubsection \<open>Absoluteness for @{term formula_rec}: Final Results\<close>
+subsubsection \<open>Absoluteness for \<^term>\<open>formula_rec\<close>: Final Results\<close>
definition
is_formula_rec :: "[i=>o, [i,i,i]=>o, i, i] => o" where
- \<comment> \<open>predicate to relativize the functional @{term formula_rec}\<close>
+ \<comment> \<open>predicate to relativize the functional \<^term>\<open>formula_rec\<close>\<close>
"is_formula_rec(M,MH,p,z) ==
\<exists>dp[M]. \<exists>i[M]. \<exists>f[M]. finite_ordinal(M,dp) & is_depth(M,p,dp) &
successor(M,dp,i) & fun_apply(M,f,p,z) & is_transrec(M,MH,i,f)"
-text\<open>Sufficient conditions to relativize the instance of @{term formula_case}
- in @{term formula_rec}\<close>
+text\<open>Sufficient conditions to relativize the instance of \<^term>\<open>formula_case\<close>
+ in \<^term>\<open>formula_rec\<close>\<close>
lemma (in M_datatypes) Relation1_formula_rec_case:
"[|Relation2(M, nat, nat, is_a, a);
Relation2(M, nat, nat, is_b, b);
@@ -941,7 +941,7 @@
text\<open>This locale packages the premises of the following theorems,
which is the normal purpose of locales. It doesn't accumulate
- constraints on the class @{term M}, as in most of this deveopment.\<close>
+ constraints on the class \<^term>\<open>M\<close>, as in most of this deveopment.\<close>
locale Formula_Rec = M_eclose +
fixes a and is_a and b and is_b and c and is_c and d and is_d and MH
defines
@@ -995,7 +995,7 @@
by (simp add: transrec_closed [OF fr_replace MH_rel2]
nat_into_M formula_rec_lam_closed)
-text\<open>The main two results: @{term formula_rec} is absolute for @{term M}.\<close>
+text\<open>The main two results: \<^term>\<open>formula_rec\<close> is absolute for \<^term>\<open>M\<close>.\<close>
theorem (in Formula_Rec) formula_rec_closed:
"p \<in> formula ==> M(formula_rec(a,b,c,d,p))"
by (simp add: formula_rec_eq fr_transrec_closed
--- a/src/ZF/Constructible/Formula.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Formula.thy Fri Jan 04 23:22:53 2019 +0100
@@ -284,7 +284,7 @@
lemma incr_bv_type [TC]: "p \<in> formula ==> incr_bv(p) \<in> nat -> formula"
by (induct_tac p, simp_all)
-text\<open>Obviously, @{term DPow} is closed under complements and finite
+text\<open>Obviously, \<^term>\<open>DPow\<close> is closed under complements and finite
intersections and unions. Needs an inductive lemma to allow two lists of
parameters to be combined.\<close>
@@ -404,7 +404,7 @@
==> {x\<in>A. sats(A, p, Cons(x,env))} \<in> DPow(A)"
by (simp add: DPow_def, blast)
-text\<open>With this rule we can specify @{term p} later.\<close>
+text\<open>With this rule we can specify \<^term>\<open>p\<close> later.\<close>
lemma DPowI2 [rule_format]:
"[|\<forall>x\<in>A. P(x) \<longleftrightarrow> sats(A, p, Cons(x,env));
env \<in> list(A); p \<in> formula; arity(p) \<le> succ(length(env))|]
@@ -482,10 +482,10 @@
apply (blast intro: cons_in_DPow)
done
-text\<open>@{term DPow} is not monotonic. For example, let @{term A} be some
-non-constructible set of natural numbers, and let @{term B} be @{term nat}.
-Then @{term "A<=B"} and obviously @{term "A \<in> DPow(A)"} but @{term "A \<notin>
-DPow(B)"}.\<close>
+text\<open>\<^term>\<open>DPow\<close> is not monotonic. For example, let \<^term>\<open>A\<close> be some
+non-constructible set of natural numbers, and let \<^term>\<open>B\<close> be \<^term>\<open>nat\<close>.
+Then \<^term>\<open>A<=B\<close> and obviously \<^term>\<open>A \<in> DPow(A)\<close> but \<^term>\<open>A \<notin>
+DPow(B)\<close>.\<close>
(*This may be true but the proof looks difficult, requiring relativization
lemma DPow_insert: "DPow (cons(a,A)) = DPow(A) \<union> {cons(a,X) . X \<in> DPow(A)}"
@@ -654,7 +654,7 @@
by (force simp add: Lset [of x] Lset [of j])
qed
-text\<open>This version lets us remove the premise @{term "Ord(i)"} sometimes.\<close>
+text\<open>This version lets us remove the premise \<^term>\<open>Ord(i)\<close> sometimes.\<close>
lemma Lset_mono_mem [rule_format]:
"\<forall>j. i \<in> j \<longrightarrow> Lset(i) \<subseteq> Lset(j)"
proof (induct i rule: eps_induct, intro allI impI)
@@ -751,7 +751,7 @@
apply (blast dest: DPow_imp_subset ltD notE [OF notin_Lset])
apply blast
apply (blast dest: ltD)
-txt\<open>Opposite inclusion, @{term "succ(x) \<subseteq> DPow(Lset(x)) \<inter> ON"}\<close>
+txt\<open>Opposite inclusion, \<^term>\<open>succ(x) \<subseteq> DPow(Lset(x)) \<inter> ON\<close>\<close>
apply auto
txt\<open>Key case:\<close>
apply (erule subst, rule Ords_in_DPow [OF Transset_Lset])
@@ -780,7 +780,7 @@
apply (rule LsetI [OF succI1])
apply (simp add: Transset_def DPow_def)
apply (intro conjI, blast)
-txt\<open>Now to create the formula @{term "\<exists>y. y \<in> X \<and> x \<in> y"}\<close>
+txt\<open>Now to create the formula \<^term>\<open>\<exists>y. y \<in> X \<and> x \<in> y\<close>\<close>
apply (rule_tac x="Cons(X,Nil)" in bexI)
apply (rule_tac x="Exists(And(Member(0,2), Member(1,0)))" in bexI)
apply typecheck
@@ -808,7 +808,7 @@
lemmas Lset_UnI1 = Un_upper1 [THEN Lset_mono [THEN subsetD]]
lemmas Lset_UnI2 = Un_upper2 [THEN Lset_mono [THEN subsetD]]
-text\<open>Hard work is finding a single @{term"j \<in> i"} such that @{term"{a,b} \<subseteq> Lset(j)"}\<close>
+text\<open>Hard work is finding a single \<^term>\<open>j \<in> i\<close> such that \<^term>\<open>{a,b} \<subseteq> Lset(j)\<close>\<close>
lemma doubleton_in_LLimit:
"[| a \<in> Lset(i); b \<in> Lset(i); Limit(i) |] ==> {a,b} \<in> Lset(i)"
apply (erule Limit_LsetE, assumption)
@@ -828,7 +828,7 @@
txt\<open>Infer that a, b occur at ordinals x,xa < i.\<close>
apply (erule Limit_LsetE, assumption)
apply (erule Limit_LsetE, assumption)
-txt\<open>Infer that @{term"succ(succ(x \<union> xa)) < i"}\<close>
+txt\<open>Infer that \<^term>\<open>succ(succ(x \<union> xa)) < i\<close>\<close>
apply (blast intro: lt_Ord lt_LsetI [OF Pair_in_Lset]
Lset_UnI1 Lset_UnI2 Limit_has_succ Un_least_lt)
done
@@ -923,7 +923,7 @@
apply (simp add: Lset_succ Vset_succ Finite_Vset Finite_DPow_eq_Pow)
done
-text\<open>Every set of constructible sets is included in some @{term Lset}\<close>
+text\<open>Every set of constructible sets is included in some \<^term>\<open>Lset\<close>\<close>
lemma subset_Lset:
"(\<forall>x\<in>A. L(x)) ==> \<exists>i. Ord(i) & A \<subseteq> Lset(i)"
by (rule_tac x = "\<Union>x\<in>A. succ(lrank(x))" in exI, force)
@@ -949,7 +949,7 @@
apply (simp add: DPow_def)
apply (intro conjI, clarify)
apply (rule_tac a=x in UN_I, simp+)
-txt\<open>Now to create the formula @{term "y \<subseteq> X"}\<close>
+txt\<open>Now to create the formula \<^term>\<open>y \<subseteq> X\<close>\<close>
apply (rule_tac x="Cons(X,Nil)" in bexI)
apply (rule_tac x="subset_fm(0,1)" in bexI)
apply typecheck
@@ -964,7 +964,7 @@
by (blast intro: L_I dest: L_D LPow_in_Lset)
-subsection\<open>Eliminating @{term arity} from the Definition of @{term Lset}\<close>
+subsection\<open>Eliminating \<^term>\<open>arity\<close> from the Definition of \<^term>\<open>Lset\<close>\<close>
lemma nth_zero_eq_0: "n \<in> nat ==> nth(n,[0]) = 0"
by (induct_tac n, auto)
@@ -995,7 +995,7 @@
done
-text\<open>A simpler version of @{term DPow}: no arity check!\<close>
+text\<open>A simpler version of \<^term>\<open>DPow\<close>: no arity check!\<close>
definition
DPow' :: "i => i" where
"DPow'(A) == {X \<in> Pow(A).
@@ -1022,8 +1022,8 @@
apply (erule DPow'_subset_DPow)
done
-text\<open>And thus we can relativize @{term Lset} without bothering with
- @{term arity} and @{term length}\<close>
+text\<open>And thus we can relativize \<^term>\<open>Lset\<close> without bothering with
+ \<^term>\<open>arity\<close> and \<^term>\<open>length\<close>\<close>
lemma Lset_eq_transrec_DPow': "Lset(i) = transrec(i, %x f. \<Union>y\<in>x. DPow'(f`y))"
apply (rule_tac a=i in eps_induct)
apply (subst Lset)
@@ -1031,7 +1031,7 @@
apply (simp only: DPow_eq_DPow' [OF Transset_Lset], simp)
done
-text\<open>With this rule we can specify @{term p} later and don't worry about
+text\<open>With this rule we can specify \<^term>\<open>p\<close> later and don't worry about
arities at all!\<close>
lemma DPow_LsetI [rule_format]:
"[|\<forall>x\<in>Lset(i). P(x) \<longleftrightarrow> sats(Lset(i), p, Cons(x,env));
--- a/src/ZF/Constructible/Internalize.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Internalize.thy Fri Jan 04 23:22:53 2019 +0100
@@ -6,7 +6,7 @@
subsection\<open>Internalized Forms of Data Structuring Operators\<close>
-subsubsection\<open>The Formula @{term is_Inl}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_Inl\<close>, Internalized\<close>
(* is_Inl(M,a,z) == \<exists>zero[M]. empty(M,zero) & pair(M,zero,a,z) *)
definition
@@ -36,7 +36,7 @@
done
-subsubsection\<open>The Formula @{term is_Inr}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_Inr\<close>, Internalized\<close>
(* is_Inr(M,a,z) == \<exists>n1[M]. number1(M,n1) & pair(M,n1,a,z) *)
definition
@@ -66,7 +66,7 @@
done
-subsubsection\<open>The Formula @{term is_Nil}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_Nil\<close>, Internalized\<close>
(* is_Nil(M,xs) == \<exists>zero[M]. empty(M,zero) & is_Inl(M,zero,xs) *)
@@ -95,7 +95,7 @@
done
-subsubsection\<open>The Formula @{term is_Cons}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_Cons\<close>, Internalized\<close>
(* "is_Cons(M,a,l,Z) == \<exists>p[M]. pair(M,a,l,p) & is_Inr(M,p,Z)" *)
@@ -127,7 +127,7 @@
apply (intro FOL_reflections pair_reflection Inr_reflection)
done
-subsubsection\<open>The Formula @{term is_quasilist}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_quasilist\<close>, Internalized\<close>
(* is_quasilist(M,xs) == is_Nil(M,z) | (\<exists>x[M]. \<exists>l[M]. is_Cons(M,x,l,z))" *)
@@ -157,10 +157,10 @@
done
-subsection\<open>Absoluteness for the Function @{term nth}\<close>
+subsection\<open>Absoluteness for the Function \<^term>\<open>nth\<close>\<close>
-subsubsection\<open>The Formula @{term is_hd}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_hd\<close>, Internalized\<close>
(* "is_hd(M,xs,H) ==
(is_Nil(M,xs) \<longrightarrow> empty(M,H)) &
@@ -197,7 +197,7 @@
done
-subsubsection\<open>The Formula @{term is_tl}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_tl\<close>, Internalized\<close>
(* "is_tl(M,xs,T) ==
(is_Nil(M,xs) \<longrightarrow> T=xs) &
@@ -234,12 +234,12 @@
done
-subsubsection\<open>The Operator @{term is_bool_of_o}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_bool_of_o\<close>\<close>
(* is_bool_of_o :: "[i=>o, o, i] => o"
"is_bool_of_o(M,P,z) == (P & number1(M,z)) | (~P & empty(M,z))" *)
-text\<open>The formula @{term p} has no free variables.\<close>
+text\<open>The formula \<^term>\<open>p\<close> has no free variables.\<close>
definition
bool_of_o_fm :: "[i, i]=>i" where
"bool_of_o_fm(p,z) ==
@@ -274,10 +274,10 @@
subsection\<open>More Internalizations\<close>
-subsubsection\<open>The Operator @{term is_lambda}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_lambda\<close>\<close>
-text\<open>The two arguments of @{term p} are always 1, 0. Remember that
- @{term p} will be enclosed by three quantifiers.\<close>
+text\<open>The two arguments of \<^term>\<open>p\<close> are always 1, 0. Remember that
+ \<^term>\<open>p\<close> will be enclosed by three quantifiers.\<close>
(* is_lambda :: "[i=>o, i, [i,i]=>o, i] => o"
"is_lambda(M, A, is_b, z) ==
@@ -290,7 +290,7 @@
Exists(Exists(And(Member(1,A#+3),
And(pair_fm(1,0,2), p))))))"
-text\<open>We call @{term p} with arguments x, y by equating them with
+text\<open>We call \<^term>\<open>p\<close> with arguments x, y by equating them with
the corresponding quantified variables with de Bruijn indices 1, 0.\<close>
lemma is_lambda_type [TC]:
@@ -319,7 +319,7 @@
apply (intro FOL_reflections is_b_reflection pair_reflection)
done
-subsubsection\<open>The Operator @{term is_Member}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_Member\<close>, Internalized\<close>
(* "is_Member(M,x,y,Z) ==
\<exists>p[M]. \<exists>u[M]. pair(M,x,y,p) & is_Inl(M,p,u) & is_Inl(M,u,Z)" *)
@@ -352,7 +352,7 @@
apply (intro FOL_reflections pair_reflection Inl_reflection)
done
-subsubsection\<open>The Operator @{term is_Equal}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_Equal\<close>, Internalized\<close>
(* "is_Equal(M,x,y,Z) ==
\<exists>p[M]. \<exists>u[M]. pair(M,x,y,p) & is_Inr(M,p,u) & is_Inl(M,u,Z)" *)
@@ -385,7 +385,7 @@
apply (intro FOL_reflections pair_reflection Inl_reflection Inr_reflection)
done
-subsubsection\<open>The Operator @{term is_Nand}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_Nand\<close>, Internalized\<close>
(* "is_Nand(M,x,y,Z) ==
\<exists>p[M]. \<exists>u[M]. pair(M,x,y,p) & is_Inl(M,p,u) & is_Inr(M,u,Z)" *)
@@ -418,7 +418,7 @@
apply (intro FOL_reflections pair_reflection Inl_reflection Inr_reflection)
done
-subsubsection\<open>The Operator @{term is_Forall}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_Forall\<close>, Internalized\<close>
(* "is_Forall(M,p,Z) == \<exists>u[M]. is_Inr(M,p,u) & is_Inr(M,u,Z)" *)
definition
@@ -450,7 +450,7 @@
done
-subsubsection\<open>The Operator @{term is_and}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_and\<close>, Internalized\<close>
(* is_and(M,a,b,z) == (number1(M,a) & z=b) |
(~number1(M,a) & empty(M,z)) *)
@@ -484,7 +484,7 @@
done
-subsubsection\<open>The Operator @{term is_or}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_or\<close>, Internalized\<close>
(* is_or(M,a,b,z) == (number1(M,a) & number1(M,z)) |
(~number1(M,a) & z=b) *)
@@ -520,7 +520,7 @@
-subsubsection\<open>The Operator @{term is_not}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_not\<close>, Internalized\<close>
(* is_not(M,a,z) == (number1(M,a) & empty(M,z)) |
(~number1(M,a) & number1(M,z)) *)
@@ -561,7 +561,7 @@
subsection\<open>Well-Founded Recursion!\<close>
-subsubsection\<open>The Operator @{term M_is_recfun}\<close>
+subsubsection\<open>The Operator \<^term>\<open>M_is_recfun\<close>\<close>
text\<open>Alternative definition, minimizing nesting of quantifiers around MH\<close>
lemma M_is_recfun_iff:
@@ -590,7 +590,7 @@
xa \<in> r)"
*)
-text\<open>The three arguments of @{term p} are always 2, 1, 0 and z\<close>
+text\<open>The three arguments of \<^term>\<open>p\<close> are always 2, 1, 0 and z\<close>
definition
is_recfun_fm :: "[i, i, i, i]=>i" where
"is_recfun_fm(p,r,a,f) ==
@@ -632,8 +632,8 @@
==> M_is_recfun(##A, MH, x, y, z) \<longleftrightarrow> sats(A, is_recfun_fm(p,i,j,k), env)"
by (simp add: sats_is_recfun_fm [OF MH_iff_sats])
-text\<open>The additional variable in the premise, namely @{term f'}, is essential.
-It lets @{term MH} depend upon @{term x}, which seems often necessary.
+text\<open>The additional variable in the premise, namely \<^term>\<open>f'\<close>, is essential.
+It lets \<^term>\<open>MH\<close> depend upon \<^term>\<open>x\<close>, which seems often necessary.
The same thing occurs in \<open>is_wfrec_reflection\<close>.\<close>
theorem is_recfun_reflection:
assumes MH_reflection:
@@ -646,10 +646,10 @@
restriction_reflection MH_reflection)
done
-subsubsection\<open>The Operator @{term is_wfrec}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_wfrec\<close>\<close>
-text\<open>The three arguments of @{term p} are always 2, 1, 0;
- @{term p} is enclosed by 5 quantifiers.\<close>
+text\<open>The three arguments of \<^term>\<open>p\<close> are always 2, 1, 0;
+ \<^term>\<open>p\<close> is enclosed by 5 quantifiers.\<close>
(* is_wfrec :: "[i=>o, i, [i,i,i]=>o, i, i] => o"
"is_wfrec(M,MH,r,a,z) ==
@@ -661,7 +661,7 @@
Exists(Exists(Exists(Exists(
And(Equal(2,a#+5), And(Equal(1,4), And(Equal(0,z#+5), p)))))))))"
-text\<open>We call @{term p} with arguments a, f, z by equating them with
+text\<open>We call \<^term>\<open>p\<close> with arguments a, f, z by equating them with
the corresponding quantified variables with de Bruijn indices 2, 1, 0.\<close>
text\<open>There's an additional existential quantifier to ensure that the
@@ -787,7 +787,7 @@
done
-subsubsection\<open>The Operator @{term quasinat}\<close>
+subsubsection\<open>The Operator \<^term>\<open>quasinat\<close>\<close>
(* "is_quasinat(M,z) == empty(M,z) | (\<exists>m[M]. successor(M,m,z))" *)
definition
@@ -817,17 +817,17 @@
done
-subsubsection\<open>The Operator @{term is_nat_case}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_nat_case\<close>\<close>
text\<open>I could not get it to work with the more natural assumption that
- @{term is_b} takes two arguments. Instead it must be a formula where 1 and 0
- stand for @{term m} and @{term b}, respectively.\<close>
+ \<^term>\<open>is_b\<close> takes two arguments. Instead it must be a formula where 1 and 0
+ stand for \<^term>\<open>m\<close> and \<^term>\<open>b\<close>, respectively.\<close>
(* is_nat_case :: "[i=>o, i, [i,i]=>o, i, i] => o"
"is_nat_case(M, a, is_b, k, z) ==
(empty(M,k) \<longrightarrow> z=a) &
(\<forall>m[M]. successor(M,m,k) \<longrightarrow> is_b(m,z)) &
(is_quasinat(M,k) | empty(M,z))" *)
-text\<open>The formula @{term is_b} has free variables 1 and 0.\<close>
+text\<open>The formula \<^term>\<open>is_b\<close> has free variables 1 and 0.\<close>
definition
is_nat_case_fm :: "[i, i, i, i]=>i" where
"is_nat_case_fm(a,is_b,k,z) ==
@@ -863,9 +863,9 @@
by (simp add: sats_is_nat_case_fm [of A is_b])
-text\<open>The second argument of @{term is_b} gives it direct access to @{term x},
+text\<open>The second argument of \<^term>\<open>is_b\<close> gives it direct access to \<^term>\<open>x\<close>,
which is essential for handling free variable references. Without this
- argument, we cannot prove reflection for @{term iterates_MH}.\<close>
+ argument, we cannot prove reflection for \<^term>\<open>iterates_MH\<close>.\<close>
theorem is_nat_case_reflection:
assumes is_b_reflection:
"!!h f g. REFLECTS[\<lambda>x. is_b(L, h(x), f(x), g(x)),
@@ -878,7 +878,7 @@
done
-subsection\<open>The Operator @{term iterates_MH}, Needed for Iteration\<close>
+subsection\<open>The Operator \<^term>\<open>iterates_MH\<close>, Needed for Iteration\<close>
(* iterates_MH :: "[i=>o, [i,i]=>o, i, i, i, i] => o"
"iterates_MH(M,isF,v,n,g,z) ==
@@ -926,9 +926,9 @@
sats(A, iterates_MH_fm(p,i',i,j,k), env)"
by (simp add: sats_iterates_MH_fm [OF is_F_iff_sats])
-text\<open>The second argument of @{term p} gives it direct access to @{term x},
+text\<open>The second argument of \<^term>\<open>p\<close> gives it direct access to \<^term>\<open>x\<close>,
which is essential for handling free variable references. Without this
- argument, we cannot prove reflection for @{term list_N}.\<close>
+ argument, we cannot prove reflection for \<^term>\<open>list_N\<close>.\<close>
theorem iterates_MH_reflection:
assumes p_reflection:
"!!f g h. REFLECTS[\<lambda>x. p(L, h(x), f(x), g(x)),
@@ -941,10 +941,10 @@
done
-subsubsection\<open>The Operator @{term is_iterates}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_iterates\<close>\<close>
-text\<open>The three arguments of @{term p} are always 2, 1, 0;
- @{term p} is enclosed by 9 (??) quantifiers.\<close>
+text\<open>The three arguments of \<^term>\<open>p\<close> are always 2, 1, 0;
+ \<^term>\<open>p\<close> is enclosed by 9 (??) quantifiers.\<close>
(* "is_iterates(M,isF,v,n,Z) ==
\<exists>sn[M]. \<exists>msn[M]. successor(M,n,sn) & membership(M,sn,msn) &
@@ -959,7 +959,7 @@
is_wfrec_fm(iterates_MH_fm(p, v#+7, 2, 1, 0),
0, n#+2, Z#+2)))))"
-text\<open>We call @{term p} with arguments a, f, z by equating them with
+text\<open>We call \<^term>\<open>p\<close> with arguments a, f, z by equating them with
the corresponding quantified variables with de Bruijn indices 2, 1, 0.\<close>
@@ -1002,9 +1002,9 @@
sats(A, is_iterates_fm(p,i,j,k), env)"
by (simp add: sats_is_iterates_fm [OF is_F_iff_sats])
-text\<open>The second argument of @{term p} gives it direct access to @{term x},
+text\<open>The second argument of \<^term>\<open>p\<close> gives it direct access to \<^term>\<open>x\<close>,
which is essential for handling free variable references. Without this
- argument, we cannot prove reflection for @{term list_N}.\<close>
+ argument, we cannot prove reflection for \<^term>\<open>list_N\<close>.\<close>
theorem is_iterates_reflection:
assumes p_reflection:
"!!f g h. REFLECTS[\<lambda>x. p(L, h(x), f(x), g(x)),
@@ -1017,7 +1017,7 @@
done
-subsubsection\<open>The Formula @{term is_eclose_n}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_eclose_n\<close>, Internalized\<close>
(* is_eclose_n(M,A,n,Z) == is_iterates(M, big_union(M), A, n, Z) *)
@@ -1053,7 +1053,7 @@
done
-subsubsection\<open>Membership in @{term "eclose(A)"}\<close>
+subsubsection\<open>Membership in \<^term>\<open>eclose(A)\<close>\<close>
(* mem_eclose(M,A,l) ==
\<exists>n[M]. \<exists>eclosen[M].
@@ -1088,7 +1088,7 @@
done
-subsubsection\<open>The Predicate ``Is @{term "eclose(A)"}''\<close>
+subsubsection\<open>The Predicate ``Is \<^term>\<open>eclose(A)\<close>''\<close>
(* is_eclose(M,A,Z) == \<forall>l[M]. l \<in> Z \<longleftrightarrow> mem_eclose(M,A,l) *)
definition
@@ -1156,7 +1156,7 @@
done
-subsubsection\<open>The Formula @{term is_list_N}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_list_N\<close>, Internalized\<close>
(* "is_list_N(M,A,n,Z) ==
\<exists>zero[M]. empty(M,zero) &
@@ -1233,7 +1233,7 @@
done
-subsubsection\<open>The Predicate ``Is @{term "list(A)"}''\<close>
+subsubsection\<open>The Predicate ``Is \<^term>\<open>list(A)\<close>''\<close>
(* is_list(M,A,Z) == \<forall>l[M]. l \<in> Z \<longleftrightarrow> mem_list(M,A,l) *)
definition
@@ -1307,7 +1307,7 @@
done
-subsubsection\<open>The Formula @{term is_formula_N}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_formula_N\<close>, Internalized\<close>
(* "is_formula_N(M,n,Z) ==
\<exists>zero[M]. empty(M,zero) &
@@ -1383,7 +1383,7 @@
-subsubsection\<open>The Predicate ``Is @{term "formula"}''\<close>
+subsubsection\<open>The Predicate ``Is \<^term>\<open>formula\<close>''\<close>
(* is_formula(M,Z) == \<forall>p[M]. p \<in> Z \<longleftrightarrow> mem_formula(M,p) *)
definition
@@ -1412,11 +1412,11 @@
done
-subsubsection\<open>The Operator @{term is_transrec}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_transrec\<close>\<close>
-text\<open>The three arguments of @{term p} are always 2, 1, 0. It is buried
+text\<open>The three arguments of \<^term>\<open>p\<close> are always 2, 1, 0. It is buried
within eight quantifiers!
- We call @{term p} with arguments a, f, z by equating them with
+ We call \<^term>\<open>p\<close> with arguments a, f, z by equating them with
the corresponding quantified variables with de Bruijn indices 2, 1, 0.\<close>
(* is_transrec :: "[i=>o, [i,i,i]=>o, i, i] => o"
--- a/src/ZF/Constructible/L_axioms.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/L_axioms.thy Fri Jan 04 23:22:53 2019 +0100
@@ -38,7 +38,7 @@
apply (blast intro: transL)
done
-text\<open>We don't actually need @{term L} to satisfy the foundation axiom.\<close>
+text\<open>We don't actually need \<^term>\<open>L\<close> to satisfy the foundation axiom.\<close>
theorem foundation_ax: "foundation_ax(L)"
apply (simp add: foundation_ax_def)
apply (rule rallI)
@@ -565,9 +565,9 @@
subsubsection\<open>Variants of Satisfaction Definitions for Ordinals, etc.\<close>
text\<open>The \<open>sats\<close> theorems below are standard versions of the ones proved
-in theory \<open>Formula\<close>. They relate elements of type @{term formula} to
-relativized concepts such as @{term subset} or @{term ordinal} rather than to
-real concepts such as @{term Ord}. Now that we have instantiated the locale
+in theory \<open>Formula\<close>. They relate elements of type \<^term>\<open>formula\<close> to
+relativized concepts such as \<^term>\<open>subset\<close> or \<^term>\<open>ordinal\<close> rather than to
+real concepts such as \<^term>\<open>Ord\<close>. Now that we have instantiated the locale
\<open>M_trivial\<close>, we no longer require the earlier versions.\<close>
lemma sats_subset_fm':
--- a/src/ZF/Constructible/Normal.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Normal.thy Fri Jan 04 23:22:53 2019 +0100
@@ -55,11 +55,11 @@
theorem Closed_Unbounded_V [simp]: "Closed_Unbounded(\<lambda>x. True)"
by (unfold Closed_Unbounded_def Closed_def Unbounded_def, blast)
-text\<open>The class of ordinals, @{term Ord}, is closed and unbounded.\<close>
+text\<open>The class of ordinals, \<^term>\<open>Ord\<close>, is closed and unbounded.\<close>
theorem Closed_Unbounded_Ord [simp]: "Closed_Unbounded(Ord)"
by (unfold Closed_Unbounded_def Closed_def Unbounded_def, blast)
-text\<open>The class of limit ordinals, @{term Limit}, is closed and unbounded.\<close>
+text\<open>The class of limit ordinals, \<^term>\<open>Limit\<close>, is closed and unbounded.\<close>
theorem Closed_Unbounded_Limit [simp]: "Closed_Unbounded(Limit)"
apply (simp add: Closed_Unbounded_def Closed_def Unbounded_def Limit_Union,
clarify)
@@ -67,7 +67,7 @@
apply (blast intro: oadd_lt_self oadd_LimitI Limit_nat Limit_has_0)
done
-text\<open>The class of cardinals, @{term Card}, is closed and unbounded.\<close>
+text\<open>The class of cardinals, \<^term>\<open>Card\<close>, is closed and unbounded.\<close>
theorem Closed_Unbounded_Card [simp]: "Closed_Unbounded(Card)"
apply (simp add: Closed_Unbounded_def Closed_def Unbounded_def Card_Union)
apply (blast intro: lt_csucc Card_csucc)
@@ -80,8 +80,8 @@
text\<open>The constructions below come from Kunen, \emph{Set Theory}, page 78.\<close>
locale cub_family =
fixes P and A
- fixes next_greater \<comment> \<open>the next ordinal satisfying class @{term A}\<close>
- fixes sup_greater \<comment> \<open>sup of those ordinals over all @{term A}\<close>
+ fixes next_greater \<comment> \<open>the next ordinal satisfying class \<^term>\<open>A\<close>\<close>
+ fixes sup_greater \<comment> \<open>sup of those ordinals over all \<^term>\<open>A\<close>\<close>
assumes closed: "a\<in>A ==> Closed(P(a))"
and unbounded: "a\<in>A ==> Unbounded(P(a))"
and A_non0: "A\<noteq>0"
@@ -103,8 +103,8 @@
"Ord(next_greater(a,x))"
by (simp add: next_greater_def Ord_Least)
-text\<open>@{term next_greater} works as expected: it returns a larger value
-and one that belongs to class @{term "P(a)"}.\<close>
+text\<open>\<^term>\<open>next_greater\<close> works as expected: it returns a larger value
+and one that belongs to class \<^term>\<open>P(a)\<close>.\<close>
lemma (in cub_family) next_greater_lemma:
"[| Ord(x); a\<in>A |] ==> P(a, next_greater(a,x)) \<and> x < next_greater(a,x)"
apply (simp add: next_greater_def)
@@ -285,11 +285,11 @@
apply (frule Ord_set_cases)
apply (erule disjE, force)
apply (thin_tac "X=0 \<longrightarrow> Q" for Q, auto)
- txt\<open>The trival case of @{term "\<Union>X \<in> X"}\<close>
+ txt\<open>The trival case of \<^term>\<open>\<Union>X \<in> X\<close>\<close>
apply (rule equalityI, blast intro: Ord_Union_eq_succD)
apply (simp add: mono_le_subset_def UN_subset_iff le_subset_iff)
apply (blast elim: equalityE)
-txt\<open>The limit case, @{term "Limit(\<Union>X)"}:
+txt\<open>The limit case, \<^term>\<open>Limit(\<Union>X)\<close>:
@{subgoals[display,indent=0,margin=65]}
\<close>
apply (simp add: OUN_Union_eq cont_Ord_def)
--- a/src/ZF/Constructible/Rank.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Rank.thy Fri Jan 04 23:22:53 2019 +0100
@@ -93,7 +93,7 @@
not required elsewhere.\<close>
text\<open>Can't use \<open>well_ord_iso_preserving\<close> because it needs the
-strong premise @{term "well_ord(A,r)"}\<close>
+strong premise \<^term>\<open>well_ord(A,r)\<close>\<close>
lemma (in M_ordertype) ord_iso_pred_imp_lt:
"[| f \<in> ord_iso(Order.pred(A,x,r), r, i, Memrel(i));
g \<in> ord_iso(Order.pred(A,y,r), r, j, Memrel(j));
@@ -103,18 +103,18 @@
apply (frule wellordered_is_trans_on, assumption)
apply (frule_tac y=y in transM, assumption)
apply (rule_tac i=i and j=j in Ord_linear_lt, auto)
-txt\<open>case @{term "i=j"} yields a contradiction\<close>
+txt\<open>case \<^term>\<open>i=j\<close> yields a contradiction\<close>
apply (rule_tac x1=x and A1="Order.pred(A,y,r)" in
wellordered_iso_predD [THEN notE])
apply (blast intro: wellordered_subset [OF _ pred_subset])
apply (simp add: trans_pred_pred_eq)
apply (blast intro: Ord_iso_implies_eq ord_iso_sym ord_iso_trans)
apply (simp_all add: pred_iff pred_closed converse_closed comp_closed)
-txt\<open>case @{term "j<i"} also yields a contradiction\<close>
+txt\<open>case \<^term>\<open>j<i\<close> also yields a contradiction\<close>
apply (frule restrict_ord_iso2, assumption+)
apply (frule ord_iso_sym [THEN ord_iso_is_bij, THEN bij_is_fun])
apply (frule apply_type, blast intro: ltD)
- \<comment> \<open>thus @{term "converse(f)`j \<in> Order.pred(A,x,r)"}\<close>
+ \<comment> \<open>thus \<^term>\<open>converse(f)`j \<in> Order.pred(A,x,r)\<close>\<close>
apply (simp add: pred_iff)
apply (subgoal_tac
"\<exists>h[M]. h \<in> ord_iso(Order.pred(A,y,r), r,
@@ -154,8 +154,8 @@
"otype(M,A,r,i) == \<exists>f[M]. omap(M,A,r,f) & is_range(M,f,i)"
-text\<open>Can also be proved with the premise @{term "M(z)"} instead of
- @{term "M(f)"}, but that version is less useful. This lemma
+text\<open>Can also be proved with the premise \<^term>\<open>M(z)\<close> instead of
+ \<^term>\<open>M(f)\<close>, but that version is less useful. This lemma
is also more useful than the definition, \<open>omap_def\<close>.\<close>
lemma (in M_ordertype) omap_iff:
"[| omap(M,A,r,f); M(A); M(f) |]
@@ -256,7 +256,7 @@
done
-text\<open>This is not the final result: we must show @{term "oB(A,r) = A"}\<close>
+text\<open>This is not the final result: we must show \<^term>\<open>oB(A,r) = A\<close>\<close>
lemma (in M_ordertype) omap_ord_iso:
"[| wellordered(M,A,r); omap(M,A,r,f); otype(M,A,r,i);
M(A); M(r); M(f); M(i) |] ==> f \<in> ord_iso(obase(M,A,r),r,i,Memrel(i))"
@@ -266,15 +266,15 @@
apply (frule_tac a=x in apply_Pair, assumption)
apply (frule_tac a=y in apply_Pair, assumption)
apply (auto simp add: omap_iff)
- txt\<open>direction 1: assuming @{term "\<langle>x,y\<rangle> \<in> r"}\<close>
+ txt\<open>direction 1: assuming \<^term>\<open>\<langle>x,y\<rangle> \<in> r\<close>\<close>
apply (blast intro: ltD ord_iso_pred_imp_lt)
- txt\<open>direction 2: proving @{term "\<langle>x,y\<rangle> \<in> r"} using linearity of @{term r}\<close>
+ txt\<open>direction 2: proving \<^term>\<open>\<langle>x,y\<rangle> \<in> r\<close> using linearity of \<^term>\<open>r\<close>\<close>
apply (rename_tac x y g ga)
apply (frule wellordered_is_linear, assumption,
erule_tac x=x and y=y in linearE, assumption+)
-txt\<open>the case @{term "x=y"} leads to immediate contradiction\<close>
+txt\<open>the case \<^term>\<open>x=y\<close> leads to immediate contradiction\<close>
apply (blast elim: mem_irrefl)
-txt\<open>the case @{term "\<langle>y,x\<rangle> \<in> r"}: handle like the opposite direction\<close>
+txt\<open>the case \<^term>\<open>\<langle>y,x\<rangle> \<in> r\<close>: handle like the opposite direction\<close>
apply (blast dest: ord_iso_pred_imp_lt ltD elim: mem_asym)
done
@@ -331,8 +331,8 @@
-text\<open>Main result: @{term om} gives the order-isomorphism
- @{term "\<langle>A,r\<rangle> \<cong> \<langle>i, Memrel(i)\<rangle>"}\<close>
+text\<open>Main result: \<^term>\<open>om\<close> gives the order-isomorphism
+ \<^term>\<open>\<langle>A,r\<rangle> \<cong> \<langle>i, Memrel(i)\<rangle>\<close>\<close>
theorem (in M_ordertype) omap_ord_iso_otype:
"[| wellordered(M,A,r); omap(M,A,r,f); otype(M,A,r,i);
M(A); M(r); M(f); M(i) |] ==> f \<in> ord_iso(A, r, i, Memrel(i))"
@@ -671,8 +671,8 @@
subsection \<open>Absoluteness of Well-Founded Relations\<close>
-text\<open>Relativized to @{term M}: Every well-founded relation is a subset of some
-inverse image of an ordinal. Key step is the construction (in @{term M}) of a
+text\<open>Relativized to \<^term>\<open>M\<close>: Every well-founded relation is a subset of some
+inverse image of an ordinal. Key step is the construction (in \<^term>\<open>M\<close>) of a
rank function.\<close>
locale M_wfrank = M_trancl +
@@ -766,9 +766,9 @@
apply (rule wellfounded_induct, assumption, erule (1) transM)
apply simp
apply (blast intro: Ord_wfrank_separation', clarify)
-txt\<open>The reasoning in both cases is that we get @{term y} such that
- @{term "\<langle>y, x\<rangle> \<in> r^+"}. We find that
- @{term "f`y = restrict(f, r^+ -`` {y})"}.\<close>
+txt\<open>The reasoning in both cases is that we get \<^term>\<open>y\<close> such that
+ \<^term>\<open>\<langle>y, x\<rangle> \<in> r^+\<close>. We find that
+ \<^term>\<open>f`y = restrict(f, r^+ -`` {y})\<close>.\<close>
apply (rule OrdI [OF _ Ord_is_Transset])
txt\<open>An ordinal is a transitive set...\<close>
apply (simp add: Transset_def)
--- a/src/ZF/Constructible/Rank_Separation.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Rank_Separation.thy Fri Jan 04 23:22:53 2019 +0100
@@ -34,7 +34,7 @@
done
-subsubsection\<open>Separation for @{term "obase"}\<close>
+subsubsection\<open>Separation for \<^term>\<open>obase\<close>\<close>
lemma obase_reflects:
"REFLECTS[\<lambda>a. \<exists>x[L]. \<exists>g[L]. \<exists>mx[L]. \<exists>par[L].
@@ -57,7 +57,7 @@
done
-subsubsection\<open>Separation for a Theorem about @{term "obase"}\<close>
+subsubsection\<open>Separation for a Theorem about \<^term>\<open>obase\<close>\<close>
lemma obase_equals_reflects:
"REFLECTS[\<lambda>x. x\<in>A \<longrightarrow> ~(\<exists>y[L]. \<exists>g[L].
@@ -82,7 +82,7 @@
done
-subsubsection\<open>Replacement for @{term "omap"}\<close>
+subsubsection\<open>Replacement for \<^term>\<open>omap\<close>\<close>
lemma omap_reflects:
"REFLECTS[\<lambda>z. \<exists>a[L]. a\<in>B & (\<exists>x[L]. \<exists>g[L]. \<exists>mx[L]. \<exists>par[L].
@@ -129,7 +129,7 @@
subsection\<open>The Locale \<open>M_wfrank\<close>\<close>
-subsubsection\<open>Separation for @{term "wfrank"}\<close>
+subsubsection\<open>Separation for \<^term>\<open>wfrank\<close>\<close>
lemma wfrank_Reflects:
"REFLECTS[\<lambda>x. \<forall>rplus[L]. tran_closure(L,r,rplus) \<longrightarrow>
@@ -150,7 +150,7 @@
done
-subsubsection\<open>Replacement for @{term "wfrank"}\<close>
+subsubsection\<open>Replacement for \<^term>\<open>wfrank\<close>\<close>
lemma wfrank_replacement_Reflects:
"REFLECTS[\<lambda>z. \<exists>x[L]. x \<in> A &
--- a/src/ZF/Constructible/Rec_Separation.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Rec_Separation.thy Fri Jan 04 23:22:53 2019 +0100
@@ -71,7 +71,7 @@
apply (intro FOL_reflections function_reflections fun_plus_reflections)
done
-text\<open>Separation for @{term "rtrancl(r)"}.\<close>
+text\<open>Separation for \<^term>\<open>rtrancl(r)\<close>.\<close>
lemma rtrancl_separation:
"[| L(r); L(A) |] ==> separation (L, rtran_closure_mem(L,A,r))"
apply (rule gen_separation_multi [OF rtran_closure_mem_reflection, of "{r,A}"],
@@ -187,7 +187,7 @@
interpretation L?: M_trancl L by (rule M_trancl_L)
-subsection\<open>@{term L} is Closed Under the Operator @{term list}\<close>
+subsection\<open>\<^term>\<open>L\<close> is Closed Under the Operator \<^term>\<open>list\<close>\<close>
subsubsection\<open>Instances of Replacement for Lists\<close>
@@ -237,7 +237,7 @@
done
-subsection\<open>@{term L} is Closed Under the Operator @{term formula}\<close>
+subsection\<open>\<^term>\<open>L\<close> is Closed Under the Operator \<^term>\<open>formula\<close>\<close>
subsubsection\<open>Instances of Replacement for Formulas\<close>
@@ -286,11 +286,11 @@
apply (rule sep_rules formula_functor_iff_sats is_iterates_iff_sats | simp)+
done
-text\<open>NB The proofs for type @{term formula} are virtually identical to those
-for @{term "list(A)"}. It was a cut-and-paste job!\<close>
+text\<open>NB The proofs for type \<^term>\<open>formula\<close> are virtually identical to those
+for \<^term>\<open>list(A)\<close>. It was a cut-and-paste job!\<close>
-subsubsection\<open>The Formula @{term is_nth}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_nth\<close>, Internalized\<close>
(* "is_nth(M,n,l,Z) ==
\<exists>X[M]. is_iterates(M, is_tl(M), l, n, X) & is_hd(M,X,Z)" *)
@@ -327,7 +327,7 @@
done
-subsubsection\<open>An Instance of Replacement for @{term nth}\<close>
+subsubsection\<open>An Instance of Replacement for \<^term>\<open>nth\<close>\<close>
(*FIXME: could prove a lemma iterates_replacementI to eliminate the
need to expand iterates_replacement and wfrec_replacement*)
@@ -374,9 +374,9 @@
interpretation L?: M_datatypes L by (rule M_datatypes_L)
-subsection\<open>@{term L} is Closed Under the Operator @{term eclose}\<close>
+subsection\<open>\<^term>\<open>L\<close> is Closed Under the Operator \<^term>\<open>eclose\<close>\<close>
-subsubsection\<open>Instances of Replacement for @{term eclose}\<close>
+subsubsection\<open>Instances of Replacement for \<^term>\<open>eclose\<close>\<close>
lemma eclose_replacement1_Reflects:
"REFLECTS
--- a/src/ZF/Constructible/Reflection.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Reflection.thy Fri Jan 04 23:22:53 2019 +0100
@@ -22,10 +22,10 @@
text\<open>First part: the cumulative hierarchy defining the class \<open>M\<close>.
To avoid handling multiple arguments, we assume that \<open>Mset(l)\<close> is
closed under ordered pairing provided \<open>l\<close> is limit. Possibly this
-could be avoided: the induction hypothesis @{term Cl_reflects}
+could be avoided: the induction hypothesis \<^term>\<open>Cl_reflects\<close>
(in locale \<open>ex_reflection\<close>) could be weakened to
-@{term "\<forall>y\<in>Mset(a). \<forall>z\<in>Mset(a). P(<y,z>) \<longleftrightarrow> Q(a,<y,z>)"}, removing most
-uses of @{term Pair_in_Mset}. But there isn't much point in doing so, since
+\<^term>\<open>\<forall>y\<in>Mset(a). \<forall>z\<in>Mset(a). P(<y,z>) \<longleftrightarrow> Q(a,<y,z>)\<close>, removing most
+uses of \<^term>\<open>Pair_in_Mset\<close>. But there isn't much point in doing so, since
ultimately the \<open>ex_reflection\<close> proof is packaged up using the
predicate \<open>Reflects\<close>.
\<close>
@@ -38,9 +38,9 @@
defines "M(x) == \<exists>a. Ord(a) & x \<in> Mset(a)"
and "Reflects(Cl,P,Q) == Closed_Unbounded(Cl) &
(\<forall>a. Cl(a) \<longrightarrow> (\<forall>x\<in>Mset(a). P(x) \<longleftrightarrow> Q(a,x)))"
- fixes F0 \<comment> \<open>ordinal for a specific value @{term y}\<close>
- fixes FF \<comment> \<open>sup over the whole level, @{term "y\<in>Mset(a)"}\<close>
- fixes ClEx \<comment> \<open>Reflecting ordinals for the formula @{term "\<exists>z. P"}\<close>
+ fixes F0 \<comment> \<open>ordinal for a specific value \<^term>\<open>y\<close>\<close>
+ fixes FF \<comment> \<open>sup over the whole level, \<^term>\<open>y\<in>Mset(a)\<close>\<close>
+ fixes ClEx \<comment> \<open>Reflecting ordinals for the formula \<^term>\<open>\<exists>z. P\<close>\<close>
defines "F0(P,y) == \<mu> b. (\<exists>z. M(z) & P(<y,z>)) \<longrightarrow>
(\<exists>z\<in>Mset(b). P(<y,z>))"
and "FF(P) == \<lambda>a. \<Union>y\<in>Mset(a). F0(P,y)"
@@ -115,8 +115,8 @@
apply (simp add: cont_Ord_def FF_def, blast)
done
-text\<open>Recall that @{term F0} depends upon @{term "y\<in>Mset(a)"},
-while @{term FF} depends only upon @{term a}.\<close>
+text\<open>Recall that \<^term>\<open>F0\<close> depends upon \<^term>\<open>y\<in>Mset(a)\<close>,
+while \<^term>\<open>FF\<close> depends only upon \<^term>\<open>a\<close>.\<close>
lemma (in reflection) FF_works:
"[| M(z); y\<in>Mset(a); P(<y,z>); Ord(a) |] ==> \<exists>z\<in>Mset(FF(P,a)). P(<y,z>)"
apply (simp add: FF_def)
@@ -275,7 +275,7 @@
by fast
text\<open>Problem here: there needs to be a conjunction (class intersection)
-in the class of reflecting ordinals. The @{term "Ord(a)"} is redundant,
+in the class of reflecting ordinals. The \<^term>\<open>Ord(a)\<close> is redundant,
though harmless.\<close>
lemma (in reflection)
"Reflects(\<lambda>a. Ord(a) & ClEx(\<lambda>x. fst(x) \<in> snd(x), a),
@@ -328,7 +328,7 @@
done
text\<open>Example 3. Warning: the following examples make sense only
-if @{term P} is quantifier-free, since it is not being relativized.\<close>
+if \<^term>\<open>P\<close> is quantifier-free, since it is not being relativized.\<close>
schematic_goal (in reflection)
"Reflects(?Cl,
\<lambda>x. \<exists>y. M(y) & (\<forall>z. M(z) \<longrightarrow> z \<in> y \<longleftrightarrow> z \<in> x & P(z)),
--- a/src/ZF/Constructible/Relative.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Relative.thy Fri Jan 04 23:22:53 2019 +0100
@@ -124,9 +124,9 @@
definition
is_range :: "[i=>o,i,i] => o" where
\<comment> \<open>the cleaner
- @{term "\<exists>r'[M]. is_converse(M,r,r') & is_domain(M,r',z)"}
+ \<^term>\<open>\<exists>r'[M]. is_converse(M,r,r') & is_domain(M,r',z)\<close>
unfortunately needs an instance of separation in order to prove
- @{term "M(converse(r))"}.\<close>
+ \<^term>\<open>M(converse(r))\<close>.\<close>
"is_range(M,r,z) ==
\<forall>y[M]. y \<in> z \<longleftrightarrow> (\<exists>w[M]. w\<in>r & (\<exists>x[M]. pair(M,x,y,w)))"
@@ -555,7 +555,7 @@
text\<open>Simplifies proofs of equalities when there's an iff-equality
available for rewriting, universally quantified over M.
But it's not the only way to prove such equalities: its
- premises @{term "M(A)"} and @{term "M(B)"} can be too strong.\<close>
+ premises \<^term>\<open>M(A)\<close> and \<^term>\<open>M(B)\<close> can be too strong.\<close>
lemma (in M_trivial) M_equalityI:
"[| !!x. M(x) ==> x\<in>A \<longleftrightarrow> x\<in>B; M(A); M(B) |] ==> A=B"
by (blast intro!: equalityI dest: transM)
@@ -698,7 +698,7 @@
apply (rule_tac x=y in rexI, force, assumption)
done
-subsubsection\<open>The Operator @{term is_Replace}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_Replace\<close>\<close>
lemma is_Replace_cong [cong]:
@@ -758,7 +758,7 @@
lemma Replace_conj_eq: "{y . x \<in> A, x\<in>A & y=f(x)} = {y . x\<in>A, y=f(x)}"
by simp
-text\<open>Better than \<open>RepFun_closed\<close> when having the formula @{term "x\<in>A"}
+text\<open>Better than \<open>RepFun_closed\<close> when having the formula \<^term>\<open>x\<in>A\<close>
makes relativization easier.\<close>
lemma (in M_trivial) RepFun_closed2:
"[| strong_replacement(M, \<lambda>x y. x\<in>A & y = f(x)); M(A); \<forall>x\<in>A. M(f(x)) |]
@@ -768,7 +768,7 @@
apply (auto dest: transM simp add: Replace_conj_eq univalent_def)
done
-subsubsection \<open>Absoluteness for @{term Lambda}\<close>
+subsubsection \<open>Absoluteness for \<^term>\<open>Lambda\<close>\<close>
definition
is_lambda :: "[i=>o, i, [i,i]=>o, i] => o" where
@@ -781,7 +781,7 @@
==> M(\<lambda>x\<in>A. b(x))"
by (simp add: lam_def, blast intro: RepFun_closed dest: transM)
-text\<open>Better than \<open>lam_closed\<close>: has the formula @{term "x\<in>A"}\<close>
+text\<open>Better than \<open>lam_closed\<close>: has the formula \<^term>\<open>x\<in>A\<close>\<close>
lemma (in M_trivial) lam_closed2:
"[|strong_replacement(M, \<lambda>x y. x\<in>A & y = \<langle>x, b(x)\<rangle>);
M(A); \<forall>m[M]. m\<in>A \<longrightarrow> M(b(m))|] ==> M(Lambda(A,b))"
@@ -1224,7 +1224,7 @@
lemma (in M_basic) composition_abs [simp]:
"[| M(r); M(s); M(t) |] ==> composition(M,r,s,t) \<longleftrightarrow> t = r O s"
apply safe
- txt\<open>Proving @{term "composition(M, r, s, r O s)"}\<close>
+ txt\<open>Proving \<^term>\<open>composition(M, r, s, r O s)\<close>\<close>
prefer 2
apply (simp add: composition_def comp_def)
apply (blast dest: transM)
@@ -1333,8 +1333,8 @@
subsubsection\<open>Functions and function space\<close>
-text\<open>The assumption @{term "M(A->B)"} is unusual, but essential: in
-all but trivial cases, A->B cannot be expected to belong to @{term M}.\<close>
+text\<open>The assumption \<^term>\<open>M(A->B)\<close> is unusual, but essential: in
+all but trivial cases, A->B cannot be expected to belong to \<^term>\<open>M\<close>.\<close>
lemma (in M_basic) is_funspace_abs [simp]:
"[|M(A); M(B); M(F); M(A->B)|] ==> is_funspace(M,A,B,F) \<longleftrightarrow> F = A->B"
apply (simp add: is_funspace_def)
@@ -1358,7 +1358,7 @@
apply (force simp add: succ_fun_eq2 univalent_def)
done
-text\<open>@{term M} contains all finite function spaces. Needed to prove the
+text\<open>\<^term>\<open>M\<close> contains all finite function spaces. Needed to prove the
absoluteness of transitive closure. See the definition of
\<open>rtrancl_alt\<close> in in \<open>WF_absolute.thy\<close>.\<close>
lemma (in M_basic) finite_funspace_closed [intro,simp]:
@@ -1428,12 +1428,12 @@
definition
is_Nil :: "[i=>o, i] => o" where
- \<comment> \<open>because @{prop "[] \<equiv> Inl(0)"}\<close>
+ \<comment> \<open>because \<^prop>\<open>[] \<equiv> Inl(0)\<close>\<close>
"is_Nil(M,xs) == \<exists>zero[M]. empty(M,zero) & is_Inl(M,zero,xs)"
definition
is_Cons :: "[i=>o,i,i,i] => o" where
- \<comment> \<open>because @{prop "Cons(a, l) \<equiv> Inr(\<langle>a,l\<rangle>)"}\<close>
+ \<comment> \<open>because \<^prop>\<open>Cons(a, l) \<equiv> Inr(\<langle>a,l\<rangle>)\<close>\<close>
"is_Cons(M,a,l,Z) == \<exists>p[M]. pair(M,a,l,p) & is_Inr(M,p,Z)"
@@ -1461,7 +1461,7 @@
definition
list_case' :: "[i, [i,i]=>i, i] => i" where
- \<comment> \<open>A version of @{term list_case} that's always defined.\<close>
+ \<comment> \<open>A version of \<^term>\<open>list_case\<close> that's always defined.\<close>
"list_case'(a,b,xs) ==
if quasilist(xs) then list_case(a,b,xs) else 0"
@@ -1475,17 +1475,17 @@
definition
hd' :: "i => i" where
- \<comment> \<open>A version of @{term hd} that's always defined.\<close>
+ \<comment> \<open>A version of \<^term>\<open>hd\<close> that's always defined.\<close>
"hd'(xs) == if quasilist(xs) then hd(xs) else 0"
definition
tl' :: "i => i" where
- \<comment> \<open>A version of @{term tl} that's always defined.\<close>
+ \<comment> \<open>A version of \<^term>\<open>tl\<close> that's always defined.\<close>
"tl'(xs) == if quasilist(xs) then tl(xs) else 0"
definition
is_hd :: "[i=>o,i,i] => o" where
- \<comment> \<open>@{term "hd([]) = 0"} no constraints if not a list.
+ \<comment> \<open>\<^term>\<open>hd([]) = 0\<close> no constraints if not a list.
Avoiding implication prevents the simplifier's looping.\<close>
"is_hd(M,xs,H) ==
(is_Nil(M,xs) \<longrightarrow> empty(M,H)) &
@@ -1494,13 +1494,13 @@
definition
is_tl :: "[i=>o,i,i] => o" where
- \<comment> \<open>@{term "tl([]) = []"}; see comments about @{term is_hd}\<close>
+ \<comment> \<open>\<^term>\<open>tl([]) = []\<close>; see comments about \<^term>\<open>is_hd\<close>\<close>
"is_tl(M,xs,T) ==
(is_Nil(M,xs) \<longrightarrow> T=xs) &
(\<forall>x[M]. \<forall>l[M]. ~ is_Cons(M,x,l,xs) | T=l) &
(is_quasilist(M,xs) | empty(M,T))"
-subsubsection\<open>@{term quasilist}: For Case-Splitting with @{term list_case'}\<close>
+subsubsection\<open>\<^term>\<open>quasilist\<close>: For Case-Splitting with \<^term>\<open>list_case'\<close>\<close>
lemma [iff]: "quasilist(Nil)"
by (simp add: quasilist_def)
@@ -1511,7 +1511,7 @@
lemma list_imp_quasilist: "l \<in> list(A) ==> quasilist(l)"
by (erule list.cases, simp_all)
-subsubsection\<open>@{term list_case'}, the Modified Version of @{term list_case}\<close>
+subsubsection\<open>\<^term>\<open>list_case'\<close>, the Modified Version of \<^term>\<open>list_case\<close>\<close>
lemma list_case'_Nil [simp]: "list_case'(a,b,Nil) = a"
by (simp add: list_case'_def quasilist_def)
@@ -1550,7 +1550,7 @@
done
-subsubsection\<open>The Modified Operators @{term hd'} and @{term tl'}\<close>
+subsubsection\<open>The Modified Operators \<^term>\<open>hd'\<close> and \<^term>\<open>tl'\<close>\<close>
lemma (in M_trivial) is_hd_Nil: "is_hd(M,[],Z) \<longleftrightarrow> empty(M,Z)"
by (simp add: is_hd_def)
--- a/src/ZF/Constructible/Satisfies_absolute.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Satisfies_absolute.thy Fri Jan 04 23:22:53 2019 +0100
@@ -9,7 +9,7 @@
subsection \<open>More Internalization\<close>
-subsubsection\<open>The Formula @{term is_depth}, Internalized\<close>
+subsubsection\<open>The Formula \<^term>\<open>is_depth\<close>, Internalized\<close>
(* "is_depth(M,p,n) ==
\<exists>sn[M]. \<exists>formula_n[M]. \<exists>formula_sn[M].
@@ -52,9 +52,9 @@
-subsubsection\<open>The Operator @{term is_formula_case}\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_formula_case\<close>\<close>
-text\<open>The arguments of @{term is_a} are always 2, 1, 0, and the formula
+text\<open>The arguments of \<^term>\<open>is_a\<close> are always 2, 1, 0, and the formula
will be enclosed by three quantifiers.\<close>
(* is_formula_case ::
@@ -145,7 +145,7 @@
is_c_iff_sats is_d_iff_sats])
-text\<open>The second argument of @{term is_a} gives it direct access to @{term x},
+text\<open>The second argument of \<^term>\<open>is_a\<close> gives it direct access to \<^term>\<open>x\<close>,
which is essential for handling free variable references. Treatment is
based on that of \<open>is_nat_case_reflection\<close>.\<close>
theorem is_formula_case_reflection:
@@ -172,7 +172,7 @@
-subsection \<open>Absoluteness for the Function @{term satisfies}\<close>
+subsection \<open>Absoluteness for the Function \<^term>\<open>satisfies\<close>\<close>
definition
is_depth_apply :: "[i=>o,i,i,i] => o" where
@@ -192,8 +192,8 @@
text\<open>There is at present some redundancy between the relativizations in
e.g. \<open>satisfies_is_a\<close> and those in e.g. \<open>Member_replacement\<close>.\<close>
-text\<open>These constants let us instantiate the parameters @{term a}, @{term b},
- @{term c}, @{term d}, etc., of the locale \<open>Formula_Rec\<close>.\<close>
+text\<open>These constants let us instantiate the parameters \<^term>\<open>a\<close>, \<^term>\<open>b\<close>,
+ \<^term>\<open>c\<close>, \<^term>\<open>d\<close>, etc., of the locale \<open>Formula_Rec\<close>.\<close>
definition
satisfies_a :: "[i,i,i]=>i" where
"satisfies_a(A) ==
@@ -216,8 +216,8 @@
definition
satisfies_is_b :: "[i=>o,i,i,i,i]=>o" where
- \<comment> \<open>We simplify the formula to have just @{term nx} rather than
- introducing @{term ny} with @{term "nx=ny"}\<close>
+ \<comment> \<open>We simplify the formula to have just \<^term>\<open>nx\<close> rather than
+ introducing \<^term>\<open>ny\<close> with \<^term>\<open>nx=ny\<close>\<close>
"satisfies_is_b(M,A) ==
\<lambda>x y zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
is_lambda(M, lA,
@@ -259,7 +259,7 @@
definition
satisfies_MH :: "[i=>o,i,i,i,i]=>o" where
- \<comment> \<open>The variable @{term u} is unused, but gives @{term satisfies_MH}
+ \<comment> \<open>The variable \<^term>\<open>u\<close> is unused, but gives \<^term>\<open>satisfies_MH\<close>
the correct arity.\<close>
"satisfies_MH ==
\<lambda>M A u f z.
@@ -276,7 +276,7 @@
text\<open>This lemma relates the fragments defined above to the original primitive
- recursion in @{term satisfies}.
+ recursion in \<^term>\<open>satisfies\<close>.
Induction is not required: the definitions are directly equal!\<close>
lemma satisfies_eq:
"satisfies(A,p) =
@@ -285,9 +285,9 @@
by (simp add: satisfies_formula_def satisfies_a_def satisfies_b_def
satisfies_c_def satisfies_d_def)
-text\<open>Further constraints on the class @{term M} in order to prove
+text\<open>Further constraints on the class \<^term>\<open>M\<close> in order to prove
absoluteness for the constants defined above. The ultimate goal
- is the absoluteness of the function @{term satisfies}.\<close>
+ is the absoluteness of the function \<^term>\<open>satisfies\<close>.\<close>
locale M_satisfies = M_eclose +
assumes
Member_replacement:
@@ -327,11 +327,11 @@
pair(M,env,bo,z))"
and
formula_rec_replacement:
- \<comment> \<open>For the @{term transrec}\<close>
+ \<comment> \<open>For the \<^term>\<open>transrec\<close>\<close>
"[|n \<in> nat; M(A)|] ==> transrec_replacement(M, satisfies_MH(M,A), n)"
and
formula_rec_lambda_replacement:
- \<comment> \<open>For the \<open>\<lambda>-abstraction\<close> in the @{term transrec} body\<close>
+ \<comment> \<open>For the \<open>\<lambda>-abstraction\<close> in the \<^term>\<open>transrec\<close> body\<close>
"[|M(g); M(A)|] ==>
strong_replacement (M,
\<lambda>x y. mem_formula(M,x) &
@@ -461,7 +461,7 @@
text\<open>Instantiate locale \<open>Formula_Rec\<close> for the
- Function @{term satisfies}\<close>
+ Function \<^term>\<open>satisfies\<close>\<close>
lemma (in M_satisfies) Formula_Rec_axioms_M:
"M(A) ==>
@@ -507,7 +507,7 @@
subsection\<open>Internalizations Needed to Instantiate \<open>M_satisfies\<close>\<close>
-subsubsection\<open>The Operator @{term is_depth_apply}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>is_depth_apply\<close>, Internalized\<close>
(* is_depth_apply(M,h,p,z) ==
\<exists>dp[M]. \<exists>sdp[M]. \<exists>hsdp[M].
@@ -548,7 +548,7 @@
done
-subsubsection\<open>The Operator @{term satisfies_is_a}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>satisfies_is_a\<close>, Internalized\<close>
(* satisfies_is_a(M,A) ==
\<lambda>x y zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
@@ -601,7 +601,7 @@
done
-subsubsection\<open>The Operator @{term satisfies_is_b}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>satisfies_is_b\<close>, Internalized\<close>
(* satisfies_is_b(M,A) ==
\<lambda>x y zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
@@ -650,7 +650,7 @@
done
-subsubsection\<open>The Operator @{term satisfies_is_c}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>satisfies_is_c\<close>, Internalized\<close>
(* satisfies_is_c(M,A,h) ==
\<lambda>p q zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
@@ -701,7 +701,7 @@
is_list_reflection)
done
-subsubsection\<open>The Operator @{term satisfies_is_d}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>satisfies_is_d\<close>, Internalized\<close>
(* satisfies_is_d(M,A,h) ==
\<lambda>p zz. \<forall>lA[M]. is_list(M,A,lA) \<longrightarrow>
@@ -758,7 +758,7 @@
done
-subsubsection\<open>The Operator @{term satisfies_MH}, Internalized\<close>
+subsubsection\<open>The Operator \<^term>\<open>satisfies_MH\<close>, Internalized\<close>
(* satisfies_MH ==
\<lambda>M A u f zz.
@@ -818,7 +818,7 @@
subsection\<open>Lemmas for Instantiating the Locale \<open>M_satisfies\<close>\<close>
-subsubsection\<open>The @{term "Member"} Case\<close>
+subsubsection\<open>The \<^term>\<open>Member\<close> Case\<close>
lemma Member_Reflects:
"REFLECTS[\<lambda>u. \<exists>v[L]. v \<in> B \<and> (\<exists>bo[L]. \<exists>nx[L]. \<exists>ny[L].
@@ -848,7 +848,7 @@
done
-subsubsection\<open>The @{term "Equal"} Case\<close>
+subsubsection\<open>The \<^term>\<open>Equal\<close> Case\<close>
lemma Equal_Reflects:
"REFLECTS[\<lambda>u. \<exists>v[L]. v \<in> B \<and> (\<exists>bo[L]. \<exists>nx[L]. \<exists>ny[L].
@@ -877,7 +877,7 @@
apply (rule sep_rules nth_iff_sats is_bool_of_o_iff_sats | simp)+
done
-subsubsection\<open>The @{term "Nand"} Case\<close>
+subsubsection\<open>The \<^term>\<open>Nand\<close> Case\<close>
lemma Nand_Reflects:
"REFLECTS [\<lambda>x. \<exists>u[L]. u \<in> B \<and>
@@ -910,7 +910,7 @@
done
-subsubsection\<open>The @{term "Forall"} Case\<close>
+subsubsection\<open>The \<^term>\<open>Forall\<close> Case\<close>
lemma Forall_Reflects:
"REFLECTS [\<lambda>x. \<exists>u[L]. u \<in> B \<and> (\<exists>bo[L]. u \<in> list(A) \<and>
@@ -948,7 +948,7 @@
apply (rule sep_rules is_bool_of_o_iff_sats Cons_iff_sats | simp)+
done
-subsubsection\<open>The @{term "transrec_replacement"} Case\<close>
+subsubsection\<open>The \<^term>\<open>transrec_replacement\<close> Case\<close>
lemma formula_rec_replacement_Reflects:
"REFLECTS [\<lambda>x. \<exists>u[L]. u \<in> B \<and> (\<exists>y[L]. pair(L, u, y, x) \<and>
@@ -959,7 +959,7 @@
is_wfrec_reflection)
lemma formula_rec_replacement:
- \<comment> \<open>For the @{term transrec}\<close>
+ \<comment> \<open>For the \<^term>\<open>transrec\<close>\<close>
"[|n \<in> nat; L(A)|] ==> transrec_replacement(L, satisfies_MH(L,A), n)"
apply (rule transrec_replacementI, simp add: nat_into_M)
apply (rule strong_replacementI)
@@ -995,7 +995,7 @@
satisfies_is_d_reflection)
lemma formula_rec_lambda_replacement:
- \<comment> \<open>For the @{term transrec}\<close>
+ \<comment> \<open>For the \<^term>\<open>transrec\<close>\<close>
"[|L(g); L(A)|] ==>
strong_replacement (L,
\<lambda>x y. mem_formula(L,x) &
--- a/src/ZF/Constructible/Separation.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Separation.thy Fri Jan 04 23:22:53 2019 +0100
@@ -66,10 +66,10 @@
apply (rule collI, assumption)
done
-text\<open>As above, but typically @{term u} is a finite enumeration such as
- @{term "{a,b}"}; thus the new subgoal gets the assumption
- @{term "{a,b} \<subseteq> Lset(i)"}, which is logically equivalent to
- @{term "a \<in> Lset(i)"} and @{term "b \<in> Lset(i)"}.\<close>
+text\<open>As above, but typically \<^term>\<open>u\<close> is a finite enumeration such as
+ \<^term>\<open>{a,b}\<close>; thus the new subgoal gets the assumption
+ \<^term>\<open>{a,b} \<subseteq> Lset(i)\<close>, which is logically equivalent to
+ \<^term>\<open>a \<in> Lset(i)\<close> and \<^term>\<open>b \<in> Lset(i)\<close>.\<close>
lemma gen_separation_multi:
assumes reflection: "REFLECTS [P,Q]"
and Lu: "L(u)"
@@ -94,7 +94,7 @@
apply (rule gen_separation [OF Inter_Reflects], simp)
apply (rule DPow_LsetI)
txt\<open>I leave this one example of a manual proof. The tedium of manually
- instantiating @{term i}, @{term j} and @{term env} is obvious.\<close>
+ instantiating \<^term>\<open>i\<close>, \<^term>\<open>j\<close> and \<^term>\<open>env\<close> is obvious.\<close>
apply (rule ball_iff_sats)
apply (rule imp_iff_sats)
apply (rule_tac [2] i=1 and j=0 and env="[y,x,A]" in mem_iff_sats)
@@ -260,7 +260,7 @@
done
-subsection\<open>Separation for a Theorem about @{term "is_recfun"}\<close>
+subsection\<open>Separation for a Theorem about \<^term>\<open>is_recfun\<close>\<close>
lemma is_recfun_reflects:
"REFLECTS[\<lambda>x. \<exists>xa[L]. \<exists>xb[L].
--- a/src/ZF/Constructible/WF_absolute.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/WF_absolute.thy Fri Jan 04 23:22:53 2019 +0100
@@ -200,9 +200,9 @@
done
-text\<open>Assuming @{term r} is transitive simplifies the occurrences of \<open>H\<close>.
- The premise @{term "relation(r)"} is necessary
- before we can replace @{term "r^+"} by @{term r}.\<close>
+text\<open>Assuming \<^term>\<open>r\<close> is transitive simplifies the occurrences of \<open>H\<close>.
+ The premise \<^term>\<open>relation(r)\<close> is necessary
+ before we can replace \<^term>\<open>r^+\<close> by \<^term>\<open>r\<close>.\<close>
theorem (in M_trancl) trans_wfrec_relativize:
"[|wf(r); trans(r); relation(r); M(r); M(a);
wfrec_replacement(M,MH,r); relation2(M,MH,H);
--- a/src/ZF/Constructible/WFrec.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/WFrec.thy Fri Jan 04 23:22:53 2019 +0100
@@ -57,7 +57,7 @@
done
text\<open>For \<open>is_recfun\<close> we need only pay attention to functions
- whose domains are initial segments of @{term r}.\<close>
+ whose domains are initial segments of \<^term>\<open>r\<close>.\<close>
lemma is_recfun_cong:
"[| r = r'; a = a'; f = f';
!!x g. [| <x,a'> \<in> r'; relation(g); domain(g) \<subseteq> r' -``{x} |]
@@ -70,7 +70,7 @@
apply (blast intro: sym)+
done
-subsection\<open>Reworking of the Recursion Theory Within @{term M}\<close>
+subsection\<open>Reworking of the Recursion Theory Within \<^term>\<open>M\<close>\<close>
lemma (in M_basic) is_recfun_separation':
"[| f \<in> r -`` {a} \<rightarrow> range(f); g \<in> r -`` {b} \<rightarrow> range(g);
@@ -80,11 +80,11 @@
apply (simp add: vimage_singleton_iff)
done
-text\<open>Stated using @{term "trans(r)"} rather than
- @{term "transitive_rel(M,A,r)"} because the latter rewrites to
+text\<open>Stated using \<^term>\<open>trans(r)\<close> rather than
+ \<^term>\<open>transitive_rel(M,A,r)\<close> because the latter rewrites to
the former anyway, by \<open>transitive_rel_abs\<close>.
As always, theorems should be expressed in simplified form.
- The last three M-premises are redundant because of @{term "M(r)"},
+ The last three M-premises are redundant because of \<^term>\<open>M(r)\<close>,
but without them we'd have to undertake
more work to set up the induction formula.\<close>
lemma (in M_basic) is_recfun_equal [rule_format]:
@@ -145,7 +145,7 @@
apply simp
apply blast
apply (subgoal_tac "is_function(M,f)")
- txt\<open>We use @{term "is_function"} rather than @{term "function"} because
+ txt\<open>We use \<^term>\<open>is_function\<close> rather than \<^term>\<open>function\<close> because
the subgoal's easier to prove with relativized quantifiers!\<close>
prefer 2 apply (simp add: is_function_def)
apply (frule pair_components_in_M, assumption)
@@ -223,9 +223,9 @@
txt\<open>Show that the constructed object satisfies \<open>is_recfun\<close>\<close>
apply clarify
apply (rule_tac x=Y in rexI)
-txt\<open>Unfold only the top-level occurrence of @{term is_recfun}\<close>
+txt\<open>Unfold only the top-level occurrence of \<^term>\<open>is_recfun\<close>\<close>
apply (simp (no_asm_simp) add: is_recfun_relativize [of concl: _ a1])
-txt\<open>The big iff-formula defining @{term Y} is now redundant\<close>
+txt\<open>The big iff-formula defining \<^term>\<open>Y\<close> is now redundant\<close>
apply safe
apply (simp add: vimage_singleton_iff restrict_Y_lemma [of r H _ a1])
txt\<open>one more case\<close>
@@ -241,7 +241,7 @@
done
text\<open>Relativized version, when we have the (currently weaker) premise
- @{term "wellfounded(M,r)"}\<close>
+ \<^term>\<open>wellfounded(M,r)\<close>\<close>
lemma (in M_basic) wellfounded_exists_is_recfun:
"[|wellfounded(M,r); trans(r);
separation(M, \<lambda>x. ~ (\<exists>f[M]. is_recfun(r, x, H, f)));
@@ -268,7 +268,7 @@
done
-subsection\<open>Relativization of the ZF Predicate @{term is_recfun}\<close>
+subsection\<open>Relativization of the ZF Predicate \<^term>\<open>is_recfun\<close>\<close>
definition
M_is_recfun :: "[i=>o, [i,i,i]=>o, i, i, i] => o" where
@@ -312,7 +312,7 @@
(\<exists>g[M]. is_recfun(r,a,H,g) & z = H(a,g))"
by (simp add: is_wfrec_def relation2_def is_recfun_abs)
-text\<open>Relating @{term wfrec_replacement} to native constructs\<close>
+text\<open>Relating \<^term>\<open>wfrec_replacement\<close> to native constructs\<close>
lemma (in M_basic) wfrec_replacement':
"[|wfrec_replacement(M,MH,r);
\<forall>x[M]. \<forall>g[M]. function(g) \<longrightarrow> M(H(x,g));
--- a/src/ZF/Constructible/Wellorderings.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Constructible/Wellorderings.thy Fri Jan 04 23:22:53 2019 +0100
@@ -6,7 +6,7 @@
theory Wellorderings imports Relative begin
-text\<open>We define functions analogous to @{term ordermap} @{term ordertype}
+text\<open>We define functions analogous to \<^term>\<open>ordermap\<close> \<^term>\<open>ordertype\<close>
but without using recursion. Instead, there is a direct appeal
to Replacement. This will be the basis for a version relativized
to some class \<open>M\<close>. The main result is Theorem I 7.6 in Kunen,
--- a/src/ZF/Datatype.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Datatype.thy Fri Jan 04 23:22:53 2019 +0100
@@ -63,12 +63,12 @@
struct
val trace = Unsynchronized.ref false;
- fun mk_new ([],[]) = Const(@{const_name True},FOLogic.oT)
+ fun mk_new ([],[]) = Const(\<^const_name>\<open>True\<close>,FOLogic.oT)
| mk_new (largs,rargs) =
Balanced_Tree.make FOLogic.mk_conj
(map FOLogic.mk_eq (ListPair.zip (largs,rargs)));
- val datatype_ss = simpset_of @{context};
+ val datatype_ss = simpset_of \<^context>;
fun proc ctxt ct =
let val old = Thm.term_of ct
@@ -89,7 +89,7 @@
if #big_rec_name lcon_info = #big_rec_name rcon_info
andalso not (null (#free_iffs lcon_info)) then
if lname = rname then mk_new (largs, rargs)
- else Const(@{const_name False},FOLogic.oT)
+ else Const(\<^const_name>\<open>False\<close>,FOLogic.oT)
else raise Match
val _ =
if !trace then writeln ("NEW = " ^ Syntax.string_of_term ctxt new)
@@ -106,8 +106,8 @@
val conv =
- Simplifier.make_simproc @{context} "data_free"
- {lhss = [@{term "(x::i) = y"}], proc = K proc};
+ Simplifier.make_simproc \<^context> "data_free"
+ {lhss = [\<^term>\<open>(x::i) = y\<close>], proc = K proc};
end;
\<close>
--- a/src/ZF/Epsilon.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Epsilon.thy Fri Jan 04 23:22:53 2019 +0100
@@ -80,7 +80,7 @@
by (rule arg_in_eclose_sing [THEN eclose_induct], blast)
-subsection\<open>Leastness of @{term eclose}\<close>
+subsection\<open>Leastness of \<^term>\<open>eclose\<close>\<close>
(** eclose(A) is the least transitive set including A as a subset. **)
--- a/src/ZF/EquivClass.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/EquivClass.thy Fri Jan 04 23:22:53 2019 +0100
@@ -31,7 +31,7 @@
subsection\<open>Suppes, Theorem 70:
- @{term r} is an equiv relation iff @{term "converse(r) O r = r"}\<close>
+ \<^term>\<open>r\<close> is an equiv relation iff \<^term>\<open>converse(r) O r = r\<close>\<close>
(** first half: equiv(A,r) ==> converse(r) O r = r **)
--- a/src/ZF/Fixedpt.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Fixedpt.thy Fri Jan 04 23:22:53 2019 +0100
@@ -20,8 +20,8 @@
gfp :: "[i,i=>i]=>i" where
"gfp(D,h) == \<Union>({X: Pow(D). X \<subseteq> h(X)})"
-text\<open>The theorem is proved in the lattice of subsets of @{term D},
- namely @{term "Pow(D)"}, with Inter as the greatest lower bound.\<close>
+text\<open>The theorem is proved in the lattice of subsets of \<^term>\<open>D\<close>,
+ namely \<^term>\<open>Pow(D)\<close>, with Inter as the greatest lower bound.\<close>
subsection\<open>Monotone Operators\<close>
@@ -69,7 +69,7 @@
apply (erule bnd_monoD2, rule Int_lower2, assumption)
done
-subsection\<open>Proof of Knaster-Tarski Theorem using @{term lfp}\<close>
+subsection\<open>Proof of Knaster-Tarski Theorem using \<^term>\<open>lfp\<close>\<close>
(*lfp is contained in each pre-fixedpoint*)
lemma lfp_lowerbound:
@@ -189,7 +189,7 @@
done
-subsection\<open>Proof of Knaster-Tarski Theorem using @{term gfp}\<close>
+subsection\<open>Proof of Knaster-Tarski Theorem using \<^term>\<open>gfp\<close>\<close>
(*gfp contains each post-fixedpoint that is contained in D*)
lemma gfp_upperbound: "[| A \<subseteq> h(A); A<=D |] ==> A \<subseteq> gfp(D,h)"
--- a/src/ZF/Induct/Acc.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Induct/Acc.thy Fri Jan 04 23:22:53 2019 +0100
@@ -21,7 +21,7 @@
monos Pow_mono
text \<open>
- The introduction rule must require @{prop "a \<in> field(r)"},
+ The introduction rule must require \<^prop>\<open>a \<in> field(r)\<close>,
otherwise \<open>acc(r)\<close> would be a proper class!
\medskip
--- a/src/ZF/Induct/Binary_Trees.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Induct/Binary_Trees.thy Fri Jan 04 23:22:53 2019 +0100
@@ -28,7 +28,7 @@
\<comment> \<open>An elimination rule, for type-checking.\<close>
text \<open>
- \medskip Lemmas to justify using @{term bt} in other recursive type
+ \medskip Lemmas to justify using \<^term>\<open>bt\<close> in other recursive type
definitions.
\<close>
@@ -119,7 +119,7 @@
by (induct set: bt) auto
text \<open>
- \medskip Theorems about @{term n_leaves}.
+ \medskip Theorems about \<^term>\<open>n_leaves\<close>.
\<close>
lemma n_leaves_reflect: "t \<in> bt(A) ==> n_leaves(bt_reflect(t)) = n_leaves(t)"
@@ -129,7 +129,7 @@
by (induct set: bt) simp_all
text \<open>
- Theorems about @{term bt_reflect}.
+ Theorems about \<^term>\<open>bt_reflect\<close>.
\<close>
lemma bt_reflect_bt_reflect_ident: "t \<in> bt(A) ==> bt_reflect(bt_reflect(t)) = t"
--- a/src/ZF/Induct/Comb.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Induct/Comb.thy Fri Jan 04 23:22:53 2019 +0100
@@ -109,7 +109,7 @@
subsection \<open>Results about Contraction\<close>
text \<open>
- For type checking: replaces @{term "a \<rightarrow>\<^sup>1 b"} by \<open>a, b \<in>
+ For type checking: replaces \<^term>\<open>a \<rightarrow>\<^sup>1 b\<close> by \<open>a, b \<in>
comb\<close>.
\<close>
@@ -235,7 +235,7 @@
done
text \<open>
- \medskip Equivalence of @{prop "p \<rightarrow> q"} and @{prop "p \<Rrightarrow> q"}.
+ \medskip Equivalence of \<^prop>\<open>p \<rightarrow> q\<close> and \<^prop>\<open>p \<Rrightarrow> q\<close>.
\<close>
lemma contract_imp_parcontract: "p\<rightarrow>\<^sup>1q ==> p\<Rrightarrow>\<^sup>1q"
--- a/src/ZF/Induct/Datatypes.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Induct/Datatypes.thy Fri Jan 04 23:22:53 2019 +0100
@@ -27,7 +27,7 @@
elim: data.cases [unfolded data.con_defs])
text \<open>
- \medskip Lemmas to justify using @{term data} in other recursive
+ \medskip Lemmas to justify using \<^term>\<open>data\<close> in other recursive
type definitions.
\<close>
--- a/src/ZF/Induct/FoldSet.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Induct/FoldSet.thy Fri Jan 04 23:22:53 2019 +0100
@@ -106,7 +106,7 @@
apply (simp add: Fin_into_Finite [THEN Finite_imp_cardinal_cons])
apply (case_tac "x=xb", auto)
apply (simp add: cons_lemma1, blast)
-txt\<open>case @{term "x\<noteq>xb"}\<close>
+txt\<open>case \<^term>\<open>x\<noteq>xb\<close>\<close>
apply (drule cons_lemma2, safe)
apply (frule Diff_sing_imp, assumption+)
txt\<open>* LEVEL 17\<close>
@@ -237,7 +237,7 @@
apply (blast intro: Fin_mono [THEN subsetD])
done
-subsection\<open>The Operator @{term setsum}\<close>
+subsection\<open>The Operator \<^term>\<open>setsum\<close>\<close>
lemma setsum_0 [simp]: "setsum(g, 0) = #0"
by (simp add: setsum_def)
--- a/src/ZF/Induct/Multiset.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Induct/Multiset.thy Fri Jan 04 23:22:53 2019 +0100
@@ -175,7 +175,7 @@
by (auto simp add: Mult_iff_multiset)
-text\<open>The @{term multiset} operator\<close>
+text\<open>The \<^term>\<open>multiset\<close> operator\<close>
(* the empty multiset is 0 *)
@@ -183,7 +183,7 @@
by (auto intro: FiniteFun.intros simp add: multiset_iff_Mult_mset_of)
-text\<open>The @{term mset_of} operator\<close>
+text\<open>The \<^term>\<open>mset_of\<close> operator\<close>
lemma multiset_set_of_Finite [simp]: "multiset(M) ==> Finite(mset_of(M))"
by (simp add: multiset_def mset_of_def, auto)
@@ -733,7 +733,7 @@
by (auto simp add: multirel1_def Mult_iff_multiset Bex_def)
-text\<open>Monotonicity of @{term multirel1}\<close>
+text\<open>Monotonicity of \<^term>\<open>multirel1\<close>\<close>
lemma multirel1_mono1: "A\<subseteq>B ==> multirel1(A, r)\<subseteq>multirel1(B, r)"
apply (auto simp add: multirel1_def)
--- a/src/ZF/Induct/Ntree.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Induct/Ntree.thy Fri Jan 04 23:22:53 2019 +0100
@@ -69,7 +69,7 @@
and step: "!!x n h. [| x \<in> A; n \<in> nat; h \<in> n -> ntree(A); f O h = g O h |] ==>
f ` Branch(x,h) = g ` Branch(x,h)"
shows "f`t=g`t"
- \<comment> \<open>Induction on @{term "ntree(A)"} to prove an equation\<close>
+ \<comment> \<open>Induction on \<^term>\<open>ntree(A)\<close> to prove an equation\<close>
using t
apply induct
apply (assumption | rule step)+
--- a/src/ZF/Induct/Primrec.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Induct/Primrec.thy Fri Jan 04 23:22:53 2019 +0100
@@ -37,7 +37,7 @@
"PREC(f,g) ==
\<lambda>l \<in> list(nat). list_case(0,
\<lambda>x xs. rec(x, f`xs, \<lambda>y r. g ` Cons(r, Cons(y, xs))), l)"
- \<comment> \<open>Note that \<open>g\<close> is applied first to @{term "PREC(f,g)`y"} and then to \<open>y\<close>!\<close>
+ \<comment> \<open>Note that \<open>g\<close> is applied first to \<^term>\<open>PREC(f,g)`y\<close> and then to \<open>y\<close>!\<close>
consts
ACK :: "i=>i"
@@ -226,7 +226,7 @@
"[| i < ack(k,j); j \<in> nat; k \<in> nat |]
==> i#+j < ack(succ(succ(succ(succ(k)))), j)"
\<comment> \<open>PROPERTY A 12.\<close>
- \<comment> \<open>Article uses existential quantifier but the ALF proof used @{term "k#+#4"}.\<close>
+ \<comment> \<open>Article uses existential quantifier but the ALF proof used \<^term>\<open>k#+#4\<close>.\<close>
\<comment> \<open>Quantified version must be nested \<open>\<exists>k'. \<forall>i,j \<dots>\<close>.\<close>
apply (rule_tac j = "ack (k,j) #+ ack (0,j) " in lt_trans)
apply (rule_tac [2] ack_add_bound [THEN lt_trans2])
--- a/src/ZF/Induct/PropLog.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Induct/PropLog.thy Fri Jan 04 23:22:53 2019 +0100
@@ -251,8 +251,7 @@
subsubsection \<open>Completeness -- lemmas for reducing the set of assumptions\<close>
text \<open>
- For the case @{prop "hyps(p,t)-cons(#v,Y) |- p"} we also have @{prop
- "hyps(p,t)-{#v} \<subseteq> hyps(p, t-{v})"}.
+ For the case \<^prop>\<open>hyps(p,t)-cons(#v,Y) |- p\<close> we also have \<^prop>\<open>hyps(p,t)-{#v} \<subseteq> hyps(p, t-{v})\<close>.
\<close>
lemma hyps_Diff:
@@ -260,8 +259,8 @@
by (induct set: propn) auto
text \<open>
- For the case @{prop "hyps(p,t)-cons(#v => Fls,Y) |- p"} we also have
- @{prop "hyps(p,t)-{#v=>Fls} \<subseteq> hyps(p, cons(v,t))"}.
+ For the case \<^prop>\<open>hyps(p,t)-cons(#v => Fls,Y) |- p\<close> we also have
+ \<^prop>\<open>hyps(p,t)-{#v=>Fls} \<subseteq> hyps(p, cons(v,t))\<close>.
\<close>
lemma hyps_cons:
@@ -277,9 +276,9 @@
by blast
text \<open>
- The set @{term "hyps(p,t)"} is finite, and elements have the form
- @{term "#v"} or @{term "#v=>Fls"}; could probably prove the stronger
- @{prop "hyps(p,t) \<in> Fin(hyps(p,0) \<union> hyps(p,nat))"}.
+ The set \<^term>\<open>hyps(p,t)\<close> is finite, and elements have the form
+ \<^term>\<open>#v\<close> or \<^term>\<open>#v=>Fls\<close>; could probably prove the stronger
+ \<^prop>\<open>hyps(p,t) \<in> Fin(hyps(p,0) \<union> hyps(p,nat))\<close>.
\<close>
lemma hyps_finite: "p \<in> propn ==> hyps(p,t) \<in> Fin(\<Union>v \<in> nat. {#v, #v=>Fls})"
@@ -288,7 +287,7 @@
lemmas Diff_weaken_left = Diff_mono [OF _ subset_refl, THEN weaken_left]
text \<open>
- Induction on the finite set of assumptions @{term "hyps(p,t0)"}. We
+ Induction on the finite set of assumptions \<^term>\<open>hyps(p,t0)\<close>. We
may repeatedly subtract assumptions until none are left!
\<close>
@@ -299,13 +298,13 @@
apply (simp add: logcon_thms_p Diff_0)
txt \<open>inductive step\<close>
apply safe
- txt \<open>Case @{prop "hyps(p,t)-cons(#v,Y) |- p"}\<close>
+ txt \<open>Case \<^prop>\<open>hyps(p,t)-cons(#v,Y) |- p\<close>\<close>
apply (rule thms_excluded_middle_rule)
apply (erule_tac [3] propn.intros)
apply (blast intro: cons_Diff_same [THEN weaken_left])
apply (blast intro: cons_Diff_subset2 [THEN weaken_left]
hyps_Diff [THEN Diff_weaken_left])
- txt \<open>Case @{prop "hyps(p,t)-cons(#v => Fls,Y) |- p"}\<close>
+ txt \<open>Case \<^prop>\<open>hyps(p,t)-cons(#v => Fls,Y) |- p\<close>\<close>
apply (rule thms_excluded_middle_rule)
apply (erule_tac [3] propn.intros)
apply (blast intro: cons_Diff_subset2 [THEN weaken_left]
--- a/src/ZF/Induct/Term.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Induct/Term.thy Fri Jan 04 23:22:53 2019 +0100
@@ -55,7 +55,7 @@
!!x z zs. [| x \<in> A; z \<in> term(A); zs: list(term(A)); P(Apply(x,zs))
|] ==> P(Apply(x, Cons(z,zs)))
|] ==> P(t)"
- \<comment> \<open>Induction on @{term "term(A)"} followed by induction on @{term list}.\<close>
+ \<comment> \<open>Induction on \<^term>\<open>term(A)\<close> followed by induction on \<^term>\<open>list\<close>.\<close>
apply (induct_tac t)
apply (erule list.induct)
apply (auto dest: list_CollectD)
@@ -66,13 +66,13 @@
!!x zs. [| x \<in> A; zs: list(term(A)); map(f,zs) = map(g,zs) |] ==>
f(Apply(x,zs)) = g(Apply(x,zs))
|] ==> f(t) = g(t)"
- \<comment> \<open>Induction on @{term "term(A)"} to prove an equation.\<close>
+ \<comment> \<open>Induction on \<^term>\<open>term(A)\<close> to prove an equation.\<close>
apply (induct_tac t)
apply (auto dest: map_list_Collect list_CollectD)
done
text \<open>
- \medskip Lemmas to justify using @{term "term"} in other recursive
+ \medskip Lemmas to justify using \<^term>\<open>term\<close> in other recursive
type definitions.
\<close>
@@ -107,7 +107,7 @@
lemma map_lemma: "[| l \<in> list(A); Ord(i); rank(l)<i |]
==> map(\<lambda>z. (\<lambda>x \<in> Vset(i).h(x)) ` z, l) = map(h,l)"
- \<comment> \<open>@{term map} works correctly on the underlying list of terms.\<close>
+ \<comment> \<open>\<^term>\<open>map\<close> works correctly on the underlying list of terms.\<close>
apply (induct set: list)
apply simp
apply (subgoal_tac "rank (a) <i & rank (l) < i")
@@ -159,7 +159,7 @@
text \<open>
- \medskip @{term term_map}.
+ \medskip \<^term>\<open>term_map\<close>.
\<close>
lemma term_map [simp]:
@@ -181,7 +181,7 @@
done
text \<open>
- \medskip @{term term_size}.
+ \medskip \<^term>\<open>term_size\<close>.
\<close>
lemma term_size [simp]:
--- a/src/ZF/Induct/Tree_Forest.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Induct/Tree_Forest.thy Fri Jan 04 23:22:53 2019 +0100
@@ -34,8 +34,8 @@
text \<open>
- \medskip @{term "tree_forest(A)"} as the union of @{term "tree(A)"}
- and @{term "forest(A)"}.
+ \medskip \<^term>\<open>tree_forest(A)\<close> as the union of \<^term>\<open>tree(A)\<close>
+ and \<^term>\<open>forest(A)\<close>.
\<close>
lemma tree_subset_TF: "tree(A) \<subseteq> tree_forest(A)"
--- a/src/ZF/Inductive.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Inductive.thy Fri Jan 04 23:22:53 2019 +0100
@@ -49,7 +49,7 @@
struct
val sigma = @{const Sigma}
val pair = @{const Pair}
- val split_name = @{const_name split}
+ val split_name = \<^const_name>\<open>split\<close>
val pair_iff = @{thm Pair_iff}
val split_eq = @{thm split}
val fsplitI = @{thm splitI}
@@ -96,7 +96,7 @@
struct
val sigma = @{const QSigma}
val pair = @{const QPair}
- val split_name = @{const_name qsplit}
+ val split_name = \<^const_name>\<open>qsplit\<close>
val pair_iff = @{thm QPair_iff}
val split_eq = @{thm qsplit}
val fsplitI = @{thm qsplitI}
--- a/src/ZF/Int.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Int.thy Fri Jan 04 23:22:53 2019 +0100
@@ -93,7 +93,7 @@
declare quotientE [elim!]
-subsection\<open>Proving that @{term intrel} is an equivalence relation\<close>
+subsection\<open>Proving that \<^term>\<open>intrel\<close> is an equivalence relation\<close>
(** Natural deduction for intrel **)
@@ -155,7 +155,7 @@
by (simp add: intify_def)
-subsection\<open>Collapsing rules: to remove @{term intify}
+subsection\<open>Collapsing rules: to remove \<^term>\<open>intify\<close>
from arithmetic expressions\<close>
lemma intify_idem [simp]: "intify(intify(x)) = intify(x)"
@@ -206,7 +206,7 @@
by (simp add: zle_def)
-subsection\<open>@{term zminus}: unary negation on @{term int}\<close>
+subsection\<open>\<^term>\<open>zminus\<close>: unary negation on \<^term>\<open>int\<close>\<close>
lemma zminus_congruent: "(%<x,y>. intrel``{<y,x>}) respects intrel"
by (auto simp add: congruent_def add_ac)
@@ -257,7 +257,7 @@
by simp
-subsection\<open>@{term znegative}: the test for negative integers\<close>
+subsection\<open>\<^term>\<open>znegative\<close>: the test for negative integers\<close>
lemma znegative: "[| x\<in>nat; y\<in>nat |] ==> znegative(intrel``{<x,y>}) \<longleftrightarrow> x<y"
apply (cases "x<y")
@@ -277,7 +277,7 @@
by (simp add: znegative int_of_def zminus Ord_0_lt_iff [THEN iff_sym])
-subsection\<open>@{term nat_of}: Coercion of an Integer to a Natural Number\<close>
+subsection\<open>\<^term>\<open>nat_of\<close>: Coercion of an Integer to a Natural Number\<close>
lemma nat_of_intify [simp]: "nat_of(intify(z)) = nat_of(z)"
by (simp add: nat_of_def)
@@ -371,7 +371,7 @@
done
-subsection\<open>@{term zadd}: addition on int\<close>
+subsection\<open>\<^term>\<open>zadd\<close>: addition on int\<close>
text\<open>Congruence Property for Addition\<close>
lemma zadd_congruent2:
@@ -485,7 +485,7 @@
by simp
-subsection\<open>@{term zmult}: Integer Multiplication\<close>
+subsection\<open>\<^term>\<open>zmult\<close>: Integer Multiplication\<close>
text\<open>Congruence property for multiplication\<close>
lemma zmult_congruent2:
--- a/src/ZF/IntDiv.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/IntDiv.thy Fri Jan 04 23:22:53 2019 +0100
@@ -642,7 +642,7 @@
apply (rule_tac u = "a" and v = "b" in negDivAlg_induct)
apply auto
apply (simp_all add: quorem_def)
- txt\<open>base case: @{term "0$\<le>a$+b"}\<close>
+ txt\<open>base case: \<^term>\<open>0$\<le>a$+b\<close>\<close>
apply (simp add: negDivAlg_eqn)
apply (simp add: not_zless_iff_zle [THEN iff_sym])
apply (simp add: int_0_less_mult_iff)
--- a/src/ZF/Nat.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Nat.thy Fri Jan 04 23:22:53 2019 +0100
@@ -209,7 +209,7 @@
==> P(m,n)"
by (blast intro: succ_lt_induct_lemma lt_nat_in_nat)
-subsection\<open>quasinat: to allow a case-split rule for @{term nat_case}\<close>
+subsection\<open>quasinat: to allow a case-split rule for \<^term>\<open>nat_case\<close>\<close>
text\<open>True if the argument is zero or any successor\<close>
lemma [iff]: "quasinat(0)"
--- a/src/ZF/OrdQuant.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/OrdQuant.thy Fri Jan 04 23:22:53 2019 +0100
@@ -339,7 +339,7 @@
ML
\<open>
val Ord_atomize =
- atomize ([(@{const_name oall}, @{thms ospec}), (@{const_name rall}, @{thms rspec})] @
+ atomize ([(\<^const_name>\<open>oall\<close>, @{thms ospec}), (\<^const_name>\<open>rall\<close>, @{thms rspec})] @
ZF_conn_pairs, ZF_mem_pairs);
\<close>
declaration \<open>fn _ =>
--- a/src/ZF/OrderArith.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/OrderArith.thy Fri Jan 04 23:22:53 2019 +0100
@@ -112,7 +112,7 @@
apply (simp add: well_ord_def tot_ord_def linear_radd)
done
-subsubsection\<open>An @{term ord_iso} congruence law\<close>
+subsubsection\<open>An \<^term>\<open>ord_iso\<close> congruence law\<close>
lemma sum_bij:
"[| f \<in> bij(A,C); g \<in> bij(B,D) |]
@@ -217,7 +217,7 @@
done
-subsubsection\<open>An @{term ord_iso} congruence law\<close>
+subsubsection\<open>An \<^term>\<open>ord_iso\<close> congruence law\<close>
lemma prod_bij:
"[| f \<in> bij(A,C); g \<in> bij(B,D) |]
@@ -370,7 +370,7 @@
done
text\<open>But note that the combination of \<open>wf_imp_wf_on\<close> and
- \<open>wf_rvimage\<close> gives @{prop "wf(r) ==> wf[C](rvimage(A,f,r))"}\<close>
+ \<open>wf_rvimage\<close> gives \<^prop>\<open>wf(r) ==> wf[C](rvimage(A,f,r))\<close>\<close>
lemma wf_on_rvimage: "[| f \<in> A->B; wf[B](r) |] ==> wf[A](rvimage(A,f,r))"
apply (rule wf_onI2)
apply (subgoal_tac "\<forall>z\<in>A. f`z=f`y \<longrightarrow> z \<in> Ba")
@@ -554,7 +554,7 @@
apply force+
done
-text\<open>As a special case, we have @{term "bij(Pow(A*B), A -> Pow(B))"}\<close>
+text\<open>As a special case, we have \<^term>\<open>bij(Pow(A*B), A -> Pow(B))\<close>\<close>
lemma Pow_Sigma_bij:
"(\<lambda>r \<in> Pow(Sigma(A,B)). \<lambda>x \<in> A. r``{x})
\<in> bij(Pow(Sigma(A,B)), \<Prod>x \<in> A. Pow(B(x)))"
--- a/src/ZF/OrderType.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/OrderType.thy Fri Jan 04 23:22:53 2019 +0100
@@ -681,7 +681,7 @@
subsection\<open>Ordinal Subtraction\<close>
-text\<open>The difference is @{term "ordertype(j-i, Memrel(j))"}.
+text\<open>The difference is \<^term>\<open>ordertype(j-i, Memrel(j))\<close>.
It's probably simpler to define the difference recursively!\<close>
lemma bij_sum_Diff:
@@ -995,7 +995,7 @@
apply (force dest: omult_lt_mono2 simp add: lt_not_refl)+
done
-subsection\<open>The Relation @{term Lt}\<close>
+subsection\<open>The Relation \<^term>\<open>Lt\<close>\<close>
lemma wf_Lt: "wf(Lt)"
apply (rule wf_subset)
--- a/src/ZF/Ordinal.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Ordinal.thy Fri Jan 04 23:22:53 2019 +0100
@@ -230,7 +230,7 @@
done
-text\<open>Recall that @{term"i \<le> j"} abbreviates @{term"i<succ(j)"} !!\<close>
+text\<open>Recall that \<^term>\<open>i \<le> j\<close> abbreviates \<^term>\<open>i<succ(j)\<close> !!\<close>
lemma le_iff: "i \<le> j <-> i<j | (i=j & Ord(j))"
by (unfold lt_def, blast)
@@ -301,7 +301,7 @@
apply (rule foundation [THEN disjE, THEN allI], erule disjI1, blast)
done
-text\<open>The premise @{term "Ord(i)"} does not suffice.\<close>
+text\<open>The premise \<^term>\<open>Ord(i)\<close> does not suffice.\<close>
lemma trans_Memrel:
"Ord(i) ==> trans(Memrel(i))"
by (unfold Ord_def Transset_def trans_def, blast)
--- a/src/ZF/Perm.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Perm.thy Fri Jan 04 23:22:53 2019 +0100
@@ -191,7 +191,7 @@
apply (force intro!: lam_type dest: apply_type)
done
-text\<open>@{term id} as the identity relation\<close>
+text\<open>\<^term>\<open>id\<close> as the identity relation\<close>
lemma id_iff [simp]: "<x,y> \<in> id(A) \<longleftrightarrow> x=y & y \<in> A"
by auto
@@ -259,7 +259,7 @@
subsection\<open>Composition of Two Relations\<close>
-text\<open>The inductive definition package could derive these theorems for @{term"r O s"}\<close>
+text\<open>The inductive definition package could derive these theorems for \<^term>\<open>r O s\<close>\<close>
lemma compI [intro]: "[| <a,b>:s; <b,c>:r |] ==> <a,c> \<in> r O s"
by (unfold comp_def, blast)
@@ -383,7 +383,7 @@
done
-subsection\<open>Dual Properties of @{term inj} and @{term surj}\<close>
+subsection\<open>Dual Properties of \<^term>\<open>inj\<close> and \<^term>\<open>surj\<close>\<close>
text\<open>Useful for proofs from
D Pastre. Automatic theorem proving in set theory.
@@ -420,7 +420,7 @@
subsubsection\<open>Inverses of Composition\<close>
text\<open>left inverse of composition; one inclusion is
- @{term "f \<in> A->B ==> id(A) \<subseteq> converse(f) O f"}\<close>
+ \<^term>\<open>f \<in> A->B ==> id(A) \<subseteq> converse(f) O f\<close>\<close>
lemma left_comp_inverse: "f \<in> inj(A,B) ==> converse(f) O f = id(A)"
apply (unfold inj_def, clarify)
apply (rule equalityI)
@@ -428,7 +428,7 @@
done
text\<open>right inverse of composition; one inclusion is
- @{term "f \<in> A->B ==> f O converse(f) \<subseteq> id(B)"}\<close>
+ \<^term>\<open>f \<in> A->B ==> f O converse(f) \<subseteq> id(B)\<close>\<close>
lemma right_comp_inverse:
"f \<in> surj(A,B) ==> f O converse(f) = id(B)"
apply (simp add: surj_def, clarify)
@@ -487,7 +487,7 @@
done
text\<open>A simple, high-level proof; the version for injections follows from it,
- using @{term "f \<in> inj(A,B) \<longleftrightarrow> f \<in> bij(A,range(f))"}\<close>
+ using \<^term>\<open>f \<in> inj(A,B) \<longleftrightarrow> f \<in> bij(A,range(f))\<close>\<close>
lemma bij_disjoint_Un:
"[| f \<in> bij(A,B); g \<in> bij(C,D); A \<inter> C = 0; B \<inter> D = 0 |]
==> (f \<union> g) \<in> bij(A \<union> C, B \<union> D)"
--- a/src/ZF/Sum.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Sum.thy Fri Jan 04 23:22:53 2019 +0100
@@ -25,7 +25,7 @@
definition Part :: "[i,i=>i] => i" where
"Part(A,h) == {x \<in> A. \<exists>z. x = h(z)}"
-subsection\<open>Rules for the @{term Part} Primitive\<close>
+subsection\<open>Rules for the \<^term>\<open>Part\<close> Primitive\<close>
lemma Part_iff:
"a \<in> Part(A,h) \<longleftrightarrow> a \<in> A & (\<exists>y. a=h(y))"
@@ -125,7 +125,7 @@
by (simp add: sum_def, blast)
-subsection\<open>The Eliminator: @{term case}\<close>
+subsection\<open>The Eliminator: \<^term>\<open>case\<close>\<close>
lemma case_Inl [simp]: "case(c, d, Inl(a)) = c(a)"
by (simp add: sum_defs)
@@ -159,7 +159,7 @@
by auto
-subsection\<open>More Rules for @{term "Part(A,h)"}\<close>
+subsection\<open>More Rules for \<^term>\<open>Part(A,h)\<close>\<close>
lemma Part_mono: "A<=B ==> Part(A,h)<=Part(B,h)"
by blast
--- a/src/ZF/Tools/cartprod.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Tools/cartprod.ML Fri Jan 04 23:22:53 2019 +0100
@@ -70,8 +70,8 @@
fun pseudo_type (t $ A $ Abs(_,_,B)) =
if t = Pr.sigma
then mk_prod(pseudo_type A, pseudo_type B)
- else @{typ i}
- | pseudo_type _ = @{typ i};
+ else \<^typ>\<open>i\<close>
+ | pseudo_type _ = \<^typ>\<open>i\<close>;
(*Maps the type T1*...*Tn to [T1,...,Tn], however nested*)
fun factors (Type("*", [T1, T2])) = factors T1 @ factors T2
--- a/src/ZF/Tools/datatype_package.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Tools/datatype_package.ML Fri Jan 04 23:22:53 2019 +0100
@@ -53,9 +53,9 @@
let val rec_hds = map head_of rec_tms
val dummy = rec_hds |> forall (fn t => is_Const t orelse
error ("Datatype set not previously declared as constant: " ^
- Syntax.string_of_term_global @{theory IFOL} t));
+ Syntax.string_of_term_global \<^theory>\<open>IFOL\<close> t));
val rec_names = (*nat doesn't have to be added*)
- @{const_name nat} :: map (#1 o dest_Const) rec_hds
+ \<^const_name>\<open>nat\<close> :: map (#1 o dest_Const) rec_hds
val u = if co then @{const QUniv.quniv} else @{const Univ.univ}
val cs = (fold o fold) (fn (_, _, _, prems) => prems |> (fold o fold_aterms)
(fn t as Const (a, _) => if member (op =) rec_names a then I else insert (op =) t
@@ -115,10 +115,10 @@
(*Combine split terms using case; yields the case operator for one part*)
fun call_case case_list =
- let fun call_f (free,[]) = Abs("null", @{typ i}, free)
+ let fun call_f (free,[]) = Abs("null", \<^typ>\<open>i\<close>, free)
| call_f (free,args) =
CP.ap_split (foldr1 CP.mk_prod (map (#2 o dest_Free) args))
- @{typ i}
+ \<^typ>\<open>i\<close>
free
in Balanced_Tree.make (fn (t1, t2) => Su.elim $ t1 $ t2) (map call_f case_list) end;
@@ -143,7 +143,7 @@
val (_, case_lists) = fold_rev add_case_list con_ty_lists (1, []);
(*extract the types of all the variables*)
- val case_typ = maps (map (#2 o #1)) con_ty_lists ---> @{typ "i => i"};
+ val case_typ = maps (map (#2 o #1)) con_ty_lists ---> \<^typ>\<open>i => i\<close>;
val case_base_name = big_rec_base_name ^ "_case";
val case_name = full_name case_base_name;
@@ -162,7 +162,7 @@
Non-identifiers (e.g. infixes) get a name of the form f_op_nnn. **)
(*a recursive call for x is the application rec`x *)
- val rec_call = @{const apply} $ Free ("rec", @{typ i});
+ val rec_call = @{const apply} $ Free ("rec", \<^typ>\<open>i\<close>);
(*look back down the "case args" (which have been reversed) to
determine the de Bruijn index*)
@@ -187,7 +187,7 @@
(*Find each recursive argument and add a recursive call for it*)
fun rec_args [] = []
- | rec_args ((Const(@{const_name mem},_)$arg$X)::prems) =
+ | rec_args ((Const(\<^const_name>\<open>mem\<close>,_)$arg$X)::prems) =
(case head_of X of
Const(a,_) => (*recursive occurrence?*)
if member (op =) rec_names a
@@ -199,7 +199,7 @@
(*Add an argument position for each occurrence of a recursive set.
Strictly speaking, the recursive arguments are the LAST of the function
variable, but they all have type "i" anyway*)
- fun add_rec_args args' T = (map (fn _ => @{typ i}) args') ---> T
+ fun add_rec_args args' T = (map (fn _ => \<^typ>\<open>i\<close>) args') ---> T
(*Plug in the function variable type needed for the recursor
as well as the new arguments (recursive calls)*)
@@ -215,7 +215,7 @@
val (_, recursor_lists) = fold_rev add_case_list rec_ty_lists (1, []);
(*extract the types of all the variables*)
- val recursor_typ = maps (map (#2 o #1)) rec_ty_lists ---> @{typ "i => i"};
+ val recursor_typ = maps (map (#2 o #1)) rec_ty_lists ---> \<^typ>\<open>i => i\<close>;
val recursor_base_name = big_rec_base_name ^ "_rec";
val recursor_name = full_name recursor_base_name;
@@ -232,7 +232,7 @@
Misc_Legacy.mk_defpair
(recursor_tm,
@{const Univ.Vrecursor} $
- absfree ("rec", @{typ i}) (list_comb (case_const, recursor_cases)));
+ absfree ("rec", \<^typ>\<open>i\<close>) (list_comb (case_const, recursor_cases)));
(* Build the new theory *)
@@ -303,7 +303,7 @@
| SOME recursor_def =>
let
(*Replace subterms rec`x (where rec is a Free var) by recursor_tm(x) *)
- fun subst_rec (Const(@{const_name apply},_) $ Free _ $ arg) = recursor_tm $ arg
+ fun subst_rec (Const(\<^const_name>\<open>apply\<close>,_) $ Free _ $ arg) = recursor_tm $ arg
| subst_rec tm =
let val (head, args) = strip_comb tm
in list_comb (head, map subst_rec args) end;
@@ -402,7 +402,7 @@
let
val ctxt = Proof_Context.init_global thy;
fun read_is strs =
- map (Syntax.parse_term ctxt #> Type.constraint @{typ i}) strs
+ map (Syntax.parse_term ctxt #> Type.constraint \<^typ>\<open>i\<close>) strs
|> Syntax.check_terms ctxt;
val rec_tms = read_is srec_tms;
@@ -422,20 +422,20 @@
#1 o add_datatype (dom, map fst dts) (map snd dts) (monos, type_intrs, type_elims);
val con_decl =
- Parse.name -- Scan.optional (@{keyword "("} |-- Parse.list1 Parse.term --| @{keyword ")"}) [] --
+ Parse.name -- Scan.optional (\<^keyword>\<open>(\<close> |-- Parse.list1 Parse.term --| \<^keyword>\<open>)\<close>) [] --
Parse.opt_mixfix >> Scan.triple1;
val coind_prefix = if coind then "co" else "";
val _ =
Outer_Syntax.command
- (if coind then @{command_keyword codatatype} else @{command_keyword datatype})
+ (if coind then \<^command_keyword>\<open>codatatype\<close> else \<^command_keyword>\<open>datatype\<close>)
("define " ^ coind_prefix ^ "datatype")
- ((Scan.optional ((@{keyword "\<subseteq>"} || @{keyword "<="}) |-- Parse.!!! Parse.term) "") --
- Parse.and_list1 (Parse.term -- (@{keyword "="} |-- Parse.enum1 "|" con_decl)) --
- Scan.optional (@{keyword "monos"} |-- Parse.!!! Parse.thms1) [] --
- Scan.optional (@{keyword "type_intros"} |-- Parse.!!! Parse.thms1) [] --
- Scan.optional (@{keyword "type_elims"} |-- Parse.!!! Parse.thms1) []
+ ((Scan.optional ((\<^keyword>\<open>\<subseteq>\<close> || \<^keyword>\<open><=\<close>) |-- Parse.!!! Parse.term) "") --
+ Parse.and_list1 (Parse.term -- (\<^keyword>\<open>=\<close> |-- Parse.enum1 "|" con_decl)) --
+ Scan.optional (\<^keyword>\<open>monos\<close> |-- Parse.!!! Parse.thms1) [] --
+ Scan.optional (\<^keyword>\<open>type_intros\<close> |-- Parse.!!! Parse.thms1) [] --
+ Scan.optional (\<^keyword>\<open>type_elims\<close> |-- Parse.!!! Parse.thms1) []
>> (Toplevel.theory o mk_datatype));
end;
--- a/src/ZF/Tools/ind_cases.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Tools/ind_cases.ML Fri Jan 04 23:22:53 2019 +0100
@@ -53,7 +53,7 @@
in thy |> Global_Theory.note_thmss "" facts |> snd end;
val _ =
- Outer_Syntax.command @{command_keyword inductive_cases}
+ Outer_Syntax.command \<^command_keyword>\<open>inductive_cases\<close>
"create simplified instances of elimination rules (improper)"
(Parse.and_list1 (Parse_Spec.opt_thm_name ":" -- Scan.repeat1 Parse.prop)
>> (Toplevel.theory o inductive_cases));
@@ -63,7 +63,7 @@
val _ =
Theory.setup
- (Method.setup @{binding "ind_cases"}
+ (Method.setup \<^binding>\<open>ind_cases\<close>
(Scan.lift (Scan.repeat1 Args.embedded_inner_syntax) >>
(fn props => fn ctxt => Method.erule ctxt 0 (map (smart_cases ctxt) props)))
"dynamic case analysis on sets");
--- a/src/ZF/Tools/induct_tacs.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Tools/induct_tacs.ML Fri Jan 04 23:22:53 2019 +0100
@@ -70,7 +70,7 @@
exception Find_tname of string
fun find_tname ctxt var As =
- let fun mk_pair (Const(@{const_name mem},_) $ Free (v,_) $ A) =
+ let fun mk_pair (Const(\<^const_name>\<open>mem\<close>,_) $ Free (v,_) $ A) =
(v, #1 (dest_Const (head_of A)))
| mk_pair _ = raise Match
val pairs = map_filter (try (mk_pair o FOLogic.dest_Trueprop)) As
@@ -98,7 +98,7 @@
val rule =
if exh then #exhaustion (datatype_info thy tn)
else #induct (datatype_info thy tn)
- val (Const(@{const_name mem},_) $ Var(ixn,_) $ _) =
+ val (Const(\<^const_name>\<open>mem\<close>,_) $ Var(ixn,_) $ _) =
(case Thm.prems_of rule of
[] => error "induction is not available for this datatype"
| major::_ => FOLogic.dest_Trueprop major)
@@ -119,14 +119,14 @@
fun rep_datatype_i elim induct case_eqns recursor_eqns thy =
let
(*analyze the LHS of a case equation to get a constructor*)
- fun const_of (Const(@{const_name IFOL.eq}, _) $ (_ $ c) $ _) = c
+ fun const_of (Const(\<^const_name>\<open>IFOL.eq\<close>, _) $ (_ $ c) $ _) = c
| const_of eqn = error ("Ill-formed case equation: " ^
Syntax.string_of_term_global thy eqn);
val constructors =
map (head_of o const_of o FOLogic.dest_Trueprop o Thm.prop_of) case_eqns;
- val Const (@{const_name mem}, _) $ _ $ data =
+ val Const (\<^const_name>\<open>mem\<close>, _) $ _ $ data =
FOLogic.dest_Trueprop (hd (Thm.prems_of elim));
val Const(big_rec_name, _) = head_of data;
@@ -178,11 +178,11 @@
val _ =
Theory.setup
- (Method.setup @{binding induct_tac}
+ (Method.setup \<^binding>\<open>induct_tac\<close>
(Args.goal_spec -- Scan.lift (Args.embedded -- Parse.for_fixes) >>
(fn (quant, (s, xs)) => fn ctxt => SIMPLE_METHOD'' quant (induct_tac ctxt s xs)))
"induct_tac emulation (dynamic instantiation!)" #>
- Method.setup @{binding case_tac}
+ Method.setup \<^binding>\<open>case_tac\<close>
(Args.goal_spec -- Scan.lift (Args.embedded -- Parse.for_fixes) >>
(fn (quant, (s, xs)) => fn ctxt => SIMPLE_METHOD'' quant (exhaust_tac ctxt s xs)))
"datatype case_tac emulation (dynamic instantiation!)");
@@ -191,11 +191,11 @@
(* outer syntax *)
val _ =
- Outer_Syntax.command @{command_keyword rep_datatype} "represent existing set inductively"
- ((@{keyword "elimination"} |-- Parse.!!! Parse.thm) --
- (@{keyword "induction"} |-- Parse.!!! Parse.thm) --
- (@{keyword "case_eqns"} |-- Parse.!!! Parse.thms1) --
- Scan.optional (@{keyword "recursor_eqns"} |-- Parse.!!! Parse.thms1) []
+ Outer_Syntax.command \<^command_keyword>\<open>rep_datatype\<close> "represent existing set inductively"
+ ((\<^keyword>\<open>elimination\<close> |-- Parse.!!! Parse.thm) --
+ (\<^keyword>\<open>induction\<close> |-- Parse.!!! Parse.thm) --
+ (\<^keyword>\<open>case_eqns\<close> |-- Parse.!!! Parse.thms1) --
+ Scan.optional (\<^keyword>\<open>recursor_eqns\<close> |-- Parse.!!! Parse.thms1) []
>> (fn (((x, y), z), w) => Toplevel.theory (rep_datatype x y z w)));
end;
--- a/src/ZF/Tools/inductive_package.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Tools/inductive_package.ML Fri Jan 04 23:22:53 2019 +0100
@@ -99,7 +99,7 @@
val z' = mk_variant"z" and X' = mk_variant"X" and w' = mk_variant"w";
- fun dest_tprop (Const(@{const_name Trueprop},_) $ P) = P
+ fun dest_tprop (Const(\<^const_name>\<open>Trueprop\<close>,_) $ P) = P
| dest_tprop Q = error ("Ill-formed premise of introduction rule: " ^
Syntax.string_of_term ctxt Q);
@@ -283,8 +283,8 @@
(*Used to make induction rules;
ind_alist = [(rec_tm1,pred1),...] associates predicates with rec ops
prem is a premise of an intr rule*)
- fun add_induct_prem ind_alist (prem as Const (@{const_name Trueprop}, _) $
- (Const (@{const_name mem}, _) $ t $ X), iprems) =
+ fun add_induct_prem ind_alist (prem as Const (\<^const_name>\<open>Trueprop\<close>, _) $
+ (Const (\<^const_name>\<open>mem\<close>, _) $ t $ X), iprems) =
(case AList.lookup (op aconv) ind_alist X of
SOME pred => prem :: FOLogic.mk_Trueprop (pred $ t) :: iprems
| NONE => (*possibly membership in M(rec_tm), for M monotone*)
@@ -500,7 +500,7 @@
(*strip quantifier and the implication*)
val induct0 = inst (quant_induct RS @{thm spec} RSN (2, @{thm rev_mp}));
- val Const (@{const_name Trueprop}, _) $ (pred_var $ _) = Thm.concl_of induct0
+ val Const (\<^const_name>\<open>Trueprop\<close>, _) $ (pred_var $ _) = Thm.concl_of induct0
val induct =
CP.split_rule_var (Proof_Context.init_global thy)
@@ -583,19 +583,19 @@
(monos, con_defs, type_intrs, type_elims);
val ind_decl =
- (@{keyword "domains"} |-- Parse.!!! (Parse.enum1 "+" Parse.term --
- ((@{keyword "\<subseteq>"} || @{keyword "<="}) |-- Parse.term))) --
- (@{keyword "intros"} |--
+ (\<^keyword>\<open>domains\<close> |-- Parse.!!! (Parse.enum1 "+" Parse.term --
+ ((\<^keyword>\<open>\<subseteq>\<close> || \<^keyword>\<open><=\<close>) |-- Parse.term))) --
+ (\<^keyword>\<open>intros\<close> |--
Parse.!!! (Scan.repeat1 (Parse_Spec.opt_thm_name ":" -- Parse.prop))) --
- Scan.optional (@{keyword "monos"} |-- Parse.!!! Parse.thms1) [] --
- Scan.optional (@{keyword "con_defs"} |-- Parse.!!! Parse.thms1) [] --
- Scan.optional (@{keyword "type_intros"} |-- Parse.!!! Parse.thms1) [] --
- Scan.optional (@{keyword "type_elims"} |-- Parse.!!! Parse.thms1) []
+ Scan.optional (\<^keyword>\<open>monos\<close> |-- Parse.!!! Parse.thms1) [] --
+ Scan.optional (\<^keyword>\<open>con_defs\<close> |-- Parse.!!! Parse.thms1) [] --
+ Scan.optional (\<^keyword>\<open>type_intros\<close> |-- Parse.!!! Parse.thms1) [] --
+ Scan.optional (\<^keyword>\<open>type_elims\<close> |-- Parse.!!! Parse.thms1) []
>> (Toplevel.theory o mk_ind);
val _ =
Outer_Syntax.command
- (if coind then @{command_keyword coinductive} else @{command_keyword inductive})
+ (if coind then \<^command_keyword>\<open>coinductive\<close> else \<^command_keyword>\<open>inductive\<close>)
("define " ^ co_prefix ^ "inductive sets") ind_decl;
end;
--- a/src/ZF/Tools/numeral_syntax.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Tools/numeral_syntax.ML Fri Jan 04 23:22:53 2019 +0100
@@ -15,13 +15,13 @@
(* bits *)
-fun mk_bit 0 = Syntax.const @{const_syntax zero}
- | mk_bit 1 = Syntax.const @{const_syntax succ} $ Syntax.const @{const_syntax zero}
+fun mk_bit 0 = Syntax.const \<^const_syntax>\<open>zero\<close>
+ | mk_bit 1 = Syntax.const \<^const_syntax>\<open>succ\<close> $ Syntax.const \<^const_syntax>\<open>zero\<close>
| mk_bit _ = raise Fail "mk_bit";
-fun dest_bit (Const (@{const_syntax zero}, _)) = 0
- | dest_bit (Const (@{const_syntax one}, _)) = 1
- | dest_bit (Const (@{const_syntax succ}, _) $ Const (@{const_syntax zero}, _)) = 1
+fun dest_bit (Const (\<^const_syntax>\<open>zero\<close>, _)) = 0
+ | dest_bit (Const (\<^const_syntax>\<open>one\<close>, _)) = 1
+ | dest_bit (Const (\<^const_syntax>\<open>succ\<close>, _) $ Const (\<^const_syntax>\<open>zero\<close>, _)) = 1
| dest_bit _ = raise Match;
@@ -42,14 +42,14 @@
fun mk_bin i =
let
- fun term_of [] = Syntax.const @{const_syntax Pls}
- | term_of [~1] = Syntax.const @{const_syntax Min}
- | term_of (b :: bs) = Syntax.const @{const_syntax Bit} $ term_of bs $ mk_bit b;
+ fun term_of [] = Syntax.const \<^const_syntax>\<open>Pls\<close>
+ | term_of [~1] = Syntax.const \<^const_syntax>\<open>Min\<close>
+ | term_of (b :: bs) = Syntax.const \<^const_syntax>\<open>Bit\<close> $ term_of bs $ mk_bit b;
in term_of (make_binary i) end;
-fun bin_of (Const (@{const_syntax Pls}, _)) = []
- | bin_of (Const (@{const_syntax Min}, _)) = [~1]
- | bin_of (Const (@{const_syntax Bit}, _) $ bs $ b) = dest_bit b :: bin_of bs
+fun bin_of (Const (\<^const_syntax>\<open>Pls\<close>, _)) = []
+ | bin_of (Const (\<^const_syntax>\<open>Min\<close>, _)) = [~1]
+ | bin_of (Const (\<^const_syntax>\<open>Bit\<close>, _) $ bs $ b) = dest_bit b :: bin_of bs
| bin_of _ = raise Match;
(*Leading 0s and (for negative numbers) -1s cause complications, though they
@@ -60,8 +60,8 @@
val rev_digs = bin_of t;
val (c, zs) =
(case rev rev_digs of
- ~1 :: bs => (@{syntax_const "_Neg_Int"}, prefix_len (equal 1) bs)
- | bs => (@{syntax_const "_Int"}, prefix_len (equal 0) bs));
+ ~1 :: bs => (\<^syntax_const>\<open>_Neg_Int\<close>, prefix_len (equal 1) bs)
+ | bs => (\<^syntax_const>\<open>_Int\<close>, prefix_len (equal 0) bs));
val num = string_of_int (abs (dest_binary rev_digs));
in (c, implode (replicate zs "0") ^ num) end;
@@ -69,11 +69,11 @@
(* translation of integer constant tokens to and from binary *)
fun int_tr [Free (s, _)] =
- Syntax.const @{const_syntax integ_of} $ mk_bin (#value (Lexicon.read_num s))
+ Syntax.const \<^const_syntax>\<open>integ_of\<close> $ mk_bin (#value (Lexicon.read_num s))
| int_tr ts = raise TERM ("int_tr", ts);
fun neg_int_tr [Free (s, _)] =
- Syntax.const @{const_syntax integ_of} $ mk_bin (~ (#value (Lexicon.read_num s)))
+ Syntax.const \<^const_syntax>\<open>integ_of\<close> $ mk_bin (~ (#value (Lexicon.read_num s)))
| neg_int_tr ts = raise TERM ("neg_int_tr", ts);
fun integ_of_tr' [t] =
@@ -83,9 +83,9 @@
val _ = Theory.setup
(Sign.parse_translation
- [(@{syntax_const "_Int"}, K int_tr),
- (@{syntax_const "_Neg_Int"}, K neg_int_tr)] #>
+ [(\<^syntax_const>\<open>_Int\<close>, K int_tr),
+ (\<^syntax_const>\<open>_Neg_Int\<close>, K neg_int_tr)] #>
Sign.print_translation
- [(@{const_syntax integ_of}, K integ_of_tr')]);
+ [(\<^const_syntax>\<open>integ_of\<close>, K integ_of_tr')]);
end;
--- a/src/ZF/Tools/primrec_package.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Tools/primrec_package.ML Fri Jan 04 23:22:53 2019 +0100
@@ -115,8 +115,8 @@
case AList.lookup (op =) eqns cname of
NONE => (warning ("no equation for constructor " ^ cname ^
"\nin definition of function " ^ fname);
- (Const (@{const_name zero}, Ind_Syntax.iT),
- #2 recursor_pair, Const (@{const_name zero}, Ind_Syntax.iT)))
+ (Const (\<^const_name>\<open>zero\<close>, Ind_Syntax.iT),
+ #2 recursor_pair, Const (\<^const_name>\<open>zero\<close>, Ind_Syntax.iT)))
| SOME (rhs, cargs', eq) =>
(rhs, inst_recursor (recursor_pair, cargs'), eq)
val allowed_terms = map use_fabs (#2 (strip_comb recursor_rhs))
@@ -197,7 +197,7 @@
(* outer syntax *)
val _ =
- Outer_Syntax.command @{command_keyword primrec} "define primitive recursive functions on datatypes"
+ Outer_Syntax.command \<^command_keyword>\<open>primrec\<close> "define primitive recursive functions on datatypes"
(Scan.repeat1 (Parse_Spec.opt_thm_name ":" -- Parse.prop)
>> (Toplevel.theory o (#1 oo (primrec o map (fn ((x, y), z) => ((x, z), y))))));
--- a/src/ZF/Tools/typechk.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Tools/typechk.ML Fri Jan 04 23:22:53 2019 +0100
@@ -76,7 +76,7 @@
if length rls <= maxr then resolve_tac ctxt rls i else no_tac
end);
-fun is_rigid_elem (Const(@{const_name Trueprop},_) $ (Const(@{const_name mem},_) $ a $ _)) =
+fun is_rigid_elem (Const(\<^const_name>\<open>Trueprop\<close>,_) $ (Const(\<^const_name>\<open>mem\<close>,_) $ a $ _)) =
not (is_Var (head_of a))
| is_rigid_elem _ = false;
@@ -116,9 +116,9 @@
val _ =
Theory.setup
- (Attrib.setup @{binding TC} (Attrib.add_del TC_add TC_del)
+ (Attrib.setup \<^binding>\<open>TC\<close> (Attrib.add_del TC_add TC_del)
"declaration of type-checking rule" #>
- Method.setup @{binding typecheck}
+ Method.setup \<^binding>\<open>typecheck\<close>
(Method.sections
[Args.add -- Args.colon >> K (Method.modifier TC_add \<^here>),
Args.del -- Args.colon >> K (Method.modifier TC_del \<^here>)]
@@ -126,7 +126,7 @@
"ZF type-checking");
val _ =
- Outer_Syntax.command @{command_keyword print_tcset} "print context of ZF typecheck"
+ Outer_Syntax.command \<^command_keyword>\<open>print_tcset\<close> "print context of ZF typecheck"
(Scan.succeed (Toplevel.keep (print_tcset o Toplevel.context_of)));
end;
--- a/src/ZF/UNITY/AllocBase.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/UNITY/AllocBase.thy Fri Jan 04 23:22:53 2019 +0100
@@ -127,7 +127,7 @@
apply (induct_tac "xs", auto)
done
-subsection\<open>The function @{term bag_of}\<close>
+subsection\<open>The function \<^term>\<open>bag_of\<close>\<close>
lemma bag_of_type [simp,TC]: "l\<in>list(A) ==>bag_of(l)\<in>Mult(A)"
apply (induct_tac "l")
@@ -168,7 +168,7 @@
by (auto simp add: mono1_def bag_of_type)
-subsection\<open>The function @{term msetsum}\<close>
+subsection\<open>The function \<^term>\<open>msetsum\<close>\<close>
lemmas nat_into_Fin = eqpoll_refl [THEN [2] Fin_lemma]
@@ -272,7 +272,7 @@
apply (auto intro: lt_trans)
done
-subsubsection\<open>The function @{term all_distinct}\<close>
+subsubsection\<open>The function \<^term>\<open>all_distinct\<close>\<close>
lemma all_distinct_Nil [simp]: "all_distinct(Nil)"
by (unfold all_distinct_def, auto)
@@ -284,7 +284,7 @@
apply (auto elim: list.cases)
done
-subsubsection\<open>The function @{term state_of}\<close>
+subsubsection\<open>The function \<^term>\<open>state_of\<close>\<close>
lemma state_of_state: "s\<in>state ==> state_of(s)=s"
by (unfold state_of_def, auto)
--- a/src/ZF/UNITY/AllocImpl.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/UNITY/AllocImpl.thy Fri Jan 04 23:22:53 2019 +0100
@@ -395,7 +395,7 @@
text\<open>Lemma 51, page 29.
This theorem states as invariant that if the number of
tokens given does not exceed the number returned, then the upper limit
- (@{term NbT}) does not exceed the number currently available.\<close>
+ (\<^term>\<open>NbT\<close>) does not exceed the number currently available.\<close>
lemma alloc_prog_Always_lemma:
"[| G \<in> program; alloc_prog ok G;
alloc_prog \<squnion> G \<in> Incr(lift(ask));
--- a/src/ZF/UNITY/Constrains.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/UNITY/Constrains.thy Fri Jan 04 23:22:53 2019 +0100
@@ -480,7 +480,7 @@
(* Three subgoals *)
rewrite_goal_tac ctxt [@{thm st_set_def}] 3,
REPEAT (force_tac ctxt 2),
- full_simp_tac (ctxt addsimps (Named_Theorems.get ctxt @{named_theorems program})) 1,
+ full_simp_tac (ctxt addsimps (Named_Theorems.get ctxt \<^named_theorems>\<open>program\<close>)) 1,
ALLGOALS (clarify_tac ctxt),
REPEAT (FIRSTGOAL (eresolve_tac ctxt @{thms disjE})),
ALLGOALS (clarify_tac ctxt),
--- a/src/ZF/UNITY/SubstAx.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/UNITY/SubstAx.thy Fri Jan 04 23:22:53 2019 +0100
@@ -354,7 +354,7 @@
REPEAT (ares_tac ctxt [@{thm LeadsTo_Basis}, @{thm leadsTo_Basis},
@{thm EnsuresI}, @{thm ensuresI}] 1),
(*now there are two subgoals: co & transient*)
- simp_tac (ctxt addsimps (Named_Theorems.get ctxt @{named_theorems program})) 2,
+ simp_tac (ctxt addsimps (Named_Theorems.get ctxt \<^named_theorems>\<open>program\<close>)) 2,
Rule_Insts.res_inst_tac ctxt
[((("act", 0), Position.none), sact)] [] @{thm transientI} 2,
(*simplify the command's domain*)
--- a/src/ZF/UNITY/UNITY.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/UNITY/UNITY.thy Fri Jan 04 23:22:53 2019 +0100
@@ -70,7 +70,7 @@
definition "constrains" :: "[i, i] => i" (infixl \<open>co\<close> 60) where
"A co B == {F \<in> program. (\<forall>act \<in> Acts(F). act``A\<subseteq>B) & st_set(A)}"
- \<comment> \<open>the condition @{term "st_set(A)"} makes the definition slightly
+ \<comment> \<open>the condition \<^term>\<open>st_set(A)\<close> makes the definition slightly
stronger than the HOL one\<close>
definition unless :: "[i, i] => i" (infixl \<open>unless\<close> 60) where
@@ -102,7 +102,7 @@
by (force simp add: SKIP_def program_def mk_program_def)
-subsection\<open>The function @{term programify}, the coercion from anything to
+subsection\<open>The function \<^term>\<open>programify\<close>, the coercion from anything to
program\<close>
lemma programify_program [simp]: "F \<in> program ==> programify(F)=F"
@@ -183,8 +183,8 @@
"[| act \<in> AllowedActs(F); <s,s'> \<in> act |] ==> s \<in> state & s' \<in> state"
by (blast dest: AllowedActs_type [THEN subsetD])
-subsection\<open>Simplification rules involving @{term state}, @{term Init},
- @{term Acts}, and @{term AllowedActs}\<close>
+subsection\<open>Simplification rules involving \<^term>\<open>state\<close>, \<^term>\<open>Init\<close>,
+ \<^term>\<open>Acts\<close>, and \<^term>\<open>AllowedActs\<close>\<close>
text\<open>But are they really needed?\<close>
@@ -224,7 +224,7 @@
by (cut_tac F = F in AllowedActs_type, blast)
-subsubsection\<open>The Operator @{term mk_program}\<close>
+subsubsection\<open>The Operator \<^term>\<open>mk_program\<close>\<close>
lemma mk_program_in_program [iff,TC]:
"mk_program(init, acts, allowed) \<in> program"
@@ -477,7 +477,7 @@
by (unfold unless_def, auto)
-subsection\<open>The Operator @{term initially}\<close>
+subsection\<open>The Operator \<^term>\<open>initially\<close>\<close>
lemma initially_type: "initially(A) \<subseteq> program"
by (unfold initially_def, blast)
@@ -489,7 +489,7 @@
by (unfold initially_def, blast)
-subsection\<open>The Operator @{term stable}\<close>
+subsection\<open>The Operator \<^term>\<open>stable\<close>\<close>
lemma stable_type: "stable(A)\<subseteq>program"
by (unfold stable_def constrains_def, blast)
@@ -511,7 +511,7 @@
by (auto simp add: unless_def stable_def)
-subsection\<open>Union and Intersection with @{term stable}\<close>
+subsection\<open>Union and Intersection with \<^term>\<open>stable\<close>\<close>
lemma stable_Un:
"[| F \<in> stable(A); F \<in> stable(A') |] ==> F \<in> stable(A \<union> A')"
@@ -559,7 +559,7 @@
(* [| F \<in> stable(C); F \<in> (C \<inter> A) co A |] ==> F \<in> stable(C \<inter> A) *)
lemmas stable_constrains_stable = stable_constrains_Int [THEN stableI]
-subsection\<open>The Operator @{term invariant}\<close>
+subsection\<open>The Operator \<^term>\<open>invariant\<close>\<close>
lemma invariant_type: "invariant(A) \<subseteq> program"
apply (unfold invariant_def)
@@ -580,7 +580,7 @@
done
text\<open>Could also say
- @{term "invariant(A) \<inter> invariant(B) \<subseteq> invariant (A \<inter> B)"}\<close>
+ \<^term>\<open>invariant(A) \<inter> invariant(B) \<subseteq> invariant (A \<inter> B)\<close>\<close>
lemma invariant_Int:
"[| F \<in> invariant(A); F \<in> invariant(B) |] ==> F \<in> invariant(A \<inter> B)"
apply (unfold invariant_def initially_def)
@@ -606,7 +606,7 @@
==> F:{s \<in> state. x(s) \<in> M} co (\<Union>m \<in> M. B(m))"
by (rule UNITY.elimination, auto)
-subsection\<open>The Operator @{term strongest_rhs}\<close>
+subsection\<open>The Operator \<^term>\<open>strongest_rhs\<close>\<close>
lemma constrains_strongest_rhs:
"[| F \<in> program; st_set(A) |] ==> F \<in> A co (strongest_rhs(F,A))"
--- a/src/ZF/Univ.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Univ.thy Fri Jan 04 23:22:53 2019 +0100
@@ -37,7 +37,7 @@
"univ(A) == Vfrom(A,nat)"
-subsection\<open>Immediate Consequences of the Definition of @{term "Vfrom(A,i)"}\<close>
+subsection\<open>Immediate Consequences of the Definition of \<^term>\<open>Vfrom(A,i)\<close>\<close>
text\<open>NOT SUITABLE FOR REWRITING -- RECURSIVE!\<close>
lemma Vfrom: "Vfrom(A,i) = A \<union> (\<Union>j\<in>i. Pow(Vfrom(A,j)))"
@@ -135,7 +135,7 @@
apply (rule Vfrom_mono [OF subset_refl subset_succI])
done
-subsection\<open>0, Successor and Limit Equations for @{term Vfrom}\<close>
+subsection\<open>0, Successor and Limit Equations for \<^term>\<open>Vfrom\<close>\<close>
lemma Vfrom_0: "Vfrom(A,0) = A"
by (subst Vfrom, blast)
@@ -176,7 +176,7 @@
apply (subst Vfrom, blast)
done
-subsection\<open>@{term Vfrom} applied to Limit Ordinals\<close>
+subsection\<open>\<^term>\<open>Vfrom\<close> applied to Limit Ordinals\<close>
(*NB. limit ordinals are non-empty:
Vfrom(A,0) = A = A \<union> (\<Union>y\<in>0. Vfrom(A,y)) *)
@@ -223,7 +223,7 @@
txt\<open>Infer that a, b occur at ordinals x,xa < i.\<close>
apply (erule Limit_VfromE, assumption)
apply (erule Limit_VfromE, assumption)
-txt\<open>Infer that @{term"succ(succ(x \<union> xa)) < i"}\<close>
+txt\<open>Infer that \<^term>\<open>succ(succ(x \<union> xa)) < i\<close>\<close>
apply (blast intro: VfromI [OF Pair_in_Vfrom]
Vfrom_UnI1 Vfrom_UnI2 Limit_has_succ Un_least_lt)
done
@@ -266,7 +266,7 @@
-subsection\<open>Properties assuming @{term "Transset(A)"}\<close>
+subsection\<open>Properties assuming \<^term>\<open>Transset(A)\<close>\<close>
lemma Transset_Vfrom: "Transset(A) ==> Transset(Vfrom(A,i))"
apply (rule_tac a=i in eps_induct)
@@ -404,7 +404,7 @@
by (blast elim: Limit_VfromE intro: Limit_has_succ Pow_in_Vfrom VfromI)
-subsection\<open>The Set @{term "Vset(i)"}\<close>
+subsection\<open>The Set \<^term>\<open>Vset(i)\<close>\<close>
lemma Vset: "Vset(i) = (\<Union>j\<in>i. Pow(Vset(j)))"
by (subst Vfrom, blast)
@@ -412,7 +412,7 @@
lemmas Vset_succ = Transset_0 [THEN Transset_Vfrom_succ]
lemmas Transset_Vset = Transset_0 [THEN Transset_Vfrom]
-subsubsection\<open>Characterisation of the elements of @{term "Vset(i)"}\<close>
+subsubsection\<open>Characterisation of the elements of \<^term>\<open>Vset(i)\<close>\<close>
lemma VsetD [rule_format]: "Ord(i) ==> \<forall>b. b \<in> Vset(i) \<longrightarrow> rank(b) < i"
apply (erule trans_induct)
@@ -520,7 +520,7 @@
done
-subsection\<open>The Datatype Universe: @{term "univ(A)"}\<close>
+subsection\<open>The Datatype Universe: \<^term>\<open>univ(A)\<close>\<close>
lemma univ_mono: "A<=B ==> univ(A) \<subseteq> univ(B)"
apply (unfold univ_def)
@@ -533,7 +533,7 @@
apply (erule Transset_Vfrom)
done
-subsubsection\<open>The Set @{term"univ(A)"} as a Limit\<close>
+subsubsection\<open>The Set \<^term>\<open>univ(A)\<close> as a Limit\<close>
lemma univ_eq_UN: "univ(A) = (\<Union>i\<in>nat. Vfrom(A,i))"
apply (unfold univ_def)
@@ -564,7 +564,7 @@
apply (blast elim: equalityCE)
done
-subsection\<open>Closure Properties for @{term "univ(A)"}\<close>
+subsection\<open>Closure Properties for \<^term>\<open>univ(A)\<close>\<close>
lemma zero_in_univ: "0 \<in> univ(A)"
apply (unfold univ_def)
@@ -790,7 +790,7 @@
ML
\<open>
val rank_ss =
- simpset_of (@{context} addsimps [@{thm VsetI}]
+ simpset_of (\<^context> addsimps [@{thm VsetI}]
addsimps @{thms rank_rls} @ (@{thms rank_rls} RLN (2, [@{thm lt_trans}])));
\<close>
--- a/src/ZF/WF.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/WF.thy Fri Jan 04 23:22:53 2019 +0100
@@ -52,7 +52,7 @@
subsection\<open>Well-Founded Relations\<close>
-subsubsection\<open>Equivalences between @{term wf} and @{term wf_on}\<close>
+subsubsection\<open>Equivalences between \<^term>\<open>wf\<close> and \<^term>\<open>wf_on\<close>\<close>
lemma wf_imp_wf_on: "wf(r) ==> wf[A](r)"
by (unfold wf_def wf_on_def, force)
@@ -75,10 +75,10 @@
lemma wf_subset: "[|wf(s); r<=s|] ==> wf(r)"
by (simp add: wf_def, fast)
-subsubsection\<open>Introduction Rules for @{term wf_on}\<close>
+subsubsection\<open>Introduction Rules for \<^term>\<open>wf_on\<close>\<close>
-text\<open>If every non-empty subset of @{term A} has an @{term r}-minimal element
- then we have @{term "wf[A](r)"}.\<close>
+text\<open>If every non-empty subset of \<^term>\<open>A\<close> has an \<^term>\<open>r\<close>-minimal element
+ then we have \<^term>\<open>wf[A](r)\<close>.\<close>
lemma wf_onI:
assumes prem: "!!Z u. [| Z<=A; u \<in> Z; \<forall>x\<in>Z. \<exists>y\<in>Z. <y,x>:r |] ==> False"
shows "wf[A](r)"
@@ -87,9 +87,9 @@
apply (rule_tac Z = Z in prem, blast+)
done
-text\<open>If @{term r} allows well-founded induction over @{term A}
- then we have @{term "wf[A](r)"}. Premise is equivalent to
- @{prop "!!B. \<forall>x\<in>A. (\<forall>y. <y,x>: r \<longrightarrow> y \<in> B) \<longrightarrow> x \<in> B ==> A<=B"}\<close>
+text\<open>If \<^term>\<open>r\<close> allows well-founded induction over \<^term>\<open>A\<close>
+ then we have \<^term>\<open>wf[A](r)\<close>. Premise is equivalent to
+ \<^prop>\<open>!!B. \<forall>x\<in>A. (\<forall>y. <y,x>: r \<longrightarrow> y \<in> B) \<longrightarrow> x \<in> B ==> A<=B\<close>\<close>
lemma wf_onI2:
assumes prem: "!!y B. [| \<forall>x\<in>A. (\<forall>y\<in>A. <y,x>:r \<longrightarrow> y \<in> B) \<longrightarrow> x \<in> B; y \<in> A |]
==> y \<in> B"
@@ -103,8 +103,8 @@
subsubsection\<open>Well-founded Induction\<close>
-text\<open>Consider the least @{term z} in @{term "domain(r)"} such that
- @{term "P(z)"} does not hold...\<close>
+text\<open>Consider the least \<^term>\<open>z\<close> in \<^term>\<open>domain(r)\<close> such that
+ \<^term>\<open>P(z)\<close> does not hold...\<close>
lemma wf_induct_raw:
"[| wf(r);
!!x.[| \<forall>y. <y,x>: r \<longrightarrow> P(y) |] ==> P(x) |]
@@ -141,8 +141,8 @@
wf_on_induct_raw [rule_format, consumes 2, case_names step, induct set: wf_on]
-text\<open>If @{term r} allows well-founded induction
- then we have @{term "wf(r)"}.\<close>
+text\<open>If \<^term>\<open>r\<close> allows well-founded induction
+ then we have \<^term>\<open>wf(r)\<close>.\<close>
lemma wfI:
"[| field(r)<=A;
!!y B. [| \<forall>x\<in>A. (\<forall>y\<in>A. <y,x>:r \<longrightarrow> y \<in> B) \<longrightarrow> x \<in> B; y \<in> A|]
@@ -192,7 +192,7 @@
text\<open>transitive closure of a WF relation is WF provided
- @{term A} is downward closed\<close>
+ \<^term>\<open>A\<close> is downward closed\<close>
lemma wf_on_trancl:
"[| wf[A](r); r-``A \<subseteq> A |] ==> wf[A](r^+)"
apply (rule wf_onI2)
@@ -210,13 +210,13 @@
done
-text\<open>@{term "r-``{a}"} is the set of everything under @{term a} in @{term r}\<close>
+text\<open>\<^term>\<open>r-``{a}\<close> is the set of everything under \<^term>\<open>a\<close> in \<^term>\<open>r\<close>\<close>
lemmas underI = vimage_singleton_iff [THEN iffD2]
lemmas underD = vimage_singleton_iff [THEN iffD1]
-subsection\<open>The Predicate @{term is_recfun}\<close>
+subsection\<open>The Predicate \<^term>\<open>is_recfun\<close>\<close>
lemma is_recfun_type: "is_recfun(r,a,H,f) ==> f \<in> r-``{a} -> range(f)"
apply (unfold is_recfun_def)
@@ -307,7 +307,7 @@
done
-subsection\<open>Unfolding @{term "wftrec(r,a,H)"}\<close>
+subsection\<open>Unfolding \<^term>\<open>wftrec(r,a,H)\<close>\<close>
lemma the_recfun_cut:
"[| wf(r); trans(r); <b,a>:r |]
@@ -324,7 +324,7 @@
done
-subsubsection\<open>Removal of the Premise @{term "trans(r)"}\<close>
+subsubsection\<open>Removal of the Premise \<^term>\<open>trans(r)\<close>\<close>
(*NOT SUITABLE FOR REWRITING: it is recursive!*)
lemma wfrec:
--- a/src/ZF/ZF.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/ZF.thy Fri Jan 04 23:22:53 2019 +0100
@@ -5,7 +5,7 @@
(*The theory of "iterates" logically belongs to Nat, but can't go there because
primrec isn't available into after Datatype.*)
-subsection\<open>Iteration of the function @{term F}\<close>
+subsection\<open>Iteration of the function \<^term>\<open>F\<close>\<close>
consts iterates :: "[i=>i,i,i] => i" (\<open>(_^_ '(_'))\<close> [60,1000,1000] 60)
--- a/src/ZF/ZF_Base.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/ZF_Base.thy Fri Jan 04 23:22:53 2019 +0100
@@ -635,8 +635,8 @@
declare Pow_iff [iff]
-lemmas Pow_bottom = empty_subsetI [THEN PowI] \<comment> \<open>@{term"0 \<in> Pow(B)"}\<close>
-lemmas Pow_top = subset_refl [THEN PowI] \<comment> \<open>@{term"A \<in> Pow(A)"}\<close>
+lemmas Pow_bottom = empty_subsetI [THEN PowI] \<comment> \<open>\<^term>\<open>0 \<in> Pow(B)\<close>\<close>
+lemmas Pow_top = subset_refl [THEN PowI] \<comment> \<open>\<^term>\<open>A \<in> Pow(A)\<close>\<close>
subsection\<open>Cantor's Theorem: There is no surjection from a set to its powerset.\<close>
--- a/src/ZF/Zorn.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/Zorn.thy Fri Jan 04 23:22:53 2019 +0100
@@ -37,7 +37,7 @@
text\<open>We could make the inductive definition conditional on
- @{term "next \<in> increasing(S)"}
+ \<^term>\<open>next \<in> increasing(S)\<close>
but instead we make this a side-condition of an introduction rule. Thus
the induction rule lets us assume that condition! Many inductive proofs
are therefore unconditional.\<close>
@@ -82,7 +82,7 @@
lemmas TFin_is_subset = TFin.dom_subset [THEN subsetD, THEN PowD]
-text\<open>Structural induction on @{term "TFin(S,next)"}\<close>
+text\<open>Structural induction on \<^term>\<open>TFin(S,next)\<close>\<close>
lemma TFin_induct:
"[| n \<in> TFin(S,next);
!!x. [| x \<in> TFin(S,next); P(x); next \<in> increasing(S) |] ==> P(next`x);
@@ -108,7 +108,7 @@
done
text\<open>Lemma 2 of section 3.2. Interesting in its own right!
- Requires @{term "next \<in> increasing(S)"} in the second induction step.\<close>
+ Requires \<^term>\<open>next \<in> increasing(S)\<close> in the second induction step.\<close>
lemma TFin_linear_lemma2:
"[| m \<in> TFin(S,next); next \<in> increasing(S) |]
==> \<forall>n \<in> TFin(S,next). n<=m \<longrightarrow> n=m | next`n \<subseteq> m"
@@ -331,7 +331,7 @@
apply blast+
done
-text\<open>Well-ordering of @{term "TFin(S,next)"}\<close>
+text\<open>Well-ordering of \<^term>\<open>TFin(S,next)\<close>\<close>
lemma well_ord_TFin_lemma: "[| Z \<subseteq> TFin(S,next); z \<in> Z |] ==> \<Inter>(Z) \<in> Z"
apply (rule classical)
apply (subgoal_tac "Z = {\<Union>(TFin (S,next))}")
@@ -356,7 +356,7 @@
apply (intro ballI)
apply (case_tac "x=y")
apply blast
-txt\<open>The @{term "x\<noteq>y"} case remains\<close>
+txt\<open>The \<^term>\<open>x\<noteq>y\<close> case remains\<close>
apply (rule_tac n1=x and m1=y in TFin_subset_linear [THEN disjE],
assumption+, blast+)
done
--- a/src/ZF/arith_data.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/arith_data.ML Fri Jan 04 23:22:53 2019 +0100
@@ -24,12 +24,12 @@
val iT = Ind_Syntax.iT;
-val zero = Const(@{const_name zero}, iT);
-val succ = Const(@{const_name succ}, iT --> iT);
+val zero = Const(\<^const_name>\<open>zero\<close>, iT);
+val succ = Const(\<^const_name>\<open>succ\<close>, iT --> iT);
fun mk_succ t = succ $ t;
val one = mk_succ zero;
-val mk_plus = FOLogic.mk_binop @{const_name Arith.add};
+val mk_plus = FOLogic.mk_binop \<^const_name>\<open>Arith.add\<close>;
(*Thus mk_sum[t] yields t+#0; longer sums don't have a trailing zero*)
fun mk_sum [] = zero
@@ -40,13 +40,13 @@
fun long_mk_sum [] = zero
| long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
-val dest_plus = FOLogic.dest_bin @{const_name Arith.add} iT;
+val dest_plus = FOLogic.dest_bin \<^const_name>\<open>Arith.add\<close> iT;
(* dest_sum *)
-fun dest_sum (Const(@{const_name zero},_)) = []
- | dest_sum (Const(@{const_name succ},_) $ t) = one :: dest_sum t
- | dest_sum (Const(@{const_name Arith.add},_) $ t $ u) = dest_sum t @ dest_sum u
+fun dest_sum (Const(\<^const_name>\<open>zero\<close>,_)) = []
+ | dest_sum (Const(\<^const_name>\<open>succ\<close>,_) $ t) = one :: dest_sum t
+ | dest_sum (Const(\<^const_name>\<open>Arith.add\<close>,_) $ t $ u) = dest_sum t @ dest_sum u
| dest_sum tm = [tm];
(*Apply the given rewrite (if present) just once*)
@@ -80,14 +80,14 @@
(*** Use CancelNumerals simproc without binary numerals,
just for cancellation ***)
-val mk_times = FOLogic.mk_binop @{const_name Arith.mult};
+val mk_times = FOLogic.mk_binop \<^const_name>\<open>Arith.mult\<close>;
fun mk_prod [] = one
| mk_prod [t] = t
| mk_prod (t :: ts) = if t = one then mk_prod ts
else mk_times (t, mk_prod ts);
-val dest_times = FOLogic.dest_bin @{const_name Arith.mult} iT;
+val dest_times = FOLogic.dest_bin \<^const_name>\<open>Arith.mult\<close> iT;
fun dest_prod t =
let val (t,u) = dest_times t
@@ -141,15 +141,15 @@
val find_first_coeff = find_first_coeff []
val norm_ss1 =
- simpset_of (put_simpset ZF_ss @{context} addsimps add_0s @ add_succs @ mult_1s @ @{thms add_ac})
+ simpset_of (put_simpset ZF_ss \<^context> addsimps add_0s @ add_succs @ mult_1s @ @{thms add_ac})
val norm_ss2 =
- simpset_of (put_simpset ZF_ss @{context} addsimps add_0s @ mult_1s @ @{thms add_ac} @
+ simpset_of (put_simpset ZF_ss \<^context> addsimps add_0s @ mult_1s @ @{thms add_ac} @
@{thms mult_ac} @ tc_rules @ natifys)
fun norm_tac ctxt =
ALLGOALS (asm_simp_tac (put_simpset norm_ss1 ctxt))
THEN ALLGOALS (asm_simp_tac (put_simpset norm_ss2 ctxt))
val numeral_simp_ss =
- simpset_of (put_simpset ZF_ss @{context} addsimps add_0s @ tc_rules @ natifys)
+ simpset_of (put_simpset ZF_ss \<^context> addsimps add_0s @ tc_rules @ natifys)
fun numeral_simp_tac ctxt =
ALLGOALS (asm_simp_tac (put_simpset numeral_simp_ss ctxt))
val simplify_meta_eq = simplify_meta_eq final_rules
@@ -175,8 +175,8 @@
struct
open CancelNumeralsCommon
val prove_conv = prove_conv "natless_cancel_numerals"
- val mk_bal = FOLogic.mk_binrel @{const_name Ordinal.lt}
- val dest_bal = FOLogic.dest_bin @{const_name Ordinal.lt} iT
+ val mk_bal = FOLogic.mk_binrel \<^const_name>\<open>Ordinal.lt\<close>
+ val dest_bal = FOLogic.dest_bin \<^const_name>\<open>Ordinal.lt\<close> iT
val bal_add1 = @{thm less_add_iff} RS @{thm iff_trans}
val bal_add2 = @{thm less_add_iff} RS @{thm iff_trans}
fun trans_tac ctxt = gen_trans_tac ctxt @{thm iff_trans}
@@ -188,8 +188,8 @@
struct
open CancelNumeralsCommon
val prove_conv = prove_conv "natdiff_cancel_numerals"
- val mk_bal = FOLogic.mk_binop @{const_name Arith.diff}
- val dest_bal = FOLogic.dest_bin @{const_name Arith.diff} iT
+ val mk_bal = FOLogic.mk_binop \<^const_name>\<open>Arith.diff\<close>
+ val dest_bal = FOLogic.dest_bin \<^const_name>\<open>Arith.diff\<close> iT
val bal_add1 = @{thm diff_add_eq} RS @{thm trans}
val bal_add2 = @{thm diff_add_eq} RS @{thm trans}
fun trans_tac ctxt = gen_trans_tac ctxt @{thm trans}
@@ -199,23 +199,23 @@
val nat_cancel =
- [Simplifier.make_simproc @{context} "nateq_cancel_numerals"
+ [Simplifier.make_simproc \<^context> "nateq_cancel_numerals"
{lhss =
- [@{term "l #+ m = n"}, @{term "l = m #+ n"},
- @{term "l #* m = n"}, @{term "l = m #* n"},
- @{term "succ(m) = n"}, @{term "m = succ(n)"}],
+ [\<^term>\<open>l #+ m = n\<close>, \<^term>\<open>l = m #+ n\<close>,
+ \<^term>\<open>l #* m = n\<close>, \<^term>\<open>l = m #* n\<close>,
+ \<^term>\<open>succ(m) = n\<close>, \<^term>\<open>m = succ(n)\<close>],
proc = K EqCancelNumerals.proc},
- Simplifier.make_simproc @{context} "natless_cancel_numerals"
+ Simplifier.make_simproc \<^context> "natless_cancel_numerals"
{lhss =
- [@{term "l #+ m < n"}, @{term "l < m #+ n"},
- @{term "l #* m < n"}, @{term "l < m #* n"},
- @{term "succ(m) < n"}, @{term "m < succ(n)"}],
+ [\<^term>\<open>l #+ m < n\<close>, \<^term>\<open>l < m #+ n\<close>,
+ \<^term>\<open>l #* m < n\<close>, \<^term>\<open>l < m #* n\<close>,
+ \<^term>\<open>succ(m) < n\<close>, \<^term>\<open>m < succ(n)\<close>],
proc = K LessCancelNumerals.proc},
- Simplifier.make_simproc @{context} "natdiff_cancel_numerals"
+ Simplifier.make_simproc \<^context> "natdiff_cancel_numerals"
{lhss =
- [@{term "(l #+ m) #- n"}, @{term "l #- (m #+ n)"},
- @{term "(l #* m) #- n"}, @{term "l #- (m #* n)"},
- @{term "succ(m) #- n"}, @{term "m #- succ(n)"}],
+ [\<^term>\<open>(l #+ m) #- n\<close>, \<^term>\<open>l #- (m #+ n)\<close>,
+ \<^term>\<open>(l #* m) #- n\<close>, \<^term>\<open>l #- (m #* n)\<close>,
+ \<^term>\<open>succ(m) #- n\<close>, \<^term>\<open>m #- succ(n)\<close>],
proc = K DiffCancelNumerals.proc}];
end;
--- a/src/ZF/equalities.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/equalities.thy Fri Jan 04 23:22:53 2019 +0100
@@ -68,7 +68,7 @@
by blast
-subsection\<open>Finite Set Constructions Using @{term cons}\<close>
+subsection\<open>Finite Set Constructions Using \<^term>\<open>cons\<close>\<close>
lemma cons_subsetI: "[| a\<in>C; B\<subseteq>C |] ==> cons(a,B) \<subseteq> C"
by blast
@@ -971,13 +971,13 @@
ML \<open>
val subset_cs =
- claset_of (@{context}
+ claset_of (\<^context>
delrules [@{thm subsetI}, @{thm subsetCE}]
addSIs @{thms subset_SIs}
addIs [@{thm Union_upper}, @{thm Inter_lower}]
addSEs [@{thm cons_subsetE}]);
-val ZF_cs = claset_of (@{context} delrules [@{thm equalityI}]);
+val ZF_cs = claset_of (\<^context> delrules [@{thm equalityI}]);
\<close>
end
--- a/src/ZF/ex/CoUnit.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/ex/CoUnit.thy Fri Jan 04 23:22:53 2019 +0100
@@ -25,7 +25,7 @@
"counit" = Con ("x \<in> counit")
inductive_cases ConE: "Con(x) \<in> counit"
- \<comment> \<open>USELESS because folding on @{term "Con(xa) == xa"} fails.\<close>
+ \<comment> \<open>USELESS because folding on \<^term>\<open>Con(xa) == xa\<close> fails.\<close>
lemma Con_iff: "Con(x) = Con(y) \<longleftrightarrow> x = y"
\<comment> \<open>Proving freeness results.\<close>
@@ -76,11 +76,11 @@
"Ord(i) ==> \<forall>x y. x \<in> counit2 \<longrightarrow> y \<in> counit2 \<longrightarrow> x \<inter> Vset(i) \<subseteq> y"
\<comment> \<open>Lemma for proving finality.\<close>
apply (erule trans_induct)
- apply (tactic "safe_tac (put_claset subset_cs @{context})")
+ apply (tactic "safe_tac (put_claset subset_cs \<^context>)")
apply (erule counit2.cases)
apply (erule counit2.cases)
apply (unfold counit2.con_defs)
- apply (tactic \<open>fast_tac (put_claset subset_cs @{context}
+ apply (tactic \<open>fast_tac (put_claset subset_cs \<^context>
addSIs [@{thm QPair_Int_Vset_subset_UN} RS @{thm subset_trans}, @{thm QPair_mono}]
addSEs [@{thm Ord_in_Ord}, @{thm Pair_inject}]) 1\<close>)
done
--- a/src/ZF/ex/Group.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/ex/Group.thy Fri Jan 04 23:22:53 2019 +0100
@@ -273,13 +273,13 @@
qed
text \<open>
- Since @{term H} is nonempty, it contains some element @{term x}. Since
+ Since \<^term>\<open>H\<close> is nonempty, it contains some element \<^term>\<open>x\<close>. Since
it is closed under inverse, it contains \<open>inv x\<close>. Since
it is closed under product, it contains \<open>x \<cdot> inv x = \<one>\<close>.
\<close>
text \<open>
- Since @{term H} is nonempty, it contains some element @{term x}. Since
+ Since \<^term>\<open>H\<close> is nonempty, it contains some element \<^term>\<open>x\<close>. Since
it is closed under inverse, it contains \<open>inv x\<close>. Since
it is closed under product, it contains \<open>x \<cdot> inv x = \<one>\<close>.
\<close>
@@ -411,8 +411,8 @@
by (auto intro: lam_type simp add: iso_def hom_def inj_def surj_def bij_def)
qed
-text\<open>Basis for homomorphism proofs: we assume two groups @{term G} and
- @{term H}, with a homomorphism @{term h} between them\<close>
+text\<open>Basis for homomorphism proofs: we assume two groups \<^term>\<open>G\<close> and
+ \<^term>\<open>H\<close>, with a homomorphism \<^term>\<open>h\<close> between them\<close>
locale group_hom = G: group G + H: group H
for G (structure) and H (structure) and h +
assumes homh: "h \<in> hom(G,H)"
@@ -628,7 +628,7 @@
lemma (in group) coset_join2:
"\<lbrakk>x \<in> carrier(G); subgroup(H,G); x\<in>H\<rbrakk> \<Longrightarrow> H #> x = H"
- \<comment> \<open>Alternative proof is to put @{term "x=\<one>"} in \<open>repr_independence\<close>.\<close>
+ \<comment> \<open>Alternative proof is to put \<^term>\<open>x=\<one>\<close> in \<open>repr_independence\<close>.\<close>
by (force simp add: subgroup.m_closed r_coset_def solve_equation)
lemma (in group) r_coset_subset_G:
@@ -972,7 +972,7 @@
apply (simp add: r_coset_subset_G [THEN subset_Finite])
done
-text\<open>More general than the HOL version, which also requires @{term G} to
+text\<open>More general than the HOL version, which also requires \<^term>\<open>G\<close> to
be finite.\<close>
lemma (in group) card_cosets_equal:
assumes H: "H \<subseteq> carrier(G)"
@@ -1071,8 +1071,8 @@
apply (simp_all add: FactGroup_def setinv_closed rcosets_inv_mult_group_eq)
done
-text\<open>The coset map is a homomorphism from @{term G} to the quotient group
- @{term "G Mod H"}\<close>
+text\<open>The coset map is a homomorphism from \<^term>\<open>G\<close> to the quotient group
+ \<^term>\<open>G Mod H\<close>\<close>
lemma (in normal) r_coset_hom_Mod:
"(\<lambda>a \<in> carrier(G). H #> a) \<in> hom(G, G Mod H)"
by (auto simp add: FactGroup_def RCOSETS_def hom_def rcos_sum intro: lam_type)
@@ -1201,7 +1201,7 @@
-text\<open>If the homomorphism @{term h} is onto @{term H}, then so is the
+text\<open>If the homomorphism \<^term>\<open>h\<close> is onto \<^term>\<open>H\<close>, then so is the
homomorphism from the quotient group\<close>
lemma (in group_hom) FactGroup_surj:
assumes h: "h \<in> surj(carrier(G), carrier(H))"
@@ -1215,14 +1215,14 @@
hence "(\<Union>x\<in>kernel(G,H,h) #> g. {h ` x}) = {y}"
by (auto simp add: y kernel_def r_coset_def)
with g show "\<exists>x\<in>carrier(G Mod kernel(G, H, h)). contents(h `` x) = y"
- \<comment> \<open>The witness is @{term "kernel(G,H,h) #> g"}\<close>
+ \<comment> \<open>The witness is \<^term>\<open>kernel(G,H,h) #> g\<close>\<close>
by (force simp add: FactGroup_def RCOSETS_def
image_eq_UN [OF hom_is_fun] kernel_rcoset_subset)
qed
-text\<open>If @{term h} is a homomorphism from @{term G} onto @{term H}, then the
- quotient group @{term "G Mod (kernel(G,H,h))"} is isomorphic to @{term H}.\<close>
+text\<open>If \<^term>\<open>h\<close> is a homomorphism from \<^term>\<open>G\<close> onto \<^term>\<open>H\<close>, then the
+ quotient group \<^term>\<open>G Mod (kernel(G,H,h))\<close> is isomorphic to \<^term>\<open>H\<close>.\<close>
theorem (in group_hom) FactGroup_iso:
"h \<in> surj(carrier(G), carrier(H))
\<Longrightarrow> (\<lambda>X\<in>carrier (G Mod kernel(G,H,h)). contents (h``X)) \<in> (G Mod (kernel(G,H,h))) \<cong> H"
--- a/src/ZF/ex/Primes.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/ex/Primes.thy Fri Jan 04 23:22:53 2019 +0100
@@ -161,7 +161,7 @@
by (blast intro: gcd_induct_lemma)
-subsection\<open>Basic Properties of @{term gcd}\<close>
+subsection\<open>Basic Properties of \<^term>\<open>gcd\<close>\<close>
text\<open>type of gcd\<close>
lemma gcd_type [simp,TC]: "gcd(m, n) \<in> nat"
@@ -350,7 +350,7 @@
text\<open>This theorem leads immediately to a proof of the uniqueness of
- factorization. If @{term p} divides a product of primes then it is
+ factorization. If \<^term>\<open>p\<close> divides a product of primes then it is
one of those primes.\<close>
lemma prime_dvd_mult:
--- a/src/ZF/func.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/func.thy Fri Jan 04 23:22:53 2019 +0100
@@ -278,7 +278,7 @@
by (blast dest: apply_equality apply_Pair)
-subsection\<open>Properties of @{term "restrict(f,A)"}\<close>
+subsection\<open>Properties of \<^term>\<open>restrict(f,A)\<close>\<close>
lemma restrict_subset: "restrict(f,A) \<subseteq> f"
by (unfold restrict_def, blast)
--- a/src/ZF/ind_syntax.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/ind_syntax.ML Fri Jan 04 23:22:53 2019 +0100
@@ -18,7 +18,7 @@
(** Abstract syntax definitions for ZF **)
-val iT = Type(@{type_name i}, []);
+val iT = Type(\<^type_name>\<open>i\<close>, []);
(*Creates All(%v.v:A --> P(v)) rather than Ball(A,P) *)
fun mk_all_imp (A,P) =
@@ -29,16 +29,16 @@
fun mk_Collect (a, D, t) = @{const Collect} $ D $ absfree (a, iT) t;
(*simple error-checking in the premises of an inductive definition*)
-fun chk_prem rec_hd (Const (@{const_name conj}, _) $ _ $ _) =
+fun chk_prem rec_hd (Const (\<^const_name>\<open>conj\<close>, _) $ _ $ _) =
error"Premises may not be conjuctive"
- | chk_prem rec_hd (Const (@{const_name mem}, _) $ t $ X) =
+ | chk_prem rec_hd (Const (\<^const_name>\<open>mem\<close>, _) $ t $ X) =
(Logic.occs(rec_hd,t) andalso error "Recursion term on left of member symbol"; ())
| chk_prem rec_hd t =
(Logic.occs(rec_hd,t) andalso error "Recursion term in side formula"; ());
(*Return the conclusion of a rule, of the form t:X*)
fun rule_concl rl =
- let val Const (@{const_name Trueprop}, _) $ (Const (@{const_name mem}, _) $ t $ X) =
+ let val Const (\<^const_name>\<open>Trueprop\<close>, _) $ (Const (\<^const_name>\<open>mem\<close>, _) $ t $ X) =
Logic.strip_imp_concl rl
in (t,X) end;
@@ -50,7 +50,7 @@
(*For deriving cases rules. CollectD2 discards the domain, which is redundant;
read_instantiate replaces a propositional variable by a formula variable*)
val equals_CollectD =
- Rule_Insts.read_instantiate @{context} [((("W", 0), Position.none), "Q")] ["Q"]
+ Rule_Insts.read_instantiate \<^context> [((("W", 0), Position.none), "Q")] ["Q"]
(make_elim (@{thm equalityD1} RS @{thm subsetD} RS @{thm CollectD2}));
@@ -61,7 +61,7 @@
type constructor_spec =
(string * typ * mixfix) * string * term list * term list;
-fun dest_mem (Const (@{const_name mem}, _) $ x $ A) = (x, A)
+fun dest_mem (Const (\<^const_name>\<open>mem\<close>, _) $ x $ A) = (x, A)
| dest_mem _ = error "Constructor specifications must have the form x:A";
(*read a constructor specification*)
--- a/src/ZF/int_arith.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/int_arith.ML Fri Jan 04 23:22:53 2019 +0100
@@ -16,26 +16,26 @@
(* abstract syntax operations *)
-fun mk_bit 0 = @{term "0"}
- | mk_bit 1 = @{term "succ(0)"}
+fun mk_bit 0 = \<^term>\<open>0\<close>
+ | mk_bit 1 = \<^term>\<open>succ(0)\<close>
| mk_bit _ = raise TERM ("mk_bit", []);
-fun dest_bit @{term "0"} = 0
- | dest_bit @{term "succ(0)"} = 1
+fun dest_bit \<^term>\<open>0\<close> = 0
+ | dest_bit \<^term>\<open>succ(0)\<close> = 1
| dest_bit t = raise TERM ("dest_bit", [t]);
fun mk_bin i =
let
- fun term_of [] = @{term Pls}
- | term_of [~1] = @{term Min}
- | term_of (b :: bs) = @{term Bit} $ term_of bs $ mk_bit b;
+ fun term_of [] = \<^term>\<open>Pls\<close>
+ | term_of [~1] = \<^term>\<open>Min\<close>
+ | term_of (b :: bs) = \<^term>\<open>Bit\<close> $ term_of bs $ mk_bit b;
in term_of (Numeral_Syntax.make_binary i) end;
fun dest_bin tm =
let
- fun bin_of @{term Pls} = []
- | bin_of @{term Min} = [~1]
- | bin_of (@{term Bit} $ bs $ b) = dest_bit b :: bin_of bs
+ fun bin_of \<^term>\<open>Pls\<close> = []
+ | bin_of \<^term>\<open>Min\<close> = [~1]
+ | bin_of (\<^term>\<open>Bit\<close> $ bs $ b) = dest_bit b :: bin_of bs
| bin_of _ = raise TERM ("dest_bin", [tm]);
in Numeral_Syntax.dest_binary (bin_of tm) end;
@@ -44,7 +44,7 @@
fun mk_numeral i = @{const integ_of} $ mk_bin i;
-fun dest_numeral (Const(@{const_name integ_of}, _) $ w) = dest_bin w
+fun dest_numeral (Const(\<^const_name>\<open>integ_of\<close>, _) $ w) = dest_bin w
| dest_numeral t = raise TERM ("dest_numeral", [t]);
fun find_first_numeral past (t::terms) =
@@ -53,7 +53,7 @@
| find_first_numeral past [] = raise TERM("find_first_numeral", []);
val zero = mk_numeral 0;
-val mk_plus = FOLogic.mk_binop @{const_name "zadd"};
+val mk_plus = FOLogic.mk_binop \<^const_name>\<open>zadd\<close>;
(*Thus mk_sum[t] yields t+#0; longer sums don't have a trailing zero*)
fun mk_sum [] = zero
@@ -65,9 +65,9 @@
| long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
(*decompose additions AND subtractions as a sum*)
-fun dest_summing (pos, Const (@{const_name "zadd"}, _) $ t $ u, ts) =
+fun dest_summing (pos, Const (\<^const_name>\<open>zadd\<close>, _) $ t $ u, ts) =
dest_summing (pos, t, dest_summing (pos, u, ts))
- | dest_summing (pos, Const (@{const_name "zdiff"}, _) $ t $ u, ts) =
+ | dest_summing (pos, Const (\<^const_name>\<open>zdiff\<close>, _) $ t $ u, ts) =
dest_summing (pos, t, dest_summing (not pos, u, ts))
| dest_summing (pos, t, ts) =
if pos then t::ts else @{const zminus} $ t :: ts;
@@ -75,14 +75,14 @@
fun dest_sum t = dest_summing (true, t, []);
val one = mk_numeral 1;
-val mk_times = FOLogic.mk_binop @{const_name "zmult"};
+val mk_times = FOLogic.mk_binop \<^const_name>\<open>zmult\<close>;
fun mk_prod [] = one
| mk_prod [t] = t
| mk_prod (t :: ts) = if t = one then mk_prod ts
else mk_times (t, mk_prod ts);
-val dest_times = FOLogic.dest_bin @{const_name "zmult"} @{typ i};
+val dest_times = FOLogic.dest_bin \<^const_name>\<open>zmult\<close> \<^typ>\<open>i\<close>;
fun dest_prod t =
let val (t,u) = dest_times t
@@ -93,7 +93,7 @@
fun mk_coeff (k, t) = mk_times (mk_numeral k, t);
(*Express t as a product of (possibly) a numeral with other sorted terms*)
-fun dest_coeff sign (Const (@{const_name "zminus"}, _) $ t) = dest_coeff (~sign) t
+fun dest_coeff sign (Const (\<^const_name>\<open>zminus\<close>, _) $ t) = dest_coeff (~sign) t
| dest_coeff sign t =
let val ts = sort Term_Ord.term_ord (dest_prod t)
val (n, ts') = find_first_numeral [] ts
@@ -156,13 +156,13 @@
fun trans_tac ctxt = ArithData.gen_trans_tac ctxt @{thm iff_trans}
val norm_ss1 =
- simpset_of (put_simpset ZF_ss @{context}
+ simpset_of (put_simpset ZF_ss \<^context>
addsimps add_0s @ mult_1s @ diff_simps @ zminus_simps @ @{thms zadd_ac})
val norm_ss2 =
- simpset_of (put_simpset ZF_ss @{context}
+ simpset_of (put_simpset ZF_ss \<^context>
addsimps bin_simps @ int_mult_minus_simps @ intifys)
val norm_ss3 =
- simpset_of (put_simpset ZF_ss @{context}
+ simpset_of (put_simpset ZF_ss \<^context>
addsimps int_minus_from_mult_simps @ @{thms zadd_ac} @ @{thms zmult_ac} @ tc_rules @ intifys)
fun norm_tac ctxt =
ALLGOALS (asm_simp_tac (put_simpset norm_ss1 ctxt))
@@ -170,7 +170,7 @@
THEN ALLGOALS (asm_simp_tac (put_simpset norm_ss3 ctxt))
val numeral_simp_ss =
- simpset_of (put_simpset ZF_ss @{context}
+ simpset_of (put_simpset ZF_ss \<^context>
addsimps add_0s @ bin_simps @ tc_rules @ intifys)
fun numeral_simp_tac ctxt =
ALLGOALS (simp_tac (put_simpset numeral_simp_ss ctxt))
@@ -191,8 +191,8 @@
structure LessCancelNumerals = CancelNumeralsFun
(open CancelNumeralsCommon
val prove_conv = ArithData.prove_conv "intless_cancel_numerals"
- val mk_bal = FOLogic.mk_binrel @{const_name "zless"}
- val dest_bal = FOLogic.dest_bin @{const_name "zless"} @{typ i}
+ val mk_bal = FOLogic.mk_binrel \<^const_name>\<open>zless\<close>
+ val dest_bal = FOLogic.dest_bin \<^const_name>\<open>zless\<close> \<^typ>\<open>i\<close>
val bal_add1 = @{thm less_add_iff1} RS @{thm iff_trans}
val bal_add2 = @{thm less_add_iff2} RS @{thm iff_trans}
);
@@ -200,30 +200,30 @@
structure LeCancelNumerals = CancelNumeralsFun
(open CancelNumeralsCommon
val prove_conv = ArithData.prove_conv "intle_cancel_numerals"
- val mk_bal = FOLogic.mk_binrel @{const_name "zle"}
- val dest_bal = FOLogic.dest_bin @{const_name "zle"} @{typ i}
+ val mk_bal = FOLogic.mk_binrel \<^const_name>\<open>zle\<close>
+ val dest_bal = FOLogic.dest_bin \<^const_name>\<open>zle\<close> \<^typ>\<open>i\<close>
val bal_add1 = @{thm le_add_iff1} RS @{thm iff_trans}
val bal_add2 = @{thm le_add_iff2} RS @{thm iff_trans}
);
val cancel_numerals =
- [Simplifier.make_simproc @{context} "inteq_cancel_numerals"
+ [Simplifier.make_simproc \<^context> "inteq_cancel_numerals"
{lhss =
- [@{term "l $+ m = n"}, @{term "l = m $+ n"},
- @{term "l $- m = n"}, @{term "l = m $- n"},
- @{term "l $* m = n"}, @{term "l = m $* n"}],
+ [\<^term>\<open>l $+ m = n\<close>, \<^term>\<open>l = m $+ n\<close>,
+ \<^term>\<open>l $- m = n\<close>, \<^term>\<open>l = m $- n\<close>,
+ \<^term>\<open>l $* m = n\<close>, \<^term>\<open>l = m $* n\<close>],
proc = K EqCancelNumerals.proc},
- Simplifier.make_simproc @{context} "intless_cancel_numerals"
+ Simplifier.make_simproc \<^context> "intless_cancel_numerals"
{lhss =
- [@{term "l $+ m $< n"}, @{term "l $< m $+ n"},
- @{term "l $- m $< n"}, @{term "l $< m $- n"},
- @{term "l $* m $< n"}, @{term "l $< m $* n"}],
+ [\<^term>\<open>l $+ m $< n\<close>, \<^term>\<open>l $< m $+ n\<close>,
+ \<^term>\<open>l $- m $< n\<close>, \<^term>\<open>l $< m $- n\<close>,
+ \<^term>\<open>l $* m $< n\<close>, \<^term>\<open>l $< m $* n\<close>],
proc = K LessCancelNumerals.proc},
- Simplifier.make_simproc @{context} "intle_cancel_numerals"
+ Simplifier.make_simproc \<^context> "intle_cancel_numerals"
{lhss =
- [@{term "l $+ m $\<le> n"}, @{term "l $\<le> m $+ n"},
- @{term "l $- m $\<le> n"}, @{term "l $\<le> m $- n"},
- @{term "l $* m $\<le> n"}, @{term "l $\<le> m $* n"}],
+ [\<^term>\<open>l $+ m $\<le> n\<close>, \<^term>\<open>l $\<le> m $+ n\<close>,
+ \<^term>\<open>l $- m $\<le> n\<close>, \<^term>\<open>l $\<le> m $- n\<close>,
+ \<^term>\<open>l $* m $\<le> n\<close>, \<^term>\<open>l $\<le> m $* n\<close>],
proc = K LeCancelNumerals.proc}];
@@ -244,13 +244,13 @@
fun trans_tac ctxt = ArithData.gen_trans_tac ctxt @{thm trans}
val norm_ss1 =
- simpset_of (put_simpset ZF_ss @{context}
+ simpset_of (put_simpset ZF_ss \<^context>
addsimps add_0s @ mult_1s @ diff_simps @ zminus_simps @ @{thms zadd_ac} @ intifys)
val norm_ss2 =
- simpset_of (put_simpset ZF_ss @{context}
+ simpset_of (put_simpset ZF_ss \<^context>
addsimps bin_simps @ int_mult_minus_simps @ intifys)
val norm_ss3 =
- simpset_of (put_simpset ZF_ss @{context}
+ simpset_of (put_simpset ZF_ss \<^context>
addsimps int_minus_from_mult_simps @ @{thms zadd_ac} @ @{thms zmult_ac} @ tc_rules @ intifys)
fun norm_tac ctxt =
ALLGOALS (asm_simp_tac (put_simpset norm_ss1 ctxt))
@@ -258,7 +258,7 @@
THEN ALLGOALS (asm_simp_tac (put_simpset norm_ss3 ctxt))
val numeral_simp_ss =
- simpset_of (put_simpset ZF_ss @{context} addsimps add_0s @ bin_simps @ tc_rules @ intifys)
+ simpset_of (put_simpset ZF_ss \<^context> addsimps add_0s @ bin_simps @ tc_rules @ intifys)
fun numeral_simp_tac ctxt =
ALLGOALS (simp_tac (put_simpset numeral_simp_ss ctxt))
val simplify_meta_eq = ArithData.simplify_meta_eq (add_0s @ mult_1s)
@@ -267,8 +267,8 @@
structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
val combine_numerals =
- Simplifier.make_simproc @{context} "int_combine_numerals"
- {lhss = [@{term "i $+ j"}, @{term "i $- j"}],
+ Simplifier.make_simproc \<^context> "int_combine_numerals"
+ {lhss = [\<^term>\<open>i $+ j\<close>, \<^term>\<open>i $- j\<close>],
proc = K CombineNumerals.proc};
@@ -295,16 +295,16 @@
fun trans_tac ctxt = ArithData.gen_trans_tac ctxt @{thm trans}
val norm_ss1 =
- simpset_of (put_simpset ZF_ss @{context} addsimps mult_1s @ diff_simps @ zminus_simps)
+ simpset_of (put_simpset ZF_ss \<^context> addsimps mult_1s @ diff_simps @ zminus_simps)
val norm_ss2 =
- simpset_of (put_simpset ZF_ss @{context} addsimps [@{thm zmult_zminus_right} RS @{thm sym}] @
+ simpset_of (put_simpset ZF_ss \<^context> addsimps [@{thm zmult_zminus_right} RS @{thm sym}] @
bin_simps @ @{thms zmult_ac} @ tc_rules @ intifys)
fun norm_tac ctxt =
ALLGOALS (asm_simp_tac (put_simpset norm_ss1 ctxt))
THEN ALLGOALS (asm_simp_tac (put_simpset norm_ss2 ctxt))
val numeral_simp_ss =
- simpset_of (put_simpset ZF_ss @{context} addsimps bin_simps @ tc_rules @ intifys)
+ simpset_of (put_simpset ZF_ss \<^context> addsimps bin_simps @ tc_rules @ intifys)
fun numeral_simp_tac ctxt =
ALLGOALS (simp_tac (put_simpset numeral_simp_ss ctxt))
val simplify_meta_eq = ArithData.simplify_meta_eq (mult_1s);
@@ -314,8 +314,8 @@
structure CombineNumeralsProd = CombineNumeralsFun(CombineNumeralsProdData);
val combine_numerals_prod =
- Simplifier.make_simproc @{context} "int_combine_numerals_prod"
- {lhss = [@{term "i $* j"}], proc = K CombineNumeralsProd.proc};
+ Simplifier.make_simproc \<^context> "int_combine_numerals_prod"
+ {lhss = [\<^term>\<open>i $* j\<close>], proc = K CombineNumeralsProd.proc};
end;
--- a/src/ZF/pair.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/pair.thy Fri Jan 04 23:22:53 2019 +0100
@@ -16,7 +16,7 @@
#> Simplifier.add_cong @{thm if_weak_cong})
\<close>
-ML \<open>val ZF_ss = simpset_of @{context}\<close>
+ML \<open>val ZF_ss = simpset_of \<^context>\<close>
simproc_setup defined_Bex ("\<exists>x\<in>A. P(x) & Q(x)") = \<open>
fn _ => Quantifier1.rearrange_bex
@@ -122,7 +122,7 @@
by blast
-subsection\<open>Projections @{term fst} and @{term snd}\<close>
+subsection\<open>Projections \<^term>\<open>fst\<close> and \<^term>\<open>snd\<close>\<close>
lemma fst_conv [simp]: "fst(<a,b>) = a"
by (simp add: fst_def)
@@ -140,7 +140,7 @@
by auto
-subsection\<open>The Eliminator, @{term split}\<close>
+subsection\<open>The Eliminator, \<^term>\<open>split\<close>\<close>
(*A META-equality, so that it applies to higher types as well...*)
lemma split [simp]: "split(%x y. c(x,y), <a,b>) == c(a,b)"
@@ -158,7 +158,7 @@
by (auto simp add: split_def)
-subsection\<open>A version of @{term split} for Formulae: Result Type @{typ o}\<close>
+subsection\<open>A version of \<^term>\<open>split\<close> for Formulae: Result Type \<^typ>\<open>o\<close>\<close>
lemma splitI: "R(a,b) ==> split(R, <a,b>)"
by (simp add: split_def)
--- a/src/ZF/simpdata.ML Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/simpdata.ML Fri Jan 04 23:22:53 2019 +0100
@@ -19,27 +19,27 @@
| NONE => [th])
| _ => [th]
in case Thm.concl_of th of
- Const(@{const_name Trueprop},_) $ P =>
+ Const(\<^const_name>\<open>Trueprop\<close>,_) $ P =>
(case P of
- Const(@{const_name mem},_) $ a $ b => tryrules mem_pairs b
- | Const(@{const_name True},_) => []
- | Const(@{const_name False},_) => []
+ Const(\<^const_name>\<open>mem\<close>,_) $ a $ b => tryrules mem_pairs b
+ | Const(\<^const_name>\<open>True\<close>,_) => []
+ | Const(\<^const_name>\<open>False\<close>,_) => []
| A => tryrules conn_pairs A)
| _ => [th]
end;
(*Analyse a rigid formula*)
val ZF_conn_pairs =
- [(@{const_name Ball}, [@{thm bspec}]),
- (@{const_name All}, [@{thm spec}]),
- (@{const_name imp}, [@{thm mp}]),
- (@{const_name conj}, [@{thm conjunct1}, @{thm conjunct2}])];
+ [(\<^const_name>\<open>Ball\<close>, [@{thm bspec}]),
+ (\<^const_name>\<open>All\<close>, [@{thm spec}]),
+ (\<^const_name>\<open>imp\<close>, [@{thm mp}]),
+ (\<^const_name>\<open>conj\<close>, [@{thm conjunct1}, @{thm conjunct2}])];
(*Analyse a:b, where b is rigid*)
val ZF_mem_pairs =
- [(@{const_name Collect}, [@{thm CollectD1}, @{thm CollectD2}]),
- (@{const_name Diff}, [@{thm DiffD1}, @{thm DiffD2}]),
- (@{const_name Int}, [@{thm IntD1}, @{thm IntD2}])];
+ [(\<^const_name>\<open>Collect\<close>, [@{thm CollectD1}, @{thm CollectD2}]),
+ (\<^const_name>\<open>Diff\<close>, [@{thm DiffD1}, @{thm DiffD2}]),
+ (\<^const_name>\<open>Int\<close>, [@{thm IntD1}, @{thm IntD2}])];
val ZF_atomize = atomize (ZF_conn_pairs, ZF_mem_pairs);
--- a/src/ZF/upair.thy Fri Jan 04 21:49:06 2019 +0100
+++ b/src/ZF/upair.thy Fri Jan 04 23:22:53 2019 +0100
@@ -23,7 +23,7 @@
by (simp add: Ball_def atomize_all atomize_imp)
-subsection\<open>Unordered Pairs: constant @{term Upair}\<close>
+subsection\<open>Unordered Pairs: constant \<^term>\<open>Upair\<close>\<close>
lemma Upair_iff [simp]: "c \<in> Upair(a,b) \<longleftrightarrow> (c=a | c=b)"
by (unfold Upair_def, blast)
@@ -37,7 +37,7 @@
lemma UpairE: "[| a \<in> Upair(b,c); a=b ==> P; a=c ==> P |] ==> P"
by (simp, blast)
-subsection\<open>Rules for Binary Union, Defined via @{term Upair}\<close>
+subsection\<open>Rules for Binary Union, Defined via \<^term>\<open>Upair\<close>\<close>
lemma Un_iff [simp]: "c \<in> A \<union> B \<longleftrightarrow> (c \<in> A | c \<in> B)"
apply (simp add: Un_def)
@@ -63,7 +63,7 @@
lemma UnCI [intro!]: "(c \<notin> B ==> c \<in> A) ==> c \<in> A \<union> B"
by (simp, blast)
-subsection\<open>Rules for Binary Intersection, Defined via @{term Upair}\<close>
+subsection\<open>Rules for Binary Intersection, Defined via \<^term>\<open>Upair\<close>\<close>
lemma Int_iff [simp]: "c \<in> A \<inter> B \<longleftrightarrow> (c \<in> A & c \<in> B)"
apply (unfold Int_def)
@@ -83,7 +83,7 @@
by simp
-subsection\<open>Rules for Set Difference, Defined via @{term Upair}\<close>
+subsection\<open>Rules for Set Difference, Defined via \<^term>\<open>Upair\<close>\<close>
lemma Diff_iff [simp]: "c \<in> A-B \<longleftrightarrow> (c \<in> A & c\<notin>B)"
by (unfold Diff_def, blast)
@@ -101,7 +101,7 @@
by simp
-subsection\<open>Rules for @{term cons}\<close>
+subsection\<open>Rules for \<^term>\<open>cons\<close>\<close>
lemma cons_iff [simp]: "a \<in> cons(b,A) \<longleftrightarrow> (a=b | a \<in> A)"
apply (unfold cons_def)
@@ -406,7 +406,7 @@
subsection\<open>Miniscoping of the Replacement Operator\<close>
-text\<open>These cover both @{term Replace} and @{term Collect}\<close>
+text\<open>These cover both \<^term>\<open>Replace\<close> and \<^term>\<open>Collect\<close>\<close>
lemma Rep_simps [simp]:
"{x. y \<in> 0, R(x,y)} = 0"
"{x \<in> 0. P(x)} = 0"