summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Tc')
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs7
-rw-r--r--compiler/GHC/Tc/Gen/Export.hs18
-rw-r--r--compiler/GHC/Tc/Module.hs15
-rw-r--r--compiler/GHC/Tc/Utils/Backpack.hs2
4 files changed, 19 insertions, 23 deletions
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 35bfea6ae1..349f587ddc 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
@@ -1694,11 +1695,11 @@ dodgy_msg kind tc ie
quotes (ppr tc) <+> text "has (in-scope) constructors or class methods,",
text "but it has none" ]
-dodgy_msg_insert :: forall p . IdP (GhcPass p) -> IE (GhcPass p)
+dodgy_msg_insert :: forall p . (Anno (IdP (GhcPass p)) ~ SrcSpanAnnN) => IdP (GhcPass p) -> IE (GhcPass p)
dodgy_msg_insert tc = IEThingAll noAnn ii
where
- ii :: LIEWrappedName (IdP (GhcPass p))
- ii = noLocA (IEName $ noLocA tc)
+ ii :: LIEWrappedName (GhcPass p)
+ ii = noLocA (IEName noExtField $ noLocA tc)
pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc
pprTypeDoesNotHaveFixedRuntimeRep ty prov =
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index 27b2e84d6a..efc6433f29 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -190,7 +190,7 @@ rnExports explicit_mod exports
| explicit_mod = exports
| has_main
= Just (noLocA [noLocA (IEVar noExtField
- (noLocA (IEName $ noLocA default_main)))])
+ (noLocA (IEName noExtField $ noLocA default_main)))])
-- ToDo: the 'noLoc' here is unhelpful if 'main'
-- turns out to be out of scope
| otherwise = Nothing
@@ -369,8 +369,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
lookup_ie _ = panic "lookup_ie" -- Other cases covered earlier
- lookup_ie_with :: LIEWrappedName RdrName -> [LIEWrappedName RdrName]
- -> RnM (Located Name, [LIEWrappedName Name], [Name],
+ lookup_ie_with :: LIEWrappedName GhcPs -> [LIEWrappedName GhcPs]
+ -> RnM (Located Name, [LIEWrappedName GhcRn], [Name],
[Located FieldLabel])
lookup_ie_with (L l rdr) sub_rdrs
= do name <- lookupGlobalOccRn $ ieWrappedName rdr
@@ -381,7 +381,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
, map (ieWrappedName . unLoc) non_flds
, flds)
- lookup_ie_all :: IE GhcPs -> LIEWrappedName RdrName
+ lookup_ie_all :: IE GhcPs -> LIEWrappedName GhcPs
-> RnM (Located Name, [Name], [FieldLabel])
lookup_ie_all ie (L l rdr) =
do name <- lookupGlobalOccRn $ ieWrappedName rdr
@@ -476,8 +476,8 @@ If the module has NO main function:
-lookupChildrenExport :: Name -> [LIEWrappedName RdrName]
- -> RnM ([LIEWrappedName Name], [Located FieldLabel])
+lookupChildrenExport :: Name -> [LIEWrappedName GhcPs]
+ -> RnM ([LIEWrappedName GhcRn], [Located FieldLabel])
lookupChildrenExport spec_parent rdr_items =
do
xs <- mapAndReportM doOne rdr_items
@@ -492,8 +492,8 @@ lookupChildrenExport spec_parent rdr_items =
| ns == tcName = [dataName, tcName]
| otherwise = [ns]
-- Process an individual child
- doOne :: LIEWrappedName RdrName
- -> RnM (Either (LIEWrappedName Name) (Located FieldLabel))
+ doOne :: LIEWrappedName GhcPs
+ -> RnM (Either (LIEWrappedName GhcRn) (Located FieldLabel))
doOne n = do
let bareName = (ieWrappedName . unLoc) n
@@ -513,7 +513,7 @@ lookupChildrenExport spec_parent rdr_items =
case name of
NameNotFound -> do { ub <- reportUnboundName unboundName
; let l = getLoc n
- ; return (Left (L l (IEName (L (la2na l) ub))))}
+ ; return (Left (L l (IEName noExtField (L (la2na l) ub))))}
FoundChild par child -> do { checkPatSynParent spec_parent par child
; return $ case child of
FieldGreName fl -> Right (L (getLocA n) fl)
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index d23fad536c..a332d61fb1 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -239,9 +239,6 @@ tcRnModuleTcRnM :: HscEnv
-> TcRn TcGblEnv
-- Factored out separately from tcRnModule so that a Core plugin can
-- call the type checker directly
-tcRnModuleTcRnM _ _
- (HsParsedModule (L _ (XModule x)) _)
- _ = dataConCantHappen x
tcRnModuleTcRnM hsc_env mod_sum
(HsParsedModule {
hpm_module =
@@ -285,7 +282,7 @@ tcRnModuleTcRnM hsc_env mod_sum
++ import_decls))
; let { mkImport mod_name = noLocA
$ (simpleImportDecl mod_name)
- { ideclHiding = Just (False, noLocA [])}}
+ { ideclImportList = Just (Exactly, noLocA [])}}
; let { withReason t imps = map (,text t) imps }
; let { all_imports = withReason "is implicitly imported" prel_imports
++ withReason "is directly imported" import_decls
@@ -1652,7 +1649,7 @@ tcPreludeClashWarn warnFlag name = do
-- Implicit (Prelude) import?
isImplicit :: ImportDecl GhcRn -> Bool
- isImplicit = ideclImplicit
+ isImplicit = ideclImplicit . ideclExt
-- Unqualified import?
isUnqualified :: ImportDecl GhcRn -> Bool
@@ -1662,17 +1659,17 @@ tcPreludeClashWarn warnFlag name = do
-- Nothing -> No explicit imports
-- Just (False, <names>) -> Explicit import list of <names>
-- Just (True , <names>) -> Explicit hiding of <names>
- importListOf :: ImportDecl GhcRn -> Maybe (Bool, [Name])
- importListOf = fmap toImportList . ideclHiding
+ importListOf :: ImportDecl GhcRn -> Maybe (ImportListInterpretation, [Name])
+ importListOf = fmap toImportList . ideclImportList
where
toImportList (h, loc) = (h, map (ieName . unLoc) (unLoc loc))
isExplicit :: ImportDecl GhcRn -> Bool
isExplicit x = case importListOf x of
Nothing -> False
- Just (False, explicit)
+ Just (Exactly, explicit)
-> nameOccName name `elem` map nameOccName explicit
- Just (True, hidden)
+ Just (EverythingBut, hidden)
-> nameOccName name `notElem` map nameOccName hidden
-- Check whether the given name would be imported (unqualified) from
diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs
index 8758db5f47..d553ec4fad 100644
--- a/compiler/GHC/Tc/Utils/Backpack.hs
+++ b/compiler/GHC/Tc/Utils/Backpack.hs
@@ -521,8 +521,6 @@ merge_msg mod_name reqs =
-- a final 'TcGblEnv' that matches the local signature and
-- all required signatures.
mergeSignatures :: HsParsedModule -> TcGblEnv -> ModIface -> TcRn TcGblEnv
-mergeSignatures (HsParsedModule { hpm_module = L _ (XModule ext) }) _ _
- = dataConCantHappen ext
mergeSignatures
(HsParsedModule { hpm_module = L loc (HsModule { hsmodExports = mb_exports }),
hpm_src_files = src_files })
View Lorry Controller Status