X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnTypes.lhs;h=4785a49ee2d1bdb717ec1314e9ee1556f5bd07d2;hp=dc233089e98d3e1c15665aa1aa3de0976bfa765f;hb=c1681a73fa4ca4cf8758264ae387ac09a9e900d8;hpb=f4510d27c5883fe7e8570f4dd49d45a8b0122f2c

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index dc23308..4785a49 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -13,7 +13,7 @@ module TcRnTypes(
 	IfGblEnv(..), IfLclEnv(..), 
 
 	-- Ranamer types
-	ErrCtxt,
+	ErrCtxt, RecFieldEnv,
 	ImportAvails(..), emptyImportAvails, plusImportAvails, 
 	WhereFrom(..), mkModDeps,
 
@@ -30,7 +30,7 @@ module TcRnTypes(
 	-- Insts
 	Inst(..), InstOrigin(..), InstLoc(..), 
 	pprInstLoc, pprInstArising, instLocSpan, instLocOrigin,
-	LIE, emptyLIE, unitLIE, plusLIE, consLIE, 
+	LIE, emptyLIE, unitLIE, plusLIE, consLIE, instLoc, instSpan,
 	plusLIEs, mkLIE, isEmptyLIE, lieToList, listToLIE,
 
 	-- Misc other types
@@ -133,7 +133,8 @@ data TcGblEnv
 	tcg_default :: Maybe [Type],	-- Types used for defaulting
 					-- Nothing => no 'default' decl
 
-	tcg_fix_env  :: FixityEnv,	-- Just for things in this module
+	tcg_fix_env   :: FixityEnv,	-- Just for things in this module
+	tcg_field_env :: RecFieldEnv,	-- Just for things in this module
 
 	tcg_type_env :: TypeEnv,	-- Global type env for the module we are compiling now
 		-- All TyCons and Classes (for this module) end up in here right away,
@@ -225,8 +226,17 @@ data TcGblEnv
 	tcg_fords     :: [LForeignDecl Id], -- ...Foreign import & exports
 
 	tcg_doc :: Maybe (HsDoc Name), -- Maybe Haddock documentation
-        tcg_hmi :: HaddockModInfo Name -- Haddock module information
+        tcg_hmi :: HaddockModInfo Name, -- Haddock module information
+        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
+	-- This is used when dealing with ".." notation in record 
+	-- construction and pattern matching.
+	-- The FieldEnv deals *only* with constructors defined in
+	-- *thie* module.  For imported modules, we get the same info
+	-- from the TypeEnv
 \end{code}
 
 %************************************************************************
@@ -306,11 +316,15 @@ data TcLclEnv		-- Changes as we move inside an expression
 		-- Maintained during renaming, of course, but also during
 		-- type checking, solely so that when renaming a Template-Haskell
 		-- splice we have the right environment for the renamer.
+		--
+		-- Used only for names bound within a value binding (bound by
+		-- lambda, case, where, let etc), but *not* for top-level names.
+		-- 
+		-- Does *not* include global name envt; may shadow it
+		-- Includes both ordinary variables and type variables;
+		-- they are kept distinct because tyvar have a different
+		-- occurrence contructor (Name.TvOcc)
 		-- 
-		--   Does *not* include global name envt; may shadow it
-		--   Includes both ordinary variables and type variables;
-		--   they are kept distinct because tyvar have a different
-		--   occurrence contructor (Name.TvOcc)
 		-- We still need the unsullied global name env so that
     		--   we can look up record field names
 
@@ -598,14 +612,20 @@ data Inst
   | ImplicInst {	-- An implication constraint
 			-- forall tvs. (reft, given) => wanted
 	tci_name   :: Name,
+	tci_tyvars :: [TcTyVar],    -- Quantified type variables
+				    -- Includes coercion variables
+				    --   mentioned in tci_reft
 	tci_reft   :: Refinement,
-	tci_tyvars :: [TcTyVar],
 	tci_given  :: [Inst],	    -- Only Dicts
 				    --   (no Methods, LitInsts, ImplicInsts)
 	tci_wanted :: [Inst],	    -- Only Dicts and ImplicInsts
 				    --   (no Methods or LitInsts)
+
 	tci_loc    :: InstLoc
     }
+	-- NB: the tci_given are not necessarily rigid,
+	--     although they will be if the tci_reft is non-trivial
+	-- NB: the tci_reft is already applied to tci_given and tci_wanted
 
   | Method {
 	tci_id :: TcId,		-- The Id for the Inst
@@ -701,10 +721,20 @@ emptyLIE          = emptyBag
 unitLIE inst 	  = unitBag inst
 mkLIE insts	  = listToBag insts
 plusLIE lie1 lie2 = lie1 `unionBags` lie2
-consLIE inst lie  = inst `consBag` lie
 plusLIEs lies	  = unionManyBags lies
 lieToList	  = bagToList
 listToLIE	  = listToBag
+
+consLIE inst lie  = lie `snocBag` inst
+-- Putting the new Inst at the *end* of the bag is a half-hearted attempt
+-- to ensure that we tend to report the *leftmost* type-constraint error
+-- E.g. 	f :: [a]
+--		f = [1,2,3]
+-- we'd like to complain about the '1', not the '3'.
+--
+-- "Half-hearted" because the rest of the type checker makes no great
+-- claims for retaining order in the constraint set.  Still, this 
+-- seems to improve matters slightly.  Exampes: mdofail001, tcfail015
 \end{code}
 
 
@@ -725,6 +755,12 @@ functions that deal with it.
 -------------------------------------------
 data InstLoc = InstLoc InstOrigin SrcSpan ErrCtxt
 
+instLoc :: Inst -> InstLoc
+instLoc inst = tci_loc inst
+
+instSpan :: Inst -> SrcSpan
+instSpan wanted = instLocSpan (instLoc wanted)
+
 instLocSpan :: InstLoc -> SrcSpan
 instLocSpan (InstLoc _ s _) = s