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