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/bootstrap/build-initdg.sml
ViewVC logotype

View of /sml/trunk/src/cm/bootstrap/build-initdg.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 327 - (download) (annotate)
Thu Jun 10 09:14:48 1999 UTC (20 years, 6 months ago) by blume
File size: 4023 byte(s)
bootstrap compiler implemented (still needs list file generator etc.)
(*
 * Build a simple dependency graph from a direct DAG description.
 *   - This is used in the bootstrap compiler to establish the
 *     pervasive env, the core env, and the primitives which later
 *     get used by the rest of the system.
 *   - The DAG does not contain any BNODEs and the only PNODEs will
 *     be those that correspond to primitives passed via "gp".
 *     In practice, the only PNODE will be the one for Env.primEnv.
 *
 * (C) 1999 Lucent Technologies, Bell Laboratories
 *
 * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
 *)

signature BUILD_INIT_DG = sig
    val build : GeneralParams.info -> AbsPath.t ->
	{ rts: DependencyGraph.snode,
	  core: DependencyGraph.snode,
	  pervasive: DependencyGraph.snode,
	  primitives: (string * DependencyGraph.snode) list,
	  filepaths: AbsPath.t list } option
end

structure BuildInitDG :> BUILD_INIT_DG = struct

    structure S = GenericVC.Source
    structure EM = GenericVC.ErrorMsg
    structure SM = GenericVC.SourceMap
    structure DG = DependencyGraph

    fun build (gp: GeneralParams.info) specgroup = let
	val pcmode = #pcmode (#param gp)
	val primconf = #primconf (#param gp)
	val errcons = #errcons gp
	val groupreg = #groupreg gp

	val context = AbsPath.relativeContext (AbsPath.dir specgroup)
	val specname = AbsPath.name specgroup
	val stream = TextIO.openIn specname
	val source = S.newSource (specname, 1, stream, false, errcons)
	val sourceMap = #sourceMap source

	val _ = GroupReg.register groupreg (specgroup, source)

	fun error r m = EM.error source r EM.COMPLAIN m EM.nullErrorBody

	fun lineIn pos = let
	    val line = TextIO.inputLine stream
	    val len = size line
	    val newpos = pos + len
	    val _ = GenericVC.SourceMap.newline sourceMap newpos
	    fun sep c = Char.isSpace c orelse Char.contains "(),=;" c
	in
	    if line = "" then NONE
	    else if String.sub (line, 0) = #"#" then SOME ([], newpos)
	    else SOME (String.tokens sep line, newpos)
	end

	fun loop (split, m, pl, pos) =
	    case lineIn pos of
		NONE => (error (pos, pos) "unexpected end of file"; NONE)
	      | SOME (line, newpos) => let
		    val error = error (pos, newpos)
		    fun sml (spec, split) = let
			val p = AbsPath.standard pcmode
			    { context = context, spec = spec }
		    in
			(p,
			 SmlInfo.info gp { sourcepath = p,
					   group = (specgroup, (pos, newpos)),
					   share = NONE,
					   split = split })
		    end
		    fun bogus n = 
			DG.SNODE { smlinfo = #2 (sml (n, false)),
				   localimports = [], globalimports = [] }
		    fun look n =
			case StringMap.find (m, n) of
			    SOME x => x
			  | NONE =>
				(case Primitive.fromString primconf n of
				     SOME p => DG.SB_BNODE (DG.PNODE p)
				   | NONE => (error ("undefined: " ^ n);
					      DG.SB_SNODE (bogus n)))

		    fun look_snode n =
			case look n of
			    DG.SB_SNODE n => n
			  | _ => (error ("illegal: " ^ n); bogus n)

		    fun node (name, file, args) = let
			fun one (arg, (li, gi)) =
			    case look arg of
				DG.SB_SNODE n => (n :: li, gi)
			      | n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)
			val (li, gi) = foldr one ([], []) args
			val (p, i) = sml (file, split)
			val n = DG.SNODE { smlinfo = i,
					   localimports = li,
					   globalimports = gi }
		    in
			loop (split,
			      StringMap.insert (m, name, DG.SB_SNODE n),
			      p :: pl, newpos)
		    end
		in
		    case line of
			[] => loop (split, m, pl, newpos)
		      | ["split"] => loop (true, m, pl, newpos)
		      | ["nosplit"] => loop (false, m, pl, newpos)
		      | ("let" :: name :: file :: args)  =>
			    node (name, file, args)
		      | ("return" :: rts :: core :: pervasive :: prims) =>
			    SOME { rts = look_snode rts,
				   core = look_snode core,
				   pervasive = look_snode pervasive,
				   primitives =
				        map (fn n => (n, look_snode n)) prims,
				   filepaths = rev pl }
		      | _ => (error "malformed line"; NONE)
		end
    in
	loop (false, StringMap.empty, [], 2) (* consistent with ml-lex bug? *)
    end
end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0