CVS: sml-dist/src/compiler/FLINT/kernel lty.sig, 1.1.2.3, 1.1.2.4 lty.sml, 1.1.2.7, 1.1.2.8 ltyextern.sml, 1.19.24.5, 1.19.24.6

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

Modified Files:
      Tag: primop-branch-2
	lty.sig lty.sml ltyextern.sml 
Log Message:
kind checker unfolds teBinder list from tycEnv

Index: lty.sig
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/lty.sig,v
retrieving revision 1.1.2.3
retrieving revision 1.1.2.4
diff -C2 -d -r1.1.2.3 -r1.1.2.4
*** lty.sig	17 Aug 2006 20:36:49 -0000	1.1.2.3
--- lty.sig	18 Aug 2006 16:24:17 -0000	1.1.2.4
***************
*** 69,72 ****
--- 69,73 ----
           ks: the kinds of the abstraction parameters *)
  
+ val teToBinders : tycEnv -> teBinder list
  
  (* token: a hook to add new tyc *)

Index: lty.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/lty.sml,v
retrieving revision 1.1.2.7
retrieving revision 1.1.2.8
diff -C2 -d -r1.1.2.7 -r1.1.2.8
*** lty.sml	17 Aug 2006 21:55:48 -0000	1.1.2.7
--- lty.sml	18 Aug 2006 16:24:18 -0000	1.1.2.8
***************
*** 538,541 ****
--- 538,546 ----
        | _ => bug "teDest"
  
+ fun teToBinders (tenv: tycEnv) =
+     case teDest tenv 
+      of NONE => []
+       | SOME(binder, tenvRest) => binder::(teToBinders tenvRest)
+ 
  (* TeUnbound -- raised when first element of a deBruijn index is 
   * out of bounds *)

Index: ltyextern.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltyextern.sml,v
retrieving revision 1.19.24.5
retrieving revision 1.19.24.6
diff -C2 -d -r1.19.24.5 -r1.19.24.6
*** ltyextern.sml	18 Aug 2006 14:58:19 -0000	1.19.24.5
--- ltyextern.sml	18 Aug 2006 16:24:18 -0000	1.19.24.6
***************
*** 195,214 ****
      val dict = Memo.newDict()
  
!     fun tkTyc kenv t = let
          (* 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 *)
--- 195,215 ----
      val dict = Memo.newDict()
  
!     fun tkTyc (kenv : tkindEnv) t = let
          (* default recursive invocation *)    
          val g = tkTyc kenv
! 	fun chkKindEnv(env : tycEnv,j,kenv : tkindEnv) : unit =
! 	    let 
  		fun chkBinder(Lamb _) = ()
  		  | chkBinder(Beta(j',args,ks)) = 
! 		    let 
! 			val kenv' = List.drop(kenv, j-j')
! 			val argks = map (fn t => tkTyc kenv' t) args
! 		    in if tksSubkind(ks, argks)
  		       then ()
! 		       else bug "chkKindEnv: Beta binder kinds mismatch"
  		    end
  		    handle Subscript => 
! 			   bug "tkTyc[Env]: dropping too many frames"
! 	    in app chkBinder (LT.teToBinders env)
  	    end
          (* how to compute the kind of a tyc *)
***************
*** 274,286 ****
             (* | 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"
--- 275,295 ----
             (* | LT.TC_ENV _ => bug "unexpected TC_ENV in tkTyc" *)
  	      | LT.TC_ENV(body, 0, j, teEmpty) => 
! 		  (tkTyc (List.drop(kenv,j)) body 
! 		   handle Subscript => 
! 			  bug "[Env]: dropping too many frames")
  	      | LT.TC_ENV(body, i, j, env) =>
  		  (let val kenv' = 
  			   List.drop(kenv, j)
! 			   handle Subscript => 
! 				  bug "[Env]: dropping too many frames"
! 		       fun bindToKinds(Lamb(_,ks)) = ks
! 			 | bindToKinds(Beta(_,_,ks)) = ks
! 		       fun addBindToKEnv(b,ke) = 
! 			   bindToKinds b :: ke
! 		       val bodyKenv = 
! 			   foldr addBindToKEnv kenv' (LT.teToBinders env)
  		   in chkKindEnv(env,j,kenv);
! 		      tkTyc bodyKenv 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