X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnTypes.lhs;h=86f1dfcc797f43960bcabf50958dfe5a6bfed740;hp=3e63827b4155a79f0d19ff33b06b8279bad2bba7;hb=ebec49fed627b7dd17e297ddc79a9c677a2ce538;hpb=bb7ffa1642e2110e26e1243c42a8a24adafa985d

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 3e63827..86f1dfc 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -28,7 +28,7 @@ module TcRnTypes(
 	ArrowCtxt(NoArrowCtxt), newArrowScope, escapeArrowScope,
 
 	-- Insts
-	Inst(..), InstOrigin(..), InstLoc(..), 
+	Inst(..), EqInstCo, InstOrigin(..), InstLoc(..), 
 	pprInstLoc, pprInstArising, instLocSpan, instLocOrigin,
 	LIE, emptyLIE, unitLIE, plusLIE, consLIE, instLoc, instSpan,
 	plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE,
@@ -208,11 +208,6 @@ data TcGblEnv
 		-- The binds, rules and foreign-decl fiels are collected
 		-- initially in un-zonked form and are finally zonked in tcRnSrcDecls
 
-		-- The next fields accumulate the payload of the
-		-- module The binds, rules and foreign-decl fiels are
-		-- collected initially in un-zonked form and are
-		-- finally zonked in tcRnSrcDecls
-
         tcg_rn_imports :: Maybe [LImportDecl Name],
         tcg_rn_exports :: Maybe [Located (IE Name)],
 	tcg_rn_decls :: Maybe (HsGroup Name),	-- renamed decls, maybe
@@ -700,27 +695,26 @@ data Inst
 				  --  	co :: ty1 ~ ty2
 	tci_left  :: TcType,      -- ty1    -- both types are...
 	tci_right :: TcType,      -- ty2    -- ...free of boxes
-	tci_co    :: Either    	  -- co
-			TcTyVar	  --  - a wanted equation, with a hole, to be 
-				  --    filled with a witness for the equality;
-                                  --    for equation arising from deferring
-                                  --    unification, 'ty1' is the actual and
-                                  --    'ty2' the expected type
-			Coercion, --  - a given equation, with a coercion
-				  --	witnessing the equality;
-				  --    a coercion that originates from a
-				  --    signature or a GADT is a CoVar, but
-                                  --    after normalisation of coercions, they
-				  --    can be arbitrary Coercions involving
-                                  --    constructors and pseudo-constructors 
-                                  --    like sym and trans.
+	tci_co    :: EqInstCo,  	  -- co
 	tci_loc   :: InstLoc,
 
 	tci_name  :: Name	-- Debugging help only: this makes it easier to
 				-- follow where a constraint is used in a morass
-				-- of trace messages!  Unlike other Insts, it has
-				-- no semantic significance whatsoever.
+				-- of trace messages!  Unlike other Insts, it 
+                                -- has no semantic significance whatsoever.
     }
+
+type EqInstCo = Either 	  -- Distinguish between given and wanted coercions
+		  TcTyVar   --  - a wanted equation, with a hole, to be filled
+			    --    with a witness for the equality; for equation
+                            --    arising from deferring unification, 'ty1' is
+                            --    the actual and 'ty2' the expected type
+		  Coercion  --  - a given equation, with a coercion witnessing
+                            --    the equality; a coercion that originates
+                            --    from a signature or a GADT is a CoVar, but
+                            --    after normalisation of coercions, they can
+			    --    be arbitrary Coercions involving constructors 
+                            --    and pseudo-constructors like sym and trans.
 \end{code}
 
 @Insts@ are ordered by their class/type info, rather than by their
@@ -730,7 +724,8 @@ than with the Avails handling stuff in TcSimplify
 
 \begin{code}
 instance Ord Inst where
-  compare = cmpInst
+   compare = cmpInst
+	-- Used *only* for AvailEnv in TcSimplify
 
 instance Eq Inst where
   (==) i1 i2 = case i1 `cmpInst` i2 of
@@ -761,11 +756,12 @@ cmpInst i1@(ImplicInst {}) i2@(ImplicInst {}) = tci_name i1 `compare` tci_name i
 cmpInst (ImplicInst {})    _                  = LT
 
 	-- same for Equality constraints
-cmpInst (EqInst {})    (Dict {})	      = GT
-cmpInst (EqInst {})    (Method {})	      = GT
-cmpInst (EqInst {})    (LitInst {})	      = GT
-cmpInst (EqInst {})    (ImplicInst {})	      = GT
-cmpInst i1@(EqInst {}) i2@(EqInst {})         = tci_name i1 `compare` tci_name i2
+cmpInst (EqInst {})    (Dict {})       = GT
+cmpInst (EqInst {})    (Method {})     = GT
+cmpInst (EqInst {})    (LitInst {})    = GT
+cmpInst (EqInst {})    (ImplicInst {}) = GT
+cmpInst i1@(EqInst {}) i2@(EqInst {})  = (tci_left  i1 `tcCmpType` tci_left  i2) `thenCmp`
+                                         (tci_right i1 `tcCmpType` tci_right i2)
 \end{code}