Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] View of /sml/trunk/src/cm/depend/mklist.sml
ViewVC logotype

View of /sml/trunk/src/cm/depend/mklist.sml

Parent Directory Parent Directory | Revision Log Revision Log

Revision 587 - (download) (annotate)
Thu Mar 30 09:01:52 2000 UTC (20 years, 6 months ago) by blume
File size: 1808 byte(s)
merging back development branch blume_devel_v110p26p1_3...
This involves changes to CM and the removal of CMStaticEnv from
the compiler.  See the HISTORY file for more information.
 * Produce a linear listing of information pertaining to nodes in
 *  a given dependency graph.
 * (C) 1999 Lucent Technologies, Bell Laboratories
 * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
structure MkList :> sig
    val group : { bininfo: BinInfo.info -> 'element,
		  smlinfo: SmlInfo.info -> 'element,
		  Cons: 'element * 'elements -> 'elements,
		  Nil: 'elements } ->
	GroupGraph.group -> 'elements
end = struct

    structure DG = DependencyGraph
    structure GG = GroupGraph

    fun stab_isreg ((bs, ss), i) = StableSet.member (bs, i)
    fun sml_isreg ((bs, ss), i) = SmlInfoSet.member (ss, i)
    fun stab_reg ((bs, ss), i) = (StableSet.add (bs, i), ss)
    fun sml_reg ((bs, ss), i) = (bs, SmlInfoSet.add (ss, i))

    fun do_list do_elem [] k m = k m
      | do_list do_elem (h :: t) k m = do_elem h (do_list do_elem t k) m

    fun group { Nil, ... } GG.ERRORGROUP = Nil
      | group x (g as GG.GROUP { exports, ... }) = let
	val { bininfo, smlinfo, Cons, Nil } = x
	fun bnode (DG.BNODE n) k m = let
	    val { bininfo = i, localimports = l, globalimports = g } = n
	    fun k' m = Cons (bininfo i, k (stab_reg (m, i)))
	    if stab_isreg (m, i) then k m
	    else do_list bnode l (do_list farbnode g k') m

	and farbnode (_, n) = bnode n

	fun snode (DG.SNODE n) k m = let
	    val { smlinfo = i, localimports = l, globalimports = g } = n
	    fun k' m = Cons (smlinfo i, k (sml_reg (m, i)))
	    if sml_isreg (m, i) then k m
	    else do_list snode l (do_list farsbnode g k') m

	and farsbnode (_, DG.SB_BNODE (n, _)) = bnode n
	  | farsbnode (_, DG.SB_SNODE n) = snode n

	fun impexp (n, _) = farsbnode n
	do_list impexp (SymbolMap.listItems exports)
	               (fn _ => Nil)
		       (StableSet.empty, SmlInfoSet.empty)

ViewVC Help
Powered by ViewVC 1.0.0