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

Parent Directory | Revision Log

---

Revision 354 - (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	354	val build : GeneralParams.info -> SrcPath.t ->
17 :	blume	326	{ rts: DependencyGraph.snode,
18 :			core: DependencyGraph.snode,
19 :			pervasive: DependencyGraph.snode,
20 :	blume	327	primitives: (string * DependencyGraph.snode) list,
21 :	blume	354	binpaths: string 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 :	blume	354	val context = SrcPath.sameDirContext specgroup
38 :			val _ = Say.vsay ["[reading init spec from ",
39 :			SrcPath.descr specgroup, "]\n"]
40 :	blume	326
41 :	blume	345	fun work stream = let
42 :	blume	354	val source = S.newSource (SrcPath.osstring specgroup,
43 :			1, stream, false, errcons)
44 :	blume	345	val sourceMap = #sourceMap source
45 :	blume	326
46 :	blume	345	val _ = GroupReg.register groupreg (specgroup, source)
47 :	blume	326
48 :	blume	345	fun error r m = EM.error source r EM.COMPLAIN m EM.nullErrorBody
49 :	blume	326
50 :	blume	345	fun lineIn pos = let
51 :			val line = TextIO.inputLine stream
52 :			val len = size line
53 :			val newpos = pos + len
54 :			val _ = GenericVC.SourceMap.newline sourceMap newpos
55 :			fun sep c = Char.isSpace c orelse Char.contains "(),=;" c
56 :			in
57 :			if line = "" then NONE
58 :			else if String.sub (line, 0) = #"#" then SOME ([], newpos)
59 :			else SOME (String.tokens sep line, newpos)
60 :			end
61 :	blume	326
62 :	blume	354	fun loop (split, m, bnl, pos) =
63 :	blume	345	case lineIn pos of
64 :			NONE => (error (pos, pos) "unexpected end of file"; NONE)
65 :			| SOME (line, newpos) => let
66 :			val error = error (pos, newpos)
67 :			fun sml (spec, split) = let
68 :	blume	354	val p = SrcPath.standard pcmode
69 :	blume	345	{ context = context, spec = spec }
70 :			in
71 :			SmlInfo.info gp { sourcepath = p,
72 :			group = (specgroup,
73 :			(pos, newpos)),
74 :			share = NONE,
75 :			split = split }
76 :			end
77 :			fun bogus n =
78 :			DG.SNODE { smlinfo = sml (n, false),
79 :			localimports = [], globalimports = [] }
80 :			fun look n =
81 :			case StringMap.find (m, n) of
82 :			SOME x => x
83 :			| NONE =>
84 :			(case Primitive.fromString primconf n of
85 :			SOME p => DG.SB_BNODE (DG.PNODE p)
86 :			| NONE => (error ("undefined: " ^ n);
87 :			DG.SB_SNODE (bogus n)))
88 :	blume	326
89 :	blume	345	fun look_snode n =
90 :			case look n of
91 :			DG.SB_SNODE n => n
92 :			| _ => (error ("illegal: " ^ n); bogus n)
93 :
94 :			fun node (name, file, args) = let
95 :			fun one (arg, (li, gi)) =
96 :			case look arg of
97 :			DG.SB_SNODE n => (n :: li, gi)
98 :			| n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)
99 :			val (li, gi) = foldr one ([], []) args
100 :			val i = sml (file, split)
101 :			val n = DG.SNODE { smlinfo = i,
102 :			localimports = li,
103 :			globalimports = gi }
104 :	blume	354	val bnl' =
105 :			case bnl of
106 :	blume	345	NONE => NONE
107 :	blume	354	| SOME l => SOME (SmlInfo.binname i :: l)
108 :	blume	345	in
109 :			loop (split,
110 :			StringMap.insert (m, name, DG.SB_SNODE n),
111 :	blume	354	bnl', newpos)
112 :	blume	345	end
113 :	blume	326	in
114 :	blume	345	case line of
115 :	blume	354	[] => loop (split, m, bnl, newpos)
116 :			| ["split"] => loop (true, m, bnl, newpos)
117 :			| ["nosplit"] => loop (false, m, bnl, newpos)
118 :	blume	345	| ["start"] => loop (split, m, SOME [], newpos)
119 :			| ("bind" :: name :: file :: args) =>
120 :			node (name, file, args)
121 :			| ("return" :: core :: rts :: pervasive :: prims) =>
122 :			SOME { rts = look_snode rts,
123 :			core = look_snode core,
124 :			pervasive = look_snode pervasive,
125 :			primitives =
126 :			map (fn n => (n, look_snode n)) prims,
127 :	blume	354	binpaths = rev (getOpt (bnl, [])) }
128 :	blume	345	| _ => (error "malformed line"; NONE)
129 :	blume	326	end
130 :	blume	345	in
131 :			loop (false, StringMap.empty, NONE, 1)
132 :			end
133 :	blume	326	in
134 :	blume	354	SafeIO.perform { openIt = fn () => SrcPath.openTextIn specgroup,
135 :	blume	345	closeIt = TextIO.closeIn,
136 :			work = work,
137 :			cleanup = fn () => () }
138 :	blume	326	end
139 :			end

---

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