CVS: sml-dist/src/compiler/FLINT/plambda chkplexp.sml, 1.9.10.8, 1.9.10.9 pplexp.sml, 1.4.10.2, 1.4.10.3
George Kuan <[email protected]> Thu, 24 Aug 2006 12:17:48 -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-serv23469/src/compiler/FLINT/plambda
Modified Files:
Tag: primop-branch-2
chkplexp.sml pplexp.sml
Log Message:
pplexp uses new pplty/pptkind pretty printers
Index: chkplexp.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/plambda/chkplexp.sml,v
retrieving revision 1.9.10.8
retrieving revision 1.9.10.9
diff -C2 -d -r1.9.10.8 -r1.9.10.9
*** chkplexp.sml 24 Aug 2006 19:09:41 -0000 1.9.10.8
--- chkplexp.sml 24 Aug 2006 19:17:46 -0000 1.9.10.9
***************
*** 255,259 ****
(ltyChkenv " PRIM " t;
map (tycChk kenv) ts;
! debugmsg " PRIM \n";
ltTyApp le "PRIM" (t, ts, kenv))
--- 255,259 ----
(ltyChkenv " PRIM " t;
map (tycChk kenv) ts;
! debugmsg " PRIM";
ltTyApp le "PRIM" (t, ts, kenv))
***************
*** 264,271 ****
val res = check (kenv, venv', d) e1
val _ = ltyChkenv "FN rng" res
! val _ = debugmsg " FN \n"
val fnlty = ltFun(t, res) (* handle both functions and functors *)
val _ = ltyChkenv "FNlty " fnlty
! val _ = debugmsg " FN 2 \n"
in fnlty
end
--- 264,271 ----
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
***************
*** 282,286 ****
val _ = map (ltyChkenv "FIX body types") nts
val _ = app2(ltMatch le "FIX1", ts, nts)
! val _ = debugmsg " FIX \n"
in check (kenv, venv', d) eb
end
--- 282,286 ----
val _ = map (ltyChkenv "FIX body types") nts
val _ = app2(ltMatch le "FIX1", ts, nts)
! val _ = debugmsg " FIX"
in check (kenv, venv', d) eb
end
***************
*** 291,295 ****
val _ = ltyChkenv "APP operator " top
val _ = ltyChkenv "APP argument " targ
! val _ = debugmsg " APP \n"
in
ltFnApp le "APP" (top, targ)
--- 291,295 ----
val _ = ltyChkenv "APP operator " top
val _ = ltyChkenv "APP argument " targ
! val _ = debugmsg " APP"
in
ltFnApp le "APP" (top, targ)
***************
*** 302,306 ****
val bodyLty = check (kenv, venv', d) e2
val _ = ltyChkenv "LET body" bodyLty
! val _ = debugmsg "LET \n"
in bodyLty
end
--- 302,306 ----
val bodyLty = check (kenv, venv', d) e2
val _ = ltyChkenv "LET body" bodyLty
! val _ = debugmsg "LET"
in bodyLty
end
***************
*** 310,314 ****
val lt = check (kenv', venv, DI.next d) e
val _ = ltyChkMsgLexp "TFN body" (ks::kenv) lt
! val _ = debugmsg " TFN\n"
in LT.ltc_poly(ks, [lt])
end
--- 310,314 ----
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
***************
*** 319,323 ****
(* kind check type args *)
val _ = ltyChkenv "TAPP type function " lt
! val _ = debugmsg " TAPP \n"
in ltTyApp le "TAPP" (lt, ts, kenv)
end
--- 319,323 ----
(* kind check type args *)
val _ = ltyChkenv "TAPP type function " lt
! val _ = debugmsg " TAPP"
in ltTyApp le "TAPP" (lt, ts, kenv)
end
***************
*** 333,337 ****
val bodyTy = loop e
val _ = ltyChkenv " PACK body " bodyTy
! val _ = debugmsg "PACK \n"
in ltMatch le "PACK-M" (argTy, loop e);
ltTyApp le "PACK-R" (lt, nts, kenv)
--- 333,337 ----
val bodyTy = loop e
val _ = ltyChkenv " PACK body " bodyTy
! val _ = debugmsg "PACK"
in ltMatch le "PACK-M" (argTy, loop e);
ltTyApp le "PACK-R" (lt, nts, kenv)
***************
*** 343,347 ****
val t2 = loop e
val _ = ltyChkenv "CON 2 " t2
! val _ = debugmsg " CON\n"
in ltFnApp le "CON-A" (t1, t2)
end
--- 343,347 ----
val t2 = loop e
val _ = ltyChkenv "CON 2 " t2
! val _ = debugmsg " CON"
in ltFnApp le "CON-A" (t1, t2)
end
***************
*** 356,360 ****
let val elemsltys = map loop el
val _ = map (ltyChkenv "RECORD elem ") elemsltys
! val _ = debugmsg " RECORD \n"
in ltTup elemsltys
end
--- 356,360 ----
let val elemsltys = map loop el
val _ = map (ltyChkenv "RECORD elem ") elemsltys
! val _ = debugmsg " RECORD"
in ltTup elemsltys
end
***************
*** 369,373 ****
map (ltyChkenv "VECTOR vector ") ts;
app (fn x => ltMatch le "VECTOR" (x, LT.ltc_tyc t)) ts;
! debugmsg " VECTOR\n ";
ltVector t
end
--- 369,373 ----
map (ltyChkenv "VECTOR vector ") ts;
app (fn x => ltMatch le "VECTOR" (x, LT.ltc_tyc t)) ts;
! debugmsg " VECTOR ";
ltVector t
end
***************
*** 376,380 ****
let val lty = loop e
val _ = ltyChkenv " SELECT " lty
! val _ = debugmsg " SELECT \n"
in
ltSelect le "SEL" (lty, i)
--- 376,380 ----
let val lty = loop e
val _ = ltyChkenv " SELECT " lty
! val _ = debugmsg " SELECT"
in
ltSelect le "SEL" (lty, i)
***************
*** 389,393 ****
val ts = map h cl
val _ = map (ltyChkenv "SWITCH branch ") ts
! val _ = debugmsg "SWITCH\n"
in (case ts
of [] => bug "empty switch in checkLty"
--- 389,393 ----
val ts = map h cl
val _ = map (ltyChkenv "SWITCH branch ") ts
! val _ = debugmsg "SWITCH"
in (case ts
of [] => bug "empty switch in checkLty"
***************
*** 411,415 ****
let val exlty = loop e
val _ = ltyChkenv "RAISE " exlty
! val _ = debugmsg "RAISE\n"
in
(ltMatch le "RAISE" (exlty, ltExn); t)
--- 411,415 ----
let val exlty = loop e
val _ = ltyChkenv "RAISE " exlty
! val _ = debugmsg "RAISE"
in
(ltMatch le "RAISE" (exlty, ltExn); t)
***************
*** 422,426 ****
val arg = ltFnAppR le "HANDLE" (loop e2, t1)
val _ = ltyChkenv "HANDLE arg " arg
! val _ = debugmsg "HANDLE\n"
in t1 (* [GK] Is this right?? *)
end
--- 422,426 ----
val arg = ltFnAppR le "HANDLE" (loop e2, t1)
val _ = ltyChkenv "HANDLE arg " arg
! val _ = debugmsg "HANDLE"
in t1 (* [GK] Is this right?? *)
end
Index: pplexp.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/plambda/pplexp.sml,v
retrieving revision 1.4.10.2
retrieving revision 1.4.10.3
diff -C2 -d -r1.4.10.2 -r1.4.10.3
*** pplexp.sml 11 Aug 2006 20:42:24 -0000 1.4.10.2
--- pplexp.sml 24 Aug 2006 19:17:46 -0000 1.4.10.3
***************
*** 29,32 ****
--- 29,33 ----
in
+ val depth = ref 20
val say = Control.Print.say
fun sayrep rep = say (DA.prRep rep)
***************
*** 112,121 ****
fun printLexp l =
! let fun prLty t = say (LT.lt_print t)
fun prTyc t = PPN.with_default_pp
! (fn ppstrm => (PPLty.ppTyc 20 ppstrm t;
PPN.flushStream ppstrm))
! (* say (LT.tc_print t) *)
! fun prKnd k = say (LT.tk_print k)
fun plist (p, [], sep) = ()
--- 113,123 ----
fun printLexp l =
! let fun prLty t = PPN.with_default_pp
! (fn ppstrm => (PPLty.ppLty (!depth) ppstrm t))
fun prTyc t = PPN.with_default_pp
! (fn ppstrm => (PPLty.ppTyc (!depth) ppstrm t;
PPN.flushStream ppstrm))
! fun prKnd k = PPN.with_default_pp
! (fn ppstrm => (PPLty.ppTKind (!depth) ppstrm k))
fun plist (p, [], sep) = ()
-------------------------------------------------------------------------
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