tuned pretty_sg;
authorwenzelm
Mon, 23 May 2005 14:56:37 +0200
changeset 16047 b2bf9a5cde37
parent 16046 7d68cd1b1b8b
child 16048 25cb0fe2e1c6
tuned pretty_sg; tuned;
src/Pure/Thy/thy_info.ML
--- a/src/Pure/Thy/thy_info.ML	Mon May 23 14:56:36 2005 +0200
+++ b/src/Pure/Thy/thy_info.ML	Mon May 23 14:56:37 2005 +0200
@@ -95,7 +95,6 @@
 fun update_node name parents entry G =
   (if can (Graph.get_node G) name then upd_deps name entry G else Graph.new_node (name, entry) G)
   |> add_deps name parents;
-   
 
 
 (* thy database *)
@@ -135,7 +134,7 @@
 fun lookup_thy name =
   SOME (thy_graph Graph.get_node name) handle Graph.UNDEF _ => NONE;
 
-val known_thy = isSome o lookup_thy;
+val known_thy = is_some o lookup_thy;
 fun check_known_thy name = known_thy name orelse (warning ("Unknown theory " ^ quote name); false);
 fun if_known_thy f name = if check_known_thy name then f name else ();
 
@@ -168,18 +167,27 @@
     error (loader_msg "nothing known about theory" [name]);
 
 
-(* pretty printing a theory: omit finished theories *)
+(* pretty printing a theory *)
+
+local
 
-fun unfinished_names stamps =
-    List.last (List.filter is_finished stamps) :: List.filter (not o is_finished) stamps;
+fun relevant_names names =
+  let
+    val (finished, unfinished) =
+      List.filter (equal "#" orf known_thy) names
+      |> List.partition (not_equal "#" andf is_finished);
+  in (if not (null finished) then [List.last finished] else []) @ unfinished end;
 
-fun pretty_sg sg = 
-      Pretty.str_list "{" "}" 
-        (unfinished_names (List.filter known_thy (Sign.stamp_names_of sg)));
+fun pretty_sg sg =
+  Pretty.str_list "{" "}" (relevant_names (Sign.stamp_names_of sg));
+
+in
 
 val pretty_theory = pretty_sg o Theory.sign_of;
 val pprint_theory = Pretty.pprint o pretty_theory;
 
+end;
+
 
 (* access theory *)
 
@@ -244,8 +252,8 @@
 (* load_file *)
 
 val opt_path = Option.map (Path.dir o fst o ThyLoad.get_thy);
-fun opt_path' (d : deps option) = getOpt (Option.map (opt_path o #master) d, NONE);
-fun opt_path'' d = getOpt (Option.map opt_path' d, NONE);
+fun opt_path' (d: deps option) = if_none (Option.map (opt_path o #master) d) NONE;
+fun opt_path'' d = if_none (Option.map opt_path' d) NONE;
 
 local
 
@@ -360,7 +368,7 @@
         val (current, (new_deps, parents)) = current_deps ml strict dir name handle ERROR =>
           error (loader_msg "the error(s) above occurred while examining theory" [name] ^
             (if null initiators then "" else required_by "\n" initiators));
-        val dir' = getOpt (opt_path'' new_deps, dir);
+        val dir' = if_none (opt_path'' new_deps) dir;
         val (visited', parent_results) = foldl_map (req_parent dir') (name :: visited, parents);
 
         val thy = if not really then SOME (get_theory name) else NONE;
@@ -417,7 +425,7 @@
   let
     val bparents = map base_of_path parents;
     val dir' = opt_path'' (lookup_deps name);
-    val dir = getOpt (dir',Path.current);
+    val dir = if_none dir' Path.current;
     val assert_thy = if upd then quiet_update_thy' true dir else weak_use_thy dir;
     val _ = check_unfinished error name;
     val _ = List.app assert_thy parents;