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

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