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/pickmod-new.sml
ViewVC logotype

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

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

revision 489, Tue Nov 23 12:55:00 1999 UTC revision 504, Tue Dec 7 18:31:05 1999 UTC
# Line 26  Line 26 
26               exportLvars: Access.lvar list,               exportLvars: Access.lvar list,
27               exportPid: PersStamps.persstamp option}               exportPid: PersStamps.persstamp option}
28    
29        (* Re-pickling is done for the purpose of getting the hash value
30         * of a "reduced" (filtered) version of another environment that
31         * has been pickled before.  During re-pickling, the LOCAL->GLOBAL
32         * translation for stamps and the LVAR->EXTERN translation for
33         * accesses is undone so that the resulting hash value is the
34         * same that one would have gotten if the current environment
35         * was pickled using "pickleEnv". The context for repickling is
36         * specified using a set of module IDs instead of an entire
37         * context environment.  The set will have to be obtained from the
38         * unpickling process of the original pickle. *)
39        val repickleEnvHash :
40            { context: ModuleId.Set.set,
41              env: StaticEnv.staticEnv,
42              orig_hash: PersStamps.persstamp } -> PersStamps.persstamp
43    
44      val pickleFLINT:      val pickleFLINT:
45          CompBasic.flint option          CompBasic.flint option
46          -> { hash: PersStamps.persstamp,          -> { hash: PersStamps.persstamp,
# Line 36  Line 51 
51      type map      type map
52      val emptyMap : map      val emptyMap : map
53    
54        type env'n'ctxt = { env: StaticEnv.staticEnv, ctxt: ModuleId.Set.set }
55    
56      val envPickler :      val envPickler :
57          ckey option context -> (map, StaticEnv.staticEnv) PickleUtil.pickler          ckey option context -> (map, env'n'ctxt) PickleUtil.pickler
58    
59      val symenvPickler : (map, SymbolicEnv.symenv) PickleUtil.pickler      val symenvPickler : (map, SymbolicEnv.symenv) PickleUtil.pickler
60    
# Line 398  Line 415 
415          share TKs tk x          share TKs tk x
416      end      end
417    
418      fun mkAccess lvar = let      fun mkAccess { lvar, isLocalPid } = let
419          val op $ = PU.$ A          val op $ = PU.$ A
420          fun access (A.LVAR i) = "A" $ lvar i          fun access (A.LVAR i) = "A" $ lvar i
421            | access (A.EXTERN p) = "B" $ pid p            | access (A.EXTERN p) = "B" $ pid p
422              | access (A.PATH (a as A.EXTERN p, i)) =
423                (* isLocalPid always returns false for in the "normal pickler"
424                 * case.  It returns true in the "repickle" case for the
425                 * pid that was the hash of the original whole pickle.
426                 * Since alpha-conversion has already taken place if we find
427                 * an EXTERN pid, we don't call "lvar" but "int". *)
428                if isLocalPid p then "A" $ int i
429                else "C" $ access a & int i
430            | access (A.PATH (a, i)) = "C" $ access a & int i            | access (A.PATH (a, i)) = "C" $ access a & int i
431            | access A.NO_ACCESS = % A "D"            | access A.NO_ACCESS = % A "D"
432    
# Line 482  Line 507 
507          val lvar = int o alphaConvert          val lvar = int o alphaConvert
508          val lty = lty alphaConvert          val lty = lty alphaConvert
509          val tyc = tyc alphaConvert          val tyc = tyc alphaConvert
510          val { access, conrep } = mkAccess lvar          val { access, conrep } = mkAccess { lvar = lvar,
511                                                isLocalPid = fn _ => false }
512          val op $ = PU.$ V          val op $ = PU.$ V
513          fun value (F.VAR v) = "a" $ lvar v          fun value (F.VAR v) = "a" $ lvar v
514            | value (F.INT i) = "b" $ int i            | value (F.INT i) = "b" $ int i
# Line 624  Line 649 
649        | NodeStub of int * Symbol.symbol        | NodeStub of int * Symbol.symbol
650    
651      (* the environment pickler *)      (* the environment pickler *)
652      fun mkEnvPickler (context0: stubinfo context) = let      fun mkEnvPickler (context0: stubinfo context, isLocalPid) = let
653    
654          val { lookTYC, lookSIG, lookFSIG, lookSTR, lookFCT, lookEENV } =          val { lookTYC, lookSIG, lookFSIG, lookSTR, lookFCT, lookEENV } =
655              context0              context0
# Line 636  Line 661 
661          in          in
662              case scope of              case scope of
663                  Stamps.LOCAL => "A" $ int (alphaConvert count)                  Stamps.LOCAL => "A" $ int (alphaConvert count)
664                | Stamps.GLOBAL p => "B" $ pid p & int count                | Stamps.GLOBAL p =>
665                        if isLocalPid p then "A" $ int count
666                        else "B" $ pid p & int count
667                | Stamps.SPECIAL s => "C" $ string s & int count                | Stamps.SPECIAL s => "C" $ string s & int count
668          end          end
669    
# Line 663  Line 690 
690              j              j
691          end          end
692    
693          val { access, conrep } = mkAccess (int o anotherLvar)          val { access, conrep } = mkAccess { lvar = int o anotherLvar,
694                                                isLocalPid = isLocalPid }
695    
696          fun spath (SP.SPATH p) = list symbol p          fun spath (SP.SPATH p) = list symbol p
697          fun ipath (IP.IPATH p) = list symbol p          fun ipath (IP.IPATH p) = list symbol p
# Line 1081  Line 1109 
1109          in          in
1110              list (pair (symbol, binding)) pairs              list (pair (symbol, binding)) pairs
1111          end          end
1112    
1113            fun env'n'ctxt { env = e, ctxt } =
1114                pair (env, list modId) (e, ModuleId.Set.listItems ctxt)
1115      in      in
1116          { pickler = env, exportLvarsGetter = fn () => rev (!lvlist) }          { pickler = env, pickler' = env'n'ctxt,
1117              exportLvarsGetter = fn () => rev (!lvlist) }
1118      end      end
1119    
1120      fun pickleEnv { context, env } = let      fun pickleEnv { context, env } = let
# Line 1098  Line 1130 
1130                    lookTYC = cvt CMStaticEnv.lookTYC,                    lookTYC = cvt CMStaticEnv.lookTYC,
1131                    lookEENV = cvt CMStaticEnv.lookEENV }                    lookEENV = cvt CMStaticEnv.lookEENV }
1132    
1133          val { pickler, exportLvarsGetter } = mkEnvPickler c          val { pickler, exportLvarsGetter, ... } =
1134                mkEnvPickler (c, fn _ => false)
1135          val pickle = Byte.stringToBytes (PU.pickle emptyMap (pickler env))          val pickle = Byte.stringToBytes (PU.pickle emptyMap (pickler env))
1136          val exportLvars = exportLvarsGetter ()          val exportLvars = exportLvarsGetter ()
1137    
# Line 1114  Line 1147 
1147            exportPid = exportPid }            exportPid = exportPid }
1148      end      end
1149    
1150        fun repickleEnvHash { context, env, orig_hash } = let
1151            fun lk i =
1152                if ModuleId.Set.member (context, i) then SimpleStub else NoStub
1153            val c = { lookSTR = lk, lookSIG = lk, lookFCT = lk,
1154                      lookFSIG = lk, lookTYC = lk, lookEENV = lk }
1155            fun isLocalPid p = PersStamps.compare (p, orig_hash) = EQUAL
1156            val { pickler, ... } = mkEnvPickler (c, isLocalPid)
1157            val pickle = Byte.stringToBytes (PU.pickle emptyMap (pickler env))
1158        in
1159            pickle2hash pickle
1160        end
1161    
1162        type env'n'ctxt = { env: StaticEnv.staticEnv, ctxt: ModuleId.Set.set }
1163    
1164      fun envPickler context = let      fun envPickler context = let
1165          val { lookSTR, lookSIG, lookFCT, lookFSIG, lookTYC, lookEENV } =          val { lookSTR, lookSIG, lookFCT, lookFSIG, lookTYC, lookEENV } =
1166              context              context
# Line 1128  Line 1175 
1175                    lookFSIG = cvt lookFSIG,                    lookFSIG = cvt lookFSIG,
1176                    lookTYC = cvt lookTYC,                    lookTYC = cvt lookTYC,
1177                    lookEENV = cvt lookEENV }                    lookEENV = cvt lookEENV }
1178          val { pickler, ... } = mkEnvPickler c          val { pickler', ... } = mkEnvPickler (c, fn _ => false)
1179      in      in
1180          pickler          pickler'
1181      end      end
1182    
1183      (* the dummy environment pickler *)      (* the dummy environment pickler *)

Legend:
Removed from v.489  
changed lines
  Added in v.504

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