CVS: sml-dist/src/compiler/FLINT/kernel kindchk.sml, 1.1.2.1, 1.1.2.2

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

Modified Files:
      Tag: primop-branch-2
	kindchk.sml 
Log Message:
kind checking

Index: kindchk.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/kindchk.sml,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** kindchk.sml	17 Aug 2006 15:36:17 -0000	1.1.2.1
--- kindchk.sml	17 Aug 2006 19:54:34 -0000	1.1.2.2
***************
*** 13,18 ****
    | eqKind (TK_BOX, TK_BOX) = true
    | eqKind (TK_SEQ ks, TK_SEQ ks') = List.all eqKind (ListPair.zip (ks,ks'))
!   | eqKind (TK_FUN (paramks, retknd), TK_FUN (paramks', retknd')) =
!       (List.all eqKind (ListPair.zip (paramks, paramks'))) andalso eqKind(retknd,retknd')
   *)
  
--- 13,18 ----
    | eqKind (TK_BOX, TK_BOX) = true
    | eqKind (TK_SEQ ks, TK_SEQ ks') = List.all eqKind (ListPair.zip (ks,ks'))
!   | eqKind (TK_FUN (paramks, rngknd), TK_FUN (paramks', rngknd')) =
!       (List.all eqKind (ListPair.zip (paramks, paramks'))) andalso eqKind(rngknd,rngknd')
   *)
  
***************
*** 20,28 ****
  (* ltyextern.sml has a tkSubkind and tksSubkind functions *)
  
  (* ltyextern.sml has a tkTycGen() that returns a function that returns the 
     kind of a given tyc using a given kenv *)
! fun chkKind(tyc : tyc, kenv) =
!     (case (tc_outX tyc) of
! 	 TC_VAR(n,argnum) => lookupKind(kenv, n, argnum)
!        | TC_NVAR(lv) => raise Fail "Unimplemented" (* ... *)
!        | TC_PRIM(ptyc) => 
--- 20,60 ----
  (* ltyextern.sml has a tkSubkind and tksSubkind functions *)
  
+ 
  (* ltyextern.sml has a tkTycGen() that returns a function that returns the 
     kind of a given tyc using a given kenv *)
! val tkTyc = tkTycGen()
! 
! exception KindCheck of string
! fun error e = raise KindCheck e
! 
! fun chkKind(tyc: tyc, kenv) =
!     let val chkKind' = fn tyc => chkKind(tyc, kenv)
!     in
!       (case (tc_outX tyc) of
! 	   TC_VAR(n,argnum) => lookupKind(kenv, n, argnum)
! 	 | TC_NVAR(lv) => raise Fail "Unimplemented" (* ... *)
! 	 | TC_PRIM(ptyc) => 
! 	 | TC_FN(paramknds, bodyTyc) => 
! 	   F(paramknds, 
! 	     chkKind(bodyTyc, tkInsert(kenv, paramknds)))
! 	 | TC_APP(opTyc, argTycs) =>
! 	   let 
! 	       val argKnds = map chkKind' argTycs
! 	   in
! 	       (case chkKind opTyc of
! 		    F(paramknds, rngknd) => 
! 		    if LT.tksSubkind(argKnds, paramknds)
! 		    then rngknd
! 		    else error "Arg/param kind mismatch"
! 		  | _ => error "Application of a non type \ 
! 			       \ function")
! 	   end
! 	 | TC_SEQ tycs => TK_SEQ(map chkKind' tycs)
! 	 | TC_PROJ (tyc, ind) => 
! 	     (case chkKind' tyc of
! 		  TK_SEQ ks => 
! 		    (List.nth ks ind 
! 		     handle Subscript => error "PROJ bad index")
! 		| _ => error "PROJ non-seq")
! 	 | TC_SUM
! 				 


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