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 353, Thu Jun 24 09:43:28 1999 UTC revision 354, Fri Jun 25 08:36:12 1999 UTC
# Line 21  Line 21 
21  signature STABILIZE = sig  signature STABILIZE = sig
22    
23      val loadStable :      val loadStable :
24          GP.info * (AbsPath.t -> GG.group option) * bool ref ->          GP.info * (SrcPath.t -> GG.group option) * bool ref ->
25          AbsPath.t -> GG.group option          SrcPath.t -> GG.group option
26    
27      val stabilize :      val stabilize :
28          GP.info -> { group: GG.group, anyerrors: bool ref } ->          GP.info -> { group: GG.group, anyerrors: bool ref } ->
# Line 62  Line 62 
62          fun add (((_, DG.SB_BNODE (n as DG.BNODE b)), _), m) = let          fun add (((_, DG.SB_BNODE (n as DG.BNODE b)), _), m) = let
63              val i = #bininfo b              val i = #bininfo b
64          in          in
65              if AbsPath.compare (BinInfo.group i, group) = EQUAL then              if SrcPath.compare (BinInfo.group i, group) = EQUAL then
66                  IntBinaryMap.insert (m, BinInfo.offset i, n)                  IntBinaryMap.insert (m, BinInfo.offset i, n)
67              else m              else m
68          end          end
# Line 87  Line 87 
87                               :: map (fn s => ("  " ^ s ^ "\n"))                               :: map (fn s => ("  " ^ s ^ "\n"))
88                                      (StringSet.listItems wrapped))                                      (StringSet.listItems wrapped))
89    
90              val bname = AbsPath.name o SmlInfo.binpath              val bname = SmlInfo.binname
91              val bsz = OS.FileSys.fileSize o bname              val bsz = OS.FileSys.fileSize o bname
92    
93              fun cpb s i = let              fun cpb s i = let
# Line 227  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.specOf (SmlInfo.sourcepath i)                  val spec = SrcPath.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 244  Line 244 
244                  val relabs = if abs then "absolute" else "relative"                  val relabs = if abs then "absolute" else "relative"
245                  fun ppb pps =                  fun ppb pps =
246                      (PP.add_newline pps;                      (PP.add_newline pps;
247                       PP.add_string pps (AbsPath.name p);                       PP.add_string pps (SrcPath.descr 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";
# Line 256  Line 256 
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,                      (concat [SrcPath.descr grouppath,
260                               ": library 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_relabs p) (p, grouppath))                  w_list w_string (SrcPath.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 310  Line 310 
310              val sz = size pickle              val sz = size pickle
311              val offset_adjustment = sz + 4              val offset_adjustment = sz + 4
312    
313              fun mkStableGroup spath = let              fun mkStableGroup sname = let
314                  val m = ref SmlInfoMap.empty                  val m = ref SmlInfoMap.empty
315                  fun sn (DG.SNODE (n as { smlinfo, ... })) =                  fun sn (DG.SNODE (n as { smlinfo, ... })) =
316                      case SmlInfoMap.find (!m, smlinfo) of                      case SmlInfoMap.find (!m, smlinfo) of
# Line 320  Line 320 
320                              val gi = map fsbn (#globalimports n)                              val gi = map fsbn (#globalimports n)
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 SrcPath.spec... *)
324                              val spec = AbsPath.specOf sourcepath                              val spec = SrcPath.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
328                              val locs = SmlInfo.errorLocation gp smlinfo                              val locs = SmlInfo.errorLocation gp smlinfo
329                              val error = EM.errorNoSource grpSrcInfo locs                              val error = EM.errorNoSource grpSrcInfo locs
330                              val i = BinInfo.new { group = grouppath,                              val i = BinInfo.new { group = grouppath,
331                                                    stablepath = spath,                                                    stablename = sname,
332                                                    spec = spec,                                                    spec = spec,
333                                                    offset = offset,                                                    offset = offset,
334                                                    share = share,                                                    share = share,
# Line 367  Line 367 
367              val memberlist = rev (!members)              val memberlist = rev (!members)
368    
369              val gpath = #grouppath grec              val gpath = #grouppath grec
370              val spath = FilenamePolicy.mkStablePath policy gpath              val sname = FilenamePolicy.mkStableName policy gpath
371              fun work outs =              fun work outs =
372                  (Say.vsay ["[stabilizing ", AbsPath.name gpath, "]\n"];                  (Say.vsay ["[stabilizing ", SrcPath.descr gpath, "]\n"];
373                   writeInt32 (outs, sz);                   writeInt32 (outs, sz);
374                   BinIO.output (outs, Byte.stringToBytes pickle);                   BinIO.output (outs, Byte.stringToBytes pickle);
375                   app (cpb outs) memberlist;                   app (cpb outs) memberlist;
376                   mkStableGroup spath)                   mkStableGroup sname)
377          in          in
378              SOME (SafeIO.perform { openIt = fn () => AbsPath.openBinOut spath,              SOME (SafeIO.perform { openIt = fn () => AutoDir.openBinOut sname,
379                                     closeIt = BinIO.closeOut,                                     closeIt = BinIO.closeOut,
380                                     work = work,                                     work = work,
381                                     cleanup = fn () => AbsPath.delete spath })                                     cleanup = fn () =>
382                                        (OS.FileSys.remove sname handle _ => ()) })
383              handle exn => NONE              handle exn => NONE
384          end          end
385      in      in
# Line 401  Line 402 
402                                    | loop ((p, GG.GROUP { grouppath, ... })                                    | loop ((p, GG.GROUP { grouppath, ... })
403                                            :: t) =                                            :: t) =
404                                      (PP.add_string pps                                      (PP.add_string pps
405                                          (AbsPath.name grouppath);                                          (SrcPath.descr grouppath);
406                                       PP.add_string pps " (";                                       PP.add_string pps " (";
407                                       PP.add_string pps (AbsPath.name p);                                       PP.add_string pps (SrcPath.descr p);
408                                       PP.add_string pps ")";                                       PP.add_string pps ")";
409                                       PP.add_newline pps;                                       PP.add_newline pps;
410                                       loop t)                                       loop t)
# Line 416  Line 417 
417                                  loop l                                  loop l
418                              end                              end
419                              val errcons = #errcons gp                              val errcons = #errcons gp
420                              val gname = AbsPath.name (#grouppath grec)                              val gdescr = SrcPath.descr (#grouppath grec)
421                          in                          in
422                              EM.errorNoFile (errcons, anyerrors) SM.nullRegion                              EM.errorNoFile (errcons, anyerrors) SM.nullRegion
423                                 EM.COMPLAIN                                 EM.COMPLAIN
424                                 (gname ^ " cannot be stabilized")                                 (gdescr ^ " cannot be stabilized")
425                                 ppb;                                 ppb;
426                              NONE                              NONE
427                          end                          end
# Line 433  Line 434 
434    
435          val errcons = #errcons gp          val errcons = #errcons gp
436          val grpSrcInfo = (errcons, anyerrors)          val grpSrcInfo = (errcons, anyerrors)
437          val gname = AbsPath.name group          val gdescr = SrcPath.descr group
438          fun error l = EM.errorNoFile (errcons, anyerrors) SM.nullRegion          fun error l = EM.errorNoFile (errcons, anyerrors) SM.nullRegion
439              EM.COMPLAIN (concat (gname :: ": " :: l)) EM.nullErrorBody              EM.COMPLAIN (concat (gdescr :: ": " :: l)) EM.nullErrorBody
440    
441          exception Format          exception Format
442    
443          val pcmode = #pcmode (#param gp)          val pcmode = #pcmode (#param gp)
444          val policy = #fnpolicy (#param gp)          val policy = #fnpolicy (#param gp)
445          val primconf = #primconf (#param gp)          val primconf = #primconf (#param gp)
446          val spath = FilenamePolicy.mkStablePath policy group          val sname = FilenamePolicy.mkStableName policy group
447          val _ = Say.vsay ["[checking stable ", gname, "]\n"]          val _ = Say.vsay ["[checking stable ", gdescr, "]\n"]
448    
449          fun work s = let          fun work s = let
450    
451              fun getGroup' p =              fun getGroup' p =
452                  case getGroup p of                  case getGroup p of
453                      SOME g => g                      SOME g => g
454                    | NONE => (error ["unable to find ", AbsPath.name p];                    | NONE => (error ["unable to find ", SrcPath.descr p];
455                               raise Format)                               raise Format)
456    
457              (* for getting sharing right... *)              (* for getting sharing right... *)
# Line 541  Line 542 
542              end              end
543    
544              fun r_abspath () =              fun r_abspath () =
545                  case AbsPath.unpickle pcmode (r_list r_string (), group) of                  case SrcPath.unpickle pcmode (r_list r_string (), group) of
546                      SOME p => p                      SOME p => p
547                    | NONE => raise Format                    | NONE => raise Format
548    
# Line 595  Line 596 
596                  val error = EM.errorNoSource grpSrcInfo locs                  val error = EM.errorNoSource grpSrcInfo locs
597              in              in
598                  BinInfo.new { group = group,                  BinInfo.new { group = group,
599                                stablepath = spath,                                stablename = sname,
600                                error = error,                                error = error,
601                                spec = spec,                                spec = spec,
602                                offset = offset,                                offset = offset,
# Line 672  Line 673 
673                         sublibs = sublibs }                         sublibs = sublibs }
674          end          end
675      in      in
676          SOME (SafeIO.perform { openIt = fn () => AbsPath.openBinIn spath,          SOME (SafeIO.perform { openIt = fn () => BinIO.openIn sname,
677                                 closeIt = BinIO.closeIn,                                 closeIt = BinIO.closeIn,
678                                 work = work,                                 work = work,
679                                 cleanup = fn () => () })                                 cleanup = fn () => () })

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

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