CVS: sml-dist/src/compiler/FLINT/trans matchcomp.sml, 1.7.4.1, 1.7.4.2 pequal.sml, 1.7, 1.7.2.1 translate.sml, 1.33.4.24, 1.33.4.25 transtypes.sml, 1.5.10.10, 1.5.10.11
David MacQueen <[email protected]> Sun, 27 Aug 2006 22:12:13 -0700
| Newsgroups | gmane.comp.lang.sml.smlnj.commits |
|---|---|
| Message-ID | <[email protected]> |
Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv26302/src/compiler/FLINT/trans
Modified Files:
Tag: primop-branch-2
matchcomp.sml pequal.sml translate.sml transtypes.sml
Log Message:
switched all pretty printing to use PrettyPrintNew
Index: matchcomp.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/matchcomp.sml,v
retrieving revision 1.7.4.1
retrieving revision 1.7.4.2
diff -C2 -d -r1.7.4.1 -r1.7.4.2
*** matchcomp.sml 11 Jul 2006 23:00:41 -0000 1.7.4.1
--- matchcomp.sml 28 Aug 2006 05:12:11 -0000 1.7.4.2
***************
*** 46,54 ****
structure TP = Types
structure LN = LiteralToNum
! structure PP = PrettyPrint
open VarCon Types
open Absyn PLambda
! open PrettyPrint
open TemplateExpansion MCCommon
--- 46,54 ----
structure TP = Types
structure LN = LiteralToNum
! structure PP = PrettyPrintNew
open VarCon Types
open Absyn PLambda
! open PrettyPrintNew
open TemplateExpansion MCCommon
***************
*** 62,65 ****
--- 62,68 ----
fun bug s = EM.impossible ("MatchComp: " ^ s)
val say = Control.Print.say
+ val pd = ref 20
+ fun ppLexp le = PP.with_default_pp(fn ppstrm => MP.ppLexp (!pd) ppstrm le)
+
type toTcLt = (ty -> LT.tyc) * (ty -> LT.lty)
***************
*** 1236,1240 ****
fun bindCompile (env, rules, finish, rootv, toTcLt, err, giis) =
let val _ =
! if !printArgs then (say "MC called with:"; MP.printMatch env rules)
else ()
val (code, _, _, exhaustive) =
--- 1239,1243 ----
fun bindCompile (env, rules, finish, rootv, toTcLt, err, giis) =
let val _ =
! if !printArgs then (say "MC called with:"; MP.ppMatch env rules)
else ()
val (code, _, _, exhaustive) =
***************
*** 1257,1261 ****
if !printRet then
! (say "MC: returns with\n"; MP.printLexp code)
else ();
code
--- 1260,1264 ----
if !printRet then
! (say "MC: returns with\n"; ppLexp code)
else ();
code
***************
*** 1271,1275 ****
fun handCompile (env, rules, finish, rootv, toTcLt, err, giis) =
let val _ =
! if !printArgs then (say "MC called with: "; MP.printMatch env rules)
else ()
val (code, unused, redundant, _) =
--- 1274,1278 ----
fun handCompile (env, rules, finish, rootv, toTcLt, err, giis) =
let val _ =
! if !printArgs then (say "MC called with: "; MP.ppMatch env rules)
else ()
val (code, unused, redundant, _) =
***************
*** 1285,1289 ****
if !printRet
! then (say "MC: returns with\n"; MP.printLexp code)
else ();
code
--- 1288,1292 ----
if !printRet
! then (say "MC: returns with\n"; ppLexp code)
else ();
code
***************
*** 1301,1305 ****
fun matchCompile (env, rules, finish, rootv, toTcLt, err, giis) =
let val _ =
! if !printArgs then (say "MC called with: "; MP.printMatch env rules)
else ()
val (code, unused, redundant, exhaustive) =
--- 1304,1308 ----
fun matchCompile (env, rules, finish, rootv, toTcLt, err, giis) =
let val _ =
! if !printArgs then (say "MC called with: "; MP.ppMatch env rules)
else ()
val (code, unused, redundant, exhaustive) =
***************
*** 1330,1334 ****
if (!printRet)
! then (say "MatchComp: returns with\n"; MP.printLexp code) else ();
code
end
--- 1333,1337 ----
if (!printRet)
! then (say "MatchComp: returns with\n"; ppLexp code) else ();
code
end
Index: pequal.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/pequal.sml,v
retrieving revision 1.7
retrieving revision 1.7.2.1
diff -C2 -d -r1.7 -r1.7.2.1
*** pequal.sml 14 Oct 2005 21:24:05 -0000 1.7
--- pequal.sml 28 Aug 2006 05:12:11 -0000 1.7.2.1
***************
*** 30,34 ****
structure SE = StaticEnv
structure PO = PrimOp
! structure PP = PrettyPrint
open Types PLambda
--- 30,34 ----
structure SE = StaticEnv
structure PO = PrimOp
! structure PP = PrettyPrintNew
open Types PLambda
Index: translate.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/translate.sml,v
retrieving revision 1.33.4.24
retrieving revision 1.33.4.25
diff -C2 -d -r1.33.4.24 -r1.33.4.25
*** translate.sml 24 Aug 2006 19:09:41 -0000 1.33.4.24
--- translate.sml 28 Aug 2006 05:12:11 -0000 1.33.4.25
***************
*** 29,33 ****
structure MC = MatchComp
structure PO = PrimOp
! structure PP = PrettyPrint
structure S = Symbol
structure SP = SymPath
--- 29,33 ----
structure MC = MatchComp
structure PO = PrimOp
! structure PP = PrettyPrintNew
structure S = Symbol
structure SP = SymPath
***************
*** 63,66 ****
--- 63,69 ----
("type: ",PPType.ppType StaticEnv.empty, ty))
+ fun ppLexp lexp =
+ PP.with_default_pp(fn s => PPLexp.ppLexp 20 s lexp)
+
fun ident x = x
val unitLexp = RECORD []
***************
*** 1237,1246 ****
(let val _ = debugmsg ">>mkExp CONexp: "
val c = mkCE(dc, ts, NONE, d)
! val _ = if !debugging then PPLexp.printLexp c else ()
in c end)
| g (APPexp (CONexp(dc, ts), e2)) =
(let val _ = debugmsg ">>mkExp APPexp: "
val c = mkCE(dc, ts, SOME(g e2), d)
! val _ = if !debugging then PPLexp.printLexp c else ()
in c end)
| g (INTexp (s, t)) =
--- 1240,1249 ----
(let val _ = debugmsg ">>mkExp CONexp: "
val c = mkCE(dc, ts, NONE, d)
! val _ = if !debugging then ppLexp c else ()
in c end)
| g (APPexp (CONexp(dc, ts), e2)) =
(let val _ = debugmsg ">>mkExp APPexp: "
val c = mkCE(dc, ts, SOME(g e2), d)
! val _ = if !debugging then ppLexp c else ()
in c end)
| g (INTexp (s, t)) =
***************
*** 1488,1492 ****
fun prGen (flag,printE) s e =
if !flag then (say ("\n\n[After " ^ s ^ " ...]\n\n"); printE e) else ()
! val _ = prGen(Control.FLINT.print, PPLexp.printLexp) "Translate" plexp
(** normalizing the plambda expression into FLINT *)
--- 1491,1495 ----
fun prGen (flag,printE) s e =
if !flag then (say ("\n\n[After " ^ s ^ " ...]\n\n"); printE e) else ()
! val _ = prGen(Control.FLINT.print, ppLexp) "Translate" plexp
(** normalizing the plambda expression into FLINT *)
Index: transtypes.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/transtypes.sml,v
retrieving revision 1.5.10.10
retrieving revision 1.5.10.11
diff -C2 -d -r1.5.10.10 -r1.5.10.11
*** transtypes.sml 24 Aug 2006 19:28:41 -0000 1.5.10.10
--- transtypes.sml 28 Aug 2006 05:12:11 -0000 1.5.10.11
***************
*** 32,35 ****
--- 32,36 ----
structure SE = StaticEnv
structure TU = TypesUtil
+ structure PP = PrettyPrintNew
open Types Modules ElabDebug
in
***************
*** 44,51 ****
EM.errorNoFile(EM.defaultConsumer(),ref false) SourceMap.nullRegion
- local
- structure PP = PrettyPrint
- in
val env = StaticEnv.empty
fun ppType x =
((PP.with_pp (EM.defaultConsumer())
--- 45,50 ----
EM.errorNoFile(EM.defaultConsumer(),ref false) SourceMap.nullRegion
val env = StaticEnv.empty
+
fun ppType x =
((PP.with_pp (EM.defaultConsumer())
***************
*** 56,72 ****
fun ppTycon x =
! ((PP.with_pp (EM.defaultConsumer())
! (fn ppstrm => (PP.string ppstrm "find: ";
! PPType.resetPPType();
! PPType.ppTycon env ppstrm x)))
! handle _ => say "fail to print anything")
! end
- local
- structure PPN = PrettyPrintNew
- in
fun ppLtyc ltyc =
! PPN.with_default_pp (fn ppstrm => PPLty.ppTyc 20 ppstrm ltyc)
! end
(****************************************************************************
--- 55,68 ----
fun ppTycon x =
! ((PP.with_pp (EM.defaultConsumer())
! (fn ppstrm => (PP.string ppstrm "find: ";
! PPType.resetPPType();
! PPType.ppTycon env ppstrm x)))
! handle _ => say "fail to print anything")
!
fun ppLtyc ltyc =
! PP.with_default_pp (fn ppstrm => PPLty.ppTyc 20 ppstrm ltyc)
!
(****************************************************************************
-------------------------------------------------------------------------
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