Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/link.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 349 - (view) (download)

1 : blume 314 (* test implementation of functor LinkCM *)
2 : blume 274
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 : blume 316 structure ER = GenericVC.EnvRef
14 :     structure BE = GenericVC.BareEnvironment
15 : blume 301 structure CMSE = GenericVC.CMStaticEnv
16 :     structure S = GenericVC.Symbol
17 : blume 327 structure CoerceEnv = GenericVC.CoerceEnv
18 : blume 301
19 : blume 336 val os = SMLofNJ.SysInfo.getOSKind ()
20 :    
21 :     structure SSV = SpecificSymValFn (structure MachDepVC = HostMachDepVC
22 :     val os = os)
23 :    
24 : blume 317 (* For testing purposes, I need to have access to the old basis
25 :     * library. This is done via the "primitives" mechanism. Eventually,
26 :     * the basis will be accessed as a genuine library. The "primitives"
27 :     * mechanism is really meant to serve a different purpose.
28 :     *
29 :     * We split the existing pervasive environment into two parts:
30 : blume 318 * 1. All ML module definitions -- this is the part that will
31 : blume 317 * become available via a primitive called "basis".
32 :     * 2. The remaining (non-modular) bindings. Those will be
33 :     * used as our "pervasive" environment.
34 :     *
35 :     * I didn't bother to split dynamic or symbolic environments.
36 :     * To function properly this is not necessary, and the whole thing
37 :     * will soon go away anyhow.
38 :     *)
39 : blume 301 fun split e = let
40 :     val sym = E.symbolicPart e
41 :     val dyn = E.dynamicPart e
42 :     val stat = E.staticPart e
43 : blume 327 val bstat = CoerceEnv.es2bs stat
44 : blume 301 fun f ((s, b), (mods, nomods)) =
45 :     case S.nameSpace s of
46 :     (S.STRspace | S.SIGspace | S.FCTspace | S.FSIGspace) =>
47 :     (SE.bind (s, b, mods), nomods)
48 :     | _ => (mods, SE.bind (s, b, nomods))
49 :     val (bmods, bnomods) = SE.fold f (SE.empty, SE.empty) bstat
50 :     val mods = CMSE.CM bmods
51 :     val nomods = CMSE.CM bnomods
52 :     fun mk s = E.mkenv { static = s, dynamic = dyn, symbolic = sym }
53 :     in
54 :     { mod = mk mods, nomod = mk nomods }
55 :     end
56 :    
57 : blume 317 (* Instantiate the persistent state functor; this includes
58 :     * the binfile cache and the dynamic value cache *)
59 : blume 301 structure FullPersstate =
60 :     FullPersstateFn (structure MachDepVC = HostMachDepVC)
61 :    
62 : blume 317 (* Create two arguments appropriate for being passed to
63 :     * CompileGenericFn. One instantiation of that functor
64 :     * is responsible for "recompile" traversals, the other one
65 :     * does "link" traversals. Notice how the two share the same
66 :     * underlying state. *)
67 : blume 301 structure Recomp = RecompFn (structure PS = FullPersstate)
68 :     structure Exec = ExecFn (structure PS = FullPersstate)
69 :    
70 : blume 317 (* make the two traversals *)
71 : blume 301 structure RecompTraversal = CompileGenericFn (structure CT = Recomp)
72 :     structure ExecTraversal = CompileGenericFn (structure CT = Exec)
73 :    
74 : blume 317 (* The StabilizeFn functor needs a way of converting bnodes to
75 :     * dependency-analysis environments. This can be achieved quite
76 :     * conveniently by a "recompile" traversal for bnodes. *)
77 : blume 310 fun bn2statenv gp i = #1 (#stat (valOf (RecompTraversal.bnode gp i)))
78 :    
79 : blume 317 (* exec_group is basically the same as ExecTraversal.group with
80 :     * two additional actions to be taken:
81 :     * 1. Before executing the code, we announce the priviliges
82 :     * that are being invoked. (For the time being, we assume
83 :     * that everybody has every conceivable privilege, but at the
84 :     * very least we announce which ones are being made use of.)
85 :     * 2. After we are done we must make the values of "shared"
86 :     * compilation units permanent. *)
87 : blume 315 fun exec_group gp (g as GroupGraph.GROUP { required = rq, ... }) =
88 : blume 314 (if StringSet.isEmpty rq then ()
89 :     else Say.say ("$Execute: required privileges are:\n" ::
90 :     map (fn s => (" " ^ s ^ "\n")) (StringSet.listItems rq));
91 : blume 315 ExecTraversal.group gp g
92 : blume 320 before FullPersstate.rememberShared gp)
93 : blume 314
94 : blume 317 fun recomp_runner gp g = isSome (RecompTraversal.group gp g)
95 : blume 315
96 : blume 317 (* This function combines the actions of "recompile" and "exec".
97 :     * When successful, it combines the results (thus forming a full
98 :     * environment) and adds it to the toplevel environment. *)
99 : blume 316 fun make_runner gp g =
100 : blume 317 case RecompTraversal.group gp g of
101 : blume 316 NONE => false
102 :     | SOME { stat, sym} =>
103 :     (case exec_group gp g of
104 :     NONE => false
105 :     | SOME dyn => let
106 :     val delta = E.mkenv { static = stat, symbolic = sym,
107 :     dynamic = dyn }
108 :     val base = #get ER.topLevel ()
109 : blume 327 val new = BE.concatEnv (CoerceEnv.e2b delta, base)
110 : blume 316 in
111 :     #set ER.topLevel new;
112 :     Say.vsay ["[New bindings added.]\n"];
113 :     true
114 :     end)
115 :    
116 : blume 317 (* Instantiate the stabilization mechanism. *)
117 : blume 311 structure Stabilize = StabilizeFn (val bn2statenv = bn2statenv
118 : blume 316 val recomp = recomp_runner)
119 : blume 311
120 : blume 317 (* Access to the stabilization mechanism is integrated into the
121 :     * parser. I'm not sure if this is the cleanest way, but it works
122 :     * well enough. *)
123 : blume 311 structure Parse = ParseFn (structure Stabilize = Stabilize)
124 : blume 316
125 : blume 317 (* this is just a dummy argument to "run" (see below). *)
126 : blume 316 fun stabilize_runner gp g = true
127 : blume 276 in
128 : blume 274 structure CM = struct
129 : blume 301
130 : blume 310 fun run sflag f s = let
131 : blume 274 val c = AbsPath.cwdContext ()
132 : blume 329 val p = AbsPath.native { context = c, spec = s }
133 : blume 317 val { mod = basis, nomod = perv } = split (#get ER.pervasive ())
134 : blume 316 val corenv = #get ER.core ()
135 : blume 323 val bpspec = let
136 :     val bogus = GenericVC.PersStamps.fromBytes
137 :     (Byte.stringToBytes "0123456789abcdef")
138 :     in
139 :     { name = "basis",
140 :     env = basis,
141 :     pidInfo = { statpid = bogus, sympid = bogus,
142 :     ctxt = GenericVC.CMStaticEnv.empty } }
143 :     end
144 :     val primconf = Primitive.configuration [bpspec]
145 : blume 321 val pcmode = PathConfig.hardwire
146 :     [("smlnj-lib.cm", "/home/blume/ML/current/lib")]
147 : blume 322 val fnpolicy =
148 : blume 336 FilenamePolicy.colocate { os = os,
149 : blume 322 arch = HostMachDepVC.architecture }
150 : blume 329 val keep_going = EnvConfig.getSet StdConfig.keep_going NONE
151 : blume 301 val param = { primconf = primconf,
152 : blume 322 fnpolicy = fnpolicy,
153 : blume 321 pcmode = pcmode,
154 : blume 336 symenv = SSV.env,
155 : blume 329 keep_going = keep_going,
156 : blume 301 pervasive = perv,
157 : blume 327 corenv = corenv,
158 :     pervcorepids = PidSet.empty }
159 : blume 274 in
160 : blume 314 case Parse.parse param sflag p of
161 : blume 316 NONE => false
162 : blume 314 | SOME (g, gp) => f gp g
163 : blume 274 end
164 : blume 286
165 : blume 316 fun stabilize recursively = run (SOME recursively) stabilize_runner
166 :     val recomp = run NONE recomp_runner
167 :     val make = run NONE make_runner
168 : blume 274 end
169 :    
170 :     structure CMB = struct
171 : blume 327 structure BootstrapCompile =
172 : blume 329 BootstrapCompileFn (structure MachDepVC = HostMachDepVC
173 : blume 336 val os = os)
174 : blume 349 fun make () =
175 :     BootstrapCompile.compile
176 :     { binroot = "xxx.bin.xxx",
177 : blume 331 pcmodespec = "pathconfig",
178 :     initgspec = "Init/spec.cmi",
179 :     maingspec = "Libs/main.cm" }
180 : blume 274 fun setRetargetPervStatEnv x = ()
181 :     fun wipeOut () = ()
182 :     fun make' _ = ()
183 :     end
184 : blume 276 end
185 : blume 274 end
186 :    
187 :     signature CMTOOLS = sig end
188 :     signature COMPILATION_MANAGER = sig end

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