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

Parent Directory | Revision Log

---

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

---

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