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 330, Sat Jun 12 07:45:52 1999 UTC revision 340, Fri Jun 18 05:32:46 1999 UTC
# Line 80  Line 80 
80          val primconf = #primconf (#param gp)          val primconf = #primconf (#param gp)
81          val policy = #fnpolicy (#param gp)          val policy = #fnpolicy (#param gp)
82    
83            val grouppath = #grouppath grec
84            val groupdir = AbsPath.dir grouppath
85    
86          fun doit granted = let          fun doit granted = let
87    
88              val _ =              val _ =
# Line 100  Line 103 
103                  cp () handle e => (BinIO.closeIn ins; raise e);                  cp () handle e => (BinIO.closeIn ins; raise e);
104                      BinIO.closeIn ins                      BinIO.closeIn ins
105              end              end
             val delb = deleteFile o bname  
106    
107              val grpSrcInfo = (#errcons gp, anyerrors)              val grpSrcInfo = (#errcons gp, anyerrors)
108    
109              val exports = #exports grec              val exports = #exports grec
110              val islib = #islib grec              val islib = #islib grec
111              val required = StringSet.difference (#required grec, granted)              val required = StringSet.difference (#required grec, granted)
112              val grouppath = #grouppath grec              val sublibs = #sublibs grec
             val subgroups = #subgroups grec  
113    
114              (* The format of a stable archive is the following:              (* The format of a stable archive is the following:
115               *  - It starts with the size s of the pickled dependency               *  - It starts with the size s of the pickled dependency
# Line 122  Line 123 
123               *  - Individual binfile contents (concatenated).               *  - Individual binfile contents (concatenated).
124               *)               *)
125    
126              (* Here we build an inverse map that records for each              (* Here we build a mapping that maps each BNODE to a number
127               * imported bnode a representative symbol.               * representing the sub-library that it came from and a
128               * This is used for pickling BNODEs -- they get represented               * representative symbol that can be used to find the BNODE
129               * by a symbol that they export. This avoids having to               * within the exports of that library *)
130               * pickle a filename in the case of BNODEs. *)              fun oneB i (sy, ((_, DG.SB_BNODE (DG.BNODE n)), _), m) =
131              fun oneB (sy, ((_, DG.SB_BNODE (DG.BNODE n)), _), m) =                  StableMap.insert (m, #bininfo n, (i, sy))
132                  StableMap.insert (m, #bininfo n, sy)                | oneB i (_, _, m) = m
133                | oneB (_, _, m) = m              fun oneSL ((_, g as GG.GROUP { exports, ... }), (m, i)) =
134              fun oneSG ((_, GG.GROUP { exports, ... }), m) =                  (SymbolMap.foldli (oneB i) m exports, i + 1)
135                  SymbolMap.foldli oneB m exports              val inverseMap = #1 (foldl oneSL (StableMap.empty, 0) sublibs)
             val inverseMap = foldl oneSG StableMap.empty subgroups  
136    
137              val members = ref []              val members = ref []
138              val (registerOffset, getOffset) = let              val (registerOffset, getOffset) = let
# Line 221  Line 221 
221                | w_sharing (SOME false) k m = "f" :: k m                | w_sharing (SOME false) k m = "f" :: k m
222    
223              fun w_si i k = let              fun w_si i k = let
224                    (* FIXME: this is not a technical flaw, but perhaps one
225                     * that deserves fixing anyway:  If we only look at spec,
226                     * then we are losing information about sub-grouping
227                     * within libraries.  However, the spec in BinInfo.info
228                     * is only used for diagnostics and has no impact on the
229                     * operation of CM itself. *)
230                  val spec = AbsPath.spec (SmlInfo.sourcepath i)                  val spec = AbsPath.spec (SmlInfo.sourcepath i)
231                  val locs = SmlInfo.errorLocation gp i                  val locs = SmlInfo.errorLocation gp i
232                  val offset = registerOffset (i, bsz i)                  val offset = registerOffset (i, bsz i)
# Line 234  Line 240 
240              fun w_primitive p k m =              fun w_primitive p k m =
241                  String.str (Primitive.toIdent primconf p) :: k m                  String.str (Primitive.toIdent primconf p) :: k m
242    
243              fun warn_nonanchor s = let              fun warn_relabs p abs = let
244                  val relabs =                  val relabs = if abs then "absolute" else "relative"
                     if OS.Path.isRelative s then "relative" else "absolute"  
245                  fun ppb pps =                  fun ppb pps =
246                      (PP.add_newline pps;                      (PP.add_newline pps;
247                       PP.add_string pps ("subgroup: " ^ s);                       PP.add_string pps (AbsPath.name p);
248                       PP.add_newline pps;                       PP.add_newline pps;
249                       PP.add_string pps                       PP.add_string pps
250      "(This means that in order to be able to use the result of stabilization";      "(This means that in order to be able to use the result of stabilization";
251                       PP.add_newline pps;                       PP.add_newline pps;
252                       PP.add_string pps "the subgroups must be in the same ";                       PP.add_string pps "the library must be in the same ";
253                       PP.add_string pps relabs;                       PP.add_string pps relabs;
254                       PP.add_string pps " location as it is now.)";                       PP.add_string pps " location as it is now.)";
255                       PP.add_newline pps)                       PP.add_newline pps)
256              in              in
257                  EM.errorNoFile (#errcons gp, anyerrors) SM.nullRegion                  EM.errorNoFile (#errcons gp, anyerrors) SM.nullRegion
258                      EM.WARN                      EM.WARN
259                      (concat [AbsPath.name (#grouppath grec),                      (concat [AbsPath.name grouppath,
260                               ": subgroup referred to by ", relabs,                               ": library referred to by ", relabs,
261                               " pathname"])                               " pathname:"])
262                      ppb                      ppb
263              end              end
264    
265              fun w_abspath p k m =              fun w_abspath p k m =
266                  w_list w_string (AbsPath.pickle warn_nonanchor p) k m                  w_list w_string (AbsPath.pickle (warn_relabs p) (p, groupdir))
267                                    k m
268    
269              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
270                | w_bn (DG.BNODE { bininfo = i, ... }) k m =                | w_bn (DG.BNODE { bininfo = i, ... }) k m = let
271                  "b" :: w_symbol (valOf (StableMap.find (inverseMap, i))) k m                      val (n, sy) = valOf (StableMap.find (inverseMap, i))
272                    in
273                        "b" :: w_int n (w_symbol sy k) m
274                    end
275    
276              fun w_sn_raw (DG.SNODE n) k =              fun w_sn_raw (DG.SNODE n) k =
277                  w_si (#smlinfo n)                  w_si (#smlinfo n)
# Line 290  Line 299 
299                  fun k0 m = []                  fun k0 m = []
300                  val m0 = (0, Map.empty)                  val m0 = (0, Map.empty)
301              in              in
302                  (* Pickle the subgroups first because we need to already                  (* Pickle the sublibs first because we need to already
303                   * have them back when we unpickle BNODEs. *)                   * have them back when we unpickle BNODEs. *)
304                  concat (w_list w_sg subgroups                  concat (w_list w_sg sublibs
305                              (w_exports exports                              (w_exports exports
306                                  (w_bool islib                                  (w_bool islib
307                                      (w_privileges required k0))) m0)                                      (w_privileges required k0))) m0)
# Line 311  Line 320 
320                              val li = map sn (#localimports n)                              val li = map sn (#localimports n)
321                              val gi = map fsbn (#globalimports n)                              val gi = map fsbn (#globalimports n)
322                              val sourcepath = SmlInfo.sourcepath smlinfo                              val sourcepath = SmlInfo.sourcepath smlinfo
323                                (* FIXME: see the comment near the other
324                                 * occurence of AbsPath.spec... *)
325                              val spec = AbsPath.spec sourcepath                              val spec = AbsPath.spec sourcepath
326                              val offset =                              val offset =
327                                  getOffset smlinfo + offset_adjustment                                  getOffset smlinfo + offset_adjustment
# Line 345  Line 356 
356                             islib = islib,                             islib = islib,
357                             required = required,                             required = required,
358                             grouppath = grouppath,                             grouppath = grouppath,
359                             subgroups = subgroups,                             sublibs = sublibs,
360                             stableinfo = GG.STABLE simap }                             stableinfo = GG.STABLE simap }
361              end              end
362    
# Line 366  Line 377 
377                   writeInt32 (outs, sz);                   writeInt32 (outs, sz);
378                   BinIO.output (outs, Byte.stringToBytes pickle);                   BinIO.output (outs, Byte.stringToBytes pickle);
379                   app (cpb outs) memberlist;                   app (cpb outs) memberlist;
                  app delb memberlist;  
380                   BinIO.closeOut outs;                   BinIO.closeOut outs;
381                   SOME (mkStableGroup spath))                   SOME (mkStableGroup spath))
382          in          in
# Line 388  Line 398 
398                              GG.STABLE _ => false                              GG.STABLE _ => false
399                            | GG.NONSTABLE _ => true                            | GG.NONSTABLE _ => true
400                  in                  in
401                      case List.filter notStable (#subgroups grec) of                      case List.filter notStable (#sublibs grec) of
402                          [] => doit granted                          [] => doit granted
403                        | l => let                        | l => let
404                              val grammar = case l of [_] => " is" | _ => "s are"                              val grammar = case l of [_] => " is" | _ => "s are"
# Line 425  Line 435 
435    
436      fun loadStable (gp, getGroup, anyerrors) group = let      fun loadStable (gp, getGroup, anyerrors) group = let
437    
438          val context = AbsPath.relativeContext (AbsPath.dir group)          val groupdir = AbsPath.dir group
439          fun bn2env n = Statenv2DAEnv.cvtMemo (fn () => bn2statenv gp n)          fun bn2env n = Statenv2DAEnv.cvtMemo (fn () => bn2statenv gp n)
440    
441          val errcons = #errcons gp          val errcons = #errcons gp
# Line 537  Line 547 
547          end          end
548    
549          fun r_abspath () =          fun r_abspath () =
550              case AbsPath.unpickle pcmode (r_list r_string (), context) of              case AbsPath.unpickle pcmode (r_list r_string (), groupdir) of
551                  SOME p => p                  SOME p => p
552                | NONE => raise Format                | NONE => raise Format
553    
# Line 606  Line 616 
616    
617          fun unpickle_group () = let          fun unpickle_group () = let
618    
619              val subgroups = r_list r_sg ()              val sublibs = r_list r_sg ()
             fun oneSG ((_, GG.GROUP { exports, ... }), m) =  
                 SymbolMap.unionWith #1 (exports, m)  
             val forwardMap = foldl oneSG SymbolMap.empty subgroups  
620    
621              fun r_bn () =              fun r_bn () =
622                  case rd () of                  case rd () of
623                      #"p" => DG.PNODE (r_primitive ())                      #"p" => DG.PNODE (r_primitive ())
624                    | #"b" => let                    | #"b" => let
625                            val n = r_int ()
626                          val sy = r_symbol ()                          val sy = r_symbol ()
627                            val (_, GG.GROUP { exports = slexp, ... }) =
628                                List.nth (sublibs, n) handle _ => raise Format
629                      in                      in
630                          case SymbolMap.find (forwardMap, sy) of                          case SymbolMap.find (slexp, sy) of
631                              SOME ((_, DG.SB_BNODE (n as DG.BNODE _)), _) => n                              SOME ((_, DG.SB_BNODE (n as DG.BNODE _)), _) => n
632                            | _ => raise Format                            | _ => raise Format
633                      end                      end
# Line 668  Line 678 
678                         islib = islib,                         islib = islib,
679                         required = required,                         required = required,
680                         grouppath = group,                         grouppath = group,
681                         subgroups = subgroups,                         sublibs = sublibs,
682                         stableinfo = GG.STABLE simap }                         stableinfo = GG.STABLE simap }
683              before BinIO.closeIn s              before BinIO.closeIn s
684          end          end

Legend:
Removed from v.330  
changed lines
  Added in v.340

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