CVS: sml/src/compiler/FLINT/trans pequal.sml,1.6,1.7

Update of /cvsroot/smlnj/sml/src/compiler/FLINT/trans
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21829/src/compiler/FLINT/trans

Modified Files:
	pequal.sml 
Log Message:
Add Zhong Shao's fix for datatype equality functions.

Index: pequal.sml
===================================================================
RCS file: /cvsroot/smlnj/sml/src/compiler/FLINT/trans/pequal.sml,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** pequal.sml	12 Nov 2004 22:19:51 -0000	1.6
--- pequal.sml	14 Oct 2005 21:24:05 -0000	1.7
***************
*** 95,98 ****
--- 95,112 ----
       | ty => ty)
  
+ (* Given a list of data constructors; return its signature and a list
+    of value-carrying data constructors *)
+ fun getCsig dcons = 
+   let fun isConst(DA.CONSTANT _) = true
+         | isConst(DA.LISTNIL) = true
+         | isConst _ = false
+ 
+       fun h ([], c, v, rds) = (DA.CSIG(v,c), rev rds)
+         | h ((dc as {rep=a,domain,name})::r, c, v, rds) = 
+                if isConst a then h(r, c+1, v, rds)
+   	       else h(r, c, v+1, dc::rds)
+    in h(dcons, 0, 0, [])
+   end
+ 
  fun expandREC (family as {members: T.dtmember vector, ...}, stamps, freetycs) =
    let fun g (RECtyc i) = 
***************
*** 290,307 ****
  (*                              | [dcon] => inside dcon       *)
  				| _ => let
! 				      (* this is somewhat a hack !! *)
! 				      (* val sign = map #rep dcons *)
! 				      fun isConst(DA.CONSTANT _) =
! 					  true
! 					| isConst(DA.LISTNIL) = true
! 					| isConst _ = false
! 
! 				      fun getCsig({rep=a,domain,name}::r,c,v)= 
! 					  if isConst a then getCsig(r, c+1, v)
! 					  else getCsig(r, c, v+1)
! 					| getCsig([], c, v) = DA.CSIG(v,c)
! 
! 				      val sign = getCsig(dcons,0,0)
! 
  				      fun concase dcon = 
  					  let val tcs = map toTyc tyl
--- 304,308 ----
  (*                              | [dcon] => inside dcon       *)
  				| _ => let
! 				      val (sign, ndcons) = getCsig dcons
  				      fun concase dcon = 
  					  let val tcs = map toTyc tyl
***************
*** 319,326 ****
  						      SOME(falseLexp)))
  					  end
  				  in
! 				      SWITCH(VAR x, sign, 
! 					     map concase dcons, NONE)
! 				  end
  
                            val root = APP(PRIM(PO.PTREQL, pty, []), 
--- 320,335 ----
  						      SOME(falseLexp)))
  					  end
+ 
  				  in
!                                       case sign 
!                                        of DA.CSIG(0, _) => falseLexp
!                                         | DA.CSIG(_, 0) => 
!                                             SWITCH(VAR x, sign, 
! 					      map concase ndcons, NONE)
!                                         | _ => 
!                                             SWITCH(VAR x, sign, 
! 					      map concase ndcons, 
!                                                        SOME falseLexp)
! 				 end
  
                            val root = APP(PRIM(PO.PTREQL, pty, []), 



-------------------------------------------------------
This SF.Net email is sponsored by:
Power Architecture Resource Center: Free content, downloads, discussions,
and more. http://solutions.newsforge.com/ibmarch.tmpl