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/mkprimperv.sml
ViewVC logotype

View of /sml/trunk/src/cm/bootstrap/mkprimperv.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 325 - (download) (annotate)
Thu Jun 10 05:00:05 1999 UTC (21 years, 5 months ago) by blume
File size: 3510 byte(s)
a bit more flesh on the bootstrap skeleton
functor MkPrimPervFn (structure MachDepVC: MACHDEP_VC) = struct

    structure E = GenericVC.Environment
    structure S = GenericVC.Source
    structure EM = GenericVC.ErrorMsg
    structure SM = GenericVC.SourceMap
    structure BF = MachDepVC.Binfile
    structure DE = GenericVC.DynamicEnv

    fun mk (gp: GeneralParams.info) specgroup = let
	val context = AbsPath.relativeContext (AbsPath.dir specgroup)
	val specname = AbsPath.name specgroup
	val stream = TextIO.openIn specname
	val errcons = #errcons gp
	val source = S.newSource (specname, 1, stream, false, errcons)
	val sourceMap = #sourceMap source

	val _ = GroupReg.register (#groupreg gp) (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

	local
	    val boguspid = GenericVC.PersStamps.fromBytes
		(Byte.stringToBytes "0123456789abcdef")
	in
	    fun bogus n = { name = n, env = GenericVC.Environment.emptyEnv,
			    pidInfo = { statpid = boguspid, sympid = boguspid,
				        ctxt = GenericVC.CMStaticEnv.empty } }
	end

	fun loop (split, m, fl, pos) =
	    case lineIn pos of
		NONE => (error (pos, pos) "unexpected end of file"; NONE)
	      | SOME (line, newpos) => let
		    val error = error (pos, newpos)
		    fun look n =
			case StringMap.find (m, n) of
			    SOME x => x
			  | NONE => (error ("undefined: " ^ n); bogus n)
		    fun sml spec = let
			val sourcepath = AbsPath.standard (#pcmode (#param gp))
			    { context = context, spec = spec }
		    in
			SmlInfo.info gp { sourcepath = sourcepath,
					  group = (specgroup, (pos, newpos)),
					  share = NONE }
		    end
			
		    fun report n = let
			val outfile =
			    AbsPath.name (SmlInfo.binpath (sml n)) ^ ".PID"
			val s = TextIO.openOut outfile
			val p = #statpid (#pidInfo (look n))
		    in
			TextIO.output (s, GenericVC.PersStamps.toHex p ^ "\n");
			TextIO.closeOut s
		    end

		    fun compile (name, file, args) = let
			fun one (arg, e) = E.layerEnv (#env (look arg), e)
			val ctxt = foldl one E.emptyEnv args
			val bfc = Dummy.f ()
			val pi = { statpid = BF.staticPidOf bfc,
				   sympid = BF.lambdaPidOf bfc,
				   ctxt = E.staticPart ctxt }
			val env = E.mkenv { static = BF.senvOf bfc,
					    symbolic = BF.symenvOf bfc,
					    dynamic = DE.empty }
			val pspec = { name = name, env = env, pidInfo = pi }
		    in
			StringMap.insert (m, name, pspec)
		    end
		in
		    case line of
			[] => loop (split, m, fl, newpos)
		      | ["split"] => loop (true, m, fl, newpos)
		      | ["nosplit"] => loop (false, m, fl, newpos)
		      | ["reportPid", name] =>
			    (report name;
			     loop (split, m, fl, newpos))
		      | ("let" :: name :: file :: args)  =>
			    loop (split, compile (name, file, args),
				  file :: fl, newpos)
		      | ("return" :: core :: pervasive :: primitives) =>
			    SOME { core = #env (look core),
				   pervasive = #env (look pervasive),
				   primitives = foldr
				          (fn (n, l) => look n :: l)
					  [] primitives }
		      | _ => (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