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 308, Wed Jun 2 01:26:19 1999 UTC revision 360, Tue Jun 29 09:21:02 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        structure SM = GenericVC.SourceMap
14        structure GP = GeneralParams
15        structure E = GenericVC.Environment
16        structure Pid = GenericVC.PersStamps
17    
18        type statenvgetter = GP.info -> DG.bnode -> E.staticEnv
19        type recomp = GP.info -> GG.group -> bool
20        type pid = Pid.persstamp
21    in
22    
23    signature STABILIZE = sig
24    
25        val loadStable :
26            GP.info * (SrcPath.t -> GG.group option) * bool ref ->
27            SrcPath.t -> GG.group option
28    
29        val stabilize :
30            GP.info -> { group: GG.group, anyerrors: bool ref } ->
31            GG.group option
32    end
33    
34    functor StabilizeFn (val bn2statenv : statenvgetter
35                         val getPid : SmlInfo.info -> pid option
36                         val warmup : BinInfo.info * pid option -> unit
37                         val recomp : recomp) :> STABILIZE = struct
38    
39      datatype pitem =      datatype pitem =
40          PSS of SymbolSet.set          PSS of SymbolSet.set
41        | PS of Symbol.symbol        | PS of Symbol.symbol
42        | PSN of DG.snode        | PSN of DG.snode
       | PAP of AbsPath.t  
43    
44      datatype uitem =      datatype uitem =
45          USS of SymbolSet.set          USS of SymbolSet.set
46        | US of Symbol.symbol        | US of Symbol.symbol
47        | UBN of DG.bnode        | UBN of DG.bnode
       | UAP of AbsPath.t  
48    
49      fun compare (PS s, PS s') = SymbolOrdKey.compare (s, s')      fun compare (PS s, PS s') = SymbolOrdKey.compare (s, s')
50        | compare (PS _, _) = GREATER        | compare (PS _, _) = GREATER
# Line 24  Line 54 
54        | compare (_, PSS _) = LESS        | compare (_, PSS _) = LESS
55        | compare (PSN (DG.SNODE n), PSN (DG.SNODE n')) =        | compare (PSN (DG.SNODE n), PSN (DG.SNODE n')) =
56          SmlInfo.compare (#smlinfo n, #smlinfo n')          SmlInfo.compare (#smlinfo n, #smlinfo n')
       | compare (PSN _, _) = GREATER  
       | compare (_, PSN _) = LESS  
       | compare (PAP p, PAP p') = AbsPath.compare (p, p')  
57    
58      structure Map =      structure Map =
59          BinaryMapFn (struct          BinaryMapFn (struct
# Line 39  Line 66 
66          fun add (((_, DG.SB_BNODE (n as DG.BNODE b)), _), m) = let          fun add (((_, DG.SB_BNODE (n as DG.BNODE b)), _), m) = let
67              val i = #bininfo b              val i = #bininfo b
68          in          in
69              if AbsPath.compare (BinInfo.group i, group) = EQUAL then              if SrcPath.compare (BinInfo.group i, group) = EQUAL then
70                  IntBinaryMap.insert (m, BinInfo.offset i, n)                  IntBinaryMap.insert (m, BinInfo.offset i, n)
71              else m              else m
72          end          end
# Line 48  Line 75 
75          SymbolMap.foldl add IntBinaryMap.empty exports          SymbolMap.foldl add IntBinaryMap.empty exports
76      end      end
77    
78      fun stabilize gp (g as GG.GROUP grec, binSizeOf, copyBin, outs) =      fun stabilize gp { group = g as GG.GROUP grec, anyerrors } = let
         case #stableinfo grec of  
             GG.STABLE _ => g  
           | GG.NONSTABLE granted => let  
79    
80                  (* this needs to be refined (perhaps) *)          val primconf = #primconf (#param gp)
81                  val grpSrcInfo = (EM.defaultConsumer (), ref false)          val policy = #fnpolicy (#param gp)
82    
                 val exports = #exports grec  
                 val islib = #islib grec  
                 val required = StringSet.difference (#required grec,  
                                                      granted)  
83                  val grouppath = #grouppath grec                  val grouppath = #grouppath grec
84                  val subgroups = #subgroups grec  
85            fun doit wrapped = let
86    
87                val _ =
88                    if StringSet.isEmpty wrapped then ()
89                    else
90                        Say.say ("$Stabilize: wrapping the following privileges:\n"
91                                 :: map (fn s => ("  " ^ s ^ "\n"))
92                                        (StringSet.listItems wrapped))
93    
94                val bname = SmlInfo.binname
95                val bsz = OS.FileSys.fileSize o bname
96    
97                fun cpb s i = let
98                    val N = 4096
99                    fun copy ins = let
100                        fun cp () =
101                            if BinIO.endOfStream ins then ()
102                            else (BinIO.output (s, BinIO.inputN (ins, N));
103                                  cp ())
104                    in
105                        cp ()
106                    end
107                in
108                    SafeIO.perform { openIt = fn () => BinIO.openIn (bname i),
109                                     closeIt = BinIO.closeIn,
110                                     work = copy,
111                                     cleanup = fn () => () }
112                end
113    
114                val grpSrcInfo = (#errcons gp, anyerrors)
115    
116                val exports = #exports grec
117                val required = StringSet.difference (#required grec, wrapped)
118                val sublibs = #sublibs grec
119    
120                  (* The format of a stable archive is the following:                  (* The format of a stable archive is the following:
121                   *  - It starts with the size s of the pickled dependency                   *  - It starts with the size s of the pickled dependency
# Line 75  Line 129 
129                   *  - Individual binfile contents (concatenated).                   *  - Individual binfile contents (concatenated).
130                   *)                   *)
131    
132                (* Here we build a mapping that maps each BNODE to a number
133                 * representing the sub-library that it came from and a
134                 * representative symbol that can be used to find the BNODE
135                 * within the exports of that library *)
136                fun oneB i (sy, ((_, DG.SB_BNODE (DG.BNODE n)), _), m) =
137                    StableMap.insert (m, #bininfo n, (i, sy))
138                  | oneB i (_, _, m) = m
139                fun oneSL ((_, g as GG.GROUP { exports, ... }), (m, i)) =
140                    (SymbolMap.foldli (oneB i) m exports, i + 1)
141                val inverseMap = #1 (foldl oneSL (StableMap.empty, 0) sublibs)
142    
143                  val members = ref []                  val members = ref []
144                  val (registerOffset, getOffset) = let                  val (registerOffset, getOffset) = let
145                      val dict = ref SmlInfoMap.empty                      val dict = ref SmlInfoMap.empty
# Line 153  Line 218 
218                      fun esc #"\\" = "\\\\"                      fun esc #"\\" = "\\\\"
219                        | esc #"\"" = "\\\""                        | esc #"\"" = "\\\""
220                        | esc c = String.str c                        | esc c = String.str c
   
221                  in                  in
222                      String.translate esc s :: "\"" :: k m                      String.translate esc s :: "\"" :: k m
223                  end                  end
# Line 163  Line 227 
227                    | w_sharing (SOME false) k m = "f" :: k m                    | w_sharing (SOME false) k m = "f" :: k m
228    
229                  fun w_si i k = let                  fun w_si i k = let
230                      val spec = AbsPath.spec (SmlInfo.sourcepath i)                  (* FIXME: this is not a technical flaw, but perhaps one
231                     * that deserves fixing anyway:  If we only look at spec,
232                     * then we are losing information about sub-grouping
233                     * within libraries.  However, the spec in BinInfo.info
234                     * is only used for diagnostics and has no impact on the
235                     * operation of CM itself. *)
236                    val spec = SrcPath.specOf (SmlInfo.sourcepath i)
237                      val locs = SmlInfo.errorLocation gp i                      val locs = SmlInfo.errorLocation gp i
238                      val offset = registerOffset (i, binSizeOf i)                  val offset = registerOffset (i, bsz i)
239                  in                  in
240                      w_string spec                      w_string spec
241                          (w_string locs                          (w_string locs
# Line 173  Line 243 
243                                   (w_sharing (SmlInfo.share i) k)))                                   (w_sharing (SmlInfo.share i) k)))
244                  end                  end
245    
246                  fun w_primitive p k m = String.str (Primitive.toIdent p) :: k m              fun w_primitive p k m =
247                    String.str (Primitive.toIdent primconf p) :: k m
                 fun w_abspath_raw p k m =  
                     w_list w_string (AbsPath.pickle p) k m  
248    
249                  val w_abspath = w_share w_abspath_raw PAP              fun warn_relabs p abs = let
250                    val relabs = if abs then "absolute" else "relative"
251                    fun ppb pps =
252                        (PP.add_newline pps;
253                         PP.add_string pps (SrcPath.descr p);
254                         PP.add_newline pps;
255                         PP.add_string pps
256        "(This means that in order to be able to use the result of stabilization";
257                         PP.add_newline pps;
258                         PP.add_string pps "the library must be in the same ";
259                         PP.add_string pps relabs;
260                         PP.add_string pps " location as it is now.)";
261                         PP.add_newline pps)
262                in
263                    EM.errorNoFile (#errcons gp, anyerrors) SM.nullRegion
264                        EM.WARN
265                        (concat [SrcPath.descr grouppath,
266                                 ": library referred to by ", relabs,
267                                 " pathname:"])
268                        ppb
269                end
270    
271                fun w_abspath p k m =
272                    w_list w_string (SrcPath.pickle (warn_relabs p) (p, grouppath))
273                                    k m
274    
275                  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
276                    | w_bn (DG.BNODE { bininfo = i, ... }) k m =                | w_bn (DG.BNODE { bininfo = i, ... }) k m = let
277                      "b" :: w_abspath (BinInfo.group i)                      val (n, sy) = valOf (StableMap.find (inverseMap, i))
278                                (w_int (BinInfo.offset i) k) m                  in
279                        "b" :: w_int n (w_symbol sy k) m
280                    end
281    
282                fun w_pid p = w_string (Byte.bytesToString (Pid.toBytes p))
283    
284                  fun w_sn_raw (DG.SNODE n) k =                  fun w_sn_raw (DG.SNODE n) k =
285                      w_si (#smlinfo n)                  w_option w_pid (getPid (#smlinfo n))
286                             (w_si (#smlinfo n)
287                          (w_list w_sn (#localimports n)                          (w_list w_sn (#localimports n)
288                                (w_list w_fsbn (#globalimports n) k))                                         (w_list w_fsbn (#globalimports n) k)))
289    
290                  and w_sn n = w_share w_sn_raw PSN n                  and w_sn n = w_share w_sn_raw PSN n
291    
# Line 207  Line 304 
304                  fun w_privileges p = w_list w_string (StringSet.listItems p)                  fun w_privileges p = w_list w_string (StringSet.listItems p)
305    
306                  fun pickle_group () = let                  fun pickle_group () = let
307                      fun w_sg (GG.GROUP g) = w_abspath (#grouppath g)                  fun w_sg (p, _) = w_abspath p
308                      fun k0 m = []                      fun k0 m = []
309                      val m0 = (0, Map.empty)                      val m0 = (0, Map.empty)
310                  in                  in
311                      concat                  (* Pickle the sublibs first because we need to already
312                     * have them back when we unpickle BNODEs. *)
313                    concat (w_list w_sg sublibs
314                         (w_exports exports                         (w_exports exports
315                             (w_bool islib                                   (w_privileges required k0)) m0)
                               (w_privileges required  
                                     (w_list w_sg subgroups k0))) m0)  
316                  end                  end
317    
318                  val pickle = pickle_group ()                  val pickle = pickle_group ()
319                  val sz = size pickle                  val sz = size pickle
320                  val offset_adjustment = sz + 4                  val offset_adjustment = sz + 4
321    
322                  fun mkStableGroup () = let              fun mkStableGroup sname = let
323                      val m = ref SmlInfoMap.empty                      val m = ref SmlInfoMap.empty
324                      fun sn (DG.SNODE (n as { smlinfo, ... })) =                      fun sn (DG.SNODE (n as { smlinfo, ... })) =
325                          case SmlInfoMap.find (!m, smlinfo) of                          case SmlInfoMap.find (!m, smlinfo) of
# Line 231  Line 328 
328                                  val li = map sn (#localimports n)                                  val li = map sn (#localimports n)
329                                  val gi = map fsbn (#globalimports n)                                  val gi = map fsbn (#globalimports n)
330                                  val sourcepath = SmlInfo.sourcepath smlinfo                                  val sourcepath = SmlInfo.sourcepath smlinfo
331                                  val spec = AbsPath.spec sourcepath                              (* FIXME: see the comment near the other
332                                 * occurence of SrcPath.spec... *)
333                                val spec = SrcPath.specOf sourcepath
334                                  val offset =                                  val offset =
335                                      getOffset smlinfo + offset_adjustment                                      getOffset smlinfo + offset_adjustment
336                                  val share = SmlInfo.share smlinfo                                  val share = SmlInfo.share smlinfo
337                                  val locs = SmlInfo.errorLocation gp smlinfo                                  val locs = SmlInfo.errorLocation gp smlinfo
338                                  val error = EM.errorNoSource grpSrcInfo locs                                  val error = EM.errorNoSource grpSrcInfo locs
339                                  val i = BinInfo.new { group = grouppath,                                  val i = BinInfo.new { group = grouppath,
340                                                      stablename = sname,
341                                                        spec = spec,                                                        spec = spec,
342                                                        offset = offset,                                                        offset = offset,
343                                                        share = share,                                                        share = share,
# Line 261  Line 361 
361                      val simap = genStableInfoMap (exports, grouppath)                      val simap = genStableInfoMap (exports, grouppath)
362                  in                  in
363                      GG.GROUP { exports = exports,                      GG.GROUP { exports = exports,
364                                 islib = islib,                             kind = GG.STABLELIB simap,
365                                 required = required,                                 required = required,
366                                 grouppath = grouppath,                                 grouppath = grouppath,
367                                 subgroups = subgroups,                             sublibs = sublibs }
                                stableinfo = GG.STABLE simap }  
368                  end                  end
369    
370                  fun writeInt32 (s, i) = let                  fun writeInt32 (s, i) = let
# Line 274  Line 373 
373                  in                  in
374                      BinIO.output (s, Word8Array.extract (a, 0, NONE))                      BinIO.output (s, Word8Array.extract (a, 0, NONE))
375                  end                  end
376              in              val memberlist = rev (!members)
377    
378                val gpath = #grouppath grec
379                val sname = FilenamePolicy.mkStableName policy gpath
380                fun work outs =
381                    (Say.vsay ["[stabilizing ", SrcPath.descr gpath, "]\n"];
382                  writeInt32 (outs, sz);                  writeInt32 (outs, sz);
383                  BinIO.output (outs, Byte.stringToBytes pickle);                  BinIO.output (outs, Byte.stringToBytes pickle);
384                  app (copyBin outs) (rev (!members));                   app (cpb outs) memberlist;
385                  mkStableGroup ()                   mkStableGroup sname)
386              end          in
387                SOME (SafeIO.perform { openIt = fn () => AutoDir.openBinOut sname,
388      fun g (getGroup, bn2env, group, s) = let                                     closeIt = BinIO.closeOut,
389                                       work = work,
390          (* we don't care about errors... (?) *)                                     cleanup = fn () =>
391          val grpSrcInfo = (EM.defaultConsumer (), ref false)                                      (OS.FileSys.remove sname handle _ => ()) })
392                handle exn => NONE
393            end
394        in
395            case #kind grec of
396                GG.STABLELIB _ => SOME g
397              | GG.NOLIB => EM.impossible "stabilize: no library"
398              | GG.LIB wrapped =>
399                    if not (recomp gp g) then
400                        (anyerrors := true; NONE)
401                    else let
402                        fun notStable (_, GG.GROUP { kind, ... }) =
403                            case kind of GG.STABLELIB _ => false | _ => true
404                    in
405                        case List.filter notStable (#sublibs grec) of
406                            [] => doit wrapped
407                          | l => let
408                                val grammar = case l of [_] => " is" | _ => "s are"
409                                fun ppb pps = let
410                                    fun loop [] = ()
411                                      | loop ((p, GG.GROUP { grouppath, ... })
412                                              :: t) =
413                                        (PP.add_string pps
414                                            (SrcPath.descr grouppath);
415                                         PP.add_string pps " (";
416                                         PP.add_string pps (SrcPath.descr p);
417                                         PP.add_string pps ")";
418                                         PP.add_newline pps;
419                                         loop t)
420                                in
421                                    PP.add_newline pps;
422                                    PP.add_string pps
423                                        (concat ["because the following sub-group",
424                                                 grammar, " not stable:"]);
425                                    PP.add_newline pps;
426                                    loop l
427                                end
428                                val errcons = #errcons gp
429                                val gdescr = SrcPath.descr (#grouppath grec)
430                            in
431                                EM.errorNoFile (errcons, anyerrors) SM.nullRegion
432                                   EM.COMPLAIN
433                                   (gdescr ^ " cannot be stabilized")
434                                   ppb;
435                                NONE
436                            end
437                    end
438        end
439    
440        fun loadStable (gp, getGroup, anyerrors) group = let
441    
442            val es2bs = GenericVC.CoerceEnv.es2bs
443            fun bn2env n =
444                Statenv2DAEnv.cvtMemo (fn () => es2bs (bn2statenv gp n))
445    
446            val errcons = #errcons gp
447            val grpSrcInfo = (errcons, anyerrors)
448            val gdescr = SrcPath.descr group
449            fun error l = EM.errorNoFile (errcons, anyerrors) SM.nullRegion
450                EM.COMPLAIN (concat (gdescr :: ": " :: l)) EM.nullErrorBody
451    
452          exception Format          exception Format
453    
454            val pcmode = #pcmode (#param gp)
455            val policy = #fnpolicy (#param gp)
456            val primconf = #primconf (#param gp)
457            val sname = FilenamePolicy.mkStableName policy group
458            val _ = Say.vsay ["[checking stable ", gdescr, "]\n"]
459    
460            fun work s = let
461    
462                fun getGroup' p =
463                    case getGroup p of
464                        SOME g => g
465                      | NONE => (error ["unable to find ", SrcPath.descr p];
466                                 raise Format)
467    
468          (* for getting sharing right... *)          (* for getting sharing right... *)
469          val m = ref IntBinaryMap.empty          val m = ref IntBinaryMap.empty
470          val next = ref 0          val next = ref 0
471    
472                val pset = ref PidSet.empty
473    
474          fun bytesIn n = let          fun bytesIn n = let
475              val bv = BinIO.inputN (s, n)              val bv = BinIO.inputN (s, n)
476          in          in
# Line 341  Line 520 
520          fun r_int () = let          fun r_int () = let
521              fun loop n = let              fun loop n = let
522                  val w8 = Byte.charToByte (rd ())                  val w8 = Byte.charToByte (rd ())
523                  val n' = n * 0w128 + Word8.toLargeWord (Word8.andb (w8, 0w127))                      val n' =
524                            n * 0w128 + Word8.toLargeWord (Word8.andb (w8, 0w127))
525              in              in
526                  if Word8.andb (w8, 0w128) = 0w0 then n' else loop n'                  if Word8.andb (w8, 0w128) = 0w0 then n' else loop n'
527              end              end
# Line 374  Line 554 
554              loop []              loop []
555          end          end
556    
557          val r_abspath = let              fun r_abspath () =
558              fun r_abspath_raw () =                  case SrcPath.unpickle pcmode (r_list r_string (), group) of
                 case AbsPath.unpickle (r_list r_string ()) of  
559                      SOME p => p                      SOME p => p
560                    | NONE => raise Format                    | NONE => raise Format
             fun unUAP (UAP x) = x  
               | unUAP _ = raise Format  
         in  
             r_share r_abspath_raw UAP unUAP  
         end  
561    
562          val r_symbol = let          val r_symbol = let
563              fun r_symbol_raw () = let              fun r_symbol_raw () = let
564                  val (ns, first) =                  val (ns, first) =
565                      case rd () of                      case rd () of
566                          #"`" => (Symbol.sigSymbol, rd ())                              #"'" => (Symbol.sigSymbol, rd ())
567                        | #"(" => (Symbol.fctSymbol, rd ())                        | #"(" => (Symbol.fctSymbol, rd ())
568                        | #")" => (Symbol.fsigSymbol, rd ())                        | #")" => (Symbol.fsigSymbol, rd ())
569                        | c => (Symbol.strSymbol, c)                        | c => (Symbol.strSymbol, c)
# Line 416  Line 590 
590          val r_filter = r_option r_ss          val r_filter = r_option r_ss
591    
592          fun r_primitive () =          fun r_primitive () =
593              case Primitive.fromIdent (rd ()) of                  case Primitive.fromIdent primconf (rd ()) of
594                  NONE => raise Format                  NONE => raise Format
595                | SOME p => p                | SOME p => p
596    
# Line 435  Line 609 
609              val error = EM.errorNoSource grpSrcInfo locs              val error = EM.errorNoSource grpSrcInfo locs
610          in          in
611              BinInfo.new { group = group,              BinInfo.new { group = group,
612                                  stablename = sname,
613                            error = error,                            error = error,
614                            spec = spec,                            spec = spec,
615                            offset = offset,                            offset = offset,
616                            share = share }                            share = share }
617          end          end
618    
619                fun r_sg () = let
620                    val p = r_abspath ()
621                in
622                    (p, getGroup' p)
623                end
624    
625                val sublibs = r_list r_sg ()
626    
627          fun r_bn () =          fun r_bn () =
628              case rd () of              case rd () of
629                  #"p" => DG.PNODE (r_primitive ())                  #"p" => DG.PNODE (r_primitive ())
630                | #"b" => let                | #"b" => let
631                      val p = r_abspath ()                          val n = r_int ()
632                      val os = r_int ()                          val sy = r_symbol ()
633                      val GG.GROUP { stableinfo, ... } = getGroup p                          val (_, GG.GROUP { exports = slexp, ... }) =
634                                List.nth (sublibs, n) handle _ => raise Format
635                  in                  in
636                      case stableinfo of                          case SymbolMap.find (slexp, sy) of
637                          GG.NONSTABLE _ => raise Format                              SOME ((_, DG.SB_BNODE (n as DG.BNODE _)), _) => n
638                        | GG.STABLE im =>                            | _ => raise Format
                             (case IntBinaryMap.find (im, os) of  
                                  NONE => raise Format  
                                | SOME n => n)  
639                  end                  end
640                | _ => raise Format                | _ => raise Format
641    
642                fun r_pid () = Pid.fromBytes (Byte.stringToBytes (r_string ()))
643    
644          (* this is the place where what used to be an          (* this is the place where what used to be an
645           * SNODE changes to a BNODE! *)           * SNODE changes to a BNODE! *)
646          fun r_sn_raw () =              fun r_sn_raw () = let
647              DG.BNODE { bininfo = r_si (),                  val popt = r_option r_pid ()
648                    val i = r_si ()
649                in
650                    warmup (i, popt);
651                    DG.BNODE { bininfo = i,
652                         localimports = r_list r_sn (),                         localimports = r_list r_sn (),
653                         globalimports = r_list r_fsbn () }                         globalimports = r_list r_fsbn () }
654                end
655    
656          and r_sn () =          and r_sn () =
657              r_share r_sn_raw UBN (fn (UBN n) => n | _ => raise Format) ()              r_share r_sn_raw UBN (fn (UBN n) => n | _ => raise Format) ()
# Line 481  Line 669 
669              val sy = r_symbol ()              val sy = r_symbol ()
670              val (f, n) = r_fsbn ()      (* really reads farbnodes! *)              val (f, n) = r_fsbn ()      (* really reads farbnodes! *)
671              val e = bn2env n              val e = bn2env n
672                    (* put a filter in front to avoid having the FCTENV being
673                     * queried needlessly (this avoids spurious module loadings) *)
674                    val e' = DAEnv.FILTER (SymbolSet.singleton sy, e)
675          in          in
676              (sy, ((f, DG.SB_BNODE n), e)) (* coerce to farsbnodes *)                  (sy, ((f, DG.SB_BNODE n), e')) (* coerce to farsbnodes *)
677          end          end
678    
679          fun r_exports () =          fun r_exports () =
# Line 491  Line 682 
682          fun r_privileges () =          fun r_privileges () =
683              StringSet.addList (StringSet.empty, r_list r_string ())              StringSet.addList (StringSet.empty, r_list r_string ())
684    
         fun unpickle_group () = let  
685              val exports = r_exports ()              val exports = r_exports ()
             val islib = r_bool ()  
686              val required = r_privileges ()              val required = r_privileges ()
             val subgroups = r_list (getGroup o r_abspath) ()  
687              val simap = genStableInfoMap (exports, group)              val simap = genStableInfoMap (exports, group)
688          in          in
689              GG.GROUP { exports = exports,              GG.GROUP { exports = exports,
690                         islib = islib,                         kind = GG.STABLELIB simap,
691                         required = required,                         required = required,
692                         grouppath = group,                         grouppath = group,
693                         subgroups = subgroups,                         sublibs = sublibs }
                        stableinfo = GG.STABLE simap }  
694          end          end
695      in      in
696          SOME (unpickle_group ()) handle Format => NONE          SOME (SafeIO.perform { openIt = fn () => BinIO.openIn sname,
697                                   closeIt = BinIO.closeIn,
698                                   work = work,
699                                   cleanup = fn () => () })
700            handle Format => NONE
701                 | IO.Io _ => NONE
702      end      end
703  end  end
704    
705    end (* local *)

Legend:
Removed from v.308  
changed lines
  Added in v.360

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