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/branches/primop-branch-3/compiler/Semant/pickle/pickmod.sml
ViewVC logotype

Diff of /sml/branches/primop-branch-3/compiler/Semant/pickle/pickmod.sml

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

revision 2739, Tue Aug 21 20:44:08 2007 UTC revision 2740, Tue Aug 21 21:05:34 2007 UTC
# Line 118  Line 118 
118          (struct type ord_key = LT.lty val compare = LT.lt_cmp end)          (struct type ord_key = LT.lty val compare = LT.lt_cmp end)
119      structure TCMap = MapFn      structure TCMap = MapFn
120          (struct type ord_key = LT.tyc val compare = LT.tc_cmp end)          (struct type ord_key = LT.tyc val compare = LT.tc_cmp end)
121        structure PKMap = MapFn
122            (struct
123               type ord_key = T.pkind
124               (* [GK] TODO: compare needs to be done right. TKMap uses
125                  LT.tk_cmp, which is just pointer ordering. The front-end
126                  representation of kinds is simpler, hence cannot do
127                  pointer ordering there. *)
128               fun compare(T.PK_MONO, T.PK_MONO) = EQUAL
129                 | compare(T.PK_MONO, T.PK_SEQ _) = LESS
130                 | compare(T.PK_SEQ _, T.PK_MONO) = GREATER
131                 | compare _ = EQUAL
132             end)
133      structure TKMap = MapFn      structure TKMap = MapFn
134          (struct type ord_key = LT.tkind val compare = LT.tk_cmp end)          (struct type ord_key = LT.tkind val compare = LT.tk_cmp end)
135      structure DTMap = StampMap      structure DTMap = StampMap
# Line 129  Line 141 
141      type map =      type map =
142          { lt: PU.id LTMap.map,          { lt: PU.id LTMap.map,
143            tc: PU.id TCMap.map,            tc: PU.id TCMap.map,
144              pk: PU.id PKMap.map,
145            tk: PU.id TKMap.map,            tk: PU.id TKMap.map,
146            dt: PU.id DTMap.map,            dt: PU.id DTMap.map,
147            mb: PU.id MBMap.map,            mb: PU.id MBMap.map,
148            mi: PU.id MI.umap }            mi: PU.id MI.umap }
149    
150      val emptyMap = { lt = LTMap.empty, tc = TCMap.empty, tk = TKMap.empty,      val emptyMap = { lt = LTMap.empty, tc = TCMap.empty, pk = PKMap.empty,
151                         tk = TKMap.empty,
152                       dt = DTMap.empty, mb = MBMap.empty, mi = MI.emptyUmap }                       dt = DTMap.empty, mb = MBMap.empty, mi = MI.emptyUmap }
153    
154      (* type info *)      (* type info *)
# Line 144  Line 158 
158           STR, F, STE, TCE, STRE, FE, EE, ED, EEV, FX,           STR, F, STE, TCE, STRE, FE, EE, ED, EEV, FX,
159           B, DCON, DICT, FPRIM, FUNDEC, TFUNDEC, DATACON, DTMEM, NRD, OVERLD,           B, DCON, DICT, FPRIM, FUNDEC, TFUNDEC, DATACON, DTMEM, NRD, OVERLD,
160           FCTC, SEN, FEN, SPATH, IPATH, STRID, FCTID, CCI, CTYPE, CCALL_TYPE,           FCTC, SEN, FEN, SPATH, IPATH, STRID, FCTID, CCI, CTYPE, CCALL_TYPE,
161           SPE, TSI) =           SPE, TSI, PK) =
162          ( 1,  2,  3,  4,  5,  6,  7,  8,  9, 10,          ( 1,  2,  3,  4,  5,  6,  7,  8,  9, 10,
163           11, 12, 13, 14, 15, 16, 17, 18, 19, 20,           11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
164           21, 22, 23, 24, 25, 26, 27, 28, 29, 30,           21, 22, 23, 24, 25, 26, 27, 28, 29, 30,
165           31, 32, 33, 34, 35, 36, 37, 38, 39, 40,           31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
166           41, 42, 43, 44, 45, 46, 47, 48, 49, 50,           41, 42, 43, 44, 45, 46, 47, 48, 49, 50,
167           51, 52, 53, 54, 55, 56, 57, 58, 59, 60,           51, 52, 53, 54, 55, 56, 57, 58, 59, 60,
168           61, 62)           61, 62, 63)
169    
170      (* this is a bit awful...      (* this is a bit awful...
171       * (we really ought to have syntax for "functional update") *)       * (we really ought to have syntax for "functional update") *)
172      val LTs = { find = fn (m: map, x) => LTMap.find (#lt m, x),      val LTs = { find = fn (m: map, x) => LTMap.find (#lt m, x),
173                  insert = fn ({ lt, tc, tk, dt, mb, mi }, x, v) =>                  insert = fn ({ lt, tc, pk,tk, dt, mb, mi }, x, v) =>
174                           { lt = LTMap.insert (lt, x, v),                           { lt = LTMap.insert (lt, x, v),
175                             tc = tc,                             tc = tc,
176                               pk = pk,
177                             tk = tk,                             tk = tk,
178                             dt = dt,                             dt = dt,
179                             mb = mb,                             mb = mb,
180                             mi = mi } }                             mi = mi } }
181      val TCs = { find = fn (m: map, x) => TCMap.find (#tc m, x),      val TCs = { find = fn (m: map, x) => TCMap.find (#tc m, x),
182                  insert = fn ({ lt, tc, tk, dt, mb, mi }, x, v) =>                  insert = fn ({ lt, tc, pk,tk, dt, mb, mi }, x, v) =>
183                           { lt = lt,                           { lt = lt,
184                             tc = TCMap.insert (tc, x, v),                             tc = TCMap.insert (tc, x, v),
185                               pk = pk,
186                             tk = tk,                             tk = tk,
187                             dt = dt,                             dt = dt,
188                             mb = mb,                             mb = mb,
189                             mi = mi } }                             mi = mi } }
190      val TKs = { find = fn (m: map, x) => TKMap.find (#tk m, x),      val TKs = { find = fn (m: map, x) => TKMap.find (#tk m, x),
191                  insert = fn ({ lt, tc, tk, dt, mb, mi }, x, v) =>                  insert = fn ({ lt, tc, pk,tk, dt, mb, mi }, x, v) =>
192                           { lt = lt,                           { lt = lt,
193                             tc = tc,                             tc = tc,
194                               pk = pk,
195                             tk = TKMap.insert (tk, x, v),                             tk = TKMap.insert (tk, x, v),
196                             dt = dt,                             dt = dt,
197                             mb = mb,                             mb = mb,
198                             mi = mi } }                             mi = mi } }
199        val PKs = { find = fn (m: map, x) => PKMap.find (#pk m, x),
200                    insert = fn ({ lt, tc, pk,tk, dt, mb, mi }, x, v) =>
201                             { lt = lt,
202                               tc = tc,
203                               pk = PKMap.insert (pk, x, v),
204                               tk = tk,
205                               dt = dt,
206                               mb = mb,
207                               mi = mi } }
208      fun DTs x = { find = fn (m: map, _) => DTMap.find (#dt m, x),      fun DTs x = { find = fn (m: map, _) => DTMap.find (#dt m, x),
209                    insert = fn ({ lt, tc, tk, dt, mb, mi }, _, v) =>                    insert = fn ({ lt, tc, pk,tk, dt, mb, mi }, _, v) =>
210                             { lt = lt,                             { lt = lt,
211                               tc = tc,                               tc = tc,
212                                 pk = pk,
213                               tk = tk,                               tk = tk,
214                               dt = DTMap.insert (dt, x, v),                               dt = DTMap.insert (dt, x, v),
215                               mb = mb,                               mb = mb,
216                               mi = mi } }                               mi = mi } }
217      fun MBs x = { find = fn (m: map, _) => MBMap.find (#mb m, x),      fun MBs x = { find = fn (m: map, _) => MBMap.find (#mb m, x),
218                    insert = fn ({ lt, tc, tk, dt, mb, mi }, _, v) =>                    insert = fn ({ lt, tc, pk,tk, dt, mb, mi }, _, v) =>
219                             { lt = lt,                             { lt = lt,
220                               tc = tc,                               tc = tc,
221                                 pk = pk,
222                               tk = tk,                               tk = tk,
223                               dt = dt,                               dt = dt,
224                               mb = MBMap.insert (mb, x, v),                               mb = MBMap.insert (mb, x, v),
225                               mi = mi } }                               mi = mi } }
226      fun TYCs id = { find = fn (m: map, _) => MI.uLookTyc (#mi m, id),      fun TYCs id = { find = fn (m: map, _) => MI.uLookTyc (#mi m, id),
227                      insert = fn ({ lt, tc, tk, dt, mb, mi }, _, v) =>                      insert = fn ({ lt, tc, pk,tk, dt, mb, mi }, _, v) =>
228                                  { lt = lt,                                  { lt = lt,
229                                    tc = tc,                                    tc = tc,
230                                      pk = pk,
231                                    tk = tk,                                    tk = tk,
232                                    dt = dt,                                    dt = dt,
233                                    mb = mb,                                    mb = mb,
234                                    mi = MI.uInsertTyc (mi, id, v) } }                                    mi = MI.uInsertTyc (mi, id, v) } }
235      val SIGs = { find = fn (m: map, r) => MI.uLookSig (#mi m, MI.sigId r),      val SIGs = { find = fn (m: map, r) => MI.uLookSig (#mi m, MI.sigId r),
236                   insert = fn ({ lt, tc, tk, dt, mb, mi }, r, v) =>                   insert = fn ({ lt, tc, pk,tk, dt, mb, mi }, r, v) =>
237                               { lt = lt,                               { lt = lt,
238                                 tc = tc,                                 tc = tc,
239                                   pk = pk,
240                                 tk = tk,                                 tk = tk,
241                                 dt = dt,                                 dt = dt,
242                                 mb = mb,                                 mb = mb,
243                                 mi = MI.uInsertSig (mi, MI.sigId r, v) } }                                 mi = MI.uInsertSig (mi, MI.sigId r, v) } }
244      fun STRs i = { find = fn (m: map, _) => MI.uLookStr (#mi m, i),      fun STRs i = { find = fn (m: map, _) => MI.uLookStr (#mi m, i),
245                     insert = fn ({ lt, tc, tk, dt, mb, mi }, _, v) =>                     insert = fn ({ lt, tc, pk,tk, dt, mb, mi }, _, v) =>
246                                 { lt = lt,                                 { lt = lt,
247                                   tc = tc,                                   tc = tc,
248                                     pk = pk,
249                                   tk = tk,                                   tk = tk,
250                                   dt = dt,                                   dt = dt,
251                                   mb = mb,                                   mb = mb,
252                                   mi = MI.uInsertStr (mi, i, v) } }                                   mi = MI.uInsertStr (mi, i, v) } }
253      fun FCTs i = { find = fn (m: map, _) => MI.uLookFct (#mi m, i),      fun FCTs i = { find = fn (m: map, _) => MI.uLookFct (#mi m, i),
254                     insert = fn ({ lt, tc, tk, dt, mb, mi }, _, v) =>                     insert = fn ({ lt, tc, pk,tk, dt, mb, mi }, _, v) =>
255                                 { lt = lt,                                 { lt = lt,
256                                   tc = tc,                                   tc = tc,
257                                     pk = pk,
258                                   tk = tk,                                   tk = tk,
259                                   dt = dt,                                   dt = dt,
260                                   mb = mb,                                   mb = mb,
261                                   mi = MI.uInsertFct (mi, i, v) } }                                   mi = MI.uInsertFct (mi, i, v) } }
262      val ENVs = { find = fn (m: map, r) => MI.uLookEnv (#mi m, MI.envId r),      val ENVs = { find = fn (m: map, r) => MI.uLookEnv (#mi m, MI.envId r),
263                   insert = fn ({ lt, tc, tk, dt, mb, mi }, r, v) =>                   insert = fn ({ lt, tc, pk,tk, dt, mb, mi }, r, v) =>
264                               { lt = lt,                               { lt = lt,
265                                 tc = tc,                                 tc = tc,
266                                   pk = pk,
267                                 tk = tk,                                 tk = tk,
268                                 dt = dt,                                 dt = dt,
269                                 mb = mb,                                 mb = mb,
# Line 508  Line 541 
541          { access = access, conrep = conrep }          { access = access, conrep = conrep }
542      end      end
543    
544        fun pkind x = let
545            val op $ = PU.$ PK
546            fun pk T.PK_MONO = "A" $ []
547              | pk (T.PK_SEQ ks) = "B" $ [list pkind ks]
548              | pk (T.PK_FUN (ks, kr)) = "C" $ [list pkind ks, pkind kr]
549        in
550            share PKs pk x
551        end
552    
553      (* lambda-type stuff; some of it is used in both picklers *)      (* lambda-type stuff; some of it is used in both picklers *)
554      fun tkind x = let      fun tkind x = let
555          val op $ = PU.$ TK          val op $ = PU.$ TK
# Line 1007  Line 1049 
1049                                     fctflag, elements,                                     fctflag, elements,
1050                                     properties,                                     properties,
1051                                     stub, typsharing, strsharing } = s                                     stub, typsharing, strsharing } = s
1052                               val b = ModulePropLists.sigBoundeps s                               val b = ModPropList.sigBoundeps s
1053                               val b = NONE (* currently turned off *)                               val b = NONE (* currently turned off *)
1054                           in                           in
1055                               "C" $ ([stamp sta,                               "C" $ ([stamp sta,
1056                                       option symbol name, bool closed,                                       option symbol name, bool closed,
1057                                       bool fctflag,                                       bool fctflag,
1058                                       list (pair (symbol, spec)) elements,                                       list (pair (symbol, spec)) elements,
1059                                       option (list (pair (entPath, tkind))) b,                                       option (list (pair (entPath, pkind))) b,
1060                                       list (list spath) typsharing,                                       list (list spath) typsharing,
1061                                       list (list spath) strsharing]                                       list (list spath) strsharing]
1062                                      @ libPid (stub, #owner))                                      @ libPid (stub, #owner))

Legend:
Removed from v.2739  
changed lines
  Added in v.2740

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