CVS: sml-dist/src/compiler/FLINT/plambda chkplexp.sml, 1.9.10.11, 1.9.10.12 pplexp.sml, 1.4.10.5, 1.4.10.6
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/plambda
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv3562/src/compiler/FLINT/plambda
Modified Files:
Tag: primop-branch-2
chkplexp.sml pplexp.sml
Log Message:
added further debugging instrumentation
Index: chkplexp.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/plambda/chkplexp.sml,v
retrieving revision 1.9.10.11
retrieving revision 1.9.10.12
diff -C2 -d -r1.9.10.11 -r1.9.10.12
*** chkplexp.sml 28 Aug 2006 05:12:11 -0000 1.9.10.11
--- chkplexp.sml 28 Aug 2006 22:57:54 -0000 1.9.10.12
***************
*** 46,51 ****
* BASIC UTILITY FUNCTIONS *
****************************************************************************)
! fun debugmsg msg = if !debugging then (say "[ChkPlexp]: "; say msg; say "\n")
! else ()
fun app2(f, [], []) = ()
--- 46,53 ----
* BASIC UTILITY FUNCTIONS *
****************************************************************************)
! fun debugmsg msg =
! if false (* !debugging *)
! then (say "[ChkPlexp]: "; say msg; say "\n")
! else ()
fun app2(f, [], []) = ()
***************
*** 164,178 ****
(if ltEquiv(t1,t2) then ()
else (clickerror();
! say (s ^ " **** Lty conflicting in lexp =====> \n ");
! ltPrint t1; say "\n and \n "; ltPrint t2;
! say "\n \n"; with_pp(fn s => PPLexp.ppLexp 20 s le);
! say "***************************************************** \n"))
! handle zz =>
(clickerror();
! say (s ^ " **** Lty conflicting in lexp =====> \n ");
! say "uncaught exception found ";
! say "\n \n"; with_pp(fn s => PPLexp.ppLexp 20 s le); say "\n";
! ltPrint t1; say "\n and \n "; ltPrint t2; say "\n";
! say "***************************************************** \n")
fun ltFnApp le s (t1, t2) =
--- 166,185 ----
(if ltEquiv(t1,t2) then ()
else (clickerror();
! with_pp(fn s =>
! (PU.pps s "ERROR(checkLty): ltEquiv fails in ltMatch"; PP.newline s;
! PU.pps s "le:"; PP.newline s; PPLexp.ppLexp 6 s le;
! PU.pps s "t1:"; PP.newline s; PPLty.ppLty 10 s t1; PP.newline s;
! PU.pps s "t2:"; PP.newline s; PPLty.ppLty 10 s t2; PP.newline s;
! PU.pps s"***************************************************";
! PP.newline s))))
! handle teUnbound2 =>
(clickerror();
! with_pp(fn s =>
! (PU.pps s "ERROR(checkLty): exception teUnbound2 in ltMatch"; PP.newline s;
! PU.pps s "le:"; PP.newline s; PPLexp.ppLexp 6 s le;
! PU.pps s "t1:"; PP.newline s; PPLty.ppLty 10 s t1; PP.newline s;
! PU.pps s "t2:"; PP.newline s; PPLty.ppLty 10 s t2; PP.newline s;
! PU.pps s"***************************************************";
! PP.newline s)))
fun ltFnApp le s (t1, t2) =
***************
*** 273,277 ****
(ltyChkenv " PRIM " t;
map (tycChk kenv) ts;
! debugmsg " PRIM";
ltTyApp le "PRIM" (t, ts, kenv))
--- 280,284 ----
(ltyChkenv " PRIM " t;
map (tycChk kenv) ts;
! debugmsg "PRIM";
ltTyApp le "PRIM" (t, ts, kenv))
***************
*** 282,289 ****
val res = check (kenv, venv', d) e1
val _ = ltyChkenv "FN rng" res
! val _ = debugmsg " FN"
val fnlty = ltFun(t, res) (* handle both functions and functors *)
val _ = ltyChkenv "FNlty " fnlty
! val _ = debugmsg " FN 2"
in fnlty
end
--- 289,296 ----
val res = check (kenv, venv', d) e1
val _ = ltyChkenv "FN rng" res
! val _ = debugmsg "FN"
val fnlty = ltFun(t, res) (* handle both functions and functors *)
val _ = ltyChkenv "FNlty " fnlty
! val _ = debugmsg "FN 2"
in fnlty
end
***************
*** 300,304 ****
val _ = map (ltyChkenv "FIX body types") nts
val _ = app2(ltMatch le "FIX1", ts, nts)
! val _ = debugmsg " FIX"
in check (kenv, venv', d) eb
end
--- 307,311 ----
val _ = map (ltyChkenv "FIX body types") nts
val _ = app2(ltMatch le "FIX1", ts, nts)
! val _ = debugmsg "FIX"
in check (kenv, venv', d) eb
end
***************
*** 309,313 ****
val _ = ltyChkenv "APP operator " top
val _ = ltyChkenv "APP argument " targ
! val _ = debugmsg " APP"
in
ltFnApp le "APP" (top, targ)
--- 316,320 ----
val _ = ltyChkenv "APP operator " top
val _ = ltyChkenv "APP argument " targ
! val _ = debugmsg "APP"
in
ltFnApp le "APP" (top, targ)
***************
*** 328,332 ****
val lt = check (kenv', venv, DI.next d) e
val _ = ltyChkMsgLexp "TFN body" (ks::kenv) lt
! val _ = debugmsg " TFN"
in LT.ltc_poly(ks, [lt])
end
--- 335,339 ----
val lt = check (kenv', venv, DI.next d) e
val _ = ltyChkMsgLexp "TFN body" (ks::kenv) lt
! val _ = debugmsg "TFN"
in LT.ltc_poly(ks, [lt])
end
***************
*** 337,341 ****
(* kind check type args *)
val _ = ltyChkenv "TAPP type function " lt
! val _ = debugmsg " TAPP"
in ltTyApp le "TAPP" (lt, ts, kenv)
end
--- 344,348 ----
(* kind check type args *)
val _ = ltyChkenv "TAPP type function " lt
! val _ = debugmsg "TAPP"
in ltTyApp le "TAPP" (lt, ts, kenv)
end
***************
*** 361,365 ****
val t2 = loop e
val _ = ltyChkenv "CON 2 " t2
! val _ = debugmsg " CON"
in ltFnApp le "CON-A" (t1, t2)
end
--- 368,372 ----
val t2 = loop e
val _ = ltyChkenv "CON 2 " t2
! val _ = debugmsg "CON"
in ltFnApp le "CON-A" (t1, t2)
end
***************
*** 374,378 ****
let val elemsltys = map loop el
val _ = map (ltyChkenv "RECORD elem ") elemsltys
! val _ = debugmsg " RECORD"
in ltTup elemsltys
end
--- 381,385 ----
let val elemsltys = map loop el
val _ = map (ltyChkenv "RECORD elem ") elemsltys
! val _ = debugmsg "RECORD"
in ltTup elemsltys
end
***************
*** 387,391 ****
map (ltyChkenv "VECTOR vector ") ts;
app (fn x => ltMatch le "VECTOR" (x, LT.ltc_tyc t)) ts;
! debugmsg " VECTOR ";
ltVector t
end
--- 394,398 ----
map (ltyChkenv "VECTOR vector ") ts;
app (fn x => ltMatch le "VECTOR" (x, LT.ltc_tyc t)) ts;
! debugmsg "VECTOR ";
ltVector t
end
***************
*** 394,398 ****
let val lty = loop e
val _ = ltyChkenv " SELECT " lty
! val _ = debugmsg " SELECT"
in
ltSelect le "SEL" (lty, i)
--- 401,405 ----
let val lty = loop e
val _ = ltyChkenv " SELECT " lty
! val _ = debugmsg "SELECT"
in
ltSelect le "SEL" (lty, i)
***************
*** 463,468 ****
in
! anyerror := false;
! check (LT.initTkEnv, venv, DI.top) lexp; !anyerror
end (* end of function checkLty *)
--- 470,476 ----
in
! anyerror := false;
! check (LT.initTkEnv, venv, DI.top) lexp;
! !anyerror
end (* end of function checkLty *)
Index: pplexp.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/plambda/pplexp.sml,v
retrieving revision 1.4.10.5
retrieving revision 1.4.10.6
diff -C2 -d -r1.4.10.5 -r1.4.10.6
*** pplexp.sml 28 Aug 2006 05:12:11 -0000 1.4.10.5
--- pplexp.sml 28 Aug 2006 22:57:54 -0000 1.4.10.6
***************
*** 85,89 ****
fun ppLexp (pd:int) ppstrm (l: lexp): unit =
- if pd < 1 then pps ppstrm "<tyc>" else
let val {openHOVBox, openHVBox, closeBox, break, newline, pps, ppi, ...} =
en_pp ppstrm
--- 85,88 ----
***************
*** 108,140 ****
elems
! fun ppl (VAR v) = pps (lvarName v)
! | ppl (INT i) = ppi i
! | ppl (WORD i) = (pps "(W)"; pps (Word.toString i))
! | ppl (INT32 i) = (pps "(I32)"; pps(Int32.toString i))
! | ppl (WORD32 i) = (pps "(W32)"; pps(Word32.toString i))
! | ppl (REAL s) = pps s
! | ppl (STRING s) = pps (mlstr s)
! | ppl (ETAG (l,_)) = ppl l
! | ppl (RECORD l) =
(openHOVBox 3;
pps "RCD";
! ppClosedSeq ("(",",",")") (ppLexp (pd-1)) l;
closeBox ())
! | ppl (SRECORD l) =
(openHOVBox 4;
pps "SRCD";
! ppClosedSeq ("(",",",")") (ppLexp (pd-1)) l;
closeBox ())
! | ppl (le as VECTOR (l, _)) =
! let val style = if complex le then PU.CONSISTENT else PU.INCONSISTENT
! in openHOVBox 3;
! pps "VEC";
! ppClosedSeq ("(",",",")") (ppLexp (pd-1)) l;
! closeBox ()
! end
! | ppl (PRIM(p,t,ts)) =
(openHOVBox 4;
pps "PRM(";
--- 107,142 ----
elems
! fun ppl pd (VAR v) = pps (lvarName v)
! | ppl pd (INT i) = ppi i
! | ppl pd (WORD i) = (pps "(W)"; pps (Word.toString i))
! | ppl pd (INT32 i) = (pps "(I32)"; pps(Int32.toString i))
! | ppl pd (WORD32 i) = (pps "(W32)"; pps(Word32.toString i))
! | ppl pd (REAL s) = pps s
! | ppl pd (STRING s) = pps (mlstr s)
! | ppl pd (ETAG (l,_)) = ppl pd l
! | ppl pd (RECORD l) =
! if pd < 1 then pps "<REC>" else
(openHOVBox 3;
pps "RCD";
! ppClosedSeq ("(",",",")") (fn s => ppl (pd-1)) l;
closeBox ())
!
! | ppl ps (SRECORD l) =
! if pd < 1 then pps "<REC>" else
(openHOVBox 4;
pps "SRCD";
! ppClosedSeq ("(",",",")") (fn s => ppl (pd-1)) l;
closeBox ())
! | ppl pd (le as VECTOR (l, _)) =
! if pd < 1 then pps "<VEC>" else
! (openHOVBox 3;
! pps "VEC";
! ppClosedSeq ("(",",",")") (fn s => ppl (pd-1)) l;
! closeBox ())
! | ppl pd (PRIM(p,t,ts)) =
! if pd < 1 then pps "<PRIM>" else
(openHOVBox 4;
pps "PRM(";
***************
*** 147,151 ****
closeBox ())
! | ppl (l as SELECT(i, _)) =
let fun gather(SELECT(i,l)) =
let val (more,root) = gather l
--- 149,154 ----
closeBox ())
! | ppl pd (l as SELECT(i, _)) =
! if pd < 1 then pps "<SEL>" else
let fun gather(SELECT(i,l)) =
let val (more,root) = gather l
***************
*** 157,174 ****
fun ipr (i:int) = pps(Int.toString i)
in openHOVBox 2;
! ppl root;
ppClosedSeq ("[",",","]") (fn s => ppi) (rev path);
closeBox ()
end
! | ppl (FN(v,t,l)) =
(openHOVBox 3; pps "FN(";
pps(lvarName v); pps ":"; br1 0; ppLty' t; pps ",";
! if complex l then
! (newline(); ppLexp' l; pps ")")
! else (ppl l; pps ")");
closeBox())
! | ppl (CON((s, c, lt), ts, l)) =
(openHOVBox 4;
pps "CON(";
--- 160,178 ----
fun ipr (i:int) = pps(Int.toString i)
in openHOVBox 2;
! ppl (pd-1) root;
ppClosedSeq ("[",",","]") (fn s => ppi) (rev path);
closeBox ()
end
! | ppl pd (FN(v,t,l)) =
! if pd < 1 then pps "<FN>" else
(openHOVBox 3; pps "FN(";
pps(lvarName v); pps ":"; br1 0; ppLty' t; pps ",";
! if complex l then newline() else ();
! ppl (pd-1) l; pps ")";
closeBox())
! | ppl pd (CON((s, c, lt), ts, l)) =
! if pd < 1 then pps "<FN>" else
(openHOVBox 4;
pps "CON(";
***************
*** 180,184 ****
ppClosedSeq ("[",",","]") (PPLty.ppTyc (pd-1)) ts;
pps ","; br1 0;
! ppl l; pps ")";
closeBox())
--- 184,188 ----
ppClosedSeq ("[",",","]") (PPLty.ppTyc (pd-1)) ts;
pps ","; br1 0;
! ppl (pd-1) l; pps ")";
closeBox())
***************
*** 190,229 ****
else (g l; pps ")"))
*)
! | ppl (APP(FN(v,_,l),r)) =
(openHOVBox 5;
! pps "(APP)";
! ppl (LET(v, r, l));
closeBox())
! | ppl (LET(v, r, l)) =
(openHVBox 2;
openHOVBox 4;
! pps (lvarName v); br1 0; pps "="; br1 0; ppl r;
closeBox();
newline();
! ppl l;
closeBox())
! | ppl (APP(l, r)) =
(pps "APP(";
openHVBox 0;
! ppl l; pps ","; br1 0; ppl r;
closeBox();
pps ")")
! | ppl (TFN(ks, b)) =
! (openHOVBox 0; pps "TFN(";
openHVBox 0;
ppClosedSeq ("(",",",")") (PPLty.ppTKind (pd-1)) ks; br1 0;
! ppl b;
closeBox();
pps ")";
closeBox())
! | ppl (TAPP(l, ts)) =
(openHOVBox 0;
! pps "TAPP(";
openHVBox 0;
! ppl l; br1 0;
ppClosedSeq ("[",",","]") (PPLty.ppTyc (pd-1)) ts;
closeBox();
--- 194,239 ----
else (g l; pps ")"))
*)
! | ppl pd (APP(FN(v,_,l),r)) =
! if pd < 1 then pps "<LET*>" else
(openHOVBox 5;
! pps "(APP)";
! ppl (pd-1) (LET(v, r, l));
closeBox())
! | ppl pd (LET(v, r, l)) =
! if pd < 1 then pps "<LET>" else
(openHVBox 2;
openHOVBox 4;
! pps (lvarName v); br1 0; pps "="; br1 0; ppl (pd-1) r;
closeBox();
newline();
! ppl (pd-1) l;
closeBox())
! | ppl pd (APP(l, r)) =
! if pd < 1 then pps "<APP>" else
(pps "APP(";
openHVBox 0;
! ppl (pd-1) l; pps ","; br1 0; ppl (pd-1) r;
closeBox();
pps ")")
! | ppl pd (TFN(ks, b)) =
! if pd < 1 then pps "<TFN>" else
! (openHOVBox 0;
! pps "TFN(";
openHVBox 0;
ppClosedSeq ("(",",",")") (PPLty.ppTKind (pd-1)) ks; br1 0;
! ppl (pd-1) b;
closeBox();
pps ")";
closeBox())
! | ppl pd (TAPP(l, ts)) =
! if pd < 1 then pps "<TAP>" else
(openHOVBox 0;
! pps "TAP(";
openHVBox 0;
! ppl (pd-1) l; br1 0;
ppClosedSeq ("[",",","]") (PPLty.ppTyc (pd-1)) ts;
closeBox();
***************
*** 231,246 ****
closeBox())
! | ppl (GENOP(dict, p, t, ts)) =
! (openHOVBox 4;
! pps "GEN(";
! openHOVBox 0;
! pps(PrimOp.prPrimop p); pps ","; br1 0;
! ppLty' t; br1 0;
! ppClosedSeq ("[",",","]") (PPLty.ppTyc (pd-1)) ts;
! closeBox();
! pps ")";
! closeBox ())
! | ppl (PACK(lt, ts, nts, l)) =
(openHOVBox 0;
pps "PACK(";
--- 241,258 ----
closeBox())
! | ppl pd (GENOP(dict, p, t, ts)) =
! if pd < 1 then pps "<GEN>" else
! (openHOVBox 4;
! pps "GEN(";
! openHOVBox 0;
! pps(PrimOp.prPrimop p); pps ","; br1 0;
! ppLty' t; br1 0;
! ppClosedSeq ("[",",","]") (PPLty.ppTyc (pd-1)) ts;
! closeBox();
! pps ")";
! closeBox ())
! | ppl pd (PACK(lt, ts, nts, l)) =
! if pd < 1 then pps "<PACK>" else
(openHOVBox 0;
pps "PACK(";
***************
*** 253,269 ****
closeBox(); br1 0;
ppLty' lt; pps ","; br1 0;
! ppl l;
closeBox();
pps ")";
closeBox())
! | ppl (SWITCH (l,_,llist,default)) =
let fun switch [(c,l)] =
(openHOVBox 2;
! pps (conToString c); pps " =>"; br1 0; ppl l;
closeBox())
| switch ((c,l)::more) =
(openHOVBox 2;
! pps (conToString c); pps " =>"; br1 0; ppl l;
closeBox();
newline();
--- 265,282 ----
closeBox(); br1 0;
ppLty' lt; pps ","; br1 0;
! ppl (pd-1) l;
closeBox();
pps ")";
closeBox())
! | ppl pd (SWITCH (l,_,llist,default)) =
! if pd < 1 then pps "<SWI>" else
let fun switch [(c,l)] =
(openHOVBox 2;
! pps (conToString c); pps " =>"; br1 0; ppl (pd-1) l;
closeBox())
| switch ((c,l)::more) =
(openHOVBox 2;
! pps (conToString c); pps " =>"; br1 0; ppl (pd-1) l;
closeBox();
newline();
***************
*** 273,277 ****
in openHOVBox 3;
pps "SWI";
! ppl l; newline();
pps "of ";
openHVBox 0;
--- 286,290 ----
in openHOVBox 3;
pps "SWI";
! ppl (pd-1) l; newline();
pps "of ";
openHVBox 0;
***************
*** 279,287 ****
case (default,llist)
of (NONE,_) => ()
! | (SOME l,nil) => (openHOVBox 2; pps "_ =>"; br1 0; ppl l;
closeBox())
| (SOME l,_) => (newline();
openHOVBox 2;
! pps "_ =>"; br1 0; ppl l;
closeBox());
closeBox();
--- 292,300 ----
case (default,llist)
of (NONE,_) => ()
! | (SOME l,nil) => (openHOVBox 2; pps "_ =>"; br1 0; ppl (pd-1)l;
closeBox())
| (SOME l,_) => (newline();
openHOVBox 2;
! pps "_ =>"; br1 0; ppl (pd-1) l;
closeBox());
closeBox();
***************
*** 289,298 ****
end
! | ppl (FIX(varlist,ltylist,lexplist,lexp)) =
let fun flist([v],[t],[l]) =
let val lv = lvarName v
val len = size lv + 2
in pps lv; pps ": "; ppLty' t; pps " :: ";
! ppl l
end
| flist(v::vs,t::ts,l::ls) =
--- 302,312 ----
end
! | ppl pd (FIX(varlist,ltylist,lexplist,lexp)) =
! if pd < 1 then pps "<FIX>" else
let fun flist([v],[t],[l]) =
let val lv = lvarName v
val len = size lv + 2
in pps lv; pps ": "; ppLty' t; pps " :: ";
! ppl (pd-1) l
end
| flist(v::vs,t::ts,l::ls) =
***************
*** 300,304 ****
val len = size lv + 2
in pps lv; pps ": "; ppLty' t; pps " :: ";
! ppl l; newline();
flist(vs,ts,ls)
end
--- 314,318 ----
val len = size lv + 2
in pps lv; pps ": "; ppLty' t; pps " :: ";
! ppl (pd-1) l; newline();
flist(vs,ts,ls)
end
***************
*** 310,351 ****
openHVBox 0; flist(varlist,ltylist,lexplist); closeBox();
newline(); pps "IN ";
! ppl lexp;
pps ")";
closeBox()
end
! | ppl (RAISE(l,t)) =
(openHOVBox 0;
pps "RAISE(";
openHVBox 0;
! ppLty' t; pps ","; br1 0; ppl l;
closeBox();
pps ")";
closeBox())
! | ppl (HANDLE (lexp,withlexp)) =
(openHOVBox 0;
! pps "HANDLE"; br1 0; ppl lexp;
newline();
! pps "WITH"; br1 0; ppl withlexp;
closeBox())
! | ppl (WRAP(t, _, l)) =
(openHOVBox 0;
pps "WRAP("; ppTyc' t; pps ",";
newline();
! ppl l;
pps ")";
closeBox())
! | ppl (UNWRAP(t, _, l)) =
(openHOVBox 0;
pps "UNWRAP("; ppTyc' t; pps ",";
newline();
! ppl l;
pps ")";
closeBox())
! in ppl l; newline(); newline()
end
--- 324,369 ----
openHVBox 0; flist(varlist,ltylist,lexplist); closeBox();
newline(); pps "IN ";
! ppl (pd-1) lexp;
pps ")";
closeBox()
end
! | ppl pd (RAISE(l,t)) =
! if pd < 1 then pps "<RAISE>" else
(openHOVBox 0;
pps "RAISE(";
openHVBox 0;
! ppLty' t; pps ","; br1 0; ppl (pd-1) l;
closeBox();
pps ")";
closeBox())
! | ppl pd (HANDLE (lexp,withlexp)) =
! if pd < 1 then pps "<HANDLE>" else
(openHOVBox 0;
! pps "HANDLE"; br1 0; ppl (pd-1) lexp;
newline();
! pps "WITH"; br1 0; ppl (pd-1) withlexp;
closeBox())
! | ppl pd (WRAP(t, _, l)) =
! if pd < 1 then pps "<WRAP>" else
(openHOVBox 0;
pps "WRAP("; ppTyc' t; pps ",";
newline();
! ppl (pd-1) l;
pps ")";
closeBox())
! | ppl pd (UNWRAP(t, _, l)) =
! if pd < 1 then pps "<WRAP>" else
(openHOVBox 0;
pps "UNWRAP("; ppTyc' t; pps ",";
newline();
! ppl (pd-1) l;
pps ")";
closeBox())
! in ppl pd l; newline(); newline()
end
-------------------------------------------------------------------------
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