never executed always true always false
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE UndecidableInstances #-}
4
5 {-
6 %
7 % (c) Adam Gundry 2013-2015
8 %
9
10 Note [FieldLabel]
11 ~~~~~~~~~~~~~~~~~
12
13 This module defines the representation of FieldLabels as stored in
14 TyCons. As well as a selector name, these have some extra structure
15 to support the DuplicateRecordFields and NoFieldSelectors extensions.
16
17 In the normal case (with NoDuplicateRecordFields and FieldSelectors),
18 a datatype like
19
20 data T = MkT { foo :: Int }
21
22 has
23
24 FieldLabel { flLabel = "foo"
25 , flHasDuplicateRecordFields = NoDuplicateRecordFields
26 , flHasFieldSelector = FieldSelectors
27 , flSelector = foo }.
28
29 In particular, the Name of the selector has the same string
30 representation as the label. If DuplicateRecordFields
31 is enabled, however, the same declaration instead gives
32
33 FieldLabel { flLabel = "foo"
34 , flHasDuplicateRecordFields = DuplicateRecordFields
35 , flHasFieldSelector = FieldSelectors
36 , flSelector = $sel:foo:MkT }.
37
38 Similarly, the selector name will be mangled if NoFieldSelectors is used
39 (whether or not DuplicateRecordFields is enabled). See Note [NoFieldSelectors]
40 in GHC.Rename.Env.
41
42 Now the name of the selector ($sel:foo:MkT) does not match the label of
43 the field (foo). We must be careful not to show the selector name to
44 the user! The point of mangling the selector name is to allow a
45 module to define the same field label in different datatypes:
46
47 data T = MkT { foo :: Int }
48 data U = MkU { foo :: Bool }
49
50 Now there will be two FieldLabel values for 'foo', one in T and one in
51 U. They share the same label (FieldLabelString), but the selector
52 functions differ.
53
54 See also Note [Representing fields in AvailInfo] in GHC.Types.Avail.
55
56 Note [Why selector names include data constructors]
57 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
58
59 As explained above, a selector name includes the name of the first
60 data constructor in the type, so that the same label can appear
61 multiple times in the same module. (This is irrespective of whether
62 the first constructor has that field, for simplicity.)
63
64 We use a data constructor name, rather than the type constructor name,
65 because data family instances do not have a representation type
66 constructor name generated until relatively late in the typechecking
67 process.
68
69 Of course, datatypes with no constructors cannot have any fields.
70
71 -}
72
73 module GHC.Types.FieldLabel
74 ( FieldLabelString
75 , FieldLabelEnv
76 , FieldLabel(..)
77 , fieldSelectorOccName
78 , fieldLabelPrintableName
79 , DuplicateRecordFields(..)
80 , FieldSelectors(..)
81 , flIsOverloaded
82 )
83 where
84
85 import GHC.Prelude
86
87 import {-# SOURCE #-} GHC.Types.Name.Occurrence
88 import {-# SOURCE #-} GHC.Types.Name
89
90 import GHC.Data.FastString
91 import GHC.Data.FastString.Env
92 import GHC.Utils.Outputable
93 import GHC.Utils.Binary
94
95 import Data.Bool
96 import Data.Data
97
98 -- | Field labels are just represented as strings;
99 -- they are not necessarily unique (even within a module)
100 type FieldLabelString = FastString
101
102 -- | A map from labels to all the auxiliary information
103 type FieldLabelEnv = DFastStringEnv FieldLabel
104
105 -- | Fields in an algebraic record type; see Note [FieldLabel].
106 data FieldLabel = FieldLabel {
107 flLabel :: FieldLabelString,
108 -- ^ User-visible label of the field
109 flHasDuplicateRecordFields :: DuplicateRecordFields,
110 -- ^ Was @DuplicateRecordFields@ on in the defining module for this datatype?
111 flHasFieldSelector :: FieldSelectors,
112 -- ^ Was @FieldSelectors@ enabled in the defining module for this datatype?
113 -- See Note [NoFieldSelectors] in GHC.Rename.Env
114 flSelector :: Name
115 -- ^ Record selector function
116 }
117 deriving (Data, Eq)
118
119 instance HasOccName FieldLabel where
120 occName = mkVarOccFS . flLabel
121
122 instance Outputable FieldLabel where
123 ppr fl = ppr (flLabel fl) <> whenPprDebug (braces (ppr (flSelector fl))
124 <> ppr (flHasDuplicateRecordFields fl)
125 <> ppr (flHasFieldSelector fl))
126
127 -- | Flag to indicate whether the DuplicateRecordFields extension is enabled.
128 data DuplicateRecordFields
129 = DuplicateRecordFields -- ^ Fields may be duplicated in a single module
130 | NoDuplicateRecordFields -- ^ Fields must be unique within a module (the default)
131 deriving (Show, Eq, Typeable, Data)
132
133 instance Binary DuplicateRecordFields where
134 put_ bh f = put_ bh (f == DuplicateRecordFields)
135 get bh = bool NoDuplicateRecordFields DuplicateRecordFields <$> get bh
136
137 instance Outputable DuplicateRecordFields where
138 ppr DuplicateRecordFields = text "+dup"
139 ppr NoDuplicateRecordFields = text "-dup"
140
141
142 -- | Flag to indicate whether the FieldSelectors extension is enabled.
143 data FieldSelectors
144 = FieldSelectors -- ^ Selector functions are available (the default)
145 | NoFieldSelectors -- ^ Selector functions are not available
146 deriving (Show, Eq, Typeable, Data)
147
148 instance Binary FieldSelectors where
149 put_ bh f = put_ bh (f == FieldSelectors)
150 get bh = bool NoFieldSelectors FieldSelectors <$> get bh
151
152 instance Outputable FieldSelectors where
153 ppr FieldSelectors = text "+sel"
154 ppr NoFieldSelectors = text "-sel"
155
156
157 -- | We need the @Binary Name@ constraint here even though there is an instance
158 -- defined in "GHC.Types.Name", because the we have a SOURCE import, so the
159 -- instance is not in scope. And the instance cannot be added to Name.hs-boot
160 -- because "GHC.Utils.Binary" itself depends on "GHC.Types.Name".
161 instance Binary Name => Binary FieldLabel where
162 put_ bh (FieldLabel aa ab ac ad) = do
163 put_ bh aa
164 put_ bh ab
165 put_ bh ac
166 put_ bh ad
167 get bh = do
168 aa <- get bh
169 ab <- get bh
170 ac <- get bh
171 ad <- get bh
172 return (FieldLabel aa ab ac ad)
173
174
175 -- | Record selector OccNames are built from the underlying field name
176 -- and the name of the first data constructor of the type, to support
177 -- duplicate record field names.
178 -- See Note [Why selector names include data constructors].
179 fieldSelectorOccName :: FieldLabelString -> OccName -> DuplicateRecordFields -> FieldSelectors -> OccName
180 fieldSelectorOccName lbl dc dup_fields_ok has_sel
181 | shouldMangleSelectorNames dup_fields_ok has_sel = mkRecFldSelOcc str
182 | otherwise = mkVarOccFS lbl
183 where
184 str = ":" ++ unpackFS lbl ++ ":" ++ occNameString dc
185
186 -- | Undo the name mangling described in Note [FieldLabel] to produce a Name
187 -- that has the user-visible OccName (but the selector's unique). This should
188 -- be used only when generating output, when we want to show the label, but may
189 -- need to qualify it with a module prefix.
190 fieldLabelPrintableName :: FieldLabel -> Name
191 fieldLabelPrintableName fl
192 | flIsOverloaded fl = tidyNameOcc (flSelector fl) (mkVarOccFS (flLabel fl))
193 | otherwise = flSelector fl
194
195 -- | Selector name mangling should be used if either DuplicateRecordFields or
196 -- NoFieldSelectors is enabled, so that the OccName of the field can be used for
197 -- something else. See Note [FieldLabel], and Note [NoFieldSelectors] in
198 -- GHC.Rename.Env.
199 shouldMangleSelectorNames :: DuplicateRecordFields -> FieldSelectors -> Bool
200 shouldMangleSelectorNames dup_fields_ok has_sel
201 = dup_fields_ok == DuplicateRecordFields || has_sel == NoFieldSelectors
202
203 flIsOverloaded :: FieldLabel -> Bool
204 flIsOverloaded fl =
205 shouldMangleSelectorNames (flHasDuplicateRecordFields fl) (flHasFieldSelector fl)