marked some CRITICAL sections;
authorwenzelm
Mon, 23 Jul 2007 20:47:56 +0200
changeset 23944 2ea068548a83
parent 23943 1b5f77bc146a
child 23945 622641164de8
marked some CRITICAL sections;
src/Pure/Thy/present.ML
src/Pure/Thy/thy_load.ML
src/Pure/context.ML
--- a/src/Pure/Thy/present.ML	Mon Jul 23 20:47:55 2007 +0200
+++ b/src/Pure/Thy/present.ML	Mon Jul 23 20:47:56 2007 +0200
@@ -172,7 +172,7 @@
 (* state *)
 
 val browser_info = ref empty_browser_info;
-fun change_browser_info f = browser_info := map_browser_info f (! browser_info);
+fun change_browser_info f = CRITICAL (fn () => change browser_info (map_browser_info f));
 
 val suppress_tex_source = ref false;
 fun no_document f x = Library.setmp suppress_tex_source true f x;
@@ -290,7 +290,7 @@
 fun name_of_session elems = space_implode "/" ("Isabelle" :: elems);
 
 fun init build info doc doc_graph doc_versions path name doc_prefix2
-    (remote_path, first_time) verbose thys =
+    (remote_path, first_time) verbose thys = CRITICAL (fn () =>
   if not build andalso not info andalso doc = "" andalso is_none doc_prefix2 then
     (browser_info := empty_browser_info; session_info := NONE)
   else
@@ -327,7 +327,7 @@
       info, doc, doc_graph, documents, doc_prefix1, doc_prefix2, remote_path, verbose, readme));
       browser_info := init_browser_info remote_path path thys;
       add_html_index index_text
-    end;
+    end);
 
 
 (* isatool wrappers *)
@@ -371,8 +371,9 @@
   write_tex (Buffer.add Latex.tex_trailer tex_index) doc_indexN path;
 
 
-fun finish () = with_session () (fn {name, info, html_prefix, doc_format, doc_graph,
-    documents, doc_prefix1, doc_prefix2, path, verbose, readme, ...} =>
+fun finish () = CRITICAL (fn () =>
+    with_session () (fn {name, info, html_prefix, doc_format, doc_graph,
+      documents, doc_prefix1, doc_prefix2, path, verbose, readme, ...} =>
   let
     val {theories, files, tex_index, html_index, graph} = ! browser_info;
     val thys = Symtab.dest theories;
@@ -429,7 +430,7 @@
 
     browser_info := empty_browser_info;
     session_info := NONE
-  end);
+  end));
 
 
 (* theory elements *)
@@ -503,7 +504,7 @@
 
 
 val hooks = ref ([]: (string -> (string * thm list) list -> unit) list);
-fun add_hook f = hooks := (f :: ! hooks);
+fun add_hook f = CRITICAL (fn () => change hooks (cons f));
 
 fun results k xs =
  (List.app (fn f => (try (fn () => f k xs) (); ())) (! hooks);
--- a/src/Pure/Thy/thy_load.ML	Mon Jul 23 20:47:55 2007 +0200
+++ b/src/Pure/Thy/thy_load.ML	Mon Jul 23 20:47:56 2007 +0200
@@ -46,16 +46,25 @@
 
 (* maintain load path *)
 
-val load_path = ref [Path.current];
+local val load_path = ref [Path.current] in
 
 fun show_path () = map Path.implode (! load_path);
-fun del_path s = change load_path (remove (op =) (Path.explode s));
-fun add_path s = (del_path s; change load_path (cons (Path.explode s)));
-fun path_add s = (del_path s; change load_path (fn path => path @ [Path.explode s]));
+
+fun del_path s = CRITICAL (fn () => change load_path (remove (op =) (Path.explode s)));
+fun add_path s = CRITICAL (fn () => (del_path s; change load_path (cons (Path.explode s))));
+fun path_add s =
+  CRITICAL (fn () => (del_path s; change load_path (fn path => path @ [Path.explode s])));
 fun reset_path () = load_path := [Path.current];
-fun with_paths ss f x = Library.setmp load_path (! load_path @ map Path.explode ss) f x;
+
+fun with_paths ss f x =
+  CRITICAL (fn () => Library.setmp load_path (! load_path @ map Path.explode ss) f x);
 fun with_path s f x = with_paths [s] f x;
 
+fun search_path dir path =
+  distinct (op =) (dir :: (if Path.is_basic path then (! load_path) else [Path.current]));
+
+end;
+
 
 (* file formats *)
 
@@ -66,10 +75,7 @@
 
 (* check files *)
 
-fun search_path dir path =
-  distinct (op =) (dir :: (if Path.is_basic path then (! load_path) else [Path.current]));
-
-fun check_ext exts dir src_path =
+fun check_ext exts paths dir src_path =
   let
     val path = Path.expand src_path;
     val _ = Path.is_current path andalso error "Bad file specification";
@@ -78,16 +84,19 @@
       let val ext_path = Path.expand (Path.ext ext rel_path)
       in Option.map (fn id => (File.full_path ext_path, id)) (File.ident ext_path) end;
     fun try_prfx prfx = get_first (try_ext (Path.append prfx path)) ("" :: exts);
-  in get_first try_prfx (search_path dir path) end;
+  in get_first try_prfx paths end;
 
-val check_file = check_ext [];
-val check_ml = check_ext ml_exts;
+fun check_file dir path = check_ext [] (search_path dir path) dir path;
+fun check_ml dir path = check_ext ml_exts (search_path dir path) dir path;
 
 fun check_thy dir name ml =
-  let val thy_file = thy_path name in
-    (case check_file dir thy_file of
+  let
+    val thy_file = thy_path name;
+    val paths = search_path dir thy_file;
+  in
+    (case check_ext [] paths dir thy_file of
       NONE => error ("Could not find theory file " ^ quote (Path.implode thy_file) ^
-        " in " ^ commas_quote (map Path.implode (search_path dir thy_file)))
+        " in " ^ commas_quote (map Path.implode paths))
     | SOME thy_id => (thy_id, if ml then check_file dir (ml_path name) else NONE))
   end;
 
--- a/src/Pure/context.ML	Mon Jul 23 20:47:55 2007 +0200
+++ b/src/Pure/context.ML	Mon Jul 23 20:47:56 2007 +0200
@@ -126,7 +126,7 @@
   let
     val k = serial ();
     val kind = {empty = empty, copy = copy, extend = extend, merge = merge};
-    val _ = change kinds (Datatab.update (k, kind));
+    val _ = CRITICAL (fn () => change kinds (Datatab.update (k, kind)));
   in k end;
 
 val copy_data = Datatab.map' invoke_copy;
@@ -449,7 +449,7 @@
 fun declare init =
   let
     val k = serial ();
-    val _ = change kinds (Datatab.update (k, init));
+    val _ = CRITICAL (fn () => change kinds (Datatab.update (k, init)));
   in k end;
 
 fun get k dest prf =
@@ -494,8 +494,8 @@
 local
   val setup_fn = ref (I: theory -> theory);
 in
-  fun add_setup f = setup_fn := (! setup_fn #> f);
-  fun setup () = let val f = ! setup_fn in setup_fn := I; f end;
+  fun add_setup f = CRITICAL (fn () => setup_fn := (! setup_fn #> f));
+  fun setup () = CRITICAL (fn () => let val f = ! setup_fn in setup_fn := I; f end);
 end;
 
 end;