CVS: sml-dist/src/compiler/FLINT/kernel ltyextern.sml, 1.19.24.16, 1.19.24.17 ltykernel.sml, 1.18.12.22, 1.18.12.23 pplty.sml, 1.1.2.17, 1.1.2.18
David MacQueen <[email protected]> Mon, 28 Aug 2006 15:57:56 -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-serv3562/src/compiler/FLINT/kernel
Modified Files:
Tag: primop-branch-2
ltyextern.sml ltykernel.sml pplty.sml
Log Message:
added further debugging instrumentation
Index: ltyextern.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltyextern.sml,v
retrieving revision 1.19.24.16
retrieving revision 1.19.24.17
diff -C2 -d -r1.19.24.16 -r1.19.24.17
*** ltyextern.sml 24 Aug 2006 23:03:10 -0000 1.19.24.16
--- ltyextern.sml 28 Aug 2006 22:57:53 -0000 1.19.24.17
***************
*** 91,99 ****
of (LT.LT_POLY(ks, b), ts) =>
if length ks <> length ts
! then (print "### arity error in lt_inst:\n|ks| = ";
! print (Int.toString (length ks));
! print ", |ts| = "; print (Int.toString (length ks));
! print "\n";
! bug "lt_inst")
else
let val nenv = LT.teCons(LT.Beta(0,ts,ks), LT.teEmpty)
--- 91,115 ----
of (LT.LT_POLY(ks, b), ts) =>
if length ks <> length ts
! then (with_pp (fn ppstm =>
! (PU.pps ppstm "### arity error in lt_inst:\n|ks| = ";
! PU.ppi ppstm (length ks);
! PU.pps ppstm ", |ts| = "; PU.ppi ppstm (length ts);
! PP.newline ppstm;
! PU.pps ppstm "lt: ";
! PP.openHOVBox ppstm (PP.Rel 0);
! PPLty.ppLty 20 ppstm lt;
! PP.closeBox ppstm;
! PP.newline ppstm;
! PU.pps ppstm "nt: ";
! PP.openHOVBox ppstm (PP.Rel 0);
! PPLty.ppLty 20 ppstm nt;
! PP.closeBox ppstm;
! PP.newline ppstm;
! PU.pps ppstm "ts: ";
! PPLty.ppList ppstm
! {sep = ",",pp=PPLty.ppTyc 20}
! ts;
! PP.newline ppstm));
! bug "lt_inst - arity mismatch")
else
let val nenv = LT.teCons(LT.Beta(0,ts,ks), LT.teEmpty)
Index: ltykernel.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltykernel.sml,v
retrieving revision 1.18.12.22
retrieving revision 1.18.12.23
diff -C2 -d -r1.18.12.22 -r1.18.12.23
*** ltykernel.sml 24 Aug 2006 19:28:40 -0000 1.18.12.22
--- ltykernel.sml 28 Aug 2006 22:57:53 -0000 1.18.12.23
***************
*** 302,306 ****
in openHVBox 0;
pps "***Debugging***"; newline();
! pps "tc_lzrd arg: "; PPLty.ppTyc (!dp) s t;
newline();
pps "n = "; ppi n; pps ", k = "; ppi k;
--- 302,308 ----
in openHVBox 0;
pps "***Debugging***"; newline();
! pps "tc_lzrd arg:";
! newline();
! PPLty.ppTyc (!dp) s t;
newline();
pps "n = "; ppi n; pps ", k = "; ppi k;
Index: pplty.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/pplty.sml,v
retrieving revision 1.1.2.17
retrieving revision 1.1.2.18
diff -C2 -d -r1.1.2.17 -r1.1.2.18
*** pplty.sml 24 Aug 2006 23:03:10 -0000 1.1.2.17
--- pplty.sml 28 Aug 2006 22:57:54 -0000 1.1.2.18
***************
*** 23,26 ****
--- 23,27 ----
val dtPrintNames : bool ref = ref true
+ val printIND : bool ref = ref false
fun ppSeq ppstrm {sep: string, pp : PP.stream -> 'a -> unit} (list: 'a list) =
***************
*** 38,43 ****
{front = fn ppstrm => (PP.string ppstrm "["),
back = fn ppstrm => (PP.string ppstrm "]"),
! sep = fn ppstrm => (PP.string ppstrm sep;
! PP.break ppstrm {nsp=0, offset=0}),
style = INCONSISTENT,
pr = pp}
--- 39,43 ----
{front = fn ppstrm => (PP.string ppstrm "["),
back = fn ppstrm => (PP.string ppstrm "]"),
! sep = fn ppstrm => (PP.string ppstrm sep),
style = INCONSISTENT,
pr = pp}
***************
*** 112,116 ****
(* FLINT variables are represented using deBruijn indices *)
if pd < 1 then pps ppstrm "<tyc>" else
! let val {openHOVBox, openHVBox, closeBox, pps, ppi, ...} = en_pp ppstrm
val ppList' : {pp:PP.stream -> 'a -> unit, sep: string} -> 'a list -> unit =
fn x => ppList ppstrm x
--- 112,117 ----
(* FLINT variables are represented using deBruijn indices *)
if pd < 1 then pps ppstrm "<tyc>" else
! let val {openHOVBox, openHVBox, closeBox, pps, ppi, break, ...} =
! en_pp ppstrm
val ppList' : {pp:PP.stream -> 'a -> unit, sep: string} -> 'a list -> unit =
fn x => ppList ppstrm x
***************
*** 139,145 ****
(openHOVBox 1;
pps "FN(";
! ppList' {sep="*", pp=ppTKind (pd-1)} argTkinds;
pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppTyc' resultTyc;
pps ")";
--- 140,146 ----
(openHOVBox 1;
pps "FN(";
! ppList' {sep=",", pp=ppTKind (pd-1)} argTkinds;
pps ",";
! break {nsp=1,offset=0};
ppTyc' resultTyc;
pps ")";
***************
*** 150,154 ****
ppTyc' contyc;
pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep=",", pp=ppTyc (pd-1)} tys;
pps ")";
--- 151,155 ----
ppTyc' contyc;
pps ",";
! break {nsp=1,offset=0};
ppList' {sep=",", pp=ppTyc (pd-1)} tys;
pps ")";
***************
*** 165,169 ****
ppTyc' tycon;
pps ",";
! PP.break ppstrm {nsp=1,offset=0};
pps (Int.toString index);
pps ")";
--- 166,170 ----
ppTyc' tycon;
pps ",";
! break {nsp=1,offset=0};
pps (Int.toString index);
pps ")";
***************
*** 181,186 ****
pps "FIX(";
openHVBox 0;
! pps "size = "; ppi size; PP.break ppstrm {nsp=1,offset=0};
! pps "index = "; ppi index; PP.break ppstrm {nsp=1,offset=0};
pps "gen = ";
openHOVBox 2;
--- 182,187 ----
pps "FIX(";
openHVBox 0;
! pps "size = "; ppi size; break {nsp=1,offset=0};
! pps "index = "; ppi index; break {nsp=1,offset=0};
pps "gen = ";
openHOVBox 2;
***************
*** 191,195 ****
ppList' {sep = ",", pp = ppTyc (pd-1)} params;
closeBox ();
! PP.break ppstrm {nsp=0,offset=0};
pps ")";
closeBox())
--- 192,196 ----
ppList' {sep = ",", pp = ppTyc (pd-1)} params;
closeBox ();
! break {nsp=0,offset=0};
pps ")";
closeBox())
***************
*** 206,211 ****
(ppClosedSequence ppstrm
{front = (fn s => PP.string s "{"),
! sep = (fn s => PP.string s ","),
! back = (fn s => PP.string s "}"),
pr = ppTyc (pd-1),
style = INCONSISTENT}
--- 207,212 ----
(ppClosedSequence ppstrm
{front = (fn s => PP.string s "{"),
! sep = (fn s => PP.string s ","),
! back = (fn s => PP.string s "}"),
pr = ppTyc (pd-1),
style = INCONSISTENT}
***************
*** 213,227 ****
(* fflag records the calling convention: either FF_FIXED or FF_VAR *)
| ppTycI (Lty.TC_ARROW (fflag, argTycs, resTycs)) =
! (pps "ARR(";
! (case fflag of Lty.FF_FIXED => pps "FF_FIXED"
! | Lty.FF_VAR(b1, b2) =>
! (pps "<FF_VAR>" (*; ppBool b1; pps ",";
! ppBool b2; pps ")"*) ));
! pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep=",", pp=ppTyc (pd-1)} argTycs;
pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep=",", pp=ppTyc (pd-1)} resTycs;
pps ")")
(* According to ltykernel.sml comment, this arrow tyc is not used *)
--- 214,228 ----
(* fflag records the calling convention: either FF_FIXED or FF_VAR *)
| ppTycI (Lty.TC_ARROW (fflag, argTycs, resTycs)) =
! ((case fflag
! of Lty.FF_FIXED => pps "ARF("
! | Lty.FF_VAR(b1, b2) =>
! (pps "ARV(" (*; ppBool b1; pps ",";
! ppBool b2; pps ")"*) ));
! openHOVBox 0;
ppList' {sep=",", pp=ppTyc (pd-1)} argTycs;
pps ",";
! break {nsp=1,offset=0};
ppList' {sep=",", pp=ppTyc (pd-1)} resTycs;
+ closeBox ();
pps ")")
(* According to ltykernel.sml comment, this arrow tyc is not used *)
***************
*** 230,234 ****
ppTyc' argTyc;
pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppTyc' resTyc;
pps ")")
--- 231,235 ----
ppTyc' argTyc;
pps ",";
! break {nsp=1,offset=0};
ppTyc' resTyc;
pps ")")
***************
*** 237,241 ****
pps (Lty.token_name tok);
pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppTyc' tyc;
pps ")")
--- 238,242 ----
pps (Lty.token_name tok);
pps ",";
! break {nsp=1,offset=0};
ppTyc' tyc;
pps ")")
***************
*** 245,256 ****
pps ")")
| ppTycI (Lty.TC_IND (tyc, tycI)) =
! (openHOVBox 1;
! pps "IND(";
! ppTyc' tyc;
! pps ", ";
! PP.break ppstrm {nsp=1,offset=0};
! ppTycI tycI;
! pps ")";
! closeBox())
| ppTycI (Lty.TC_ENV (tyc, ol, nl, tenv)) =
(openHVBox 1;
--- 246,259 ----
pps ")")
| ppTycI (Lty.TC_IND (tyc, tycI)) =
! if !printIND then
! (openHOVBox 1;
! pps "IND(";
! ppTyc' tyc;
! pps ",";
! break {nsp=1,offset=0};
! ppTycI tycI;
! pps ")";
! closeBox())
! else ppTyc' tyc
| ppTycI (Lty.TC_ENV (tyc, ol, nl, tenv)) =
(openHVBox 1;
***************
*** 262,269 ****
pps (Int.toString nl);
pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppTyc' tyc;
pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep=",", pp=ppTEBinder (pd-1)} (tycEnvFlatten tenv);
pps ")";
--- 265,272 ----
pps (Int.toString nl);
pps ",";
! break {nsp=1,offset=0};
ppTyc' tyc;
pps ",";
! break {nsp=1,offset=0};
ppList' {sep=",", pp=ppTEBinder (pd-1)} (tycEnvFlatten tenv);
pps ")";
***************
*** 286,290 ****
fun ppLty pd ppstrm (lty: Lty.lty) =
if pd < 1 then pps ppstrm "<tyc>" else
! let val {openHOVBox, openHVBox, closeBox, pps, ppi, ...} = en_pp ppstrm
val ppList' : {pp:PP.stream -> 'a -> unit, sep: string} -> 'a list -> unit =
fn x => ppList ppstrm x
--- 289,294 ----
fun ppLty pd ppstrm (lty: Lty.lty) =
if pd < 1 then pps ppstrm "<tyc>" else
! let val {openHOVBox, openHVBox, closeBox, pps, ppi, break, newline} =
! en_pp ppstrm
val ppList' : {pp:PP.stream -> 'a -> unit, sep: string} -> 'a list -> unit =
fn x => ppList ppstrm x
***************
*** 300,311 ****
| ppLtyI (Lty.LT_FCT (args,res)) =
(pps "FCT("; ppList' {sep=",",pp=ppLty (pd-1)} args; pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep=",",pp=ppLty (pd-1)} res; pps ")")
| ppLtyI (Lty.LT_POLY (ks,ltys)) =
(openHOVBox 1;
! pps "P0L(";
! ppList' {sep="*", pp=ppTKind (pd-1)} ks;
pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep=",",pp=ppLty (pd-1)} ltys;
pps ")";
--- 304,315 ----
| ppLtyI (Lty.LT_FCT (args,res)) =
(pps "FCT("; ppList' {sep=",",pp=ppLty (pd-1)} args; pps ",";
! break {nsp=1,offset=0};
ppList' {sep=",",pp=ppLty (pd-1)} res; pps ")")
| ppLtyI (Lty.LT_POLY (ks,ltys)) =
(openHOVBox 1;
! pps "POL(";
! ppList' {sep=",", pp=ppTKind (pd-1)} ks;
pps ",";
! break {nsp=1,offset=0};
ppList' {sep=",",pp=ppLty (pd-1)} ltys;
pps ")";
***************
*** 314,320 ****
(pps "CONT("; ppList' {sep=",",pp=ppLty (pd-1)} ltys; pps ")")
| ppLtyI (Lty.LT_IND(nt,ot)) =
! (pps "IND("; ppLty (pd-1) ppstrm nt; pps ",";
! PP.break ppstrm {nsp=1,offset=0};
! ppLtyI ot; pps ")")
| ppLtyI (Lty.LT_ENV (lty, ol, nl, tenv)) =
(openHVBox 1;
--- 318,326 ----
(pps "CONT("; ppList' {sep=",",pp=ppLty (pd-1)} ltys; pps ")")
| ppLtyI (Lty.LT_IND(nt,ot)) =
! if !printIND then
! (pps "IND("; ppLty' nt; pps ",";
! break {nsp=1,offset=0};
! ppLtyI ot; pps ")")
! else ppLty pd ppstrm nt
| ppLtyI (Lty.LT_ENV (lty, ol, nl, tenv)) =
(openHVBox 1;
***************
*** 326,333 ****
pps (Int.toString nl);
pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppLty' lty;
pps ",";
! PP.break ppstrm {nsp=1,offset=0};
ppList' {sep=",", pp=ppTEBinder (pd-1)} (tycEnvFlatten tenv);
pps ")";
--- 332,339 ----
pps (Int.toString nl);
pps ",";
! break {nsp=1,offset=0};
ppLty' lty;
pps ",";
! break {nsp=1,offset=0};
ppList' {sep=",", pp=ppTEBinder (pd-1)} (tycEnvFlatten tenv);
pps ")";
-------------------------------------------------------------------------
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