# HG changeset patch # User wenzelm # Date 1185216476 -7200 # Node ID 2ea068548a835eb851fff2c585398f31f080732d # Parent 1b5f77bc146a2dbab8013ad11598902686ec992d marked some CRITICAL sections; diff -r 1b5f77bc146a -r 2ea068548a83 src/Pure/Thy/present.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); diff -r 1b5f77bc146a -r 2ea068548a83 src/Pure/Thy/thy_load.ML --- 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; diff -r 1b5f77bc146a -r 2ea068548a83 src/Pure/context.ML --- 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;