Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Tracker SCM

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

Legend:
Removed from v.44  
changed lines
  Added in v.45

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