summaryrefslogtreecommitdiff
path: root/compiler/basicTypes
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/basicTypes')
-rw-r--r--compiler/basicTypes/Avail.hs63
-rw-r--r--compiler/basicTypes/BasicTypes.hs2
-rw-r--r--compiler/basicTypes/RdrName.hs27
3 files changed, 68 insertions, 24 deletions
diff --git a/compiler/basicTypes/Avail.hs b/compiler/basicTypes/Avail.hs
index 495e96ded8..c51c6eea1c 100644
--- a/compiler/basicTypes/Avail.hs
+++ b/compiler/basicTypes/Avail.hs
@@ -8,24 +8,54 @@ module Avail (
availsToNameSet,
availsToNameEnv,
availName, availNames,
- stableAvailCmp
+ stableAvailCmp,
+
+ NameWarn(..),
+ nameWarnName,
+ availNameWarns,
) where
import Name
import NameEnv
import NameSet
+import BasicTypes
import Binary
import Outputable
import Util
-- -----------------------------------------------------------------------------
+-- The NameWarn type
+
+data NameWarn = NameWarn Name (Maybe WarningTxt)
+
+nameWarnName :: NameWarn -> Name
+nameWarnName (NameWarn n _) = n
+
+-- XXX?
+instance Eq NameWarn where
+ x == y = nameWarnName x == nameWarnName y
+
+instance Outputable NameWarn where
+ ppr (NameWarn n m) = ppr n <> braces wd
+ where wd = case m of
+ Nothing -> text "no warning"
+ Just w -> text "warning:" <+> ppr w
+
+instance Binary NameWarn where
+ put_ h (NameWarn n w) = do put_ h n
+ put_ h w
+ get h = do n <- get h
+ w <- get h
+ return (NameWarn n w)
+
+-- -----------------------------------------------------------------------------
-- The AvailInfo type
-- | Records what things are "available", i.e. in scope
-data AvailInfo = Avail Name -- ^ An ordinary identifier in scope
- | AvailTC Name
- [Name] -- ^ A type or class in scope. Parameters:
+data AvailInfo = Avail NameWarn -- ^ An ordinary identifier in scope
+ | AvailTC NameWarn
+ [NameWarn] -- ^ A type or class in scope. Parameters:
--
-- 1) The name of the type or class
-- 2) The available pieces of type or class.
@@ -44,10 +74,14 @@ type Avails = [AvailInfo]
-- | Compare lexicographically
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
-stableAvailCmp (Avail n1) (Avail n2) = n1 `stableNameCmp` n2
+stableAvailCmp (Avail n1) (Avail n2) = nameWarnName n1 `stableNameCmp`
+ nameWarnName n2
stableAvailCmp (Avail {}) (AvailTC {}) = LT
-stableAvailCmp (AvailTC n ns) (AvailTC m ms) = (n `stableNameCmp` m) `thenCmp`
- (cmpList stableNameCmp ns ms)
+stableAvailCmp (AvailTC n ns) (AvailTC m ms) = (nameWarnName n `stableNameCmp`
+ nameWarnName m) `thenCmp`
+ (cmpList stableNameCmp
+ (map nameWarnName ns)
+ (map nameWarnName ms))
stableAvailCmp (AvailTC {}) (Avail {}) = GT
@@ -66,13 +100,19 @@ availsToNameEnv avails = foldr add emptyNameEnv avails
-- | Just the main name made available, i.e. not the available pieces
-- of type or class brought into scope by the 'GenAvailInfo'
availName :: AvailInfo -> Name
-availName (Avail n) = n
-availName (AvailTC n _) = n
+availName = nameWarnName . availNameWarn
+
+availNameWarn :: AvailInfo -> NameWarn
+availNameWarn (Avail nw) = nw
+availNameWarn (AvailTC nw _) = nw
-- | All names made available by the availability information
availNames :: AvailInfo -> [Name]
-availNames (Avail n) = [n]
-availNames (AvailTC _ ns) = ns
+availNames = map nameWarnName . availNameWarns
+
+availNameWarns :: AvailInfo -> [NameWarn]
+availNameWarns (Avail nw) = [nw]
+availNameWarns (AvailTC _ nws) = nws
-- -----------------------------------------------------------------------------
-- Printing
@@ -100,4 +140,3 @@ instance Binary AvailInfo where
_ -> do ab <- get bh
ac <- get bh
return (AvailTC ab ac)
-
diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index 9e52844b6b..6adb66966f 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -268,7 +268,7 @@ initialVersion = 1
-- For SourceText usage, see note [Pragma source text]
data WarningTxt = WarningTxt (Located SourceText) [Located FastString]
| DeprecatedTxt (Located SourceText) [Located FastString]
- deriving (Eq, Data, Typeable)
+ deriving (Eq, Ord, Data, Typeable)
instance Outputable WarningTxt where
ppr (WarningTxt _ ws) = doubleQuotes (vcat (map (ftext . unLoc) ws))
diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs
index 094347a4fa..9f9c8d8a9c 100644
--- a/compiler/basicTypes/RdrName.hs
+++ b/compiler/basicTypes/RdrName.hs
@@ -62,6 +62,7 @@ module RdrName (
#include "HsVersions.h"
+import BasicTypes
import Module
import Name
import Avail
@@ -509,22 +510,25 @@ That's why plusParent picks the "best" case.
-- | make a 'GlobalRdrEnv' where all the elements point to the same
-- Provenance (useful for "hiding" imports, or imports with
-- no details).
-gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
+gresFromAvails :: (Maybe WarningTxt -> Provenance) -> [AvailInfo]
+ -> [GlobalRdrElt]
gresFromAvails prov avails
= concatMap (gresFromAvail (const prov)) avails
-gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
+gresFromAvail :: (Name -> Maybe WarningTxt -> Provenance) -> AvailInfo
+ -> [GlobalRdrElt]
gresFromAvail prov_fn avail
= [ GRE {gre_name = n,
gre_par = mkParent n avail,
- gre_prov = prov_fn n}
- | n <- availNames avail ]
- where
+ gre_prov = prov_fn n mw}
+ | NameWarn n mw <- availNameWarns avail ]
mkParent :: Name -> AvailInfo -> Parent
mkParent _ (Avail _) = NoParent
-mkParent n (AvailTC m _) | n == m = NoParent
- | otherwise = ParentIs m
+mkParent n (AvailTC m _) | n == mn = NoParent
+ | otherwise = ParentIs mn
+ where
+ mn = nameWarnName m
emptyGlobalRdrEnv :: GlobalRdrEnv
emptyGlobalRdrEnv = emptyOccEnv
@@ -741,7 +745,7 @@ shadow_name env name
(Just old_mod, Just new_mod) | new_mod == old_mod -> Nothing
(Just old_mod, _) -> Just (old_gre { gre_prov = Imported [fake_imp_spec] })
where
- fake_imp_spec = ImpSpec id_spec ImpAll -- Urgh!
+ fake_imp_spec = ImpSpec id_spec ImpAll Nothing -- Urgh!
old_mod_name = moduleName old_mod
id_spec = ImpDeclSpec { is_mod = old_mod_name
, is_as = old_mod_name
@@ -815,7 +819,8 @@ data Provenance
-- INVARIANT: the list of 'ImportSpec' is non-empty
data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
- is_item :: ImpItemSpec }
+ is_item :: ImpItemSpec,
+ is_warning :: Maybe WarningTxt }
deriving( Eq, Ord )
-- | Describes a particular import declaration and is
@@ -860,8 +865,8 @@ qualSpecOK :: ModuleName -> ImportSpec -> Bool
qualSpecOK mod is = mod == is_as (is_decl is)
importSpecLoc :: ImportSpec -> SrcSpan
-importSpecLoc (ImpSpec decl ImpAll) = is_dloc decl
-importSpecLoc (ImpSpec _ item) = is_iloc item
+importSpecLoc (ImpSpec decl ImpAll _) = is_dloc decl
+importSpecLoc (ImpSpec _ item _) = is_iloc item
importSpecModule :: ImportSpec -> ModuleName
importSpecModule is = is_mod (is_decl is)
View Lorry Controller Status