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/compiler/Semant/pickle/pickmod-new.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/Semant/pickle/pickmod-new.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

sml/branches/SMLNJ/src/compiler/Semant/pickle/pickmod-new.sml revision 428, Wed Sep 8 09:47:00 1999 UTC sml/trunk/src/compiler/Semant/pickle/pickmod-new.sml revision 476, Wed Nov 10 22:59:58 1999 UTC
# Line 49  Line 49 
49                       Access.lvar list * PersStamps.persstamp option                       Access.lvar list * PersStamps.persstamp option
50  end  end
51    
52    local
53        (* make those into red-black-maps once rb-maps work correcty. *)
54        functor MapFn = RedBlackMapFn
55        structure IntMap = IntRedBlackMap
56    in
57  structure PickMod :> PICKMOD = struct  structure PickMod :> PICKMOD = struct
58    
59      (* to gather some statistics... *)      (* to gather some statistics... *)
# Line 85  Line 90 
90          if Symbol.symbolGt (a, b) then GREATER          if Symbol.symbolGt (a, b) then GREATER
91          else if Symbol.eq (a, b) then EQUAL else LESS          else if Symbol.eq (a, b) then EQUAL else LESS
92    
93      structure LTMap = BinaryMapFn      structure LTMap = MapFn
94          (struct type ord_key = LK.lty val compare = LK.lt_cmp end)          (struct type ord_key = LK.lty val compare = LK.lt_cmp end)
95      structure TCMap = BinaryMapFn      structure TCMap = MapFn
96          (struct type ord_key = LK.tyc val compare = LK.tc_cmp end)          (struct type ord_key = LK.tyc val compare = LK.tc_cmp end)
97      structure TKMap = BinaryMapFn      structure TKMap = MapFn
98          (struct type ord_key = LK.tkind val compare = LK.tk_cmp end)          (struct type ord_key = LK.tkind val compare = LK.tk_cmp end)
99      local      local
100          structure StampMap = BinaryMapFn          structure StampMap = MapFn
101              (struct type ord_key = Stamps.stamp val compare = Stamps.cmp end)              (struct type ord_key = Stamps.stamp val compare = Stamps.cmp end)
102      in      in
103          structure DTMap = StampMap          structure DTMap = StampMap
104          structure MBMap = StampMap          structure MBMap = StampMap
105      end      end
106      structure MIMap = BinaryMapFn  
107          (struct type ord_key = MI.modId val compare = MI.cmp end)  
108        type pid = PS.persstamp
109        type mi = MI.modId * pid option
110    
111        fun mi_cmp ((mi, po), (mi', po')) = let
112            fun po_cmp (NONE, NONE) = EQUAL
113              | po_cmp (NONE, SOME _) = LESS
114              | po_cmp (SOME _, NONE) = GREATER
115              | po_cmp (SOME p, SOME p') = PS.compare (p, p')
116        in
117            case MI.cmp (mi, mi') of
118                EQUAL => po_cmp (po, po')
119              | unequal => unequal
120        end
121    
122        fun acc_pid (A.LVAR _) = NONE
123          | acc_pid (A.EXTERN p) = SOME p
124          | acc_pid (A.PATH (a, _)) = acc_pid a
125          | acc_pid A.NO_ACCESS = NONE
126    
127        structure MIMap = MapFn
128            (struct type ord_key = mi val compare = mi_cmp end)
129    
130      structure PU = PickleUtil      structure PU = PickleUtil
131      structure PSymPid = PickleSymPid      structure PSymPid = PickleSymPid
# Line 199  Line 225 
225      val pid = PSymPid.w_pid      val pid = PSymPid.w_pid
226    
227      fun mkAlphaConvert () = let      fun mkAlphaConvert () = let
228          val m = ref IntBinaryMap.empty          val m = ref IntMap.empty
229          val cnt = ref 0          val cnt = ref 0
230          fun cvt i =          fun cvt i =
231              case IntBinaryMap.find (!m, i) of              case IntMap.find (!m, i) of
232                  SOME i' => i'                  SOME i' => i'
233                | NONE => let                | NONE => let
234                      val i' = !cnt                      val i' = !cnt
235                  in                  in
236                      cnt := i' + 1;                      cnt := i' + 1;
237                      m := IntBinaryMap.insert (!m, i, i');                      m := IntMap.insert (!m, i, i');
238                      i'                      i'
239                  end                  end
240      in      in
# Line 719  Line 745 
745                            | NodeStub (i, s) =>                            | NodeStub (i, s) =>
746                                              "J" $ int i & symbol s & modId id                                              "J" $ int i & symbol s & modId id
747                  in                  in
748                      share (MIs id) gt_raw x                      share (MIs (id, NONE)) gt_raw x
749                  end                  end
750                | tc (T.DEFtyc x) = let                | tc (T.DEFtyc x) = let
751                      fun dt_raw x = let                      fun dt_raw x = let
# Line 730  Line 756 
756                                list bool strict & ipath path                                list bool strict & ipath path
757                      end                      end
758                  in                  in
759                      share (MIs (MI.TYCid (#stamp x))) dt_raw x                      share (MIs (MI.TYCid (#stamp x), NONE)) dt_raw x
760                  end                  end
761                | tc (T.PATHtyc { arity, entPath = ep, path }) =                | tc (T.PATHtyc { arity, entPath = ep, path }) =
762                  "D" $ int arity & entPath ep & ipath path                  "D" $ int arity & entPath ep & ipath path
# Line 822  Line 848 
848                                        "E" $ int i & symbol s & modId id                                        "E" $ int i & symbol s & modId id
849                      end                      end
850                  in                  in
851                      share (MIs id) sig_raw x                      share (MIs (id, NONE)) sig_raw x
852                  end                  end
853          in          in
854              sg arg              sg arg
# Line 848  Line 874 
874                                        "e" $ int i & symbol s & modId id                                        "e" $ int i & symbol s & modId id
875                      end                      end
876                  in                  in
877                      share (MIs id) fsig_raw x                      share (MIs (id, NONE)) fsig_raw x
878                  end                  end
879          in          in
880              fsg arg              fsg arg
# Line 904  Line 930 
930                            | NodeStub (i, s) =>                            | NodeStub (i, s) =>
931                                   "J" $ int i & symbol s & modId id & access a                                   "J" $ int i & symbol s & modId id & access a
932                  in                  in
933                      share (MIs id) s_raw x                      share (MIs (id, acc_pid (#access x))) s_raw x
934                  end                  end
935                | str _ = bug "unexpected structure in pickmod"                | str _ = bug "unexpected structure in pickmod"
936          in          in
# Line 927  Line 953 
953                            | NodeStub (i, s) =>                            | NodeStub (i, s) =>
954                                  "I" $ int i & symbol s & modId id & access a                                  "I" $ int i & symbol s & modId id & access a
955                  in                  in
956                      share (MIs id) f_raw x                      share (MIs (id, acc_pid (#access x))) f_raw x
957                  end                  end
958          in          in
959              fct arg              fct arg
# Line 1004  Line 1030 
1030                        | PrimStub s => "F" $ string s & modId id                        | PrimStub s => "F" $ string s & modId id
1031                        | NodeStub (i, s) => "G" $ int i & symbol s & modId id                        | NodeStub (i, s) => "G" $ int i & symbol s & modId id
1032              in              in
1033                  share (MIs id) mee_raw (s, r)                  share (MIs (id, NONE)) mee_raw (s, r)
1034              end              end
1035            | entityEnv (M.BINDeenv (d, r)) =            | entityEnv (M.BINDeenv (d, r)) =
1036              PU.$ EEV ("A", list (pair (entVar, entity)) (ED.listItemsi d) &              PU.$ EEV ("A", list (pair (entVar, entity)) (ED.listItemsi d) &
# Line 1179  Line 1205 
1205          (newenv, hash, rev lvars, exportPid)          (newenv, hash, rev lvars, exportPid)
1206      end      end
1207  end  end
1208    end
1209    

Legend:
Removed from v.428  
changed lines
  Added in v.476

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