Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/SMLNJ/src/compiler/Semant/pickle/pickmod.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/compiler/Semant/pickle/pickmod.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (view) (download)
Original Path: sml/trunk/src/compiler/Semant/pickle/pickmod.sml

1 : monnier 16 (* COPYRIGHT (c) 1996 Bell Laboratories *)
2 :     (* pickmod.sml *)
3 :    
4 :     signature PICKMOD =
5 :     sig
6 :     val pickleEnv :
7 :     SCStaticEnv.staticEnv * StaticEnv.staticEnv
8 :     -> {hash: PersStamps.persstamp,
9 :     pickle: Word8Vector.vector,
10 :     exportLvars: Access.lvar list,
11 :     exportPid: PersStamps.persstamp option}
12 :     val pickleFLINT:
13 :     CompBasic.flint option ->
14 :     {hash: PersStamps.persstamp, pickle: Word8Vector.vector}
15 :    
16 :     val pickle2hash: Word8Vector.vector -> PersStamps.persstamp
17 :    
18 :     val dontPickle :
19 :     StaticEnv.staticEnv * int
20 :     -> StaticEnv.staticEnv * PersStamps.persstamp *
21 :     Access.lvar list * PersStamps.persstamp option
22 :    
23 :     val debugging : bool ref
24 :     val debuggingSW : bool ref
25 :    
26 :     end (* signature PICKMOD *)
27 :    
28 :     structure PickMod : PICKMOD =
29 :     struct
30 :    
31 :     local structure A = Access
32 :     structure B = Bindings
33 :     structure DI = DebIndex
34 :     structure EP = EntPath
35 :     structure ED = EntPath.EvDict
36 :     structure II = InlInfo
37 :     structure IP = InvPath
38 :     structure F = FLINT
39 :     structure LK = LtyKernel (* structure LT = LtyDef *)
40 :     (** pickmod must look under the abstract lty representation *)
41 :     structure M = Modules
42 :     structure MI = ModuleId
43 :     structure P = PrimOp
44 :     structure PS = PersStamps
45 :     structure PT = PrimTyc
46 :     structure S = Symbol
47 :     structure SP = SymPath
48 :     structure T = Types
49 :     structure TU = TypesUtil
50 :     structure V = VarCon
51 :     structure LtyKey : ORD_KEY =
52 :     struct type ord_key = LK.lty * DI.depth
53 :     fun cmpKey((t,d),(t',d')) =
54 :     case LK.lt_cmp(t,t') of EQUAL => DI.cmp(d,d')
55 :     | x => x
56 :     end
57 :     structure LtyDict = BinaryDict(LtyKey)
58 :     in
59 :    
60 :     val say = Control.Print.say
61 :     val debugging = ref true
62 :     fun debugmsg (msg: string) =
63 :     if !debugging then (say msg; say "\n") else ()
64 :     fun bug msg = ErrorMsg.impossible ("PickMod: " ^ msg)
65 :    
66 :     fun isGlobalStamp(Stamps.STAMP{scope=Stamps.GLOBAL _,...}) = true
67 :     | isGlobalStamp _ = false
68 :    
69 :     val addPickles = Stats.addStat(Stats.makeStat "Pickle Bytes")
70 :    
71 :     (**************************************************************************
72 :     * UTILITY FUNCTIONS *
73 :     **************************************************************************)
74 :     datatype key
75 :     = MIkey of MI.modId
76 :     | LTkey of LK.lty
77 :     | TCkey of LK.tyc
78 :     | TKkey of LK.tkind
79 :     | DTkey of Stamps.stamp
80 :     | MBkey of Stamps.stamp
81 :     | EPkey of EP.entPath
82 :    
83 :     structure Key =
84 :     struct
85 :     type ord_key = key
86 :    
87 :     fun cmpKey(MIkey a', MIkey b') = MI.cmp(a',b')
88 :     | cmpKey(MIkey _, _) = GREATER
89 :     | cmpKey(_, MIkey _) = LESS
90 :     | cmpKey(LTkey a', LTkey b') = LK.lt_cmp(a',b')
91 :     | cmpKey(LTkey _, _) = GREATER
92 :     | cmpKey(_, LTkey _) = LESS
93 :     | cmpKey(TCkey a', TCkey b') = LK.tc_cmp(a',b')
94 :     | cmpKey(TCkey _, _) = GREATER
95 :     | cmpKey(_, TCkey _) = LESS
96 :     | cmpKey(TKkey a', TKkey b') = LK.tk_cmp(a',b')
97 :     | cmpKey(TKkey _, _) = GREATER
98 :     | cmpKey(_, TKkey _) = LESS
99 :     | cmpKey(DTkey a', DTkey b') = Stamps.cmp(a',b')
100 :     | cmpKey(DTkey _, _) = GREATER
101 :     | cmpKey(_, DTkey _) = LESS
102 :     | cmpKey(MBkey a', MBkey b') = Stamps.cmp(a',b')
103 :     | cmpKey(MBkey _, _) = GREATER
104 :     | cmpKey(_, MBkey _) = LESS
105 :     | cmpKey(EPkey a', EPkey b') = EP.cmpEntPath(a', b')
106 :     (*
107 :     | cmpKey(EPkey _, _) = GREATER
108 :     | cmpKey(_, EPkey _) = LESS
109 :     *)
110 :    
111 :    
112 :     end (* structure Key *)
113 :    
114 :     structure W = ShareWrite(Key)
115 :    
116 :     val debuggingSW = W.debugging
117 :     (*
118 :     val cnt = ref 0
119 :     fun getcnt () = if !cnt = 10 then (cnt := 0; true) else (cnt := (!cnt)+1; false)
120 :     fun dmsg x = (say x; if getcnt() then say "\n" else ())
121 :    
122 :     val $ = fn (s,z) => (dmsg (s^" "); W.$(s,z))
123 :     *)
124 :     val $ = W.$
125 :     infix $
126 :    
127 :     val nilEncode = "Na" $ []
128 :    
129 :     fun list alpha nil () = nilEncode
130 :     | list alpha [a] () = "1a" $ [alpha a]
131 :     | list alpha [a,b] () = "2a" $ [alpha a, alpha b]
132 :     | list alpha [a,b,c] () = "3a" $ [alpha a, alpha b, alpha c]
133 :     | list alpha [a,b,c,d] () = "4a" $ [alpha a, alpha b, alpha c, alpha d]
134 :     | list alpha [a,b,c,d,e] () =
135 :     "5a" $ [alpha a, alpha b, alpha c, alpha d, alpha e]
136 :     | list alpha (a::b::c::d::e::rest) () =
137 :     "Ma" $ [alpha a, alpha b, alpha c, alpha d, alpha e, list alpha rest]
138 :    
139 :     fun tuple2 (alpha,beta) (x,y) () = "Tb" $ [alpha x, beta y]
140 :    
141 :     fun option alpha (SOME x) () = "Sc" $ [alpha x]
142 :     | option alpha NONE () = "Nc" $ []
143 :    
144 :     fun bool true () = "Td" $ []
145 :     | bool false() = "Fd" $ []
146 :    
147 :     fun persstamp x = W.w8vector (PS.toBytes x)
148 :    
149 :     fun symbol s () =
150 :     let val code =
151 :     case S.nameSpace s
152 :     of S.VALspace => "Ap"
153 :     | S.TYCspace => "Bp"
154 :     | S.SIGspace => "Cp"
155 :     | S.STRspace => "Dp"
156 :     | S.FCTspace => "Ep"
157 :     | S.FIXspace => "Fp"
158 :     | S.LABspace => "Gp"
159 :     | S.TYVspace => "Hp"
160 :     | S.FSIGspace=> "Ip"
161 :     in code $ [W.string(S.name s)]
162 :     end
163 :    
164 :     val int = W.int
165 :     val word = W.string o Word.toString
166 :     val word32 = W.string o Word32.toString
167 :     val int32 = W.string o Int32.toString
168 :    
169 :     (* val apath = int list *)
170 :    
171 :     fun numkind (P.INT i) () = "Ig" $ [int i]
172 :     | numkind (P.UINT i) () = "Ug" $ [int i]
173 :     | numkind (P.FLOAT i) () = "Fg" $ [int i]
174 :    
175 :     fun arithop P.+ () = "ah" $ []
176 :     | arithop P.- () = "bh" $ []
177 :     | arithop P.* () = "ch" $ []
178 :     | arithop P./ () = "dh" $ []
179 :     | arithop P.~ () = "eh" $ []
180 :     | arithop P.ABS () = "fh" $ []
181 :     | arithop P.LSHIFT () = "gh" $ []
182 :     | arithop P.RSHIFT () = "hh" $ []
183 :     | arithop P.RSHIFTL () = "ih" $ []
184 :     | arithop P.ANDB () = "jh" $ []
185 :     | arithop P.ORB () = "kh" $ []
186 :     | arithop P.XORB () = "lh" $ []
187 :     | arithop P.NOTB () = "mh" $ []
188 :    
189 :     fun cmpop P.> () = "ai" $ []
190 :     | cmpop P.>= () = "bi" $ []
191 :     | cmpop P.< () = "ci" $ []
192 :     | cmpop P.<= () = "di" $ []
193 :     | cmpop P.LEU () = "ei" $ []
194 :     | cmpop P.LTU () = "fi" $ []
195 :     | cmpop P.GEU () = "gi" $ []
196 :     | cmpop P.GTU () = "hi" $ []
197 :     | cmpop P.EQL () = "ii" $ []
198 :     | cmpop P.NEQ () = "ji" $ []
199 :    
200 :     fun primop (P.ARITH{oper=p,overflow=v,kind=k}) () =
201 :     "Aj" $ [arithop p, bool v, numkind k]
202 :     | primop (P.CMP{oper=p,kind=k}) () =
203 :     "Cj" $ [cmpop p, numkind k]
204 :    
205 :     | primop (P.TEST(from,to)) () = "Gj" $ [int from, int to]
206 :     | primop (P.TESTU(from,to)) () = "Hj" $ [int from, int to]
207 :     | primop (P.TRUNC(from,to)) () = "Ij" $ [int from, int to]
208 :     | primop (P.EXTEND(from,to)) () = "Jj" $ [int from, int to]
209 :     | primop (P.COPY(from,to)) () = "Kj" $ [int from, int to]
210 :    
211 :     | primop (P.INLLSHIFT k) () = "<j" $ [numkind k]
212 :     | primop (P.INLRSHIFT k) () = ">j" $ [numkind k]
213 :     | primop (P.INLRSHIFTL k) () = "Lj" $ [numkind k]
214 :    
215 :     | primop (P.ROUND{floor=f,fromkind=k,tokind=t}) () =
216 :     "Rj" $ [bool f, numkind k, numkind t]
217 :     | primop (P.REAL{fromkind=k,tokind=t}) () =
218 :     "Fj" $ [numkind k, numkind t]
219 :     | primop (P.NUMSUBSCRIPT{kind=k,checked=c,immutable=i}) () =
220 :     "Sj" $ [numkind k, bool c, bool i]
221 :     | primop (P.NUMUPDATE{kind=k,checked=c}) () =
222 :     "Uj" $ [numkind k, bool c]
223 :     | primop (P.INL_MONOARRAY k) () = "Mj" $ [numkind k]
224 :     | primop (P.INL_MONOVECTOR k) () = "Vj" $ [numkind k]
225 :    
226 :     | primop (P.MKETAG) () = "Xj" $ []
227 :     | primop (P.WRAP) () = "Yj" $ []
228 :     | primop (P.UNWRAP) () = "Zj" $ []
229 :    
230 :     | primop P.SUBSCRIPT () = "ak" $ []
231 :     | primop P.SUBSCRIPTV () = "bk" $ []
232 :     | primop P.INLSUBSCRIPT () = "ck" $ []
233 :     | primop P.INLSUBSCRIPTV () = "dk" $ []
234 :     | primop P.INLMKARRAY () = "~k" $ []
235 :    
236 :     | primop P.PTREQL () = "ek" $ []
237 :     | primop P.PTRNEQ () = "fk" $ []
238 :     | primop P.POLYEQL () = "gk" $ []
239 :     | primop P.POLYNEQ () = "hk" $ []
240 :     | primop P.BOXED () = "ik" $ []
241 :     | primop P.UNBOXED () = "jk" $ []
242 :     | primop P.LENGTH () = "kk" $ []
243 :     | primop P.OBJLENGTH () = "lk" $ []
244 :     | primop P.CAST () = "mk" $ []
245 :     | primop P.GETRUNVEC () = "nk" $ []
246 :     | primop P.MARKEXN () = "[k" $ []
247 :     | primop P.GETHDLR () = "ok" $ []
248 :     | primop P.SETHDLR () = "pk" $ []
249 :     | primop P.GETVAR () = "qk" $ []
250 :     | primop P.SETVAR () = "rk" $ []
251 :     | primop P.GETPSEUDO () = "sk" $ []
252 :     | primop P.SETPSEUDO () = "tk" $ []
253 :     | primop P.SETMARK () = "uk" $ []
254 :     | primop P.DISPOSE () = "vk" $ []
255 :     | primop P.MAKEREF () = "wk" $ []
256 :     | primop P.CALLCC () = "xk" $ []
257 :     | primop P.CAPTURE () = "yk" $ []
258 :     | primop P.THROW () = "zk" $ []
259 :     | primop P.DEREF () = "1k" $ []
260 :     | primop P.ASSIGN () = "2k" $ []
261 :     | primop P.UPDATE () = "3k" $ []
262 :     | primop P.INLUPDATE () = "4k" $ []
263 :     | primop P.BOXEDUPDATE () = "5k" $ []
264 :     | primop P.UNBOXEDUPDATE () = "6k" $ []
265 :    
266 :     | primop P.GETTAG () = "7k" $ []
267 :     | primop P.MKSPECIAL () = "8k" $ []
268 :     | primop P.SETSPECIAL () = "9k" $ []
269 :     | primop P.GETSPECIAL () = "0k" $ []
270 :     | primop P.USELVAR () = "!k" $ []
271 :     | primop P.DEFLVAR () = "@k" $ []
272 :     | primop P.INLDIV () = "#k" $ []
273 :     | primop P.INLMOD () = "$k" $ []
274 :     | primop P.INLREM () = "%k" $ []
275 :     | primop P.INLMIN () = "^k" $ []
276 :     | primop P.INLMAX () = "&k" $ []
277 :     | primop P.INLABS () = "*k" $ []
278 :     | primop P.INLNOT () = "(k" $ []
279 :     | primop P.INLCOMPOSE () = ")k" $ []
280 :     | primop P.INLBEFORE () = ",k" $ []
281 :     | primop P.INL_ARRAY () = ".k" $ []
282 :     | primop P.INL_VECTOR () = "/k" $ []
283 :     | primop P.ISOLATE () = ":k" $ []
284 :    
285 :    
286 :     fun consig (A.CSIG(i,j)) () = "S8" $ [W.int i, W.int j]
287 :     | consig (A.CNIL) () = "N8" $ []
288 :    
289 :     fun mkAccess var =
290 :     let fun access (A.LVAR i) () = "Ll" $ [var i]
291 :     | access (A.EXTERN p) () = "El" $ [persstamp p]
292 :     | access (A.PATH(a,i)) () = "Pl" $ [int i, access a]
293 :     | access (A.NO_ACCESS) () = "Nl" $ []
294 :    
295 :     fun conrep (A.UNTAGGED) () = "Um" $ []
296 :     | conrep (A.TAGGED i) () = "Tm" $ [int i]
297 :     | conrep (A.TRANSPARENT) () = "Bm" $ []
298 :     | conrep (A.CONSTANT i) () = "Cm" $ [int i]
299 :     | conrep (A.REF) () = "Rm" $ []
300 :     | conrep (A.EXN a) () = "Vm" $ [access a]
301 :     | conrep (A.LISTCONS) () = "Lm" $ []
302 :     | conrep (A.LISTNIL) () = "Nm" $ []
303 :     | conrep (A.SUSP NONE) () = "Sm" $ []
304 :     | conrep (A.SUSP (SOME (a,b))) () = "Xm" $ [access a, access b]
305 :    
306 :     in {access=access,conrep=conrep}
307 :     end
308 :    
309 :     fun alphaConverter () =
310 :     let exception AlphaCvt
311 :     val m: int Intmap.intmap = Intmap.new (32, AlphaCvt)
312 :     val alphacount = ref 0
313 :     fun alphaConvert i =
314 :     (Intmap.map m i
315 :     handle AlphaCvt => (let val j = !alphacount
316 :     in alphacount := j+1;
317 :     Intmap.add m (i,j);
318 :     j
319 :     end))
320 :     in alphaConvert
321 :     end
322 :    
323 :     fun mkStamp alphaConvert =
324 :     let fun stamp (Stamps.STAMP{scope=Stamps.LOCAL, count=i}) () =
325 :     "Le" $ [W.int(alphaConvert i)]
326 :     | stamp (Stamps.STAMP{scope=Stamps.GLOBAL pid, count=i}) () =
327 :     "Ge" $ [persstamp pid, W.int i]
328 :     | stamp (Stamps.STAMP{scope=Stamps.SPECIAL s, count=i}) () =
329 :     "Se" $ [W.string s, W.int i]
330 :     in stamp
331 :     end
332 :    
333 :     (** NOTE: the CRC functions really ought to work on Word8Vector.vectors **)
334 :     fun pickle2hash pickle =
335 :     PS.fromBytes(Byte.stringToBytes(CRC.toString(
336 :     CRC.fromString(Byte.bytesToString pickle))))
337 :    
338 :    
339 :     (**************************************************************************
340 :     * PICKLING A LAMBDA EXPRESSIONS *
341 :     **************************************************************************)
342 :    
343 :     fun mkPickleLty (stamp,tvar) =
344 :     let fun ltyI x () =
345 :     (case LK.lt_out x
346 :     of LK.LT_TYC tc => "An" $ [tyc tc]
347 :     | LK.LT_STR l => "Bn" $ [list lty l]
348 :     | LK.LT_PST l => "Cn" $ [list (tuple2 (int, lty)) l]
349 :     | LK.LT_FCT (ts1,ts2) => "Dn" $ [list lty ts1, list lty ts2]
350 :     | LK.LT_POLY(ks,ts) => "En" $ [list tkind ks, list lty ts]
351 :     | LK.LT_IND _ =>
352 :     bug "unexpected LT_IND in mkPickeLty"
353 :     | LK.LT_ENV (lt,ol,nl,te) =>
354 :     bug "unexpected LT_ENV in mkPickeLty"
355 :     | LK.LT_CONT _ =>
356 :     bug "unexpected LT_CONT in mkPickeLty")
357 :    
358 :     and lty x () =
359 :     if (LK.ltp_norm x) then
360 :     (W.identify (LTkey x) (fn () => ltyI x ()))
361 :     else ltyI x ()
362 :     (* bug "unexpected complex lambda type in mkPickleLty" *)
363 :    
364 :     and tycI x () =
365 :     (case LK.tc_out x
366 :     of LK.TC_VAR(db,i) => "A6" $ [int(DI.di_toint db), int i]
367 :     | LK.TC_NVAR(n, dp, i) =>
368 :     "B6" $ [int n, int(DI.dp_toint dp), int i]
369 :     | LK.TC_PRIM t => "C6" $ [int(PT.pt_toint t)]
370 :     | LK.TC_FN(ks,tc) => "D6" $ [list tkind ks, tyc tc]
371 :     | LK.TC_APP(tc,l) => "E6" $ [tyc tc, list tyc l]
372 :     | LK.TC_SEQ l => "F6" $ [list tyc l]
373 :     | LK.TC_PROJ(tc,i) => "G6" $ [tyc tc, int i]
374 :     | LK.TC_SUM l => "H6" $ [list tyc l]
375 :     | LK.TC_FIX((n,tc,ts),i) =>
376 :     "I6" $ [int n, tyc tc, list tyc ts, int i]
377 :     | LK.TC_ABS tc => "J6" $ [tyc tc]
378 :     | LK.TC_BOX tc => "K6" $ [tyc tc]
379 :     | LK.TC_TUPLE (_,l) => "L6" $ [list tyc l]
380 :     | LK.TC_ARROW ((b1,b2),ts1,ts2) =>
381 :     "M6" $ [bool b1, bool b2, list tyc ts1, list tyc ts2]
382 :     | LK.TC_PARROW _ =>
383 :     bug "unexpected TC_PARROW in mkPickleLty"
384 :     | LK.TC_IND _ =>
385 :     bug "unexpected TC_IND in mkPickleLty"
386 :     | LK.TC_ENV (tc, ol, nl, te) =>
387 :     bug "unexpected TC_ENV in mkPickleLty"
388 :     | LK.TC_CONT _ =>
389 :     bug "unexpected TC_CONT in mkPickleLty")
390 :    
391 :     and tyc x () =
392 :     if (LK.tcp_norm x) then
393 :     (W.identify (TCkey x) (fn () => tycI x ()))
394 :     else tycI x ()
395 :     (* bug "unexpected complex lambda tyc in mkPickleLty" *)
396 :    
397 :     and tkind x () =
398 :     W.identify (TKkey x)
399 :     (fn ()=>
400 :     case LK.tk_out x
401 :     of LK.TK_MONO => "A7" $ []
402 :     | LK.TK_BOX => "B7" $ []
403 :     | LK.TK_SEQ ks => "C7" $ [list tkind ks]
404 :     | LK.TK_FUN(ks,k) => "D7" $ [list tkind ks, tkind k])
405 :    
406 :     in {lty=lty,tyc=tyc,tkind=tkind}
407 :     end
408 :    
409 :     fun pickleFLINT fdecOp =
410 :     let val alphaConvert = alphaConverter()
411 :     val stamp = mkStamp alphaConvert
412 :     val lvar = int o alphaConvert
413 :     val tvar = lvar
414 :     val {access,conrep} = mkAccess lvar
415 :     val {lty,tyc,tkind} = mkPickleLty(stamp,tvar)
416 :    
417 :     fun con (F.DATAcon (dc, ts, v), e) () =
418 :     ".5" $ [dcon (dc, ts), lvar v, lexp e]
419 :     | con (F.INTcon i, e) () = ",5" $ [int i, lexp e]
420 :     | con (F.INT32con i32, e) () = "=5" $ [int32 i32, lexp e]
421 :     | con (F.WORDcon w, e) () = "?5" $ [word w, lexp e]
422 :     | con (F.WORD32con w32, e) () = ">5" $ [word32 w32, lexp e]
423 :     | con (F.REALcon s, e) () = "<5" $ [W.string s, lexp e]
424 :     | con (F.STRINGcon s, e) () = "'5" $ [W.string s, lexp e]
425 :     | con (F.VLENcon i, e) () = ";5" $ [int i, lexp e]
426 :    
427 :     and dcon ((s, cr, t), ts) () =
428 :     "^5" $ [symbol s, conrep cr, lty t, list tyc ts]
429 :    
430 :     and dict {default=v, table=tbls} () =
431 :     "%5" $ [lvar v, list (tuple2 (list tyc, lvar)) tbls]
432 :    
433 :     and value (F.VAR v) () = "a5" $ [lvar v]
434 :     | value (F.INT i) () = "b5" $ [int i]
435 :     | value (F.INT32 i32) () = "c5" $ [int32 i32]
436 :     | value (F.WORD w) () = "d5" $ [word w]
437 :     | value (F.WORD32 w32) () = "e5" $ [word32 w32]
438 :     | value (F.REAL s) () = "f5" $ [W.string s]
439 :     | value (F.STRING s) () = "g5" $ [W.string s]
440 :    
441 :     and fprim (NONE, p, t, ts) () =
442 :     "h5" $ [primop p, lty t, list tyc ts]
443 :     | fprim (SOME dt, p, t, ts) () =
444 :     "i5" $ [dict dt, primop p, lty t, list tyc ts]
445 :    
446 :     and lexp (F.RET vs) () = "j5" $ [list value vs]
447 :     | lexp (F.LET(vs, e1, e2)) () =
448 :     "k5" $ [list lvar vs, lexp e1, lexp e2]
449 :     | lexp (F.FIX (fdecs, e)) () = "l5" $ [list fundec fdecs, lexp e]
450 :     | lexp (F.APP (v, vs)) () = "m5" $ [value v, list value vs]
451 :     | lexp (F.TFN(tfdec, e)) () =
452 :     "n5" $ [tfundec tfdec, lexp e]
453 :     | lexp (F.TAPP(v, ts)) () =
454 :     "o5" $ [value v, list tyc ts]
455 :     | lexp (F.SWITCH (v, crl, cel, eo)) () =
456 :     "p5" $ [value v, consig crl, list con cel, option lexp eo]
457 :     | lexp (F.CON (dc, ts, u, v, e)) () =
458 :     "q5" $ [dcon(dc, ts), value u, lvar v, lexp e]
459 :     | lexp (F.RECORD(rk, vl, v, e)) () =
460 :     "r5" $ [rkind rk, list value vl, lvar v, lexp e]
461 :     | lexp (F.SELECT (u, i, v, e)) () =
462 :     "s5" $ [value u, int i, lvar v, lexp e]
463 :     | lexp (F.RAISE (u, ts)) () = "t5" $ [value u, list lty ts]
464 :     | lexp (F.HANDLE (e, u)) () = "u5" $ [lexp e, value u]
465 :     | lexp (F.BRANCH (p, vs, e1, e2)) () =
466 :     "v5" $ [fprim p, list value vs, lexp e1, lexp e2]
467 :     | lexp (F.PRIMOP (p, vs, v, e)) () =
468 :     "w5" $ [fprim p, list value vs, lvar v, lexp e]
469 :    
470 :     and fundec (fk, v, vts, e) () =
471 :     "05" $ [fkind fk, lvar v, list (tuple2(lvar, lty)) vts, lexp e]
472 :    
473 :     and tfundec (v, tvks, e) () =
474 :     "15" $ [lvar v, list (tuple2(tvar, tkind)) tvks, lexp e]
475 :    
476 :     and fkind (F.FK_FCT) () = "25" $ []
477 :     | fkind (F.FK_FUN {isrec, fixed=(b1, b2), known, inline}) () =
478 :     "35" $ [option (list lty) isrec, bool b1, bool b2, bool known,
479 :     bool inline]
480 :    
481 :     and rkind (F.RK_VECTOR tc) () = "45" $ [tyc tc]
482 :     | rkind (F.RK_STRUCT) () = "55" $ []
483 :     | rkind (F.RK_TUPLE _) () = "65" $ []
484 :    
485 :     val prog = fundec
486 :     val pickle = W.pickle (option prog fdecOp)
487 :     val hash = pickle2hash pickle
488 :     in {pickle = pickle, hash = hash}
489 :     end
490 :    
491 :    
492 :     (**************************************************************************
493 :     * PICKLING AN ENVIRONMENT *
494 :     **************************************************************************)
495 :    
496 :     fun pickleEnv(context0, e0: B.binding Env.env) =
497 :     let val alphaConvert = alphaConverter ()
498 :     val stamp = mkStamp alphaConvert
499 :     val entVar = stamp
500 :     val entPath = list entVar
501 :    
502 :     fun modId (MI.STRid{rlzn=a,sign=b}) () = "Bf" $ [stamp a, stamp b]
503 :     | modId (MI.SIGid s) () = "Cf" $ [stamp s]
504 :     | modId (MI.FCTid{rlzn=a,sign=b}) () = "Ef" $ [stamp a, modId b]
505 :     | modId (MI.FSIGid{paramsig=a,bodysig=b}) () = "Ff" $ [stamp a, stamp b]
506 :     | modId (MI.TYCid a) () = "Gf" $ [stamp a]
507 :     | modId (MI.EENVid s) () = "Vf" $ [stamp s]
508 :    
509 :     val lvcount = ref 0
510 :     val lvlist = ref ([]: Access.lvar list)
511 :    
512 :     fun anotherLvar v =
513 :     let val j = !lvcount
514 :     in lvlist := v :: !lvlist;
515 :     lvcount := j+1;
516 :     j
517 :     end
518 :    
519 :     val {access,conrep} = mkAccess (int o anotherLvar)
520 :     val {lty,tkind,...} = mkPickleLty(stamp, int o alphaConvert)
521 :    
522 :     (* SP.path and IP.path are both treated as symbol lists *)
523 :     fun spath (SP.SPATH p) = list symbol p
524 :     fun ipath (IP.IPATH p) = list symbol p
525 :    
526 :     val label = symbol
527 :    
528 :     fun eqprop T.YES () = "Yq" $ []
529 :     | eqprop T.NO () = "Nq" $ []
530 :     | eqprop T.IND () = "Iq" $ []
531 :     | eqprop T.OBJ () = "Oq" $ []
532 :     | eqprop T.DATA() = "Dq" $ []
533 :     | eqprop T.ABS () = "Aq" $ []
534 :     | eqprop T.UNDEF()= "Uq" $ []
535 :    
536 :     fun datacon (T.DATACON{name=n,const=c,typ=t,rep=r,sign=s}) () =
537 :     "Dr" $ [symbol n, bool c, ty t, conrep r, consig s]
538 :    
539 :     and tyckind (T.PRIMITIVE pt) () = "Ps" $ [int (PT.pt_toint pt)]
540 :     | tyckind (T.DATATYPE{index=i, family, stamps=ss, root, freetycs}) () =
541 :     "Ds" $ [W.int i, option entVar root,
542 :     dtypeInfo (ss, family, freetycs)]
543 :    
544 :     | tyckind (T.ABSTRACT tyc) () = "As" $ [tycon tyc]
545 :     | tyckind (T.FLEXTYC tps) () =
546 :     (*** tycpath should never be pickled; the only way it can be
547 :     pickled is when pickling the domains of a mutually
548 :     recursive datatypes; right now the mutually recursive
549 :     datatypes are not assigned accurate domains ... (ZHONG)
550 :     the following code is just a temporary gross hack.
551 :     ***)
552 :     "Fs" $ [] (* "Ss" $ [tycpath tps] *)
553 :     | tyckind (T.FORMAL) () = "Fs" $ []
554 :     | tyckind (T.TEMP) () = "Ts" $ []
555 :    
556 :     and dtypeInfo (ss, family, freetycs) () =
557 :     W.identify (DTkey (Vector.sub(ss,0)))
558 :     (fn () => "Zs" $ [list stamp (Vector.foldr (op ::) nil ss),
559 :     dtFamily family, list tycon freetycs])
560 :    
561 :     and dtFamily {mkey=s, members=v, lambdatyc} () =
562 :     W.identify (MBkey s)
563 :     (fn () => "Us" $ [stamp s,
564 :     (list dtmember (Vector.foldr (op ::) nil v))])
565 :    
566 :     and tycpath _ () = bug "unexpected tycpath during the pickling"
567 :    
568 :     and dtmember {tycname=n,dcons=d,arity=i,eq=ref e,sign=sn} () =
569 :     "Tt" $ [symbol n, list nameRepDomain d, int i, eqprop e,
570 :     consig sn]
571 :    
572 :     and nameRepDomain {name=n,rep=r,domain=t} () =
573 :     "Nu" $ [symbol n, conrep r, option ty t]
574 :    
575 :     and tycon (T.GENtyc{stamp=s, arity=a, eq=ref e, kind=k, path=p}) () =
576 :     let val id = MI.TYCid s
577 :     in W.identify(MIkey id)
578 :     (fn()=> case SCStaticEnv.lookTYC context0 id
579 :     of SOME _ => "Xv" $ [modId id]
580 :     | NONE => "Gv" $ [stamp s, int a, eqprop e,
581 :     tyckind k, ipath p])
582 :     end
583 :    
584 :     | tycon (T.DEFtyc{stamp=x, tyfun=T.TYFUN{arity=r,body=b},
585 :     strict=s, path=p}) () =
586 :     W.identify(MIkey(MI.TYCid x))
587 :     (fn()=> "Dw" $ [stamp x, int r, ty b, list bool s, ipath p])
588 :    
589 :     | tycon (T.PATHtyc{arity=a, entPath=e, path=p}) () =
590 :     "Pw" $ [int a, ipath p, entPath e]
591 :     (*
592 :     W.identify(EPkey e)
593 :     (fn()=>"Pw" $ [int a, entPath e, ipath p])
594 :     *)
595 :    
596 :     | tycon (T.RECORDtyc l) () = "Rw" $ [list label l]
597 :     | tycon (T.RECtyc i) () = "Cw" $ [int i]
598 :     | tycon (T.FREEtyc i) () = "Hw" $ [int i]
599 :     | tycon T.ERRORtyc () = "Ew" $ []
600 :    
601 :     and ty (T.VARty(ref(T.INSTANTIATED t))) () = ty t ()
602 :     | ty (T.VARty(ref(T.OPEN _))) () = (* "Vx" $ [tyvar v] *)
603 :     bug "uninstatiated VARty in pickmod"
604 :     | ty (T.CONty (c,[])) () = "Nx" $ [tycon c]
605 :     | ty (T.CONty (c,l)) () = "Cx" $ [tycon c, list ty l]
606 :     | ty (T.IBOUND i) () = "Ix" $ [int i]
607 :     | ty T.WILDCARDty () = "Wx" $ []
608 :     | ty (T.POLYty{sign=s,tyfun=T.TYFUN{arity=r,body=b}}) () =
609 :     "Px" $ [list bool s, int r, ty b]
610 :     | ty T.UNDEFty () = "Ux" $ []
611 :     | ty _ () = bug "unexpected types in pickmod-ty"
612 :    
613 :     fun inl_info (II.INL_PRIM(p, t)) () = "Py" $ [primop p, option ty t]
614 :     | inl_info (II.INL_STR sl) () = "Sy" $ [list inl_info sl]
615 :     | inl_info (II.INL_NO) () = "Ny" $ []
616 :     | inl_info _ () = bug "unexpected inl_info in pickmod"
617 :    
618 :     fun var (V.VALvar{access=a, info=z, path=p, typ=ref t}) () =
619 :     "Vz" $ [access a, inl_info z, spath p, ty t]
620 :     | var (V.OVLDvar{name=n, options=ref p,
621 :     scheme=T.TYFUN{arity=r,body=b}}) () =
622 :     "Oz" $ [symbol n, list overld p, int r, ty b]
623 :     | var V.ERRORvar () = "Ez" $ []
624 :    
625 :     and overld {indicator=i,variant=v} () = "OA" $ [ty i, var v]
626 :    
627 :     fun fsigId(M.FSIG{kind,
628 :     paramsig=p as M.SIG{stamp=ps,...},
629 :     paramvar=q,
630 :     paramsym=s,
631 :     bodysig=b as M.SIG{stamp=bs,...}}) =
632 :     MI.FSIGid{paramsig=ps,bodysig=bs}
633 :     | fsigId _ = bug "unexpected functor signatures in fsigId"
634 :    
635 :    
636 :     fun strDef(M.CONSTstrDef s) () = "CE" $ [Structure s]
637 :     | strDef(M.VARstrDef(s,p)) () = "VE" $ [Signature s,entPath p]
638 :    
639 :     (*
640 :     * boundeps is not pickled right now, but it really should
641 :     * be pickled in the future.
642 :     *)
643 :     and Signature (M.SIG{name=k, closed=c, fctflag=f,
644 :     stamp=m, symbols=l, elements=e,
645 :     boundeps=ref b, lambdaty=_, typsharing=t,
646 :     strsharing=s}) () =
647 :     let val id = MI.SIGid m
648 :     in W.identify (MIkey id)
649 :     (fn () =>
650 :     case (SCStaticEnv.lookSIG context0 id)
651 :     of SOME _ => "XE" $ [modId id]
652 :     | NONE => "SE" $ [option symbol k, bool c, bool f,
653 :     stamp m, list symbol l,
654 :     list (tuple2 (symbol,spec)) e,
655 :    
656 :     (* this is currently turned off ...
657 :     * option (list (tuple2 (entPath, tkind))) b,
658 :     *)
659 :     option (list (tuple2 (entPath, tkind))) NONE,
660 :     list (list spath) t,
661 :     list (list spath) s])
662 :     end
663 :    
664 :     | Signature M.ERRORsig () = "EE" $ []
665 :    
666 :     and fctSig (fs as M.FSIG{kind=k, paramsig=p, paramvar=q,
667 :     paramsym=s, bodysig=b}) () =
668 :     let val id = fsigId fs
669 :     in W.identify (MIkey id)
670 :     (fn () =>
671 :     case SCStaticEnv.lookFSIG context0 id
672 :     of SOME _ => "XF" $ [modId id]
673 :     | NONE => "FF" $ [option symbol k, Signature p,
674 :     entVar q, option symbol s,
675 :     Signature b])
676 :     end
677 :     | fctSig M.ERRORfsig () = "EF" $ []
678 :    
679 :     and spec (M.TYCspec{spec=t, entVar=v, scope=s}) () =
680 :     "TG" $ [tycon t,entVar v,int s]
681 :     | spec (M.STRspec{sign=s, slot=d, def=e, entVar=v}) () =
682 :     "SG" $ [Signature s, int d, option (tuple2 (strDef, int)) e, entVar v]
683 :     | spec (M.FCTspec{sign=s, slot=d, entVar=v}) () =
684 :     "FG" $ [fctSig s, int d, entVar v]
685 :     | spec (M.VALspec{spec=t, slot=d}) () = "PH" $ [ty t, int d]
686 :     | spec (M.CONspec{spec=c, slot=i}) () = "QH" $ [datacon c, option int i]
687 :    
688 :     and entity (M.TYCent t) () = "LI" $ [tycEntity t]
689 :     | entity (M.STRent t) () = "SI" $ [strEntity t]
690 :     | entity (M.FCTent t) () = "FI" $ [fctEntity t]
691 :     | entity M.ERRORent () = "EI" $ []
692 :    
693 :     and fctClosure (M.CLOSURE{param=p,body=s,env=e}) () =
694 :     "FJ" $ [entVar p, strExp s, entityEnv e]
695 :    
696 :     and Structure (m as M.STR{sign=s as M.SIG{stamp=g,...},
697 :     rlzn=r as {stamp=st,...},
698 :     access=a, info=z}) () =
699 :     let val id = MI.STRid{rlzn=st,sign=g}
700 :     in W.identify (MIkey id)
701 :     (fn () =>
702 :     case SCStaticEnv.lookSTR context0 id
703 :     of NONE =>
704 :     ((* if isGlobalStamp st andalso isGlobalStamp g
705 :     then say (String.concat["#pickmod: missed global structure ",
706 :     MI.idToString id, "\n"])
707 :     else (); *)
708 :     "SK" $ [Signature s, strEntity r,
709 :     access a, inl_info z])
710 :     | SOME _ => "XK" $ [modId id, access a])
711 :     end
712 :     | Structure (M.STRSIG{sign=s,entPath=p}) () =
713 :     "GK" $ [Signature s, entPath p]
714 :     | Structure M.ERRORstr () = "EK" $ []
715 :     | Structure _ () = bug "unexpected structure in Structure"
716 :    
717 :     and Functor (M.FCT{sign=s, rlzn=r as {stamp=m,...},
718 :     access=a, info=z}) () =
719 :     let val sigid = fsigId s
720 :     val id = MI.FCTid{rlzn=m, sign=sigid}
721 :     in W.identify (MIkey id)
722 :     (fn () =>
723 :     case SCStaticEnv.lookFCT context0 id
724 :     of NONE =>
725 :     ((* if isGlobalStamp m andalso
726 :     (case sigid
727 :     of MI.FSIGid{paramsig,bodysig} =>
728 :     isGlobalStamp paramsig andalso
729 :     isGlobalStamp bodysig
730 :     | _ => (say "#pickmod: funny functor sig id\n";
731 :     false))
732 :     then say (String.concat["#pickmod: missed global functor ",
733 :     MI.idToString id, "\n"])
734 :     else (); *)
735 :     "FL" $ [fctSig s, fctEntity r,
736 :     access a, inl_info z])
737 :     | SOME _ => "XL" $ [modId id, access a])
738 :     end
739 :     | Functor M.ERRORfct () = "EL" $ []
740 :    
741 :     and stampExp (M.CONST s) () = "CM" $ [stamp s]
742 :     | stampExp (M.GETSTAMP s) () = "GM" $ [strExp s]
743 :     | stampExp M.NEW () = "NM" $ []
744 :    
745 :     and tycExp (M.CONSTtyc t) () = "CN" $ [tycon t]
746 :     | tycExp (M.FORMtyc t) () = "DN" $ [tycon t]
747 :     | tycExp (M.VARtyc s) () = "VN" $ [entPath s]
748 :    
749 :     and strExp (M.VARstr s) () = "VO" $ [entPath s]
750 :     | strExp (M.CONSTstr s) () = "CO" $ [strEntity s]
751 :     | strExp (M.STRUCTURE{stamp=s,entDec=e}) () =
752 :     "SO" $ [stampExp s, entityDec e]
753 :     | strExp (M.APPLY(f,s)) () = "AO" $ [fctExp f, strExp s]
754 :     | strExp (M.LETstr(e,s)) () = "LO" $ [entityDec e, strExp s]
755 :     | strExp (M.ABSstr(s,e)) () = "BO" $ [Signature s, strExp e]
756 :     | strExp (M.CONSTRAINstr{boundvar,raw,coercion}) () =
757 :     "RO" $ [entVar boundvar, strExp raw, strExp coercion]
758 :     | strExp (M.FORMstr fs) () = "FO" $ [fctSig fs]
759 :    
760 :     and fctExp (M.VARfct s) () = "VP" $ [entPath s]
761 :     | fctExp (M.CONSTfct e) () = "CP" $ [fctEntity e]
762 :     | fctExp (M.LAMBDA{param=p,body=b}) () = "LP" $ [entVar p, strExp b]
763 :     | fctExp (M.LAMBDA_TP{param=p, body=b, sign=fs}) () =
764 :     "PP" $ [entVar p, strExp b, fctSig fs]
765 :     | fctExp (M.LETfct(e,f)) () = "TP" $ [entityDec e, fctExp f]
766 :    
767 :     and entityExp (M.TYCexp t) () = "TQ" $ [tycExp t]
768 :     | entityExp (M.STRexp t) () = "SQ" $ [strExp t]
769 :     | entityExp (M.FCTexp t) () = "FQ" $ [fctExp t]
770 :     | entityExp (M.ERRORexp) () = "EQ" $ []
771 :     | entityExp (M.DUMMYexp) () = "DQ" $ []
772 :    
773 :     and entityDec (M.TYCdec(s,x)) () = "TR" $ [entVar s, tycExp x]
774 :     | entityDec (M.STRdec(s,x,n)) () = "SR" $ [entVar s, strExp x, symbol n]
775 :     | entityDec (M.FCTdec(s,x)) () = "FR" $ [entVar s, fctExp x]
776 :     | entityDec (M.SEQdec e) () = "QR" $ [list entityDec e]
777 :     | entityDec (M.LOCALdec(a,b)) () = "LR" $ [entityDec a, entityDec b]
778 :     | entityDec M.ERRORdec () = "ER" $ []
779 :     | entityDec M.EMPTYdec () = "MR" $ []
780 :    
781 :     and entityEnv (M.MARKeenv(s,r)) () =
782 :     let val id = MI.EENVid s
783 :     in W.identify(MIkey id)
784 :     (fn() => case SCStaticEnv.lookEENV context0 id
785 :     of SOME _ => "X4" $ [modId id]
786 :     | NONE => "M4" $ [stamp s, entityEnv r])
787 :     end
788 :     | entityEnv (M.BINDeenv(d, r)) () =
789 :     "B4" $ [list (tuple2(entVar, entity)) (ED.members d), entityEnv r]
790 :     | entityEnv M.NILeenv () = "N4" $ []
791 :     | entityEnv M.ERReenv () = "E4" $ []
792 :    
793 :     and strEntity {stamp=s, entities=e, lambdaty=_, rpath=r} () =
794 :     "SS" $ [stamp s, entityEnv e, ipath r]
795 :    
796 :     and fctEntity {stamp=s, closure=c, lambdaty=_,
797 :     tycpath=_, rpath=r} () =
798 :     "FT" $ [stamp s, fctClosure c, ipath r]
799 :     (* | fctEntity {stamp=s, closure=c, lambdaty=ref t,
800 :     tycpath=SOME _, rpath=r} () =
801 :     bug "unexpected fctEntity in pickmod"
802 :     *)
803 :    
804 :     and tycEntity x () = tycon x ()
805 :    
806 :     fun fixity Fixity.NONfix () = "NW" $ []
807 :     | fixity (Fixity.INfix(i,j)) () = "IW" $ [int i, int j]
808 :    
809 :     fun binding (B.VALbind x) () = "V2" $ [var x]
810 :     | binding (B.CONbind x) () = "C2" $ [datacon x]
811 :     | binding (B.TYCbind x) () = "T2" $ [tycon x]
812 :     | binding (B.SIGbind x) () = "G2" $ [Signature x]
813 :     | binding (B.STRbind x) () = "S2" $ [Structure x]
814 :     | binding (B.FSGbind x) () = "I2" $ [fctSig x]
815 :     | binding (B.FCTbind x) () = "F2" $ [Functor x]
816 :     | binding (B.FIXbind x) () = "X2" $ [fixity x]
817 :    
818 :     fun env alpha e () =
819 :     let fun uniq (a::b::rest) = if S.eq(a,b) then uniq(b::rest)
820 :     else a::uniq(b::rest)
821 :     | uniq l = l
822 :     val syms = uniq(Sort.sort S.symbolGt (Env.symbols e))
823 :     val pairs = map (fn s => (s, Env.look(e,s))) syms
824 :     in "E3" $ [list (tuple2(symbol,alpha)) pairs]
825 :     end
826 :    
827 :     val pickle = W.pickle (env binding e0)
828 :    
829 :     val hash = pickle2hash pickle
830 :    
831 :     val exportLvars = rev(!lvlist)
832 :     val exportPid = case exportLvars of [] => NONE
833 :     | _ => SOME hash
834 :    
835 :     in addPickles (Word8Vector.length pickle);
836 :     {hash = hash,
837 :     pickle = pickle,
838 :     exportLvars = exportLvars,
839 :     exportPid = exportPid}
840 :     end (* fun pickleEnv *)
841 :    
842 :     fun dontPickle (senv : StaticEnv.staticEnv, count) =
843 :     let val hash =
844 :     let val toByte = Word8.fromLargeWord o Word32.toLargeWord
845 :     val >> = Word32.>>
846 :     infix >>
847 :     val w = Word32.fromInt count
848 :     in
849 :     PersStamps.fromBytes(
850 :     Word8Vector.fromList
851 :     [0w0,0w0,0w0,toByte(w >> 0w24),0w0,0w0,0w0,toByte(w >> 0w16),
852 :     0w0,0w0,0w0,toByte(w >> 0w8),0w0,0w0,0w0,toByte(w)])
853 :     end
854 :     fun uniq (a::b::rest) = if S.eq(a,b) then uniq(b::rest)
855 :     else a::uniq(b::rest)
856 :     | uniq l = l
857 :     (* next two lines are alternative to using Env.consolidate *)
858 :     val syms = uniq(Sort.sort S.symbolGt (Env.symbols senv))
859 :     fun newAccess i = A.PATH (A.EXTERN hash, i)
860 :     fun mapbinding(sym,(i,env,lvars)) =
861 :     case Env.look(senv,sym)
862 :     of B.VALbind(V.VALvar{access=a, info=z, path=p, typ=ref t}) =>
863 :     (case a
864 :     of A.LVAR k =>
865 :     (i+1,
866 :     Env.bind(sym,B.VALbind(V.VALvar{access=newAccess i,
867 :     info=z, path=p,
868 :     typ=ref t}),
869 :     env),
870 :     k :: lvars)
871 :     | _ => (say(A.prAcc a ^ "\n"); bug "dontPickle 1"))
872 :     | B.STRbind(M.STR{sign=s, rlzn=r, access=a, info=z}) =>
873 :     (case a
874 :     of A.LVAR k =>
875 :     (i+1,
876 :     Env.bind(sym,B.STRbind(M.STR{access=newAccess i,
877 :     sign=s,rlzn=r,info=z}),
878 :     env),
879 :     k :: lvars)
880 :     | _ => (say(A.prAcc a ^ "\n"); bug "dontPickle 2"))
881 :     | B.FCTbind(M.FCT{sign=s, rlzn=r, access=a, info=z}) =>
882 :     (case a
883 :     of A.LVAR k =>
884 :     (i+1,
885 :     Env.bind(sym,B.FCTbind(M.FCT{access=newAccess i,
886 :     sign=s,rlzn=r,info=z}),
887 :     env),
888 :     k :: lvars)
889 :     | _ => (say(A.prAcc a ^ "\n"); bug "dontPickle 3"))
890 :     | B.CONbind(T.DATACON{name=n,const=c,typ=t,sign=s,
891 :     rep as (A.EXN a)}) =>
892 :     let val newrep = A.EXN (newAccess i)
893 :     in case a
894 :     of A.LVAR k =>
895 :     (i+1,
896 :     Env.bind(sym,B.CONbind
897 :     (T.DATACON{rep=newrep, name=n,
898 :     const=c, typ=t, sign=s}),
899 :     env),
900 :     k :: lvars)
901 :     | _ => (say(A.prAcc a ^ "\n"); bug "dontPickle 4")
902 :     end
903 :     | binding =>
904 :     (i, Env.bind(sym,binding,env), lvars)
905 :     val (_,newenv,lvars) = foldl mapbinding (0,StaticEnv.empty,nil) syms
906 :     val exportPid = case lvars
907 :     of [] => NONE
908 :     | _ => SOME hash
909 :     in (newenv,hash,rev(lvars),exportPid)
910 :     end
911 :    
912 :     end (* toplevel local *)
913 :     end (* structure PickMod *)
914 :    
915 :    

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