CVS: sml-dist/src/compiler/FLINT/trans translate.sml, 1.33.4.13, 1.33.4.14
George Kuan <[email protected]> Mon, 24 Jul 2006 16:07:39 -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-serv6474/trans
Modified Files:
Tag: primop-branch-2
translate.sml
Log Message:
debugging info flintnm and translate
Index: translate.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/trans/translate.sml,v
retrieving revision 1.33.4.13
retrieving revision 1.33.4.14
diff -C2 -d -r1.33.4.13 -r1.33.4.14
*** translate.sml 18 Jul 2006 14:15:36 -0000 1.33.4.13
--- translate.sml 24 Jul 2006 23:07:36 -0000 1.33.4.14
***************
*** 49,55 ****
****************************************************************************)
! val debugging = ref true
fun bug msg = EM.impossible("Translate: " ^ msg)
val say = Control.Print.say
val ppDepth = Control.Print.printDepth
--- 49,59 ----
****************************************************************************)
! val debugging = ref false
fun bug msg = EM.impossible("Translate: " ^ msg)
val say = Control.Print.say
+
+ fun debugmsg (msg : string) =
+ if !debugging then (say msg; say "\n") else ()
+
val ppDepth = Control.Print.printDepth
***************
*** 312,318 ****
let val nt = toDconLty DI.top typ
val nrep = mkRep(rep, nt, name)
! val _ = print "coreExn in translate.sml: "
! val _ = PPLexp.printLexp (CON'((name, nrep, nt), [], unitLexp))
! val _ = print "\n"
in CON'((name, nrep, nt), [], unitLexp)
end
--- 316,322 ----
let val nt = toDconLty DI.top typ
val nrep = mkRep(rep, nt, name)
! val _ = debugmsg ">>coreExn in translate.sml: "
! (* val _ = PPLexp.printLexp (CON'((name, nrep, nt), [], unitLexp))
! val _ = print "\n" *)
in CON'((name, nrep, nt), [], unitLexp)
end
***************
*** 859,863 ****
of (SOME p, SOME t) => (p,t)
| _ => bug "mkVE: unrecognized primop name"
! val _ = print "mkVE: before matchInstTypes\n"
val intrinsicParams =
(* compute intrinsic instantiation params of intrinsicType *)
--- 863,867 ----
of (SOME p, SOME t) => (p,t)
| _ => bug "mkVE: unrecognized primop name"
! val _ = debugmsg ">>mkVE: before matchInstTypes"
val intrinsicParams =
(* compute intrinsic instantiation params of intrinsicType *)
***************
*** 886,890 ****
PPType.ppType env ppstrm (#1 (TU.instantiatePoly intrinsicType))));
bug "primop intrinsic type doesn't match occurrence type")
! val _ = print "mkVE: after matchInstTypes\n"
in case (primop, intrinsicParams)
of (PO.POLYEQL, [t]) => eqGen(intrinsicType, t, toTcLt d)
--- 890,894 ----
PPType.ppType env ppstrm (#1 (TU.instantiatePoly intrinsicType))));
bug "primop intrinsic type doesn't match occurrence type")
! val _ = debugmsg "<<mkVE: after matchInstTypes"
in case (primop, intrinsicParams)
of (PO.POLYEQL, [t]) => eqGen(intrinsicType, t, toTcLt d)
***************
*** 1167,1177 ****
***************************************************************************)
and mkDec (dec, d) =
! let fun g (VALdec vbs) = (print "VALdec"; mkVBs(vbs, d))
! | g (VALRECdec rvbs) = (print "VALRECdec"; mkRVBs(rvbs, d))
| g (ABSTYPEdec{body,...}) = g body
! | g (EXCEPTIONdec ebs) = (print "EXCEPTIONdec"; mkEBs(ebs, d))
! | g (STRdec sbs) = (print "STRdec"; mkStrbs(sbs, d))
! | g (ABSdec sbs) = (print "ABSdec"; mkStrbs(sbs, d))
! | g (FCTdec fbs) = (print "FCTdec"; mkFctbs(fbs, d))
| g (LOCALdec(ld, vd)) = (g ld) o (g vd)
| g (SEQdec ds) = foldr (op o) ident (map g ds)
--- 1171,1181 ----
***************************************************************************)
and mkDec (dec, d) =
! let fun g (VALdec vbs) = mkVBs(vbs, d)
! | g (VALRECdec rvbs) = mkRVBs(rvbs, d)
| g (ABSTYPEdec{body,...}) = g body
! | g (EXCEPTIONdec ebs) = mkEBs(ebs, d)
! | g (STRdec sbs) = mkStrbs(sbs, d)
! | g (ABSdec sbs) = mkStrbs(sbs, d)
! | g (FCTdec fbs) = mkFctbs(fbs, d)
| g (LOCALdec(ld, vd)) = (g ld) o (g vd)
| g (SEQdec ds) = foldr (op o) ident (map g ds)
***************
*** 1202,1217 ****
and g (VARexp (ref v, ts)) =
! (print "mkExp VARexp\n"; mkVE(v, map TP.VARty ts, d))
! | g (CONexp (dc, ts)) = (let val _ = print "mkExp CONexp: "
! val c = mkCE(dc, ts, NONE, d)
! val _ = PPLexp.printLexp c
! in c end)
! | g (APPexp (CONexp(dc, ts), e2)) = (let val _ = print "mkExp APPexp: "
! val c = mkCE(dc, ts, SOME(g e2), d)
! val _ = PPLexp.printLexp c
! in c end)
| g (INTexp (s, t)) =
! (print "mkExp INTexp\n";
((if TU.equalType (t, BT.intTy) then INT (LN.int s)
else if TU.equalType (t, BT.int32Ty) then INT32 (LN.int32 s)
--- 1206,1223 ----
and g (VARexp (ref v, ts)) =
! (debugmsg ">>mkExp VARexp"; mkVE(v, map TP.VARty ts, d))
! | g (CONexp (dc, ts)) =
! (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)) =
! (debugmsg ">>mkExp INTexp";
((if TU.equalType (t, BT.intTy) then INT (LN.int s)
else if TU.equalType (t, BT.int32Ty) then INT32 (LN.int32 s)
***************
*** 1225,1229 ****
| g (WORDexp(s, t)) =
! (print "WORDexp\n";
((if TU.equalType (t, BT.wordTy) then WORD (LN.word s)
else if TU.equalType (t, BT.word8Ty) then WORD (LN.word8 s)
--- 1231,1235 ----
| g (WORDexp(s, t)) =
! (debugmsg ">>WORDexp";
((if TU.equalType (t, BT.wordTy) then WORD (LN.word s)
else if TU.equalType (t, BT.word8Ty) then WORD (LN.word8 s)
***************
*** 1437,1444 ****
val exportLexp = SRECORD (map VAR exportLvars)
! val _ = print "pre-mkDec\n"
(** translating the ML absyn into the PLambda expression *)
val body = mkDec (rootdec, DI.top) exportLexp
! val _ = print "post-mkDec\n"
(** add bindings for intinf constants *)
--- 1443,1450 ----
val exportLexp = SRECORD (map VAR exportLvars)
! val _ = debugmsg ">>mkDec"
(** translating the ML absyn into the PLambda expression *)
val body = mkDec (rootdec, DI.top) exportLexp
! val _ = debugmsg "<<mkDec"
(** add bindings for intinf constants *)
***************
*** 1453,1459 ****
(** normalizing the plambda expression into FLINT *)
! val flint = let val _ = print "prenorm\n"
val n = FlintNM.norm plexp
! val _ = print "postnorm\n"
in n end
--- 1459,1465 ----
(** normalizing the plambda expression into FLINT *)
! val flint = let val _ = debugmsg ">>norm"
val n = FlintNM.norm plexp
! val _ = debugmsg "<<postnorm"
in n end
-------------------------------------------------------------------------
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