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 353, Thu Jun 24 09:43:28 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)
77          val policy = #fnpolicy (#param gp)          val policy = #fnpolicy (#param gp)
78    
79          val grouppath = #grouppath grec          val grouppath = #grouppath grec
         val groupdir = AbsPath.dir grouppath  
80    
81          fun doit granted = let          fun doit wrapped = let
82    
83              val _ =              val _ =
84                  if StringSet.isEmpty granted then ()                  if StringSet.isEmpty wrapped then ()
85                  else                  else
86                      Say.say ("$Stabilize: wrapping the following privileges:\n"                      Say.say ("$Stabilize: wrapping the following privileges:\n"
87                               :: map (fn s => ("  " ^ s ^ "\n"))                               :: map (fn s => ("  " ^ s ^ "\n"))
88                                      (StringSet.listItems granted))                                      (StringSet.listItems wrapped))
89    
90              val bname = AbsPath.name o SmlInfo.binpath              val bname = AbsPath.name o SmlInfo.binpath
91              val bsz = OS.FileSys.fileSize o bname              val bsz = OS.FileSys.fileSize o bname
# Line 111  Line 108 
108              val grpSrcInfo = (#errcons gp, anyerrors)              val grpSrcInfo = (#errcons gp, anyerrors)
109    
110              val exports = #exports grec              val exports = #exports grec
111              val islib = #islib grec              val required = StringSet.difference (#required grec, wrapped)
             val required = StringSet.difference (#required grec, granted)  
112              val sublibs = #sublibs grec              val sublibs = #sublibs grec
113    
114              (* The format of a stable archive is the following:              (* The format of a stable archive is the following:
# Line 231  Line 227 
227                   * within libraries.  However, the spec in BinInfo.info                   * within libraries.  However, the spec in BinInfo.info
228                   * is only used for diagnostics and has no impact on the                   * is only used for diagnostics and has no impact on the
229                   * operation of CM itself. *)                   * operation of CM itself. *)
230                  val spec = AbsPath.spec (SmlInfo.sourcepath i)                  val spec = AbsPath.specOf (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)
233              in              in
# Line 267  Line 263 
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_relabs p) (p, groupdir))                  w_list w_string (AbsPath.pickle (warn_relabs p) (p, grouppath))
267                                  k m                                  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
# Line 307  Line 303 
303                   * have them back when we unpickle BNODEs. *)                   * have them back when we unpickle BNODEs. *)
304                  concat (w_list w_sg sublibs                  concat (w_list w_sg sublibs
305                              (w_exports exports                              (w_exports exports
306                                  (w_bool islib                                   (w_privileges required k0)) m0)
                                     (w_privileges required k0))) m0)  
307              end              end
308    
309              val pickle = pickle_group ()              val pickle = pickle_group ()
# Line 326  Line 321 
321                              val sourcepath = SmlInfo.sourcepath smlinfo                              val sourcepath = SmlInfo.sourcepath smlinfo
322                              (* FIXME: see the comment near the other                              (* FIXME: see the comment near the other
323                               * occurence of AbsPath.spec... *)                               * occurence of AbsPath.spec... *)
324                              val spec = AbsPath.spec sourcepath                              val spec = AbsPath.specOf sourcepath
325                              val offset =                              val offset =
326                                  getOffset smlinfo + offset_adjustment                                  getOffset smlinfo + offset_adjustment
327                              val share = SmlInfo.share smlinfo                              val share = SmlInfo.share smlinfo
# Line 357  Line 352 
352                  val simap = genStableInfoMap (exports, grouppath)                  val simap = genStableInfoMap (exports, grouppath)
353              in              in
354                  GG.GROUP { exports = exports,                  GG.GROUP { exports = exports,
355                             islib = islib,                             kind = GG.STABLELIB simap,
356                             required = required,                             required = required,
357                             grouppath = grouppath,                             grouppath = grouppath,
358                             sublibs = sublibs,                             sublibs = sublibs }
                            stableinfo = GG.STABLE simap }  
359              end              end
360    
361              fun writeInt32 (s, i) = let              fun writeInt32 (s, i) = let
# Line 374  Line 368 
368    
369              val gpath = #grouppath grec              val gpath = #grouppath grec
370              val spath = FilenamePolicy.mkStablePath policy gpath              val spath = FilenamePolicy.mkStablePath policy gpath
             fun delete () = deleteFile (AbsPath.name spath)  
371              fun work outs =              fun work outs =
372                  (Say.vsay ["[stabilizing ", AbsPath.name gpath, "]\n"];                  (Say.vsay ["[stabilizing ", AbsPath.name gpath, "]\n"];
373                   writeInt32 (outs, sz);                   writeInt32 (outs, sz);
# Line 385  Line 378 
378              SOME (SafeIO.perform { openIt = fn () => AbsPath.openBinOut spath,              SOME (SafeIO.perform { openIt = fn () => AbsPath.openBinOut spath,
379                                     closeIt = BinIO.closeOut,                                     closeIt = BinIO.closeOut,
380                                     work = work,                                     work = work,
381                                     cleanup = delete })                                     cleanup = fn () => AbsPath.delete spath })
382              handle exn => NONE              handle exn => NONE
383          end          end
384      in      in
385          case #stableinfo grec of          case #kind grec of
386              GG.STABLE _ => SOME g              GG.STABLELIB _ => SOME g
387            | GG.NONSTABLE granted =>            | GG.NOLIB => EM.impossible "stabilize: no library"
388              | GG.LIB wrapped =>
389                  if not (recomp gp g) then                  if not (recomp gp g) then
390                      (anyerrors := true; NONE)                      (anyerrors := true; NONE)
391                  else let                  else let
392                      fun notStable (_, GG.GROUP { stableinfo, ... }) =                      fun notStable (_, GG.GROUP { kind, ... }) =
393                          case stableinfo of                          case kind of GG.STABLELIB _ => false | _ => true
                             GG.STABLE _ => false  
                           | GG.NONSTABLE _ => true  
394                  in                  in
395                      case List.filter notStable (#sublibs grec) of                      case List.filter notStable (#sublibs grec) of
396                          [] => doit granted                          [] => doit wrapped
397                        | l => let                        | l => let
398                              val grammar = case l of [_] => " is" | _ => "s are"                              val grammar = case l of [_] => " is" | _ => "s are"
399                              fun ppb pps = let                              fun ppb pps = let
# Line 437  Line 429 
429    
430      fun loadStable (gp, getGroup, anyerrors) group = let      fun loadStable (gp, getGroup, anyerrors) group = let
431    
         val groupdir = AbsPath.dir group  
432          fun bn2env n = Statenv2DAEnv.cvtMemo (fn () => bn2statenv gp n)          fun bn2env n = Statenv2DAEnv.cvtMemo (fn () => bn2statenv gp n)
433    
434          val errcons = #errcons gp          val errcons = #errcons gp
# Line 550  Line 541 
541              end              end
542    
543              fun r_abspath () =              fun r_abspath () =
544                  case AbsPath.unpickle pcmode (r_list r_string (), groupdir) of                  case AbsPath.unpickle pcmode (r_list r_string (), group) of
545                      SOME p => p                      SOME p => p
546                    | NONE => raise Format                    | NONE => raise Format
547    
# Line 558  Line 549 
549                  fun r_symbol_raw () = let                  fun r_symbol_raw () = let
550                      val (ns, first) =                      val (ns, first) =
551                          case rd () of                          case rd () of
552                              #"`" => (Symbol.sigSymbol, rd ())                              #"'" => (Symbol.sigSymbol, rd ())
553                            | #"(" => (Symbol.fctSymbol, rd ())                            | #"(" => (Symbol.fctSymbol, rd ())
554                            | #")" => (Symbol.fsigSymbol, rd ())                            | #")" => (Symbol.fsigSymbol, rd ())
555                            | c => (Symbol.strSymbol, c)                            | c => (Symbol.strSymbol, c)
# Line 671  Line 662 
662                  StringSet.addList (StringSet.empty, r_list r_string ())                  StringSet.addList (StringSet.empty, r_list r_string ())
663    
664              val exports = r_exports ()              val exports = r_exports ()
             val islib = r_bool ()  
665              val required = r_privileges ()              val required = r_privileges ()
666              val simap = genStableInfoMap (exports, group)              val simap = genStableInfoMap (exports, group)
667          in          in
668              GG.GROUP { exports = exports,              GG.GROUP { exports = exports,
669                         islib = islib,                         kind = GG.STABLELIB simap,
670                         required = required,                         required = required,
671                         grouppath = group,                         grouppath = group,
672                         sublibs = sublibs,                         sublibs = sublibs }
                        stableinfo = GG.STABLE simap }  
673          end          end
674      in      in
675          SOME (SafeIO.perform { openIt = fn () => AbsPath.openBinIn spath,          SOME (SafeIO.perform { openIt = fn () => AbsPath.openBinIn spath,
# Line 688  Line 677 
677                                 work = work,                                 work = work,
678                                 cleanup = fn () => () })                                 cleanup = fn () => () })
679          handle Format => NONE          handle Format => NONE
680                 | IO.Io _ => NONE
681      end      end
682  end  end
683    

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

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