Fix Trac #2723: keep track of record field names in the renamer

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

diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index e70161c..7b4f85a 100644 (file)
--- 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,13 +225,18 @@ 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* module.  For imported modules, we get the same info
-       -- from the TypeEnv
+       -- 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}