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

Parent Directory | Revision Log

---

Revision 301 - (view) (download)

1 :	blume	274	(* dummy implementation of functor LinkCM *)
2 :
3 :	blume	301	functor LinkCM (structure HostMachDepVC : MACHDEP_VC) = struct
4 :	blume	274
5 :	blume	276	local
6 :			structure YaccTool = YaccTool
7 :			structure LexTool = LexTool
8 :			structure BurgTool = BurgTool
9 :			val _ = EnvConfig.init ()
10 :	blume	301
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 :	blume	276	in
58 :	blume	274	structure CM = struct
59 :	blume	301
60 :			fun run f s = let
61 :	blume	274	val c = AbsPath.cwdContext ()
62 :			val p = AbsPath.native { context = AbsPath.cwdContext (),
63 :			spec = s }
64 :	blume	301	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 :	blume	274	in
74 :	blume	301	Say.vsay "[starting]\n";
75 :			Option.map f (CMParse.parse param p)
76 :	blume	274	end
77 :	blume	286
78 :	blume	301	val parse = run #1
79 :			val recomp = run recomp_group
80 :			val make = run make_group
81 :	blume	274	end
82 :
83 :			structure CMB = struct
84 :			fun setRetargetPervStatEnv x = ()
85 :			fun wipeOut () = ()
86 :			fun make' _ = ()
87 :			end
88 :	blume	276	end
89 :	blume	274	end
90 :
91 :			signature CMTOOLS = sig end
92 :			signature COMPILATION_MANAGER = sig end

---

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