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

revision 438, Wed Sep 15 16:37:27 1999 UTC revision 439, Wed Sep 15 16:37:27 1999 UTC
# Line 98  Line 98 
98          structure DTMap = StampMap          structure DTMap = StampMap
99          structure MBMap = StampMap          structure MBMap = StampMap
100      end      end
101    
102    
103        type pid = PS.persstamp
104        type mi = MI.modId * pid option
105    
106        fun mi_cmp ((mi, po), (mi', po')) = let
107            fun po_cmp (NONE, NONE) = EQUAL
108              | po_cmp (NONE, SOME _) = LESS
109              | po_cmp (SOME _, NONE) = GREATER
110              | po_cmp (SOME p, SOME p') = PS.compare (p, p')
111        in
112            case MI.cmp (mi, mi') of
113                EQUAL => po_cmp (po, po')
114              | unequal => unequal
115        end
116    
117        fun acc_pid (A.LVAR _) = NONE
118          | acc_pid (A.EXTERN p) = SOME p
119          | acc_pid (A.PATH (a, _)) = acc_pid a
120          | acc_pid A.NO_ACCESS = NONE
121    
122      structure MIMap = BinaryMapFn      structure MIMap = BinaryMapFn
123          (struct type ord_key = MI.modId val compare = MI.cmp end)          (struct type ord_key = mi val compare = mi_cmp end)
124    
125      structure PU = PickleUtil      structure PU = PickleUtil
126      structure PSymPid = PickleSymPid      structure PSymPid = PickleSymPid
# Line 719  Line 740 
740                            | NodeStub (i, s) =>                            | NodeStub (i, s) =>
741                                              "J" $ int i & symbol s & modId id                                              "J" $ int i & symbol s & modId id
742                  in                  in
743                      share (MIs id) gt_raw x                      share (MIs (id, NONE)) gt_raw x
744                  end                  end
745                | tc (T.DEFtyc x) = let                | tc (T.DEFtyc x) = let
746                      fun dt_raw x = let                      fun dt_raw x = let
# Line 730  Line 751 
751                                list bool strict & ipath path                                list bool strict & ipath path
752                      end                      end
753                  in                  in
754                      share (MIs (MI.TYCid (#stamp x))) dt_raw x                      share (MIs (MI.TYCid (#stamp x), NONE)) dt_raw x
755                  end                  end
756                | tc (T.PATHtyc { arity, entPath = ep, path }) =                | tc (T.PATHtyc { arity, entPath = ep, path }) =
757                  "D" $ int arity & entPath ep & ipath path                  "D" $ int arity & entPath ep & ipath path
# Line 822  Line 843 
843                                        "E" $ int i & symbol s & modId id                                        "E" $ int i & symbol s & modId id
844                      end                      end
845                  in                  in
846                      share (MIs id) sig_raw x                      share (MIs (id, NONE)) sig_raw x
847                  end                  end
848          in          in
849              sg arg              sg arg
# Line 848  Line 869 
869                                        "e" $ int i & symbol s & modId id                                        "e" $ int i & symbol s & modId id
870                      end                      end
871                  in                  in
872                      share (MIs id) fsig_raw x                      share (MIs (id, NONE)) fsig_raw x
873                  end                  end
874          in          in
875              fsg arg              fsg arg
# Line 904  Line 925 
925                            | NodeStub (i, s) =>                            | NodeStub (i, s) =>
926                                   "J" $ int i & symbol s & modId id & access a                                   "J" $ int i & symbol s & modId id & access a
927                  in                  in
928                      share (MIs id) s_raw x                      share (MIs (id, acc_pid (#access x))) s_raw x
929                  end                  end
930                | str _ = bug "unexpected structure in pickmod"                | str _ = bug "unexpected structure in pickmod"
931          in          in
# Line 927  Line 948 
948                            | NodeStub (i, s) =>                            | NodeStub (i, s) =>
949                                  "I" $ int i & symbol s & modId id & access a                                  "I" $ int i & symbol s & modId id & access a
950                  in                  in
951                      share (MIs id) f_raw x                      share (MIs (id, acc_pid (#access x))) f_raw x
952                  end                  end
953          in          in
954              fct arg              fct arg
# Line 1004  Line 1025 
1025                        | PrimStub s => "F" $ string s & modId id                        | PrimStub s => "F" $ string s & modId id
1026                        | NodeStub (i, s) => "G" $ int i & symbol s & modId id                        | NodeStub (i, s) => "G" $ int i & symbol s & modId id
1027              in              in
1028                  share (MIs id) mee_raw (s, r)                  share (MIs (id, NONE)) mee_raw (s, r)
1029              end              end
1030            | entityEnv (M.BINDeenv (d, r)) =            | entityEnv (M.BINDeenv (d, r)) =
1031              PU.$ EEV ("A", list (pair (entVar, entity)) (ED.listItemsi d) &              PU.$ EEV ("A", list (pair (entVar, entity)) (ED.listItemsi d) &

Legend:
Removed from v.438  
changed lines
  Added in v.439

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