module Avail (
Avails,
AvailInfo(..),
availsToNameSet,
availsToNameEnv,
availName, availNames,
stableAvailCmp,
gresFromAvails,
gresFromAvail
) where
import Name
import NameEnv
import NameSet
import RdrName
import Binary
import Outputable
import Util
data AvailInfo = Avail Name
| AvailTC Name
[Name]
deriving( Eq )
type Avails = [AvailInfo]
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
stableAvailCmp (Avail n1) (Avail n2) = n1 `stableNameCmp` n2
stableAvailCmp (Avail {}) (AvailTC {}) = LT
stableAvailCmp (AvailTC n ns) (AvailTC m ms) = (n `stableNameCmp` m) `thenCmp`
(cmpList stableNameCmp ns ms)
stableAvailCmp (AvailTC {}) (Avail {}) = GT
availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet avails = foldr add emptyNameSet avails
where add avail set = addListToNameSet set (availNames avail)
availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv avails = foldr add emptyNameEnv avails
where add avail env = extendNameEnvList env
(zip (availNames avail) (repeat avail))
availName :: AvailInfo -> Name
availName (Avail n) = n
availName (AvailTC n _) = n
availNames :: AvailInfo -> [Name]
availNames (Avail n) = [n]
availNames (AvailTC _ ns) = ns
gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails prov avails
= concatMap (gresFromAvail (const prov)) avails
gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail prov_fn avail
= [ GRE {gre_name = n,
gre_par = parent n avail,
gre_prov = prov_fn n}
| n <- availNames avail ]
where
parent _ (Avail _) = NoParent
parent n (AvailTC m _) | n == m = NoParent
| otherwise = ParentIs m
instance Outputable AvailInfo where
ppr = pprAvail
pprAvail :: AvailInfo -> SDoc
pprAvail (Avail n) = ppr n
pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
instance Binary AvailInfo where
put_ bh (Avail aa) = do
putByte bh 0
put_ bh aa
put_ bh (AvailTC ab ac) = do
putByte bh 1
put_ bh ab
put_ bh ac
get bh = do
h <- getByte bh
case h of
0 -> do aa <- get bh
return (Avail aa)
_ -> do ab <- get bh
ac <- get bh
return (AvailTC ab ac)