# HG changeset patch # User wenzelm # Date 1320964250 -3600 # Node ID 018f8959c7a6d6430c08553d5e9c0919c94e87b8 # Parent a97251eea45852a0fd008db98398058785544b3d more efficient prepare_sorts -- bypass encoded positions; diff -r a97251eea458 -r 018f8959c7a6 src/Pure/Syntax/syntax_phases.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 _ = diff -r a97251eea458 -r 018f8959c7a6 src/Pure/Syntax/term_position.ML --- 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