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

Parent Directory | Revision Log

---

Revision 335 - (view) (download)

1 :	blume	326	(*
2 :			* Build a simple dependency graph from a direct DAG description.
3 :			* - This is used in the bootstrap compiler to establish the
4 :	blume	327	* pervasive env, the core env, and the primitives which later
5 :			* get used by the rest of the system.
6 :			* - The DAG does not contain any BNODEs and the only PNODEs will
7 :			* be those that correspond to primitives passed via "gp".
8 :			* In practice, the only PNODE will be the one for Env.primEnv.
9 :	blume	326	*
10 :			* (C) 1999 Lucent Technologies, Bell Laboratories
11 :			*
12 :			* Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
13 :			*)
14 :
15 :	blume	327	signature BUILD_INIT_DG = sig
16 :	blume	326	val build : GeneralParams.info -> AbsPath.t ->
17 :			{ rts: DependencyGraph.snode,
18 :			core: DependencyGraph.snode,
19 :			pervasive: DependencyGraph.snode,
20 :	blume	327	primitives: (string * DependencyGraph.snode) list,
21 :	blume	335	binpaths: AbsPath.t list } option
22 :	blume	326	end
23 :
24 :	blume	327	structure BuildInitDG :> BUILD_INIT_DG = struct
25 :	blume	326
26 :			structure S = GenericVC.Source
27 :			structure EM = GenericVC.ErrorMsg
28 :			structure SM = GenericVC.SourceMap
29 :			structure DG = DependencyGraph
30 :
31 :			fun build (gp: GeneralParams.info) specgroup = let
32 :			val pcmode = #pcmode (#param gp)
33 :			val primconf = #primconf (#param gp)
34 :			val errcons = #errcons gp
35 :			val groupreg = #groupreg gp
36 :
37 :			val context = AbsPath.relativeContext (AbsPath.dir specgroup)
38 :			val specname = AbsPath.name specgroup
39 :	blume	329	val _ = Say.vsay ["[reading init spec from ", specname, "]\n"]
40 :			val stream = AbsPath.openTextIn specgroup
41 :	blume	326	val source = S.newSource (specname, 1, stream, false, errcons)
42 :			val sourceMap = #sourceMap source
43 :
44 :			val _ = GroupReg.register groupreg (specgroup, source)
45 :
46 :			fun error r m = EM.error source r EM.COMPLAIN m EM.nullErrorBody
47 :
48 :			fun lineIn pos = let
49 :			val line = TextIO.inputLine stream
50 :			val len = size line
51 :			val newpos = pos + len
52 :			val _ = GenericVC.SourceMap.newline sourceMap newpos
53 :			fun sep c = Char.isSpace c orelse Char.contains "(),=;" c
54 :			in
55 :			if line = "" then NONE
56 :			else if String.sub (line, 0) = #"#" then SOME ([], newpos)
57 :			else SOME (String.tokens sep line, newpos)
58 :			end
59 :
60 :	blume	335	fun loop (split, m, bpl, pos) =
61 :	blume	326	case lineIn pos of
62 :			NONE => (error (pos, pos) "unexpected end of file"; NONE)
63 :			| SOME (line, newpos) => let
64 :			val error = error (pos, newpos)
65 :			fun sml (spec, split) = let
66 :	blume	327	val p = AbsPath.standard pcmode
67 :	blume	326	{ context = context, spec = spec }
68 :			in
69 :	blume	335	SmlInfo.info gp { sourcepath = p,
70 :			group = (specgroup, (pos, newpos)),
71 :			share = NONE,
72 :			split = split }
73 :	blume	326	end
74 :			fun bogus n =
75 :	blume	335	DG.SNODE { smlinfo = sml (n, false),
76 :	blume	326	localimports = [], globalimports = [] }
77 :			fun look n =
78 :			case StringMap.find (m, n) of
79 :			SOME x => x
80 :			| NONE =>
81 :			(case Primitive.fromString primconf n of
82 :			SOME p => DG.SB_BNODE (DG.PNODE p)
83 :			| NONE => (error ("undefined: " ^ n);
84 :			DG.SB_SNODE (bogus n)))
85 :
86 :			fun look_snode n =
87 :			case look n of
88 :			DG.SB_SNODE n => n
89 :			| _ => (error ("illegal: " ^ n); bogus n)
90 :
91 :	blume	327	fun node (name, file, args) = let
92 :	blume	326	fun one (arg, (li, gi)) =
93 :			case look arg of
94 :			DG.SB_SNODE n => (n :: li, gi)
95 :			| n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)
96 :			val (li, gi) = foldr one ([], []) args
97 :	blume	335	val i = sml (file, split)
98 :	blume	327	val n = DG.SNODE { smlinfo = i,
99 :	blume	326	localimports = li,
100 :			globalimports = gi }
101 :	blume	335	val bpl' =
102 :			case bpl of
103 :	blume	329	NONE => NONE
104 :	blume	335	| SOME l => SOME (SmlInfo.binpath i :: l)
105 :	blume	326	in
106 :	blume	327	loop (split,
107 :			StringMap.insert (m, name, DG.SB_SNODE n),
108 :	blume	335	bpl', newpos)
109 :	blume	326	end
110 :			in
111 :			case line of
112 :	blume	335	[] => loop (split, m, bpl, newpos)
113 :			| ["split"] => loop (true, m, bpl, newpos)
114 :			| ["nosplit"] => loop (false, m, bpl, newpos)
115 :	blume	329	| ["start"] => loop (split, m, SOME [], newpos)
116 :			| ("bind" :: name :: file :: args) =>
117 :	blume	327	node (name, file, args)
118 :	blume	331	| ("return" :: core :: rts :: pervasive :: prims) =>
119 :	blume	330	SOME { rts = look_snode rts,
120 :			core = look_snode core,
121 :			pervasive = look_snode pervasive,
122 :			primitives =
123 :	blume	329	map (fn n => (n, look_snode n)) prims,
124 :	blume	335	binpaths = rev (getOpt (bpl, [])) }
125 :	blume	326	| _ => (error "malformed line"; NONE)
126 :			end
127 :			in
128 :	blume	330	loop (false, StringMap.empty, NONE, 1)
129 :	blume	326	end
130 :			end

---

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