minor tuning and clarification;
authorwenzelm
Wed, 21 Feb 2018 16:26:42 +0100
changeset 67696 3d8d4f6d1d64
parent 67695 29d0f173b537
child 67697 58f951ce71c8
minor tuning and clarification;
src/Pure/Isar/expression.ML
--- a/src/Pure/Isar/expression.ML	Tue Feb 20 23:23:40 2018 +0100
+++ b/src/Pure/Isar/expression.ML	Wed Feb 21 16:26:42 2018 +0100
@@ -169,22 +169,27 @@
 fun inst_morphism (parm_names, parm_types) ((prfx, mandatory), insts') ctxt =
   let
     (* parameters *)
-    val type_parm_names = fold Term.add_tfreesT parm_types [] |> map fst;
+    val type_parms = fold Term.add_tfreesT parm_types [];
 
-    (* type inference and contexts *)
+    (* type inference and context *)
     val parm_types' = map (Type_Infer.paramify_vars o Logic.varifyT_global) parm_types;
-    val type_parms = fold Term.add_tvarsT parm_types' [] |> map (Logic.mk_type o TVar);
-    val arg = type_parms @ map2 Type.constraint parm_types' insts';
-    val res = Syntax.check_terms (Config.put Type_Infer.object_logic false ctxt) arg;
-    val ctxt' = ctxt |> fold Variable.auto_fixes res;
+    val type_parms' = fold Term.add_tvarsT parm_types' [];
+    val checked =
+      (map (Logic.mk_type o TVar) type_parms' @ map2 Type.constraint parm_types' insts')
+      |> Syntax.check_terms (Config.put Type_Infer.object_logic false ctxt)
+    val (type_parms'', insts'') = chop (length type_parms') checked;
+
+    val ctxt' = ctxt |> fold Variable.auto_fixes checked;
 
     (* instantiation *)
-    val (type_parms'', res') = chop (length type_parms) res;
-    val insts'' = (parm_names ~~ res') |> map_filter
-      (fn inst as (x, Free (y, _)) => if x = y then NONE else SOME inst
-        | inst => SOME inst);
-    val instT = Symtab.make (type_parm_names ~~ map Logic.dest_type type_parms'');
-    val inst = Symtab.make insts'';
+    val instT =
+      (type_parms ~~ map Logic.dest_type type_parms'')
+      |> map_filter (fn (v, T) => if TFree v = T then NONE else SOME (#1 v, T))
+      |> Symtab.make;
+    val inst =
+      (parm_names ~~ insts'')
+      |> filter (fn (a, Free (b, _)) => a <> b | _ => true)
+      |> Symtab.make;
   in
     (Element.inst_morphism (Proof_Context.theory_of ctxt) (instT, inst) $>
       Morphism.binding_morphism "Expression.inst" (Binding.prefix mandatory prfx), ctxt')