[project @ 2004-12-22 12:06:13 by simonpj]

----------------------------------------
     New Core invariant: keep case alternatives in sorted order
	----------------------------------------

We now keep the alternatives of a Case in the Core language in sorted
order.  Sorted, that is,
	by constructor tag	for DataAlt
	by literal		for LitAlt

The main reason is that it makes matching and equality testing more robust.
But in fact some lines of code vanished from SimplUtils.mkAlts.


WARNING: no change to interface file formats, but you'll need to recompile
your libraries so that they generate interface files that respect the
invariant.

1 files changed, 28 insertions, 3 deletions

diff --git a/ghc/compiler/coreSyn/CoreSyn.lhs b/ghc/compiler/coreSyn/CoreSyn.lhs
index 28c913d369..3e9127689c 100644
--- a/ghc/compiler/coreSyn/CoreSyn.lhs
+++ b/ghc/compiler/coreSyn/CoreSyn.lhs
@@ -15,7 +15,7 @@ module CoreSyn (
 	mkConApp, 
 	varToCoreExpr,
 
-	isTyVar, isId, 
+	isTyVar, isId, cmpAltCon, cmpAlt, ltAlt,
 	bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, 
 	collectBinders, collectTyBinders, collectValBinders, collectTyAndValBinders,
 	collectArgs, 
@@ -54,7 +54,7 @@ import CostCentre	( CostCentre, noCostCentre )
 import Var		( Var, Id, TyVar, isTyVar, isId )
 import Type		( Type, mkTyVarTy, seqType )
 import Literal	        ( Literal, mkMachInt )
-import DataCon		( DataCon, dataConWorkId )
+import DataCon		( DataCon, dataConWorkId, dataConTag )
 import BasicTypes	( Activation )
 import VarSet
 import FastString
@@ -78,13 +78,17 @@ data Expr b	-- "b" for the type of binders,
   | App   (Expr b) (Arg b)
   | Lam   b (Expr b)
   | Let   (Bind b) (Expr b)
-  -- gaw 2004, added Type field
   | Case  (Expr b) b Type [Alt b]  	-- Binder gets bound to value of scrutinee
 	-- Invariant: The list of alternatives is ALWAYS EXHAUSTIVE,
 	--	      meaning that it covers all cases that can occur
 	--	      See the example below
 	--
 	-- Invariant: The DEFAULT case must be *first*, if it occurs at all
+	-- Invariant: The remaining cases are in order of increasing 
+	--		tag	(for DataAlts)
+	--		lit	(for LitAlts)
+	--	      This makes finding the relevant constructor easy,
+	--	      and makes comparison easier too
   | Note  Note (Expr b)
   | Type  Type			-- This should only show up at the top
 				-- level of an Arg
@@ -110,6 +114,7 @@ data AltCon = DataAlt DataCon
 	    | DEFAULT
 	 deriving (Eq, Ord)
 
+
 data Bind b = NonRec b (Expr b)
 	      | Rec [(b, (Expr b))]
 
@@ -345,6 +350,26 @@ instance Outputable AltCon where
 
 instance Show AltCon where
   showsPrec p con = showsPrecSDoc p (ppr con)
+
+cmpAlt :: Alt b -> Alt b -> Ordering
+cmpAlt (con1, _, _) (con2, _, _) = con1 `cmpAltCon` con2
+
+ltAlt :: Alt b -> Alt b -> Bool
+ltAlt a1 a2 = case a1 `cmpAlt` a2 of { LT -> True; other -> False }
+
+cmpAltCon :: AltCon -> AltCon -> Ordering
+-- Compares AltCons within a single list of alternatives
+cmpAltCon DEFAULT      DEFAULT	   = EQ
+cmpAltCon DEFAULT      con	   = LT
+
+cmpAltCon (DataAlt d1) (DataAlt d2) = dataConTag d1 `compare` dataConTag d2
+cmpAltCon (DataAlt _)  DEFAULT      = GT
+cmpAltCon (LitAlt  l1) (LitAlt  l2) = l1 `compare` l2
+cmpAltCon (LitAlt _)   DEFAULT      = GT
+
+cmpAltCon con1 con2 = WARN( True, text "Comparing incomparable AltCons" <+> 
+			 	  ppr con1 <+> ppr con2 )
+		      LT
 \end{code}