CVS: sml-dist/src/compiler/ElabData/types typesutil.sml, 1.3.2.12, 1.3.2.13

Update of /cvsroot/smlnj/sml-dist/src/compiler/ElabData/types
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv28574/ElabData/types

Modified Files:
      Tag: primop-branch-2
	typesutil.sml 
Log Message:
Debug info for matchInstTypes bug during translate of core.sml

Index: typesutil.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/ElabData/types/typesutil.sml,v
retrieving revision 1.3.2.12
retrieving revision 1.3.2.13
diff -C2 -d -r1.3.2.12 -r1.3.2.13
*** typesutil.sml	13 Jul 2006 21:10:44 -0000	1.3.2.12
--- typesutil.sml	13 Jul 2006 22:35:51 -0000	1.3.2.13
***************
*** 553,556 ****
--- 553,557 ----
   * the parameters of instantiation of the primop.
   *)
+ 
  fun matchInstTypes(specTy,actualTy) =
      let	fun match'(WILDCARDty, _) = () (* possible? how? *)
***************
*** 558,574 ****
  	  | match'(ty1, VARty(tv as ref(OPEN{kind=META,eq,...}))) =
                if eq andalso not(checkEqTyInst(ty1))
! 	      then raise CompareTypes
  	      else tv := INSTANTIATED ty1
  	  | match'(ty1, VARty(tv as ref(INSTANTIATED ty2))) =
!               if equalType(ty1,ty2) then () else raise CompareTypes
  	  | match'(CONty(tycon1, args1), CONty(tycon2, args2)) =
  	      if eqTycon(tycon1,tycon2)
  	      then ListPair.app match (args1,args2)
! 	      else raise CompareTypes
! 	  | match' _ = raise CompareTypes
          and match(ty1,ty2) = match'(headReduceType ty1, headReduceType ty2)
          val (actinst, actParamTvs) = instantiatePoly actualTy
          val (specinst, specGenericTvs) = instantiatePoly specTy
!     in match(specinst,actinst);
         SOME(specGenericTvs, actParamTvs)
      end handle CompareTypes => NONE
--- 559,586 ----
  	  | match'(ty1, VARty(tv as ref(OPEN{kind=META,eq,...}))) =
                if eq andalso not(checkEqTyInst(ty1))
! 	      then (print "VARty META\n"; raise CompareTypes)
  	      else tv := INSTANTIATED ty1
  	  | match'(ty1, VARty(tv as ref(INSTANTIATED ty2))) =
!               if equalType(ty1,ty2) then () else (print "INSTANTIATED\n"; raise CompareTypes)
  	  | match'(CONty(tycon1, args1), CONty(tycon2, args2)) =
  	      if eqTycon(tycon1,tycon2)
  	      then ListPair.app match (args1,args2)
! 	      else (print "CONty\n"; raise CompareTypes)
! 	  | match'(_, UNDEFty) = (print "UNDEFty\n"; raise CompareTypes)
! 	  | match'(_, IBOUND _) = (print "IBOUND\n"; raise CompareTypes)
! 	  | match'(_, POLYty _) = (print "POLYty\n"; raise CompareTypes)
! 	  | match'(_, CONty _) = (print "unmatched CONty\n"; raise CompareTypes)
! 	  | match'(_, VARty vk) = (print "VARty other\n"; 
! 				  (case vk of 
! 				       (ref (OPEN _)) => print "open\n"
! 				     | (ref (UBOUND _)) => print "ubound\n"
! 				     | (ref (LITERAL _)) => print "literal\n"
! 				     | (ref (SCHEME _)) => print "scheme\n"
! 				     | (ref (TV_MARK _)) => print "mark\n");
! 				  raise CompareTypes)
          and match(ty1,ty2) = match'(headReduceType ty1, headReduceType ty2)
          val (actinst, actParamTvs) = instantiatePoly actualTy
          val (specinst, specGenericTvs) = instantiatePoly specTy
!     in match(specinst, actinst);
         SOME(specGenericTvs, actParamTvs)
      end handle CompareTypes => NONE



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