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 514, Thu Dec 16 08:32:57 1999 UTC revision 515, Sun Jan 9 09:59:14 2000 UTC
# Line 149  Line 149 
149          val accM = UU.mkMap ()          val accM = UU.mkMap ()
150          val crM = UU.mkMap ()          val crM = UU.mkMap ()
151          val csM = UU.mkMap ()          val csM = UU.mkMap ()
         val ltyM = UU.mkMap ()  
         val ltyListM = UU.mkMap ()  
         val tycM = UU.mkMap ()  
         val tycListM = UU.mkMap ()  
         val tkindM = UU.mkMap ()  
         val tkindListM = UU.mkMap ()  
152          val nkM = UU.mkMap ()          val nkM = UU.mkMap ()
153          val poM = UU.mkMap ()          val poM = UU.mkMap ()
154          val boolListM = UU.mkMap ()          val boolListM = UU.mkMap ()
155            val tkindM = UU.mkMap ()
156            val tkindListM = UU.mkMap ()
157    
158          val boollist = list boolListM bool          val boollist = list boolListM bool
159    
160          val pid = UnpickleSymPid.r_pid string          val pid = UnpickleSymPid.r_pid (session, string)
161    
162          fun access () = let          fun access () = let
163              fun a #"A" = lvar (int ())              fun a #"A" = lvar (int ())
# Line 197  Line 193 
193              share csM cs              share csM cs
194          end          end
195    
196          fun lty () = let          fun tkind () = let
             fun lt #"A" = LT.ltc_tyc (tyc ())  
               | lt #"B" = LT.ltc_str (ltylist ())  
               | lt #"C" = LT.ltc_fct (ltylist (), ltylist ())  
               | lt #"D" = LT.ltc_poly (tkindlist (), ltylist ())  
               | lt _ = raise Format  
         in  
             share ltyM lt  
         end  
   
         and ltylist () = list ltyListM lty ()  
   
         and tyc () = let  
             fun tc #"A" = LT.tcc_var (DI.di_fromint (int ()), int ())  
               | tc #"B" = LT.tcc_nvar (int ())  
               | tc #"C" = LT.tcc_prim (PT.pt_fromint (int ()))  
               | tc #"D" = LT.tcc_fn (tkindlist (), tyc ())  
               | tc #"E" = LT.tcc_app (tyc (), tyclist ())  
               | tc #"F" = LT.tcc_seq (tyclist ())  
               | tc #"G" = LT.tcc_proj (tyc (), int ())  
               | tc #"H" = LT.tcc_sum (tyclist ())  
               | tc #"I" = LT.tcc_fix ((int (), tyc (), tyclist ()), int ())  
               | tc #"J" = LT.tcc_abs (tyc ())  
               | tc #"K" = LT.tcc_box (tyc ())  
               | tc #"L" = LT.tcc_tuple (tyclist ())  
               | tc #"M" = LT.tcc_arrow (LT.ffc_var (bool (), bool ()),  
                                         tyclist (), tyclist ())  
               | tc #"N" = LT.tcc_arrow (LT.ffc_fixed, tyclist (), tyclist ())  
               | tc #"O" = LK.tc_inj (LK.TC_TOKEN (LK.token_key (int ()),  
                                                   tyc ()))  
               | tc _ = raise Format  
         in  
             share tycM tc  
         end  
   
         and tyclist () = list tycListM tyc ()  
   
         and tkind () = let  
197              fun tk #"A" = LT.tkc_mono              fun tk #"A" = LT.tkc_mono
198                | tk #"B" = LT.tkc_box                | tk #"B" = LT.tkc_box
199                | tk #"C" = LT.tkc_seq (tkindlist ())                | tk #"C" = LT.tkc_seq (tkindlist ())
# Line 303  Line 262 
262      in      in
263          { pid = pid, string = string, symbol = symbol,          { pid = pid, string = string, symbol = symbol,
264            access = access, conrep = conrep, consig = consig,            access = access, conrep = conrep, consig = consig,
265            lty = lty, tyc = tyc, tkind = tkind,            primop = primop, boollist = boollist,
266            ltylist = ltylist, tyclist = tyclist,            tkind = tkind, tkindlist = tkindlist }
           primop = primop, boollist = boollist }  
267      end      end
268    
269      fun mkEnvUnpickler arg = let      fun mkEnvUnpickler arg = let
# Line 319  Line 277 
277          fun list m r = UU.r_list session m r          fun list m r = UU.r_list session m r
278          fun option m r = UU.r_option session m r          fun option m r = UU.r_option session m r
279          val bool = UU.r_bool session          val bool = UU.r_bool session
280          val pair = UU.r_pair          fun pair m fp p = UU.r_pair session m fp p
281          val int = UU.r_int session          val int = UU.r_int session
282    
283          fun share m f = UU.share session m f          fun share m f = UU.share session m f
# Line 381  Line 339 
339          val eenvBindM = UU.mkMap ()          val eenvBindM = UU.mkMap ()
340          val envM = UU.mkMap ()          val envM = UU.mkMap ()
341          val milM = UU.mkMap ()          val milM = UU.mkMap ()
342            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    
351          val { pid, string, symbol,          val { pid, string, symbol, access, conrep, consig,
352                access, conrep, consig, lty, tyc, tkind, ltylist, tyclist,                primop, boollist, tkind, tkindlist } = sharedStuff
               primop, boollist } = sharedStuff  
353    
354          fun stamp () = let          fun stamp () = let
355              fun st #"A" = Stamps.STAMP { scope = Stamps.GLOBAL (globalPid ()),              fun st #"A" = Stamps.STAMP { scope = Stamps.GLOBAL (globalPid ()),
# Line 421  Line 386 
386          val symbollist = list symbolListM symbol          val symbollist = list symbolListM symbol
387          val symboloption = option symbolOptionM symbol          val symboloption = option symbolOptionM symbol
388    
389          fun spath () = SP.SPATH (symbollist ())  
390          fun ipath () = IP.IPATH (symbollist ())          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          val spathlist = list spathListM spath          val spathlist = list spathListM spath
405          val spathlistlist = list spathListListM spathlist          val spathlistlist = list spathListListM spathlist
# Line 597  Line 574 
574                                    stamp = stamp (),                                    stamp = stamp (),
575                                    symbols = symbollist (),                                    symbols = symbollist (),
576                                    elements = list elementsM                                    elements = list elementsM
577                                                   (pair (symbol, spec)) (),                                              (pair symSpecPM (symbol, spec)) (),
578                                    boundeps =                                    boundeps =
579                                      ref (option bepsOM                                      ref (option bepsOM
580                                           (list bepsLM (pair (entPath,                                           (list bepsLM
581                                                               tkind))) ()),                                            (pair epTkPM (entPath, tkind))) ()),
582                                    lambdaty = ref NONE,                                    lambdaty = ref NONE,
583                                    typsharing = spathlistlist (),                                    typsharing = spathlistlist (),
584                                    strsharing = spathlistlist () }                                    strsharing = spathlistlist () }
# Line 633  Line 610 
610                                        repl = bool (), scope = int () }                                        repl = bool (), scope = int () }
611                | sp #"2" = M.STRspec { sign = Signature (), slot = int (),                | sp #"2" = M.STRspec { sign = Signature (), slot = int (),
612                                        def = option spDefM                                        def = option spDefM
613                                                 (pair (strDef, int)) (),                                                 (pair sdIntPM (strDef, int)) (),
614                                        entVar = entVar () }                                        entVar = entVar () }
615                | sp #"3" = M.FCTspec { sign = fctSig (), slot = int (),                | sp #"3" = M.FCTspec { sign = fctSig (), slot = int (),
616                                        entVar = entVar () }                                        entVar = entVar () }
# Line 772  Line 749 
749          and entityEnv () = let          and entityEnv () = let
750              fun eenv #"A" =              fun eenv #"A" =
751                  let                  let
752                      val l = list eenvBindM (pair (entVar, entity)) ()                      val l = list eenvBindM (pair evEntPM (entVar, entity)) ()
753                      fun add ((v, e), z) = ED.insert (z, v, e)                      fun add ((v, e), z) = ED.insert (z, v, e)
754                      val ed = foldr add ED.empty l                      val ed = foldr add ED.empty l
755                  in                  in
# Line 832  Line 809 
809          end          end
810    
811          fun env () = let          fun env () = let
812              val bindlist = list envM (pair (symbol, binding)) ()              val bindlist = list envM (pair symBindPM (symbol, binding)) ()
813              fun bind ((s, b), e) = Env.bind (s, b, e)              fun bind ((s, b), e) = Env.bind (s, b, e)
814          in          in
815              Env.consolidate (foldl bind Env.empty bindlist)              Env.consolidate (foldl bind Env.empty bindlist)
816          end          end
817    
818          fun env' () = let          fun env' () = let
819              val (e, mil) = pair (env, list milM modId) ()              val (e, mil) = pair envMilPM (env, list milM modId) ()
820              val ctxt = ModuleId.Set.addList (ModuleId.Set.empty, mil)              val ctxt = ModuleId.Set.addList (ModuleId.Set.empty, mil)
821          in          in
822              { env = e, ctxt = ctxt }              { env = e, ctxt = ctxt }
# Line 894  Line 871 
871          fun list m r = UU.r_list session m r          fun list m r = UU.r_list session m r
872          fun option m r = UU.r_option session m r          fun option m r = UU.r_option session m r
873    
874          val pair = UU.r_pair          fun pair m fp p = UU.r_pair session m fp p
875          val int = UU.r_int session          val int = UU.r_int session
876          val int32 = UU.r_int32 session          val int32 = UU.r_int32 session
877          val word = UU.r_word session          val word = UU.r_word session
878          val word32 = UU.r_word32 session          val word32 = UU.r_word32 session
879          val bool = UU.r_bool session          val bool = UU.r_bool session
880    
881          val { pid, string, symbol,          val { pid, string, symbol, access, conrep, consig,
882                access, conrep, consig, lty, tyc, tkind, ltylist, tyclist,                primop, boollist, tkind, tkindlist } = sharedStuff
               primop, boollist } = sharedStuff  
883    
884            val ltyM = UU.mkMap ()
885            val ltyListM = UU.mkMap ()
886            val tycM = UU.mkMap ()
887            val tycListM = UU.mkMap ()
888          val valueM = UU.mkMap ()          val valueM = UU.mkMap ()
889          val conM = UU.mkMap ()          val conM = UU.mkMap ()
890          val dconM = UU.mkMap ()          val dconM = UU.mkMap ()
# Line 923  Line 903 
903          val lexpOptionM = UU.mkMap ()          val lexpOptionM = UU.mkMap ()
904          val fundecM = UU.mkMap ()          val fundecM = UU.mkMap ()
905          val tfundecM = UU.mkMap ()          val tfundecM = UU.mkMap ()
906          val fdplM = UU.mkMap ()          val lvLtPM = UU.mkMap ()
907          val tfplM = UU.mkMap ()          val lvLtPLM = UU.mkMap ()
908            val lvTkPM = UU.mkMap ()
909            val lvTkPLM = UU.mkMap ()
910            val tycLvPM = UU.mkMap ()
911    
912            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          val lvar = int          val lvar = int
950          val lvarlist = list lvarListM lvar          val lvarlist = list lvarListM lvar
# Line 975  Line 995 
995          and dict () = let          and dict () = let
996              fun d #"y" =              fun d #"y" =
997                  { default = lvar (),                  { default = lvar (),
998                    table = list dictTableM (pair (tyclist, lvar)) () }                    table = list dictTableM (pair tycLvPM (tyclist, lvar)) () }
999                | d _ = raise Format                | d _ = raise Format
1000          in          in
1001              share dictM d              share dictM d
# Line 1018  Line 1038 
1038    
1039          and fundec () = let          and fundec () = let
1040              fun f #"a" =              fun f #"a" =
1041                  (fkind (), lvar (), list fdplM (pair (lvar, lty)) (), lexp ())                  (fkind (), lvar (),
1042                     list lvLtPLM (pair lvLtPM (lvar, lty)) (),
1043                     lexp ())
1044                | f _ = raise Format                | f _ = raise Format
1045          in          in
1046              share fundecM f              share fundecM f
# Line 1027  Line 1049 
1049          and fundeclist () = list fundecListM fundec ()          and fundeclist () = list fundecListM fundec ()
1050    
1051          and tfundec () = let          and tfundec () = let
1052              fun t #"b" = ({inline=F.IH_SAFE}, lvar (), list tfplM (pair (lvar, tkind)) (), lexp ())              fun t #"b" = ({ inline = F.IH_SAFE }, lvar (),
1053                              list lvTkPLM (pair lvTkPM (lvar, tkind)) (),
1054                              lexp ())
1055                | t _ = raise Format                | t _ = raise Format
1056          in          in
1057              share tfundecM t              share tfundecM t
1058          end          end
1059    
1060          and fkind () = let          and fkind () = let
1061              val fkfct = {isrec=NONE, known=false, inline=F.IH_SAFE, cconv=F.CC_FCT}              fun aug_unknown x = (x, F.LK_UNKNOWN)
1062              fun fk #"2" = fkfct              fun inlflag true = F.IH_ALWAYS
1063                | fk #"3" = { isrec = Option.map (fn x => (x, F.LK_UNKNOWN)) (ltylistoption ()),                | 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 ())),                              cconv = F.CC_FUN(LT.ffc_var (bool (), bool ())),
1068                              known = bool (),                              known = bool (),
1069                              inline = if bool () then F.IH_ALWAYS else F.IH_SAFE}                              inline = inlflag (bool ()) }
1070                | fk #"4" = { isrec = Option.map (fn x => (x, F.LK_UNKNOWN)) (ltylistoption ()),                | fk #"4" = { isrec = Option.map aug_unknown (ltylistoption ()),
1071                              cconv = F.CC_FUN LT.ffc_fixed,                              cconv = F.CC_FUN LT.ffc_fixed,
1072                              known = bool (),                              known = bool (),
1073                              inline = if bool () then F.IH_ALWAYS else F.IH_SAFE}                              inline = inlflag (bool ()) }
1074                | fk _ = raise Format                | fk _ = raise Format
1075          in          in
1076              share fkindM fk              share fkindM fk
# Line 1110  Line 1137 
1137              mkEnvUnpickler (session, symbollist, sharedStuff,              mkEnvUnpickler (session, symbollist, sharedStuff,
1138                              c, fn () => raise Format)                              c, fn () => raise Format)
1139          val flint = mkFlintUnpickler (session, sharedStuff)          val flint = mkFlintUnpickler (session, sharedStuff)
1140          val symbind = UU.r_pair (pid, flint)          val pidFlintPM = UU.mkMap ()
1141            val symbind = UU.r_pair session pidFlintPM (pid, flint)
1142          val sblM = UU.mkMap ()          val sblM = UU.mkMap ()
1143          val sbl = UU.r_list session sblM symbind          val sbl = UU.r_list session sblM symbind
1144          fun symenvUnpickler () = SymbolicEnv.fromListi (sbl ())          fun symenvUnpickler () = SymbolicEnv.fromListi (sbl ())

Legend:
Removed from v.514  
changed lines
  Added in v.515

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