compiler/basicTypes/Avail.hs

   1 --
   2 -- (c) The University of Glasgow
   3 --
   4
   5 module Avail (
   6     Avails,
   7     AvailInfo(..),
   8     IsPatSyn(..),
   9     avail,
  10     patSynAvail,
  11     availsToNameSet,
  12     availsToNameSetWithSelectors,
  13     availsToNameEnv,
  14     availName, availNames, availNonFldNames,
  15     availNamesWithSelectors,
  16     availFlds,
  17     stableAvailCmp
  18   ) where
  19
  20 import Name
  21 import NameEnv
  22 import NameSet
  23
  24 import FieldLabel
  25 import Binary
  26 import Outputable
  27 import Util
  28
  29 import Data.Function
  30
  31 -- -----------------------------------------------------------------------------
  32 -- The AvailInfo type
  33
  34 -- | Records what things are "available", i.e. in scope
  35 data AvailInfo = Avail IsPatSyn Name      -- ^ An ordinary identifier in scope
  36                | AvailTC Name
  37                          [Name]
  38                          [FieldLabel]
  39                                  -- ^ A type or class in scope. Parameters:
  40                                  --
  41                                  --  1) The name of the type or class
  42                                  --  2) The available pieces of type or class,
  43                                  --     excluding field selectors.
  44                                  --  3) The record fields of the type
  45                                  --     (see Note [Representing fields in AvailInfo]).
  46                                  --
  47                                  -- The AvailTC Invariant:
  48                                  --   * If the type or class is itself
  49                                  --     to be in scope, it must be
  50                                  --     *first* in this list.  Thus,
  51                                  --     typically: @AvailTC Eq [Eq, ==, \/=]@
  52                 deriving( Eq )
  53                         -- Equality used when deciding if the
  54                         -- interface has changed
  55
  56 data IsPatSyn = NotPatSyn | IsPatSyn deriving Eq
  57
  58 -- | A collection of 'AvailInfo' - several things that are \"available\"
  59 type Avails = [AvailInfo]
  60
  61 {-
  62 Note [Representing fields in AvailInfo]
  63 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  64 When -XDuplicateRecordFields is disabled (the normal case), a
  65 datatype like
  66
  67   data T = MkT { foo :: Int }
  68
  69 gives rise to the AvailInfo
  70
  71   AvailTC T [T, MkT] [FieldLabel "foo" False foo],
  72
  73 whereas if -XDuplicateRecordFields is enabled it gives
  74
  75   AvailTC T [T, MkT] [FieldLabel "foo" True $sel:foo:MkT]
  76
  77 since the label does not match the selector name.
  78
  79 The labels in a field list are not necessarily unique:
  80 data families allow the same parent (the family tycon) to have
  81 multiple distinct fields with the same label. For example,
  82
  83   data family F a
  84   data instance F Int  = MkFInt { foo :: Int }
  85   data instance F Bool = MkFBool { foo :: Bool}
  86
  87 gives rise to
  88
  89   AvailTC F [F, MkFInt, MkFBool]
  90     [FieldLabel "foo" True $sel:foo:MkFInt, FieldLabel "foo" True $sel:foo:MkFBool].
  91
  92 Moreover, note that the flIsOverloaded flag need not be the same for
  93 all the elements of the list.  In the example above, this occurs if
  94 the two data instances are defined in different modules, one with
  95 `-XDuplicateRecordFields` enabled and one with it disabled.  Thus it
  96 is possible to have
  97
  98   AvailTC F [F, MkFInt, MkFBool]
  99     [FieldLabel "foo" True $sel:foo:MkFInt, FieldLabel "foo" False foo].
 100
 101 If the two data instances are defined in different modules, both
 102 without `-XDuplicateRecordFields`, it will be impossible to export
 103 them from the same module (even with `-XDuplicateRecordfields`
 104 enabled), because they would be represented identically.  The
 105 workaround here is to enable `-XDuplicateRecordFields` on the defining
 106 modules.
 107 -}
 108
 109 -- | Compare lexicographically
 110 stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
 111 stableAvailCmp (Avail _ n1)       (Avail _ n2)   = n1 `stableNameCmp` n2
 112 stableAvailCmp (Avail {})         (AvailTC {})   = LT
 113 stableAvailCmp (AvailTC n ns nfs) (AvailTC m ms mfs) =
 114     (n `stableNameCmp` m) `thenCmp`
 115     (cmpList stableNameCmp ns ms) `thenCmp`
 116     (cmpList (stableNameCmp `on` flSelector) nfs mfs)
 117 stableAvailCmp (AvailTC {})       (Avail {})     = GT
 118
 119 patSynAvail :: Name -> AvailInfo
 120 patSynAvail n = Avail IsPatSyn n
 121
 122 avail :: Name -> AvailInfo
 123 avail n = Avail NotPatSyn n
 124
 125 -- -----------------------------------------------------------------------------
 126 -- Operations on AvailInfo
 127
 128 availsToNameSet :: [AvailInfo] -> NameSet
 129 availsToNameSet avails = foldr add emptyNameSet avails
 130       where add avail set = extendNameSetList set (availNames avail)
 131
 132 availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
 133 availsToNameSetWithSelectors avails = foldr add emptyNameSet avails
 134       where add avail set = extendNameSetList set (availNamesWithSelectors avail)
 135
 136 availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
 137 availsToNameEnv avails = foldr add emptyNameEnv avails
 138      where add avail env = extendNameEnvList env
 139                                 (zip (availNames avail) (repeat avail))
 140
 141 -- | Just the main name made available, i.e. not the available pieces
 142 -- of type or class brought into scope by the 'GenAvailInfo'
 143 availName :: AvailInfo -> Name
 144 availName (Avail _ n)     = n
 145 availName (AvailTC n _ _) = n
 146
 147 -- | All names made available by the availability information (excluding overloaded selectors)
 148 availNames :: AvailInfo -> [Name]
 149 availNames (Avail _ n)         = [n]
 150 availNames (AvailTC _ ns fs) = ns ++ [ flSelector f | f <- fs, not (flIsOverloaded f) ]
 151
 152 -- | All names made available by the availability information (including overloaded selectors)
 153 availNamesWithSelectors :: AvailInfo -> [Name]
 154 availNamesWithSelectors (Avail _ n)         = [n]
 155 availNamesWithSelectors (AvailTC _ ns fs) = ns ++ map flSelector fs
 156
 157 -- | Names for non-fields made available by the availability information
 158 availNonFldNames :: AvailInfo -> [Name]
 159 availNonFldNames (Avail _ n)        = [n]
 160 availNonFldNames (AvailTC _ ns _) = ns
 161
 162 -- | Fields made available by the availability information
 163 availFlds :: AvailInfo -> [FieldLabel]
 164 availFlds (AvailTC _ _ fs) = fs
 165 availFlds _                = []
 166
 167 -- -----------------------------------------------------------------------------
 168 -- Printing
 169
 170 instance Outputable AvailInfo where
 171    ppr = pprAvail
 172
 173 pprAvail :: AvailInfo -> SDoc
 174 pprAvail (Avail _ n)
 175   = ppr n
 176 pprAvail (AvailTC n ns fs)
 177   = ppr n <> braces (sep [ fsep (punctuate comma (map ppr ns)) <> semi
 178                          , fsep (punctuate comma (map (ppr . flLabel) fs))])
 179
 180 instance Binary AvailInfo where
 181     put_ bh (Avail b aa) = do
 182             putByte bh 0
 183             put_ bh aa
 184             put_ bh b
 185     put_ bh (AvailTC ab ac ad) = do
 186             putByte bh 1
 187             put_ bh ab
 188             put_ bh ac
 189             put_ bh ad
 190     get bh = do
 191             h <- getByte bh
 192             case h of
 193               0 -> do aa <- get bh
 194                       b  <- get bh
 195                       return (Avail b aa)
 196               _ -> do ab <- get bh
 197                       ac <- get bh
 198                       ad <- get bh
 199                       return (AvailTC ab ac ad)
 200
 201 instance Binary IsPatSyn where
 202   put_ bh IsPatSyn = putByte bh 0
 203   put_ bh NotPatSyn = putByte bh 1
 204   get bh = do
 205     h <- getByte bh
 206     case h of
 207       0 -> return IsPatSyn
 208       _ -> return NotPatSyn