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 901, Tue Aug 14 19:21:17 2001 UTC revision 902, Wed Aug 15 21:17:05 2001 UTC
# Line 56  Line 56 
56      val pickleFLINT: FLINT.prog option -> { hash: PersStamps.persstamp,      val pickleFLINT: FLINT.prog option -> { hash: PersStamps.persstamp,
57                                              pickle: Word8Vector.vector }                                              pickle: Word8Vector.vector }
58    
59      val symenvPickler : (map, SymbolicEnv.symenv) PickleUtil.pickler      val symenvPickler : (map, SymbolicEnv.env) PickleUtil.pickler
60    
61      val pickle2hash: Word8Vector.vector -> PersStamps.persstamp      val pickle2hash: Word8Vector.vector -> PersStamps.persstamp
62    
# Line 826  Line 826 
826    
827          and tyckind arg = let          and tyckind arg = let
828              val op $ = PU.$ TYCKIND              val op $ = PU.$ TYCKIND
829              fun tk (T.PRIMITIVE pt) = "a" $ [int (PT.pt_toint pt)]              fun tk (T.PRIMITIVE pt) = "a" $ [int pt]
830                | tk (T.DATATYPE { index, family, stamps, root,freetycs }) =                | tk (T.DATATYPE { index, family, stamps, root,freetycs }) =
831                  "b" $ [int index, option entVar root,                  "b" $ [int index, option entVar root,
832                         dtypeInfo (stamps, family, freetycs)]                         dtypeInfo (stamps, family, freetycs)]
# Line 856  Line 856 
856    
857          and dtFamily x = let          and dtFamily x = let
858              val op $ = PU.$ DTF              val op $ = PU.$ DTF
859              fun dtf_raw { mkey, members, lambdatyc } =              fun dtf_raw { mkey, members, properties } =
860                  "b" $ [stamp mkey,                  "b" $ [stamp mkey,
861                         list dtmember (Vector.foldr (op ::) [] members)]                         list dtmember (Vector.foldr (op ::) [] members)]
862          in          in
# Line 926  Line 926 
926          end          end
927    
928          val op $ = PU.$ II          val op $ = PU.$ II
929          fun inl_info (II.INL_PRIM (p, t)) = "A" $ [primop p, ty t]          fun inl_info i =
930            | inl_info (II.INL_STR sl) = "B" $ [list inl_info sl]              II.match i { inl_prim = fn (p, t) => "A" $ [primop p, ty t],
931            | inl_info II.INL_NO = "C" $ []                           inl_str = fn sl => "B" $ [list inl_info sl],
932            | inl_info _ = bug "unexpected inl_info in pickmod"                           inl_no = fn () => "C" $ [] }
933    
934          val op $ = PU.$ VAR          val op $ = PU.$ VAR
935          fun var (V.VALvar { access = a, info, path, typ = ref t }) =          fun var (V.VALvar { access = a, info, path, typ = ref t }) =
# Line 967  Line 967 
967                           fun sig_raw (s: M.sigrec) = let                           fun sig_raw (s: M.sigrec) = let
968                               val { stamp = sta, name, closed,                               val { stamp = sta, name, closed,
969                                     fctflag, symbols, elements,                                     fctflag, symbols, elements,
970                                     boundeps = ref b,                                     properties,
971                                     lambdaty = _, stub,                                     (* boundeps = ref b, *)
972                                     typsharing, strsharing } = s                                     (* lambdaty = _, *)
973                                       stub, typsharing, strsharing } = s
974                                 val b = ModulePropLists.sigBoundeps s
975                               val b = NONE (* currently turned off *)                               val b = NONE (* currently turned off *)
976                           in                           in
977                               "C" $ ([stamp sta,                               "C" $ ([stamp sta,
# Line 1147  Line 1149 
1149            | entityEnv M.NILeenv = "B" $ []            | entityEnv M.NILeenv = "B" $ []
1150            | entityEnv M.ERReenv = "C" $ []            | entityEnv M.ERReenv = "C" $ []
1151    
1152          and strEntity { stamp = s, entities, lambdaty = _, rpath, stub } =          and strEntity { stamp = s, entities, properties, rpath, stub } =
1153              let val op $ = PU.$ SEN              let val op $ = PU.$ SEN
1154              in              in
1155                  "s" $ ([stamp s, entityEnv entities, ipath rpath]                  "s" $ ([stamp s, entityEnv entities, ipath rpath]
# Line 1156  Line 1158 
1158    
1159          and shStrEntity id = share (STRs id) strEntity          and shStrEntity id = share (STRs id) strEntity
1160    
1161          and fctEntity { stamp = s, closure, lambdaty, tycpath, rpath, stub } =          and fctEntity { stamp = s,
1162                            closure, properties, tycpath, rpath, stub } =
1163              let val op $ = PU.$ FEN              let val op $ = PU.$ FEN
1164              in              in
1165                  "f" $ ([stamp s, fctClosure closure, ipath rpath]                  "f" $ ([stamp s, fctClosure closure, ipath rpath]
# Line 1181  Line 1184 
1184            | binding (B.FIXbind x) = "8" $ [fixity x]            | binding (B.FIXbind x) = "8" $ [fixity x]
1185    
1186          fun env e = let          fun env e = let
1187              val syms = ListMergeSort.uniqueSort symCmp (Env.symbols e)              val syms = ListMergeSort.uniqueSort symCmp (StaticEnv.symbols e)
1188              val pairs = map (fn s => (s, StaticEnv.look (e, s))) syms              val pairs = map (fn s => (s, StaticEnv.look (e, s))) syms
1189          in          in
1190              list (pair (symbol, binding)) pairs              list (pair (symbol, binding)) pairs
# Line 1221  Line 1224 
1224                  0w0,0w0,0w0,toByte(w >> 0w8),0w0,0w0,0w0,toByte(w)])                  0w0,0w0,0w0,toByte(w >> 0w8),0w0,0w0,0w0,toByte(w)])
1225          end          end
1226          (* next line is an alternative to using Env.consolidate *)          (* next line is an alternative to using Env.consolidate *)
1227          val syms = ListMergeSort.uniqueSort symCmp (Env.symbols senv)          val syms = ListMergeSort.uniqueSort symCmp (StaticEnv.symbols senv)
1228          fun newAccess i = A.PATH (A.EXTERN hash, i)          fun newAccess i = A.PATH (A.EXTERN hash, i)
1229          fun mapbinding (sym, (i, env, lvars)) =          fun mapbinding (sym, (i, env, lvars)) =
1230              case StaticEnv.look (senv, sym) of              case StaticEnv.look (senv, sym) of

Legend:
Removed from v.901  
changed lines
  Added in v.902

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