CVS: sml-dist/src/compiler/FLINT/kernel ltyextern.sml, 1.19.24.4, 1.19.24.5

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

Modified Files:
      Tag: primop-branch-2
	ltyextern.sml 
Log Message:
added TC_ENV checking to kind checker

Index: ltyextern.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltyextern.sml,v
retrieving revision 1.19.24.4
retrieving revision 1.19.24.5
diff -C2 -d -r1.19.24.4 -r1.19.24.5
*** ltyextern.sml	17 Aug 2006 23:13:14 -0000	1.19.24.4
--- ltyextern.sml	18 Aug 2006 14:58:19 -0000	1.19.24.5
***************
*** 198,201 ****
--- 198,215 ----
          (* default recursive invocation *)    
          val g = tkTyc kenv
+ 	fun chkKindEnv(env,j,kenv) : unit =
+ 	    let fun bindToKinds(Lamb(_,ks)) = ks
+ 		  | bindToKinds(Beta(_,_,ks)) = ks
+ 		fun chkBinder(Lamb _) = ()
+ 		  | chkBinder(Beta(j',args,ks)) = 
+ 		    let val kenv' = List.drop(kenv, j-j')
+ 		    in if tksSubkind(ks, map (fn t => tkTyc(t,kenv')) args)
+ 		       then ()
+ 		       else error "chkKindEnv: Beta binder kinds mismatch"
+ 		    end
+ 		    handle Subscript => 
+ 			   error "tkTyc[Env]: dropping too many frames"
+ 	    in app chkBinder env
+ 	    end
          (* how to compute the kind of a tyc *)
          fun mk() =
***************
*** 258,262 ****
                   tkc_mono)
                | LT.TC_PARROW _ => bug "unexpected TC_PARROW in tkTyc"
!               | LT.TC_ENV _ => bug "unexpected TC_ENV in tkTyc"
                | LT.TC_IND _ => bug "unexpected TC_IND in tkTyc"
                | LT.TC_CONT _ => bug "unexpected TC_CONT in tkTyc"
--- 272,286 ----
                   tkc_mono)
                | LT.TC_PARROW _ => bug "unexpected TC_PARROW in tkTyc"
!            (* | LT.TC_ENV _ => bug "unexpected TC_ENV in tkTyc" *)
! 	      | LT.TC_ENV(body, 0, j, teEmpty) => 
! 		  (tkTyc List.drop(kenv,j) body 
! 		   handle Subscript => error "[Env]: dropping too many frames")
! 	      | LT.TC_ENV(body, i, j, env) =>
! 		  (let val kenv' = 
! 			   List.drop(kenv, j)
! 			   handle Subscript => "[Env]: dropping too many frames"
! 		   in chkKindEnv(env,j,kenv);
! 		      tkTyc (foldr (fn (b,ke) => bindToKinds b :: ke)) body
! 		   end 
                | LT.TC_IND _ => bug "unexpected TC_IND in tkTyc"
                | LT.TC_CONT _ => bug "unexpected TC_CONT in tkTyc"


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