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/branches/SMLNJ/src/compiler/Semant/pickle/pickmod-new.sml
ViewVC logotype

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

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

revision 497, Tue Dec 7 15:44:50 1999 UTC revision 498, Tue Dec 7 15:44:50 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 386  Line 403 
403          cs arg          cs arg
404      end      end
405    
406      fun mkAccess lvar = let      fun mkAccess { lvar, isLocalPid } = let
407          val op $ = PU.$ A          val op $ = PU.$ A
408          fun access (A.LVAR i) = "A" $ lvar i          fun access (A.LVAR i) = "A" $ lvar i
409            | access (A.EXTERN p) = "B" $ pid p            | access (A.EXTERN p) = "B" $ pid p
410              | access (A.PATH (a as A.EXTERN p, i)) =
411                (* isLocalPid always returns false for in the "normal pickler"
412                 * case.  It returns true in the "repickle" case for the
413                 * pid that was the hash of the original whole pickle.
414                 * Since alpha-conversion has already taken place if we find
415                 * an EXTERN pid, we don't call "lvar" but "int". *)
416                if isLocalPid p then "A" $ int i
417                else "C" $ access a & int i
418            | access (A.PATH (a, i)) = "C" $ access a & int i            | access (A.PATH (a, i)) = "C" $ access a & int i
419            | access A.NO_ACCESS = % A "D"            | access A.NO_ACCESS = % A "D"
420    
# Line 475  Line 500 
500      fun flint flint_exp = let      fun flint flint_exp = let
501          val alphaConvert = mkAlphaConvert ()          val alphaConvert = mkAlphaConvert ()
502          val lvar = int o alphaConvert          val lvar = int o alphaConvert
503          val { access, conrep } = mkAccess lvar          val { access, conrep } = mkAccess { lvar = lvar,
504                                                isLocalPid = fn _ => false }
505          val op $ = PU.$ V          val op $ = PU.$ V
506          fun value (F.VAR v) = "a" $ lvar v          fun value (F.VAR v) = "a" $ lvar v
507            | value (F.INT i) = "b" $ int i            | value (F.INT i) = "b" $ int i
# Line 615  Line 640 
640        | NodeStub of int * Symbol.symbol        | NodeStub of int * Symbol.symbol
641    
642      (* the environment pickler *)      (* the environment pickler *)
643      fun mkEnvPickler (context0: stubinfo context) = let      fun mkEnvPickler (context0: stubinfo context, isLocalPid) = let
644    
645          val { lookTYC, lookSIG, lookFSIG, lookSTR, lookFCT, lookEENV } =          val { lookTYC, lookSIG, lookFSIG, lookSTR, lookFCT, lookEENV } =
646              context0              context0
# Line 627  Line 652 
652          in          in
653              case scope of              case scope of
654                  Stamps.LOCAL => "A" $ int (alphaConvert count)                  Stamps.LOCAL => "A" $ int (alphaConvert count)
655                | Stamps.GLOBAL p => "B" $ pid p & int count                | Stamps.GLOBAL p =>
656                        if isLocalPid p then "A" $ int count
657                        else "B" $ pid p & int count
658                | Stamps.SPECIAL s => "C" $ string s & int count                | Stamps.SPECIAL s => "C" $ string s & int count
659          end          end
660    
# Line 654  Line 681 
681              j              j
682          end          end
683    
684          val { access, conrep } = mkAccess (int o anotherLvar)          val { access, conrep } = mkAccess { lvar = int o anotherLvar,
685                                                isLocalPid = isLocalPid }
686    
687          fun spath (SP.SPATH p) = list symbol p          fun spath (SP.SPATH p) = list symbol p
688          fun ipath (IP.IPATH p) = list symbol p          fun ipath (IP.IPATH p) = list symbol p
# Line 1072  Line 1100 
1100          in          in
1101              list (pair (symbol, binding)) pairs              list (pair (symbol, binding)) pairs
1102          end          end
1103    
1104            fun env'n'ctxt { env = e, ctxt } =
1105                pair (env, list modId) (e, ModuleId.Set.listItems ctxt)
1106      in      in
1107          { pickler = env, exportLvarsGetter = fn () => rev (!lvlist) }          { pickler = env, pickler' = env'n'ctxt,
1108              exportLvarsGetter = fn () => rev (!lvlist) }
1109      end      end
1110    
1111      fun pickleEnv { context, env } = let      fun pickleEnv { context, env } = let
# Line 1089  Line 1121 
1121                    lookTYC = cvt CMStaticEnv.lookTYC,                    lookTYC = cvt CMStaticEnv.lookTYC,
1122                    lookEENV = cvt CMStaticEnv.lookEENV }                    lookEENV = cvt CMStaticEnv.lookEENV }
1123    
1124          val { pickler, exportLvarsGetter } = mkEnvPickler c          val { pickler, exportLvarsGetter, ... } =
1125                mkEnvPickler (c, fn _ => false)
1126          val pickle = Byte.stringToBytes (PU.pickle emptyMap (pickler env))          val pickle = Byte.stringToBytes (PU.pickle emptyMap (pickler env))
1127          val exportLvars = exportLvarsGetter ()          val exportLvars = exportLvarsGetter ()
1128    
# Line 1105  Line 1138 
1138            exportPid = exportPid }            exportPid = exportPid }
1139      end      end
1140    
1141        fun repickleEnvHash { context, env, orig_hash } = let
1142            fun lk i =
1143                if ModuleId.Set.member (context, i) then SimpleStub else NoStub
1144            val c = { lookSTR = lk, lookSIG = lk, lookFCT = lk,
1145                      lookFSIG = lk, lookTYC = lk, lookEENV = lk }
1146            fun isLocalPid p = PersStamps.compare (p, orig_hash) = EQUAL
1147            val { pickler, ... } = mkEnvPickler (c, isLocalPid)
1148            val pickle = Byte.stringToBytes (PU.pickle emptyMap (pickler env))
1149        in
1150            pickle2hash pickle
1151        end
1152    
1153        type env'n'ctxt = { env: StaticEnv.staticEnv, ctxt: ModuleId.Set.set }
1154    
1155      fun envPickler context = let      fun envPickler context = let
1156          val { lookSTR, lookSIG, lookFCT, lookFSIG, lookTYC, lookEENV } =          val { lookSTR, lookSIG, lookFCT, lookFSIG, lookTYC, lookEENV } =
1157              context              context
# Line 1119  Line 1166 
1166                    lookFSIG = cvt lookFSIG,                    lookFSIG = cvt lookFSIG,
1167                    lookTYC = cvt lookTYC,                    lookTYC = cvt lookTYC,
1168                    lookEENV = cvt lookEENV }                    lookEENV = cvt lookEENV }
1169          val { pickler, ... } = mkEnvPickler c          val { pickler', ... } = mkEnvPickler (c, fn _ => false)
1170      in      in
1171          pickler          pickler'
1172      end      end
1173    
1174      (* the dummy environment pickler *)      (* the dummy environment pickler *)

Legend:
Removed from v.497  
changed lines
  Added in v.498

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