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

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/stable/stabilize.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 306, Tue Jun 1 08:25:21 1999 UTC revision 323, Wed Jun 9 06:16:22 1999 UTC
# Line 1  Line 1 
1  structure Stablize = struct  (*
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      structure DG = DependencyGraph      structure DG = DependencyGraph
10      structure GG = GroupGraph      structure GG = GroupGraph
11      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
12        structure PP = PrettyPrint
13      datatype item =      structure SM = GenericVC.SourceMap
14          SS of SymbolSet.set      structure GP = GeneralParams
15        | S of Symbol.symbol      structure E = GenericVC.Environment
16        | SI of SmlInfo.info              (* only used during pickling *)  
17        | AP of AbsPath.t      type statenvgetter = GP.info -> DG.bnode -> E.staticEnv
18        | BI of BinInfo.info              (* only used during unpickling *)      type recomp = GP.info -> GG.group -> bool
19    in
20      fun compare (S s, S s') = SymbolOrdKey.compare (s, s')  
21        | compare (S _, _) = GREATER  signature STABILIZE = sig
22        | compare (_, S _) = LESS  
23        | compare (SS s, SS s') = SymbolSet.compare (s, s')      val loadStable :
24        | compare (SS _, _) = GREATER          GP.info * (AbsPath.t -> GG.group option) * bool ref ->
25        | compare (_, SS _) = LESS          AbsPath.t -> GG.group option
26        | compare (SI i, SI i') = SmlInfo.compare (i, i')  
27        | compare (SI _, _) = GREATER      val stabilize :
28        | compare (_, SI _) = LESS          GP.info -> { group: GG.group, anyerrors: bool ref } ->
29        | compare (AP p, AP p') = AbsPath.compare (p, p')          GG.group option
30        | compare (AP _, _) = GREATER  end
31        | compare (_, AP _) = LESS  
32        | compare (BI i, BI i') = BinInfo.compare (i, i')  functor StabilizeFn (val bn2statenv : statenvgetter
33                         val recomp: recomp) :> STABILIZE = struct
34    
35        datatype pitem =
36            PSS of SymbolSet.set
37          | PS of Symbol.symbol
38          | PSN of DG.snode
39          | PAP of AbsPath.t
40    
41        datatype uitem =
42            USS of SymbolSet.set
43          | US of Symbol.symbol
44          | UBN of DG.bnode
45          | UAP of AbsPath.t
46    
47        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      structure Map =      structure Map =
60          BinaryMapFn (struct          BinaryMapFn (struct
61                           type ord_key = item                           type ord_key = pitem
62                           val compare = compare                           val compare = compare
63          end)          end)
64    
65      fun stabilize (g as GG.GROUP grec, binSizeOf, binCopy, gp) =      fun genStableInfoMap (exports, group) = let
66          case #stableinfo grec of          (* find all the exported bnodes that are in the same group: *)
67              GG.STABLE _ => g          fun add (((_, DG.SB_BNODE (n as DG.BNODE b)), _), m) = let
68            | GG.NONSTABLE granted => let              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        fun deleteFile n = OS.FileSys.remove n
80            handle e as Interrupt.Interrupt => raise e
81                 | _ => ()
82    
83        fun stabilize gp { group = g as GG.GROUP grec, anyerrors } = let
84    
85            val primconf = #primconf (#param gp)
86            val policy = #fnpolicy (#param gp)
87    
88            fun doit granted = let
89    
90                val _ =
91                    if StringSet.isEmpty granted then ()
92                    else
93                        Say.say ("$Stabilize: wrapping the following privileges:\n"
94                                 :: map (fn s => ("  " ^ s ^ "\n"))
95                                        (StringSet.listItems granted))
96    
97                val bname = AbsPath.name o SmlInfo.binpath
98                val bsz = OS.FileSys.fileSize o bname
99                fun cpb s i = let
100                    val ins = BinIO.openIn (bname i)
101                    fun cp () =
102                        if BinIO.endOfStream ins then ()
103                        else (BinIO.output (s, BinIO.input ins); cp ())
104                in
105                    cp () handle e => (BinIO.closeIn ins; raise e);
106                        BinIO.closeIn ins
107                end
108                val delb = deleteFile o bname
109    
110                val grpSrcInfo = (#errcons gp, anyerrors)
111    
112                  val exports = #exports grec                  val exports = #exports grec
113                val islib = #islib grec
114                val required = StringSet.difference (#required grec, granted)
115                val grouppath = #grouppath grec
116                val subgroups = #subgroups grec
117    
118                  (* The format of a stable archive is the following:                  (* The format of a stable archive is the following:
119                   *  - It starts with the size s of the pickled dependency                   *  - It starts with the size s of the pickled dependency
# Line 49  Line 126 
126                   *    need no further adjustment.                   *    need no further adjustment.
127                   *  - Individual binfile contents (concatenated).                   *  - Individual binfile contents (concatenated).
128                   *)                   *)
                 val members = let  
                     fun sn (DG.SNODE { smlinfo, localimports = l, ... }, s) =  
                               if SmlInfoSet.member (s, smlinfo) then s  
                               else foldl sn (SmlInfoSet.add (s, smlinfo)) l  
                     fun impexp (((_, DG.SB_BNODE _), _), s) = s  
                       | impexp (((_, DG.SB_SNODE n), _), s) = sn (n, s)  
                 in  
                               SmlInfoSet.listItems  
                               (SymbolMap.foldl impexp SmlInfoSet.empty exports)  
                 end  
   
                 val offsetDict = let  
                     fun add (i, (d, n)) =  
                         (SmlInfoMap.insert (d, i, n), n + binSizeOf i)  
                 in  
                     #1 (foldl add (SmlInfoMap.empty, 0) members)  
                 end  
129    
130                  fun w_list w_item [] k m = "0" :: k m              val members = ref []
131                    | w_list w_item [a] k m = "1" :: w_item a k m              val (registerOffset, getOffset) = let
132                    | w_list w_item [a, b] k m = "2" :: w_item a (w_item b k) m                  val dict = ref SmlInfoMap.empty
133                    val cur = ref 0
134                    fun reg (i, sz) = let
135                        val os = !cur
136                    in
137                        cur := os + sz;
138                        dict := SmlInfoMap.insert (!dict, i, os);
139                        members := i :: (!members);
140                        os
141                    end
142                    fun get i = valOf (SmlInfoMap.find (!dict, i))
143                in
144                    (reg, get)
145                end
146    
147                fun w_list w_item [] k m =
148                    "0" :: k m
149                  | w_list w_item [a] k m =
150                    "1" :: w_item a k m
151                  | w_list w_item [a, b] k m =
152                    "2" :: w_item a (w_item b k) m
153                    | w_list w_item [a, b, c] k m =                    | w_list w_item [a, b, c] k m =
154                      "3" :: w_item a (w_item b (w_item c k)) m                      "3" :: w_item a (w_item b (w_item c k)) m
155                    | w_list w_item [a, b, c, d] k m =                    | w_list w_item [a, b, c, d] k m =
# Line 115  Line 195 
195                      ns :: Symbol.name s :: "." :: k m                      ns :: Symbol.name s :: "." :: k m
196                  end                  end
197    
198                  val w_symbol = w_share w_symbol_raw S              val w_symbol = w_share w_symbol_raw PS
199    
200                  val w_ss = w_share (w_list w_symbol o SymbolSet.listItems) SS              val w_ss = w_share (w_list w_symbol o SymbolSet.listItems) PSS
201    
202                  val w_filter = w_option w_ss                  val w_filter = w_option w_ss
203    
# Line 125  Line 205 
205                      fun esc #"\\" = "\\\\"                      fun esc #"\\" = "\\\\"
206                        | esc #"\"" = "\\\""                        | esc #"\"" = "\\\""
207                        | esc c = String.str c                        | esc c = String.str c
   
208                  in                  in
209                      String.translate esc s :: "\"" :: k m                      String.translate esc s :: "\"" :: k m
210                  end                  end
# Line 134  Line 213 
213                    | w_sharing (SOME true) k m = "t" :: k m                    | w_sharing (SOME true) k m = "t" :: k m
214                    | w_sharing (SOME false) k m = "f" :: k m                    | w_sharing (SOME false) k m = "f" :: k m
215    
216                  fun w_si_raw i k = let              fun w_si i k = let
217                      val spec = AbsPath.spec (SmlInfo.sourcepath i)                      val spec = AbsPath.spec (SmlInfo.sourcepath i)
218                      val locs = SmlInfo.errorLocation gp i                      val locs = SmlInfo.errorLocation gp i
219                      val offset = valOf (SmlInfoMap.find (offsetDict, i))                  val offset = registerOffset (i, bsz i)
220                  in                  in
221                      w_string spec                      w_string spec
222                          (w_string locs                          (w_string locs
# Line 145  Line 224 
224                                   (w_sharing (SmlInfo.share i) k)))                                   (w_sharing (SmlInfo.share i) k)))
225                  end                  end
226    
227                  val w_si = w_share w_si_raw SI              fun w_primitive p k m =
228                    String.str (Primitive.toIdent primconf p) :: k m
                 fun w_primitive p k m = String.str (Primitive.toIdent p) :: k m  
229    
230                  fun w_abspath_raw p k m =              fun w_abspath_raw p k m = w_list w_string (AbsPath.pickle p) k m
                     w_list w_string (AbsPath.pickle p) k m  
231    
232                  val w_abspath = w_share w_abspath_raw AP              val w_abspath = w_share w_abspath_raw PAP
233    
234                  fun w_bn (DG.PNODE p) k m = "p" :: w_primitive p k m                  fun w_bn (DG.PNODE p) k m = "p" :: w_primitive p k m
235                    | w_bn (DG.BNODE { bininfo = i, ... }) k m =                    | w_bn (DG.BNODE { bininfo = i, ... }) k m =
236                      "b" :: w_abspath (BinInfo.group i)                      "b" :: w_abspath (BinInfo.group i)
237                                (w_int (BinInfo.offset i) k) m                                (w_int (BinInfo.offset i) k) m
238    
239                  fun w_sn (DG.SNODE n) k =              fun w_sn_raw (DG.SNODE n) k =
240                      w_si (#smlinfo n)                      w_si (#smlinfo n)
241                          (w_list w_sn (#localimports n)                          (w_list w_sn (#localimports n)
242                                (w_list w_fsbn (#globalimports n) k))                                (w_list w_fsbn (#globalimports n) k))
243    
244                and w_sn n = w_share w_sn_raw PSN n
245    
246                  and w_sbn (DG.SB_BNODE n) k m = "b" :: w_bn n k m                  and w_sbn (DG.SB_BNODE n) k m = "b" :: w_bn n k m
247                    | w_sbn (DG.SB_SNODE n) k m = "s" :: w_sn n k m                    | w_sbn (DG.SB_SNODE n) k m = "s" :: w_sn n k m
248    
# Line 178  Line 257 
257    
258                  fun w_privileges p = w_list w_string (StringSet.listItems p)                  fun w_privileges p = w_list w_string (StringSet.listItems p)
259    
260                  fun pickle_group (GG.GROUP g, granted) = let              fun pickle_group () = let
261                      fun w_sg (GG.GROUP g) = w_abspath (#grouppath g)                      fun w_sg (GG.GROUP g) = w_abspath (#grouppath g)
                     val req' = StringSet.difference (#required g, granted)  
262                      fun k0 m = []                      fun k0 m = []
263                      val m0 = (0, Map.empty)                      val m0 = (0, Map.empty)
264                  in                  in
265                      concat                  concat (w_exports exports
266                         (w_exports (#exports g)                               (w_bool islib
267                            (w_bool (#islib g)                                     (w_privileges required
268                                (w_privileges req'                                            (w_list w_sg subgroups k0))) m0)
                                    (w_abspath (#grouppath g)  
                                          (w_list w_sg (#subgroups g) k0)))) m0)  
269                  end                  end
270                  val pickle = pickle_group (g, granted)  
271                val pickle = pickle_group ()
272                  val sz = size pickle                  val sz = size pickle
273                val offset_adjustment = sz + 4
274    
275                fun mkStableGroup () = let
276                    val m = ref SmlInfoMap.empty
277                    fun sn (DG.SNODE (n as { smlinfo, ... })) =
278                        case SmlInfoMap.find (!m, smlinfo) of
279                            SOME n => n
280                          | NONE => let
281                                val li = map sn (#localimports n)
282                                val gi = map fsbn (#globalimports n)
283                                val sourcepath = SmlInfo.sourcepath smlinfo
284                                val spec = AbsPath.spec sourcepath
285                                val offset =
286                                    getOffset smlinfo + offset_adjustment
287                                val share = SmlInfo.share smlinfo
288                                val locs = SmlInfo.errorLocation gp smlinfo
289                                val error = EM.errorNoSource grpSrcInfo locs
290                                val i = BinInfo.new { group = grouppath,
291                                                      spec = spec,
292                                                      offset = offset,
293                                                      share = share,
294                                                      error = error }
295                                val n = DG.BNODE { bininfo = i,
296                                                   localimports = li,
297                                                   globalimports = gi }
298              in              in
299                  Dummy.f ()                              m := SmlInfoMap.insert (!m, smlinfo, n);
300                                n
301              end              end
302    
303      fun g (getGroup, fsbn2env, knownStable, grpSrcInfo, group, s) = let                  and sbn (DG.SB_SNODE n) = sn n
304                      | sbn (DG.SB_BNODE n) = n
305    
306                    and fsbn (f, n) = (f, sbn n)
307    
308                    fun impexp ((f, n), e) = ((f, DG.SB_BNODE (sbn n)), e)
309    
310                    val exports = SymbolMap.map impexp (#exports grec)
311                    val simap = genStableInfoMap (exports, grouppath)
312                in
313                    GG.GROUP { exports = exports,
314                               islib = islib,
315                               required = required,
316                               grouppath = grouppath,
317                               subgroups = subgroups,
318                               stableinfo = GG.STABLE simap }
319                end
320    
321                fun writeInt32 (s, i) = let
322                    val a = Word8Array.array (4, 0w0)
323                    val _ = Pack32Big.update (a, 0, LargeWord.fromInt i)
324                in
325                    BinIO.output (s, Word8Array.extract (a, 0, NONE))
326                end
327                val memberlist = rev (!members)
328    
329                val gpath = #grouppath grec
330                val spath = FilenamePolicy.mkStablePath policy gpath
331                fun delete () = deleteFile (AbsPath.name spath)
332                val outs = AbsPath.openBinOut spath
333                fun try () =
334                    (Say.vsay ["[stabilizing ", AbsPath.name gpath, "]\n"];
335                     writeInt32 (outs, sz);
336                     BinIO.output (outs, Byte.stringToBytes pickle);
337                     app (cpb outs) memberlist;
338                     app delb memberlist;
339                     BinIO.closeOut outs;
340                     SOME (mkStableGroup ()))
341            in
342                Interrupt.guarded try
343                handle e as Interrupt.Interrupt => (BinIO.closeOut outs;
344                                                    delete ();
345                                                    raise e)
346                     | exn => (BinIO.closeOut outs; NONE)
347            end
348        in
349            case #stableinfo grec of
350                GG.STABLE _ => SOME g
351              | GG.NONSTABLE granted =>
352                    if not (recomp gp g) then
353                        (anyerrors := true; NONE)
354                    else let
355                        fun notStable (GG.GROUP { stableinfo, ... }) =
356                            case stableinfo of
357                                GG.STABLE _ => false
358                              | GG.NONSTABLE _ => true
359                    in
360                        case List.filter notStable (#subgroups grec) of
361                            [] => doit granted
362                          | l => let
363                                val grammar = case l of [_] => " is" | _ => "s are"
364                                fun ppb pps = let
365                                    fun loop [] = ()
366                                      | loop (GG.GROUP { grouppath, ... } :: t) =
367                                        (PP.add_string pps
368                                            (AbsPath.name grouppath);
369                                         PP.add_newline pps;
370                                         loop t)
371                                in
372                                    PP.add_newline pps;
373                                    PP.add_string pps
374                                        (concat ["because the following sub-group",
375                                                 grammar, " not stable:"]);
376                                    PP.add_newline pps;
377                                    loop l
378                                end
379                                val errcons = #errcons gp
380                                val gname = AbsPath.name (#grouppath grec)
381                            in
382                                EM.errorNoFile (errcons, anyerrors) SM.nullRegion
383                                   EM.COMPLAIN
384                                   (gname ^ " cannot be stabilized")
385                                   ppb;
386                                NONE
387                            end
388                    end
389        end
390    
391        fun loadStable (gp, getGroup, anyerrors) group = let
392    
393            fun bn2env n = Statenv2DAEnv.cvtMemo (fn () => bn2statenv gp n)
394    
395            val errcons = #errcons gp
396            val grpSrcInfo = (errcons, anyerrors)
397            val gname = AbsPath.name group
398            fun error l = EM.errorNoFile (errcons, anyerrors) SM.nullRegion
399                EM.COMPLAIN (concat (gname :: ": " :: l)) EM.nullErrorBody
400    
401          exception Format          exception Format
402    
403            val pcmode = #pcmode (#param gp)
404            val policy = #fnpolicy (#param gp)
405            val primconf = #primconf (#param gp)
406            val spath = FilenamePolicy.mkStablePath policy group
407            val _ = Say.vsay ["[checking stable ", gname, "]\n"]
408            val s = AbsPath.openBinIn spath
409    
410            fun getGroup' p =
411                case getGroup p of
412                    SOME g => g
413                  | NONE =>
414                        (error ["unable to find ", AbsPath.name p];
415                         raise Format)
416    
417          (* for getting sharing right... *)          (* for getting sharing right... *)
418          val m = ref IntBinaryMap.empty          val m = ref IntBinaryMap.empty
419          val next = ref 0          val next = ref 0
420    
         (* to build the stable info *)  
         val simap = ref IntBinaryMap.empty  
   
421          fun bytesIn n = let          fun bytesIn n = let
422              val bv = BinIO.inputN (s, n)              val bv = BinIO.inputN (s, n)
423          in          in
# Line 292  Line 502 
502    
503          val r_abspath = let          val r_abspath = let
504              fun r_abspath_raw () =              fun r_abspath_raw () =
505                  case AbsPath.unpickle (r_list r_string ()) of                  case AbsPath.unpickle pcmode (r_list r_string ()) of
506                      SOME p => p                      SOME p => p
507                    | NONE => raise Format                    | NONE => raise Format
508              fun unAP (AP x) = x              fun unUAP (UAP x) = x
509                | unAP _ = raise Format                | unUAP _ = raise Format
510          in          in
511              r_share r_abspath_raw AP unAP              r_share r_abspath_raw UAP unUAP
512          end          end
513    
514          val r_symbol = let          val r_symbol = let
# Line 314  Line 524 
524              in              in
525                  ns (loop (first, []))                  ns (loop (first, []))
526              end              end
527              fun unS (S x) = x              fun unUS (US x) = x
528                | unS _ = raise Format                | unUS _ = raise Format
529          in          in
530              r_share r_symbol_raw S unS              r_share r_symbol_raw US unUS
531          end          end
532    
533          val r_ss = let          val r_ss = let
534              fun r_ss_raw () =              fun r_ss_raw () =
535                  SymbolSet.addList (SymbolSet.empty, r_list r_symbol ())                  SymbolSet.addList (SymbolSet.empty, r_list r_symbol ())
536              fun unSS (SS s) = s              fun unUSS (USS s) = s
537                | unSS _ = raise Format                | unUSS _ = raise Format
538          in          in
539              r_share r_ss_raw SS unSS              r_share r_ss_raw USS unUSS
540          end          end
541    
542          val r_filter = r_option r_ss          val r_filter = r_option r_ss
543    
544          fun r_primitive () =          fun r_primitive () =
545              case Primitive.fromIdent (rd ()) of              case Primitive.fromIdent primconf (rd ()) of
546                  NONE => raise Format                  NONE => raise Format
547                | SOME p => p                | SOME p => p
548    
# Line 343  Line 553 
553                | #"f" => SOME false                | #"f" => SOME false
554                | _ => raise Format                | _ => raise Format
555    
556          val r_si = let          fun r_si () = let
             fun r_si_raw () = let  
557                  val spec = r_string ()                  val spec = r_string ()
558                  val locs = r_string ()                  val locs = r_string ()
559                  val offset = r_int () + offset_adjustment                  val offset = r_int () + offset_adjustment
560                  val share = r_sharing ()                  val share = r_sharing ()
561                  val error = EM.errorNoSource grpSrcInfo locs                  val error = EM.errorNoSource grpSrcInfo locs
562                  val i = BinInfo.new { group = group,          in
563                BinInfo.new { group = group,
564                                        error = error,                                        error = error,
565                                        spec = spec,                                        spec = spec,
566                                        offset = offset,                                        offset = offset,
567                                        share = share }                                        share = share }
             in  
                 simap := IntBinaryMap.insert (!simap, offset, i);  
                 i  
             end  
             fun unBI (BI i) = i  
               | unBI _ = raise Format  
         in  
             r_share r_si_raw BI unBI  
568          end          end
569    
570          fun r_bn () =          fun r_bn () =
571              case rd () of              case rd () of
572                  #"p" => DG.PNODE (r_primitive ())                  #"p" => DG.PNODE (r_primitive ())
573                | #"b" =>                | #"b" => let
574                      (case AbsPathMap.find (knownStable, r_abspath ()) of                      val p = r_abspath ()
575                        val os = r_int ()
576                    in
577                        case getGroup' p of
578                            GG.GROUP { stableinfo = GG.STABLE im, ... } =>
579                                (case IntBinaryMap.find (im, os) of
580                           NONE => raise Format                           NONE => raise Format
581                         | SOME im =>                                 | SOME n => n)
582                               (case IntBinaryMap.find (im, r_int ()) of                        | _ => raise Format
583                                    NONE => raise Format                  end
                                 | SOME n => n))  
584                | _ => raise Format                | _ => raise Format
585    
586          (* this is the place where what used to be an          (* this is the place where what used to be an
587           * SNODE changes to a BNODE! *)           * SNODE changes to a BNODE! *)
588          fun r_sn () =          fun r_sn_raw () =
589              DG.BNODE { bininfo = r_si (),              DG.BNODE { bininfo = r_si (),
590                         localimports = r_list r_sn (),                         localimports = r_list r_sn (),
591                         globalimports = r_list r_fsbn () }                         globalimports = r_list r_fsbn () }
592    
593            and r_sn () =
594                r_share r_sn_raw UBN (fn (UBN n) => n | _ => raise Format) ()
595    
596          (* this one changes from farsbnode to plain farbnode *)          (* this one changes from farsbnode to plain farbnode *)
597          and r_sbn () =          and r_sbn () =
598              case rd () of              case rd () of
# Line 396  Line 605 
605          fun r_impexp () = let          fun r_impexp () = let
606              val sy = r_symbol ()              val sy = r_symbol ()
607              val (f, n) = r_fsbn ()      (* really reads farbnodes! *)              val (f, n) = r_fsbn ()      (* really reads farbnodes! *)
608              val e = fsbn2env n              val e = bn2env n
609                (* put a filter in front to avoid having the FCTENV being
610                 * queried needlessly (this avoids spurious module loadings) *)
611                val e' = DAEnv.FILTER (SymbolSet.singleton sy, e)
612          in          in
613              (sy, ((f, DG.SB_BNODE n), e)) (* coerce to farsbnodes *)              (sy, ((f, DG.SB_BNODE n), e')) (* coerce to farsbnodes *)
614          end          end
615    
616          fun r_exports () =          fun r_exports () =
# Line 411  Line 623 
623              val exports = r_exports ()              val exports = r_exports ()
624              val islib = r_bool ()              val islib = r_bool ()
625              val required = r_privileges ()              val required = r_privileges ()
626              val grouppath = r_abspath ()              val subgroups = r_list (getGroup' o r_abspath) ()
627              val subgroups = r_list (getGroup o r_abspath) ()              val simap = genStableInfoMap (exports, group)
             fun add (((_, DG.SB_BNODE (DG.BNODE { bininfo, ... })), _), s) =  
                 IntBinarySet.add (s, BinInfo.offset bininfo)  
               | add (_, s) = s  
             val ens = SymbolMap.foldl add IntBinarySet.empty exports  
             fun isExported (os, _) = IntBinarySet.member (ens, os)  
             val final_simap = IntBinaryMap.filteri isExported (!simap)  
628          in          in
629              GG.GROUP { exports = exports,              GG.GROUP { exports = exports,
630                         islib = islib,                         islib = islib,
631                         required = required,                         required = required,
632                         grouppath = grouppath,                         grouppath = group,
633                         subgroups = subgroups,                         subgroups = subgroups,
634                         stableinfo = GG.STABLE final_simap }                         stableinfo = GG.STABLE simap }
635                before BinIO.closeIn s
636          end          end
637      in      in
638          SOME (unpickle_group ()) handle Format => NONE          SOME (unpickle_group ())
639      end          handle Format => (BinIO.closeIn s; NONE)
640                 | exn => (BinIO.closeIn s; raise exn)
641        end handle IO.Io _ => NONE
642  end  end
643    
644    end (* local *)

Legend:
Removed from v.306  
changed lines
  Added in v.323

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