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

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 3e63827..7b4f85a 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -13,7 +13,7 @@ module TcRnTypes(
 	IfGblEnv(..), IfLclEnv(..), 
 
 	-- Ranamer types
-	ErrCtxt, RecFieldEnv,
+	ErrCtxt, RecFieldEnv(..),
 	ImportAvails(..), emptyImportAvails, plusImportAvails, 
 	WhereFrom(..), mkModDeps,
 
@@ -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
@@ -230,11 +225,16 @@ data TcGblEnv
         tcg_hpc :: AnyHpcUsage -- True if any part of the prog uses hpc instrumentation.
     }
 
-type RecFieldEnv = NameEnv [Name]	-- Maps a constructor name *in this module*
-					-- to the fields for that constructor
+data RecFieldEnv 
+  = RecFields (NameEnv [Name])	-- Maps a constructor name *in this module*
+				-- to the fields for that constructor
+	      NameSet		-- Set of all fields declared *in this module*;
+				-- used to suppress name-shadowing complaints
+				-- when using record wild cards
+				-- E.g.  let fld = e in C {..}
 	-- This is used when dealing with ".." notation in record 
 	-- construction and pattern matching.
-	-- The FieldEnv deals *only* with constructors defined in *thie*
+	-- The FieldEnv deals *only* with constructors defined in *this*
 	-- module.  For imported modules, we get the same info from the
 	-- TypeEnv
 \end{code}
@@ -638,7 +638,7 @@ I am not convinced that this duplication is necessary or useful! -=chak
 data Inst
   = Dict {
 	tci_name :: Name,
-	tci_pred :: TcPredType,
+	tci_pred :: TcPredType,	  -- Class or implicit parameter only
 	tci_loc  :: InstLoc 
     }
 
@@ -700,27 +700,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 +729,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 +761,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}