tuned signature;
authorwenzelm
Mon, 29 Jul 2019 10:26:12 +0200
changeset 70435 52fbcf7a61f8
parent 70432 495881aadbff
child 70436 251f1fb44ccd
tuned signature;
src/HOL/Types_To_Sets/internalize_sort.ML
src/Pure/Proof/extraction.ML
src/Pure/Proof/reconstruct.ML
src/Pure/logic.ML
src/Pure/proofterm.ML
--- a/src/HOL/Types_To_Sets/internalize_sort.ML	Sun Jul 28 15:39:30 2019 +0200
+++ b/src/HOL/Types_To_Sets/internalize_sort.ML	Mon Jul 29 10:26:12 2019 +0200
@@ -31,7 +31,8 @@
     val thy = Thm.theory_of_thm thm;
     val tvar = Thm.typ_of ctvar;
 
-    val ((_, assms, classes),_) = Logic.unconstrainT [] (Thm.prop_of thm);
+    val {constraints = assms, outer_constraints = classes, ...} =
+      Logic.unconstrainT [] (Thm.prop_of thm);
 
     fun is_proper_class thy = can (Axclass.get_info thy); (* trick by FH *)
     fun reduce_to_non_proper_sort (TVar (name, sort)) =
--- a/src/Pure/Proof/extraction.ML	Sun Jul 28 15:39:30 2019 +0200
+++ b/src/Pure/Proof/extraction.ML	Mon Jul 29 10:26:12 2019 +0200
@@ -365,7 +365,7 @@
 fun abs_corr_shyps thy thm vs xs prf =
   let
     val S = Sign.defaultS thy;
-    val ((atyp_map, constraints, _), prop') =
+    val {atyp_map, constraints, prop = prop', ...} =
       Logic.unconstrainT (Thm.shyps_of thm) (Thm.prop_of thm);
     val atyps = fold_types (fold_atyps (insert (op =))) (Thm.prop_of thm) [];
     val Ts = map_filter (fn ((v, i), _) => if member (op =) vs v then
--- a/src/Pure/Proof/reconstruct.ML	Sun Jul 28 15:39:30 2019 +0200
+++ b/src/Pure/Proof/reconstruct.ML	Mon Jul 29 10:26:12 2019 +0200
@@ -379,7 +379,7 @@
 
 fun clean_proof_of ctxt full thm =
   let
-    val (_, prop) =
+    val {prop, ...} =
       Logic.unconstrainT (Thm.shyps_of thm)
         (Logic.list_implies (Thm.hyps_of thm, Thm.prop_of thm));
   in
--- a/src/Pure/logic.ML	Sun Jul 28 15:39:30 2019 +0200
+++ b/src/Pure/logic.ML	Mon Jul 29 10:26:12 2019 +0200
@@ -57,7 +57,10 @@
   val mk_arity: string * sort list * class -> term
   val dest_arity: term -> string * sort list * class
   val unconstrainT: sort list -> term ->
-    ((typ -> typ) * ((typ * class) * term) list * (typ * class) list) * term
+   {atyp_map: typ -> typ,
+    constraints: ((typ * class) * term) list,
+    outer_constraints: (typ * class) list,
+    prop: term}
   val protectC: term
   val protect: term -> term
   val unprotect: term -> term
@@ -374,7 +377,12 @@
       prop
       |> (Term.map_types o Term.map_atyps) (Type.strip_sorts o atyp_map)
       |> curry list_implies (map snd constraints);
-  in ((atyp_map, constraints, outer_constraints), prop') end;
+  in
+   {atyp_map = atyp_map,
+    constraints = constraints,
+    outer_constraints = outer_constraints,
+    prop = prop'}
+  end;
 
 
 
--- a/src/Pure/proofterm.ML	Sun Jul 28 15:39:30 2019 +0200
+++ b/src/Pure/proofterm.ML	Mon Jul 29 10:26:12 2019 +0200
@@ -1719,7 +1719,8 @@
     val prop = Logic.list_implies (hyps, concl);
     val args = prop_args prop;
 
-    val ((atyp_map, constraints, outer_constraints), prop1) = Logic.unconstrainT shyps prop;
+    val {atyp_map, constraints, outer_constraints, prop = prop1, ...} =
+      Logic.unconstrainT shyps prop;
     val args1 =
       (map o Option.map o Term.map_types o Term.map_atyps)
         (Type.strip_sorts o atyp_map) args;
@@ -1771,7 +1772,7 @@
 (* approximative PThm name *)
 
 fun get_name shyps hyps prop prf =
-  let val (_, prop) = Logic.unconstrainT shyps (Logic.list_implies (hyps, prop)) in
+  let val {prop, ...} = Logic.unconstrainT shyps (Logic.list_implies (hyps, prop)) in
     (case strip_combt (fst (strip_combP prf)) of
       (PThm (_, ((name, prop', _, _), _)), _) => if prop = prop' then name else ""
     | _ => "")