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/stable/stabilize.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/stable/stabilize.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 312 - (view) (download)

1 : blume 309 (*
2 :     * Reading, generating, and writing stable groups.
3 :     *
4 :     * (C) 1999 Lucent Technologies, Bell Laboratories
5 :     *
6 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
7 :     *)
8 :     local
9 : blume 304 structure DG = DependencyGraph
10 : blume 306 structure GG = GroupGraph
11 :     structure EM = GenericVC.ErrorMsg
12 : blume 311 structure PP = PrettyPrint
13 :     structure SM = GenericVC.SourceMap
14 : blume 309 structure GP = GeneralParams
15 :     structure E = GenericVC.Environment
16 : blume 310
17 :     type statenvgetter = GP.info -> DG.bnode -> E.staticEnv
18 : blume 311 type recomp = GG.group * GP.info -> bool
19 : blume 309 in
20 : blume 304
21 : blume 309 signature STABILIZE = sig
22 :    
23 :     val loadStable :
24 : blume 310 GP.info * (AbsPath.t -> GG.group option) * bool ref ->
25 :     AbsPath.t -> GG.group option
26 : blume 309
27 :     val stabilize :
28 : blume 311 GP.info -> { group: GG.group, anyerrors: bool ref } ->
29 : blume 310 GG.group option
30 : blume 309 end
31 :    
32 : blume 311 functor StabilizeFn (val bn2statenv : statenvgetter
33 :     val recomp: recomp) :> STABILIZE = struct
34 : blume 309
35 : blume 307 datatype pitem =
36 :     PSS of SymbolSet.set
37 :     | PS of Symbol.symbol
38 :     | PSN of DG.snode
39 :     | PAP of AbsPath.t
40 : blume 304
41 : blume 307 datatype uitem =
42 :     USS of SymbolSet.set
43 :     | US of Symbol.symbol
44 :     | UBN of DG.bnode
45 :     | UAP of AbsPath.t
46 : blume 304
47 : blume 307 fun compare (PS s, PS s') = SymbolOrdKey.compare (s, s')
48 :     | compare (PS _, _) = GREATER
49 :     | compare (_, PS _) = LESS
50 :     | compare (PSS s, PSS s') = SymbolSet.compare (s, s')
51 :     | compare (PSS _, _) = GREATER
52 :     | compare (_, PSS _) = LESS
53 :     | compare (PSN (DG.SNODE n), PSN (DG.SNODE n')) =
54 :     SmlInfo.compare (#smlinfo n, #smlinfo n')
55 :     | compare (PSN _, _) = GREATER
56 :     | compare (_, PSN _) = LESS
57 :     | compare (PAP p, PAP p') = AbsPath.compare (p, p')
58 :    
59 : blume 304 structure Map =
60 :     BinaryMapFn (struct
61 : blume 307 type ord_key = pitem
62 : blume 304 val compare = compare
63 :     end)
64 :    
65 : blume 308 fun genStableInfoMap (exports, group) = let
66 :     (* find all the exported bnodes that are in the same group: *)
67 :     fun add (((_, DG.SB_BNODE (n as DG.BNODE b)), _), m) = let
68 :     val i = #bininfo b
69 :     in
70 :     if AbsPath.compare (BinInfo.group i, group) = EQUAL then
71 :     IntBinaryMap.insert (m, BinInfo.offset i, n)
72 :     else m
73 :     end
74 :     | add (_, m) = m
75 :     in
76 :     SymbolMap.foldl add IntBinaryMap.empty exports
77 :     end
78 :    
79 : blume 310 fun deleteFile n = OS.FileSys.remove n
80 :     handle e as Interrupt.Interrupt => raise e
81 :     | _ => ()
82 :    
83 : blume 311 fun stabilize gp { group = g as GG.GROUP grec, anyerrors } = let
84 : blume 304
85 : blume 311 fun doit granted = let
86 : blume 312
87 :     val _ = Say.say ("$Stabilize: wrapping the following privileges:\n"
88 :     :: map (fn s => (" " ^ s ^ "\n"))
89 :     (StringSet.listItems granted))
90 :    
91 : blume 311 val bname = AbsPath.name o SmlInfo.binpath
92 :     val bsz = OS.FileSys.fileSize o bname
93 :     fun cpb s i = let
94 :     val ins = BinIO.openIn (bname i)
95 :     fun cp () =
96 :     if BinIO.endOfStream ins then ()
97 :     else (BinIO.output (s, BinIO.input ins); cp ())
98 :     in
99 :     cp () handle e => (BinIO.closeIn ins; raise e);
100 : blume 310 BinIO.closeIn ins
101 : blume 311 end
102 :     val delb = deleteFile o bname
103 : blume 310
104 : blume 311 val grpSrcInfo = (#errcons gp, anyerrors)
105 : blume 308
106 : blume 311 val exports = #exports grec
107 :     val islib = #islib grec
108 :     val required = StringSet.difference (#required grec, granted)
109 :     val grouppath = #grouppath grec
110 :     val subgroups = #subgroups grec
111 : blume 304
112 : blume 311 (* The format of a stable archive is the following:
113 :     * - It starts with the size s of the pickled dependency
114 :     * graph. This size itself is written as four-byte string.
115 :     * - The pickled dependency graph. This graph contains
116 :     * integer offsets of the binfiles for the individual ML
117 :     * members. These offsets need to be adjusted by adding
118 :     * s + 4. The pickled dependency graph also contains integer
119 :     * offsets relative to other stable groups. These offsets
120 :     * need no further adjustment.
121 :     * - Individual binfile contents (concatenated).
122 :     *)
123 : blume 304
124 : blume 311 val members = ref []
125 :     val (registerOffset, getOffset) = let
126 :     val dict = ref SmlInfoMap.empty
127 :     val cur = ref 0
128 :     fun reg (i, sz) = let
129 :     val os = !cur
130 : blume 306 in
131 : blume 311 cur := os + sz;
132 :     dict := SmlInfoMap.insert (!dict, i, os);
133 :     members := i :: (!members);
134 :     os
135 : blume 306 end
136 : blume 311 fun get i = valOf (SmlInfoMap.find (!dict, i))
137 :     in
138 :     (reg, get)
139 :     end
140 : blume 304
141 : blume 311 fun w_list w_item [] k m =
142 :     "0" :: k m
143 :     | w_list w_item [a] k m =
144 :     "1" :: w_item a k m
145 :     | w_list w_item [a, b] k m =
146 :     "2" :: w_item a (w_item b k) m
147 :     | w_list w_item [a, b, c] k m =
148 :     "3" :: w_item a (w_item b (w_item c k)) m
149 :     | w_list w_item [a, b, c, d] k m =
150 :     "4" :: w_item a (w_item b (w_item c (w_item d k))) m
151 :     | w_list w_item (a :: b :: c :: d :: e :: r) k m =
152 :     "5" :: w_item a (w_item b (w_item c (w_item d (w_item e
153 :     (w_list w_item r k))))) m
154 : blume 304
155 : blume 311 fun w_option w_item NONE k m = "n" :: k m
156 :     | w_option w_item (SOME i) k m = "s" :: w_item i k m
157 : blume 304
158 : blume 311 fun int_encode i = let
159 :     (* this is the same mechanism that's also used in
160 :     * TopLevel/batch/binfile.sml (maybe we should share it) *)
161 :     val n = Word32.fromInt i
162 :     val // = LargeWord.div
163 :     val %% = LargeWord.mod
164 :     val !! = LargeWord.orb
165 :     infix // %% !!
166 :     val toW8 = Word8.fromLargeWord
167 :     fun r (0w0, l) = Word8Vector.fromList l
168 :     | r (n, l) =
169 :     r (n // 0w128, toW8 ((n %% 0w128) !! 0w128) :: l)
170 :     in
171 :     Byte.bytesToString (r (n // 0w128, [toW8 (n %% 0w128)]))
172 :     end
173 : blume 304
174 : blume 311 fun w_int i k m = int_encode i :: k m
175 : blume 304
176 : blume 311 fun w_share w C v k (i, m) =
177 :     case Map.find (m, C v) of
178 :     SOME i' => "o" :: w_int i' k (i, m)
179 :     | NONE => "n" :: w v k (i + 1, Map.insert (m, C v, i))
180 : blume 304
181 : blume 311 fun w_symbol_raw s k m = let
182 :     val ns = case Symbol.nameSpace s of
183 :     Symbol.SIGspace => "'"
184 :     | Symbol.FCTspace => "("
185 :     | Symbol.FSIGspace => ")"
186 :     | Symbol.STRspace => ""
187 :     | _ => GenericVC.ErrorMsg.impossible "stabilize:w_symbol"
188 :     in
189 :     ns :: Symbol.name s :: "." :: k m
190 :     end
191 : blume 304
192 : blume 311 val w_symbol = w_share w_symbol_raw PS
193 : blume 304
194 : blume 311 val w_ss = w_share (w_list w_symbol o SymbolSet.listItems) PSS
195 : blume 306
196 : blume 311 val w_filter = w_option w_ss
197 : blume 306
198 : blume 311 fun w_string s k m = let
199 :     fun esc #"\\" = "\\\\"
200 :     | esc #"\"" = "\\\""
201 :     | esc c = String.str c
202 :     in
203 :     String.translate esc s :: "\"" :: k m
204 :     end
205 : blume 306
206 : blume 311 fun w_sharing NONE k m = "n" :: k m
207 :     | w_sharing (SOME true) k m = "t" :: k m
208 :     | w_sharing (SOME false) k m = "f" :: k m
209 : blume 306
210 : blume 311 fun w_si i k = let
211 :     val spec = AbsPath.spec (SmlInfo.sourcepath i)
212 :     val locs = SmlInfo.errorLocation gp i
213 :     val offset = registerOffset (i, bsz i)
214 :     in
215 :     w_string spec
216 :     (w_string locs
217 :     (w_int offset
218 :     (w_sharing (SmlInfo.share i) k)))
219 :     end
220 : blume 306
221 : blume 311 fun w_primitive p k m = String.str (Primitive.toIdent p) :: k m
222 : blume 306
223 : blume 311 fun w_abspath_raw p k m = w_list w_string (AbsPath.pickle p) k m
224 : blume 306
225 : blume 311 val w_abspath = w_share w_abspath_raw PAP
226 : blume 306
227 : blume 311 fun w_bn (DG.PNODE p) k m = "p" :: w_primitive p k m
228 :     | w_bn (DG.BNODE { bininfo = i, ... }) k m =
229 :     "b" :: w_abspath (BinInfo.group i)
230 :     (w_int (BinInfo.offset i) k) m
231 : blume 306
232 : blume 311 fun w_sn_raw (DG.SNODE n) k =
233 :     w_si (#smlinfo n)
234 :     (w_list w_sn (#localimports n)
235 :     (w_list w_fsbn (#globalimports n) k))
236 : blume 306
237 : blume 311 and w_sn n = w_share w_sn_raw PSN n
238 : blume 307
239 : blume 311 and w_sbn (DG.SB_BNODE n) k m = "b" :: w_bn n k m
240 :     | w_sbn (DG.SB_SNODE n) k m = "s" :: w_sn n k m
241 : blume 306
242 : blume 311 and w_fsbn (f, n) k = w_filter f (w_sbn n k)
243 : blume 306
244 : blume 311 fun w_impexp (s, (n, _)) k = w_symbol s (w_fsbn n k)
245 : blume 306
246 : blume 311 fun w_exports e = w_list w_impexp (SymbolMap.listItemsi e)
247 : blume 306
248 : blume 311 fun w_bool true k m = "t" :: k m
249 :     | w_bool false k m = "f" :: k m
250 : blume 306
251 : blume 311 fun w_privileges p = w_list w_string (StringSet.listItems p)
252 : blume 306
253 : blume 311 fun pickle_group () = let
254 :     fun w_sg (GG.GROUP g) = w_abspath (#grouppath g)
255 :     fun k0 m = []
256 :     val m0 = (0, Map.empty)
257 :     in
258 :     concat (w_exports exports
259 :     (w_bool islib
260 :     (w_privileges required
261 :     (w_list w_sg subgroups k0))) m0)
262 :     end
263 : blume 308
264 : blume 311 val pickle = pickle_group ()
265 :     val sz = size pickle
266 :     val offset_adjustment = sz + 4
267 : blume 308
268 : blume 311 fun mkStableGroup () = let
269 :     val m = ref SmlInfoMap.empty
270 :     fun sn (DG.SNODE (n as { smlinfo, ... })) =
271 :     case SmlInfoMap.find (!m, smlinfo) of
272 :     SOME n => n
273 :     | NONE => let
274 :     val li = map sn (#localimports n)
275 :     val gi = map fsbn (#globalimports n)
276 :     val sourcepath = SmlInfo.sourcepath smlinfo
277 :     val spec = AbsPath.spec sourcepath
278 :     val offset =
279 :     getOffset smlinfo + offset_adjustment
280 :     val share = SmlInfo.share smlinfo
281 :     val locs = SmlInfo.errorLocation gp smlinfo
282 :     val error = EM.errorNoSource grpSrcInfo locs
283 :     val i = BinInfo.new { group = grouppath,
284 :     spec = spec,
285 :     offset = offset,
286 :     share = share,
287 :     error = error }
288 :     val n = DG.BNODE { bininfo = i,
289 :     localimports = li,
290 :     globalimports = gi }
291 :     in
292 :     m := SmlInfoMap.insert (!m, smlinfo, n);
293 :     n
294 :     end
295 : blume 308
296 : blume 311 and sbn (DG.SB_SNODE n) = sn n
297 :     | sbn (DG.SB_BNODE n) = n
298 : blume 308
299 : blume 311 and fsbn (f, n) = (f, sbn n)
300 : blume 308
301 : blume 311 fun impexp ((f, n), e) = ((f, DG.SB_BNODE (sbn n)), e)
302 : blume 308
303 : blume 311 val exports = SymbolMap.map impexp (#exports grec)
304 :     val simap = genStableInfoMap (exports, grouppath)
305 :     in
306 :     GG.GROUP { exports = exports,
307 :     islib = islib,
308 :     required = required,
309 :     grouppath = grouppath,
310 :     subgroups = subgroups,
311 :     stableinfo = GG.STABLE simap }
312 :     end
313 : blume 308
314 : blume 311 fun writeInt32 (s, i) = let
315 :     val a = Word8Array.array (4, 0w0)
316 :     val _ = Pack32Big.update (a, 0, LargeWord.fromInt i)
317 :     in
318 :     BinIO.output (s, Word8Array.extract (a, 0, NONE))
319 :     end
320 :     val memberlist = rev (!members)
321 :    
322 :     val policy = #fnpolicy (#param gp)
323 :     val gpath = #grouppath grec
324 :     val spath = FilenamePolicy.mkStablePath policy gpath
325 :     fun delete () = deleteFile (AbsPath.name spath)
326 :     val outs = AbsPath.openBinOut spath
327 :     fun try () =
328 :     (Say.vsay ["[stabilizing ", AbsPath.name gpath, "]\n"];
329 :     writeInt32 (outs, sz);
330 :     BinIO.output (outs, Byte.stringToBytes pickle);
331 :     app (cpb outs) memberlist;
332 :     app delb memberlist;
333 :     BinIO.closeOut outs;
334 :     SOME (mkStableGroup ()))
335 :     in
336 :     Interrupt.guarded try
337 :     handle e as Interrupt.Interrupt => (BinIO.closeOut outs;
338 :     delete ();
339 :     raise e)
340 :     | exn => (BinIO.closeOut outs; NONE)
341 :     end
342 :     in
343 :     case #stableinfo grec of
344 :     GG.STABLE _ => SOME g
345 :     | GG.NONSTABLE granted =>
346 :     if not (recomp (g, gp)) then
347 :     (anyerrors := true; NONE)
348 :     else let
349 :     fun notStable (GG.GROUP { stableinfo, ... }) =
350 :     case stableinfo of
351 :     GG.STABLE _ => false
352 :     | GG.NONSTABLE _ => true
353 : blume 308 in
354 : blume 311 case List.filter notStable (#subgroups grec) of
355 :     [] => doit granted
356 :     | l => let
357 :     val grammar = case l of [_] => " is" | _ => "s are"
358 :     fun ppb pps = let
359 :     fun loop [] = ()
360 :     | loop (GG.GROUP { grouppath, ... } :: t) =
361 :     (PP.add_string pps
362 :     (AbsPath.name grouppath);
363 :     PP.add_newline pps;
364 :     loop t)
365 :     in
366 :     PP.add_newline pps;
367 :     PP.add_string pps
368 :     (concat ["because the following sub-group",
369 :     grammar, " not stable:"]);
370 :     PP.add_newline pps;
371 :     loop l
372 :     end
373 :     val errcons = #errcons gp
374 :     val gname = AbsPath.name (#grouppath grec)
375 :     in
376 :     EM.errorNoFile (errcons, anyerrors) SM.nullRegion
377 :     EM.COMPLAIN
378 :     (gname ^ " cannot be stabilized")
379 :     ppb;
380 :     NONE
381 :     end
382 : blume 308 end
383 : blume 311 end
384 : blume 310
385 :     fun loadStable (gp, getGroup, anyerrors) group = let
386 : blume 306
387 : blume 310 fun bn2env n = Statenv2DAEnv.cvtMemo (fn () => bn2statenv gp n)
388 : blume 308
389 : blume 311 val errcons = #errcons gp
390 :     val grpSrcInfo = (errcons, anyerrors)
391 :     val gname = AbsPath.name group
392 :     fun error l = EM.errorNoFile (errcons, anyerrors) SM.nullRegion
393 :     EM.COMPLAIN (concat (gname :: ": " :: l)) EM.nullErrorBody
394 : blume 309
395 : blume 306 exception Format
396 :    
397 : blume 310 val policy = #fnpolicy (#param gp)
398 :     val spath = FilenamePolicy.mkStablePath policy group
399 : blume 311 val _ = Say.vsay ["[checking stable ", gname, "]\n"]
400 : blume 310 val s = AbsPath.openBinIn spath
401 :    
402 :     fun getGroup' p =
403 :     case getGroup p of
404 :     SOME g => g
405 : blume 311 | NONE =>
406 :     (error ["unable to find ", AbsPath.name p];
407 :     raise Format)
408 : blume 310
409 : blume 306 (* for getting sharing right... *)
410 :     val m = ref IntBinaryMap.empty
411 :     val next = ref 0
412 :    
413 :     fun bytesIn n = let
414 :     val bv = BinIO.inputN (s, n)
415 : blume 304 in
416 : blume 306 if n = Word8Vector.length bv then bv
417 :     else raise Format
418 : blume 304 end
419 :    
420 : blume 306 val sz = LargeWord.toIntX (Pack32Big.subVec (bytesIn 4, 0))
421 :     val pickle = bytesIn sz
422 :     val offset_adjustment = sz + 4
423 : blume 304
424 : blume 306 val rd = let
425 :     val pos = ref 0
426 :     fun rd () = let
427 :     val p = !pos
428 :     in
429 :     pos := p + 1;
430 :     Byte.byteToChar (Word8Vector.sub (pickle, p))
431 :     handle _ => raise Format
432 :     end
433 : blume 304 in
434 : blume 306 rd
435 : blume 304 end
436 :    
437 : blume 306 fun r_list r () =
438 :     case rd () of
439 :     #"0" => []
440 :     | #"1" => [r ()]
441 :     | #"2" => [r (), r ()]
442 :     | #"3" => [r (), r (), r ()]
443 :     | #"4" => [r (), r (), r (), r ()]
444 :     | #"5" => r () :: r () :: r () :: r () :: r () :: r_list r ()
445 :     | _ => raise Format
446 : blume 304
447 : blume 306 fun r_bool () =
448 :     case rd () of
449 :     #"t" => true
450 :     | #"f" => false
451 :     | _ => raise Format
452 : blume 304
453 : blume 306 fun r_option r_item () =
454 :     case rd () of
455 :     #"n" => NONE
456 :     | #"s" => SOME (r_item ())
457 :     | _ => raise Format
458 : blume 304
459 : blume 306 fun r_int () = let
460 :     fun loop n = let
461 :     val w8 = Byte.charToByte (rd ())
462 :     val n' = n * 0w128 + Word8.toLargeWord (Word8.andb (w8, 0w127))
463 :     in
464 :     if Word8.andb (w8, 0w128) = 0w0 then n' else loop n'
465 :     end
466 :     in
467 :     LargeWord.toIntX (loop 0w0)
468 :     end
469 : blume 304
470 : blume 306 fun r_share r_raw C unC () =
471 :     case rd () of
472 :     #"o" => (case IntBinaryMap.find (!m, r_int ()) of
473 :     SOME x => unC x
474 :     | NONE => raise Format)
475 :     | #"n" => let
476 :     val i = !next
477 :     val _ = next := i + 1
478 :     val v = r_raw ()
479 :     in
480 :     m := IntBinaryMap.insert (!m, i, C v);
481 :     v
482 :     end
483 :     | _ => raise Format
484 : blume 304
485 : blume 306 fun r_string () = let
486 :     fun loop l =
487 :     case rd () of
488 :     #"\"" => String.implode (rev l)
489 :     | #"\\" => loop (rd () :: l)
490 :     | c => loop (c :: l)
491 :     in
492 :     loop []
493 :     end
494 : blume 304
495 : blume 306 val r_abspath = let
496 :     fun r_abspath_raw () =
497 :     case AbsPath.unpickle (r_list r_string ()) of
498 :     SOME p => p
499 :     | NONE => raise Format
500 : blume 307 fun unUAP (UAP x) = x
501 :     | unUAP _ = raise Format
502 : blume 306 in
503 : blume 307 r_share r_abspath_raw UAP unUAP
504 : blume 306 end
505 : blume 304
506 : blume 306 val r_symbol = let
507 :     fun r_symbol_raw () = let
508 :     val (ns, first) =
509 :     case rd () of
510 :     #"`" => (Symbol.sigSymbol, rd ())
511 :     | #"(" => (Symbol.fctSymbol, rd ())
512 :     | #")" => (Symbol.fsigSymbol, rd ())
513 :     | c => (Symbol.strSymbol, c)
514 :     fun loop (#".", l) = String.implode (rev l)
515 :     | loop (c, l) = loop (rd (), c :: l)
516 :     in
517 :     ns (loop (first, []))
518 :     end
519 : blume 307 fun unUS (US x) = x
520 :     | unUS _ = raise Format
521 : blume 306 in
522 : blume 307 r_share r_symbol_raw US unUS
523 : blume 306 end
524 : blume 304
525 : blume 306 val r_ss = let
526 :     fun r_ss_raw () =
527 :     SymbolSet.addList (SymbolSet.empty, r_list r_symbol ())
528 : blume 307 fun unUSS (USS s) = s
529 :     | unUSS _ = raise Format
530 : blume 306 in
531 : blume 307 r_share r_ss_raw USS unUSS
532 : blume 306 end
533 : blume 304
534 : blume 306 val r_filter = r_option r_ss
535 : blume 305
536 : blume 306 fun r_primitive () =
537 :     case Primitive.fromIdent (rd ()) of
538 :     NONE => raise Format
539 :     | SOME p => p
540 : blume 305
541 : blume 306 fun r_sharing () =
542 :     case rd () of
543 :     #"n" => NONE
544 :     | #"t" => SOME true
545 :     | #"f" => SOME false
546 :     | _ => raise Format
547 : blume 305
548 : blume 307 fun r_si () = let
549 :     val spec = r_string ()
550 :     val locs = r_string ()
551 :     val offset = r_int () + offset_adjustment
552 :     val share = r_sharing ()
553 :     val error = EM.errorNoSource grpSrcInfo locs
554 : blume 306 in
555 : blume 307 BinInfo.new { group = group,
556 :     error = error,
557 :     spec = spec,
558 :     offset = offset,
559 :     share = share }
560 : blume 306 end
561 : blume 305
562 : blume 306 fun r_bn () =
563 :     case rd () of
564 :     #"p" => DG.PNODE (r_primitive ())
565 : blume 307 | #"b" => let
566 :     val p = r_abspath ()
567 :     val os = r_int ()
568 :     in
569 : blume 310 case getGroup' p of
570 :     GG.GROUP { stableinfo = GG.STABLE im, ... } =>
571 : blume 307 (case IntBinaryMap.find (im, os) of
572 :     NONE => raise Format
573 :     | SOME n => n)
574 : blume 310 | _ => raise Format
575 : blume 307 end
576 : blume 306 | _ => raise Format
577 :    
578 :     (* this is the place where what used to be an
579 :     * SNODE changes to a BNODE! *)
580 : blume 307 fun r_sn_raw () =
581 : blume 306 DG.BNODE { bininfo = r_si (),
582 :     localimports = r_list r_sn (),
583 :     globalimports = r_list r_fsbn () }
584 :    
585 : blume 307 and r_sn () =
586 :     r_share r_sn_raw UBN (fn (UBN n) => n | _ => raise Format) ()
587 :    
588 : blume 306 (* this one changes from farsbnode to plain farbnode *)
589 :     and r_sbn () =
590 :     case rd () of
591 :     #"b" => r_bn ()
592 :     | #"s" => r_sn ()
593 :     | _ => raise Format
594 :    
595 :     and r_fsbn () = (r_filter (), r_sbn ())
596 :    
597 :     fun r_impexp () = let
598 :     val sy = r_symbol ()
599 :     val (f, n) = r_fsbn () (* really reads farbnodes! *)
600 : blume 307 val e = bn2env n
601 : blume 310 (* put a filter in front to avoid having the FCTENV being
602 :     * queried needlessly (this avoids spurious module loadings) *)
603 :     val e' = DAEnv.FILTER (SymbolSet.singleton sy, e)
604 : blume 305 in
605 : blume 310 (sy, ((f, DG.SB_BNODE n), e')) (* coerce to farsbnodes *)
606 : blume 305 end
607 : blume 306
608 :     fun r_exports () =
609 :     foldl SymbolMap.insert' SymbolMap.empty (r_list r_impexp ())
610 :    
611 :     fun r_privileges () =
612 :     StringSet.addList (StringSet.empty, r_list r_string ())
613 :    
614 :     fun unpickle_group () = let
615 :     val exports = r_exports ()
616 :     val islib = r_bool ()
617 :     val required = r_privileges ()
618 : blume 310 val subgroups = r_list (getGroup' o r_abspath) ()
619 : blume 308 val simap = genStableInfoMap (exports, group)
620 : blume 306 in
621 :     GG.GROUP { exports = exports,
622 :     islib = islib,
623 :     required = required,
624 : blume 308 grouppath = group,
625 : blume 306 subgroups = subgroups,
626 : blume 307 stableinfo = GG.STABLE simap }
627 : blume 310 before BinIO.closeIn s
628 : blume 306 end
629 : blume 304 in
630 : blume 310 SOME (unpickle_group ())
631 :     handle Format => (BinIO.closeIn s; NONE)
632 :     | exn => (BinIO.closeIn s; raise exn)
633 :     end handle IO.Io _ => NONE
634 : blume 304 end
635 : blume 309
636 :     end (* local *)

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