SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/stable/stabilize.sml

[smlnj] / sml / trunk / src / cm / stable / stabilize.sml

Diff of /sml/trunk/src/cm/stable/stabilize.sml

-revision 384, Wed Jul 21 08:54:00 1999 UTC
+revision 385, Thu Jul 22 05:23:25 1999 UTC
 Line 43
      val op & = PU.&
      val % = PU.%
-     datatype uitem =
+     (* type info *)
-         USS of SymbolSet.set
+     val (BN, SN, SBN, SS, SI, FSBN, IMPEXP) = (1, 2, 3, 4, 5, 6, 7)
-       | US of Symbol.symbol
-       | UBN of DG.bnode
+     structure SSMap = BinaryMapFn
+         (struct
+              type ord_key = SymbolSet.set
+              val compare = SymbolSet.compare
+         end)
      structure SNMap = BinaryMapFn
          (struct
-Line 55
+Line 59
                   SmlInfo.compare (#smlinfo n, #smlinfo n')
          end)
-     val initMap = SNMap.empty
+     type 'a maps = { ss: 'a SSMap.map, sn: 'a SNMap.map }
-     val SNs = { find = SNMap.find, insert = SNMap.insert }
+     val initMap = { ss = SSMap.empty, sn = SNMap.empty }
+     val SSs = { find = fn (m: 'a maps, k) => SSMap.find (#ss m, k),
+                 insert = fn ({ ss, sn }, k, v) =>
+                              { sn = sn, ss = SSMap.insert (ss, k, v) } }
+     val SNs = { find = fn (m: 'a maps, k) => SNMap.find (#sn m, k),
+                 insert = fn ({ ss, sn }, k, v) =>
+                              { ss = ss, sn = SNMap.insert (sn, k, v) } }
      fun genStableInfoMap (exports, group) = let
          (* find all the exported bnodes that are in the same group: *)
-Line 163
+Line 174
              val bool = PU.w_bool
              val int = PU.w_int
-             val symbolset = list symbol o SymbolSet.listItems
+             fun symbolset ss = let
+                 val op $ = PU.$ SS
+                 fun raw_ss ss = "s" $ list symbol (SymbolSet.listItems ss)
+             in
+                 share SSs raw_ss ss
+             end
              val filter = option symbolset
-Line 179
+Line 195
                  val spec = SrcPath.specOf (SmlInfo.sourcepath i)
                  val locs = SmlInfo.errorLocation gp i
                  val offset = registerOffset (i, bsz i)
+                 val share = SmlInfo.share i
+                 val op $ = PU.$ SI
              in
-                 string spec & string locs & int offset & sh (SmlInfo.share i)
+                 "s" $ string spec & string locs & int offset & sh share
              end
              fun primitive p =
-Line 214
+Line 232
                  list string pp
              end
-             val BN = 1
              val op $ = PU.$ BN
              fun bn (DG.PNODE p) = "1" $ primitive p
                | bn (DG.BNODE { bininfo = i, ... }) = let
-Line 223
+Line 240
                      "2" $ int n & symbol sy
                  end
-             local
-                 val SN = 2
-                 val SBN = 3
-             in
                  fun sn n = let
                      fun raw_sn (DG.SNODE n) =
                          "a" $ si (#smlinfo n) & list sn (#localimports n) &
-Line 243
+Line 256
                        | DG.SB_SNODE n => "b" $ sn n
                  end
-                 and fsbn (f, n) = filter f & sbn n
+             and fsbn (f, n) = let
+                 val op $ = PU.$ FSBN
+             in
+                 "f" $ filter f & sbn n
              end
-             fun impexp (s, (n, _)) = symbol s & fsbn n
+             fun impexp (s, (n, _)) = let
+                 val op $ = PU.$ IMPEXP
+             in
+                 "i" $ symbol s & fsbn n
+             end
              fun w_exports e = list impexp (SymbolMap.listItemsi e)
-Line 438
+Line 458
              val stringListM = UU.mkMap ()
              val symbolListM = UU.mkMap ()
              val stringListM = UU.mkMap ()
+             val ssM = UU.mkMap ()
              val ssoM = UU.mkMap ()
              val boolOptionM = UU.mkMap ()
+             val siM = UU.mkMap ()
              val sgListM = UU.mkMap ()
              val snM = UU.mkMap ()
              val snListM = UU.mkMap ()
              val bnM = UU.mkMap ()
              val sbnM = UU.mkMap ()
+             val fsbnM = UU.mkMap ()
              val fsbnListM = UU.mkMap ()
+             val impexpM = UU.mkMap ()
              val impexpListM = UU.mkMap ()
              val stringlist = list stringListM string
-Line 459
+Line 483
              val symbollist = list symbolListM symbol
-             fun symbolset () =
+             fun symbolset () = let
-                 SymbolSet.addList (SymbolSet.empty, symbollist ())
+                 fun s #"s" = SymbolSet.addList (SymbolSet.empty, symbollist ())
+                   | s _ = raise Format
+             in
+                 share ssM s
+             end
              val filter = option ssoM symbolset
-Line 472
+Line 500
              val sh = option boolOptionM bool
              fun si () = let
-                 val spec = string ()
+                 fun s #"s" =
+                     let val spec = string ()
                  val locs = string ()
                  val offset = int () + offset_adjustment
                  val share = sh ()
-Line 485
+Line 514
                                offset = offset,
                                share = share }
              end
+                   | s _ = raise Format
+             in
+                 share siM s
+             end
              fun sg () = getGroup' (abspath ())
-Line 530
+Line 563
                  share sbnM sbn'
              end
-             and fsbn () = (filter (), sbn ())
+             and fsbn () = let
+                 fun f #"f" = (filter (), sbn ())
+                   | f _ = raise Format
+             in
+                 share fsbnM f
+             end
              and fsbnlist () = list fsbnListM fsbn ()
              fun impexp () = let
-                 val sy = symbol ()
+                 fun ie #"i" =
+                     let val sy = symbol ()
                  val (f, n) = fsbn ()    (* really reads farbnodes! *)
                  val e = bn2env n
-                 (* put a filter in front to avoid having the FCTENV being
+                         (* put a filter in front to avoid having the FCTENV
-                  * queried needlessly (this avoids spurious module loadings) *)
+                          * being queried needlessly (this avoids spurious
+                          * module loadings) *)
                  val e' = DAEnv.FILTER (SymbolSet.singleton sy, e)
              in
-                 (sy, ((f, DG.SB_BNODE n), e')) (* coerce to farsbnodes *)
+                         (* coerce to farsbnodes *)
+                         (sy, ((f, DG.SB_BNODE n), e'))
+                     end
+                   | ie _ = raise Format
+             in
+                 share impexpM ie
              end
              val impexplist = list impexpListM impexp

 Legend:



Removed from v.384
 


changed lines


 
Added in v.385
 Legend:



Removed from v.384
 


changed lines


 
Added in v.385
-Removed from v.384
+Added in v.385

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