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 384, Wed Jul 21 08:54:00 1999 UTC revision 385, Thu Jul 22 05:23:25 1999 UTC
# Line 43  Line 43 
43      val op & = PU.&      val op & = PU.&
44      val % = PU.%      val % = PU.%
45    
46      datatype uitem =      (* type info *)
47          USS of SymbolSet.set      val (BN, SN, SBN, SS, SI, FSBN, IMPEXP) = (1, 2, 3, 4, 5, 6, 7)
48        | US of Symbol.symbol  
49        | UBN of DG.bnode      structure SSMap = BinaryMapFn
50            (struct
51                 type ord_key = SymbolSet.set
52                 val compare = SymbolSet.compare
53            end)
54    
55      structure SNMap = BinaryMapFn      structure SNMap = BinaryMapFn
56          (struct          (struct
# Line 55  Line 59 
59                   SmlInfo.compare (#smlinfo n, #smlinfo n')                   SmlInfo.compare (#smlinfo n, #smlinfo n')
60          end)          end)
61    
62      val initMap = SNMap.empty      type 'a maps = { ss: 'a SSMap.map, sn: 'a SNMap.map }
63      val SNs = { find = SNMap.find, insert = SNMap.insert }  
64        val initMap = { ss = SSMap.empty, sn = SNMap.empty }
65        val SSs = { find = fn (m: 'a maps, k) => SSMap.find (#ss m, k),
66                    insert = fn ({ ss, sn }, k, v) =>
67                                 { sn = sn, ss = SSMap.insert (ss, k, v) } }
68        val SNs = { find = fn (m: 'a maps, k) => SNMap.find (#sn m, k),
69                    insert = fn ({ ss, sn }, k, v) =>
70                                 { ss = ss, sn = SNMap.insert (sn, k, v) } }
71    
72      fun genStableInfoMap (exports, group) = let      fun genStableInfoMap (exports, group) = let
73          (* find all the exported bnodes that are in the same group: *)          (* find all the exported bnodes that are in the same group: *)
# Line 163  Line 174 
174              val bool = PU.w_bool              val bool = PU.w_bool
175              val int = PU.w_int              val int = PU.w_int
176    
177              val symbolset = list symbol o SymbolSet.listItems              fun symbolset ss = let
178                    val op $ = PU.$ SS
179                    fun raw_ss ss = "s" $ list symbol (SymbolSet.listItems ss)
180                in
181                    share SSs raw_ss ss
182                end
183    
184              val filter = option symbolset              val filter = option symbolset
185    
# Line 179  Line 195 
195                  val spec = SrcPath.specOf (SmlInfo.sourcepath i)                  val spec = SrcPath.specOf (SmlInfo.sourcepath i)
196                  val locs = SmlInfo.errorLocation gp i                  val locs = SmlInfo.errorLocation gp i
197                  val offset = registerOffset (i, bsz i)                  val offset = registerOffset (i, bsz i)
198                    val share = SmlInfo.share i
199                    val op $ = PU.$ SI
200              in              in
201                  string spec & string locs & int offset & sh (SmlInfo.share i)                  "s" $ string spec & string locs & int offset & sh share
202              end              end
203    
204              fun primitive p =              fun primitive p =
# Line 214  Line 232 
232                  list string pp                  list string pp
233              end              end
234    
             val BN = 1  
235              val op $ = PU.$ BN              val op $ = PU.$ BN
236              fun bn (DG.PNODE p) = "1" $ primitive p              fun bn (DG.PNODE p) = "1" $ primitive p
237                | bn (DG.BNODE { bininfo = i, ... }) = let                | bn (DG.BNODE { bininfo = i, ... }) = let
# Line 223  Line 240 
240                      "2" $ int n & symbol sy                      "2" $ int n & symbol sy
241                  end                  end
242    
             local  
                 val SN = 2  
                 val SBN = 3  
             in  
243                  fun sn n = let                  fun sn n = let
244                      fun raw_sn (DG.SNODE n) =                      fun raw_sn (DG.SNODE n) =
245                          "a" $ si (#smlinfo n) & list sn (#localimports n) &                          "a" $ si (#smlinfo n) & list sn (#localimports n) &
# Line 243  Line 256 
256                        | DG.SB_SNODE n => "b" $ sn n                        | DG.SB_SNODE n => "b" $ sn n
257                  end                  end
258    
259                  and fsbn (f, n) = filter f & sbn n              and fsbn (f, n) = let
260                    val op $ = PU.$ FSBN
261                in
262                    "f" $ filter f & sbn n
263              end              end
264    
265              fun impexp (s, (n, _)) = symbol s & fsbn n              fun impexp (s, (n, _)) = let
266                    val op $ = PU.$ IMPEXP
267                in
268                    "i" $ symbol s & fsbn n
269                end
270    
271              fun w_exports e = list impexp (SymbolMap.listItemsi e)              fun w_exports e = list impexp (SymbolMap.listItemsi e)
272    
# Line 438  Line 458 
458              val stringListM = UU.mkMap ()              val stringListM = UU.mkMap ()
459              val symbolListM = UU.mkMap ()              val symbolListM = UU.mkMap ()
460              val stringListM = UU.mkMap ()              val stringListM = UU.mkMap ()
461                val ssM = UU.mkMap ()
462              val ssoM = UU.mkMap ()              val ssoM = UU.mkMap ()
463              val boolOptionM = UU.mkMap ()              val boolOptionM = UU.mkMap ()
464                val siM = UU.mkMap ()
465              val sgListM = UU.mkMap ()              val sgListM = UU.mkMap ()
466              val snM = UU.mkMap ()              val snM = UU.mkMap ()
467              val snListM = UU.mkMap ()              val snListM = UU.mkMap ()
468              val bnM = UU.mkMap ()              val bnM = UU.mkMap ()
469              val sbnM = UU.mkMap ()              val sbnM = UU.mkMap ()
470                val fsbnM = UU.mkMap ()
471              val fsbnListM = UU.mkMap ()              val fsbnListM = UU.mkMap ()
472                val impexpM = UU.mkMap ()
473              val impexpListM = UU.mkMap ()              val impexpListM = UU.mkMap ()
474    
475              val stringlist = list stringListM string              val stringlist = list stringListM string
# Line 459  Line 483 
483    
484              val symbollist = list symbolListM symbol              val symbollist = list symbolListM symbol
485    
486              fun symbolset () =              fun symbolset () = let
487                  SymbolSet.addList (SymbolSet.empty, symbollist ())                  fun s #"s" = SymbolSet.addList (SymbolSet.empty, symbollist ())
488                      | s _ = raise Format
489                in
490                    share ssM s
491                end
492    
493              val filter = option ssoM symbolset              val filter = option ssoM symbolset
494    
# Line 472  Line 500 
500              val sh = option boolOptionM bool              val sh = option boolOptionM bool
501    
502              fun si () = let              fun si () = let
503                  val spec = string ()                  fun s #"s" =
504                        let val spec = string ()
505                  val locs = string ()                  val locs = string ()
506                  val offset = int () + offset_adjustment                  val offset = int () + offset_adjustment
507                  val share = sh ()                  val share = sh ()
# Line 485  Line 514 
514                                offset = offset,                                offset = offset,
515                                share = share }                                share = share }
516              end              end
517                      | s _ = raise Format
518                in
519                    share siM s
520                end
521    
522              fun sg () = getGroup' (abspath ())              fun sg () = getGroup' (abspath ())
523    
# Line 530  Line 563 
563                  share sbnM sbn'                  share sbnM sbn'
564              end              end
565    
566              and fsbn () = (filter (), sbn ())              and fsbn () = let
567                    fun f #"f" = (filter (), sbn ())
568                      | f _ = raise Format
569                in
570                    share fsbnM f
571                end
572    
573              and fsbnlist () = list fsbnListM fsbn ()              and fsbnlist () = list fsbnListM fsbn ()
574    
575              fun impexp () = let              fun impexp () = let
576                  val sy = symbol ()                  fun ie #"i" =
577                        let val sy = symbol ()
578                  val (f, n) = fsbn ()    (* really reads farbnodes! *)                  val (f, n) = fsbn ()    (* really reads farbnodes! *)
579                  val e = bn2env n                  val e = bn2env n
580                  (* put a filter in front to avoid having the FCTENV being                          (* put a filter in front to avoid having the FCTENV
581                   * queried needlessly (this avoids spurious module loadings) *)                           * being queried needlessly (this avoids spurious
582                             * module loadings) *)
583                  val e' = DAEnv.FILTER (SymbolSet.singleton sy, e)                  val e' = DAEnv.FILTER (SymbolSet.singleton sy, e)
584              in              in
585                  (sy, ((f, DG.SB_BNODE n), e')) (* coerce to farsbnodes *)                          (* coerce to farsbnodes *)
586                            (sy, ((f, DG.SB_BNODE n), e'))
587                        end
588                      | ie _ = raise Format
589                in
590                    share impexpM ie
591              end              end
592    
593              val impexplist = list impexpListM impexp              val impexplist = list impexpListM impexp

Legend:
Removed from v.384  
changed lines
  Added in v.385

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