{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
--
-- (c) The University of Glasgow
--

#include "HsVersions.h"

module Avail (
    Avails,
    AvailInfo(..),
    avail,
    availsToNameSet,
    availsToNameSetWithSelectors,
    availsToNameEnv,
    availName, availNames, availNonFldNames,
    availNamesWithSelectors,
    availFlds,
    availsNamesWithOccs,
    availNamesWithOccs,
    stableAvailCmp,
    plusAvail,
    trimAvail,
    filterAvail,
    filterAvails,
    nubAvails


  ) where

import GhcPrelude

import Name
import NameEnv
import NameSet

import FieldLabel
import Binary
import ListSetOps
import Outputable
import Util

import Data.Data ( Data )
import Data.List ( find )
import Data.Function

-- -----------------------------------------------------------------------------
-- The AvailInfo type

-- | Records what things are \"available\", i.e. in scope
data AvailInfo

  -- | An ordinary identifier in scope
  = Avail Name

  -- | A type or class in scope
  --
  -- The __AvailTC Invariant__: If the type or class is itself to be in scope,
  -- it must be /first/ in this list.  Thus, typically:
  --
  -- > AvailTC Eq [Eq, ==, \/=] []
  | AvailTC
       Name         -- ^ The name of the type or class
       [Name]       -- ^ The available pieces of type or class,
                    -- excluding field selectors.
       [FieldLabel] -- ^ The record fields of the type
                    -- (see Note [Representing fields in AvailInfo]).

   deriving ( Eq    -- ^ Used when deciding if the interface has changed
            , Typeable AvailInfo
DataType
Constr
Typeable AvailInfo
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> AvailInfo -> c AvailInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AvailInfo)
-> (AvailInfo -> Constr)
-> (AvailInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AvailInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AvailInfo))
-> ((forall b. Data b => b -> b) -> AvailInfo -> AvailInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AvailInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AvailInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> AvailInfo -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AvailInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo)
-> Data AvailInfo
AvailInfo -> DataType
AvailInfo -> Constr
(forall b. Data b => b -> b) -> AvailInfo -> AvailInfo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AvailInfo -> c AvailInfo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AvailInfo
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AvailInfo -> u
forall u. (forall d. Data d => d -> u) -> AvailInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AvailInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AvailInfo -> c AvailInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AvailInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AvailInfo)
$cAvailTC :: Constr
$cAvail :: Constr
$tAvailInfo :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
gmapMp :: (forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
gmapM :: (forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AvailInfo -> m AvailInfo
gmapQi :: Int -> (forall d. Data d => d -> u) -> AvailInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AvailInfo -> u
gmapQ :: (forall d. Data d => d -> u) -> AvailInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AvailInfo -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AvailInfo -> r
gmapT :: (forall b. Data b => b -> b) -> AvailInfo -> AvailInfo
$cgmapT :: (forall b. Data b => b -> b) -> AvailInfo -> AvailInfo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AvailInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c AvailInfo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AvailInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AvailInfo)
dataTypeOf :: AvailInfo -> DataType
$cdataTypeOf :: AvailInfo -> DataType
toConstr :: AvailInfo -> Constr
$ctoConstr :: AvailInfo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AvailInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AvailInfo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AvailInfo -> c AvailInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AvailInfo -> c AvailInfo
$cp1Data :: Typeable AvailInfo
Data )

-- | A collection of 'AvailInfo' - several things that are \"available\"
type Avails = [AvailInfo]

{-
Note [Representing fields in AvailInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When -XDuplicateRecordFields is disabled (the normal case), a
datatype like

  data T = MkT { foo :: Int }

gives rise to the AvailInfo

  AvailTC T [T, MkT] [FieldLabel "foo" False foo]

whereas if -XDuplicateRecordFields is enabled it gives

  AvailTC T [T, MkT] [FieldLabel "foo" True $sel:foo:MkT]

since the label does not match the selector name.

The labels in a field list are not necessarily unique:
data families allow the same parent (the family tycon) to have
multiple distinct fields with the same label. For example,

  data family F a
  data instance F Int  = MkFInt { foo :: Int }
  data instance F Bool = MkFBool { foo :: Bool}

gives rise to

  AvailTC F [ F, MkFInt, MkFBool ]
            [ FieldLabel "foo" True $sel:foo:MkFInt
            , FieldLabel "foo" True $sel:foo:MkFBool ]

Moreover, note that the flIsOverloaded flag need not be the same for
all the elements of the list.  In the example above, this occurs if
the two data instances are defined in different modules, one with
`-XDuplicateRecordFields` enabled and one with it disabled.  Thus it
is possible to have

  AvailTC F [ F, MkFInt, MkFBool ]
            [ FieldLabel "foo" True $sel:foo:MkFInt
            , FieldLabel "foo" False foo ]

If the two data instances are defined in different modules, both
without `-XDuplicateRecordFields`, it will be impossible to export
them from the same module (even with `-XDuplicateRecordfields`
enabled), because they would be represented identically.  The
workaround here is to enable `-XDuplicateRecordFields` on the defining
modules.
-}

-- | Compare lexicographically
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
stableAvailCmp (Avail Name
n1)       (Avail Name
n2)   = Name
n1 Name -> Name -> Ordering
`stableNameCmp` Name
n2
stableAvailCmp (Avail {})         (AvailTC {})   = Ordering
LT
stableAvailCmp (AvailTC Name
n [Name]
ns [FieldLabel]
nfs) (AvailTC Name
m [Name]
ms [FieldLabel]
mfs) =
    (Name
n Name -> Name -> Ordering
`stableNameCmp` Name
m) Ordering -> Ordering -> Ordering
`thenCmp`
    ((Name -> Name -> Ordering) -> [Name] -> [Name] -> Ordering
forall a. (a -> a -> Ordering) -> [a] -> [a] -> Ordering
cmpList Name -> Name -> Ordering
stableNameCmp [Name]
ns [Name]
ms) Ordering -> Ordering -> Ordering
`thenCmp`
    ((FieldLabel -> FieldLabel -> Ordering)
-> [FieldLabel] -> [FieldLabel] -> Ordering
forall a. (a -> a -> Ordering) -> [a] -> [a] -> Ordering
cmpList (Name -> Name -> Ordering
stableNameCmp (Name -> Name -> Ordering)
-> (FieldLabel -> Name) -> FieldLabel -> FieldLabel -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector) [FieldLabel]
nfs [FieldLabel]
mfs)
stableAvailCmp (AvailTC {})       (Avail {})     = Ordering
GT

avail :: Name -> AvailInfo
avail :: Name -> AvailInfo
avail Name
n = Name -> AvailInfo
Avail Name
n

-- -----------------------------------------------------------------------------
-- Operations on AvailInfo

availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet [AvailInfo]
avails = (AvailInfo -> NameSet -> NameSet)
-> NameSet -> [AvailInfo] -> NameSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AvailInfo -> NameSet -> NameSet
add NameSet
emptyNameSet [AvailInfo]
avails
      where add :: AvailInfo -> NameSet -> NameSet
add AvailInfo
avail NameSet
set = NameSet -> [Name] -> NameSet
extendNameSetList NameSet
set (AvailInfo -> [Name]
availNames AvailInfo
avail)

availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
availsToNameSetWithSelectors [AvailInfo]
avails = (AvailInfo -> NameSet -> NameSet)
-> NameSet -> [AvailInfo] -> NameSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AvailInfo -> NameSet -> NameSet
add NameSet
emptyNameSet [AvailInfo]
avails
      where add :: AvailInfo -> NameSet -> NameSet
add AvailInfo
avail NameSet
set = NameSet -> [Name] -> NameSet
extendNameSetList NameSet
set (AvailInfo -> [Name]
availNamesWithSelectors AvailInfo
avail)

availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv [AvailInfo]
avails = (AvailInfo -> NameEnv AvailInfo -> NameEnv AvailInfo)
-> NameEnv AvailInfo -> [AvailInfo] -> NameEnv AvailInfo
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AvailInfo -> NameEnv AvailInfo -> NameEnv AvailInfo
add NameEnv AvailInfo
forall a. NameEnv a
emptyNameEnv [AvailInfo]
avails
     where add :: AvailInfo -> NameEnv AvailInfo -> NameEnv AvailInfo
add AvailInfo
avail NameEnv AvailInfo
env = NameEnv AvailInfo -> [(Name, AvailInfo)] -> NameEnv AvailInfo
forall a. NameEnv a -> [(Name, a)] -> NameEnv a
extendNameEnvList NameEnv AvailInfo
env
                                ([Name] -> [AvailInfo] -> [(Name, AvailInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip (AvailInfo -> [Name]
availNames AvailInfo
avail) (AvailInfo -> [AvailInfo]
forall a. a -> [a]
repeat AvailInfo
avail))

-- | 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 :: AvailInfo -> Name
availName (Avail Name
n)     = Name
n
availName (AvailTC Name
n [Name]
_ [FieldLabel]
_) = Name
n

-- | All names made available by the availability information (excluding overloaded selectors)
availNames :: AvailInfo -> [Name]
availNames :: AvailInfo -> [Name]
availNames (Avail Name
n)         = [Name
n]
availNames (AvailTC Name
_ [Name]
ns [FieldLabel]
fs) = [Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [ FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector FieldLabel
f | FieldLabel
f <- [FieldLabel]
fs, Bool -> Bool
not (FieldLabel -> Bool
forall a. FieldLbl a -> Bool
flIsOverloaded FieldLabel
f) ]

-- | All names made available by the availability information (including overloaded selectors)
availNamesWithSelectors :: AvailInfo -> [Name]
availNamesWithSelectors :: AvailInfo -> [Name]
availNamesWithSelectors (Avail Name
n)         = [Name
n]
availNamesWithSelectors (AvailTC Name
_ [Name]
ns [FieldLabel]
fs) = [Name]
ns [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (FieldLabel -> Name) -> [FieldLabel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector [FieldLabel]
fs

-- | Names for non-fields made available by the availability information
availNonFldNames :: AvailInfo -> [Name]
availNonFldNames :: AvailInfo -> [Name]
availNonFldNames (Avail Name
n)        = [Name
n]
availNonFldNames (AvailTC Name
_ [Name]
ns [FieldLabel]
_) = [Name]
ns

-- | Fields made available by the availability information
availFlds :: AvailInfo -> [FieldLabel]
availFlds :: AvailInfo -> [FieldLabel]
availFlds (AvailTC Name
_ [Name]
_ [FieldLabel]
fs) = [FieldLabel]
fs
availFlds AvailInfo
_                = []

availsNamesWithOccs :: [AvailInfo] -> [(Name, OccName)]
availsNamesWithOccs :: [AvailInfo] -> [(Name, OccName)]
availsNamesWithOccs = (AvailInfo -> [(Name, OccName)])
-> [AvailInfo] -> [(Name, OccName)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AvailInfo -> [(Name, OccName)]
availNamesWithOccs

-- | 'Name's made available by the availability information, paired with
-- the 'OccName' used to refer to each one.
--
-- When @DuplicateRecordFields@ is in use, the 'Name' may be the
-- mangled name of a record selector (e.g. @$sel:foo:MkT@) while the
-- 'OccName' will be the label of the field (e.g. @foo@).
--
-- See Note [Representing fields in AvailInfo].
availNamesWithOccs :: AvailInfo -> [(Name, OccName)]
availNamesWithOccs :: AvailInfo -> [(Name, OccName)]
availNamesWithOccs (Avail Name
n) = [(Name
n, Name -> OccName
nameOccName Name
n)]
availNamesWithOccs (AvailTC Name
_ [Name]
ns [FieldLabel]
fs)
  = [ (Name
n, Name -> OccName
nameOccName Name
n) | Name
n <- [Name]
ns ] [(Name, OccName)] -> [(Name, OccName)] -> [(Name, OccName)]
forall a. [a] -> [a] -> [a]
++
    [ (FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector FieldLabel
fl, FastString -> OccName
mkVarOccFS (FieldLabel -> FastString
forall a. FieldLbl a -> FastString
flLabel FieldLabel
fl)) | FieldLabel
fl <- [FieldLabel]
fs ]

-- -----------------------------------------------------------------------------
-- Utility

plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
plusAvail AvailInfo
a1 AvailInfo
a2
  | Bool
debugIsOn Bool -> Bool -> Bool
&& AvailInfo -> Name
availName AvailInfo
a1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= AvailInfo -> Name
availName AvailInfo
a2
  = String -> SDoc -> AvailInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"RnEnv.plusAvail names differ" ([SDoc] -> SDoc
hsep [AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
a1,AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
a2])
plusAvail a1 :: AvailInfo
a1@(Avail {})         (Avail {})        = AvailInfo
a1
plusAvail (AvailTC Name
_ [] [])     a2 :: AvailInfo
a2@(AvailTC {})   = AvailInfo
a2
plusAvail a1 :: AvailInfo
a1@(AvailTC {})       (AvailTC Name
_ [] []) = AvailInfo
a1
plusAvail (AvailTC Name
n1 (Name
s1:[Name]
ss1) [FieldLabel]
fs1) (AvailTC Name
n2 (Name
s2:[Name]
ss2) [FieldLabel]
fs2)
  = case (Name
n1Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
s1, Name
n2Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
s2) of  -- Maintain invariant the parent is first
       (Bool
True,Bool
True)   -> Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n1 (Name
s1 Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: ([Name]
ss1 [Name] -> [Name] -> [Name]
forall a.
(HasDebugCallStack, Outputable a, Eq a) =>
[a] -> [a] -> [a]
`unionLists` [Name]
ss2))
                                   ([FieldLabel]
fs1 [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a.
(HasDebugCallStack, Outputable a, Eq a) =>
[a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
       (Bool
True,Bool
False)  -> Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n1 (Name
s1 Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: ([Name]
ss1 [Name] -> [Name] -> [Name]
forall a.
(HasDebugCallStack, Outputable a, Eq a) =>
[a] -> [a] -> [a]
`unionLists` (Name
s2Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ss2)))
                                   ([FieldLabel]
fs1 [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a.
(HasDebugCallStack, Outputable a, Eq a) =>
[a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
       (Bool
False,Bool
True)  -> Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n1 (Name
s2 Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: ((Name
s1Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ss1) [Name] -> [Name] -> [Name]
forall a.
(HasDebugCallStack, Outputable a, Eq a) =>
[a] -> [a] -> [a]
`unionLists` [Name]
ss2))
                                   ([FieldLabel]
fs1 [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a.
(HasDebugCallStack, Outputable a, Eq a) =>
[a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
       (Bool
False,Bool
False) -> Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n1 ((Name
s1Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ss1) [Name] -> [Name] -> [Name]
forall a.
(HasDebugCallStack, Outputable a, Eq a) =>
[a] -> [a] -> [a]
`unionLists` (Name
s2Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ss2))
                                   ([FieldLabel]
fs1 [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a.
(HasDebugCallStack, Outputable a, Eq a) =>
[a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
plusAvail (AvailTC Name
n1 [Name]
ss1 [FieldLabel]
fs1) (AvailTC Name
_ [] [FieldLabel]
fs2)
  = Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n1 [Name]
ss1 ([FieldLabel]
fs1 [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a.
(HasDebugCallStack, Outputable a, Eq a) =>
[a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
plusAvail (AvailTC Name
n1 [] [FieldLabel]
fs1)  (AvailTC Name
_ [Name]
ss2 [FieldLabel]
fs2)
  = Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n1 [Name]
ss2 ([FieldLabel]
fs1 [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a.
(HasDebugCallStack, Outputable a, Eq a) =>
[a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
plusAvail AvailInfo
a1 AvailInfo
a2 = String -> SDoc -> AvailInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"RnEnv.plusAvail" ([SDoc] -> SDoc
hsep [AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
a1,AvailInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr AvailInfo
a2])

-- | trims an 'AvailInfo' to keep only a single name
trimAvail :: AvailInfo -> Name -> AvailInfo
trimAvail :: AvailInfo -> Name -> AvailInfo
trimAvail (Avail Name
n)         Name
_ = Name -> AvailInfo
Avail Name
n
trimAvail (AvailTC Name
n [Name]
ns [FieldLabel]
fs) Name
m = case (FieldLabel -> Bool) -> [FieldLabel] -> Maybe FieldLabel
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
m) (Name -> Bool) -> (FieldLabel -> Name) -> FieldLabel -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector) [FieldLabel]
fs of
    Just FieldLabel
x  -> Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n [] [FieldLabel
x]
    Maybe FieldLabel
Nothing -> ASSERT( m `elem` ns ) AvailTC n [m] []

-- | filters 'AvailInfo's by the given predicate
filterAvails  :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
filterAvails :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
filterAvails Name -> Bool
keep [AvailInfo]
avails = (AvailInfo -> [AvailInfo] -> [AvailInfo])
-> [AvailInfo] -> [AvailInfo] -> [AvailInfo]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
filterAvail Name -> Bool
keep) [] [AvailInfo]
avails

-- | filters an 'AvailInfo' by the given predicate
filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
filterAvail Name -> Bool
keep AvailInfo
ie [AvailInfo]
rest =
  case AvailInfo
ie of
    Avail Name
n | Name -> Bool
keep Name
n    -> AvailInfo
ie AvailInfo -> [AvailInfo] -> [AvailInfo]
forall a. a -> [a] -> [a]
: [AvailInfo]
rest
            | Bool
otherwise -> [AvailInfo]
rest
    AvailTC Name
tc [Name]
ns [FieldLabel]
fs ->
        let ns' :: [Name]
ns' = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
keep [Name]
ns
            fs' :: [FieldLabel]
fs' = (FieldLabel -> Bool) -> [FieldLabel] -> [FieldLabel]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> Bool
keep (Name -> Bool) -> (FieldLabel -> Name) -> FieldLabel -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> Name
forall a. FieldLbl a -> a
flSelector) [FieldLabel]
fs in
        if [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
ns' Bool -> Bool -> Bool
&& [FieldLabel] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldLabel]
fs' then [AvailInfo]
rest else Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
tc [Name]
ns' [FieldLabel]
fs' AvailInfo -> [AvailInfo] -> [AvailInfo]
forall a. a -> [a] -> [a]
: [AvailInfo]
rest


-- | Combines 'AvailInfo's from the same family
-- 'avails' may have several items with the same availName
-- E.g  import Ix( Ix(..), index )
-- will give Ix(Ix,index,range) and Ix(index)
-- We want to combine these; addAvail does that
nubAvails :: [AvailInfo] -> [AvailInfo]
nubAvails :: [AvailInfo] -> [AvailInfo]
nubAvails [AvailInfo]
avails = NameEnv AvailInfo -> [AvailInfo]
forall a. NameEnv a -> [a]
nameEnvElts ((NameEnv AvailInfo -> AvailInfo -> NameEnv AvailInfo)
-> NameEnv AvailInfo -> [AvailInfo] -> NameEnv AvailInfo
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' NameEnv AvailInfo -> AvailInfo -> NameEnv AvailInfo
add NameEnv AvailInfo
forall a. NameEnv a
emptyNameEnv [AvailInfo]
avails)
  where
    add :: NameEnv AvailInfo -> AvailInfo -> NameEnv AvailInfo
add NameEnv AvailInfo
env AvailInfo
avail = (AvailInfo -> AvailInfo -> AvailInfo)
-> NameEnv AvailInfo -> Name -> AvailInfo -> NameEnv AvailInfo
forall a. (a -> a -> a) -> NameEnv a -> Name -> a -> NameEnv a
extendNameEnv_C AvailInfo -> AvailInfo -> AvailInfo
plusAvail NameEnv AvailInfo
env (AvailInfo -> Name
availName AvailInfo
avail) AvailInfo
avail

-- -----------------------------------------------------------------------------
-- Printing

instance Outputable AvailInfo where
   ppr :: AvailInfo -> SDoc
ppr = AvailInfo -> SDoc
pprAvail

pprAvail :: AvailInfo -> SDoc
pprAvail :: AvailInfo -> SDoc
pprAvail (Avail Name
n)
  = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
pprAvail (AvailTC Name
n [Name]
ns [FieldLabel]
fs)
  = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces ([SDoc] -> SDoc
sep [ [SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((Name -> SDoc) -> [Name] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Name]
ns)) SDoc -> SDoc -> SDoc
<> SDoc
semi
                         , [SDoc] -> SDoc
fsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((FieldLabel -> SDoc) -> [FieldLabel] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FastString -> SDoc)
-> (FieldLabel -> FastString) -> FieldLabel -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> FastString
forall a. FieldLbl a -> FastString
flLabel) [FieldLabel]
fs))])

instance Binary AvailInfo where
    put_ :: BinHandle -> AvailInfo -> IO ()
put_ BinHandle
bh (Avail Name
aa) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            BinHandle -> Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
aa
    put_ BinHandle
bh (AvailTC Name
ab [Name]
ac [FieldLabel]
ad) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            BinHandle -> Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
ab
            BinHandle -> [Name] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Name]
ac
            BinHandle -> [FieldLabel] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FieldLabel]
ad
    get :: BinHandle -> IO AvailInfo
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do Name
aa <- BinHandle -> IO Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      AvailInfo -> IO AvailInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> AvailInfo
Avail Name
aa)
              Word8
_ -> do Name
ab <- BinHandle -> IO Name
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      [Name]
ac <- BinHandle -> IO [Name]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      [FieldLabel]
ad <- BinHandle -> IO [FieldLabel]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      AvailInfo -> IO AvailInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
ab [Name]
ac [FieldLabel]
ad)