Avail.hs 6.52 KB
Newer Older
1
2
3
4
5
6
7
--
-- (c) The University of Glasgow
--

module Avail (
    Avails,
    AvailInfo(..),
8
    avail,
9
    availsToNameSet,
Adam Gundry's avatar
Adam Gundry committed
10
    availsToNameSetWithSelectors,
11
    availsToNameEnv,
Adam Gundry's avatar
Adam Gundry committed
12
13
14
    availName, availNames, availNonFldNames,
    availNamesWithSelectors,
    availFlds,
15
    stableAvailCmp
16
17
18
19
20
21
  ) where

import Name
import NameEnv
import NameSet

Adam Gundry's avatar
Adam Gundry committed
22
import FieldLabel
23
import Binary
24
25
26
import Outputable
import Util

Adam Gundry's avatar
Adam Gundry committed
27
28
import Data.Function

29
30
31
32
-- -----------------------------------------------------------------------------
-- The AvailInfo type

-- | Records what things are "available", i.e. in scope
33
data AvailInfo = Avail Name      -- ^ An ordinary identifier in scope
34
               | AvailTC Name
Adam Gundry's avatar
Adam Gundry committed
35
36
37
                         [Name]
                         [FieldLabel]
                                 -- ^ A type or class in scope. Parameters:
38
39
                                 --
                                 --  1) The name of the type or class
Adam Gundry's avatar
Adam Gundry committed
40
41
42
43
                                 --  2) The available pieces of type or class,
                                 --     excluding field selectors.
                                 --  3) The record fields of the type
                                 --     (see Note [Representing fields in AvailInfo]).
44
45
                                 --
                                 -- The AvailTC Invariant:
46
                                 --   * If the type or class is itself
47
48
                                 --     to be in scope, it must be
                                 --     *first* in this list.  Thus,
49
                                 --     typically: @AvailTC Eq [Eq, ==, \/=]@
50
                deriving( Eq )
51
52
53
54
                        -- Equality used when deciding if the
                        -- interface has changed

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

Adam Gundry's avatar
Adam Gundry committed
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
{-
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.
-}

105
106
-- | Compare lexicographically
stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
107
stableAvailCmp (Avail n1)       (Avail n2)   = n1 `stableNameCmp` n2
Adam Gundry's avatar
Adam Gundry committed
108
109
110
111
112
113
stableAvailCmp (Avail {})         (AvailTC {})   = LT
stableAvailCmp (AvailTC n ns nfs) (AvailTC m ms mfs) =
    (n `stableNameCmp` m) `thenCmp`
    (cmpList stableNameCmp ns ms) `thenCmp`
    (cmpList (stableNameCmp `on` flSelector) nfs mfs)
stableAvailCmp (AvailTC {})       (Avail {})     = GT
114

115
avail :: Name -> AvailInfo
116
avail n = Avail n
117

118
119
120
121
122
-- -----------------------------------------------------------------------------
-- Operations on AvailInfo

availsToNameSet :: [AvailInfo] -> NameSet
availsToNameSet avails = foldr add emptyNameSet avails
123
      where add avail set = extendNameSetList set (availNames avail)
124

Adam Gundry's avatar
Adam Gundry committed
125
126
127
128
availsToNameSetWithSelectors :: [AvailInfo] -> NameSet
availsToNameSetWithSelectors avails = foldr add emptyNameSet avails
      where add avail set = extendNameSetList set (availNamesWithSelectors avail)

129
130
131
132
133
134
135
136
availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
availsToNameEnv avails = foldr add emptyNameEnv avails
     where add avail env = extendNameEnvList env
                                (zip (availNames avail) (repeat 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
137
availName (Avail n)     = n
Adam Gundry's avatar
Adam Gundry committed
138
availName (AvailTC n _ _) = n
139

Adam Gundry's avatar
Adam Gundry committed
140
-- | All names made available by the availability information (excluding overloaded selectors)
141
availNames :: AvailInfo -> [Name]
142
availNames (Avail n)         = [n]
Adam Gundry's avatar
Adam Gundry committed
143
144
145
146
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]
147
availNamesWithSelectors (Avail n)         = [n]
Adam Gundry's avatar
Adam Gundry committed
148
149
150
151
availNamesWithSelectors (AvailTC _ ns fs) = ns ++ map flSelector fs

-- | Names for non-fields made available by the availability information
availNonFldNames :: AvailInfo -> [Name]
152
availNonFldNames (Avail n)        = [n]
Adam Gundry's avatar
Adam Gundry committed
153
154
155
156
157
158
159
availNonFldNames (AvailTC _ ns _) = ns

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

160
161
162
163
164
165
166
-- -----------------------------------------------------------------------------
-- Printing

instance Outputable AvailInfo where
   ppr = pprAvail

pprAvail :: AvailInfo -> SDoc
167
pprAvail (Avail n)
168
169
170
171
  = 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))])
172

173
instance Binary AvailInfo where
174
    put_ bh (Avail aa) = do
175
176
            putByte bh 0
            put_ bh aa
Adam Gundry's avatar
Adam Gundry committed
177
    put_ bh (AvailTC ab ac ad) = do
178
179
180
            putByte bh 1
            put_ bh ab
            put_ bh ac
Adam Gundry's avatar
Adam Gundry committed
181
            put_ bh ad
182
183
184
185
    get bh = do
            h <- getByte bh
            case h of
              0 -> do aa <- get bh
186
                      return (Avail aa)
187
188
              _ -> do ab <- get bh
                      ac <- get bh
Adam Gundry's avatar
Adam Gundry committed
189
190
                      ad <- get bh
                      return (AvailTC ab ac ad)