more efficient prepare_sorts -- bypass encoded positions;
authorwenzelm
Thu, 10 Nov 2011 23:30:50 +0100
changeset 45448 018f8959c7a6
parent 45447 a97251eea458
child 45449 eeffd04cd899
more efficient prepare_sorts -- bypass encoded positions;
src/Pure/Syntax/syntax_phases.ML
src/Pure/Syntax/term_position.ML
--- a/src/Pure/Syntax/syntax_phases.ML	Thu Nov 10 22:54:15 2011 +0100
+++ b/src/Pure/Syntax/syntax_phases.ML	Thu Nov 10 23:30:50 2011 +0100
@@ -809,9 +809,13 @@
     val get_sort = Proof_Context.get_sort ctxt env;
   in
     (map o map_atyps)
-      (fn TFree (x, _) => TFree (x, get_sort (x, ~1))
-        | TVar (xi, _) => TVar (xi, get_sort xi)
-        | T => T) tys
+      (fn T =>
+        if Term_Position.is_positionT T then T
+        else
+          (case T of
+            TFree (x, _) => TFree (x, get_sort (x, ~1))
+          | TVar (xi, _) => TVar (xi, get_sort xi)
+          | _ => T)) tys
   end;
 
 in
@@ -823,10 +827,11 @@
 
 fun check_terms ctxt raw_ts =
   let
-    val (ts, ps) = Type_Infer_Context.prepare_positions ctxt raw_ts;
+    val (ts, ps) = raw_ts
+      |> Term.burrow_types (prepare_sorts ctxt)
+      |> Type_Infer_Context.prepare_positions ctxt;
     val tys = map (Logic.mk_type o snd) ps;
-    val (ts', tys') =
-      Term.burrow_types (prepare_sorts ctxt) ts @ tys
+    val (ts', tys') = ts @ tys
       |> apply_term_check ctxt
       |> chop (length ts);
     val _ =
--- a/src/Pure/Syntax/term_position.ML	Thu Nov 10 22:54:15 2011 +0100
+++ b/src/Pure/Syntax/term_position.ML	Thu Nov 10 23:30:50 2011 +0100
@@ -12,6 +12,7 @@
   val decode_position: term -> (Position.T * typ) option
   val decode_positionT: typ -> Position.T option
   val is_position: term -> bool
+  val is_positionT: typ -> bool
   val strip_positions: term -> term
 end;
 
@@ -50,6 +51,7 @@
   | decode_positionT _ = NONE;
 
 val is_position = is_some o decode_position;
+val is_positionT = is_some o decode_positionT;
 
 fun strip_positions ((t as Const (c, _)) $ u $ v) =
       if (c = "_constrain" orelse c = "_constrainAbs") andalso is_position v