--- a/src/Tools/Code/code_namespace.ML Wed Sep 01 12:27:49 2010 +0200
+++ b/src/Tools/Code/code_namespace.ML Wed Sep 01 15:09:43 2010 +0200
@@ -29,6 +29,13 @@
| Stmt of 'a
| Module of ('b * (string * ('a, 'b) node) Graph.T);
+fun map_module_content f (Module content) = Module (f content);
+
+fun map_module [] = I
+ | map_module (name_fragment :: name_fragments) =
+ apsnd o Graph.map_node name_fragment o apsnd o map_module_content
+ o map_module name_fragments;
+
fun hierarchical_program labelled_name { module_alias, reserved, empty_nsp,
namify_module, namify_stmt, cyclic_modules, empty_data, memorize_data } program =
let
@@ -45,11 +52,6 @@
(* building empty module hierarchy *)
val empty_module = (empty_data, Graph.empty);
- fun map_module f (Module content) = Module (f content);
- fun change_module [] = I
- | change_module (name_fragment :: name_fragments) =
- apsnd o Graph.map_node name_fragment o apsnd o map_module
- o change_module name_fragments;
fun ensure_module name_fragment (data, nodes) =
if can (Graph.get_node nodes) name_fragment then (data, nodes)
else (data,
@@ -57,7 +59,7 @@
fun allocate_module [] = I
| allocate_module (name_fragment :: name_fragments) =
ensure_module name_fragment
- #> (apsnd o Graph.map_node name_fragment o apsnd o map_module o allocate_module) name_fragments;
+ #> (apsnd o Graph.map_node name_fragment o apsnd o map_module_content o allocate_module) name_fragments;
val empty_program = Symtab.fold (fn (_, fragments) => allocate_module fragments)
fragments_tab empty_module;
@@ -66,8 +68,7 @@
let
val (name_fragments, base) = dest_name name;
in
- change_module name_fragments (fn (data, nodes) =>
- (memorize_data name data, Graph.new_node (name, (base, Stmt stmt)) nodes))
+ (map_module name_fragments o apsnd) (Graph.new_node (name, (base, Stmt stmt)))
end;
fun add_dependency name name' =
let
@@ -83,7 +84,7 @@
^ quote name ^ " -> " ^ quote name'
^ " would result in module dependency cycle"))
else Graph.add_edge dep
- in (change_module name_fragments_common o apsnd) add_edge end;
+ in (map_module name_fragments_common o apsnd) add_edge end;
val proto_program = empty_program
|> Graph.fold (fn (name, (stmt, _)) => add_stmt name stmt) program
|> Graph.fold (fn (name, (_, (_, names))) => fold (add_dependency name) names) program;
@@ -109,8 +110,9 @@
|> fold (declare (namify_stmt o (fn Stmt stmt => stmt)) modify_stmt) stmt_names;
val nodes'' = nodes'
|> fold (fn name_fragment => (Graph.map_node name_fragment
- o apsnd o map_module) (make_declarations nsps')) module_fragments;
- in (data, nodes'') end;
+ o apsnd o map_module_content) (make_declarations nsps')) module_fragments;
+ val data' = fold memorize_data stmt_names data;
+ in (data', nodes'') end;
val (_, hierarchical_program) = make_declarations empty_nsp proto_program;
(* deresolving *)