Fix #1476 by making splice patterns work.
[ghc.git] / compiler / rename / RnPat.lhs
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 \begin{code}
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
25               -- CpsRn monad
26               CpsRn, liftCps,
27
28               -- Literals
29               rnLit, rnOverLit,
30
31              -- Pattern Error messages that are also used elsewhere
32              checkTupSize, patSigErr
33              ) where
34
35 -- ENH: thin imports to only what is necessary for patterns
36
37 import {-# SOURCE #-} RnExpr ( rnLExpr )
38 import {-# SOURCE #-} RnSplice ( rnSplicePat )
39 import {-# SOURCE #-} TcSplice ( runQuasiQuotePat )
40
41 #include "HsVersions.h"
42
43 import HsSyn            
44 import TcRnMonad
45 import TcHsSyn             ( hsOverLitName )
46 import RnEnv
47 import RnTypes
48 import DynFlags
49 import PrelNames
50 import TyCon               ( tyConName )
51 import ConLike
52 import DataCon             ( dataConTyCon )
53 import TypeRep             ( TyThing(..) )
54 import Name
55 import NameSet
56 import RdrName
57 import BasicTypes
58 import Util
59 import ListSetOps          ( removeDups )
60 import Outputable
61 import SrcLoc
62 import FastString
63 import Literal             ( inCharRange )
64 import TysWiredIn          ( nilDataCon )
65 import DataCon             ( dataConName )
66 import Control.Monad       ( when, liftM, ap )
67 import Data.Ratio
68 \end{code}
69
70
71 %*********************************************************
72 %*                                                      *
73         The CpsRn Monad
74 %*                                                      *
75 %*********************************************************
76
77 Note [CpsRn monad]
78 ~~~~~~~~~~~~~~~~~~
79 The CpsRn monad uses continuation-passing style to support this
80 style of programming:
81
82         do { ...
83            ; ns <- bindNames rs
84            ; ...blah... }
85
86    where rs::[RdrName], ns::[Name]
87
88 The idea is that '...blah...' 
89   a) sees the bindings of ns
90   b) returns the free variables it mentions
91      so that bindNames can report unused ones
92
93 In particular, 
94     mapM rnPatAndThen [p1, p2, p3]
95 has a *left-to-right* scoping: it makes the binders in 
96 p1 scope over p2,p3.
97
98 \begin{code}
99 newtype CpsRn b = CpsRn { unCpsRn :: forall r. (b -> RnM (r, FreeVars))
100                                             -> RnM (r, FreeVars) }
101         -- See Note [CpsRn monad]
102
103 instance Functor CpsRn where
104     fmap = liftM
105
106 instance Applicative CpsRn where
107     pure = return
108     (<*>) = ap
109
110 instance Monad CpsRn where
111   return x = CpsRn (\k -> k x)
112   (CpsRn m) >>= mk = CpsRn (\k -> m (\v -> unCpsRn (mk v) k))
113
114 runCps :: CpsRn a -> RnM (a, FreeVars)
115 runCps (CpsRn m) = m (\r -> return (r, emptyFVs))
116
117 liftCps :: RnM a -> CpsRn a
118 liftCps rn_thing = CpsRn (\k -> rn_thing >>= k)
119
120 liftCpsFV :: RnM (a, FreeVars) -> CpsRn a
121 liftCpsFV rn_thing = CpsRn (\k -> do { (v,fvs1) <- rn_thing
122                                      ; (r,fvs2) <- k v
123                                      ; return (r, fvs1 `plusFV` fvs2) })
124
125 wrapSrcSpanCps :: (a -> CpsRn b) -> Located a -> CpsRn (Located b)
126 -- Set the location, and also wrap it around the value returned
127 wrapSrcSpanCps fn (L loc a)
128   = CpsRn (\k -> setSrcSpan loc $ 
129                  unCpsRn (fn a) $ \v -> 
130                  k (L loc v))
131
132 lookupConCps :: Located RdrName -> CpsRn (Located Name)
133 lookupConCps con_rdr 
134   = CpsRn (\k -> do { con_name <- lookupLocatedOccRn con_rdr
135                     ; (r, fvs) <- k con_name
136                     ; return (r, addOneFV fvs (unLoc con_name)) })
137     -- We add the constructor name to the free vars
138     -- See Note [Patterns are uses]
139 \end{code}
140
141 Note [Patterns are uses]
142 ~~~~~~~~~~~~~~~~~~~~~~~~
143 Consider
144   module Foo( f, g ) where
145   data T = T1 | T2
146
147   f T1 = True
148   f T2 = False
149
150   g _ = T1
151
152 Arguably we should report T2 as unused, even though it appears in a
153 pattern, because it never occurs in a constructed position.  See
154 Trac #7336.
155 However, implementing this in the face of pattern synonyms would be
156 less straightforward, since given two pattern synonyms
157
158   pattern P1 <- P2
159   pattern P2 <- ()
160
161 we need to observe the dependency between P1 and P2 so that type
162 checking can be done in the correct order (just like for value
163 bindings). Dependencies between bindings is analyzed in the renamer,
164 where we don't know yet whether P2 is a constructor or a pattern
165 synonym. So for now, we do report conid occurrences in patterns as
166 uses.
167
168 %*********************************************************
169 %*                                                      *
170         Name makers
171 %*                                                      *
172 %*********************************************************
173
174 Externally abstract type of name makers,
175 which is how you go from a RdrName to a Name
176
177 \begin{code}
178 data NameMaker 
179   = LamMk       -- Lambdas 
180       Bool      -- True <=> report unused bindings
181                 --   (even if True, the warning only comes out 
182                 --    if -fwarn-unused-matches is on)
183
184   | LetMk       -- Let bindings, incl top level
185                 -- Do *not* check for unused bindings
186       TopLevelFlag
187       MiniFixityEnv
188
189 topRecNameMaker :: MiniFixityEnv -> NameMaker
190 topRecNameMaker fix_env = LetMk TopLevel fix_env
191
192 isTopRecNameMaker :: NameMaker -> Bool
193 isTopRecNameMaker (LetMk TopLevel _) = True
194 isTopRecNameMaker _ = False
195
196 localRecNameMaker :: MiniFixityEnv -> NameMaker
197 localRecNameMaker fix_env = LetMk NotTopLevel fix_env 
198
199 matchNameMaker :: HsMatchContext a -> NameMaker
200 matchNameMaker ctxt = LamMk report_unused
201   where
202     -- Do not report unused names in interactive contexts
203     -- i.e. when you type 'x <- e' at the GHCi prompt
204     report_unused = case ctxt of
205                       StmtCtxt GhciStmtCtxt -> False
206                       _                     -> True
207
208 rnHsSigCps :: HsWithBndrs RdrName (LHsType RdrName)
209            -> CpsRn (HsWithBndrs Name (LHsType Name))
210 rnHsSigCps sig 
211   = CpsRn (rnHsBndrSig PatCtx sig)
212
213 newPatName :: NameMaker -> Located RdrName -> CpsRn Name
214 newPatName (LamMk report_unused) rdr_name
215   = CpsRn (\ thing_inside -> 
216         do { name <- newLocalBndrRn rdr_name
217            ; (res, fvs) <- bindLocalNames [name] (thing_inside name)
218            ; when report_unused $ warnUnusedMatches [name] fvs
219            ; return (res, name `delFV` fvs) })
220
221 newPatName (LetMk is_top fix_env) rdr_name
222   = CpsRn (\ thing_inside -> 
223         do { name <- case is_top of
224                        NotTopLevel -> newLocalBndrRn rdr_name
225                        TopLevel    -> newTopSrcBinder rdr_name
226            ; bindLocalNames [name] $       -- Do *not* use bindLocalNameFV here
227                                         -- See Note [View pattern usage]
228              addLocalFixities fix_env [name] $
229              thing_inside name })
230                           
231     -- Note: the bindLocalNames is somewhat suspicious
232     --       because it binds a top-level name as a local name.
233     --       however, this binding seems to work, and it only exists for
234     --       the duration of the patterns and the continuation;
235     --       then the top-level name is added to the global env
236     --       before going on to the RHSes (see RnSource.lhs).
237 \end{code}
238
239 Note [View pattern usage]
240 ~~~~~~~~~~~~~~~~~~~~~~~~~
241 Consider
242   let (r, (r -> x)) = x in ...
243 Here the pattern binds 'r', and then uses it *only* in the view pattern.
244 We want to "see" this use, and in let-bindings we collect all uses and
245 report unused variables at the binding level. So we must use bindLocalNames
246 here, *not* bindLocalNameFV.  Trac #3943.
247
248 %*********************************************************
249 %*                                                      *
250         External entry points
251 %*                                                      *
252 %*********************************************************
253
254 There are various entry points to renaming patterns, depending on
255  (1) whether the names created should be top-level names or local names
256  (2) whether the scope of the names is entirely given in a continuation
257      (e.g., in a case or lambda, but not in a let or at the top-level,
258       because of the way mutually recursive bindings are handled)
259  (3) whether the a type signature in the pattern can bind 
260         lexically-scoped type variables (for unpacking existential 
261         type vars in data constructors)
262  (4) whether we do duplicate and unused variable checking
263  (5) whether there are fixity declarations associated with the names
264      bound by the patterns that need to be brought into scope with them.
265      
266  Rather than burdening the clients of this module with all of these choices,
267  we export the three points in this design space that we actually need:
268
269 \begin{code}
270 -- ----------- Entry point 1: rnPats -------------------
271 -- Binds local names; the scope of the bindings is entirely in the thing_inside
272 --   * allows type sigs to bind type vars
273 --   * local namemaker
274 --   * unused and duplicate checking
275 --   * no fixities
276 rnPats :: HsMatchContext Name -- for error messages
277        -> [LPat RdrName] 
278        -> ([LPat Name] -> RnM (a, FreeVars))
279        -> RnM (a, FreeVars)
280 rnPats ctxt pats thing_inside
281   = do  { envs_before <- getRdrEnvs
282
283           -- (1) rename the patterns, bringing into scope all of the term variables
284           -- (2) then do the thing inside.
285         ; unCpsRn (rnLPatsAndThen (matchNameMaker ctxt) pats) $ \ pats' -> do
286         { -- Check for duplicated and shadowed names 
287           -- Must do this *after* renaming the patterns
288           -- See Note [Collect binders only after renaming] in HsUtils
289           -- Because we don't bind the vars all at once, we can't
290           --    check incrementally for duplicates; 
291           -- Nor can we check incrementally for shadowing, else we'll
292           --    complain *twice* about duplicates e.g. f (x,x) = ...
293         ; addErrCtxt doc_pat $ 
294           checkDupAndShadowedNames envs_before $
295           collectPatsBinders pats'
296         ; thing_inside pats' } }
297   where
298     doc_pat = ptext (sLit "In") <+> pprMatchContext ctxt
299
300 rnPat :: HsMatchContext Name -- for error messages
301       -> LPat RdrName 
302       -> (LPat Name -> RnM (a, FreeVars))
303       -> RnM (a, FreeVars)     -- Variables bound by pattern do not 
304                                -- appear in the result FreeVars 
305 rnPat ctxt pat thing_inside 
306   = rnPats ctxt [pat] (\pats' -> let [pat'] = pats' in thing_inside pat')
307
308 applyNameMaker :: NameMaker -> Located RdrName -> RnM Name
309 applyNameMaker mk rdr = do { (n, _fvs) <- runCps (newPatName mk rdr); return n }
310
311 -- ----------- Entry point 2: rnBindPat -------------------
312 -- Binds local names; in a recursive scope that involves other bound vars
313 --      e.g let { (x, Just y) = e1; ... } in ...
314 --   * does NOT allows type sig to bind type vars
315 --   * local namemaker
316 --   * no unused and duplicate checking
317 --   * fixities might be coming in
318 rnBindPat :: NameMaker
319           -> LPat RdrName
320           -> RnM (LPat Name, FreeVars)
321    -- Returned FreeVars are the free variables of the pattern,
322    -- of course excluding variables bound by this pattern 
323
324 rnBindPat name_maker pat = runCps (rnLPatAndThen name_maker pat)
325 \end{code}
326
327
328 %*********************************************************
329 %*                                                      *
330         The main event
331 %*                                                      *
332 %*********************************************************
333
334 \begin{code}
335 -- ----------- Entry point 3: rnLPatAndThen -------------------
336 -- General version: parametrized by how you make new names
337
338 rnLPatsAndThen :: NameMaker -> [LPat RdrName] -> CpsRn [LPat Name]
339 rnLPatsAndThen mk = mapM (rnLPatAndThen mk)
340   -- Despite the map, the monad ensures that each pattern binds
341   -- variables that may be mentioned in subsequent patterns in the list
342
343 --------------------
344 -- The workhorse
345 rnLPatAndThen :: NameMaker -> LPat RdrName -> CpsRn (LPat Name)
346 rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat
347
348 rnPatAndThen :: NameMaker -> Pat RdrName -> CpsRn (Pat Name)
349 rnPatAndThen _  (WildPat _)   = return (WildPat placeHolderType)
350 rnPatAndThen mk (ParPat pat)  = do { pat' <- rnLPatAndThen mk pat; return (ParPat pat') }
351 rnPatAndThen mk (LazyPat pat) = do { pat' <- rnLPatAndThen mk pat; return (LazyPat pat') }
352 rnPatAndThen mk (BangPat pat) = do { pat' <- rnLPatAndThen mk pat; return (BangPat pat') }
353 rnPatAndThen mk (VarPat rdr)  = do { loc <- liftCps getSrcSpanM
354                                    ; name <- newPatName mk (L loc rdr)
355                                    ; return (VarPat name) }
356      -- we need to bind pattern variables for view pattern expressions
357      -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
358                                      
359 rnPatAndThen mk (SigPatIn pat sig)
360   -- When renaming a pattern type signature (e.g. f (a :: T) = ...), it is
361   -- important to rename its type signature _before_ renaming the rest of the
362   -- pattern, so that type variables are first bound by the _outermost_ pattern
363   -- type signature they occur in. This keeps the type checker happy when
364   -- pattern type signatures happen to be nested (#7827)
365   --
366   -- f ((Just (x :: a) :: Maybe a)
367   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~^       `a' is first bound here
368   -- ~~~~~~~~~~~~~~~^                   the same `a' then used here
369   = do { sig' <- rnHsSigCps sig
370        ; pat' <- rnLPatAndThen mk pat
371        ; return (SigPatIn pat' sig') }
372        
373 rnPatAndThen mk (LitPat lit)
374   | HsString s <- lit
375   = do { ovlStr <- liftCps (xoptM Opt_OverloadedStrings)
376        ; if ovlStr 
377          then rnPatAndThen mk (mkNPat (mkHsIsString s placeHolderType) Nothing)
378          else normal_lit }
379   | otherwise = normal_lit
380   where
381     normal_lit = do { liftCps (rnLit lit); return (LitPat lit) }
382
383 rnPatAndThen _ (NPat lit mb_neg _eq)
384   = do { lit'    <- liftCpsFV $ rnOverLit lit
385        ; mb_neg' <- liftCpsFV $ case mb_neg of
386                       Nothing -> return (Nothing, emptyFVs)
387                       Just _  -> do { (neg, fvs) <- lookupSyntaxName negateName
388                                     ; return (Just neg, fvs) }
389        ; eq' <- liftCpsFV $ lookupSyntaxName eqName
390        ; return (NPat lit' mb_neg' eq') }
391
392 rnPatAndThen mk (NPlusKPat rdr lit _ _)
393   = do { new_name <- newPatName mk rdr
394        ; lit'  <- liftCpsFV $ rnOverLit lit
395        ; minus <- liftCpsFV $ lookupSyntaxName minusName
396        ; ge    <- liftCpsFV $ lookupSyntaxName geName
397        ; return (NPlusKPat (L (nameSrcSpan new_name) new_name) lit' ge minus) }
398                 -- The Report says that n+k patterns must be in Integral
399
400 rnPatAndThen mk (AsPat rdr pat)
401   = do { new_name <- newPatName mk rdr
402        ; pat' <- rnLPatAndThen mk pat
403        ; return (AsPat (L (nameSrcSpan new_name) new_name) pat') }
404
405 rnPatAndThen mk p@(ViewPat expr pat _ty)
406   = do { liftCps $ do { vp_flag <- xoptM Opt_ViewPatterns
407                       ; checkErr vp_flag (badViewPat p) }
408          -- Because of the way we're arranging the recursive calls,
409          -- this will be in the right context 
410        ; expr' <- liftCpsFV $ rnLExpr expr 
411        ; pat' <- rnLPatAndThen mk pat
412        -- Note: at this point the PreTcType in ty can only be a placeHolder
413        -- ; return (ViewPat expr' pat' ty) }
414        ; return (ViewPat expr' pat' placeHolderType) }
415
416 rnPatAndThen mk (ConPatIn con stuff)
417    -- rnConPatAndThen takes care of reconstructing the pattern
418    -- The pattern for the empty list needs to be replaced by an empty explicit list pattern when overloaded lists is turned on.
419   = case unLoc con == nameRdrName (dataConName nilDataCon) of
420       True    -> do { ol_flag <- liftCps $ xoptM Opt_OverloadedLists
421                     ; if ol_flag then rnPatAndThen mk (ListPat [] placeHolderType Nothing)
422                                  else rnConPatAndThen mk con stuff} 
423       False   -> rnConPatAndThen mk con stuff
424
425 rnPatAndThen mk (ListPat pats _ _)
426   = do { opt_OverloadedLists <- liftCps $ xoptM Opt_OverloadedLists
427        ; pats' <- rnLPatsAndThen mk pats
428        ; case opt_OverloadedLists of
429           True -> do { (to_list_name,_) <- liftCps $ lookupSyntaxName toListName
430                      ; return (ListPat pats' placeHolderType
431                                        (Just (placeHolderType, to_list_name)))}
432           False -> return (ListPat pats' placeHolderType Nothing) }
433
434 rnPatAndThen mk (PArrPat pats _)
435   = do { pats' <- rnLPatsAndThen mk pats
436        ; return (PArrPat pats' placeHolderType) }
437
438 rnPatAndThen mk (TuplePat pats boxed _)
439   = do { liftCps $ checkTupSize (length pats)
440        ; pats' <- rnLPatsAndThen mk pats
441        ; return (TuplePat pats' boxed []) }
442
443 rnPatAndThen mk (SplicePat splice)
444   = do { eith <- liftCpsFV $ rnSplicePat splice
445        ; case eith of   -- See Note [rnSplicePat] in RnSplice
446            Left not_yet_renamed -> rnPatAndThen mk not_yet_renamed
447            Right already_renamed -> return already_renamed } 
448     
449 rnPatAndThen mk (QuasiQuotePat qq)
450   = do { pat <- liftCps $ runQuasiQuotePat qq
451          -- Wrap the result of the quasi-quoter in parens so that we don't
452          -- lose the outermost location set by runQuasiQuote (#7918) 
453        ; rnPatAndThen mk (ParPat pat) }
454
455 rnPatAndThen _ pat = pprPanic "rnLPatAndThen" (ppr pat)
456
457
458 --------------------
459 rnConPatAndThen :: NameMaker
460                 -> Located RdrName          -- the constructor
461                 -> HsConPatDetails RdrName 
462                 -> CpsRn (Pat Name)
463
464 rnConPatAndThen mk con (PrefixCon pats)
465   = do  { con' <- lookupConCps con
466         ; pats' <- rnLPatsAndThen mk pats
467         ; return (ConPatIn con' (PrefixCon pats')) }
468
469 rnConPatAndThen mk con (InfixCon pat1 pat2)
470   = do  { con' <- lookupConCps con
471         ; pat1' <- rnLPatAndThen mk pat1
472         ; pat2' <- rnLPatAndThen mk pat2
473         ; fixity <- liftCps $ lookupFixityRn (unLoc con')
474         ; liftCps $ mkConOpPatRn con' fixity pat1' pat2' }
475
476 rnConPatAndThen mk con (RecCon rpats)
477   = do  { con' <- lookupConCps con
478         ; rpats' <- rnHsRecPatsAndThen mk con' rpats
479         ; return (ConPatIn con' (RecCon rpats')) }
480
481 --------------------
482 rnHsRecPatsAndThen :: NameMaker
483                    -> Located Name      -- Constructor
484                    -> HsRecFields RdrName (LPat RdrName)
485                    -> CpsRn (HsRecFields Name (LPat Name))
486 rnHsRecPatsAndThen mk (L _ con) hs_rec_fields@(HsRecFields { rec_dotdot = dd })
487   = do { flds <- liftCpsFV $ rnHsRecFields (HsRecFieldPat con) VarPat hs_rec_fields
488        ; flds' <- mapM rn_field (flds `zip` [1..])
489        ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }
490   where 
491     rn_field (fld, n') = do { arg' <- rnLPatAndThen (nested_mk dd mk n') 
492                                                     (hsRecFieldArg fld)
493                             ; return (fld { hsRecFieldArg = arg' }) }
494
495         -- Suppress unused-match reporting for fields introduced by ".."
496     nested_mk Nothing  mk                    _  = mk
497     nested_mk (Just _) mk@(LetMk {})         _  = mk
498     nested_mk (Just n) (LamMk report_unused) n' = LamMk (report_unused && (n' <= n))
499 \end{code}
500
501
502 %************************************************************************
503 %*                                                                      *
504         Record fields
505 %*                                                                      *
506 %************************************************************************
507
508 \begin{code}
509 data HsRecFieldContext 
510   = HsRecFieldCon Name
511   | HsRecFieldPat Name
512   | HsRecFieldUpd
513
514 rnHsRecFields
515     :: forall arg. 
516        HsRecFieldContext
517     -> (RdrName -> arg) -- When punning, use this to build a new field
518     -> HsRecFields RdrName (Located arg)
519     -> RnM ([HsRecField Name (Located arg)], FreeVars)
520
521 -- This surprisingly complicated pass
522 --   a) looks up the field name (possibly using disambiguation)
523 --   b) fills in puns and dot-dot stuff
524 -- When we we've finished, we've renamed the LHS, but not the RHS,
525 -- of each x=e binding
526
527 rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
528   = do { pun_ok      <- xoptM Opt_RecordPuns
529        ; disambig_ok <- xoptM Opt_DisambiguateRecordFields
530        ; parent <- check_disambiguation disambig_ok mb_con
531        ; flds1  <- mapM (rn_fld pun_ok parent) flds
532        ; mapM_ (addErr . dupFieldErr ctxt) dup_flds
533        ; dotdot_flds <- rn_dotdot dotdot mb_con flds1
534
535        -- Check for an empty record update  e {}
536        -- NB: don't complain about e { .. }, because rn_dotdot has done that already
537        ; case ctxt of
538            HsRecFieldUpd | Nothing <- dotdot
539                          , null flds
540                          -> addErr emptyUpdateErr
541            _ -> return ()
542
543        ; let all_flds | null dotdot_flds = flds1
544                       | otherwise        = flds1 ++ dotdot_flds
545        ; return (all_flds, mkFVs (getFieldIds all_flds)) }
546   where
547     mb_con = case ctxt of
548                 HsRecFieldCon con | not (isUnboundName con) -> Just con
549                 HsRecFieldPat con | not (isUnboundName con) -> Just con
550                 _ {- update or isUnboundName con -}         -> Nothing
551            -- The unbound name test is because if the constructor 
552            -- isn't in scope the constructor lookup will add an error
553            -- add an error, but still return an unbound name. 
554            -- We don't want that to screw up the dot-dot fill-in stuff.
555
556     doc = case mb_con of
557             Nothing  -> ptext (sLit "constructor field name")
558             Just con -> ptext (sLit "field of constructor") <+> quotes (ppr con)
559
560     rn_fld pun_ok parent (HsRecField { hsRecFieldId = fld
561                                      , hsRecFieldArg = arg
562                                      , hsRecPun = pun })
563       = do { fld'@(L loc fld_nm) <- wrapLocM (lookupSubBndrOcc True parent doc) fld
564            ; arg' <- if pun 
565                      then do { checkErr pun_ok (badPun fld)
566                              ; return (L loc (mk_arg (mkRdrUnqual (nameOccName fld_nm)))) }
567                      else return arg
568            ; return (HsRecField { hsRecFieldId = fld'
569                                 , hsRecFieldArg = arg'
570                                 , hsRecPun = pun }) }
571
572     rn_dotdot :: Maybe Int      -- See Note [DotDot fields] in HsPat
573               -> Maybe Name     -- The constructor (Nothing for an update
574                                 --    or out of scope constructor)
575               -> [HsRecField Name (Located arg)]   -- Explicit fields
576               -> RnM [HsRecField Name (Located arg)]   -- Filled in .. fields
577     rn_dotdot Nothing _mb_con _flds     -- No ".." at all
578       = return []
579     rn_dotdot (Just {}) Nothing _flds   -- ".." on record update
580       = do { case ctxt of
581                 HsRecFieldUpd -> addErr badDotDotUpd
582                 _             -> return ()
583            ; return [] }
584     rn_dotdot (Just n) (Just con) flds -- ".." on record construction / pat match
585       = ASSERT( n == length flds )
586         do { loc <- getSrcSpanM -- Rather approximate
587            ; dd_flag <- xoptM Opt_RecordWildCards
588            ; checkErr dd_flag (needFlagDotDot ctxt)
589            ; (rdr_env, lcl_env) <- getRdrEnvs
590            ; con_fields <- lookupConstructorFields con
591            ; when (null con_fields) (addErr (badDotDotCon con))
592            ; let present_flds = getFieldIds flds
593                  parent_tc = find_tycon rdr_env con
594
595                    -- For constructor uses (but not patterns)
596                    -- the arg should be in scope (unqualified)
597                    -- ignoring the record field itself
598                    -- Eg.  data R = R { x,y :: Int }
599                    --      f x = R { .. }   -- Should expand to R {x=x}, not R{x=x,y=y}
600                  arg_in_scope fld 
601                    = rdr `elemLocalRdrEnv` lcl_env
602                    || notNull [ gre | gre <- lookupGRE_RdrName rdr rdr_env
603                                     , case gre_par gre of
604                                         ParentIs p -> p /= parent_tc
605                                         _          -> True ]
606                    where
607                      rdr = mkRdrUnqual (nameOccName fld)
608
609                  dot_dot_gres = [ head gres
610                                 | fld <- con_fields
611                                 , not (fld `elem` present_flds)
612                                 , let gres = lookupGRE_Name rdr_env fld
613                                 , not (null gres)  -- Check field is in scope
614                                 , case ctxt of
615                                     HsRecFieldCon {} -> arg_in_scope fld
616                                     _other           -> True ] 
617
618            ; addUsedRdrNames (map greRdrName dot_dot_gres)
619            ; return [ HsRecField
620                         { hsRecFieldId  = L loc fld
621                         , hsRecFieldArg = L loc (mk_arg arg_rdr)
622                         , hsRecPun      = False }
623                     | gre <- dot_dot_gres
624                     , let fld     = gre_name gre
625                           arg_rdr = mkRdrUnqual (nameOccName fld) ] }
626
627     check_disambiguation :: Bool -> Maybe Name -> RnM Parent
628     -- When disambiguation is on, 
629     check_disambiguation disambig_ok mb_con
630       | disambig_ok, Just con <- mb_con
631       = do { env <- getGlobalRdrEnv; return (ParentIs (find_tycon env con)) }
632       | otherwise = return NoParent
633  
634     find_tycon :: GlobalRdrEnv -> Name {- DataCon -} -> Name {- TyCon -}
635     -- Return the parent *type constructor* of the data constructor
636     -- That is, the parent of the data constructor.  
637     -- That's the parent to use for looking up record fields.
638     find_tycon env con 
639       | Just (AConLike (RealDataCon dc)) <- wiredInNameTyThing_maybe con
640       = tyConName (dataConTyCon dc)   -- Special case for [], which is built-in syntax
641                                       -- and not in the GlobalRdrEnv (Trac #8448)
642       | [GRE { gre_par = ParentIs p }] <- lookupGRE_Name env con
643       = p
644
645       | otherwise
646       = pprPanic "find_tycon" (ppr con $$ ppr (lookupGRE_Name env con))
647
648     dup_flds :: [[RdrName]]
649         -- Each list represents a RdrName that occurred more than once
650         -- (the list contains all occurrences)
651         -- Each list in dup_fields is non-empty
652     (_, dup_flds) = removeDups compare (getFieldIds flds)
653
654 getFieldIds :: [HsRecField id arg] -> [id]
655 getFieldIds flds = map (unLoc . hsRecFieldId) flds
656
657 needFlagDotDot :: HsRecFieldContext -> SDoc
658 needFlagDotDot ctxt = vcat [ptext (sLit "Illegal `..' in record") <+> pprRFC ctxt,
659                             ptext (sLit "Use RecordWildCards to permit this")]
660
661 badDotDotCon :: Name -> SDoc
662 badDotDotCon con
663   = vcat [ ptext (sLit "Illegal `..' notation for constructor") <+> quotes (ppr con)
664          , nest 2 (ptext (sLit "The constructor has no labelled fields")) ]
665
666 badDotDotUpd :: SDoc
667 badDotDotUpd = ptext (sLit "You cannot use `..' in a record update")
668
669 emptyUpdateErr :: SDoc
670 emptyUpdateErr = ptext (sLit "Empty record update")
671
672 badPun :: Located RdrName -> SDoc
673 badPun fld = vcat [ptext (sLit "Illegal use of punning for field") <+> quotes (ppr fld),
674                    ptext (sLit "Use NamedFieldPuns to permit this")]
675
676 dupFieldErr :: HsRecFieldContext -> [RdrName] -> SDoc
677 dupFieldErr ctxt dups
678   = hsep [ptext (sLit "duplicate field name"), 
679           quotes (ppr (head dups)),
680           ptext (sLit "in record"), pprRFC ctxt]
681
682 pprRFC :: HsRecFieldContext -> SDoc
683 pprRFC (HsRecFieldCon {}) = ptext (sLit "construction")
684 pprRFC (HsRecFieldPat {}) = ptext (sLit "pattern")
685 pprRFC (HsRecFieldUpd {}) = ptext (sLit "update")
686 \end{code}
687
688
689 %************************************************************************
690 %*                                                                      *
691 \subsubsection{Literals}
692 %*                                                                      *
693 %************************************************************************
694
695 When literals occur we have to make sure
696 that the types and classes they involve
697 are made available.
698
699 \begin{code}
700 rnLit :: HsLit -> RnM ()
701 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
702 rnLit _ = return ()
703
704 -- Turn a Fractional-looking literal which happens to be an integer into an
705 -- Integer-looking literal.
706 generalizeOverLitVal :: OverLitVal -> OverLitVal
707 generalizeOverLitVal (HsFractional (FL {fl_value=val}))
708     | denominator val == 1 = HsIntegral (numerator val)
709 generalizeOverLitVal lit = lit
710
711 rnOverLit :: HsOverLit t -> RnM (HsOverLit Name, FreeVars)
712 rnOverLit origLit
713   = do  { opt_NumDecimals <- xoptM Opt_NumDecimals
714         ; let { lit@(OverLit {ol_val=val})
715             | opt_NumDecimals = origLit {ol_val = generalizeOverLitVal (ol_val origLit)}
716             | otherwise       = origLit
717           }
718         ; let std_name = hsOverLitName val
719         ; (from_thing_name, fvs) <- lookupSyntaxName std_name
720         ; let rebindable = case from_thing_name of
721                                 HsVar v -> v /= std_name
722                                 _       -> panic "rnOverLit"
723         ; return (lit { ol_witness = from_thing_name
724                       , ol_rebindable = rebindable
725                       , ol_type = placeHolderType }, fvs) }
726 \end{code}
727
728 %************************************************************************
729 %*                                                                      *
730 \subsubsection{Errors}
731 %*                                                                      *
732 %************************************************************************
733
734 \begin{code}
735 patSigErr :: Outputable a => a -> SDoc
736 patSigErr ty
737   =  (ptext (sLit "Illegal signature in pattern:") <+> ppr ty)
738         $$ nest 4 (ptext (sLit "Use ScopedTypeVariables to permit it"))
739
740 bogusCharError :: Char -> SDoc
741 bogusCharError c
742   = ptext (sLit "character literal out of range: '\\") <> char c  <> char '\''
743
744 badViewPat :: Pat RdrName -> SDoc
745 badViewPat pat = vcat [ptext (sLit "Illegal view pattern: ") <+> ppr pat,
746                        ptext (sLit "Use ViewPatterns to enable view patterns")]
747 \end{code}