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

Annotation of /sml/trunk/src/compiler/Semant/pickle/unpickmod-new.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 537 - (view) (download)

1 : monnier 427 (*
2 :     * The new unpickler (based on the new generic unpickling facility).
3 :     *
4 :     * July 1999, Matthias Blume
5 :     *)
6 :     signature UNPICKMOD = sig
7 :    
8 : monnier 504 type env'n'ctxt = { env: StaticEnv.staticEnv, ctxt: ModuleId.Set.set }
9 :    
10 : monnier 427 val unpickleEnv :
11 :     { context: CMStaticEnv.staticEnv,
12 :     hash: PersStamps.persstamp,
13 :     pickle: Word8Vector.vector }
14 : monnier 504 -> env'n'ctxt
15 : monnier 427
16 :     val unpickleFLINT : Word8Vector.vector -> CompBasic.flint option
17 :    
18 :     (*
19 :     * The env unpickler resulting from "mkUnpicklers" cannot be used for
20 :     * "original" environments that come out of the elaborator. For those,
21 :     * continue to use "unpickleEnv". "mkUnpicklers" is intended to be
22 :     * used by CM's stable library mechanism.
23 :     *)
24 :     val mkUnpicklers :
25 :     UnpickleUtil.session ->
26 : blume 537 { prim_context: CMStaticEnv.staticEnv,
27 : monnier 427 node_context: int * Symbol.symbol -> CMStaticEnv.staticEnv option }
28 :     -> { symenv: SymbolicEnv.symenv UnpickleUtil.reader,
29 : monnier 504 env: env'n'ctxt UnpickleUtil.reader,
30 : monnier 427 symbol: Symbol.symbol UnpickleUtil.reader,
31 :     symbollist: Symbol.symbol list UnpickleUtil.reader }
32 :     end
33 :    
34 :     structure UnpickMod : UNPICKMOD = struct
35 :    
36 :     structure A = Access
37 :     structure DI = DebIndex
38 :     structure LT = LtyDef
39 :     structure LK = LtyKernel
40 :     structure PT = PrimTyc
41 :     structure F = FLINT
42 :     structure T = Types
43 :     structure SP = SymPath
44 :     structure IP = InvPath
45 :     structure MI = ModuleId
46 :     structure II = InlInfo
47 :     structure V = VarCon
48 :     structure ED = EntPath.EvDict
49 :     structure PS = PersStamps
50 :     structure P = PrimOp
51 :     structure M = Modules
52 :     structure B = Bindings
53 :    
54 :     structure UU = UnpickleUtil
55 :     exception Format = UU.Format
56 :    
57 : monnier 504 type env'n'ctxt = { env: StaticEnv.staticEnv, ctxt: ModuleId.Set.set }
58 :    
59 : monnier 427 (* The order of the entries in the following tables
60 :     * must be coordinated with pickmod! *)
61 :     val primop_table =
62 :     #[P.MKETAG,
63 :     P.WRAP,
64 :     P.UNWRAP,
65 :     P.SUBSCRIPT,
66 :     P.SUBSCRIPTV,
67 :     P.INLSUBSCRIPT,
68 :     P.INLSUBSCRIPTV,
69 :     P.INLMKARRAY,
70 :    
71 :     P.PTREQL,
72 :     P.PTRNEQ,
73 :     P.POLYEQL,
74 :     P.POLYNEQ,
75 :     P.BOXED,
76 :     P.UNBOXED,
77 :     P.LENGTH,
78 :     P.OBJLENGTH,
79 :     P.CAST,
80 :     P.GETRUNVEC,
81 :     P.MARKEXN,
82 :     P.GETHDLR,
83 :     P.SETHDLR,
84 :     P.GETVAR,
85 :     P.SETVAR,
86 :     P.GETPSEUDO,
87 :     P.SETPSEUDO,
88 :     P.SETMARK,
89 :     P.DISPOSE,
90 :     P.MAKEREF,
91 :     P.CALLCC,
92 :     P.CAPTURE,
93 :     P.THROW,
94 :     P.DEREF,
95 :     P.ASSIGN,
96 :     P.UPDATE,
97 :     P.INLUPDATE,
98 :     P.BOXEDUPDATE,
99 :     P.UNBOXEDUPDATE,
100 :    
101 :     P.GETTAG,
102 :     P.MKSPECIAL,
103 :     P.SETSPECIAL,
104 :     P.GETSPECIAL,
105 :     P.USELVAR,
106 :     P.DEFLVAR,
107 :     P.INLDIV,
108 :     P.INLMOD,
109 :     P.INLREM,
110 :     P.INLMIN,
111 :     P.INLMAX,
112 :     P.INLABS,
113 :     P.INLNOT,
114 :     P.INLCOMPOSE,
115 :     P.INLBEFORE,
116 :     P.INL_ARRAY,
117 :     P.INL_VECTOR,
118 :     P.ISOLATE,
119 :     P.WCAST,
120 :     P.NEW_ARRAY0,
121 :     P.GET_SEQ_DATA,
122 :     P.SUBSCRIPT_REC,
123 :     P.SUBSCRIPT_RAW64,
124 :     P.UNBOXEDASSIGN]
125 :    
126 :     val cmpop_table =
127 :     #[P.>, P.>=, P.<, P.<=, P.LEU, P.LTU, P.GEU, P.GTU, P.EQL, P.NEQ]
128 :    
129 :     val arithop_table =
130 :     #[P.+, P.-, P.*, P./, P.~, P.ABS, P.LSHIFT, P.RSHIFT, P.RSHIFTL,
131 :     P.ANDB, P.ORB, P.XORB, P.NOTB]
132 :    
133 :     val eqprop_table =
134 :     #[T.YES, T.NO, T.IND, T.OBJ, T.DATA, T.ABS, T.UNDEF]
135 :    
136 :     fun mkSharedStuff (session, lvar) = let
137 :    
138 :     fun share m f = UU.share session m f
139 :     fun nonshare f = UU.nonshare session f
140 :    
141 :     val int = UU.r_int session
142 :     val bool = UU.r_bool session
143 :     fun list m r = UU.r_list session m r
144 :     val string = UU.r_string session
145 :     val symbol = UnpickleSymPid.r_symbol (session, string)
146 :    
147 :     (* These maps will all acquire different types by being used in
148 :     * different contexts... *)
149 :     val accM = UU.mkMap ()
150 :     val crM = UU.mkMap ()
151 :     val csM = UU.mkMap ()
152 :     val nkM = UU.mkMap ()
153 :     val poM = UU.mkMap ()
154 :     val boolListM = UU.mkMap ()
155 : blume 515 val tkindM = UU.mkMap ()
156 :     val tkindListM = UU.mkMap ()
157 : monnier 427
158 :     val boollist = list boolListM bool
159 :    
160 : blume 515 val pid = UnpickleSymPid.r_pid (session, string)
161 : monnier 427
162 :     fun access () = let
163 :     fun a #"A" = lvar (int ())
164 :     | a #"B" = A.EXTERN (pid ())
165 :     | a #"C" = A.PATH (access (), int ())
166 :     | a #"D" = A.NO_ACCESS
167 :     | a _ = raise Format
168 :     in
169 :     share accM a
170 :     end
171 :    
172 :     fun conrep () = let
173 :     fun cr #"A" = A.UNTAGGED
174 :     | cr #"B" = A.TAGGED (int ())
175 :     | cr #"C" = A.TRANSPARENT
176 :     | cr #"D" = A.CONSTANT (int ())
177 :     | cr #"E" = A.REF
178 :     | cr #"F" = A.EXN (access ())
179 :     | cr #"G" = A.LISTCONS
180 :     | cr #"H" = A.LISTNIL
181 :     | cr #"I" = A.SUSP NONE
182 :     | cr #"J" = A.SUSP (SOME (access (), access ()))
183 :     | cr _ = raise Format
184 :     in
185 :     share crM cr
186 :     end
187 :    
188 :     fun consig () = let
189 :     fun cs #"S" = A.CSIG (int (), int ())
190 :     | cs #"N" = A.CNIL
191 :     | cs _ = raise Format
192 :     in
193 :     share csM cs
194 :     end
195 :    
196 : blume 515 fun tkind () = let
197 : monnier 427 fun tk #"A" = LT.tkc_mono
198 :     | tk #"B" = LT.tkc_box
199 :     | tk #"C" = LT.tkc_seq (tkindlist ())
200 :     | tk #"D" = LT.tkc_fun (tkindlist (), tkind ())
201 :     | tk _ = raise Format
202 :     in
203 :     share tkindM tk
204 :     end
205 :    
206 :     and tkindlist () = list tkindListM tkind ()
207 :    
208 :     fun numkind () = let
209 :     fun nk #"A" = P.INT (int ())
210 :     | nk #"B" = P.UINT (int ())
211 :     | nk #"C" = P.FLOAT (int ())
212 :     | nk _ = raise Format
213 :     in
214 :     share nkM nk
215 :     end
216 :    
217 :     fun arithop () = let
218 :     fun ao c =
219 :     Vector.sub (arithop_table, Char.ord c)
220 :     handle General.Subscript => raise Format
221 :     in
222 :     nonshare ao
223 :     end
224 :    
225 :     fun cmpop () = let
226 :     fun co c =
227 :     Vector.sub (cmpop_table, Char.ord c)
228 :     handle General.Subscript => raise Format
229 :     in
230 :     nonshare co
231 :     end
232 :    
233 :     fun primop () = let
234 :     fun po #"\100" = P.ARITH { oper = arithop (), overflow = bool (),
235 :     kind = numkind () }
236 :     | po #"\101" = P.CMP { oper = cmpop (), kind = numkind () }
237 :     | po #"\102" = P.TEST (int (), int ())
238 :     | po #"\103" = P.TESTU (int (), int ())
239 :     | po #"\104" = P.TRUNC (int (), int ())
240 :     | po #"\105" = P.EXTEND (int (), int ())
241 :     | po #"\106" = P.COPY (int (), int ())
242 :     | po #"\107" = P.INLLSHIFT (numkind ())
243 :     | po #"\108" = P.INLRSHIFT (numkind ())
244 :     | po #"\109" = P.INLRSHIFTL (numkind ())
245 :     | po #"\110" = P.ROUND { floor = bool (), fromkind = numkind (),
246 :     tokind = numkind () }
247 :     | po #"\111" = P.REAL { fromkind = numkind (),
248 :     tokind = numkind ()}
249 :     | po #"\112" = P.NUMSUBSCRIPT { kind = numkind (),
250 :     checked = bool (),
251 :     immutable = bool () }
252 :     | po #"\113" = P.NUMUPDATE { kind = numkind (),
253 :     checked = bool () }
254 :     | po #"\114" = P.INL_MONOARRAY (numkind ())
255 :     | po #"\115" = P.INL_MONOVECTOR (numkind ())
256 :     | po c =
257 :     Vector.sub (primop_table, Char.ord c)
258 :     handle General.Subscript => raise Format
259 :     in
260 :     share poM po
261 :     end
262 :     in
263 :     { pid = pid, string = string, symbol = symbol,
264 :     access = access, conrep = conrep, consig = consig,
265 : blume 515 primop = primop, boollist = boollist,
266 :     tkind = tkind, tkindlist = tkindlist }
267 : monnier 427 end
268 :    
269 :     fun mkEnvUnpickler arg = let
270 :     val (session, symbollist, sharedStuff, context0, globalPid) = arg
271 :    
272 :     val { lookTYC, lookSIG, lookFSIG, lookSTR, lookFCT, lookEENV,
273 :     lookTYCp, lookSIGp, lookFSIGp, lookSTRp, lookFCTp, lookEENVp,
274 :     lookTYCn, lookSIGn, lookFSIGn, lookSTRn, lookFCTn, lookEENVn } =
275 :     context0
276 :    
277 :     fun list m r = UU.r_list session m r
278 :     fun option m r = UU.r_option session m r
279 :     val bool = UU.r_bool session
280 : blume 515 fun pair m fp p = UU.r_pair session m fp p
281 : monnier 427 val int = UU.r_int session
282 :    
283 :     fun share m f = UU.share session m f
284 :     fun nonshare f = UU.nonshare session f
285 :    
286 :     (* The following maps all acquire different types by being used
287 :     * in different contexts: *)
288 :     val stampM = UU.mkMap ()
289 :     val stampOptionM = UU.mkMap ()
290 :     val stampListM = UU.mkMap ()
291 :     val modIdM = UU.mkMap ()
292 :     val symbolOptionM = UU.mkMap ()
293 :     val symbolListM = UU.mkMap ()
294 :     val spathListM = UU.mkMap ()
295 :     val spathListListM = UU.mkMap ()
296 :     val dataconM = UU.mkMap ()
297 :     val tkM = UU.mkMap ()
298 :     val dtiM = UU.mkMap ()
299 :     val dtfM = UU.mkMap ()
300 :     val dtmemberM = UU.mkMap ()
301 :     val dtmListM = UU.mkMap ()
302 :     val nrdM = UU.mkMap ()
303 :     val nrdListM = UU.mkMap ()
304 :     val tyconM = UU.mkMap ()
305 :     val tyconListM = UU.mkMap ()
306 :     val tyM = UU.mkMap ()
307 :     val tyOptionM = UU.mkMap ()
308 :     val tyListM = UU.mkMap ()
309 :     val iiM = UU.mkMap ()
310 :     val vM = UU.mkMap ()
311 :     val sdM = UU.mkMap ()
312 :     val sigM = UU.mkMap ()
313 :     val fsigM = UU.mkMap ()
314 :     val spM = UU.mkMap ()
315 :     val enM = UU.mkMap ()
316 :     val fctcM = UU.mkMap ()
317 :     val strM = UU.mkMap ()
318 :     val fctM = UU.mkMap ()
319 :     val steM = UU.mkMap ()
320 :     val tceM = UU.mkMap ()
321 :     val streM = UU.mkMap ()
322 :     val feM = UU.mkMap ()
323 :     val eeM = UU.mkMap ()
324 :     val edM = UU.mkMap ()
325 :     val eenvM = UU.mkMap ()
326 :     val senM = UU.mkMap ()
327 :     val fenM = UU.mkMap ()
328 :     val fxM = UU.mkMap ()
329 :     val bM = UU.mkMap ()
330 :     val elementsM = UU.mkMap ()
331 :     val bepsLM = UU.mkMap ()
332 :     val bepsOM = UU.mkMap ()
333 :     val spDefM = UU.mkMap ()
334 :     val iiListM = UU.mkMap ()
335 :     val overldM = UU.mkMap ()
336 :     val olListM = UU.mkMap ()
337 :     val ioM = UU.mkMap ()
338 :     val edListM = UU.mkMap ()
339 :     val eenvBindM = UU.mkMap ()
340 :     val envM = UU.mkMap ()
341 : monnier 504 val milM = UU.mkMap ()
342 : blume 515 val spathM = UU.mkMap ()
343 :     val ipathM = UU.mkMap ()
344 :     val symSpecPM = UU.mkMap ()
345 :     val epTkPM = UU.mkMap ()
346 :     val sdIntPM = UU.mkMap ()
347 :     val evEntPM = UU.mkMap ()
348 :     val symBindPM = UU.mkMap ()
349 :     val envMilPM = UU.mkMap ()
350 : monnier 427
351 : blume 515 val { pid, string, symbol, access, conrep, consig,
352 :     primop, boollist, tkind, tkindlist } = sharedStuff
353 : monnier 427
354 :     fun stamp () = let
355 :     fun st #"A" = Stamps.STAMP { scope = Stamps.GLOBAL (globalPid ()),
356 :     count = int () }
357 :     | st #"B" = Stamps.STAMP { scope = Stamps.GLOBAL (pid ()),
358 :     count = int () }
359 :     | st #"C" = Stamps.STAMP { scope = Stamps.SPECIAL (string ()),
360 :     count = int () }
361 :     | st _ = raise Format
362 :     in
363 :     share stampM st
364 :     end
365 :    
366 :     val stamplist = list stampListM stamp
367 :     val stampoption = option stampOptionM stamp
368 :    
369 :     val entVar = stamp
370 :     val entVarOption = stampoption
371 :     val entPath = stamplist
372 :    
373 :     fun modId () = let
374 :     fun mi #"1" = MI.STRid { rlzn = stamp (), sign = stamp () }
375 :     | mi #"2" = MI.SIGid (stamp ())
376 :     | mi #"3" = MI.FCTid { rlzn = stamp (), sign = modId () }
377 :     | mi #"4" = MI.FSIGid { paramsig = stamp (),
378 :     bodysig = stamp () }
379 :     | mi #"5" = MI.TYCid (stamp ())
380 :     | mi #"6" = MI.EENVid (stamp ())
381 :     | mi _ = raise Format
382 :     in
383 :     share modIdM mi
384 :     end
385 :    
386 :     val symbollist = list symbolListM symbol
387 :     val symboloption = option symbolOptionM symbol
388 :    
389 :    
390 : blume 515 fun spath () = let
391 :     fun sp #"s" = SP.SPATH (symbollist ())
392 :     | sp _ = raise Format
393 :     in
394 :     share spathM sp
395 :     end
396 :    
397 :     fun ipath () = let
398 :     fun ip #"i" = IP.IPATH (symbollist ())
399 :     | ip _ = raise Format
400 :     in
401 :     share ipathM ip
402 :     end
403 :    
404 : monnier 427 val spathlist = list spathListM spath
405 :     val spathlistlist = list spathListListM spathlist
406 :    
407 :     val label = symbol
408 :     val labellist = symbollist
409 :    
410 :     fun eqprop () = let
411 :     fun eqp c =
412 :     Vector.sub (eqprop_table, Char.ord c)
413 :     handle General.Subscript => raise Format
414 :     in
415 :     nonshare eqp
416 :     end
417 :    
418 :     fun datacon () = let
419 :     fun d #"c" =
420 :     T.DATACON { name = symbol (), const = bool (), typ = ty (),
421 :     rep = conrep (), sign = consig (),
422 :     lazyp = bool () }
423 :     | d _ = raise Format
424 :     in
425 :     share dataconM d
426 :     end
427 :    
428 :     and tyckind () = let
429 :     fun tk #"a" = T.PRIMITIVE (PT.pt_fromint (int ()))
430 :     | tk #"b" = let
431 :     val index = int ()
432 :     val root = entVarOption ()
433 :     val (stamps, family, freetycs) = dtypeInfo ()
434 :     in
435 :     T.DATATYPE { index = index, root = root,
436 :     stamps = stamps, family = family,
437 :     freetycs = freetycs }
438 :     end
439 :     | tk #"c" = T.ABSTRACT (tycon ())
440 :     | tk #"d" = T.FORMAL
441 :     | tk #"e" = T.TEMP
442 :     | tk _ = raise Format
443 :     in
444 :     share tkM tk
445 :     end
446 :    
447 :     and dtypeInfo () = let
448 :     fun dti #"a" =
449 :     (Vector.fromList (stamplist ()), dtFamily (), tyconlist ())
450 :     | dti _ = raise Format
451 :     in
452 :     share dtiM dti
453 :     end
454 :    
455 :     and dtFamily () = let
456 :     fun dtf #"b" =
457 :     { mkey = stamp (),
458 :     members = Vector.fromList (dtmemberlist ()),
459 :     lambdatyc = ref NONE }
460 :     | dtf _ = raise Format
461 :     in
462 :     share dtfM dtf
463 :     end
464 :    
465 :     and dtmember () = let
466 :     fun d #"c" = { tycname = symbol (), dcons = nrdlist (),
467 :     arity = int (), eq = ref (eqprop ()),
468 :     lazyp = bool (), sign = consig () }
469 :     | d _ = raise Format
470 :     in
471 :     share dtmemberM d
472 :     end
473 :    
474 :     and dtmemberlist () = list dtmListM dtmember ()
475 :    
476 :     and nameRepDomain () = let
477 :     fun n #"d" =
478 :     { name = symbol (), rep = conrep (), domain = tyoption () }
479 :     | n _ = raise Format
480 :     in
481 :     share nrdM n
482 :     end
483 :    
484 :     and nrdlist () = list nrdListM nameRepDomain ()
485 :    
486 :     and tycon () = let
487 :     fun tyc #"A" = lookTYC (modId ())
488 :     | tyc #"B" = T.GENtyc { stamp = stamp (), arity = int (),
489 :     eq = ref (eqprop ()), kind = tyckind (),
490 :     path = ipath () }
491 :     | tyc #"C" = T.DEFtyc { stamp = stamp (),
492 :     tyfun = T.TYFUN { arity = int (),
493 :     body = ty () },
494 :     strict = boollist (),
495 :     path = ipath () }
496 :     | tyc #"D" = T.PATHtyc { arity = int (), entPath = entPath (),
497 :     path = ipath () }
498 :     | tyc #"E" = T.RECORDtyc (labellist ())
499 :     | tyc #"F" = T.RECtyc (int ())
500 :     | tyc #"G" = T.FREEtyc (int ())
501 :     | tyc #"H" = T.ERRORtyc
502 : blume 537 | tyc #"I" = lookTYCp (modId ())
503 : monnier 427 | tyc #"J" = lookTYCn (int (), symbol(), modId ())
504 :     | tyc _ = raise Format
505 :     in
506 :     share tyconM tyc
507 :     end
508 :    
509 :     and tyconlist () = list tyconListM tycon ()
510 :    
511 :     and ty () = let
512 :     fun t #"a" = T.CONty (tycon (), tylist ())
513 :     | t #"b" = T.IBOUND (int ())
514 :     | t #"c" = T.WILDCARDty
515 :     | t #"d" = T.POLYty { sign = boollist (),
516 :     tyfun = T.TYFUN { arity = int (),
517 :     body = ty () } }
518 :     | t #"e" = T.UNDEFty
519 :     | t _ = raise Format
520 :     in
521 :     share tyM t
522 :     end
523 :    
524 :     and tyoption () = option tyOptionM ty ()
525 :     and tylist () = list tyListM ty ()
526 :    
527 :     and inl_info () = let
528 :     fun ii #"A" = II.INL_PRIM (primop (), tyoption ())
529 :     | ii #"B" = II.INL_STR (iilist ())
530 :     | ii #"C" = II.INL_NO
531 :     | ii _ = raise Format
532 :     in
533 :     share iiM ii
534 :     end
535 :    
536 :     and iilist () = list iiListM inl_info ()
537 :    
538 :     and var () = let
539 :     fun v #"1" = V.VALvar { access = access (), info = inl_info (),
540 :     path = spath (), typ = ref (ty ()) }
541 :     | v #"2" = V.OVLDvar { name = symbol (),
542 :     options = ref (overldlist ()),
543 :     scheme = T.TYFUN { arity = int (),
544 :     body = ty () } }
545 :     | v #"3" = V.ERRORvar
546 :     | v _ = raise Format
547 :     in
548 :     share vM v
549 :     end
550 :    
551 :     and overld () = let
552 :     fun ov #"o" = { indicator = ty (), variant = var () }
553 :     | ov _ = raise Format
554 :     in
555 :     share overldM ov
556 :     end
557 :    
558 :     and overldlist () = list olListM overld ()
559 :    
560 :     fun strDef () = let
561 :     fun sd #"C" = M.CONSTstrDef (Structure ())
562 :     | sd #"V" = M.VARstrDef (Signature (), entPath ())
563 :     | sd _ = raise Format
564 :     in
565 :     share sdM sd
566 :     end
567 :    
568 :     and Signature () = let
569 :     fun sg #"A" = M.ERRORsig
570 :     | sg #"B" = lookSIG (modId ())
571 :     | sg #"C" = M.SIG { name = symboloption (),
572 :     closed = bool (),
573 :     fctflag = bool (),
574 :     stamp = stamp (),
575 :     symbols = symbollist (),
576 :     elements = list elementsM
577 : blume 515 (pair symSpecPM (symbol, spec)) (),
578 : monnier 427 boundeps =
579 :     ref (option bepsOM
580 : blume 515 (list bepsLM
581 :     (pair epTkPM (entPath, tkind))) ()),
582 : monnier 427 lambdaty = ref NONE,
583 :     typsharing = spathlistlist (),
584 :     strsharing = spathlistlist () }
585 : blume 537 | sg #"D" = lookSIGp (modId ())
586 : monnier 427 | sg #"E" = lookSIGn (int (), symbol (), modId ())
587 :     | sg _ = raise Format
588 :     in
589 :     share sigM sg
590 :     end
591 :    
592 :     and fctSig () = let
593 :     fun fsg #"a" = M.ERRORfsig
594 :     | fsg #"b" = lookFSIG (modId ())
595 :     | fsg #"c" = M.FSIG { kind = symboloption (),
596 :     paramsig = Signature (),
597 :     paramvar = entVar (),
598 :     paramsym = symboloption (),
599 :     bodysig = Signature () }
600 : blume 537 | fsg #"d" = lookFSIGp (modId ())
601 : monnier 427 | fsg #"e" = lookFSIGn (int (), symbol (), modId ())
602 :     | fsg _ = raise Format
603 :     in
604 :     share fsigM fsg
605 :     end
606 :    
607 :     and spec () = let
608 :     val intoption = option ioM int
609 :     fun sp #"1" = M.TYCspec { spec = tycon (), entVar = entVar (),
610 :     repl = bool (), scope = int () }
611 :     | sp #"2" = M.STRspec { sign = Signature (), slot = int (),
612 :     def = option spDefM
613 : blume 515 (pair sdIntPM (strDef, int)) (),
614 : monnier 427 entVar = entVar () }
615 :     | sp #"3" = M.FCTspec { sign = fctSig (), slot = int (),
616 :     entVar = entVar () }
617 :     | sp #"4" = M.VALspec { spec = ty (), slot = int () }
618 :     | sp #"5" = M.CONspec { spec = datacon (), slot = intoption () }
619 :     | sp _ = raise Format
620 :     in
621 :     share spM sp
622 :     end
623 :    
624 :     and entity () = let
625 :     fun en #"A" = M.TYCent (tycEntity ())
626 :     | en #"B" = M.STRent (strEntity ())
627 :     | en #"C" = M.FCTent (fctEntity ())
628 :     | en #"D" = M.ERRORent
629 :     | en _ = raise Format
630 :     in
631 :     share enM en
632 :     end
633 :    
634 :     and fctClosure () = let
635 :     fun f #"f" =M.CLOSURE { param = entVar (), body = strExp (),
636 :     env = entityEnv () }
637 :     | f _ = raise Format
638 :     in
639 :     share fctcM f
640 :     end
641 :    
642 :     and Structure () = let
643 :     fun stracc (M.STR { sign, rlzn, info, ... }) =
644 :     M.STR { sign = sign, rlzn = rlzn, info = info,
645 :     access = access () }
646 :     | stracc _ = raise Format
647 :     fun str #"A" = M.STRSIG { sign = Signature (),
648 :     entPath = entPath () }
649 :     | str #"B" = M.ERRORstr
650 :     | str #"C" = stracc (lookSTR (modId ()))
651 :     | str #"D" = M.STR { sign = Signature (), rlzn = strEntity (),
652 :     access = access (), info = inl_info () }
653 : blume 537 | str #"I" = stracc (lookSTRp (modId ()))
654 : monnier 427 | str #"J" = stracc (lookSTRn (int (), symbol (), modId ()))
655 :     | str _ = raise Format
656 :     in
657 :     share strM str
658 :     end
659 :    
660 :     and Functor () = let
661 :     fun fctacc (M.FCT { sign, rlzn, info, ... }) =
662 :     M.FCT { sign = sign, rlzn = rlzn, info = info,
663 :     access = access () }
664 :     | fctacc _ = raise Format
665 :     fun fct #"E" = M.ERRORfct
666 :     | fct #"F" = fctacc (lookFCT (modId ()))
667 :     | fct #"G" = M.FCT { sign = fctSig (), rlzn = fctEntity (),
668 :     access = access (), info = inl_info () }
669 : blume 537 | fct #"H" = fctacc (lookFCTp (modId ()))
670 : monnier 427 | fct #"I" = fctacc (lookFCTn (int (), symbol (), modId ()))
671 :     | fct _ = raise Format
672 :     in
673 :     share fctM fct
674 :     end
675 :    
676 :     and stampExp () = let
677 :     fun ste #"a" = M.CONST (stamp ())
678 :     | ste #"b" = M.GETSTAMP (strExp ())
679 :     | ste #"c" = M.NEW
680 :     | ste _ = raise Format
681 :     in
682 :     share steM ste
683 :     end
684 :    
685 :     and tycExp () = let
686 :     fun tce #"d" = M.CONSTtyc (tycon ())
687 :     | tce #"e" = M.FORMtyc (tycon ())
688 :     | tce #"f" = M.VARtyc (entPath ())
689 :     | tce _ = raise Format
690 :     in
691 :     share tceM tce
692 :     end
693 :    
694 :     and strExp () = let
695 :     fun stre #"g" = M.VARstr (entPath ())
696 :     | stre #"h" = M.CONSTstr (strEntity ())
697 :     | stre #"i" = M.STRUCTURE { stamp = stampExp (),
698 :     entDec = entityDec () }
699 :     | stre #"j" = M.APPLY (fctExp (), strExp ())
700 :     | stre #"k" = M.LETstr (entityDec (), strExp ())
701 :     | stre #"l" = M.ABSstr (Signature (), strExp ())
702 :     | stre #"m" = M.CONSTRAINstr { boundvar = entVar (),
703 :     raw = strExp (),
704 :     coercion = strExp () }
705 :     | stre #"n" = M.FORMstr (fctSig ())
706 :     | stre _ = raise Format
707 :     in
708 :     share streM stre
709 :     end
710 :    
711 :     and fctExp () = let
712 :     fun fe #"o" = M.VARfct (entPath ())
713 :     | fe #"p" = M.CONSTfct (fctEntity ())
714 :     | fe #"q" = M.LAMBDA { param = entVar (), body = strExp () }
715 :     | fe #"r" = M.LAMBDA_TP { param = entVar (), body = strExp (),
716 :     sign = fctSig () }
717 :     | fe #"s" = M.LETfct (entityDec (), fctExp ())
718 :     | fe _ = raise Format
719 :     in
720 :     share feM fe
721 :     end
722 :    
723 :     and entityExp () = let
724 :     fun ee #"t" = M.TYCexp (tycExp ())
725 :     | ee #"u" = M.STRexp (strExp ())
726 :     | ee #"v" = M.FCTexp (fctExp ())
727 :     | ee #"w" = M.ERRORexp
728 :     | ee #"x" = M.DUMMYexp
729 :     | ee _ = raise Format
730 :     in
731 :     share eeM ee
732 :     end
733 :    
734 :     and entityDec () = let
735 :     fun ed #"A" = M.TYCdec (entVar (), tycExp ())
736 :     | ed #"B" = M.STRdec (entVar (), strExp (), symbol ())
737 :     | ed #"C" = M.FCTdec (entVar (), fctExp ())
738 :     | ed #"D" = M.SEQdec (entityDecList ())
739 :     | ed #"E" = M.LOCALdec (entityDec (), entityDec ())
740 :     | ed #"F" = M.ERRORdec
741 :     | ed #"G" = M.EMPTYdec
742 :     | ed _ = raise Format
743 :     in
744 :     share edM ed
745 :     end
746 :    
747 :     and entityDecList () = list edListM entityDec ()
748 :    
749 :     and entityEnv () = let
750 :     fun eenv #"A" =
751 :     let
752 : blume 515 val l = list eenvBindM (pair evEntPM (entVar, entity)) ()
753 : monnier 427 fun add ((v, e), z) = ED.insert (z, v, e)
754 :     val ed = foldr add ED.empty l
755 :     in
756 :     M.BINDeenv (ed, entityEnv ())
757 :     end
758 :     | eenv #"B" = M.NILeenv
759 :     | eenv #"C" = M.ERReenv
760 :     | eenv #"D" = lookEENV (modId ())
761 :     | eenv #"E" = M.MARKeenv (stamp (), entityEnv ())
762 : blume 537 | eenv #"F" = lookEENVp (modId ())
763 : monnier 427 | eenv #"G" = lookEENVn (int (), symbol (), modId ())
764 :     | eenv _ = raise Format
765 :     in
766 :     share eenvM eenv
767 :     end
768 :    
769 :     and strEntity () = let
770 :     fun s #"s" =
771 :     { stamp = stamp (), entities = entityEnv (), rpath = ipath (),
772 :     lambdaty = ref NONE }
773 :     | s _ = raise Format
774 :     in
775 :     share senM s
776 :     end
777 :    
778 :     and fctEntity () = let
779 :     fun f #"f" =
780 :     { stamp = stamp (), closure = fctClosure (), rpath = ipath (),
781 :     lambdaty = ref NONE, tycpath = NONE }
782 :     | f _ = raise Format
783 :     in
784 :     share fenM f
785 :     end
786 :    
787 :     and tycEntity () = tycon ()
788 :    
789 :     fun fixity () = let
790 :     fun fx #"N" = Fixity.NONfix
791 :     | fx #"I" = Fixity.INfix (int (), int ())
792 :     | fx _ = raise Format
793 :     in
794 :     share fxM fx
795 :     end
796 :    
797 :     fun binding () = let
798 :     fun b #"1" = B.VALbind (var ())
799 :     | b #"2" = B.CONbind (datacon ())
800 :     | b #"3" = B.TYCbind (tycon ())
801 :     | b #"4" = B.SIGbind (Signature ())
802 :     | b #"5" = B.STRbind (Structure ())
803 :     | b #"6" = B.FSGbind (fctSig ())
804 :     | b #"7" = B.FCTbind (Functor ())
805 :     | b #"8" = B.FIXbind (fixity ())
806 :     | b _ = raise Format
807 :     in
808 :     share bM b
809 :     end
810 :    
811 :     fun env () = let
812 : blume 515 val bindlist = list envM (pair symBindPM (symbol, binding)) ()
813 : monnier 427 fun bind ((s, b), e) = Env.bind (s, b, e)
814 :     in
815 :     Env.consolidate (foldl bind Env.empty bindlist)
816 :     end
817 : monnier 504
818 :     fun env' () = let
819 : blume 515 val (e, mil) = pair envMilPM (env, list milM modId) ()
820 : monnier 504 val ctxt = ModuleId.Set.addList (ModuleId.Set.empty, mil)
821 :     in
822 :     { env = e, ctxt = ctxt }
823 :     end
824 : monnier 427 in
825 : monnier 504 { envUnpickler = env, envUnpickler' = env' }
826 : monnier 427 end
827 :    
828 :     fun unpickleEnv { context, hash, pickle } = let
829 : monnier 504 val cs = ref ModuleId.Set.empty
830 :     fun cvt lk i =
831 :     case lk context i of
832 :     SOME v => (cs := ModuleId.Set.add (!cs, i); v)
833 :     | NONE => raise Format
834 : monnier 427 fun dont _ = raise Format
835 :     val c = { lookSTR = cvt CMStaticEnv.lookSTR,
836 :     lookSIG = cvt CMStaticEnv.lookSIG,
837 :     lookFCT = cvt CMStaticEnv.lookFCT,
838 :     lookFSIG = cvt CMStaticEnv.lookFSIG,
839 :     lookTYC = cvt CMStaticEnv.lookTYC,
840 :     lookEENV = cvt CMStaticEnv.lookEENV,
841 :     lookSTRp = dont,
842 :     lookSIGp = dont,
843 :     lookFCTp = dont,
844 :     lookFSIGp = dont,
845 :     lookTYCp = dont,
846 :     lookEENVp = dont,
847 :     lookSTRn = dont,
848 :     lookSIGn = dont,
849 :     lookFCTn = dont,
850 :     lookFSIGn = dont,
851 :     lookTYCn = dont,
852 :     lookEENVn = dont }
853 :     val session =
854 :     UU.mkSession (UU.stringGetter (Byte.bytesToString pickle))
855 :     fun import i = A.PATH (A.EXTERN hash, i)
856 :     val sharedStuff as { symbol, ... } = mkSharedStuff (session, import)
857 :     val symbolListM = UU.mkMap ()
858 :     val symbollist = UU.r_list session symbolListM symbol
859 : monnier 504 val { envUnpickler, ... } =
860 : monnier 427 mkEnvUnpickler (session, symbollist, sharedStuff,
861 :     c, fn () => hash)
862 :     in
863 : monnier 504 (* order of evaluation is important here! *)
864 :     { env = envUnpickler (), ctxt = !cs }
865 : monnier 427 end
866 :    
867 :     fun mkFlintUnpickler (session, sharedStuff) = let
868 :    
869 :     fun share m r = UU.share session m r
870 :    
871 :     fun list m r = UU.r_list session m r
872 :     fun option m r = UU.r_option session m r
873 :    
874 : blume 515 fun pair m fp p = UU.r_pair session m fp p
875 : monnier 427 val int = UU.r_int session
876 :     val int32 = UU.r_int32 session
877 :     val word = UU.r_word session
878 :     val word32 = UU.r_word32 session
879 :     val bool = UU.r_bool session
880 :    
881 : blume 515 val { pid, string, symbol, access, conrep, consig,
882 :     primop, boollist, tkind, tkindlist } = sharedStuff
883 : monnier 427
884 : blume 515 val ltyM = UU.mkMap ()
885 :     val ltyListM = UU.mkMap ()
886 :     val tycM = UU.mkMap ()
887 :     val tycListM = UU.mkMap ()
888 : monnier 427 val valueM = UU.mkMap ()
889 :     val conM = UU.mkMap ()
890 :     val dconM = UU.mkMap ()
891 :     val dictM = UU.mkMap ()
892 :     val fprimM = UU.mkMap ()
893 :     val lexpM = UU.mkMap ()
894 :     val fkindM = UU.mkMap ()
895 :     val rkindM = UU.mkMap ()
896 :     val ltyloM = UU.mkMap ()
897 :     val dictTableM = UU.mkMap ()
898 :     val dictOptionM = UU.mkMap ()
899 :     val valueListM = UU.mkMap ()
900 :     val lvarListM = UU.mkMap ()
901 :     val fundecListM = UU.mkMap ()
902 :     val conListM = UU.mkMap ()
903 :     val lexpOptionM = UU.mkMap ()
904 :     val fundecM = UU.mkMap ()
905 :     val tfundecM = UU.mkMap ()
906 : blume 515 val lvLtPM = UU.mkMap ()
907 :     val lvLtPLM = UU.mkMap ()
908 :     val lvTkPM = UU.mkMap ()
909 :     val lvTkPLM = UU.mkMap ()
910 :     val tycLvPM = UU.mkMap ()
911 : monnier 427
912 : blume 515 fun lty () = let
913 :     fun lt #"A" = LT.ltc_tyc (tyc ())
914 :     | lt #"B" = LT.ltc_str (ltylist ())
915 :     | lt #"C" = LT.ltc_fct (ltylist (), ltylist ())
916 :     | lt #"D" = LT.ltc_poly (tkindlist (), ltylist ())
917 :     | lt _ = raise Format
918 :     in
919 :     share ltyM lt
920 :     end
921 :    
922 :     and ltylist () = list ltyListM lty ()
923 :    
924 :     and tyc () = let
925 :     fun tc #"A" = LT.tcc_var (DI.di_fromint (int ()), int ())
926 :     | tc #"B" = LT.tcc_nvar (int ())
927 :     | tc #"C" = LT.tcc_prim (PT.pt_fromint (int ()))
928 :     | tc #"D" = LT.tcc_fn (tkindlist (), tyc ())
929 :     | tc #"E" = LT.tcc_app (tyc (), tyclist ())
930 :     | tc #"F" = LT.tcc_seq (tyclist ())
931 :     | tc #"G" = LT.tcc_proj (tyc (), int ())
932 :     | tc #"H" = LT.tcc_sum (tyclist ())
933 :     | tc #"I" = LT.tcc_fix ((int (), tyc (), tyclist ()), int ())
934 :     | tc #"J" = LT.tcc_abs (tyc ())
935 :     | tc #"K" = LT.tcc_box (tyc ())
936 :     | tc #"L" = LT.tcc_tuple (tyclist ())
937 :     | tc #"M" = LT.tcc_arrow (LT.ffc_var (bool (), bool ()),
938 :     tyclist (), tyclist ())
939 :     | tc #"N" = LT.tcc_arrow (LT.ffc_fixed, tyclist (), tyclist ())
940 :     | tc #"O" = LK.tc_inj (LK.TC_TOKEN (LK.token_key (int ()),
941 :     tyc ()))
942 :     | tc _ = raise Format
943 :     in
944 :     share tycM tc
945 :     end
946 :    
947 :     and tyclist () = list tycListM tyc ()
948 :    
949 : monnier 427 val lvar = int
950 :     val lvarlist = list lvarListM lvar
951 :    
952 :     fun value () = let
953 :     fun v #"a" = F.VAR (lvar ())
954 :     | v #"b" = F.INT (int ())
955 :     | v #"c" = F.INT32 (int32 ())
956 :     | v #"d" = F.WORD (word ())
957 :     | v #"e" = F.WORD32 (word32 ())
958 :     | v #"f" = F.REAL (string ())
959 :     | v #"g" = F.STRING (string ())
960 :     | v _ = raise Format
961 :     in
962 :     share valueM v
963 :     end
964 :    
965 :     val valuelist = list valueListM value
966 :    
967 :     fun con () = let
968 :     fun c #"1" =
969 :     let
970 :     val (dc, ts) = dcon ()
971 :     in
972 :     (F.DATAcon (dc, ts, lvar ()), lexp ())
973 :     end
974 :     | c #"2" = (F.INTcon (int ()), lexp ())
975 :     | c #"3" = (F.INT32con (int32 ()), lexp ())
976 :     | c #"4" = (F.WORDcon (word ()), lexp ())
977 :     | c #"5" = (F.WORD32con (word32 ()), lexp ())
978 :     | c #"6" = (F.REALcon (string ()), lexp ())
979 :     | c #"7" = (F.STRINGcon (string ()), lexp ())
980 :     | c #"8" = (F.VLENcon (int ()), lexp ())
981 :     | c _ = raise Format
982 :     in
983 :     share conM c
984 :     end
985 :    
986 :     and conlist () = list conListM con ()
987 :    
988 :     and dcon () = let
989 :     fun d #"x" = ((symbol (), conrep (), lty ()), tyclist ())
990 :     | d _ = raise Format
991 :     in
992 :     share dconM d
993 :     end
994 :    
995 :     and dict () = let
996 :     fun d #"y" =
997 :     { default = lvar (),
998 : blume 515 table = list dictTableM (pair tycLvPM (tyclist, lvar)) () }
999 : monnier 427 | d _ = raise Format
1000 :     in
1001 :     share dictM d
1002 :     end
1003 :    
1004 :     and fprim () = let
1005 :     fun f #"z" = (option dictOptionM dict (),
1006 :     primop (), lty (), tyclist ())
1007 :     | f _ = raise Format
1008 :     in
1009 :     share fprimM f
1010 :     end
1011 :    
1012 :     and lexp () = let
1013 :     fun e #"j" = F.RET (valuelist ())
1014 :     | e #"k" = F.LET (lvarlist (), lexp (), lexp ())
1015 :     | e #"l" = F.FIX (fundeclist (), lexp ())
1016 :     | e #"m" = F.APP (value (), valuelist ())
1017 :     | e #"n" = F.TFN (tfundec (), lexp ())
1018 :     | e #"o" = F.TAPP (value (), tyclist ())
1019 :     | e #"p" = F.SWITCH (value (), consig (), conlist (),
1020 :     lexpoption ())
1021 :     | e #"q" = let
1022 :     val (dc, ts) = dcon ()
1023 :     in
1024 :     F.CON (dc, ts, value (), lvar (), lexp ())
1025 :     end
1026 :     | e #"r" = F.RECORD (rkind (), valuelist (), lvar (), lexp ())
1027 :     | e #"s" = F.SELECT (value (), int (), lvar (), lexp ())
1028 :     | e #"t" = F.RAISE (value (), ltylist ())
1029 :     | e #"u" = F.HANDLE (lexp (), value ())
1030 :     | e #"v" = F.BRANCH (fprim (), valuelist (), lexp (), lexp ())
1031 :     | e #"w" = F.PRIMOP (fprim (), valuelist (), lvar (), lexp ())
1032 :     | e _ = raise Format
1033 :     in
1034 :     share lexpM e
1035 :     end
1036 :    
1037 :     and lexpoption () = option lexpOptionM lexp ()
1038 :    
1039 :     and fundec () = let
1040 :     fun f #"a" =
1041 : blume 515 (fkind (), lvar (),
1042 :     list lvLtPLM (pair lvLtPM (lvar, lty)) (),
1043 :     lexp ())
1044 : monnier 427 | f _ = raise Format
1045 :     in
1046 :     share fundecM f
1047 :     end
1048 :    
1049 :     and fundeclist () = list fundecListM fundec ()
1050 :    
1051 :     and tfundec () = let
1052 : blume 515 fun t #"b" = ({ inline = F.IH_SAFE }, lvar (),
1053 :     list lvTkPLM (pair lvTkPM (lvar, tkind)) (),
1054 :     lexp ())
1055 : monnier 427 | t _ = raise Format
1056 :     in
1057 :     share tfundecM t
1058 :     end
1059 :    
1060 :     and fkind () = let
1061 : blume 515 fun aug_unknown x = (x, F.LK_UNKNOWN)
1062 :     fun inlflag true = F.IH_ALWAYS
1063 :     | inlflag false = F.IH_SAFE
1064 :     fun fk #"2" = { isrec = NONE, cconv = F.CC_FCT,
1065 :     known = false, inline = F.IH_SAFE }
1066 :     | fk #"3" = { isrec = Option.map aug_unknown (ltylistoption ()),
1067 :     cconv = F.CC_FUN (LT.ffc_var (bool (), bool ())),
1068 : monnier 489 known = bool (),
1069 : blume 515 inline = inlflag (bool ()) }
1070 :     | fk #"4" = { isrec = Option.map aug_unknown (ltylistoption ()),
1071 : monnier 489 cconv = F.CC_FUN LT.ffc_fixed,
1072 :     known = bool (),
1073 : blume 515 inline = inlflag (bool ()) }
1074 : monnier 427 | fk _ = raise Format
1075 :     in
1076 :     share fkindM fk
1077 :     end
1078 :    
1079 :     and ltylistoption () = option ltyloM ltylist ()
1080 :    
1081 :     and rkind () = let
1082 :     fun rk #"5" = F.RK_VECTOR (tyc ())
1083 :     | rk #"6" = F.RK_STRUCT
1084 :     | rk #"7" = FlintUtil.rk_tuple
1085 :     | rk _ = raise Format
1086 :     in
1087 :     share rkindM rk
1088 :     end
1089 :     in
1090 :     fundec
1091 :     end
1092 :    
1093 :     fun unpickleFLINT pickle = let
1094 :     val session =
1095 :     UU.mkSession (UU.stringGetter (Byte.bytesToString pickle))
1096 :     val sharedStuff = mkSharedStuff (session, A.LVAR)
1097 :     val flint = mkFlintUnpickler (session, sharedStuff)
1098 :     val foM = UU.mkMap ()
1099 :     in
1100 :     UU.r_option session foM flint ()
1101 :     end
1102 :    
1103 :     fun mkUnpicklers session contexts = let
1104 :     val { prim_context, node_context } = contexts
1105 : blume 537 fun cvtP lk id =
1106 :     case lk prim_context id of
1107 :     SOME v => v
1108 :     | NONE => raise Format
1109 : monnier 427 fun cvtN lk (i, s, id) =
1110 :     case node_context (i, s) of
1111 :     NONE => raise Format
1112 :     | SOME e => (case lk e id of SOME v => v | NONE => raise Format)
1113 :     fun dont i = raise Format
1114 :     val c = { lookSTRn = cvtN CMStaticEnv.lookSTR,
1115 :     lookSIGn = cvtN CMStaticEnv.lookSIG,
1116 :     lookFCTn = cvtN CMStaticEnv.lookFCT,
1117 :     lookFSIGn = cvtN CMStaticEnv.lookFSIG,
1118 :     lookTYCn = cvtN CMStaticEnv.lookTYC,
1119 :     lookEENVn = cvtN CMStaticEnv.lookEENV,
1120 :     lookSTRp = cvtP CMStaticEnv.lookSTR,
1121 :     lookSIGp = cvtP CMStaticEnv.lookSIG,
1122 :     lookFCTp = cvtP CMStaticEnv.lookFCT,
1123 :     lookFSIGp = cvtP CMStaticEnv.lookFSIG,
1124 :     lookTYCp = cvtP CMStaticEnv.lookTYC,
1125 :     lookEENVp = cvtP CMStaticEnv.lookEENV,
1126 :     lookSTR = dont,
1127 :     lookSIG = dont,
1128 :     lookFCT = dont,
1129 :     lookFSIG = dont,
1130 :     lookTYC = dont,
1131 :     lookEENV = dont }
1132 :     val sharedStuff as { symbol, pid, ... } =
1133 :     mkSharedStuff (session, A.LVAR)
1134 :     val symbolListM = UU.mkMap ()
1135 :     val symbollist = UU.r_list session symbolListM symbol
1136 : monnier 504 val { envUnpickler', ... } =
1137 : monnier 427 mkEnvUnpickler (session, symbollist, sharedStuff,
1138 :     c, fn () => raise Format)
1139 :     val flint = mkFlintUnpickler (session, sharedStuff)
1140 : blume 515 val pidFlintPM = UU.mkMap ()
1141 :     val symbind = UU.r_pair session pidFlintPM (pid, flint)
1142 : monnier 427 val sblM = UU.mkMap ()
1143 :     val sbl = UU.r_list session sblM symbind
1144 :     fun symenvUnpickler () = SymbolicEnv.fromListi (sbl ())
1145 :     in
1146 : monnier 504 { symenv = symenvUnpickler, env = envUnpickler',
1147 : monnier 427 symbol = symbol, symbollist = symbollist }
1148 :     end
1149 :    
1150 :     val unpickleEnv =
1151 :     Stats.doPhase (Stats.makePhase "Compiler 087 unpickleEnv") unpickleEnv
1152 :     end

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