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

Parent Directory | Revision Log | Patch

	revision 326, Thu Jun 10 06:08:29 1999 UTC	revision 327, Thu Jun 10 09:14:48 1999 UTC
#	Line 1	Line 1
1	(*	(*
2	* Build a simple dependency graph from a direct DAG description.	* Build a simple dependency graph from a direct DAG description.
3	*   - This is used in the bootstrap compiler to establish the	*   - This is used in the bootstrap compiler to establish the
4	*     pervasive env that is used in the rest of the system.	*     pervasive env, the core env, and the primitives which later
5	*   - The DAG does not contain any BNODEs and the only PNODE will	*     get used by the rest of the system.
6	*     be the one for Environment.primEnv.	*   - 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	*	*
10	* (C) 1999 Lucent Technologies, Bell Laboratories	* (C) 1999 Lucent Technologies, Bell Laboratories
11	*	*
12	* Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)	* Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
13	*)	*)
14
15	signature BUILDINITDG = sig	signature BUILD_INIT_DG = sig
16	val build : GeneralParams.info -> AbsPath.t ->	val build : GeneralParams.info -> AbsPath.t ->
17	{ rts: DependencyGraph.snode,	{ rts: DependencyGraph.snode,
18	core: DependencyGraph.snode,	core: DependencyGraph.snode,
19	pervasive: DependencyGraph.snode,	pervasive: DependencyGraph.snode,
20	primitives: DependencyGraph.snode list }	primitives: (string * DependencyGraph.snode) list,
21		filepaths: AbsPath.t list } option
22	end	end
23
24	structure BuildInitDG = struct	structure BuildInitDG :> BUILD_INIT_DG = struct
25
26	structure S = GenericVC.Source	structure S = GenericVC.Source
27	structure EM = GenericVC.ErrorMsg	structure EM = GenericVC.ErrorMsg
#	Line 53	Line 56
56	else SOME (String.tokens sep line, newpos)	else SOME (String.tokens sep line, newpos)
57	end	end
58
59	fun loop (split, m, fl, pos) =	fun loop (split, m, pl, pos) =
60	case lineIn pos of	case lineIn pos of
61	NONE => (error (pos, pos) "unexpected end of file"; NONE)	NONE => (error (pos, pos) "unexpected end of file"; NONE)
62	| SOME (line, newpos) => let	| SOME (line, newpos) => let
63	val error = error (pos, newpos)	val error = error (pos, newpos)
64	fun sml (spec, split) = let	fun sml (spec, split) = let
65	val sourcepath = AbsPath.standard pcmode	val p = AbsPath.standard pcmode
66	{ context = context, spec = spec }	{ context = context, spec = spec }
67	in	in
68	SmlInfo.info gp { sourcepath = sourcepath,	(p,
69		SmlInfo.info gp { sourcepath = p,
70	group = (specgroup, (pos, newpos)),	group = (specgroup, (pos, newpos)),
71	share = NONE,	share = NONE,
72	split = split }	split = split })
73	end	end
74	fun bogus n =	fun bogus n =
75	DG.SNODE { smlinfo = sml (n, false),	DG.SNODE { smlinfo = #2 (sml (n, false)),
76	localimports = [], globalimports = [] }	localimports = [], globalimports = [] }
77	fun look n =	fun look n =
78	case StringMap.find (m, n) of	case StringMap.find (m, n) of
#	Line 84	Line 88
88	DG.SB_SNODE n => n	DG.SB_SNODE n => n
89	| _ => (error ("illegal: " ^ n); bogus n)	| _ => (error ("illegal: " ^ n); bogus n)
90
91	fun node (name, file, split, args) = let	fun node (name, file, args) = let
92	fun one (arg, (li, gi)) =	fun one (arg, (li, gi)) =
93	case look arg of	case look arg of
94	DG.SB_SNODE n => (n :: li, gi)	DG.SB_SNODE n => (n :: li, gi)
95	| n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)	| n as DG.SB_BNODE _ => (li, (NONE, n) :: gi)
96	val (li, gi) = foldr one ([], []) args	val (li, gi) = foldr one ([], []) args
97	val n = DG.SNODE { smlinfo = sml (file, split),	val (p, i) = sml (file, split)
98		val n = DG.SNODE { smlinfo = i,
99	localimports = li,	localimports = li,
100	globalimports = gi }	globalimports = gi }
101	in	in
102	StringMap.insert (m, name, DG.SB_SNODE n)	loop (split,
103		StringMap.insert (m, name, DG.SB_SNODE n),
104		p :: pl, newpos)
105	end	end
106	in	in
107	case line of	case line of
108	[] => loop (split, m, fl, newpos)	[] => loop (split, m, pl, newpos)
109	| ["split"] => loop (true, m, fl, newpos)	| ["split"] => loop (true, m, pl, newpos)
110	| ["nosplit"] => loop (false, m, fl, newpos)	| ["nosplit"] => loop (false, m, pl, newpos)
111	| ("let" :: name :: file :: args)  =>	| ("let" :: name :: file :: args)  =>
112	loop (split, node (name, file, split, args),	node (name, file, args)
113	file :: fl, newpos)	| ("return" :: rts :: core :: pervasive :: prims) =>
	| ("return" :: rts :: core :: pervasive :: primitives) =>
114	SOME { rts = look_snode rts,	SOME { rts = look_snode rts,
115	core = look_snode core,	core = look_snode core,
116	pervasive = look_snode pervasive,	pervasive = look_snode pervasive,
117	primitives = map look_snode primitives }	primitives =
118		map (fn n => (n, look_snode n)) prims,
119		filepaths = rev pl }
120	| _ => (error "malformed line"; NONE)	| _ => (error "malformed line"; NONE)
121	end	end
122	in	in

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.326   changed lines   Added in v.327

---

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