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

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/Semant/pickle/unpickmod-new.sml
ViewVC logotype

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

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

revision 568, Tue Mar 7 03:59:09 2000 UTC revision 569, Tue Mar 7 04:01:07 2000 UTC
# Line 24  Line 24 
24      val mkUnpicklers :      val mkUnpicklers :
25          UnpickleUtil.session ->          UnpickleUtil.session ->
26          { prim_context: CMStaticEnv.staticEnv,          { prim_context: CMStaticEnv.staticEnv,
27            node_context: int * Symbol.symbol -> CMStaticEnv.staticEnv option }            node_context:
28                   string list * Symbol.symbol -> CMStaticEnv.staticEnv option,
29              stringlist: string list UnpickleUtil.reader }
30          -> { symenv: SymbolicEnv.symenv UnpickleUtil.reader,          -> { symenv: SymbolicEnv.symenv UnpickleUtil.reader,
31               env: env'n'ctxt UnpickleUtil.reader,               env: env'n'ctxt UnpickleUtil.reader,
32               symbol: Symbol.symbol UnpickleUtil.reader,               symbol: Symbol.symbol UnpickleUtil.reader,
# Line 267  Line 269 
269      end      end
270    
271      fun mkEnvUnpickler arg = let      fun mkEnvUnpickler arg = let
272          val (session, symbollist, sharedStuff, context0, globalPid) = arg          val (session, symbollist, stringlist,
273                 sharedStuff, context0, globalPid) = arg
274    
275          val { lookTYC, lookSIG, lookFSIG, lookSTR, lookFCT, lookEENV,          val { lookTYC, lookSIG, lookFSIG, lookSTR, lookFCT, lookEENV,
276                lookTYCp, lookSIGp, lookFSIGp, lookSTRp, lookFCTp, lookEENVp,                lookTYCp, lookSIGp, lookFSIGp, lookSTRp, lookFCTp, lookEENVp,
# Line 500  Line 503 
503                | tyc #"G" = T.FREEtyc (int ())                | tyc #"G" = T.FREEtyc (int ())
504                | tyc #"H" = T.ERRORtyc                | tyc #"H" = T.ERRORtyc
505                | tyc #"I" = lookTYCp (modId ())                | tyc #"I" = lookTYCp (modId ())
506                | tyc #"J" = lookTYCn (int (), symbol(), modId ())                | tyc #"J" = lookTYCn (stringlist (), symbol(), modId ())
507                | tyc _ = raise Format                | tyc _ = raise Format
508          in          in
509              share tyconM tyc              share tyconM tyc
# Line 583  Line 586 
586                                    typsharing = spathlistlist (),                                    typsharing = spathlistlist (),
587                                    strsharing = spathlistlist () }                                    strsharing = spathlistlist () }
588                | sg #"D" = lookSIGp (modId ())                | sg #"D" = lookSIGp (modId ())
589                | sg #"E" = lookSIGn (int (), symbol (), modId ())                | sg #"E" = lookSIGn (stringlist (), symbol (), modId ())
590                | sg _ = raise Format                | sg _ = raise Format
591          in          in
592              share sigM sg              share sigM sg
# Line 598  Line 601 
601                                      paramsym = symboloption (),                                      paramsym = symboloption (),
602                                      bodysig = Signature () }                                      bodysig = Signature () }
603                | fsg #"d" = lookFSIGp (modId ())                | fsg #"d" = lookFSIGp (modId ())
604                | fsg #"e" = lookFSIGn (int (), symbol (), modId ())                | fsg #"e" = lookFSIGn (stringlist (), symbol (), modId ())
605                | fsg _ = raise Format                | fsg _ = raise Format
606          in          in
607              share fsigM fsg              share fsigM fsg
# Line 651  Line 654 
654                | str #"D" = M.STR { sign = Signature (), rlzn = strEntity (),                | str #"D" = M.STR { sign = Signature (), rlzn = strEntity (),
655                                     access = access (), info = inl_info () }                                     access = access (), info = inl_info () }
656                | str #"I" = stracc (lookSTRp (modId ()))                | str #"I" = stracc (lookSTRp (modId ()))
657                | str #"J" = stracc (lookSTRn (int (), symbol (), modId ()))                | str #"J" = stracc (lookSTRn (stringlist (), symbol (), modId ()))
658                | str _ = raise Format                | str _ = raise Format
659          in          in
660              share strM str              share strM str
# Line 667  Line 670 
670                | fct #"G" = M.FCT { sign = fctSig (), rlzn = fctEntity (),                | fct #"G" = M.FCT { sign = fctSig (), rlzn = fctEntity (),
671                                     access = access (), info = inl_info () }                                     access = access (), info = inl_info () }
672                | fct #"H" = fctacc (lookFCTp (modId ()))                | fct #"H" = fctacc (lookFCTp (modId ()))
673                | fct #"I" = fctacc (lookFCTn (int (), symbol (), modId ()))                | fct #"I" = fctacc (lookFCTn (stringlist (), symbol (),
674                                                 modId ()))
675                | fct _ = raise Format                | fct _ = raise Format
676          in          in
677              share fctM fct              share fctM fct
# Line 760  Line 764 
764                | eenv #"D" = lookEENV (modId ())                | eenv #"D" = lookEENV (modId ())
765                | eenv #"E" = M.MARKeenv (stamp (), entityEnv ())                | eenv #"E" = M.MARKeenv (stamp (), entityEnv ())
766                | eenv #"F" = lookEENVp (modId ())                | eenv #"F" = lookEENVp (modId ())
767                | eenv #"G" = lookEENVn (int (), symbol (), modId ())                | eenv #"G" = lookEENVn (stringlist (), symbol (), modId ())
768                | eenv _ = raise Format                | eenv _ = raise Format
769          in          in
770              share eenvM eenv              share eenvM eenv
# Line 853  Line 857 
857          val session =          val session =
858              UU.mkSession (UU.stringGetter (Byte.bytesToString pickle))              UU.mkSession (UU.stringGetter (Byte.bytesToString pickle))
859          fun import i = A.PATH (A.EXTERN hash, i)          fun import i = A.PATH (A.EXTERN hash, i)
860          val sharedStuff as { symbol, ... } = mkSharedStuff (session, import)          val sharedStuff as { symbol, string, ... } =
861                mkSharedStuff (session, import)
862          val symbolListM = UU.mkMap ()          val symbolListM = UU.mkMap ()
863          val symbollist = UU.r_list session symbolListM symbol          val symbollist = UU.r_list session symbolListM symbol
864            val stringListM = UU.mkMap ()
865            val stringlist = UU.r_list session stringListM string
866          val { envUnpickler, ... } =          val { envUnpickler, ... } =
867              mkEnvUnpickler (session, symbollist, sharedStuff,              mkEnvUnpickler (session, symbollist, stringlist, sharedStuff,
868                              c, fn () => hash)                              c, fn () => hash)
869      in      in
870          (* order of evaluation is important here! *)          (* order of evaluation is important here! *)
# Line 1101  Line 1108 
1108      end      end
1109    
1110      fun mkUnpicklers session contexts = let      fun mkUnpicklers session contexts = let
1111          val { prim_context, node_context } = contexts          val { prim_context, node_context, stringlist } = contexts
1112          fun cvtP lk id =          fun cvtP lk id =
1113              case lk prim_context id of              case lk prim_context id of
1114                  SOME v => v                  SOME v => v
1115                | NONE => raise Format                | NONE => raise Format
1116          fun cvtN lk (i, s, id) =          fun cvtN lk (sl, s, id) =
1117              case node_context (i, s) of              case node_context (sl, s) of
1118                  NONE => raise Format                  NONE => raise Format
1119                | SOME e => (case lk e id of SOME v => v | NONE => raise Format)                | SOME e => (case lk e id of SOME v => v | NONE => raise Format)
1120          fun dont i = raise Format          fun dont i = raise Format
# Line 1134  Line 1141 
1141          val symbolListM = UU.mkMap ()          val symbolListM = UU.mkMap ()
1142          val symbollist = UU.r_list session symbolListM symbol          val symbollist = UU.r_list session symbolListM symbol
1143          val { envUnpickler', ... } =          val { envUnpickler', ... } =
1144              mkEnvUnpickler (session, symbollist, sharedStuff,              mkEnvUnpickler (session, symbollist, stringlist, sharedStuff,
1145                              c, fn () => raise Format)                              c, fn () => raise Format)
1146          val flint = mkFlintUnpickler (session, sharedStuff)          val flint = mkFlintUnpickler (session, sharedStuff)
1147          val pidFlintPM = UU.mkMap ()          val pidFlintPM = UU.mkMap ()

Legend:
Removed from v.568  
changed lines
  Added in v.569

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