CVS: sml-dist/src/compiler/FLINT/kernel ltykernel.sml, 1.18.12.12, 1.18.12.13

George Kuan <[email protected]> Tue, 08 Aug 2006 12:32:55 -0700
Newsgroups gmane.comp.lang.sml.smlnj.commits
Message-ID <[email protected]>
Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv7203/src/compiler/FLINT/kernel

Modified Files:
      Tag: primop-branch-2
	ltykernel.sml 
Log Message:
lexp trace of culprit, pplexp (which should be updated to use the PP lib) now uses PPLTy.ppTyc

Index: ltykernel.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltykernel.sml,v
retrieving revision 1.18.12.12
retrieving revision 1.18.12.13
diff -C2 -d -r1.18.12.12 -r1.18.12.13
*** ltykernel.sml	8 Aug 2006 18:02:53 -0000	1.18.12.12
--- ltykernel.sml	8 Aug 2006 19:32:53 -0000	1.18.12.13
***************
*** 713,717 ****
  val tcc_var = tc_injX o TC_VAR
  val tcc_fn = tc_injX o TC_FN
! val tcc_app = tc_injX o TC_APP
  val tcc_seq = tc_injX o TC_SEQ
  val tcc_proj = tc_injX o TC_PROJ
--- 713,751 ----
  val tcc_var = tc_injX o TC_VAR
  val tcc_fn = tc_injX o TC_FN
! val tcc_app = fn (fntyc, argtycs) =>
! 		 (* Check that parameter arity matches number of arguments
! 		    supplied because type application must be saturated *) 
! 		 let fun checkParamArity (tc,tcs) = 
! 			 let 
! 			     fun getArity(tycEnv) =
! 				 (case (tc_outX tycEnv) of
! 				      TC_PRIM(ptyc) => PT.pt_arity ptyc
! 				    | TC_FN(params, _) => length params
! 				    | (TC_APP(tc, _)) => 
! 				      (case (tc_outX tc)
! 					of (TC_FN(_, tc')) => getArity tc'
! 					 | _ => 0)
! 				    | (TC_FIX((numFamily,tc,freetycs),index)) => 
! 				      (case (tc_outX tc) of
! 					   (TC_FN (_,tc')) => (* generator function *)
! 					   (case (tc_outX tc') of
! 						(TC_SEQ tycs) => getArity (List.nth (tycs, index))
! 					      | TC_FN (params, _) => length params
! 					      | _ => raise Fail "Malformed generator range")
! 					 | _ => raise Fail "FIX without generator!" )
! 				    | _ => (print ("getArity on:\n "^tc_print tc^"\n"); 0))
! 			     val numParams = getArity tc
! 			 in
! 			     if numParams = (length tcs) then ()
! 			     else print ("(TC_APP of " ^tc_print tc^ "\nparams "
! 					 ^ Int.toString numParams
! 					 ^ "\nargument list length: " 
! 					 ^ Int.toString (length tcs) 
! 					 ^ ")\n")
! 			 end
! 		 in
! 		     (checkParamArity(fntyc, argtycs); 
! 		      (tc_injX o TC_APP) (fntyc, argtycs))
! 		 end
  val tcc_seq = tc_injX o TC_SEQ
  val tcc_proj = tc_injX o TC_PROJ
***************
*** 898,901 ****
--- 932,936 ----
  and stripInd t = (case tc_outX t of TC_IND (x,_) => stripInd x | _ => t)
  
+ (*
  and printParamArgs (tc,tcs) = 
      let 
***************
*** 926,930 ****
  		    ^ ")\n")
      end
! 	
  (** normalizing an arbitrary tyc into a simple weak-head-normal-form *)
  and tc_whnm t = if tcp_norm(t) then t else 
--- 961,965 ----
  		    ^ ")\n")
      end
!  *)
  (** normalizing an arbitrary tyc into a simple weak-head-normal-form *)
  and tc_whnm t = if tcp_norm(t) then t else 
***************
*** 954,959 ****
                     | ((TC_SEQ _) | (TC_TUPLE _) | (TC_ARROW _) | (TC_IND _)) =>
                         bug "unexpected tycs in tc_whnm-TC_APP"
!                    | _ => let val _ = printParamArgs (tc', tcs)
! 			      val xx = tcc_app(tc', tcs) 
                             in stripInd xx
                            end
--- 989,993 ----
                     | ((TC_SEQ _) | (TC_TUPLE _) | (TC_ARROW _) | (TC_IND _)) =>
                         bug "unexpected tycs in tc_whnm-TC_APP"
!                    | _ => let val xx = tcc_app(tc', tcs) 
                             in stripInd xx
                            end


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