CVS: sml-dist/src/compiler/FLINT/plambda flintnm.sml, 1.17, 1.17.10.1

George Kuan <[email protected]> Thu, 13 Jul 2006 11:21:41 -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-serv15657/src/compiler/FLINT/plambda

Modified Files:
      Tag: primop-branch-2
	flintnm.sml 
Log Message:


Index: flintnm.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/plambda/flintnm.sml,v
retrieving revision 1.17
retrieving revision 1.17.10.1
diff -C2 -d -r1.17 -r1.17.10.1
*** flintnm.sml	28 Aug 2003 21:59:07 -0000	1.17
--- flintnm.sml	13 Jul 2006 18:21:38 -0000	1.17.10.1
***************
*** 110,128 ****
  
  fun tofundec (venv,d,f_lv,arg_lv,arg_lty,body,isrec) =
!     let val (body',body_lty) =
          (* first, we translate the body (in the extended env) *)
          tolexp (LT.ltInsert(venv, arg_lv, arg_lty, d), d) body
! 
          (* detuple the arg type *)
  	val ((arg_raw, arg_ltys, _), unflatten) = FL.v_punflatten arg_lty
!             
          (* now, we add tupling code at the beginning of the body *)
          val (arg_lvs, body'') = unflatten(arg_lv, body')
! 
  	(* 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 (f_lty, fkind) =
  	    if (LT.ltp_tyc arg_lty andalso LT.ltp_tyc body_lty) then
--- 110,132 ----
  
  fun tofundec (venv,d,f_lv,arg_lv,arg_lty,body,isrec) =
!     let val _ = (print (concat ["tofundec translate body: ", 
! 				(LtyBasic.lt_print arg_lty),
! 				" "]);
! 		 PPLexp.printLexp body; print "\n")
! 	val (body',body_lty) =
          (* 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



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