{-# 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 n1 :: Name
n1)       (Avail n2 :: Name
n2)   = Name
n1 Name -> Name -> Ordering
`stableNameCmp` Name
n2
stableAvailCmp (Avail {})         (AvailTC {})   = Ordering
LT
stableAvailCmp (AvailTC n :: Name
n ns :: [Name]
ns nfs :: [FieldLabel]
nfs) (AvailTC m :: Name
m ms :: [Name]
ms mfs :: [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 n :: Name
n = Name -> AvailInfo
Avail Name
n

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

availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet avails :: [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 avail :: AvailInfo
avail set :: NameSet
set = NameSet -> [Name] -> NameSet
extendNameSetList NameSet
set (AvailInfo -> [Name]
availNames AvailInfo
avail)

availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
availsToNameSetWithSelectors avails :: [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 avail :: AvailInfo
avail set :: NameSet
set = NameSet -> [Name] -> NameSet
extendNameSetList NameSet
set (AvailInfo -> [Name]
availNamesWithSelectors AvailInfo
avail)

availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv avails :: [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 avail :: AvailInfo
avail env :: 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 n :: Name
n)     = Name
n
availName (AvailTC n :: Name
n _ _) = Name
n

-- | All names made available by the availability information (excluding overloaded selectors)
availNames :: AvailInfo -> [Name]
availNames :: AvailInfo -> [Name]
availNames (Avail n :: Name
n)         = [Name
n]
availNames (AvailTC _ ns :: [Name]
ns fs :: [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 n :: Name
n)         = [Name
n]
availNamesWithSelectors (AvailTC _ ns :: [Name]
ns fs :: [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 n :: Name
n)        = [Name
n]
availNonFldNames (AvailTC _ ns :: [Name]
ns _) = [Name]
ns

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

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 n :: Name
n) = [(Name
n, Name -> OccName
nameOccName Name
n)]
availNamesWithOccs (AvailTC _ ns :: [Name]
ns fs :: [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 a1 :: AvailInfo
a1 a2 :: 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 "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 _ [] [])     a2 :: AvailInfo
a2@(AvailTC {})   = AvailInfo
a2
plusAvail a1 :: AvailInfo
a1@(AvailTC {})       (AvailTC _ [] []) = AvailInfo
a1
plusAvail (AvailTC n1 :: Name
n1 (s1 :: Name
s1:ss1 :: [Name]
ss1) fs1 :: [FieldLabel]
fs1) (AvailTC n2 :: Name
n2 (s2 :: Name
s2:ss2 :: [Name]
ss2) fs2 :: [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
       (True,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. (Outputable a, Eq a) => [a] -> [a] -> [a]
`unionLists` [Name]
ss2))
                                   ([FieldLabel]
fs1 [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a. (Outputable a, Eq a) => [a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
       (True,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. (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. (Outputable a, Eq a) => [a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
       (False,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. (Outputable a, Eq a) => [a] -> [a] -> [a]
`unionLists` [Name]
ss2))
                                   ([FieldLabel]
fs1 [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a. (Outputable a, Eq a) => [a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
       (False,False) -> Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n1 ((Name
s1Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ss1) [Name] -> [Name] -> [Name]
forall a. (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. (Outputable a, Eq a) => [a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
plusAvail (AvailTC n1 :: Name
n1 ss1 :: [Name]
ss1 fs1 :: [FieldLabel]
fs1) (AvailTC _ [] fs2 :: [FieldLabel]
fs2)
  = Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n1 [Name]
ss1 ([FieldLabel]
fs1 [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a. (Outputable a, Eq a) => [a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
plusAvail (AvailTC n1 :: Name
n1 [] fs1 :: [FieldLabel]
fs1)  (AvailTC _ ss2 :: [Name]
ss2 fs2 :: [FieldLabel]
fs2)
  = Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n1 [Name]
ss2 ([FieldLabel]
fs1 [FieldLabel] -> [FieldLabel] -> [FieldLabel]
forall a. (Outputable a, Eq a) => [a] -> [a] -> [a]
`unionLists` [FieldLabel]
fs2)
plusAvail a1 :: AvailInfo
a1 a2 :: AvailInfo
a2 = String -> SDoc -> AvailInfo
forall a. HasCallStack => String -> SDoc -> a
pprPanic "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 n :: Name
n)         _ = Name -> AvailInfo
Avail Name
n
trimAvail (AvailTC n :: Name
n ns :: [Name]
ns fs :: [FieldLabel]
fs) m :: 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 x :: FieldLabel
x  -> Name -> [Name] -> [FieldLabel] -> AvailInfo
AvailTC Name
n [] [FieldLabel
x]
    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 keep :: Name -> Bool
keep avails :: [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 keep :: Name -> Bool
keep ie :: AvailInfo
ie rest :: [AvailInfo]
rest =
  case AvailInfo
ie of
    Avail n :: Name
n | Name -> Bool
keep Name
n    -> AvailInfo
ie AvailInfo -> [AvailInfo] -> [AvailInfo]
forall a. a -> [a] -> [a]
: [AvailInfo]
rest
            | Bool
otherwise -> [AvailInfo]
rest
    AvailTC tc :: Name
tc ns :: [Name]
ns fs :: [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 avails :: [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 env :: NameEnv AvailInfo
env avail :: 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 n :: Name
n)
  = Name -> SDoc
forall a. Outputable a => a -> SDoc
ppr Name
n
pprAvail (AvailTC n :: Name
n ns :: [Name]
ns fs :: [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_ bh :: BinHandle
bh (Avail aa :: Name
aa) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
            BinHandle -> Name -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Name
aa
    put_ bh :: BinHandle
bh (AvailTC ab :: Name
ab ac :: [Name]
ac ad :: [FieldLabel]
ad) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 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 bh :: BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              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)
              _ -> 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)