clarified signature: more operations;
authorwenzelm
Sat, 30 Dec 2023 22:36:41 +0100
changeset 79399 11b53e039f6f
parent 79398 a9fb2bc71435
child 79400 0824ca1f1da0
clarified signature: more operations;
src/HOL/Tools/SMT/z3_proof.ML
src/HOL/Tools/Sledgehammer/sledgehammer.ML
src/Pure/Proof/extraction.ML
src/Pure/logic.ML
src/Pure/term_subst.ML
src/Pure/type_infer.ML
--- a/src/HOL/Tools/SMT/z3_proof.ML	Sat Dec 30 22:16:18 2023 +0100
+++ b/src/HOL/Tools/SMT/z3_proof.ML	Sat Dec 30 22:36:41 2023 +0100
@@ -226,7 +226,7 @@
     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
+  in Term_Subst.map_types (substTs_same subst) t' end
 
 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
--- a/src/HOL/Tools/Sledgehammer/sledgehammer.ML	Sat Dec 30 22:16:18 2023 +0100
+++ b/src/HOL/Tools/Sledgehammer/sledgehammer.ML	Sat Dec 30 22:36:41 2023 +0100
@@ -73,11 +73,11 @@
   | alternative _ NONE (y as SOME _) = y
   | alternative _ NONE NONE = NONE
 
-fun varify_nonfixed_terms_global nonfixeds tm = tm
-  |> Same.commit (Term_Subst.map_aterms_same
+fun varify_nonfixed_terms_global nonfixeds tm =
+  tm |> Term_Subst.map_aterms
     (fn Free (x, T) => if member (op =) nonfixeds x then Var ((x, 0), T) else raise Same.SAME
       | Var (xi, _) => raise TERM (Logic.bad_schematic xi, [tm])
-      | _ => raise Same.SAME))
+      | _ => raise Same.SAME)
 
 fun max_outcome outcomes =
   let
--- a/src/Pure/Proof/extraction.ML	Sat Dec 30 22:16:18 2023 +0100
+++ b/src/Pure/Proof/extraction.ML	Sat Dec 30 22:36:41 2023 +0100
@@ -390,10 +390,10 @@
     val cs = maps (fn T => map (pair T) S) Ts;
     val constraints' = map Logic.mk_of_class cs;
     val typ_map = Type.strip_sorts o
-      Same.commit (Term_Subst.map_atypsT_same (fn U =>
+      Term_Subst.map_atypsT (fn U =>
         if member (op =) atyps U
         then #unconstrain_typ ucontext {strip_sorts = false} U
-        else raise Same.SAME));
+        else raise Same.SAME);
     fun mk_hyp (T, c) = Hyp (Logic.mk_of_class (typ_map T, c));
     val xs' = map (map_types typ_map) xs
   in
--- a/src/Pure/logic.ML	Sat Dec 30 22:16:18 2023 +0100
+++ b/src/Pure/logic.ML	Sat Dec 30 22:36:41 2023 +0100
@@ -404,7 +404,7 @@
       constraints = constraints,
       outer_constraints = outer_constraints};
     val prop' = prop
-      |> Same.commit (Term_Subst.map_types_same (unconstrain_typ {strip_sorts = true}))
+      |> Term_Subst.map_types (unconstrain_typ {strip_sorts = true})
       |> curry list_implies (map #2 constraints);
   in (ucontext, prop') end;
 
@@ -627,27 +627,27 @@
 val varifyT_global = Same.commit varifyT_global_same;
 val unvarifyT_global = Same.commit unvarifyT_global_same;
 
-fun varify_types_global tm = tm
-  |> Same.commit (Term_Subst.map_types_same varifyT_global_same)
-  handle TYPE (msg, _, _) => raise TERM (msg, [tm]);
+fun varify_types_global tm =
+  Term_Subst.map_types varifyT_global_same tm
+    handle TYPE (msg, _, _) => raise TERM (msg, [tm]);
 
-fun unvarify_types_global tm = tm
-  |> Same.commit (Term_Subst.map_types_same unvarifyT_global_same)
-  handle TYPE (msg, _, _) => raise TERM (msg, [tm]);
+fun unvarify_types_global tm =
+  Term_Subst.map_types unvarifyT_global_same tm
+    handle TYPE (msg, _, _) => raise TERM (msg, [tm]);
 
 fun varify_global tm = tm
-  |> Same.commit (Term_Subst.map_aterms_same
+  |> Term_Subst.map_aterms
     (fn Free (x, T) => Var ((x, 0), T)
       | Var (xi, _) => raise TERM (bad_schematic xi, [tm])
-      | _ => raise Same.SAME))
+      | _ => raise Same.SAME)
   |> varify_types_global;
 
 fun unvarify_global tm = tm
-  |> Same.commit (Term_Subst.map_aterms_same
+  |> Term_Subst.map_aterms
     (fn Var ((x, 0), T) => Free (x, T)
       | Var (xi, _) => raise TERM (bad_schematic xi, [tm])
       | Free (x, _) => raise TERM (bad_fixed x, [tm])
-      | _ => raise Same.SAME))
+      | _ => raise Same.SAME)
   |> unvarify_types_global;
 
 
--- a/src/Pure/term_subst.ML	Sat Dec 30 22:16:18 2023 +0100
+++ b/src/Pure/term_subst.ML	Sat Dec 30 22:36:41 2023 +0100
@@ -9,6 +9,9 @@
   val map_atypsT_same: typ Same.operation -> typ Same.operation
   val map_types_same: typ Same.operation -> term Same.operation
   val map_aterms_same: term Same.operation -> term Same.operation
+  val map_atypsT: typ Same.operation -> typ -> typ
+  val map_types: typ Same.operation -> term -> term
+  val map_aterms: term Same.operation -> term -> term
   val generalizeT_same: Names.set -> int -> typ Same.operation
   val generalize_same: Names.set * Names.set -> int -> term Same.operation
   val generalizeT: Names.set -> int -> typ -> typ
@@ -63,6 +66,10 @@
       | term a = f a;
   in term end;
 
+val map_atypsT = Same.commit o map_atypsT_same;
+val map_types = Same.commit o map_types_same;
+val map_aterms = Same.commit o map_aterms_same;
+
 
 (* generalization of fixed variables *)
 
--- a/src/Pure/type_infer.ML	Sat Dec 30 22:16:18 2023 +0100
+++ b/src/Pure/type_infer.ML	Sat Dec 30 22:36:41 2023 +0100
@@ -48,9 +48,7 @@
 fun anyT S = TFree ("'_dummy_", S);
 
 val paramify_vars =
-  Same.commit
-    (Term_Subst.map_atypsT_same
-      (fn TVar ((x, i), S) => (param i (x, S)) | _ => raise Same.SAME));
+  Term_Subst.map_atypsT (fn TVar ((x, i), S) => (param i (x, S)) | _ => raise Same.SAME);