Improve error reporting for type signatures

[ghc-hetmet.git] / compiler / typecheck / TcRnTypes.lhs

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index d01710c..3c23921 100644 (file)
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -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
@@ -306,11 +306,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,15 +602,20 @@ data Inst
   | ImplicInst {       -- An implication constraint
                        -- forall tvs. (reft, given) => wanted
        tci_name   :: Name,
-       tci_tyvars :: [TcTyVar],    -- Includes coercion variables
+       tci_tyvars :: [TcTyVar],    -- Quantified type variables
+                                   -- Includes coercion variables
                                    --   mentioned in tci_reft
        tci_reft   :: Refinement,
        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
@@ -702,10 +711,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}
 
 
@@ -726,6 +745,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