CVS: sml-dist/src/compiler/FLINT/plambda flintnm.sml, 1.17.10.14, 1.17.10.15

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

Modified Files:
      Tag: primop-branch-2
	flintnm.sml 
Log Message:
Narrowed down where bad suspension was built

Index: flintnm.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/plambda/flintnm.sml,v
retrieving revision 1.17.10.14
retrieving revision 1.17.10.15
diff -C2 -d -r1.17.10.14 -r1.17.10.15
*** flintnm.sml	8 Aug 2006 19:32:53 -0000	1.17.10.14
--- flintnm.sml	11 Aug 2006 04:09:23 -0000	1.17.10.15
***************
*** 345,351 ****
  					    (debugmsg ("tovalues cont ltys ["^
  						      Int.toString n ^"]:");
! 					     if !debugging then PPLexp.printLexp l else ();
! 					debugmsg (LtyBasic.lt_print x); scan' (xs, ls, n + 1))
! 					  | scan' _ = raise Fail "flintnm.sml:tovalues::scan'"
  				    in scan'(lts, lexps, 0)
  				    end
--- 345,356 ----
  					    (debugmsg ("tovalues cont ltys ["^
  						      Int.toString n ^"]:");
! 					     if !debugging 
! 					     then PPLexp.printLexp l else ();
! 					     debugmsg (LtyBasic.lt_print x); 
! 					     scan' (xs, ls, n + 1))
! 					  | scan' _ = 
! 					    raise Fail "flintnm.sml:\
! 							\ tovalues::scan'"
! 
  				    in scan'(lts, lexps, 0)
  				    end
***************
*** 401,405 ****
  fun ppTycEnv tenv = 
      PrettyPrintNew.with_default_pp (fn ppstrm => PPLTy.ppTycEnv ppstrm tenv)
! 
  
  	fun f [] (vals,ltys) = cont (rev vals, rev ltys)
--- 406,411 ----
  fun ppTycEnv tenv = 
      PrettyPrintNew.with_default_pp (fn ppstrm => PPLTy.ppTycEnv ppstrm tenv)
! fun ppTyc tyc =
!     PrettyPrintNew.with_default_pp (fn ppstrm => PPLTy.ppTyc ppstrm tyc)
  
  	fun f [] (vals,ltys) = cont (rev vals, rev ltys)
***************
*** 407,421 ****
  	    (debugmsg ("lexps2values ltys "^concat (map (fn x => ("\n"^LtyBasic.lt_print x)) ltys)); 
  	    tovalue(venv,d,lexp,
! 		    fn (v, lty) => (debugmsg ">>lexps2values tovalue";
  				    if !debugging then PPLexp.printLexp lexp else ();
! 				    if !debugging then debugmsg ("lty: "^ LtyBasic.lt_print lty) else ();
  		    f lexps (v::vals, lty::ltys)))) 
! 	    handle LtyKernel.tcUnbound tenv => 
! 		   (print "\n*** lexps2values ***\nlexp: "; 
  		    PPLexp.printLexp lexp;
! 		    print "\ntype: ";
! 		    (* Fill in with PPLty.pplty (lty) *)
! 		    print "\ntenv";
! 		    ppTycEnv tenv; raise LtyKernel.tcUnbound tenv)
  	val v = f lexps ([], [])
  	val _ = debugmsg "<<lexp2values"
--- 413,427 ----
  	    (debugmsg ("lexps2values ltys "^concat (map (fn x => ("\n"^LtyBasic.lt_print x)) ltys)); 
  	    tovalue(venv,d,lexp,
! 		    fn (v, lty) => ((*debugmsg ">>lexps2values tovalue";
  				    if !debugging then PPLexp.printLexp lexp else ();
! 				    if !debugging then debugmsg ("lty: "^ LtyBasic.lt_print lty) else ();*)
  		    f lexps (v::vals, lty::ltys)))) 
! 	    (* handle LtyKernel.tcUnbound (tenv,tyc) => 
! 		   (print "\n*** lexps2values ***\nlexp: \n"; 
  		    PPLexp.printLexp lexp;
! 		    print "\ntype: \n";
! 		    ppTyc tyc;
! 		    print "\ntenv: \n";
! 		    ppTycEnv tenv; raise LtyKernel.tcUnbound (tenv,tyc)) *)
  	val v = f lexps ([], [])
  	val _ = debugmsg "<<lexp2values"


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