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

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

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

revision 23, Thu Mar 12 00:49:56 1998 UTC revision 24, Thu Mar 12 00:49:58 1998 UTC
# Line 7  Line 7 
7          SCStaticEnv.staticEnv * StaticEnv.staticEnv          SCStaticEnv.staticEnv * StaticEnv.staticEnv
8                    -> {hash: PersStamps.persstamp,                    -> {hash: PersStamps.persstamp,
9                        pickle: Word8Vector.vector,                        pickle: Word8Vector.vector,
10                        exportLvars: Access.lvar list,                        exportLvars: Lambda.lvar list,
11                        exportPid: PersStamps.persstamp option}                        exportPid: PersStamps.persstamp option}
12    val pickleFLINT:  
13          CompBasic.flint option ->    val pickleLambda:
14            Lambda.lexp option ->
15              {hash: PersStamps.persstamp, pickle: Word8Vector.vector}              {hash: PersStamps.persstamp, pickle: Word8Vector.vector}
16    
17    val pickle2hash: Word8Vector.vector -> PersStamps.persstamp    val pickle2hash: Word8Vector.vector -> PersStamps.persstamp
# Line 18  Line 19 
19    val dontPickle :    val dontPickle :
20          StaticEnv.staticEnv * int          StaticEnv.staticEnv * int
21                    -> StaticEnv.staticEnv * PersStamps.persstamp *                    -> StaticEnv.staticEnv * PersStamps.persstamp *
22                       Access.lvar list * PersStamps.persstamp option                       Lambda.lvar list * PersStamps.persstamp option
23    
24    val debugging : bool ref    val debugging : bool ref
25    val debuggingSW : bool ref    val debuggingSW : bool ref
# Line 35  Line 36 
36        structure ED = EntPath.EvDict        structure ED = EntPath.EvDict
37        structure II = InlInfo        structure II = InlInfo
38        structure IP = InvPath        structure IP = InvPath
39        structure F  = FLINT        structure L  = Lambda
40        structure LK = LtyKernel  (* structure LT = LtyDef *)        structure LK = LtyKernel  (* structure LT = LtyDef *)
41        (** pickmod must look under the abstract lty representation *)        (** pickmod must look under the abstract lty representation *)
42        structure M  = Modules        structure M  = Modules
# Line 223  Line 224 
224    | primop (P.INL_MONOARRAY k) () = "Mj" $ [numkind k]    | primop (P.INL_MONOARRAY k) () = "Mj" $ [numkind k]
225    | primop (P.INL_MONOVECTOR k) () = "Vj" $ [numkind k]    | primop (P.INL_MONOVECTOR k) () = "Vj" $ [numkind k]
226    
   | primop (P.MKETAG) () = "Xj" $ []  
   | primop (P.WRAP) () = "Yj" $ []  
   | primop (P.UNWRAP) () = "Zj" $ []  
   
227    | primop P.SUBSCRIPT () = "ak" $ []    | primop P.SUBSCRIPT () = "ak" $ []
228    | primop P.SUBSCRIPTV () = "bk" $ []    | primop P.SUBSCRIPTV () = "bk" $ []
229    | primop P.INLSUBSCRIPT () = "ck" $ []    | primop P.INLSUBSCRIPT () = "ck" $ []
# Line 282  Line 279 
279    | primop P.INL_VECTOR () = "/k" $ []    | primop P.INL_VECTOR () = "/k" $ []
280    | primop P.ISOLATE () = ":k" $ []    | primop P.ISOLATE () = ":k" $ []
281    
   
282  fun consig (A.CSIG(i,j)) () = "S8" $ [W.int i, W.int j]  fun consig (A.CSIG(i,j)) () = "S8" $ [W.int i, W.int j]
283    | consig (A.CNIL) () = "N8" $ []    | consig (A.CNIL) () = "N8" $ []
284    
# Line 376  Line 372 
372                   "I6" $ [int n, tyc tc, list tyc ts, int i]                   "I6" $ [int n, tyc tc, list tyc ts, int i]
373               | LK.TC_ABS tc => "J6" $ [tyc tc]               | LK.TC_ABS tc => "J6" $ [tyc tc]
374               | LK.TC_BOX tc => "K6" $ [tyc tc]               | LK.TC_BOX tc => "K6" $ [tyc tc]
375               | LK.TC_TUPLE (_,l) => "L6" $ [list tyc l]               | LK.TC_TUPLE l => "L6" $ [list tyc l]
376               | LK.TC_ARROW ((b1,b2),ts1,ts2) =>               | LK.TC_ARROW ((b1,b2),ts1,ts2) =>
377                   "M6" $ [bool b1, bool b2, list tyc ts1, list tyc ts2]                   "M6" $ [bool b1, bool b2, list tyc ts1, list tyc ts2]
378               | LK.TC_PARROW _ =>               | LK.TC_PARROW _ =>
# Line 401  Line 397 
397                of LK.TK_MONO => "A7" $ []                of LK.TK_MONO => "A7" $ []
398                 | LK.TK_BOX => "B7" $ []                 | LK.TK_BOX => "B7" $ []
399                 | LK.TK_SEQ ks => "C7" $ [list tkind ks]                 | LK.TK_SEQ ks => "C7" $ [list tkind ks]
400                 | LK.TK_FUN(ks,k) => "D7" $ [list tkind ks, tkind k])                 | LK.TK_FUN(k1,k2) => "D7" $ [tkind k1, tkind k2])
401    
402       in {lty=lty,tyc=tyc,tkind=tkind}       in {lty=lty,tyc=tyc,tkind=tkind}
403      end      end
404    
405  fun pickleFLINT fdecOp =  fun pickleLambda leOp =
406    let val alphaConvert = alphaConverter()    let val alphaConvert = alphaConverter()
407        val stamp = mkStamp alphaConvert        val stamp = mkStamp alphaConvert
408        val lvar = int o alphaConvert        val lvar = int o alphaConvert
# Line 414  Line 410 
410        val {access,conrep} = mkAccess lvar        val {access,conrep} = mkAccess lvar
411        val {lty,tyc,tkind} = mkPickleLty(stamp,tvar)        val {lty,tyc,tkind} = mkPickleLty(stamp,tvar)
412    
413        fun con (F.DATAcon (dc, ts, v), e) () =        fun con (L.DATAcon (s, cr, t), e) () =
414              ".5" $ [dcon (dc, ts), lvar v, lexp e]              ".5" $ [symbol s, conrep cr, lty t, lexp e]
415          | con (F.INTcon i, e) ()           = ",5" $ [int i, lexp e]          | con (L.INTcon i, e) ()           = ",5" $ [int i, lexp e]
416          | con (F.INT32con i32, e) ()       = "=5" $ [int32 i32, lexp e]          | con (L.INT32con i32, e) ()       = "=5" $ [int32 i32, lexp e]
417          | con (F.WORDcon w, e) ()          = "?5" $ [word w, lexp e]          | con (L.WORDcon w, e) ()          = "?5" $ [word w, lexp e]
418          | con (F.WORD32con w32, e) ()      = ">5" $ [word32 w32, lexp e]          | con (L.WORD32con w32, e) ()      = ">5" $ [word32 w32, lexp e]
419          | con (F.REALcon s, e) ()          = "<5" $ [W.string s, lexp e]          | con (L.REALcon s, e) ()          = "<5" $ [W.string s, lexp e]
420          | con (F.STRINGcon s, e) ()        = "'5" $ [W.string s, lexp e]          | con (L.STRINGcon s, e) ()        = "'5" $ [W.string s, lexp e]
421          | con (F.VLENcon i, e) ()          = ";5" $ [int i, lexp e]          | con (L.VLENcon i, e) ()          = ";5" $ [int i, lexp e]
   
       and dcon ((s, cr, t), ts) () =  
             "^5" $ [symbol s, conrep cr, lty t, list tyc ts]  
422    
423        and dict {default=v, table=tbls} () =        and dict {default=v, table=tbls} () =
424              "%5" $ [lvar v, list (tuple2 (list tyc, lvar)) tbls]              "%5" $ [lvar v, list (tuple2 (list tyc, lvar)) tbls]
425    
426        and value (F.VAR v) ()               = "a5" $ [lvar v]        and sval (L.VAR v) ()               = "a5" $ [lvar v]
427          | value (F.INT i) ()               = "b5" $ [int i]          | sval (L.INT i) ()               = "b5" $ [int i]
428          | value (F.INT32 i32) ()           = "c5" $ [int32 i32]          | sval (L.INT32 i32) ()           = "z5" $ [int32 i32]
429          | value (F.WORD w) ()              = "d5" $ [word w]          | sval (L.WORD w) ()              = "c5" $ [word w]
430          | value (F.WORD32 w32) ()          = "e5" $ [word32 w32]          | sval (L.WORD32 w32) ()          = "d5" $ [word32 w32]
431          | value (F.REAL s) ()              = "f5" $ [W.string s]          | sval (L.REAL s) ()              = "e5" $ [W.string s]
432          | value (F.STRING s) ()            = "g5" $ [W.string s]          | sval (L.STRING s) ()            = "f5" $ [W.string s]
433            | sval (L.PRIM (p, t, ts)) ()     =
434        and fprim (NONE, p, t, ts) () =              "g5" $ [primop p, lty t, list tyc ts]
435              "h5" $ [primop p, lty t, list tyc ts]          | sval (L.GENOP (dt, p, t, ts)) ()   =
436          | fprim (SOME dt, p, t, ts) () =              "h5" $ [dict dt, primop p, lty t, list tyc ts]
437              "i5" $ [dict dt, primop p, lty t, list tyc ts]  
438          and lexp (L.SVAL sv) ()             = "i5" $ [sval sv]
439        and lexp (F.RET vs) () = "j5" $ [list value vs]          | lexp (L.FN (v, t, e)) ()        = "j5" $ [lvar v, lty t, lexp e]
440          | lexp (F.LET(vs, e1, e2)) () =          | lexp (L.FIX (vl, tl, el, e)) () =
441              "k5" $ [list lvar vs, lexp e1, lexp e2]              "k5" $ [list lvar vl, list lty tl, list lexp el, lexp e]
442          | lexp (F.FIX (fdecs, e)) () = "l5" $ [list fundec fdecs, lexp e]          | lexp (L.APP (v1, v2)) ()        = "l5" $ [sval v1, sval v2]
443          | lexp (F.APP (v, vs)) () = "m5" $ [value v, list value vs]          | lexp (L.SWITCH (v, crl, cel, eo)) () =
444          | lexp (F.TFN(tfdec, e)) () =              "m5" $ [sval v, consig crl, list con cel, option lexp eo]
445              "n5" $ [tfundec tfdec, lexp e]          | lexp (L.CON ((s, cr, t), ts, v)) () =
446          | lexp (F.TAPP(v, ts)) () =              "n5" $ [symbol s, conrep cr, lty t, list tyc ts, sval v]
447              "o5" $ [value v, list tyc ts]          | lexp (L.DECON ((s, cr, t), ts, v)) () =
448          | lexp (F.SWITCH (v, crl, cel, eo)) () =              "o5" $ [symbol s, conrep cr, lty t, list tyc ts, sval v]
449              "p5" $ [value v, consig crl, list con cel, option lexp eo]          | lexp (L.VECTOR (vl, t)) ()           = "p5" $ [list sval vl, tyc t]
450          | lexp (F.CON (dc, ts, u, v, e)) () =          | lexp (L.RECORD vl) ()           = "q5" $ [list sval vl]
451              "q5" $ [dcon(dc, ts), value u, lvar v, lexp e]          | lexp (L.SRECORD vl) ()          = "r5" $ [list sval vl]
452          | lexp (F.RECORD(rk, vl, v, e)) () =          | lexp (L.RAISE (v, t)) ()        = "s5" $ [sval v, lty t]
453              "r5" $ [rkind rk, list value vl, lvar v, lexp e]          | lexp (L.HANDLE (e, v)) ()     = "t5" $ [lexp e, sval v]
454          | lexp (F.SELECT (u, i, v, e)) () =          | lexp (L.WRAP (t, b, v)) ()         = "u5" $ [tyc t, bool b, sval v]
455              "s5" $ [value u, int i, lvar v, lexp e]          | lexp (L.UNWRAP (t, b, v)) ()       = "v5" $ [tyc t, bool b, sval v]
456          | lexp (F.RAISE (u, ts)) () = "t5" $ [value u, list lty ts]          | lexp (L.SELECT (i, v)) ()       = "w5" $ [int i, sval v]
457          | lexp (F.HANDLE (e, u)) () = "u5" $ [lexp e, value u]  
458          | lexp (F.BRANCH (p, vs, e1, e2)) () =          | lexp (L.TFN(ks, e)) ()          = "x5" $ [list tkind ks, lexp e]
459              "v5" $ [fprim p, list value vs, lexp e1, lexp e2]          | lexp (L.TAPP(v, ts)) ()         = "y5" $ [sval v, list tyc ts]
460          | lexp (F.PRIMOP (p, vs, v, e)) () =          | lexp (L.LET(v, e1, e2)) ()      = "05" $ [lvar v, lexp e1, lexp e2]
461              "w5" $ [fprim p, list value vs, lvar v, lexp e]          | lexp (L.PACK(t, ts, nts, v)) ()         =
462                "15" $ [lty t, list tyc ts, list tyc nts, sval v]
463        and fundec (fk, v, vts, e) () =          | lexp (L.ETAG (v, t)) ()         = "25" $ [sval v, lty t]
             "05" $ [fkind fk, lvar v, list (tuple2(lvar, lty)) vts, lexp e]  
   
       and tfundec (v, tvks, e) () =  
             "15" $ [lvar v, list (tuple2(tvar, tkind)) tvks, lexp e]  
   
       and fkind (F.FK_FCT) () = "25" $ []  
         | fkind (F.FK_FUN {isrec, fixed=(b1, b2), known, inline}) () =  
             "35" $ [option (list lty) isrec, bool b1, bool b2, bool known,  
                     bool inline]  
   
       and rkind (F.RK_VECTOR tc) () = "45" $ [tyc tc]  
         | rkind (F.RK_STRUCT) () = "55" $ []  
         | rkind (F.RK_TUPLE _) () = "65" $ []  
464    
465        val prog = fundec        val pickle = W.pickle (option lexp leOp)
       val pickle = W.pickle (option prog fdecOp)  
466        val hash = pickle2hash pickle        val hash = pickle2hash pickle
467     in {pickle = pickle, hash = hash}     in {pickle = pickle, hash = hash}
468    end    end
# Line 507  Line 486 
486        | modId (MI.EENVid s) () = "Vf" $ [stamp s]        | modId (MI.EENVid s) () = "Vf" $ [stamp s]
487    
488      val lvcount = ref 0      val lvcount = ref 0
489      val lvlist = ref ([]: Access.lvar list)      val lvlist = ref ([]: LambdaVar.lvar list)
490    
491      fun anotherLvar v =      fun anotherLvar v =
492        let val j = !lvcount        let val j = !lvcount

Legend:
Removed from v.23  
changed lines
  Added in v.24

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