Get rid of some stuttering in comments and docs
[ghc.git] / compiler / rename / RnPat.hs
1 {-
2 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3
4 \section[RnPat]{Renaming of patterns}
5
6 Basically dependency analysis.
7
8 Handles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes. In
9 general, all of these functions return a renamed thing, and a set of
10 free variables.
11 -}
12
13 {-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
14
15 module RnPat (-- main entry points
16 rnPat, rnPats, rnBindPat, rnPatAndThen,
17
18 NameMaker, applyNameMaker, -- a utility for making names:
19 localRecNameMaker, topRecNameMaker, -- sometimes we want to make local names,
20 -- sometimes we want to make top (qualified) names.
21 isTopRecNameMaker,
22
23 rnHsRecFields, HsRecFieldContext(..),
24 rnHsRecUpdFields,
25
26 -- CpsRn monad
27 CpsRn, liftCps,
28
29 -- Literals
30 rnLit, rnOverLit,
31
32 -- Pattern Error messages that are also used elsewhere
33 checkTupSize, patSigErr
34 ) where
35
36 -- ENH: thin imports to only what is necessary for patterns
37
38 import GhcPrelude
39
40 import {-# SOURCE #-} RnExpr ( rnLExpr )
41 import {-# SOURCE #-} RnSplice ( rnSplicePat )
42
43 #include "HsVersions.h"
44
45 import HsSyn
46 import TcRnMonad
47 import TcHsSyn ( hsOverLitName )
48 import RnEnv
49 import RnFixity
50 import RnUtils ( HsDocContext(..), newLocalBndrRn, bindLocalNames
51 , warnUnusedMatches, newLocalBndrRn
52 , checkDupNames, checkDupAndShadowedNames
53 , checkTupSize , unknownSubordinateErr )
54 import RnUnbound ( mkUnboundName )
55 import RnTypes
56 import PrelNames
57 import TyCon ( tyConName )
58 import ConLike
59 import Type ( TyThing(..) )
60 import Name
61 import NameSet
62 import OccName ( setOccNameSpace, tcName )
63 import RdrName
64 import BasicTypes
65 import Util
66 import ListSetOps ( removeDups )
67 import Outputable
68 import SrcLoc
69 import Literal ( inCharRange )
70 import TysWiredIn ( nilDataCon )
71 import DataCon
72 import qualified GHC.LanguageExtensions as LangExt
73
74 import Control.Monad ( when, liftM, ap )
75 import qualified Data.List.NonEmpty as NE
76 import Data.Ratio
77
78 {-
79 *********************************************************
80 * *
81 The CpsRn Monad
82 * *
83 *********************************************************
84
85 Note [CpsRn monad]
86 ~~~~~~~~~~~~~~~~~~
87 The CpsRn monad uses continuation-passing style to support this
88 style of programming:
89
90 do { ...
91 ; ns <- bindNames rs
92 ; ...blah... }
93
94 where rs::[RdrName], ns::[Name]
95
96 The idea is that '...blah...'
97 a) sees the bindings of ns
98 b) returns the free variables it mentions
99 so that bindNames can report unused ones
100
101 In particular,
102 mapM rnPatAndThen [p1, p2, p3]
103 has a *left-to-right* scoping: it makes the binders in
104 p1 scope over p2,p3.
105 -}
106
107 newtype CpsRn b = CpsRn { unCpsRn :: forall r. (b -> RnM (r, FreeVars))
108 -> RnM (r, FreeVars) }
109 -- See Note [CpsRn monad]
110
111 instance Functor CpsRn where
112 fmap = liftM
113
114 instance Applicative CpsRn where
115 pure x = CpsRn (\k -> k x)
116 (<*>) = ap
117
118 instance Monad CpsRn where
119 (CpsRn m) >>= mk = CpsRn (\k -> m (\v -> unCpsRn (mk v) k))
120
121 runCps :: CpsRn a -> RnM (a, FreeVars)
122 runCps (CpsRn m) = m (\r -> return (r, emptyFVs))
123
124 liftCps :: RnM a -> CpsRn a
125 liftCps rn_thing = CpsRn (\k -> rn_thing >>= k)
126
127 liftCpsFV :: RnM (a, FreeVars) -> CpsRn a
128 liftCpsFV rn_thing = CpsRn (\k -> do { (v,fvs1) <- rn_thing
129 ; (r,fvs2) <- k v
130 ; return (r, fvs1 `plusFV` fvs2) })
131
132 wrapSrcSpanCps :: (a -> CpsRn b) -> Located a -> CpsRn (Located b)
133 -- Set the location, and also wrap it around the value returned
134 wrapSrcSpanCps fn (L loc a)
135 = CpsRn (\k -> setSrcSpan loc $
136 unCpsRn (fn a) $ \v ->
137 k (L loc v))
138
139 lookupConCps :: Located RdrName -> CpsRn (Located Name)
140 lookupConCps con_rdr
141 = CpsRn (\k -> do { con_name <- lookupLocatedOccRn con_rdr
142 ; (r, fvs) <- k con_name
143 ; return (r, addOneFV fvs (unLoc con_name)) })
144 -- We add the constructor name to the free vars
145 -- See Note [Patterns are uses]
146
147 {-
148 Note [Patterns are uses]
149 ~~~~~~~~~~~~~~~~~~~~~~~~
150 Consider
151 module Foo( f, g ) where
152 data T = T1 | T2
153
154 f T1 = True
155 f T2 = False
156
157 g _ = T1
158
159 Arguably we should report T2 as unused, even though it appears in a
160 pattern, because it never occurs in a constructed position. See
161 Trac #7336.
162 However, implementing this in the face of pattern synonyms would be
163 less straightforward, since given two pattern synonyms
164
165 pattern P1 <- P2
166 pattern P2 <- ()
167
168 we need to observe the dependency between P1 and P2 so that type
169 checking can be done in the correct order (just like for value
170 bindings). Dependencies between bindings is analyzed in the renamer,
171 where we don't know yet whether P2 is a constructor or a pattern
172 synonym. So for now, we do report conid occurrences in patterns as
173 uses.
174
175 *********************************************************
176 * *
177 Name makers
178 * *
179 *********************************************************
180
181 Externally abstract type of name makers,
182 which is how you go from a RdrName to a Name
183 -}
184
185 data NameMaker
186 = LamMk -- Lambdas
187 Bool -- True <=> report unused bindings
188 -- (even if True, the warning only comes out
189 -- if -Wunused-matches is on)
190
191 | LetMk -- Let bindings, incl top level
192 -- Do *not* check for unused bindings
193 TopLevelFlag
194 MiniFixityEnv
195
196 topRecNameMaker :: MiniFixityEnv -> NameMaker
197 topRecNameMaker fix_env = LetMk TopLevel fix_env
198
199 isTopRecNameMaker :: NameMaker -> Bool
200 isTopRecNameMaker (LetMk TopLevel _) = True
201 isTopRecNameMaker _ = False
202
203 localRecNameMaker :: MiniFixityEnv -> NameMaker
204 localRecNameMaker fix_env = LetMk NotTopLevel fix_env
205
206 matchNameMaker :: HsMatchContext a -> NameMaker
207 matchNameMaker ctxt = LamMk report_unused
208 where
209 -- Do not report unused names in interactive contexts
210 -- i.e. when you type 'x <- e' at the GHCi prompt
211 report_unused = case ctxt of
212 StmtCtxt GhciStmtCtxt -> False
213 -- also, don't warn in pattern quotes, as there
214 -- is no RHS where the variables can be used!
215 ThPatQuote -> False
216 _ -> True
217
218 rnHsSigCps :: LHsSigWcType GhcPs -> CpsRn (LHsSigWcType GhcRn)
219 rnHsSigCps sig = CpsRn (rnHsSigWcTypeScoped PatCtx sig)
220
221 newPatLName :: NameMaker -> Located RdrName -> CpsRn (Located Name)
222 newPatLName name_maker rdr_name@(L loc _)
223 = do { name <- newPatName name_maker rdr_name
224 ; return (L loc name) }
225
226 newPatName :: NameMaker -> Located RdrName -> CpsRn Name
227 newPatName (LamMk report_unused) rdr_name
228 = CpsRn (\ thing_inside ->
229 do { name <- newLocalBndrRn rdr_name
230 ; (res, fvs) <- bindLocalNames [name] (thing_inside name)
231 ; when report_unused $ warnUnusedMatches [name] fvs
232 ; return (res, name `delFV` fvs) })
233
234 newPatName (LetMk is_top fix_env) rdr_name
235 = CpsRn (\ thing_inside ->
236 do { name <- case is_top of
237 NotTopLevel -> newLocalBndrRn rdr_name
238 TopLevel -> newTopSrcBinder rdr_name
239 ; bindLocalNames [name] $ -- Do *not* use bindLocalNameFV here
240 -- See Note [View pattern usage]
241 addLocalFixities fix_env [name] $
242 thing_inside name })
243
244 -- Note: the bindLocalNames is somewhat suspicious
245 -- because it binds a top-level name as a local name.
246 -- however, this binding seems to work, and it only exists for
247 -- the duration of the patterns and the continuation;
248 -- then the top-level name is added to the global env
249 -- before going on to the RHSes (see RnSource.hs).
250
251 {-
252 Note [View pattern usage]
253 ~~~~~~~~~~~~~~~~~~~~~~~~~
254 Consider
255 let (r, (r -> x)) = x in ...
256 Here the pattern binds 'r', and then uses it *only* in the view pattern.
257 We want to "see" this use, and in let-bindings we collect all uses and
258 report unused variables at the binding level. So we must use bindLocalNames
259 here, *not* bindLocalNameFV. Trac #3943.
260
261
262 Note [Don't report shadowing for pattern synonyms]
263 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
264 There is one special context where a pattern doesn't introduce any new binders -
265 pattern synonym declarations. Therefore we don't check to see if pattern
266 variables shadow existing identifiers as they are never bound to anything
267 and have no scope.
268
269 Without this check, there would be quite a cryptic warning that the `x`
270 in the RHS of the pattern synonym declaration shadowed the top level `x`.
271
272 ```
273 x :: ()
274 x = ()
275
276 pattern P x = Just x
277 ```
278
279 See #12615 for some more examples.
280
281 *********************************************************
282 * *
283 External entry points
284 * *
285 *********************************************************
286
287 There are various entry points to renaming patterns, depending on
288 (1) whether the names created should be top-level names or local names
289 (2) whether the scope of the names is entirely given in a continuation
290 (e.g., in a case or lambda, but not in a let or at the top-level,
291 because of the way mutually recursive bindings are handled)
292 (3) whether the a type signature in the pattern can bind
293 lexically-scoped type variables (for unpacking existential
294 type vars in data constructors)
295 (4) whether we do duplicate and unused variable checking
296 (5) whether there are fixity declarations associated with the names
297 bound by the patterns that need to be brought into scope with them.
298
299 Rather than burdening the clients of this module with all of these choices,
300 we export the three points in this design space that we actually need:
301 -}
302
303 -- ----------- Entry point 1: rnPats -------------------
304 -- Binds local names; the scope of the bindings is entirely in the thing_inside
305 -- * allows type sigs to bind type vars
306 -- * local namemaker
307 -- * unused and duplicate checking
308 -- * no fixities
309 rnPats :: HsMatchContext Name -- for error messages
310 -> [LPat GhcPs]
311 -> ([LPat GhcRn] -> RnM (a, FreeVars))
312 -> RnM (a, FreeVars)
313 rnPats ctxt pats thing_inside
314 = do { envs_before <- getRdrEnvs
315
316 -- (1) rename the patterns, bringing into scope all of the term variables
317 -- (2) then do the thing inside.
318 ; unCpsRn (rnLPatsAndThen (matchNameMaker ctxt) pats) $ \ pats' -> do
319 { -- Check for duplicated and shadowed names
320 -- Must do this *after* renaming the patterns
321 -- See Note [Collect binders only after renaming] in HsUtils
322 -- Because we don't bind the vars all at once, we can't
323 -- check incrementally for duplicates;
324 -- Nor can we check incrementally for shadowing, else we'll
325 -- complain *twice* about duplicates e.g. f (x,x) = ...
326 --
327 -- See note [Don't report shadowing for pattern synonyms]
328 ; let bndrs = collectPatsBinders pats'
329 ; addErrCtxt doc_pat $
330 if isPatSynCtxt ctxt
331 then checkDupNames bndrs
332 else checkDupAndShadowedNames envs_before bndrs
333 ; thing_inside pats' } }
334 where
335 doc_pat = text "In" <+> pprMatchContext ctxt
336
337 rnPat :: HsMatchContext Name -- for error messages
338 -> LPat GhcPs
339 -> (LPat GhcRn -> RnM (a, FreeVars))
340 -> RnM (a, FreeVars) -- Variables bound by pattern do not
341 -- appear in the result FreeVars
342 rnPat ctxt pat thing_inside
343 = rnPats ctxt [pat] (\pats' -> let [pat'] = pats' in thing_inside pat')
344
345 applyNameMaker :: NameMaker -> Located RdrName -> RnM (Located Name)
346 applyNameMaker mk rdr = do { (n, _fvs) <- runCps (newPatLName mk rdr)
347 ; return n }
348
349 -- ----------- Entry point 2: rnBindPat -------------------
350 -- Binds local names; in a recursive scope that involves other bound vars
351 -- e.g let { (x, Just y) = e1; ... } in ...
352 -- * does NOT allows type sig to bind type vars
353 -- * local namemaker
354 -- * no unused and duplicate checking
355 -- * fixities might be coming in
356 rnBindPat :: NameMaker
357 -> LPat GhcPs
358 -> RnM (LPat GhcRn, FreeVars)
359 -- Returned FreeVars are the free variables of the pattern,
360 -- of course excluding variables bound by this pattern
361
362 rnBindPat name_maker pat = runCps (rnLPatAndThen name_maker pat)
363
364 {-
365 *********************************************************
366 * *
367 The main event
368 * *
369 *********************************************************
370 -}
371
372 -- ----------- Entry point 3: rnLPatAndThen -------------------
373 -- General version: parametrized by how you make new names
374
375 rnLPatsAndThen :: NameMaker -> [LPat GhcPs] -> CpsRn [LPat GhcRn]
376 rnLPatsAndThen mk = mapM (rnLPatAndThen mk)
377 -- Despite the map, the monad ensures that each pattern binds
378 -- variables that may be mentioned in subsequent patterns in the list
379
380 --------------------
381 -- The workhorse
382 rnLPatAndThen :: NameMaker -> LPat GhcPs -> CpsRn (LPat GhcRn)
383 rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat
384
385 rnPatAndThen :: NameMaker -> Pat GhcPs -> CpsRn (Pat GhcRn)
386 rnPatAndThen _ (WildPat _) = return (WildPat placeHolderType)
387 rnPatAndThen mk (ParPat pat) = do { pat' <- rnLPatAndThen mk pat; return (ParPat pat') }
388 rnPatAndThen mk (LazyPat pat) = do { pat' <- rnLPatAndThen mk pat; return (LazyPat pat') }
389 rnPatAndThen mk (BangPat pat) = do { pat' <- rnLPatAndThen mk pat; return (BangPat pat') }
390 rnPatAndThen mk (VarPat (L l rdr)) = do { loc <- liftCps getSrcSpanM
391 ; name <- newPatName mk (L loc rdr)
392 ; return (VarPat (L l name)) }
393 -- we need to bind pattern variables for view pattern expressions
394 -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
395
396 rnPatAndThen mk (SigPatIn pat sig)
397 -- When renaming a pattern type signature (e.g. f (a :: T) = ...), it is
398 -- important to rename its type signature _before_ renaming the rest of the
399 -- pattern, so that type variables are first bound by the _outermost_ pattern
400 -- type signature they occur in. This keeps the type checker happy when
401 -- pattern type signatures happen to be nested (#7827)
402 --
403 -- f ((Just (x :: a) :: Maybe a)
404 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~^ `a' is first bound here
405 -- ~~~~~~~~~~~~~~~^ the same `a' then used here
406 = do { sig' <- rnHsSigCps sig
407 ; pat' <- rnLPatAndThen mk pat
408 ; return (SigPatIn pat' sig') }
409
410 rnPatAndThen mk (LitPat lit)
411 | HsString src s <- lit
412 = do { ovlStr <- liftCps (xoptM LangExt.OverloadedStrings)
413 ; if ovlStr
414 then rnPatAndThen mk
415 (mkNPat (noLoc (mkHsIsString src s placeHolderType))
416 Nothing)
417 else normal_lit }
418 | otherwise = normal_lit
419 where
420 normal_lit = do { liftCps (rnLit lit); return (LitPat (convertLit lit)) }
421
422 rnPatAndThen _ (NPat (L l lit) mb_neg _eq _)
423 = do { (lit', mb_neg') <- liftCpsFV $ rnOverLit lit
424 ; mb_neg' -- See Note [Negative zero]
425 <- let negative = do { (neg, fvs) <- lookupSyntaxName negateName
426 ; return (Just neg, fvs) }
427 positive = return (Nothing, emptyFVs)
428 in liftCpsFV $ case (mb_neg , mb_neg') of
429 (Nothing, Just _ ) -> negative
430 (Just _ , Nothing) -> negative
431 (Nothing, Nothing) -> positive
432 (Just _ , Just _ ) -> positive
433 ; eq' <- liftCpsFV $ lookupSyntaxName eqName
434 ; return (NPat (L l lit') mb_neg' eq' placeHolderType) }
435
436 rnPatAndThen mk (NPlusKPat rdr (L l lit) _ _ _ _)
437 = do { new_name <- newPatName mk rdr
438 ; (lit', _) <- liftCpsFV $ rnOverLit lit -- See Note [Negative zero]
439 -- We skip negateName as
440 -- negative zero doesn't make
441 -- sense in n + k patterns
442 ; minus <- liftCpsFV $ lookupSyntaxName minusName
443 ; ge <- liftCpsFV $ lookupSyntaxName geName
444 ; return (NPlusKPat (L (nameSrcSpan new_name) new_name)
445 (L l lit') lit' ge minus placeHolderType) }
446 -- The Report says that n+k patterns must be in Integral
447
448 rnPatAndThen mk (AsPat rdr pat)
449 = do { new_name <- newPatLName mk rdr
450 ; pat' <- rnLPatAndThen mk pat
451 ; return (AsPat new_name pat') }
452
453 rnPatAndThen mk p@(ViewPat expr pat _ty)
454 = do { liftCps $ do { vp_flag <- xoptM LangExt.ViewPatterns
455 ; checkErr vp_flag (badViewPat p) }
456 -- Because of the way we're arranging the recursive calls,
457 -- this will be in the right context
458 ; expr' <- liftCpsFV $ rnLExpr expr
459 ; pat' <- rnLPatAndThen mk pat
460 -- Note: at this point the PreTcType in ty can only be a placeHolder
461 -- ; return (ViewPat expr' pat' ty) }
462 ; return (ViewPat expr' pat' placeHolderType) }
463
464 rnPatAndThen mk (ConPatIn con stuff)
465 -- rnConPatAndThen takes care of reconstructing the pattern
466 -- The pattern for the empty list needs to be replaced by an empty explicit list pattern when overloaded lists is turned on.
467 = case unLoc con == nameRdrName (dataConName nilDataCon) of
468 True -> do { ol_flag <- liftCps $ xoptM LangExt.OverloadedLists
469 ; if ol_flag then rnPatAndThen mk (ListPat [] placeHolderType Nothing)
470 else rnConPatAndThen mk con stuff}
471 False -> rnConPatAndThen mk con stuff
472
473 rnPatAndThen mk (ListPat pats _ _)
474 = do { opt_OverloadedLists <- liftCps $ xoptM LangExt.OverloadedLists
475 ; pats' <- rnLPatsAndThen mk pats
476 ; case opt_OverloadedLists of
477 True -> do { (to_list_name,_) <- liftCps $ lookupSyntaxName toListName
478 ; return (ListPat pats' placeHolderType
479 (Just (placeHolderType, to_list_name)))}
480 False -> return (ListPat pats' placeHolderType Nothing) }
481
482 rnPatAndThen mk (PArrPat pats _)
483 = do { pats' <- rnLPatsAndThen mk pats
484 ; return (PArrPat pats' placeHolderType) }
485
486 rnPatAndThen mk (TuplePat pats boxed _)
487 = do { liftCps $ checkTupSize (length pats)
488 ; pats' <- rnLPatsAndThen mk pats
489 ; return (TuplePat pats' boxed []) }
490
491 rnPatAndThen mk (SumPat pat alt arity _)
492 = do { pat <- rnLPatAndThen mk pat
493 ; return (SumPat pat alt arity PlaceHolder)
494 }
495
496 -- If a splice has been run already, just rename the result.
497 rnPatAndThen mk (SplicePat (HsSpliced mfs (HsSplicedPat pat)))
498 = SplicePat . HsSpliced mfs . HsSplicedPat <$> rnPatAndThen mk pat
499
500 rnPatAndThen mk (SplicePat splice)
501 = do { eith <- liftCpsFV $ rnSplicePat splice
502 ; case eith of -- See Note [rnSplicePat] in RnSplice
503 Left not_yet_renamed -> rnPatAndThen mk not_yet_renamed
504 Right already_renamed -> return already_renamed }
505
506 rnPatAndThen _ pat = pprPanic "rnLPatAndThen" (ppr pat)
507
508
509 --------------------
510 rnConPatAndThen :: NameMaker
511 -> Located RdrName -- the constructor
512 -> HsConPatDetails GhcPs
513 -> CpsRn (Pat GhcRn)
514
515 rnConPatAndThen mk con (PrefixCon pats)
516 = do { con' <- lookupConCps con
517 ; pats' <- rnLPatsAndThen mk pats
518 ; return (ConPatIn con' (PrefixCon pats')) }
519
520 rnConPatAndThen mk con (InfixCon pat1 pat2)
521 = do { con' <- lookupConCps con
522 ; pat1' <- rnLPatAndThen mk pat1
523 ; pat2' <- rnLPatAndThen mk pat2
524 ; fixity <- liftCps $ lookupFixityRn (unLoc con')
525 ; liftCps $ mkConOpPatRn con' fixity pat1' pat2' }
526
527 rnConPatAndThen mk con (RecCon rpats)
528 = do { con' <- lookupConCps con
529 ; rpats' <- rnHsRecPatsAndThen mk con' rpats
530 ; return (ConPatIn con' (RecCon rpats')) }
531
532 --------------------
533 rnHsRecPatsAndThen :: NameMaker
534 -> Located Name -- Constructor
535 -> HsRecFields GhcPs (LPat GhcPs)
536 -> CpsRn (HsRecFields GhcRn (LPat GhcRn))
537 rnHsRecPatsAndThen mk (L _ con) hs_rec_fields@(HsRecFields { rec_dotdot = dd })
538 = do { flds <- liftCpsFV $ rnHsRecFields (HsRecFieldPat con) mkVarPat
539 hs_rec_fields
540 ; flds' <- mapM rn_field (flds `zip` [1..])
541 ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }
542 where
543 mkVarPat l n = VarPat (L l n)
544 rn_field (L l fld, n') = do { arg' <- rnLPatAndThen (nested_mk dd mk n')
545 (hsRecFieldArg fld)
546 ; return (L l (fld { hsRecFieldArg = arg' })) }
547
548 -- Suppress unused-match reporting for fields introduced by ".."
549 nested_mk Nothing mk _ = mk
550 nested_mk (Just _) mk@(LetMk {}) _ = mk
551 nested_mk (Just n) (LamMk report_unused) n' = LamMk (report_unused && (n' <= n))
552
553 {-
554 ************************************************************************
555 * *
556 Record fields
557 * *
558 ************************************************************************
559 -}
560
561 data HsRecFieldContext
562 = HsRecFieldCon Name
563 | HsRecFieldPat Name
564 | HsRecFieldUpd
565
566 rnHsRecFields
567 :: forall arg.
568 HsRecFieldContext
569 -> (SrcSpan -> RdrName -> arg)
570 -- When punning, use this to build a new field
571 -> HsRecFields GhcPs (Located arg)
572 -> RnM ([LHsRecField GhcRn (Located arg)], FreeVars)
573
574 -- This surprisingly complicated pass
575 -- a) looks up the field name (possibly using disambiguation)
576 -- b) fills in puns and dot-dot stuff
577 -- When we've finished, we've renamed the LHS, but not the RHS,
578 -- of each x=e binding
579 --
580 -- This is used for record construction and pattern-matching, but not updates.
581
582 rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
583 = do { pun_ok <- xoptM LangExt.RecordPuns
584 ; disambig_ok <- xoptM LangExt.DisambiguateRecordFields
585 ; parent <- check_disambiguation disambig_ok mb_con
586 ; flds1 <- mapM (rn_fld pun_ok parent) flds
587 ; mapM_ (addErr . dupFieldErr ctxt) dup_flds
588 ; dotdot_flds <- rn_dotdot dotdot mb_con flds1
589 ; let all_flds | null dotdot_flds = flds1
590 | otherwise = flds1 ++ dotdot_flds
591 ; return (all_flds, mkFVs (getFieldIds all_flds)) }
592 where
593 mb_con = case ctxt of
594 HsRecFieldCon con -> Just con
595 HsRecFieldPat con -> Just con
596 _ {- update -} -> Nothing
597
598 doc = case mb_con of
599 Nothing -> text "constructor field name"
600 Just con -> text "field of constructor" <+> quotes (ppr con)
601
602 rn_fld :: Bool -> Maybe Name -> LHsRecField GhcPs (Located arg)
603 -> RnM (LHsRecField GhcRn (Located arg))
604 rn_fld pun_ok parent (L l (HsRecField { hsRecFieldLbl
605 = L loc (FieldOcc (L ll lbl) _)
606 , hsRecFieldArg = arg
607 , hsRecPun = pun }))
608 = do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent doc lbl
609 ; arg' <- if pun
610 then do { checkErr pun_ok (badPun (L loc lbl))
611 -- Discard any module qualifier (#11662)
612 ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
613 ; return (L loc (mk_arg loc arg_rdr)) }
614 else return arg
615 ; return (L l (HsRecField { hsRecFieldLbl
616 = L loc (FieldOcc (L ll lbl) sel)
617 , hsRecFieldArg = arg'
618 , hsRecPun = pun })) }
619
620 rn_dotdot :: Maybe Int -- See Note [DotDot fields] in HsPat
621 -> Maybe Name -- The constructor (Nothing for an
622 -- out of scope constructor)
623 -> [LHsRecField GhcRn (Located arg)] -- Explicit fields
624 -> RnM [LHsRecField GhcRn (Located arg)] -- Filled in .. fields
625 rn_dotdot (Just n) (Just con) flds -- ".." on record construction / pat match
626 | not (isUnboundName con) -- This test is because if the constructor
627 -- isn't in scope the constructor lookup will add
628 -- an error but still return an unbound name. We
629 -- don't want that to screw up the dot-dot fill-in stuff.
630 = ASSERT( flds `lengthIs` n )
631 do { loc <- getSrcSpanM -- Rather approximate
632 ; dd_flag <- xoptM LangExt.RecordWildCards
633 ; checkErr dd_flag (needFlagDotDot ctxt)
634 ; (rdr_env, lcl_env) <- getRdrEnvs
635 ; con_fields <- lookupConstructorFields con
636 ; when (null con_fields) (addErr (badDotDotCon con))
637 ; let present_flds = mkOccSet $ map rdrNameOcc (getFieldLbls flds)
638
639 -- For constructor uses (but not patterns)
640 -- the arg should be in scope locally;
641 -- i.e. not top level or imported
642 -- Eg. data R = R { x,y :: Int }
643 -- f x = R { .. } -- Should expand to R {x=x}, not R{x=x,y=y}
644 arg_in_scope lbl = mkRdrUnqual lbl `elemLocalRdrEnv` lcl_env
645
646 (dot_dot_fields, dot_dot_gres)
647 = unzip [ (fl, gre)
648 | fl <- con_fields
649 , let lbl = mkVarOccFS (flLabel fl)
650 , not (lbl `elemOccSet` present_flds)
651 , Just gre <- [lookupGRE_FieldLabel rdr_env fl]
652 -- Check selector is in scope
653 , case ctxt of
654 HsRecFieldCon {} -> arg_in_scope lbl
655 _other -> True ]
656
657 ; addUsedGREs dot_dot_gres
658 ; return [ L loc (HsRecField
659 { hsRecFieldLbl = L loc (FieldOcc (L loc arg_rdr) sel)
660 , hsRecFieldArg = L loc (mk_arg loc arg_rdr)
661 , hsRecPun = False })
662 | fl <- dot_dot_fields
663 , let sel = flSelector fl
664 , let arg_rdr = mkVarUnqual (flLabel fl) ] }
665
666 rn_dotdot _dotdot _mb_con _flds
667 = return []
668 -- _dotdot = Nothing => No ".." at all
669 -- _mb_con = Nothing => Record update
670 -- _mb_con = Just unbound => Out of scope data constructor
671
672 check_disambiguation :: Bool -> Maybe Name -> RnM (Maybe Name)
673 -- When disambiguation is on, return name of parent tycon.
674 check_disambiguation disambig_ok mb_con
675 | disambig_ok, Just con <- mb_con
676 = do { env <- getGlobalRdrEnv; return (find_tycon env con) }
677 | otherwise = return Nothing
678
679 find_tycon :: GlobalRdrEnv -> Name {- DataCon -}
680 -> Maybe Name {- TyCon -}
681 -- Return the parent *type constructor* of the data constructor
682 -- (that is, the parent of the data constructor),
683 -- or 'Nothing' if it is a pattern synonym or not in scope.
684 -- That's the parent to use for looking up record fields.
685 find_tycon env con_name
686 | isUnboundName con_name
687 = Just (mkUnboundName (setOccNameSpace tcName (getOccName con_name)))
688 -- If the data con is not in scope, return an unboundName tycon
689 -- That way the calls to lookupRecFieldOcc in rn_fld won't generate
690 -- an error cascade; see Trac #14307
691
692 | Just (AConLike (RealDataCon dc)) <- wiredInNameTyThing_maybe con_name
693 = Just (tyConName (dataConTyCon dc))
694 -- Special case for [], which is built-in syntax
695 -- and not in the GlobalRdrEnv (Trac #8448)
696
697 | Just gre <- lookupGRE_Name env con_name
698 = case gre_par gre of
699 ParentIs p -> Just p
700 _ -> Nothing -- Can happen if the con_name
701 -- is for a pattern synonym
702
703 | otherwise = Nothing
704 -- Data constructor not lexically in scope at all
705 -- See Note [Disambiguation and Template Haskell]
706
707 dup_flds :: [NE.NonEmpty RdrName]
708 -- Each list represents a RdrName that occurred more than once
709 -- (the list contains all occurrences)
710 -- Each list in dup_fields is non-empty
711 (_, dup_flds) = removeDups compare (getFieldLbls flds)
712
713
714 {- Note [Disambiguation and Template Haskell]
715 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
716 Consider (Trac #12130)
717 module Foo where
718 import M
719 b = $(funny)
720
721 module M(funny) where
722 data T = MkT { x :: Int }
723 funny :: Q Exp
724 funny = [| MkT { x = 3 } |]
725
726 When we splice, neither T nor MkT are lexically in scope, so find_tycon will
727 fail. But there is no need for disambiguation anyway, so we just return Nothing
728 -}
729
730 rnHsRecUpdFields
731 :: [LHsRecUpdField GhcPs]
732 -> RnM ([LHsRecUpdField GhcRn], FreeVars)
733 rnHsRecUpdFields flds
734 = do { pun_ok <- xoptM LangExt.RecordPuns
735 ; overload_ok <- xoptM LangExt.DuplicateRecordFields
736 ; (flds1, fvss) <- mapAndUnzipM (rn_fld pun_ok overload_ok) flds
737 ; mapM_ (addErr . dupFieldErr HsRecFieldUpd) dup_flds
738
739 -- Check for an empty record update e {}
740 -- NB: don't complain about e { .. }, because rn_dotdot has done that already
741 ; when (null flds) $ addErr emptyUpdateErr
742
743 ; return (flds1, plusFVs fvss) }
744 where
745 doc = text "constructor field name"
746
747 rn_fld :: Bool -> Bool -> LHsRecUpdField GhcPs
748 -> RnM (LHsRecUpdField GhcRn, FreeVars)
749 rn_fld pun_ok overload_ok (L l (HsRecField { hsRecFieldLbl = L loc f
750 , hsRecFieldArg = arg
751 , hsRecPun = pun }))
752 = do { let lbl = rdrNameAmbiguousFieldOcc f
753 ; sel <- setSrcSpan loc $
754 -- Defer renaming of overloaded fields to the typechecker
755 -- See Note [Disambiguating record fields] in TcExpr
756 if overload_ok
757 then do { mb <- lookupGlobalOccRn_overloaded overload_ok lbl
758 ; case mb of
759 Nothing -> do { addErr (unknownSubordinateErr doc lbl)
760 ; return (Right []) }
761 Just r -> return r }
762 else fmap Left $ lookupGlobalOccRn lbl
763 ; arg' <- if pun
764 then do { checkErr pun_ok (badPun (L loc lbl))
765 -- Discard any module qualifier (#11662)
766 ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
767 ; return (L loc (HsVar (L loc arg_rdr))) }
768 else return arg
769 ; (arg'', fvs) <- rnLExpr arg'
770
771 ; let fvs' = case sel of
772 Left sel_name -> fvs `addOneFV` sel_name
773 Right [sel_name] -> fvs `addOneFV` sel_name
774 Right _ -> fvs
775 lbl' = case sel of
776 Left sel_name ->
777 L loc (Unambiguous (L loc lbl) sel_name)
778 Right [sel_name] ->
779 L loc (Unambiguous (L loc lbl) sel_name)
780 Right _ -> L loc (Ambiguous (L loc lbl) PlaceHolder)
781
782 ; return (L l (HsRecField { hsRecFieldLbl = lbl'
783 , hsRecFieldArg = arg''
784 , hsRecPun = pun }), fvs') }
785
786 dup_flds :: [NE.NonEmpty RdrName]
787 -- Each list represents a RdrName that occurred more than once
788 -- (the list contains all occurrences)
789 -- Each list in dup_fields is non-empty
790 (_, dup_flds) = removeDups compare (getFieldUpdLbls flds)
791
792
793
794 getFieldIds :: [LHsRecField GhcRn arg] -> [Name]
795 getFieldIds flds = map (unLoc . hsRecFieldSel . unLoc) flds
796
797 getFieldLbls :: [LHsRecField id arg] -> [RdrName]
798 getFieldLbls flds
799 = map (unLoc . rdrNameFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
800
801 getFieldUpdLbls :: [LHsRecUpdField id] -> [RdrName]
802 getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
803
804 needFlagDotDot :: HsRecFieldContext -> SDoc
805 needFlagDotDot ctxt = vcat [text "Illegal `..' in record" <+> pprRFC ctxt,
806 text "Use RecordWildCards to permit this"]
807
808 badDotDotCon :: Name -> SDoc
809 badDotDotCon con
810 = vcat [ text "Illegal `..' notation for constructor" <+> quotes (ppr con)
811 , nest 2 (text "The constructor has no labelled fields") ]
812
813 emptyUpdateErr :: SDoc
814 emptyUpdateErr = text "Empty record update"
815
816 badPun :: Located RdrName -> SDoc
817 badPun fld = vcat [text "Illegal use of punning for field" <+> quotes (ppr fld),
818 text "Use NamedFieldPuns to permit this"]
819
820 dupFieldErr :: HsRecFieldContext -> NE.NonEmpty RdrName -> SDoc
821 dupFieldErr ctxt dups
822 = hsep [text "duplicate field name",
823 quotes (ppr (NE.head dups)),
824 text "in record", pprRFC ctxt]
825
826 pprRFC :: HsRecFieldContext -> SDoc
827 pprRFC (HsRecFieldCon {}) = text "construction"
828 pprRFC (HsRecFieldPat {}) = text "pattern"
829 pprRFC (HsRecFieldUpd {}) = text "update"
830
831 {-
832 ************************************************************************
833 * *
834 \subsubsection{Literals}
835 * *
836 ************************************************************************
837
838 When literals occur we have to make sure
839 that the types and classes they involve
840 are made available.
841 -}
842
843 rnLit :: HsLit p -> RnM ()
844 rnLit (HsChar _ c) = checkErr (inCharRange c) (bogusCharError c)
845 rnLit _ = return ()
846
847 -- Turn a Fractional-looking literal which happens to be an integer into an
848 -- Integer-looking literal.
849 generalizeOverLitVal :: OverLitVal -> OverLitVal
850 generalizeOverLitVal (HsFractional (FL {fl_text=src,fl_neg=neg,fl_value=val}))
851 | denominator val == 1 = HsIntegral (IL {il_text=src,il_neg=neg,il_value=numerator val})
852 generalizeOverLitVal lit = lit
853
854 isNegativeZeroOverLit :: HsOverLit t -> Bool
855 isNegativeZeroOverLit lit
856 = case ol_val lit of
857 HsIntegral i -> 0 == il_value i && il_neg i
858 HsFractional f -> 0 == fl_value f && fl_neg f
859 _ -> False
860
861 {-
862 Note [Negative zero]
863 ~~~~~~~~~~~~~~~~~~~~~~~~~
864 There were problems with negative zero in conjunction with Negative Literals
865 extension. Numeric literal value is contained in Integer and Rational types
866 inside IntegralLit and FractionalLit. These types cannot represent negative
867 zero value. So we had to add explicit field 'neg' which would hold information
868 about literal sign. Here in rnOverLit we use it to detect negative zeroes and
869 in this case return not only literal itself but also negateName so that users
870 can apply it explicitly. In this case it stays negative zero. Trac #13211
871 -}
872
873 rnOverLit :: HsOverLit t ->
874 RnM ((HsOverLit GhcRn, Maybe (HsExpr GhcRn)), FreeVars)
875 rnOverLit origLit
876 = do { opt_NumDecimals <- xoptM LangExt.NumDecimals
877 ; let { lit@(OverLit {ol_val=val})
878 | opt_NumDecimals = origLit {ol_val = generalizeOverLitVal (ol_val origLit)}
879 | otherwise = origLit
880 }
881 ; let std_name = hsOverLitName val
882 ; (SyntaxExpr { syn_expr = from_thing_name }, fvs1)
883 <- lookupSyntaxName std_name
884 ; let rebindable = case from_thing_name of
885 HsVar (L _ v) -> v /= std_name
886 _ -> panic "rnOverLit"
887 ; let lit' = lit { ol_witness = from_thing_name
888 , ol_rebindable = rebindable
889 , ol_type = placeHolderType }
890 ; if isNegativeZeroOverLit lit'
891 then do { (SyntaxExpr { syn_expr = negate_name }, fvs2)
892 <- lookupSyntaxName negateName
893 ; return ((lit' { ol_val = negateOverLitVal val }, Just negate_name)
894 , fvs1 `plusFV` fvs2) }
895 else return ((lit', Nothing), fvs1) }
896
897 {-
898 ************************************************************************
899 * *
900 \subsubsection{Errors}
901 * *
902 ************************************************************************
903 -}
904
905 patSigErr :: Outputable a => a -> SDoc
906 patSigErr ty
907 = (text "Illegal signature in pattern:" <+> ppr ty)
908 $$ nest 4 (text "Use ScopedTypeVariables to permit it")
909
910 bogusCharError :: Char -> SDoc
911 bogusCharError c
912 = text "character literal out of range: '\\" <> char c <> char '\''
913
914 badViewPat :: Pat GhcPs -> SDoc
915 badViewPat pat = vcat [text "Illegal view pattern: " <+> ppr pat,
916 text "Use ViewPatterns to enable view patterns"]