# HG changeset patch
# User paulson
# Date 1331571449 0
# Node ID d4fdc61d9336446778cd86efcbd4689f3aeeb6cb
# Parent  8f3bb485f6283429b5bd616a79dd1628e5392e23# Parent  059d20d08ff1233471c409326eb635212ceb818b
merged

diff -r 059d20d08ff1 -r d4fdc61d9336 Admin/polyml/build
--- a/Admin/polyml/build	Mon Mar 12 16:14:25 2012 +0000
+++ b/Admin/polyml/build	Mon Mar 12 16:57:29 2012 +0000
@@ -51,14 +51,14 @@
     OPTIONS=()
     ;;
   x86-darwin)
-    OPTIONS=(--build=i686-darwin CFLAGS='-arch i686 -O3'
-      CXXFLAGS='-arch i686 -O3' CCASFLAGS='-arch i686 -O3'
+    OPTIONS=(--build=i686-darwin CFLAGS='-arch i686 -O3 -I../libffi/include'
+      CXXFLAGS='-arch i686 -O3 -I../libffi/include' CCASFLAGS='-arch i686 -O3'
       LDFLAGS='-segprot POLY rwx rwx')
     ;;
   x86_64-darwin)
-    OPTIONS=(--build=x86_64-darwin CFLAGS='-arch x86_64 -O3'
-      CXXFLAGS='-arch x86_64 -O3' CCASFLAGS='-arch x86_64'
-      LDFLAGS='-segprot POLY rwx rwx')
+   OPTIONS=(--build=x86_64-darwin CFLAGS='-arch x86_64 -O3 -I../libffi/include'
+     CXXFLAGS='-arch x86_64 -O3 -I../libffi/include' CCASFLAGS='-arch x86_64'
+     LDFLAGS='-segprot POLY rwx rwx')
     ;;
   x86-cygwin)
     OPTIONS=()
diff -r 059d20d08ff1 -r d4fdc61d9336 src/Provers/classical.ML
--- a/src/Provers/classical.ML	Mon Mar 12 16:14:25 2012 +0000
+++ b/src/Provers/classical.ML	Mon Mar 12 16:57:29 2012 +0000
@@ -301,9 +301,9 @@
     error ("Ill-formed destruction rule\n" ^ string_of_thm context th)
   else Tactic.make_elim th;
 
-fun warn_thm context msg th =
-  if (case context of SOME (Context.Proof ctxt) => Context_Position.is_visible ctxt | _ => false)
-  then warning (msg ^ string_of_thm context th)
+fun warn_thm opt_context msg th =
+  if (case opt_context of SOME context => Context_Position.is_visible_proof context | NONE => false)
+  then warning (msg ^ string_of_thm opt_context th)
   else ();
 
 fun warn_rules context msg rules th =
diff -r 059d20d08ff1 -r d4fdc61d9336 src/Pure/Isar/outer_syntax.ML
--- a/src/Pure/Isar/outer_syntax.ML	Mon Mar 12 16:14:25 2012 +0000
+++ b/src/Pure/Isar/outer_syntax.ML	Mon Mar 12 16:57:29 2012 +0000
@@ -34,7 +34,7 @@
   val process_file: Path.T -> theory -> theory
   type isar
   val isar: TextIO.instream -> bool -> isar
-  val read_command: Position.T -> string -> Toplevel.transition
+  val read_span: outer_syntax -> Token.T list -> Toplevel.transition * bool
   val read_element: outer_syntax -> (unit -> theory) -> Thy_Syntax.element ->
     (Toplevel.transition * Toplevel.transition list) list
 end;
@@ -270,12 +270,6 @@
     handle ERROR msg => (Toplevel.malformed range_pos msg, true)
   end;
 
-fun read_command pos str =
-  let
-    val (lexs, outer_syntax) = get_syntax ();
-    val toks = Thy_Syntax.parse_tokens lexs pos str;
-  in #1 (read_span outer_syntax toks) end;
-
 fun read_element outer_syntax init {head, proof, proper_proof} =
   let
     val read = read_span outer_syntax o Thy_Syntax.span_content;
diff -r 059d20d08ff1 -r d4fdc61d9336 src/Pure/PIDE/document.ML
--- a/src/Pure/PIDE/document.ML	Mon Mar 12 16:14:25 2012 +0000
+++ b/src/Pure/PIDE/document.ML	Mon Mar 12 16:57:29 2012 +0000
@@ -240,7 +240,7 @@
 
 abstype state = State of
  {versions: version Inttab.table,  (*version_id -> document content*)
-  commands: (string * Toplevel.transition future) Inttab.table,  (*command_id -> name * transition*)
+  commands: (string * Token.T list future) Inttab.table,  (*command_id -> name * span*)
   execution: version_id * Future.group}  (*current execution process*)
 with
 
@@ -273,17 +273,18 @@
 
 (* commands *)
 
+fun tokenize_command id text =
+  Position.setmp_thread_data (Position.id_only id)
+    (fn () => Thy_Syntax.parse_tokens (#1 (Outer_Syntax.get_syntax ())) (Position.id id) text) ();
+
 fun define_command (id: command_id) name text =
   map_state (fn (versions, commands, execution) =>
     let
-      val id_string = print_id id;
       val future =
         (singleton o Future.forks)
           {name = "Document.define_command", group = SOME (Future.new_group NONE),
             deps = [], pri = ~1, interrupts = false}
-          (fn () =>
-            Position.setmp_thread_data (Position.id_only id_string)
-              (fn () => Outer_Syntax.read_command (Position.id id_string) text) ());
+          (fn () => tokenize_command (print_id id) text);
       val commands' =
         Inttab.update_new (id, (name, future)) commands
           handle Inttab.DUP dup => err_dup "command" dup;
@@ -408,16 +409,20 @@
   if bad_init andalso is_none init then NONE
   else
     let
-      val (name, tr0) = the_command state command_id' ||> Future.join;
+      val (name, span) = the_command state command_id' ||> Future.join;
       val (modify_init, init') =
         if Keyword.is_theory_begin name then
           (Toplevel.modify_init (the_default illegal_init init), NONE)
         else (I, init);
       val exec_id' = new_id ();
-      val tr = tr0
-        |> modify_init
-        |> Toplevel.put_id (print_id exec_id');
-      val exec' = snd (snd command_exec) |> Lazy.map (fn (st, _) => run_command tr st);
+      val exec_id'_string = print_id exec_id';
+      val tr =
+        Position.setmp_thread_data (Position.id_only exec_id'_string)
+          (fn () =>
+            #1 (Outer_Syntax.read_span (#2 (Outer_Syntax.get_syntax ())) span)
+            |> modify_init
+            |> Toplevel.put_id exec_id'_string);
+      val exec' = snd (snd command_exec) |> Lazy.map (fn (st, _) => run_command (tr ()) st);
       val command_exec' = (command_id', (exec_id', exec'));
     in SOME (command_exec' :: execs, command_exec', init') end;
 
diff -r 059d20d08ff1 -r d4fdc61d9336 src/Pure/context_position.ML
--- a/src/Pure/context_position.ML	Mon Mar 12 16:14:25 2012 +0000
+++ b/src/Pure/context_position.ML	Mon Mar 12 16:57:29 2012 +0000
@@ -10,6 +10,7 @@
   val set_visible: bool -> Proof.context -> Proof.context
   val restore_visible: Proof.context -> Proof.context -> Proof.context
   val if_visible: Proof.context -> ('a -> unit) -> 'a -> unit
+  val is_visible_proof: Context.generic -> bool
   val if_visible_proof: Context.generic -> ('a -> unit) -> 'a -> unit
   val reported_text: Proof.context -> Position.T -> Markup.T -> string -> string
   val report_text: Proof.context -> Position.T -> Markup.T -> string -> unit
@@ -27,8 +28,10 @@
 
 fun if_visible ctxt f x = if is_visible ctxt then f x else ();
 
-fun if_visible_proof (Context.Proof ctxt) f x = if_visible ctxt f x
-  | if_visible_proof _ _ _ = ();
+fun is_visible_proof (Context.Proof ctxt) = is_visible ctxt
+  | is_visible_proof _ = false;
+
+fun if_visible_proof context f x = if is_visible_proof context then f x else ();
 
 fun reported_text ctxt pos markup txt =
   if is_visible ctxt then Position.reported_text pos markup txt else "";
diff -r 059d20d08ff1 -r d4fdc61d9336 src/Pure/type_infer_context.ML
--- a/src/Pure/type_infer_context.ML	Mon Mar 12 16:14:25 2012 +0000
+++ b/src/Pure/type_infer_context.ML	Mon Mar 12 16:57:29 2012 +0000
@@ -118,18 +118,14 @@
 
 fun prepare_positions ctxt tms =
   let
-    val visible = Context_Position.is_visible ctxt;
-
     fun prepareT (Type (a, Ts)) ps_idx =
           let val (Ts', ps_idx') = fold_map prepareT Ts ps_idx
           in (Type (a, Ts'), ps_idx') end
       | prepareT T (ps, idx) =
           (case Term_Position.decode_positionT T of
             SOME pos =>
-              if visible then
-                let val U = Type_Infer.mk_param idx []
-                in (U, ((pos, U) :: ps, idx + 1)) end
-              else (dummyT, (ps, idx))
+              let val U = Type_Infer.mk_param idx []
+              in (U, ((pos, U) :: ps, idx + 1)) end
           | NONE => (T, (ps, idx)));
 
     fun prepare (Const ("_type_constraint_", T)) ps_idx =