Diff of /sml/trunk/src/cm/link.sml

Parent Directory | Revision Log | Patch

	revision 286, Fri May 21 07:47:16 1999 UTC	revision 301, Fri May 28 09:43:39 1999 UTC
#	Line 1	Line 1
1	(* dummy implementation of functor LinkCM *)	(* dummy implementation of functor LinkCM *)
2
3	functor LinkCM () = struct	functor LinkCM (structure HostMachDepVC : MACHDEP_VC) = struct
4
5	local	local
6	structure YaccTool = YaccTool	structure YaccTool = YaccTool
7	structure LexTool = LexTool	structure LexTool = LexTool
8	structure BurgTool = BurgTool	structure BurgTool = BurgTool
9	val _ = EnvConfig.init ()	val _ = EnvConfig.init ()
10
11		structure E = GenericVC.Environment
12		structure SE = GenericVC.StaticEnv
13		structure CMSE = GenericVC.CMStaticEnv
14		structure S = GenericVC.Symbol
15
16		fun split e = let
17		val sym = E.symbolicPart e
18		val dyn = E.dynamicPart e
19		val stat = E.staticPart e
20		val bstat = CMSE.unCM stat
21		fun f ((s, b), (mods, nomods)) =
22		case S.nameSpace s of
23		(S.STRspace | S.SIGspace | S.FCTspace | S.FSIGspace) =>
24		(SE.bind (s, b, mods), nomods)
25		| _ => (mods, SE.bind (s, b, nomods))
26		val (bmods, bnomods) = SE.fold f (SE.empty, SE.empty) bstat
27		val mods = CMSE.CM bmods
28		val nomods = CMSE.CM bnomods
29		fun mk s = E.mkenv { static = s, dynamic = dyn, symbolic = sym }
30		in
31		{ mod = mk mods, nomod = mk nomods }
32		end
33
34		structure FullPersstate =
35		FullPersstateFn (structure MachDepVC = HostMachDepVC)
36
37		structure Recomp = RecompFn (structure PS = FullPersstate)
38		structure Exec = ExecFn (structure PS = FullPersstate)
39
40		structure RecompTraversal = CompileGenericFn (structure CT = Recomp)
41		structure ExecTraversal = CompileGenericFn (structure CT = Exec)
42
43		fun doall farsbnode (GroupGraph.GROUP { exports, ... }, gp) = let
44		fun one ((fsbn, _), false) = false
45		| one ((fsbn, _), true) =
46		isSome (farsbnode gp fsbn)
47		in
48		SymbolMap.foldl one true exports
49		end
50
51		val recomp_group = doall RecompTraversal.farsbnode
52		fun exec_group arg =
53		(DynTStamp.new ();
54		doall ExecTraversal.farsbnode arg)
55		fun make_group arg =
56		(if recomp_group arg then exec_group arg else false)
57	in	in
58	structure CM = struct	structure CM = struct
59
60	fun parse cfg s = let	fun run f s = let
61	val c = AbsPath.cwdContext ()	val c = AbsPath.cwdContext ()
62	val p = AbsPath.native { context = AbsPath.cwdContext (),	val p = AbsPath.native { context = AbsPath.cwdContext (),
63	spec = s }	spec = s }
64		val { mod = basis, nomod = perv } =
65		split (#get GenericVC.EnvRef.pervasive ())
66		val corenv = #get GenericVC.EnvRef.core ()
67		val primconf = Primitive.configuration { basis = basis }
68		val param = { primconf = primconf,
69		fnpolicy = FilenamePolicy.default,
70		keep_going = false,
71		pervasive = perv,
72		corenv = corenv }
73	in	in
74	CMParse.parse cfg p	Say.vsay "[starting]\n";
75		Option.map f (CMParse.parse param p)
76	end	end
77
78	val configuration = Primitive.configuration	val parse = run #1
79		val recomp = run recomp_group
80		val make = run make_group
81	end	end
82
83	structure CMB = struct	structure CMB = struct

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.286   changed lines   Added in v.301

---

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