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 587, Thu Mar 30 09:01:52 2000 UTC revision 774, Wed Jan 10 12:50:56 2001 UTC
# Line 9  Line 9 
9   * of sharing there can be significant overlap--and space overhead--in what   * of sharing there can be significant overlap--and space overhead--in what
10   * each such map points to.  Modtrees do not have these problems.)   * each such map points to.  Modtrees do not have these problems.)
11   *   *
12     * The embedding of modtrees into static environments follows the example
13     * of the control-flow in the original "cmstatenv.sml" module.  This means
14     * that not all possible branches of the environment data structure are
15     * explored when building modmaps.  I dearly hope that the original code
16     * was correct in its assumptions...
17     *
18   * March 2000, Matthias Blume   * March 2000, Matthias Blume
19   *)   *)
20  signature UNPICKMOD = sig  signature UNPICKMOD = sig
21    
22      type context = (string list * Symbol.symbol) option -> ModuleId.tmap      type context = (int * Symbol.symbol) option -> ModuleId.tmap
23    
24      val unpickleEnv : context ->      val unpickleEnv : context ->
25                        PersStamps.persstamp * Word8Vector.vector ->                        PersStamps.persstamp * Word8Vector.vector ->
# Line 37  Line 43 
43    
44  structure UnpickMod : UNPICKMOD = struct  structure UnpickMod : UNPICKMOD = struct
45    
46      type context = (string list * Symbol.symbol) option -> ModuleId.tmap      type context = (int * Symbol.symbol) option -> ModuleId.tmap
47    
48      structure A = Access      structure A = Access
49      structure DI = DebIndex      structure DI = DebIndex
# Line 125  Line 131 
131            P.GET_SEQ_DATA,            P.GET_SEQ_DATA,
132            P.SUBSCRIPT_REC,            P.SUBSCRIPT_REC,
133            P.SUBSCRIPT_RAW64,            P.SUBSCRIPT_RAW64,
134            P.UNBOXEDASSIGN]            P.UNBOXEDASSIGN,
135              P.RAW_CCALL NONE]
136    
137      val cmpop_table =      val cmpop_table =
138          #[P.>, P.>=, P.<, P.<=, P.LEU, P.LTU, P.GEU, P.GTU, P.EQL, P.NEQ]          #[P.>, P.>=, P.<, P.<=, P.LEU, P.LTU, P.GEU, P.GTU, P.EQL, P.NEQ]
139    
140      val arithop_table =      val arithop_table =
141          #[P.+, P.-, P.*, P./, P.~, P.ABS, P.LSHIFT, P.RSHIFT, P.RSHIFTL,          #[P.+, P.-, P.*, P./, P.~, P.ABS, P.LSHIFT, P.RSHIFT, P.RSHIFTL,
142            P.ANDB, P.ORB, P.XORB, P.NOTB]            P.ANDB, P.ORB, P.XORB, P.NOTB, P.FSQRT, P.FSIN, P.FCOS, P.FTAN]
143    
144      val eqprop_table =      val eqprop_table =
145          #[T.YES, T.NO, T.IND, T.OBJ, T.DATA, T.ABS, T.UNDEF]          #[T.YES, T.NO, T.IND, T.OBJ, T.DATA, T.ABS, T.UNDEF]
146    
147        val ctype_table =
148            #[CTypes.C_void,
149              CTypes.C_float,
150              CTypes.C_double,
151              CTypes.C_long_double,
152              CTypes.C_unsigned CTypes.I_char,
153              CTypes.C_unsigned CTypes.I_short,
154              CTypes.C_unsigned CTypes.I_int,
155              CTypes.C_unsigned CTypes.I_long,
156              CTypes.C_unsigned CTypes.I_long_long,
157              CTypes.C_signed CTypes.I_char,
158              CTypes.C_signed CTypes.I_short,
159              CTypes.C_signed CTypes.I_int,
160              CTypes.C_signed CTypes.I_long,
161              CTypes.C_signed CTypes.I_long_long,
162              CTypes.C_PTR]
163    
164      fun & c (x, t) = (c x, t)      fun & c (x, t) = (c x, t)
165    
166      fun branch l = let      fun branch l = let
# Line 159  Line 183 
183          val int = UU.r_int session          val int = UU.r_int session
184          val bool = UU.r_bool session          val bool = UU.r_bool session
185          fun list m r = UU.r_list session m r          fun list m r = UU.r_list session m r
186            fun option m r = UU.r_option session m r
187          val string = UU.r_string session          val string = UU.r_string session
188          val symbol = UnpickleSymPid.r_symbol (session, string)          val symbol = UnpickleSymPid.r_symbol (session, string)
189    
# Line 170  Line 195 
195          val nkM = UU.mkMap ()          val nkM = UU.mkMap ()
196          val poM = UU.mkMap ()          val poM = UU.mkMap ()
197          val boolListM = UU.mkMap ()          val boolListM = UU.mkMap ()
198            val boolOptionM = UU.mkMap ()
199          val tkindM = UU.mkMap ()          val tkindM = UU.mkMap ()
200          val tkindListM = UU.mkMap ()          val tkindListM = UU.mkMap ()
201            val ctypeM = UU.mkMap ()
202            val ctypeListM = UU.mkMap ()
203            val cciM = UU.mkMap ()
204    
205          val boollist = list boolListM bool          val boollist = list boolListM bool
206            val booloption = option boolOptionM bool
207    
208          val pid = UnpickleSymPid.r_pid (session, string)          val pid = UnpickleSymPid.r_pid (session, string)
209    
# Line 248  Line 278 
278              nonshare co              nonshare co
279          end          end
280    
281            fun ctype () = let
282                fun ct #"\020" = CTypes.C_ARRAY (ctype (), int ())
283                  | ct #"\021" = CTypes.C_STRUCT (ctypelist ())
284                  | ct c =
285                    Vector.sub (ctype_table, Char.ord c)
286                    handle General.Subscript => raise Format
287            in
288                share ctypeM ct
289            end
290    
291            and ctypelist () = list ctypeListM ctype ()
292    
293            fun ccall_info () = let
294                fun cp #"C" =
295                    { c_proto = { conv = string (),
296                                  retTy = ctype (),
297                                  paramTys = ctypelist () },
298                      ml_flt_args = boollist (),
299                      ml_flt_res_opt = booloption () }
300                  | cp _ = raise Format
301            in
302                share cciM cp
303            end
304    
305          fun primop () = let          fun primop () = let
306              fun po #"\100" = P.ARITH { oper = arithop (), overflow = bool (),              fun po #"\100" = P.ARITH { oper = arithop (), overflow = bool (),
307                                         kind = numkind () }                                         kind = numkind () }
# Line 271  Line 325 
325                                             checked = bool () }                                             checked = bool () }
326                | po #"\114" = P.INL_MONOARRAY (numkind ())                | po #"\114" = P.INL_MONOARRAY (numkind ())
327                | po #"\115" = P.INL_MONOVECTOR (numkind ())                | po #"\115" = P.INL_MONOVECTOR (numkind ())
328                  | po #"\116" = P.RAW_LOAD (numkind ())
329                  | po #"\117" = P.RAW_STORE (numkind ())
330                  | po #"\118" = P.RAW_CCALL (SOME (ccall_info ()))
331                | po c =                | po c =
332                  Vector.sub (primop_table, Char.ord c)                  Vector.sub (primop_table, Char.ord c)
333                  handle General.Subscript => raise Format                  handle General.Subscript => raise Format
# Line 382  Line 439 
439          val { pid, string, symbol, access, conrep, consig,          val { pid, string, symbol, access, conrep, consig,
440                primop, boollist, tkind, tkindlist } = sharedStuff                primop, boollist, tkind, tkindlist } = sharedStuff
441    
442          fun libModSpec () =          fun libModSpec () = option lmsOptM (pair lmsPairM (int, symbol)) ()
             option lmsOptM (pair lmsPairM (stringlist, symbol)) ()  
443    
444          fun stamp () = let          fun stamp () = let
445              fun st #"A" = Stamps.global { pid = globalPid (),              fun st #"A" = Stamps.global { pid = globalPid (),
# Line 600  Line 656 
656          end          end
657    
658          and inl_info () = let          and inl_info () = let
659              fun ii #"A" = II.INL_PRIM (primop (), tyoption ())              fun ii #"A" = II.INL_PRIM (primop (), ty ())
660                | ii #"B" = II.INL_STR (iilist ())                | ii #"B" = II.INL_STR (iilist ())
661                | ii #"C" = II.INL_NO                | ii #"C" = II.INL_NO
662                | ii _ = raise Format                | ii _ = raise Format

Legend:
Removed from v.587  
changed lines
  Added in v.774

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