CVS: sml-dist/src/compiler/FLINT/kernel ltykernel.sig, 1.11.24.2, 1.11.24.3 ltykernel.sml, 1.18.12.6, 1.18.12.7 pplty.sml, 1.1.2.4, 1.1.2.5
George Kuan <[email protected]> Mon, 31 Jul 2006 16:29:48 -0700
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv16310/src/compiler/FLINT/kernel
Modified Files:
Tag: primop-branch-2
ltykernel.sig ltykernel.sml pplty.sml
Log Message:
pp for prim, transtype IBOUND case a bug
Index: ltykernel.sig
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltykernel.sig,v
retrieving revision 1.11.24.2
retrieving revision 1.11.24.3
diff -C2 -d -r1.11.24.2 -r1.11.24.3
*** ltykernel.sig 31 Jul 2006 18:50:45 -0000 1.11.24.2
--- ltykernel.sig 31 Jul 2006 23:29:45 -0000 1.11.24.3
***************
*** 95,99 ****
val initTycEnv : tycEnv
val tcInsert : tycEnv * (tyc list option * int) -> tycEnv
! val tycEnvOut : tycEnv -> tycI
(** testing if a tyc (or lty) is in the normal form *)
--- 95,100 ----
val initTycEnv : tycEnv
val tcInsert : tycEnv * (tyc list option * int) -> tycEnv
! val tcSplit : tycEnv -> ((tyc list option * int) * tycEnv) option
! (* val tycEnvOut : tycEnv -> tycI *)
(** testing if a tyc (or lty) is in the normal form *)
Index: ltykernel.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltykernel.sml,v
retrieving revision 1.18.12.6
retrieving revision 1.18.12.7
diff -C2 -d -r1.18.12.6 -r1.18.12.7
*** ltykernel.sml 31 Jul 2006 18:50:45 -0000 1.18.12.6
--- ltykernel.sml 31 Jul 2006 23:29:45 -0000 1.18.12.7
***************
*** 804,807 ****
--- 804,808 ----
print "tc_lzrd arg: ";
print(tc_print t); print "\n";
+ print ("i = " ^ Int.toString i ^ "\n");
print ("Selecting: j = "^(Int.toString j)^ "\n");
print ("ts length: "^(Int.toString(length ts))^"\n");
Index: pplty.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/pplty.sml,v
retrieving revision 1.1.2.4
retrieving revision 1.1.2.5
diff -C2 -d -r1.1.2.4 -r1.1.2.5
*** pplty.sml 31 Jul 2006 19:07:10 -0000 1.1.2.4
--- pplty.sml 31 Jul 2006 23:29:46 -0000 1.1.2.5
***************
*** 60,65 ****
in ppTKindI (LK.tk_out tk)
end (* ppTKind *)
!
! fun ppTyc ppstrm (tycon : LK.tyc) =
(* FLINT variables are represented using deBruijn indices *)
let val {openHOVBox, closeBox, pps, ...} = en_pp ppstrm
--- 60,85 ----
in ppTKindI (LK.tk_out tk)
end (* ppTKind *)
!
! fun tycEnvFlatten(tycenv) =
! (case LK.tcSplit(tycenv) of
! NONE => []
! | SOME(elem, rest) => elem::tycEnvFlatten(rest))
!
! fun ppTycEnvElem ppstrm (tycop, i) =
! let val {openHOVBox, closeBox, pps, ...} = en_pp ppstrm
! in
! openHOVBox 1;
! pps "(";
! (case tycop of
! NONE => pps "*"
! | SOME(tycs) => ppList ppstrm {sep=",", pp=ppTyc ppstrm} tycs);
! pps ", ";
! PP.break ppstrm {nsp = 1, offset=0};
! ppi ppstrm i;
! pps ")";
! closeBox()
! end (* function ppTycEnvElem *)
!
! and ppTyc ppstrm (tycon : LK.tyc) =
(* FLINT variables are represented using deBruijn indices *)
let val {openHOVBox, closeBox, pps, ...} = en_pp ppstrm
***************
*** 71,80 ****
fun ppTycI (LK.TC_VAR(depth, cnt)) =
(pps "TC_VAR(";
! PP.break ppstrm {nsp=1,offset=0};
(* depth is a deBruijn index set in elabmod.sml/instantiate.sml *)
pps (DebIndex.di_print depth);
pps ",";
PP.break ppstrm {nsp=1,offset=0};
! (* cnt is computed in instantiate.sml sigToInst *)
pps (Int.toString cnt);
pps ")")
--- 91,101 ----
fun ppTycI (LK.TC_VAR(depth, cnt)) =
(pps "TC_VAR(";
! PP.break ppstrm {nsp=1,offset=1};
(* depth is a deBruijn index set in elabmod.sml/instantiate.sml *)
pps (DebIndex.di_print depth);
pps ",";
PP.break ppstrm {nsp=1,offset=0};
! (* cnt is computed in instantiate.sml sigToInst or
! alternatively may be simply the IBOUND index *)
pps (Int.toString cnt);
pps ")")
***************
*** 82,86 ****
| ppTycI (LK.TC_NVAR tvar) =
(pps "TC_NVAR(";
! PP.break ppstrm {nsp=1,offset=0};
pps (Int.toString tvar);
pps ")")
--- 103,107 ----
| ppTycI (LK.TC_NVAR tvar) =
(pps "TC_NVAR(";
! PP.break ppstrm {nsp=1,offset=1};
pps (Int.toString tvar);
pps ")")
***************
*** 93,97 ****
(openHOVBox 1;
pps "TC_FN(";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep="* ", pp=ppTKind'} argTkinds;
pps ",";
--- 114,118 ----
(openHOVBox 1;
pps "TC_FN(";
! PP.break ppstrm {nsp=1,offset=1};
ppList' {sep="* ", pp=ppTKind'} argTkinds;
pps ",";
***************
*** 103,107 ****
(openHOVBox 1;
pps "TC_APP(";
! PP.break ppstrm {nsp=1,offset=0};
ppTyc' contyc;
pps ",";
--- 124,128 ----
(openHOVBox 1;
pps "TC_APP(";
! PP.break ppstrm {nsp=1,offset=1};
ppTyc' contyc;
pps ",";
***************
*** 113,117 ****
(openHOVBox 1;
pps "TC_SEQ(";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep=", ", pp=ppTyc'} tycs;
pps ")";
--- 134,138 ----
(openHOVBox 1;
pps "TC_SEQ(";
! PP.break ppstrm {nsp=1,offset=1};
ppList' {sep=", ", pp=ppTyc'} tycs;
pps ")";
***************
*** 120,124 ****
(openHOVBox 1;
pps "TC_PROJ(";
! PP.break ppstrm {nsp=1,offset=0};
ppTyc' tycon;
pps ", ";
--- 141,145 ----
(openHOVBox 1;
pps "TC_PROJ(";
! PP.break ppstrm {nsp=1,offset=1};
ppTyc' tycon;
pps ", ";
***************
*** 129,133 ****
| ppTycI (LK.TC_SUM(tycs)) =
(pps "TC_SUM(";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep=", ", pp=ppTyc'} tycs;
pps ")")
--- 150,154 ----
| ppTycI (LK.TC_SUM(tycs)) =
(pps "TC_SUM(";
! PP.break ppstrm {nsp=1,offset=1};
ppList' {sep=", ", pp=ppTyc'} tycs;
pps ")")
***************
*** 136,140 ****
(openHOVBox 1;
pps "TC_FIX(";
! PP.break ppstrm {nsp=1,offset=0};
pps "nStamps = ";
pps (Int.toString numStamps);
--- 157,161 ----
(openHOVBox 1;
pps "TC_FIX(";
! PP.break ppstrm {nsp=1,offset=1};
pps "nStamps = ";
pps (Int.toString numStamps);
***************
*** 155,164 ****
| ppTycI (LK.TC_ABS tyc) =
(pps "TC_ABS(";
! PP.break ppstrm {nsp=1,offset=0};
ppTyc' tyc;
pps ")")
| ppTycI (LK.TC_BOX tyc) =
(pps "TC_BOX(";
! PP.break ppstrm {nsp=1,offset=0};
ppTyc' tyc;
pps ")")
--- 176,185 ----
| ppTycI (LK.TC_ABS tyc) =
(pps "TC_ABS(";
! PP.break ppstrm {nsp=1,offset=1};
ppTyc' tyc;
pps ")")
| ppTycI (LK.TC_BOX tyc) =
(pps "TC_BOX(";
! PP.break ppstrm {nsp=1,offset=1};
ppTyc' tyc;
pps ")")
***************
*** 166,170 ****
| ppTycI (LK.TC_TUPLE (rflag, tycs)) =
(pps "TC_TUPLE(";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep="* ", pp=ppTyc'} tycs;
pps ")")
--- 187,191 ----
| ppTycI (LK.TC_TUPLE (rflag, tycs)) =
(pps "TC_TUPLE(";
! PP.break ppstrm {nsp=1,offset=1};
ppList' {sep="* ", pp=ppTyc'} tycs;
pps ")")
***************
*** 172,176 ****
| ppTycI (LK.TC_ARROW (fflag, argTycs, resTycs)) =
(pps "TC_ARROW(";
! PP.break ppstrm {nsp=1,offset=0};
(case fflag of LK.FF_FIXED => pps "FF_FIXED"
| LK.FF_VAR(b1, b2) => (pps "<FF_VAR>" (*;
--- 193,197 ----
| ppTycI (LK.TC_ARROW (fflag, argTycs, resTycs)) =
(pps "TC_ARROW(";
! PP.break ppstrm {nsp=1,offset=1};
(case fflag of LK.FF_FIXED => pps "FF_FIXED"
| LK.FF_VAR(b1, b2) => (pps "<FF_VAR>" (*;
***************
*** 187,191 ****
| ppTycI (LK.TC_PARROW (argTyc, resTyc)) =
(pps "TC_PARROW(";
! PP.break ppstrm {nsp=1,offset=0};
ppTyc' argTyc;
pps ", ";
--- 208,212 ----
| ppTycI (LK.TC_PARROW (argTyc, resTyc)) =
(pps "TC_PARROW(";
! PP.break ppstrm {nsp=1,offset=1};
ppTyc' argTyc;
pps ", ";
***************
*** 195,199 ****
| ppTycI (LK.TC_TOKEN (tok, tyc)) =
(pps "TC_TOKEN(";
! PP.break ppstrm {nsp=1,offset=0};
pps (LK.token_name tok);
pps ", ";
--- 216,220 ----
| ppTycI (LK.TC_TOKEN (tok, tyc)) =
(pps "TC_TOKEN(";
! PP.break ppstrm {nsp=1,offset=1};
pps (LK.token_name tok);
pps ", ";
***************
*** 203,207 ****
| ppTycI (LK.TC_CONT tycs) =
(pps "TC_CONT(";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep=", ", pp=ppTyc'} tycs;
pps ")")
--- 224,228 ----
| ppTycI (LK.TC_CONT tycs) =
(pps "TC_CONT(";
! PP.break ppstrm {nsp=1,offset=1};
ppList' {sep=", ", pp=ppTyc'} tycs;
pps ")")
***************
*** 209,213 ****
(openHOVBox 1;
pps "TC_IND(";
! PP.break ppstrm {nsp=1,offset=0};
ppTyc' tyc;
pps ", ";
--- 230,234 ----
(openHOVBox 1;
pps "TC_IND(";
! PP.break ppstrm {nsp=1,offset=1};
ppTyc' tyc;
pps ", ";
***************
*** 219,223 ****
(openHOVBox 1;
pps "TC_ENV(";
! PP.break ppstrm {nsp=1,offset=0};
ppTyc' tyc;
pps ", ";
--- 240,244 ----
(openHOVBox 1;
pps "TC_ENV(";
! PP.break ppstrm {nsp=1,offset=1};
ppTyc' tyc;
pps ", ";
***************
*** 230,238 ****
pps ", ";
PP.break ppstrm {nsp=1,offset=0};
! (LK.tycEnvOut tenv);
closeBox())
in ppTycI (LK.tc_out tycon)
end (* ppTyc *)
end (* local *)
--- 251,269 ----
pps ", ";
PP.break ppstrm {nsp=1,offset=0};
! ppList' {sep=", ", pp=(ppTycEnvElem ppstrm)} (tycEnvFlatten tenv);
closeBox())
in ppTycI (LK.tc_out tycon)
end (* ppTyc *)
+ fun ppTycEnv ppstrm (tycEnv : LK.tycEnv) =
+ let val {openHOVBox, closeBox, pps, ...} = en_pp ppstrm
+ in
+ openHOVBox 1;
+ pps "TycEnv(";
+ ppList ppstrm {sep=", ", pp=ppTycEnvElem ppstrm} (tycEnvFlatten tycEnv);
+ pps ")";
+ closeBox()
+ end (* function ppTycEnv *)
+
end (* local *)
-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys -- and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV