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/compiler/Semant/statenv/genmap.sml
ViewVC logotype

View of /sml/trunk/src/compiler/Semant/statenv/genmap.sml

Parent Directory Parent Directory | Revision Log Revision Log

Revision 587 - (download) (annotate)
Thu Mar 30 09:01:52 2000 UTC (20 years, 8 months ago) by blume
File size: 1514 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.
 * Rapid modmap generation based on modtrees.
 *    (Modtrees are embedded into static environments during unpickling.
 *     This module cannot deal with environments that did not come out
 *     of the unpickler.)
 * March 2000, Matthias Blume
structure GenModIdMap : sig
    val mkMap : StaticEnv.staticEnv -> ModuleId.tmap
    val mkMap' : StaticEnv.staticEnv * ModuleId.tmap -> ModuleId.tmap
end = struct

    structure M = Modules
    structure MI = ModuleId

    fun mkMap' (se: StaticEnv.staticEnv, initial) = let
	fun tree (t, m) = let
	    fun rc (r, stubOf, treeOf, part, id, insert, look) = let
		val i = id r
		case look (m, i) of
		    SOME _ => m
		  | NONE => let
			val m' = insert (m, i, part)
			case stubOf part of
			    NONE => ErrorMsg.impossible "ModIdSet:no stubinfo"
			  | SOME stb => tree (treeOf stb, m')
	    case t of
		M.TYCNODE r => MI.insertTyc (m, MI.tycId r, r)
	      | M.SIGNODE r =>
		rc (r, #stub, #tree, r, MI.sigId, MI.insertSig, MI.lookSig)
	      | M.STRNODE r =>
		rc (r, #stub, #tree, #rlzn r,
		    MI.strId, MI.insertStr, MI.lookStr)
	      | M.FCTNODE r =>
		rc (r, #stub, #tree, #rlzn r,
		    MI.fctId, MI.insertFct, MI.lookFct)
	      | M.ENVNODE r =>
		rc (r, #stub, #tree, r, MI.envId, MI.insertEnv, MI.lookEnv)
	      | M.BRANCH l => foldl tree m l
	fun bnd ((_, (_, SOME t)), m) = tree (t, m)
	  | bnd (_, m) = m
	Env.fold bnd initial se

    fun mkMap se = mkMap' (se, MI.emptyTmap)

ViewVC Help
Powered by ViewVC 1.0.0