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 504, Tue Dec 7 18:31:05 1999 UTC revision 505, Thu Dec 9 08:24:08 1999 UTC
# Line 80  Line 80 
80            insert = fn ({ ss, sn, pm }, k, v) =>            insert = fn ({ ss, sn, pm }, k, v) =>
81                         { ss = ss, sn = SNMap.insert (sn, k, v), pm = pm } }                         { ss = ss, sn = SNMap.insert (sn, k, v), pm = pm } }
82    
83        fun fetch_pickle s = let
84            fun bytesIn n = let
85                val bv = BinIO.inputN (s, n)
86            in
87                if n = Word8Vector.length bv then bv
88                else raise UU.Format
89            end
90    
91            val dg_sz = LargeWord.toIntX (Pack32Big.subVec (bytesIn 4, 0))
92            val dg_pickle = Byte.bytesToString (bytesIn dg_sz)
93        in
94            { size = dg_sz, pickle = dg_pickle }
95        end
96    
97        fun mkPickleFetcher mksname () =
98            SafeIO.perform { openIt = BinIO.openIn o mksname,
99                             closeIt = BinIO.closeIn,
100                             work = #pickle o fetch_pickle,
101                             cleanup = fn _ => () }
102    
103      fun stabilize gp { group = g as GG.GROUP grec, anyerrors } = let      fun stabilize gp { group = g as GG.GROUP grec, anyerrors } = let
104    
105          val primconf = #primconf (#param gp)          val primconf = #primconf (#param gp)
# Line 427  Line 447 
447              in              in
448                  SmlInfoMap.appi (fn (i, _) => destroy_state gp i) (!m);                  SmlInfoMap.appi (fn (i, _) => destroy_state gp i) (!m);
449                  GG.GROUP { exports = exports,                  GG.GROUP { exports = exports,
450                             kind = GG.STABLELIB,                             kind = GG.STABLELIB (fn () => ()),
451                             required = required,                             required = required,
452                             grouppath = grouppath,                             grouppath = grouppath,
453                             sublibs = sublibs }                             sublibs = sublibs }
# Line 464  Line 484 
484          end          end
485      in      in
486          case #kind grec of          case #kind grec of
487              GG.STABLELIB => SOME g              GG.STABLELIB _ => SOME g
488            | GG.NOLIB => EM.impossible "stabilize: no library"            | GG.NOLIB => EM.impossible "stabilize: no library"
489            | GG.LIB wrapped =>            | GG.LIB wrapped =>
490               (case recomp gp g of               (case recomp gp g of
491                    NONE => (anyerrors := true; NONE)                    NONE => (anyerrors := true; NONE)
492                  | SOME bfc_acc => let                  | SOME bfc_acc => let
493                        fun notStable (_, GG.GROUP { kind, ... }) =                        fun notStable (_, GG.GROUP { kind, ... }) =
494                            case kind of GG.STABLELIB => false | _ => true                            case kind of GG.STABLELIB _ => false | _ => true
495                    in                    in
496                      case List.filter notStable (#sublibs grec) of                      case List.filter notStable (#sublibs grec) of
497                          [] => doit (wrapped, bfc_acc)                          [] => doit (wrapped, bfc_acc)
# Line 529  Line 549 
549                    | NONE => (error ["unable to find ", SrcPath.descr p];                    | NONE => (error ["unable to find ", SrcPath.descr p];
550                               raise Format)                               raise Format)
551    
552              fun bytesIn n = let              val { size = dg_sz, pickle = dg_pickle } = fetch_pickle s
                 val bv = BinIO.inputN (s, n)  
             in  
                 if n = Word8Vector.length bv then bv  
                 else raise Format  
             end  
   
             val dg_sz = LargeWord.toIntX (Pack32Big.subVec (bytesIn 4, 0))  
             val dg_pickle = Byte.bytesToString (bytesIn dg_sz)  
553              val offset_adjustment = dg_sz + 4              val offset_adjustment = dg_sz + 4
554              val session = UU.mkSession (UU.stringGetter dg_pickle)              val { getter, dropper } =
555                    UU.stringGetter' (SOME dg_pickle, mkPickleFetcher mksname)
556                val session = UU.mkSession getter
557    
558              fun list m r = UU.r_list session m r              fun list m r = UU.r_list session m r
559              val string = UU.r_string session              val string = UU.r_string session
# Line 738  Line 752 
752              val required = privileges ()              val required = privileges ()
753          in          in
754              GG.GROUP { exports = exports,              GG.GROUP { exports = exports,
755                         kind = GG.STABLELIB,                         kind = GG.STABLELIB dropper,
756                         required = required,                         required = required,
757                         grouppath = group,                         grouppath = group,
758                         sublibs = sublibs }                         sublibs = sublibs }

Legend:
Removed from v.504  
changed lines
  Added in v.505

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