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 345, Sun Jun 20 11:55:26 1999 UTC revision 349, Tue Jun 22 06:17:47 1999 UTC
# Line 71  Line 71 
71          SymbolMap.foldl add IntBinaryMap.empty exports          SymbolMap.foldl add IntBinaryMap.empty exports
72      end      end
73    
     fun deleteFile n = OS.FileSys.remove n handle _ => ()  
   
74      fun stabilize gp { group = g as GG.GROUP grec, anyerrors } = let      fun stabilize gp { group = g as GG.GROUP grec, anyerrors } = let
75    
76          val primconf = #primconf (#param gp)          val primconf = #primconf (#param gp)
# Line 81  Line 79 
79          val grouppath = #grouppath grec          val grouppath = #grouppath grec
80          val groupdir = AbsPath.dir grouppath          val groupdir = AbsPath.dir grouppath
81    
82          fun doit granted = let          fun doit wrapped = let
83    
84              val _ =              val _ =
85                  if StringSet.isEmpty granted then ()                  if StringSet.isEmpty wrapped then ()
86                  else                  else
87                      Say.say ("$Stabilize: wrapping the following privileges:\n"                      Say.say ("$Stabilize: wrapping the following privileges:\n"
88                               :: map (fn s => ("  " ^ s ^ "\n"))                               :: map (fn s => ("  " ^ s ^ "\n"))
89                                      (StringSet.listItems granted))                                      (StringSet.listItems wrapped))
90    
91              val bname = AbsPath.name o SmlInfo.binpath              val bname = AbsPath.name o SmlInfo.binpath
92              val bsz = OS.FileSys.fileSize o bname              val bsz = OS.FileSys.fileSize o bname
# Line 111  Line 109 
109              val grpSrcInfo = (#errcons gp, anyerrors)              val grpSrcInfo = (#errcons gp, anyerrors)
110    
111              val exports = #exports grec              val exports = #exports grec
112              val islib = #islib grec              val required = StringSet.difference (#required grec, wrapped)
             val required = StringSet.difference (#required grec, granted)  
113              val sublibs = #sublibs grec              val sublibs = #sublibs grec
114    
115              (* The format of a stable archive is the following:              (* The format of a stable archive is the following:
# Line 307  Line 304 
304                   * have them back when we unpickle BNODEs. *)                   * have them back when we unpickle BNODEs. *)
305                  concat (w_list w_sg sublibs                  concat (w_list w_sg sublibs
306                              (w_exports exports                              (w_exports exports
307                                  (w_bool islib                                   (w_privileges required k0)) m0)
                                     (w_privileges required k0))) m0)  
308              end              end
309    
310              val pickle = pickle_group ()              val pickle = pickle_group ()
# Line 357  Line 353 
353                  val simap = genStableInfoMap (exports, grouppath)                  val simap = genStableInfoMap (exports, grouppath)
354              in              in
355                  GG.GROUP { exports = exports,                  GG.GROUP { exports = exports,
356                             islib = islib,                             kind = GG.STABLELIB simap,
357                             required = required,                             required = required,
358                             grouppath = grouppath,                             grouppath = grouppath,
359                             sublibs = sublibs,                             sublibs = sublibs }
                            stableinfo = GG.STABLE simap }  
360              end              end
361    
362              fun writeInt32 (s, i) = let              fun writeInt32 (s, i) = let
# Line 374  Line 369 
369    
370              val gpath = #grouppath grec              val gpath = #grouppath grec
371              val spath = FilenamePolicy.mkStablePath policy gpath              val spath = FilenamePolicy.mkStablePath policy gpath
             fun delete () = deleteFile (AbsPath.name spath)  
372              fun work outs =              fun work outs =
373                  (Say.vsay ["[stabilizing ", AbsPath.name gpath, "]\n"];                  (Say.vsay ["[stabilizing ", AbsPath.name gpath, "]\n"];
374                   writeInt32 (outs, sz);                   writeInt32 (outs, sz);
# Line 385  Line 379 
379              SOME (SafeIO.perform { openIt = fn () => AbsPath.openBinOut spath,              SOME (SafeIO.perform { openIt = fn () => AbsPath.openBinOut spath,
380                                     closeIt = BinIO.closeOut,                                     closeIt = BinIO.closeOut,
381                                     work = work,                                     work = work,
382                                     cleanup = delete })                                     cleanup = fn () => AbsPath.delete spath })
383              handle exn => NONE              handle exn => NONE
384          end          end
385      in      in
386          case #stableinfo grec of          case #kind grec of
387              GG.STABLE _ => SOME g              GG.STABLELIB _ => SOME g
388            | GG.NONSTABLE granted =>            | GG.NOLIB => EM.impossible "stabilize: no library"
389              | GG.LIB wrapped =>
390                  if not (recomp gp g) then                  if not (recomp gp g) then
391                      (anyerrors := true; NONE)                      (anyerrors := true; NONE)
392                  else let                  else let
393                      fun notStable (_, GG.GROUP { stableinfo, ... }) =                      fun notStable (_, GG.GROUP { kind, ... }) =
394                          case stableinfo of                          case kind of GG.STABLELIB _ => true | _ => false
                             GG.STABLE _ => false  
                           | GG.NONSTABLE _ => true  
395                  in                  in
396                      case List.filter notStable (#sublibs grec) of                      case List.filter notStable (#sublibs grec) of
397                          [] => doit granted                          [] => doit wrapped
398                        | l => let                        | l => let
399                              val grammar = case l of [_] => " is" | _ => "s are"                              val grammar = case l of [_] => " is" | _ => "s are"
400                              fun ppb pps = let                              fun ppb pps = let
# Line 671  Line 664 
664                  StringSet.addList (StringSet.empty, r_list r_string ())                  StringSet.addList (StringSet.empty, r_list r_string ())
665    
666              val exports = r_exports ()              val exports = r_exports ()
             val islib = r_bool ()  
667              val required = r_privileges ()              val required = r_privileges ()
668              val simap = genStableInfoMap (exports, group)              val simap = genStableInfoMap (exports, group)
669          in          in
670              GG.GROUP { exports = exports,              GG.GROUP { exports = exports,
671                         islib = islib,                         kind = GG.STABLELIB simap,
672                         required = required,                         required = required,
673                         grouppath = group,                         grouppath = group,
674                         sublibs = sublibs,                         sublibs = sublibs }
                        stableinfo = GG.STABLE simap }  
675          end          end
676      in      in
677          SOME (SafeIO.perform { openIt = fn () => AbsPath.openBinIn spath,          SOME (SafeIO.perform { openIt = fn () => AbsPath.openBinIn spath,
# Line 688  Line 679 
679                                 work = work,                                 work = work,
680                                 cleanup = fn () => () })                                 cleanup = fn () => () })
681          handle Format => NONE          handle Format => NONE
682                 | IO.Io _ => NONE
683      end      end
684  end  end
685    

Legend:
Removed from v.345  
changed lines
  Added in v.349

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