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

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