CVS: sml-dist/src/compiler/FLINT/plambda flintnm.sml, 1.17.10.2, 1.17.10.3

Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/plambda
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv6474/plambda

Modified Files:
      Tag: primop-branch-2
	flintnm.sml 
Log Message:
debugging info flintnm and translate

Index: flintnm.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/plambda/flintnm.sml,v
retrieving revision 1.17.10.2
retrieving revision 1.17.10.3
diff -C2 -d -r1.17.10.2 -r1.17.10.3
*** flintnm.sml	18 Jul 2006 19:46:35 -0000	1.17.10.2
--- flintnm.sml	24 Jul 2006 23:07:36 -0000	1.17.10.3
***************
*** 23,27 ****
--- 23,34 ----
  in
  
+ (* debugging *)
  val say = Control_Print.say
+ 
+ val debugging = ref false;
+ fun debugmsg (msg : string) = 
+     if !debugging then (say msg; say "\n") else ()
+ 
+ 
  val mkv = LambdaVar.mkLvar
  val cplv = LambdaVar.dupLvar
***************
*** 117,132 ****
          (* first, we translate the body (in the extended env) *)
          tolexp (LT.ltInsert(venv, arg_lv, arg_lty, d), d) body
! 	val _ = print "tofundec detuple arg type\n"
          (* detuple the arg type *)
  	val ((arg_raw, arg_ltys, _), unflatten) = FL.v_punflatten arg_lty
!         val _ = print "unflatten body\n"    
          (* now, we add tupling code at the beginning of the body *)
          val (arg_lvs, body'') = unflatten(arg_lv, body')
! 	val _ = print "construct return type\n"
  	(* construct the return type if necessary *)
  	val (body_raw, body_ltys, _) = FL.t_pflatten body_lty
  	val rettype = if not isrec then NONE
  		      else SOME(map FL.ltc_raw body_ltys, F.LK_UNKNOWN)
! 	val _ = print "Handle fcn or fct\n"
  	val (f_lty, fkind) =
  	    if (LT.ltp_tyc arg_lty andalso LT.ltp_tyc body_lty) then
--- 124,139 ----
          (* first, we translate the body (in the extended env) *)
          tolexp (LT.ltInsert(venv, arg_lv, arg_lty, d), d) body
! 	val _ =  debugmsg ">>tofundec detuple arg type"
          (* detuple the arg type *)
  	val ((arg_raw, arg_ltys, _), unflatten) = FL.v_punflatten arg_lty
!         val _ = debugmsg ">>unflatten body"    
          (* now, we add tupling code at the beginning of the body *)
          val (arg_lvs, body'') = unflatten(arg_lv, body')
! 	val _ = debugmsg ">>construct return type"
  	(* construct the return type if necessary *)
  	val (body_raw, body_ltys, _) = FL.t_pflatten body_lty
  	val rettype = if not isrec then NONE
  		      else SOME(map FL.ltc_raw body_ltys, F.LK_UNKNOWN)
! 	val _ = debugmsg ">>Handle fcn or fct"
  	val (f_lty, fkind) =
  	    if (LT.ltp_tyc arg_lty andalso LT.ltp_tyc body_lty) then


-------------------------------------------------------------------------
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