# HG changeset patch # User wenzelm # Date 1126642790 -7200 # Node ID a8e19032497db4a8aace6a0a537445f5b2c9506c # Parent 92b9e4fdd2289ec03bca2d426fde35b0ab475b11 begin_theory: tuned interface, check uses; diff -r 92b9e4fdd228 -r a8e19032497d src/Pure/Thy/thy_info.ML --- a/src/Pure/Thy/thy_info.ML Tue Sep 13 22:19:49 2005 +0200 +++ b/src/Pure/Thy/thy_info.ML Tue Sep 13 22:19:50 2005 +0200 @@ -42,7 +42,7 @@ val pretend_use_thy_only: string -> unit val begin_theory: (Path.T option -> string -> string list -> (Path.T * bool) list -> theory -> theory) -> - bool -> string -> string list -> (Path.T * bool) list -> theory + string -> string list -> (Path.T * bool) list -> bool -> theory val end_theory: theory -> theory val finish: unit -> unit val register_theory: theory -> unit @@ -412,24 +412,33 @@ (* begin / end theory *) -fun begin_theory present upd name parents paths = +fun check_uses name uses = + let val illegal = map (fn ext => Path.ext ext (Path.basic name)) ThyLoad.ml_exts in + (case find_first (member (op =) illegal o Path.base o Path.expand o #1) uses of + NONE => () + | SOME (path, _) => error ("Illegal use of theory ML file: " ^ quote (Path.pack path))) + end; + +fun begin_theory present name parents uses int = let val bparents = map base_of_path parents; val dir' = opt_path'' (lookup_deps name); val dir = if_none dir' Path.current; - val assert_thy = if upd then quiet_update_thy' true dir else weak_use_thy dir; + val assert_thy = if int then quiet_update_thy' true dir else weak_use_thy dir; val _ = check_unfinished error name; val _ = List.app assert_thy parents; + val _ = check_uses name uses; + val theory = Theory.begin_theory name (map get_theory bparents); val deps = if known_thy name then get_deps name - else (init_deps NONE (map #1 paths)); (*records additional ML files only!*) - val use_paths = List.mapPartial (fn (x, true) => SOME x | _ => NONE) paths; + else (init_deps NONE (map #1 uses)); (*records additional ML files only!*) + val uses_now = List.mapPartial (fn (x, true) => SOME x | _ => NONE) uses; val _ = change_thys (update_node name bparents (deps, SOME (Theory.copy theory))); - val theory' = theory |> present dir' name bparents paths; + val theory' = theory |> present dir' name bparents uses; val _ = put_theory name (Theory.copy theory'); - val ((), theory'') = Context.pass_theory theory' (List.app (load_file false)) use_paths; + val ((), theory'') = Context.pass_theory theory' (List.app (load_file false)) uses_now; val _ = put_theory name (Theory.copy theory''); in theory'' end;