## find-reachable-sml-nodes.pkg
## (C) 1999 Lucent Technologies, Bell Laboratories
## Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
# Compiled by:
# src/app/makelib/makelib.sublib# Get the set of reachable SML_NODEs in a given dependency graph.
### "Ah, but a man's grasp should exceed his reach,
### Or what's a heaven for?"
###
### -- Robert Browning
stipulate
package flt = frozenlib_tome; # frozenlib_tome is from src/app/makelib/freezefile/frozenlib-tome.pkg package fts = frozenlib_tome_set; # frozenlib_tome_set is from src/app/makelib/freezefile/frozenlib-tome-set.pkg package lg = inter_library_dependency_graph; # inter_library_dependency_graph is from src/app/makelib/depend/inter-library-dependency-graph.pkg package sg = intra_library_dependency_graph; # intra_library_dependency_graph is from src/app/makelib/depend/intra-library-dependency-graph.pkg package spm = source_path_map; # source_path_map is from src/app/makelib/paths/source-path-map.pkg package sps = source_path_set; # source_path_set is from src/app/makelib/paths/source-path-set.pkg package sym = symbol_map; # symbol_map is from src/app/makelib/stuff/symbol-map.pkg package tts = thawedlib_tome_set; # thawedlib_tome_set is from src/app/makelib/compilable/thawedlib-tome-set.pkgherein
api Find_Reachable_Sml_Nodes {
#
#
# These two functions simply give you the set of (non-frozen)
# .compileds reachable from some root and the fringe of frozen
# .compileds that surrounds the non-frozen portion.
#
reachable'
:
List( sg::Tome_Tin )
->
( tts::Set,
fts::Set
);
reachable
:
lg::Inter_Library_Dependency_Graph
->
( tts::Set,
fts::Set
);
# "make_thawedlib_tome_tin_map" gives us handles at arbitrary points within
# the (non-frozen) portion of a dependency graph.
# This is used by "server" mode compiler.
#
make__sourcepath__to__thawedlib_tome_tin__map
:
lg::Inter_Library_Dependency_Graph
->
spm::Map( sg::Thawedlib_Tome_Tin );
# Given a library g, "groupsOf g" gets the set of
# sublibraries (but not sub-freezefiles) of that library.
# The result will include the argument itself:
#
groups_of: lg::Inter_Library_Dependency_Graph
->
sps::Set;
# Given an arbitrary library graph rooted at library g, "freezefiles_of g"
# gets the set of stable libraries reachable from g.
#
freezefiles_of: lg::Inter_Library_Dependency_Graph
->
spm::Map( lg::Inter_Library_Dependency_Graph );
# Given a "closed" subset of (non-stable) nodes in a dependency graph,
# "frontier" gives you the set of frontier nodes of that set. The
# closed set is given by its indicator function (first argument).
# ("closed" means that if a node's ancestors are all in
# the set, then so is the node itself. A frontier node is a node that
# is in the set but either not all of its ancestors are or the node
# is an export node.)
frontier: (flt::Frozenlib_Tome -> Bool)
->
lg::Inter_Library_Dependency_Graph
->
fts::Set;
};
end;
stipulate
package fts = frozenlib_tome_set; # frozenlib_tome_set is from src/app/makelib/freezefile/frozenlib-tome-set.pkg package lg = inter_library_dependency_graph; # inter_library_dependency_graph is from src/app/makelib/depend/inter-library-dependency-graph.pkg package sg = intra_library_dependency_graph; # intra_library_dependency_graph is from src/app/makelib/depend/intra-library-dependency-graph.pkg package spm = source_path_map; # source_path_map is from src/app/makelib/paths/source-path-map.pkg package sps = source_path_set; # source_path_set is from src/app/makelib/paths/source-path-set.pkg package sym = symbol_map; # symbol_map is from src/app/makelib/stuff/symbol-map.pkg package tlt = thawedlib_tome; # thawedlib_tome is from src/app/makelib/compilable/thawedlib-tome.pkg package tts = thawedlib_tome_set; # thawedlib_tome_set is from src/app/makelib/compilable/thawedlib-tome-set.pkgherein
package find_reachable_sml_nodes
: Find_Reachable_Sml_Nodes # Find_Reachable_Sml_Nodes is from src/app/makelib/depend/find-reachable-sml-nodes.pkg {
stipulate
#
fun reach
#
{ add, member, empty }
#
(tome_tins: List( sg::Tome_Tin ))
=
{ fun thawedlib_tomenode
#
( node as sg::THAWEDLIB_TOME_TIN { thawedlib_tome, near_imports, far_imports },
#
(known, stabfringe)
)
=
if (member (known, thawedlib_tome))
#
(known, stabfringe);
else
fold_forward
#
do_masked_tome
#
( fold_forward
thawedlib_tomenode
(add (known, thawedlib_tome, node), stabfringe)
near_imports
)
#
far_imports;
fi
also
fun do_masked_tome
(
{ tome_tin, ... }: sg::Masked_Tome, # Value being folded.
known_and_fringe # Fold-result accumulators.
)
=
do_tome_tin (tome_tin, known_and_fringe)
also
fun do_tome_tin (sg::TOME_IN_FROZENLIB { frozenlib_tome_tin => sg::FROZENLIB_TOME_TIN tin, ... }, (known, stabfringe))
=>
(known, fts::add (stabfringe, tin.frozenlib_tome));
do_tome_tin (sg::TOME_IN_THAWEDLIB node, known_and_fringe)
=>
thawedlib_tomenode (node, known_and_fringe);
end;
fold_forward
do_tome_tin
(empty, fts::empty)
tome_tins;
};
fun force f
=
f ();
fun fat_tome_map' (exports: sym::Map( lg::Fat_Tome ), acc)
=
{ fun add (m, tome, x) = spm::set (m, tlt::sourcepath_of tome, x);
fun member (m, tome) = spm::contains_key (m, tlt::sourcepath_of tome);
#1 (reach { add, member, empty => acc }
(map (.tome_tin o force o .masked_tome_thunk)
(sym::vals_list exports)));
};
herein
reachable'
=
reach { add => \\ (s, i, _) = tts::add (s, i),
member => tts::member,
empty => tts::empty
};
fun reachable (lg::LIBRARY { catalog, ... } )
=>
reachable'
(map (.tome_tin o force o .masked_tome_thunk)
(sym::vals_list catalog)
);
reachable lg::BAD_LIBRARY
=>
( tts::empty,
fts::empty
);
end;
fun make__sourcepath__to__thawedlib_tome_tin__map lib
=
#1 (do_library (lib, (spm::empty, sps::empty)))
where
fun do_library (lib as lg::LIBRARY library, (a, seen))
=>
{ library -> { catalog, sublibraries, libfile, ... };
if (sps::member (seen, libfile))
#
(a, seen);
else
fold_forward
(\\ (lt: lg::Library_Thunk, x) = do_library (lt.library_thunk (), x))
(fat_tome_map' (catalog, a), sps::add (seen, libfile))
sublibraries;
fi;
};
do_library (lg::BAD_LIBRARY, x)
=>
x;
end;
end;
fun groups_of lib
=
{ fun sublibraries (lg::LIBRARY { more => lg::SUBLIBRARY x, ... } )
=>
x.sublibraries;
sublibraries (lg::LIBRARY { more => lg::MAIN_LIBRARY { frozen_vs_thawed_stuff => lg::THAWEDLIB_STUFF x, ... }, ... } )
=>
x.sublibraries;
sublibraries _ => [];
end;
fun go (lib as lg::LIBRARY { libfile, ... }, a)
=>
{ sgl = sublibraries lib;
fun sl (lt: lg::Library_Thunk, a)
=
case (lt.library_thunk ())
#
lib as lg::LIBRARY { more => lg::SUBLIBRARY _, ... }
=>
if (sps::member (a, lt.libfile))
a;
else
go (lib, a);
fi;
#
_ => a;
esac;
sps::add (fold_forward sl a sgl, libfile);
};
go (lg::BAD_LIBRARY, a)
=>
a;
end;
go (lib, sps::empty);
};
fun freezefiles_of (lib as lg::LIBRARY { libfile, ... } )
=>
{ fun slo' ((p, lib as lg::LIBRARY library), (seen, result))
=>
{ library -> { more, sublibraries, ... };
if (sps::member (seen, p))
#
(seen, result);
else
my (seen, result)
=
fold_forward
slo
(seen, result)
sublibraries;
seen = sps::add (seen, p);
case more
#
lg::MAIN_LIBRARY { frozen_vs_thawed_stuff => lg::FROZENLIB_STUFF _, ... }
=>
( seen,
spm::set (result, p, lib)
);
#
_ => (seen, result);
esac;
fi;
};
slo' ((_, lg::BAD_LIBRARY), x)
=>
x;
end
also
fun slo (lt: lg::Library_Thunk, x)
=
slo' ((lt.libfile, lt.library_thunk ()), x);
#2 (slo' ( (libfile, lib),
( sps::empty,
spm::empty
)
)
);
};
freezefiles_of lg::BAD_LIBRARY
=>
spm::empty;
end;
fun frontier in_set (lg::LIBRARY { catalog, ... } )
=>
{ fun bnode (sg::FROZENLIB_TOME_TIN tin, (frozen_compilables_seen, f))
=
{ tin -> { frozenlib_tome, near_imports, ... };
if (fts::member (frozen_compilables_seen, frozenlib_tome))
#
(frozen_compilables_seen, f);
else
frozen_compilables_seen = fts::add (frozen_compilables_seen, frozenlib_tome);
if (in_set frozenlib_tome)
#
(frozen_compilables_seen, fts::add (f, frozenlib_tome));
else
fold_forward bnode (frozen_compilables_seen, f) near_imports;
fi;
fi;
};
fun get_bn
( t: lg::Fat_Tome,
results: List( sg::Frozenlib_Tome_Tin )
)
=
case (t.masked_tome_thunk ())
#
{ tome_tin => sg::TOME_IN_FROZENLIB r, ... }
=>
r.frozenlib_tome_tin ! results;
_ =>
results;
esac;
bnl =
sym::fold_forward
get_bn
[]
catalog;
#2 (fold_forward
bnode
(fts::empty, fts::empty)
bnl
);
};
frontier _ lg::BAD_LIBRARY
=>
fts::empty;
end;
end;
};
end;