never executed always true always false
1 {-
2 This module contains code which maintains and manipulates the
3 fixity environment during renaming.
4 -}
5
6 module GHC.Rename.Fixity
7 ( MiniFixityEnv
8 , addLocalFixities
9 , lookupFixityRn
10 , lookupFixityRn_help
11 , lookupFieldFixityRn
12 , lookupTyFixityRn
13 ) where
14
15 import GHC.Prelude
16
17 import GHC.Iface.Load
18 import GHC.Hs
19 import GHC.Tc.Utils.Monad
20
21 import GHC.Unit.Module
22 import GHC.Unit.Module.ModIface
23
24 import GHC.Types.Fixity.Env
25 import GHC.Types.Name
26 import GHC.Types.Name.Env
27 import GHC.Types.Name.Reader
28 import GHC.Types.Fixity
29 import GHC.Types.SourceText
30 import GHC.Types.SrcLoc
31
32 import GHC.Utils.Outputable
33
34 import GHC.Data.Maybe
35
36 import GHC.Rename.Unbound
37
38 {-
39 *********************************************************
40 * *
41 Fixities
42 * *
43 *********************************************************
44
45 Note [Fixity signature lookup]
46 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
47 A fixity declaration like
48
49 infixr 2 ?
50
51 can refer to a value-level operator, e.g.:
52
53 (?) :: String -> String -> String
54
55 or a type-level operator, like:
56
57 data (?) a b = A a | B b
58
59 so we extend the lookup of the reader name '?' to the TcClsName namespace, as
60 well as the original namespace.
61
62 The extended lookup is also used in other places, like resolution of
63 deprecation declarations, and lookup of names in GHCi.
64 -}
65
66 --------------------------------
67 type MiniFixityEnv = FastStringEnv (Located Fixity)
68 -- Mini fixity env for the names we're about
69 -- to bind, in a single binding group
70 --
71 -- It is keyed by the *FastString*, not the *OccName*, because
72 -- the single fixity decl infix 3 T
73 -- affects both the data constructor T and the type constructor T
74 --
75 -- We keep the location so that if we find
76 -- a duplicate, we can report it sensibly
77
78 --------------------------------
79 -- Used for nested fixity decls to bind names along with their fixities.
80 -- the fixities are given as a UFM from an OccName's FastString to a fixity decl
81
82 addLocalFixities :: MiniFixityEnv -> [Name] -> RnM a -> RnM a
83 addLocalFixities mini_fix_env names thing_inside
84 = extendFixityEnv (mapMaybe find_fixity names) thing_inside
85 where
86 find_fixity name
87 = case lookupFsEnv mini_fix_env (occNameFS occ) of
88 Just lfix -> Just (name, FixItem occ (unLoc lfix))
89 Nothing -> Nothing
90 where
91 occ = nameOccName name
92
93 {-
94 --------------------------------
95 lookupFixity is a bit strange.
96
97 * Nested local fixity decls are put in the local fixity env, which we
98 find with getFixtyEnv
99
100 * Imported fixities are found in the PIT
101
102 * Top-level fixity decls in this module may be for Names that are
103 either Global (constructors, class operations)
104 or Local/Exported (everything else)
105 (See notes with GHC.Rename.Names.getLocalDeclBinders for why we have this split.)
106 We put them all in the local fixity environment
107 -}
108
109 lookupFixityRn :: Name -> RnM Fixity
110 lookupFixityRn name = lookupFixityRn' name (nameOccName name)
111
112 lookupFixityRn' :: Name -> OccName -> RnM Fixity
113 lookupFixityRn' name = fmap snd . lookupFixityRn_help' name
114
115 -- | 'lookupFixityRn_help' returns @(True, fixity)@ if it finds a 'Fixity'
116 -- in a local environment or from an interface file. Otherwise, it returns
117 -- @(False, fixity)@ (e.g., for unbound 'Name's or 'Name's without
118 -- user-supplied fixity declarations).
119 lookupFixityRn_help :: Name
120 -> RnM (Bool, Fixity)
121 lookupFixityRn_help name =
122 lookupFixityRn_help' name (nameOccName name)
123
124 lookupFixityRn_help' :: Name
125 -> OccName
126 -> RnM (Bool, Fixity)
127 lookupFixityRn_help' name occ
128 | isUnboundName name
129 = return (False, Fixity NoSourceText minPrecedence InfixL)
130 -- Minimise errors from ubound names; eg
131 -- a>0 `foo` b>0
132 -- where 'foo' is not in scope, should not give an error (#7937)
133
134 | otherwise
135 = do { local_fix_env <- getFixityEnv
136 ; case lookupNameEnv local_fix_env name of {
137 Just (FixItem _ fix) -> return (True, fix) ;
138 Nothing ->
139
140 do { this_mod <- getModule
141 ; if nameIsLocalOrFrom this_mod name
142 -- Local (and interactive) names are all in the
143 -- fixity env, and don't have entries in the HPT
144 then return (False, defaultFixity)
145 else lookup_imported } } }
146 where
147 lookup_imported
148 -- For imported names, we have to get their fixities by doing a
149 -- loadInterfaceForName, and consulting the Ifaces that comes back
150 -- from that, because the interface file for the Name might not
151 -- have been loaded yet. Why not? Suppose you import module A,
152 -- which exports a function 'f', thus;
153 -- module CurrentModule where
154 -- import A( f )
155 -- module A( f ) where
156 -- import B( f )
157 -- Then B isn't loaded right away (after all, it's possible that
158 -- nothing from B will be used). When we come across a use of
159 -- 'f', we need to know its fixity, and it's then, and only
160 -- then, that we load B.hi. That is what's happening here.
161 --
162 -- loadInterfaceForName will find B.hi even if B is a hidden module,
163 -- and that's what we want.
164 = do { iface <- loadInterfaceForName doc name
165 ; let mb_fix = mi_fix_fn (mi_final_exts iface) occ
166 ; let msg = case mb_fix of
167 Nothing ->
168 text "looking up name" <+> ppr name
169 <+> text "in iface, but found no fixity for it."
170 <+> text "Using default fixity instead."
171 Just f ->
172 text "looking up name in iface and found:"
173 <+> vcat [ppr name, ppr f]
174 ; traceRn "lookupFixityRn_either:" msg
175 ; return (maybe (False, defaultFixity) (\f -> (True, f)) mb_fix) }
176
177 doc = text "Checking fixity for" <+> ppr name
178
179 ---------------
180 lookupTyFixityRn :: LocatedN Name -> RnM Fixity
181 lookupTyFixityRn = lookupFixityRn . unLoc
182
183 -- | Look up the fixity of an occurrence of a record field selector.
184 -- We use 'lookupFixityRn'' so that we can specify the 'OccName' as
185 -- the field label, which might be different to the 'OccName' of the
186 -- selector 'Name' if @DuplicateRecordFields@ is in use (#1173).
187 lookupFieldFixityRn :: FieldOcc GhcRn -> RnM Fixity
188 lookupFieldFixityRn (FieldOcc n lrdr)
189 = lookupFixityRn' n (rdrNameOcc (unLoc lrdr))