CVS: sml-dist/src/compiler/FLINT/kernel lty.sml, 1.1.2.10, 1.1.2.11

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

Modified Files:
      Tag: primop-branch-2
	lty.sml 
Log Message:
lty kind checker and tyc kind checker handle IND cases correctly now

Index: lty.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/Attic/lty.sml,v
retrieving revision 1.1.2.10
retrieving revision 1.1.2.11
diff -C2 -d -r1.1.2.10 -r1.1.2.11
*** lty.sml	18 Aug 2006 20:55:00 -0000	1.1.2.10
--- lty.sml	18 Aug 2006 21:19:55 -0000	1.1.2.11
***************
*** 786,791 ****
          val g = tkTyc kenv
          (* how to compute the kind of a tyc *)
!         fun mk() =
!             case tc_outX t of
                  TC_VAR (i, j) =>
                  tkLookup (kenv, i, j)
--- 786,791 ----
          val g = tkTyc kenv
          (* how to compute the kind of a tyc *)
! 	fun mkI tycI =
!             case tycI of
                  TC_VAR (i, j) =>
                  tkLookup (kenv, i, j)
***************
*** 864,869 ****
  		      tkTyc bodyKenv body
  		   end) 
!               | TC_IND _ => bug "unexpected TC_IND in tkTyc"
                | TC_CONT _ => bug "unexpected TC_CONT in tkTyc"
      in
          Memo.recallOrCompute (dict, kenv, t, mk)
--- 864,878 ----
  		      tkTyc bodyKenv body
  		   end) 
!             (*  | TC_IND _ =>  bug "unexpected TC_IND in tkTyc" *)
! 	      | TC_IND(newtyc, oldtycI) =>
! 		  let val newtycknd = g newtyc
! 		  in   
! 		      if tk_eq(newtycknd, mkI oldtycI) 
! 		      then newtycknd
! 		      else bug "tkTyc[IND]: new tyc and old tycI kind mismatch"
! 		  end 
                | TC_CONT _ => bug "unexpected TC_CONT in tkTyc"
+         fun mk () =
+ 	    mkI (tc_outX t)
      in
          Memo.recallOrCompute (dict, kenv, t, mk)
***************
*** 904,909 ****
  fun ltyChk (lty : lty) =
      let val (tkChk, chkKindEnv) = tkTycGen'()
! 	fun ltyChk' (kenv : tkindEnv) (lty : lty) =
! 	    (case lt_outX lty 
  	      of LT_TYC(tyc) => 
  		   (tkAssertIsMono (tkChk kenv tyc); tkc_mono)
--- 913,918 ----
  fun ltyChk (lty : lty) =
      let val (tkChk, chkKindEnv) = tkTycGen'()
! 	fun ltyIChk (kenv : tkindEnv) (ltyI : ltyI) =
! 	    (case ltyI 
  	      of LT_TYC(tyc) => 
  		   (tkAssertIsMono (tkChk kenv tyc); tkc_mono)
***************
*** 916,920 ****
  			      tkc_seq(map (ltyChk' tenv') rngLtys))
  		   end
- 		    (* TODO might need a little more here *)
  	       | LT_POLY(ks, ltys) => 
  		   tkc_seq(map (ltyChk' (ks::kenv)) ltys)
--- 925,928 ----
***************
*** 922,930 ****
  	       | LT_CONT(ltys) => 
  		   tkc_seq(map (ltyChk' kenv) ltys)
! 	       | LT_IND(thunk, sigltyI) =>
! 		   (ltyChk' kenv) thunk
! 		   (* TODO Need to check against sigltyI kind also? *)
  	       | LT_ENV(body, i, j, env) =>
! 		   (* Should be the same as checking TC_ENV *)
  		   (let val kenv' = 
  			    List.drop(kenv, j)
--- 930,943 ----
  	       | LT_CONT(ltys) => 
  		   tkc_seq(map (ltyChk' kenv) ltys)
! 	       | LT_IND(newLty, oldLtyI) =>
! 		   let val newLtyKnd = (ltyChk' kenv) newLty
! 		   in if tk_eq(newLtyKnd, ltyIChk kenv oldLtyI)
! 		      then newLtyKnd
! 		      else bug "ltyChk[IND]: kind mismatch"
! 		   end
  	       | LT_ENV(body, i, j, env) =>
! 		   (* Should be the same as checking TC_ENV and 
! 		    * therefore the two cases should probably just
! 		    * call the same helper function *)
  		   (let val kenv' = 
  			    List.drop(kenv, j)
***************
*** 940,943 ****
--- 953,957 ----
  		       ltyChk' bodyKenv body
  		    end))
+ 	and ltyChk' kenv lty = ltyIChk kenv (lt_outX lty)
      in ltyChk' [] lty
      end (* function ltyChk *)	   


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