more scalable operations;
authorwenzelm
Thu, 09 Sep 2021 21:37:42 +0200
changeset 74625 57b323e20763
parent 74624 aed955bb4cb1
child 74626 8cff7900871f
more scalable operations;
src/Pure/Isar/expression.ML
--- a/src/Pure/Isar/expression.ML	Thu Sep 09 21:14:05 2021 +0200
+++ b/src/Pure/Isar/expression.ML	Thu Sep 09 21:37:42 2021 +0200
@@ -693,15 +693,17 @@
     val thy_ctxt = Proof_Context.init_global thy;
 
     val (body, bodyT, body_eq) = atomize_spec thy_ctxt norm_ts;
-    val env = Term.add_free_names body [];
-    val xs = filter (member (op =) env o #1) parms;
+    val env = Names.build (Names.add_free_names body);
+    val xs = filter (Names.defined env o #1) parms;
     val Ts = map #2 xs;
-    val extraTs =
-      (subtract (op =) (fold Term.add_tfreesT Ts []) (Term.add_tfrees body []))
-      |> sort_by #1 |> map TFree;
-    val predT = map Term.itselfT extraTs ---> Ts ---> bodyT;
+    val type_tfrees = TFrees.build (fold TFrees.add_tfreesT Ts);
+    val extra_tfrees =
+      TFrees.build (body |> (Term.fold_types o Term.fold_atyps)
+        (fn TFree v => not (TFrees.defined type_tfrees v) ? TFrees.add_set v | _ => I))
+      |> TFrees.list_set |> sort_by #1 |> map TFree;
+    val predT = map Term.itselfT extra_tfrees ---> Ts ---> bodyT;
 
-    val args = map Logic.mk_type extraTs @ map Free xs;
+    val args = map Logic.mk_type extra_tfrees @ map Free xs;
     val head = Term.list_comb (Const (name, predT), args);
     val statement = Object_Logic.ensure_propT thy_ctxt head;
 
@@ -813,10 +815,11 @@
       |> prep_decl raw_import I raw_body;
     val text as (((_, exts'), _), defs) = eval ctxt' deps body_elems;
 
-    val extraTs =
-      subtract (op =)
-        (fold Term.add_tfreesT (map snd parms) [])
-        (fold Term.add_tfrees exts' []);
+    val type_tfrees = TFrees.build (fold TFrees.add_tfreesT (map snd parms));
+    val extra_tfrees =
+      TFrees.build (exts' |> (fold o Term.fold_types o Term.fold_atyps)
+        (fn TFree v => not (TFrees.defined type_tfrees v) ? TFrees.add_set v | _ => I));
+    val extraTs = TFrees.list_set_rev extra_tfrees;
     val _ =
       if null extraTs then ()
       else warning ("Additional type variable(s) in locale specification " ^