CVS: sml-dist/src/compiler/Semant/pickle pickmod-new.sml, 1.27.4.3, 1.27.4.4 unpickmod-new.sml, 1.24.4.4, 1.24.4.5
David MacQueen <[email protected]> Fri, 11 Aug 2006 13:42:26 -0700
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/compiler/Semant/pickle
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv18989/src/compiler/Semant/pickle
Modified Files:
Tag: primop-branch-2
pickmod-new.sml unpickmod-new.sml
Log Message:
broke ltykernel into lty and ltykernel, improved pplty
Index: pickmod-new.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/Semant/pickle/pickmod-new.sml,v
retrieving revision 1.27.4.3
retrieving revision 1.27.4.4
diff -C2 -d -r1.27.4.3 -r1.27.4.4
*** pickmod-new.sml 12 Jul 2006 15:43:13 -0000 1.27.4.3
--- pickmod-new.sml 11 Aug 2006 20:42:24 -0000 1.27.4.4
***************
*** 85,88 ****
--- 85,89 ----
structure A = Access
structure DI = DebIndex
+ structure LT = Lty
structure LK = LtyKernel
structure PT = PrimTyc
***************
*** 113,121 ****
structure LTMap = MapFn
! (struct type ord_key = LK.lty val compare = LK.lt_cmp end)
structure TCMap = MapFn
! (struct type ord_key = LK.tyc val compare = LK.tc_cmp end)
structure TKMap = MapFn
! (struct type ord_key = LK.tkind val compare = LK.tk_cmp end)
structure DTMap = StampMap
structure MBMap = StampMap
--- 114,122 ----
structure LTMap = MapFn
! (struct type ord_key = LT.lty val compare = LT.lt_cmp end)
structure TCMap = MapFn
! (struct type ord_key = LT.tyc val compare = LT.tc_cmp end)
structure TKMap = MapFn
! (struct type ord_key = LT.tkind val compare = LT.tk_cmp end)
structure DTMap = StampMap
structure MBMap = StampMap
***************
*** 511,518 ****
fun tk x =
case LK.tk_out x of
! LK.TK_MONO => "A" $ []
! | LK.TK_BOX => "B" $ []
! | LK.TK_SEQ ks => "C" $ [list tkind ks]
! | LK.TK_FUN (ks, kr) => "D" $ [list tkind ks, tkind kr]
in
share TKs tk x
--- 512,519 ----
fun tk x =
case LK.tk_out x of
! LT.TK_MONO => "A" $ []
! | LT.TK_BOX => "B" $ []
! | LT.TK_SEQ ks => "C" $ [list tkind ks]
! | LT.TK_FUN (ks, kr) => "D" $ [list tkind ks, tkind kr]
in
share TKs tk x
***************
*** 524,534 ****
fun ltyI x =
case LK.lt_out x of
! LK.LT_TYC tc => "A" $ [tyc tc]
! | LK.LT_STR l => "B" $ [list lty l]
! | LK.LT_FCT (ts1, ts2) => "C" $ [list lty ts1, list lty ts2]
! | LK.LT_POLY (ks, ts) => "D" $ [list tkind ks, list lty ts]
! | LK.LT_IND _ => bug "unexpected LT_IND in mkPickleLty"
! | LK.LT_ENV _ => bug "unexpected LT_ENV in mkPickleLty"
! | LK.LT_CONT _ => bug "unexpected LT_CONT in mkPickleLty"
in
share LTs ltyI x
--- 525,535 ----
fun ltyI x =
case LK.lt_out x of
! LT.LT_TYC tc => "A" $ [tyc tc]
! | LT.LT_STR l => "B" $ [list lty l]
! | LT.LT_FCT (ts1, ts2) => "C" $ [list lty ts1, list lty ts2]
! | LT.LT_POLY (ks, ts) => "D" $ [list tkind ks, list lty ts]
! | LT.LT_IND _ => bug "unexpected LT_IND in mkPickleLty"
! | LT.LT_ENV _ => bug "unexpected LT_ENV in mkPickleLty"
! | LT.LT_CONT _ => bug "unexpected LT_CONT in mkPickleLty"
in
share LTs ltyI x
***************
*** 539,564 ****
fun tycI x =
case LK.tc_out x of
! LK.TC_VAR (db, i) => "A" $ [int (DI.di_toint db), int i]
! | LK.TC_NVAR n => "B" $ [lvar n]
! | LK.TC_PRIM t => "C" $ [int (PT.pt_toint t)]
! | LK.TC_FN (ks, tc) => "D" $ [list tkind ks, tyc tc]
! | LK.TC_APP (tc, l) => "E" $ [tyc tc, list tyc l]
! | LK.TC_SEQ l => "F" $ [list tyc l]
! | LK.TC_PROJ (tc, i) => "G" $ [tyc tc, int i]
! | LK.TC_SUM l => "H" $ [list tyc l]
! | LK.TC_FIX ((n, tc, ts), i) =>
"I" $ [int n, tyc tc, list tyc ts, int i]
! | LK.TC_ABS tc => "J" $ [tyc tc]
! | LK.TC_BOX tc => "K" $ [tyc tc]
! | LK.TC_TUPLE (_, l) => "L" $ [list tyc l]
! | LK.TC_ARROW (LK.FF_VAR (b1, b2), ts1, ts2) =>
"M" $ [bool b1, bool b2, list tyc ts1, list tyc ts2]
! | LK.TC_ARROW (LK.FF_FIXED, ts1, ts2) =>
"N" $ [list tyc ts1, list tyc ts2]
! | LK.TC_PARROW _ => bug "unexpected TC_PARREW in mkPickleLty"
! | LK.TC_TOKEN (tk, t) => "O" $ [int (LK.token_int tk), tyc t]
! | LK.TC_IND _ => bug "unexpected TC_IND in mkPickleLty"
! | LK.TC_ENV _ => bug "unexpected TC_ENV in mkPickleLty"
! | LK.TC_CONT _ => bug "unexpected TC_CONT in mkPickleLty"
in
share TCs tycI x
--- 540,565 ----
fun tycI x =
case LK.tc_out x of
! LT.TC_VAR (db, i) => "A" $ [int (DI.di_toint db), int i]
! | LT.TC_NVAR n => "B" $ [lvar n]
! | LT.TC_PRIM t => "C" $ [int (PT.pt_toint t)]
! | LT.TC_FN (ks, tc) => "D" $ [list tkind ks, tyc tc]
! | LT.TC_APP (tc, l) => "E" $ [tyc tc, list tyc l]
! | LT.TC_SEQ l => "F" $ [list tyc l]
! | LT.TC_PROJ (tc, i) => "G" $ [tyc tc, int i]
! | LT.TC_SUM l => "H" $ [list tyc l]
! | LT.TC_FIX ((n, tc, ts), i) =>
"I" $ [int n, tyc tc, list tyc ts, int i]
! | LT.TC_ABS tc => "J" $ [tyc tc]
! | LT.TC_BOX tc => "K" $ [tyc tc]
! | LT.TC_TUPLE (_, l) => "L" $ [list tyc l]
! | LT.TC_ARROW (LT.FF_VAR (b1, b2), ts1, ts2) =>
"M" $ [bool b1, bool b2, list tyc ts1, list tyc ts2]
! | LT.TC_ARROW (LT.FF_FIXED, ts1, ts2) =>
"N" $ [list tyc ts1, list tyc ts2]
! | LT.TC_PARROW _ => bug "unexpected TC_PARREW in mkPickleLty"
! | LT.TC_TOKEN (tk, t) => "O" $ [int (LT.token_int tk), tyc t]
! | LT.TC_IND _ => bug "unexpected TC_IND in mkPickleLty"
! | LT.TC_ENV _ => bug "unexpected TC_ENV in mkPickleLty"
! | LT.TC_CONT _ => bug "unexpected TC_CONT in mkPickleLty"
in
share TCs tycI x
***************
*** 665,673 ****
| fk { isrec, cconv = F.CC_FUN fixed, known, inline } =
case fixed of
! LK.FF_VAR (b1, b2) =>
"3" $ [option (list lty) (Option.map strip isrec),
bool b1, bool b2, bool known,
bool (isAlways inline)]
! | LK.FF_FIXED =>
"4" $ [option (list lty) (Option.map strip isrec),
bool known, bool (isAlways inline)]
--- 666,674 ----
| fk { isrec, cconv = F.CC_FUN fixed, known, inline } =
case fixed of
! LT.FF_VAR (b1, b2) =>
"3" $ [option (list lty) (Option.map strip isrec),
bool b1, bool b2, bool known,
bool (isAlways inline)]
! | LT.FF_FIXED =>
"4" $ [option (list lty) (Option.map strip isrec),
bool known, bool (isAlways inline)]
Index: unpickmod-new.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/Semant/pickle/unpickmod-new.sml,v
retrieving revision 1.24.4.4
retrieving revision 1.24.4.5
diff -C2 -d -r1.24.4.4 -r1.24.4.5
*** unpickmod-new.sml 13 Jul 2006 20:12:25 -0000 1.24.4.4
--- unpickmod-new.sml 11 Aug 2006 20:42:24 -0000 1.24.4.5
***************
*** 48,52 ****
structure A = Access
structure DI = DebIndex
! structure LT = LtyDef
structure LK = LtyKernel
structure PT = PrimTyc
--- 48,53 ----
structure A = Access
structure DI = DebIndex
! structure LT = Lty
! structure LD = LtyDef
structure LK = LtyKernel
structure PT = PrimTyc
***************
*** 246,253 ****
fun tkind () = let
! fun tk #"A" = LT.tkc_mono
! | tk #"B" = LT.tkc_box
! | tk #"C" = LT.tkc_seq (tkindlist ())
! | tk #"D" = LT.tkc_fun (tkindlist (), tkind ())
| tk _ = raise Format
in
--- 247,254 ----
fun tkind () = let
! fun tk #"A" = LD.tkc_mono
! | tk #"B" = LD.tkc_box
! | tk #"C" = LD.tkc_seq (tkindlist ())
! | tk #"D" = LD.tkc_fun (tkindlist (), tkind ())
| tk _ = raise Format
in
***************
*** 1292,1299 ****
fun lty () = let
! fun lt #"A" = LT.ltc_tyc (tyc ())
! | lt #"B" = LT.ltc_str (ltylist ())
! | lt #"C" = LT.ltc_fct (ltylist (), ltylist ())
! | lt #"D" = LT.ltc_poly (tkindlist (), ltylist ())
| lt _ = raise Format
in
--- 1293,1300 ----
fun lty () = let
! fun lt #"A" = LD.ltc_tyc (tyc ())
! | lt #"B" = LD.ltc_str (ltylist ())
! | lt #"C" = LD.ltc_fct (ltylist (), ltylist ())
! | lt #"D" = LD.ltc_poly (tkindlist (), ltylist ())
| lt _ = raise Format
in
***************
*** 1304,1323 ****
and tyc () = let
! fun tc #"A" = LT.tcc_var (DI.di_fromint (int ()), int ())
! | tc #"B" = LT.tcc_nvar (int ())
! | tc #"C" = LT.tcc_prim (PT.pt_fromint (int ()))
! | tc #"D" = LT.tcc_fn (tkindlist (), tyc ())
! | tc #"E" = LT.tcc_app (tyc (), tyclist ())
! | tc #"F" = LT.tcc_seq (tyclist ())
! | tc #"G" = LT.tcc_proj (tyc (), int ())
! | tc #"H" = LT.tcc_sum (tyclist ())
! | tc #"I" = LT.tcc_fix ((int (), tyc (), tyclist ()), int ())
! | tc #"J" = LT.tcc_abs (tyc ())
! | tc #"K" = LT.tcc_box (tyc ())
! | tc #"L" = LT.tcc_tuple (tyclist ())
! | tc #"M" = LT.tcc_arrow (LT.ffc_var (bool (), bool ()),
tyclist (), tyclist ())
! | tc #"N" = LT.tcc_arrow (LT.ffc_fixed, tyclist (), tyclist ())
! | tc #"O" = LK.tc_inj (LK.TC_TOKEN (LK.token_key (int ()),
tyc ()))
| tc _ = raise Format
--- 1305,1324 ----
and tyc () = let
! fun tc #"A" = LD.tcc_var (DI.di_fromint (int ()), int ())
! | tc #"B" = LD.tcc_nvar (int ())
! | tc #"C" = LD.tcc_prim (PT.pt_fromint (int ()))
! | tc #"D" = LD.tcc_fn (tkindlist (), tyc ())
! | tc #"E" = LD.tcc_app (tyc (), tyclist ())
! | tc #"F" = LD.tcc_seq (tyclist ())
! | tc #"G" = LD.tcc_proj (tyc (), int ())
! | tc #"H" = LD.tcc_sum (tyclist ())
! | tc #"I" = LD.tcc_fix ((int (), tyc (), tyclist ()), int ())
! | tc #"J" = LD.tcc_abs (tyc ())
! | tc #"K" = LD.tcc_box (tyc ())
! | tc #"L" = LD.tcc_tuple (tyclist ())
! | tc #"M" = LD.tcc_arrow (LD.ffc_var (bool (), bool ()),
tyclist (), tyclist ())
! | tc #"N" = LD.tcc_arrow (LD.ffc_fixed, tyclist (), tyclist ())
! | tc #"O" = LK.tc_inj (LT.TC_TOKEN (LK.token_key (int ()),
tyc ()))
| tc _ = raise Format
***************
*** 1446,1454 ****
known = false, inline = F.IH_SAFE }
| fk #"3" = { isrec = Option.map aug_unknown (ltylistoption ()),
! cconv = F.CC_FUN (LT.ffc_var (bool (), bool ())),
known = bool (),
inline = inlflag (bool ()) }
| fk #"4" = { isrec = Option.map aug_unknown (ltylistoption ()),
! cconv = F.CC_FUN LT.ffc_fixed,
known = bool (),
inline = inlflag (bool ()) }
--- 1447,1455 ----
known = false, inline = F.IH_SAFE }
| fk #"3" = { isrec = Option.map aug_unknown (ltylistoption ()),
! cconv = F.CC_FUN (LD.ffc_var (bool (), bool ())),
known = bool (),
inline = inlflag (bool ()) }
| fk #"4" = { isrec = Option.map aug_unknown (ltylistoption ()),
! cconv = F.CC_FUN LD.ffc_fixed,
known = bool (),
inline = inlflag (bool ()) }
-------------------------------------------------------------------------
Using Tomcat but need to do more? Need to support web services, security?
Get stuff done quickly with pre-integrated technology to make your job easier
Download IBM WebSphere Application Server v.1.0.1 based on Apache Geronimo
http://sel.as-us.falkag.net/sel?cmd=lnk&kid=120709&bid=263057&dat=121642