diff options
Diffstat (limited to 'compiler/basicTypes/Avail.hs')
| -rw-r--r-- | compiler/basicTypes/Avail.hs | 38 |
1 files changed, 10 insertions, 28 deletions
diff --git a/compiler/basicTypes/Avail.hs b/compiler/basicTypes/Avail.hs index 4dc6cb6cce..8844c3faf5 100644 --- a/compiler/basicTypes/Avail.hs +++ b/compiler/basicTypes/Avail.hs @@ -5,9 +5,7 @@ module Avail ( Avails, AvailInfo(..), - IsPatSyn(..), avail, - patSynAvail, availsToNameSet, availsToNameSetWithSelectors, availsToNameEnv, @@ -32,7 +30,7 @@ import Data.Function -- The AvailInfo type -- | Records what things are "available", i.e. in scope -data AvailInfo = Avail IsPatSyn Name -- ^ An ordinary identifier in scope +data AvailInfo = Avail Name -- ^ An ordinary identifier in scope | AvailTC Name [Name] [FieldLabel] @@ -53,8 +51,6 @@ data AvailInfo = Avail IsPatSyn Name -- ^ An ordinary identifier in scope -- Equality used when deciding if the -- interface has changed -data IsPatSyn = NotPatSyn | IsPatSyn deriving Eq - -- | A collection of 'AvailInfo' - several things that are \"available\" type Avails = [AvailInfo] @@ -108,7 +104,7 @@ modules. -- | Compare lexicographically stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering -stableAvailCmp (Avail _ n1) (Avail _ n2) = n1 `stableNameCmp` n2 +stableAvailCmp (Avail n1) (Avail n2) = n1 `stableNameCmp` n2 stableAvailCmp (Avail {}) (AvailTC {}) = LT stableAvailCmp (AvailTC n ns nfs) (AvailTC m ms mfs) = (n `stableNameCmp` m) `thenCmp` @@ -116,11 +112,8 @@ stableAvailCmp (AvailTC n ns nfs) (AvailTC m ms mfs) = (cmpList (stableNameCmp `on` flSelector) nfs mfs) stableAvailCmp (AvailTC {}) (Avail {}) = GT -patSynAvail :: Name -> AvailInfo -patSynAvail n = Avail IsPatSyn n - avail :: Name -> AvailInfo -avail n = Avail NotPatSyn n +avail n = Avail n -- ----------------------------------------------------------------------------- -- Operations on AvailInfo @@ -141,22 +134,22 @@ 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 (Avail n) = n availName (AvailTC n _ _) = n -- | All names made available by the availability information (excluding overloaded selectors) availNames :: AvailInfo -> [Name] -availNames (Avail _ n) = [n] +availNames (Avail n) = [n] availNames (AvailTC _ ns fs) = ns ++ [ flSelector f | f <- fs, not (flIsOverloaded f) ] -- | All names made available by the availability information (including overloaded selectors) availNamesWithSelectors :: AvailInfo -> [Name] -availNamesWithSelectors (Avail _ n) = [n] +availNamesWithSelectors (Avail n) = [n] availNamesWithSelectors (AvailTC _ ns fs) = ns ++ map flSelector fs -- | Names for non-fields made available by the availability information availNonFldNames :: AvailInfo -> [Name] -availNonFldNames (Avail _ n) = [n] +availNonFldNames (Avail n) = [n] availNonFldNames (AvailTC _ ns _) = ns -- | Fields made available by the availability information @@ -171,17 +164,16 @@ instance Outputable AvailInfo where ppr = pprAvail pprAvail :: AvailInfo -> SDoc -pprAvail (Avail _ n) +pprAvail (Avail n) = ppr n pprAvail (AvailTC n ns fs) = ppr n <> braces (sep [ fsep (punctuate comma (map ppr ns)) <> semi , fsep (punctuate comma (map (ppr . flLabel) fs))]) instance Binary AvailInfo where - put_ bh (Avail b aa) = do + put_ bh (Avail aa) = do putByte bh 0 put_ bh aa - put_ bh b put_ bh (AvailTC ab ac ad) = do putByte bh 1 put_ bh ab @@ -191,18 +183,8 @@ instance Binary AvailInfo where h <- getByte bh case h of 0 -> do aa <- get bh - b <- get bh - return (Avail b aa) + return (Avail aa) _ -> do ab <- get bh ac <- get bh ad <- get bh return (AvailTC ab ac ad) - -instance Binary IsPatSyn where - put_ bh IsPatSyn = putByte bh 0 - put_ bh NotPatSyn = putByte bh 1 - get bh = do - h <- getByte bh - case h of - 0 -> return IsPatSyn - _ -> return NotPatSyn |