CVS: sml-dist/src/compiler/FLINT/kernel ltykernel.sml, 1.18.12.9, 1.18.12.10 primtyc.sml, 1.5, 1.5.10.1

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

Modified Files:
      Tag: primop-branch-2
	ltykernel.sml primtyc.sml 
Log Message:
(mutually-)rectype arity checking done

Index: ltykernel.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/ltykernel.sml,v
retrieving revision 1.18.12.9
retrieving revision 1.18.12.10
diff -C2 -d -r1.18.12.9 -r1.18.12.10
*** ltykernel.sml	2 Aug 2006 20:59:42 -0000	1.18.12.9
--- ltykernel.sml	3 Aug 2006 03:11:32 -0000	1.18.12.10
***************
*** 103,107 ****
  
    | TC_SUM of tyc list                         (* sum tyc *)
!   | TC_FIX of (int * tyc * tyc list) * int     (* recursive tyc *)
  
    | TC_TUPLE of rflag * tyc list               (* std record tyc *)
--- 103,113 ----
  
    | TC_SUM of tyc list                         (* sum tyc *)
!   | TC_FIX of (int * tyc * tyc list) * int     (* (mutually-)recursive tyc 
! 	                                        * int # of family members  
! 						* tyc of rec-type generator
! 						* tyc list is freetycs 
! 						* int index of dcon in dt 
! 						*  built in 
!                                                 * trans/transtypes.sml*)
  
    | TC_TUPLE of rflag * tyc list               (* std record tyc *)
***************
*** 879,899 ****
  and printParamArgs (tc,tcs) = 
      let 
! 	fun getArity(TC_FN(params, _)) = 
! 	    (print "printParamArgs TC_FN \n"; 
! 	     length params)
! 	  | getArity(TC_APP(tc, _)) = 
! 	    (case (tc_outX tc)
! 	      of (TC_FN(_, tc')) => getArity (tc_outX tc')
! 	       | _ => 0)
! 	  | getArity(TC_FIX((numFamily,tc,freetycs),_)) = 
! 	    (case (tc_outX tc) of
! 		 (TC_FN _) =>
! 		 (getArity (tc_outX tc))
! 	       | _ => 0)
! 	  | getArity _ = (print ("getArity on:\n "^tc_print tc^"\n"); 0)
! 	val numParams = getArity (tc_outX tc)
      in
! 	if numParams = (length tcs) then 
! 	    print ("(TC_APP params args matched "^Int.toString (length tcs)^")\n")
  	else print ("(TC_APP of " ^tc_print tc^ "\nparams "
  		    ^ Int.toString numParams
--- 885,910 ----
  and printParamArgs (tc,tcs) = 
      let 
! 	fun getArity(tycEnv) =
! 	    (case (tc_outX tycEnv) of
! 		 TC_PRIM(ptyc) => PT.pt_arity ptyc
! 	       | TC_FN(params, _) =>
! 		 (print "printParamArgs TC_FN \n"; 
! 		  length params)
! 	       | (TC_APP(tc, _)) => 
! 		 (case (tc_outX tc)
! 		   of (TC_FN(_, tc')) => getArity tc'
! 		    | _ => 0)
! 	       | (TC_FIX((numFamily,tc,freetycs),index)) => 
! 		 (case (tc_outX tc) of
! 		      (TC_FN (_,tc')) => (* generator function *)
! 		      (case (tc_outX tc') of
! 			   (TC_SEQ tycs) => getArity (List.nth (tycs, index))
! 			 | TC_FN (params, _) => length params
! 			 | _ => raise Fail "Malformed generator range")
! 		    | _ => raise Fail "FIX without generator!" )
! 	       | _ => (print ("getArity on:\n "^tc_print tc^"\n"); 0))
! 	val numParams = getArity tc
      in
! 	if numParams = (length tcs) then ()
  	else print ("(TC_APP of " ^tc_print tc^ "\nparams "
  		    ^ Int.toString numParams

Index: primtyc.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/kernel/primtyc.sml,v
retrieving revision 1.5
retrieving revision 1.5.10.1
diff -C2 -d -r1.5 -r1.5.10.1
*** primtyc.sml	28 Aug 2003 21:59:07 -0000	1.5
--- primtyc.sml	3 Aug 2006 03:11:32 -0000	1.5.10.1
***************
*** 58,62 ****
  
  (** the primtive type constructor *)
! type primtyc = ptyc * int * int
  
  (** the set of primitive type constructors *)
--- 58,62 ----
  
  (** the primtive type constructor *)
! type primtyc = ptyc * int * int      (* ptyc, arity, generic primtyc numbers *)
  
  (** the set of primitive type constructors *)


-------------------------------------------------------------------------
Take Surveys. Earn Cash. Influence the Future of IT
Join SourceForge.net's Techsay panel and you'll get the chance to share your
opinions on IT & business topics through brief surveys -- and earn cash
http://www.techsay.com/default.php?page=join.php&p=sourceforge&CID=DEVDEV