2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnPat]{Renaming of patterns}
6 Basically dependency analysis.
8 Handles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes. In
9 general, all of these functions return a renamed thing, and a set of
14 -- The above warning supression flag is a temporary kludge.
15 -- While working on this module you are encouraged to remove it and fix
16 -- any warnings in the module. See
17 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
20 module RnPat (-- main entry points
21 rnPatsAndThen_LocalRightwards, rnBindPat,
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.
27 rnHsRecFields_Con, rnHsRecFields_Update, --rename record fields in a constructor
36 -- Pattern Error messages that are also used elsewhere
37 checkTupSize, patSigErr
40 -- ENH: thin imports to only what is necessary for patterns
42 import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts)
44 import {-# SOURCE #-} TcSplice( runQuasiQuotePat )
47 #include "HsVersions.h"
52 import HscTypes ( availNames )
53 import RnTypes ( rnHsTypeFVs,
54 mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec, mkConOpPatRn
56 import DynFlags ( DynFlag(..) )
57 import BasicTypes ( FixityDirection(..) )
58 import SrcLoc ( SrcSpan )
59 import PrelNames ( thFAKE, hasKey, assertIdKey, assertErrorName,
60 loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
61 negateName, thenMName, bindMName, failMName,
62 eqClassName, integralClassName, geName, eqName,
63 negateName, minusName, lengthPName, indexPName,
64 plusIntegerName, fromIntegerName, timesIntegerName,
65 ratioDataConName, fromRationalName, fromStringName, mkUnboundName )
66 import Constants ( mAX_TUPLE_SIZE )
67 import Name ( Name, nameOccName, nameModule_maybe, getOccName, nameSrcSpan )
68 import OccName ( occEnvElts )
71 import RdrName ( RdrName, GlobalRdrElt(..), Provenance(..),
72 extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals,
73 mkRdrUnqual, nameRdrName, gre_name, globalRdrEnvElts, isLocalGRE )
74 import LoadIface ( loadInterfaceForName )
75 import UniqSet ( emptyUniqSet )
77 import Util ( isSingleton )
78 import ListSetOps ( removeDups, minusList )
79 import Maybes ( expectJust )
81 import SrcLoc ( Located(..), unLoc, getLoc, cmpLocated, noLoc )
83 import Literal ( inIntRange, inCharRange )
84 import List ( unzip4 )
87 import ErrUtils (Message)
91 *********************************************************
95 *********************************************************
98 -- externally abstract type of name makers,
99 -- which is how you go from a RdrName to a Name
100 data NameMaker = NM (forall a. Located RdrName -> (Name -> RnM (a, FreeVars))
101 -> RnM (a, FreeVars))
103 matchNameMaker :: NameMaker
105 = NM (\ rdr_name thing_inside ->
106 do { names@[name] <- newLocalsRn [rdr_name]
107 ; bindLocalNamesFV names $ do
108 { (res, fvs) <- thing_inside name
109 ; warnUnusedMatches names fvs
110 ; return (res, fvs) }})
112 topRecNameMaker, localRecNameMaker
113 :: MiniFixityEnv -> NameMaker
115 -- topNameMaker and localBindMaker do not check for unused binding
116 localRecNameMaker fix_env
117 = NM (\ rdr_name thing_inside ->
118 do { [name] <- newLocalsRn [rdr_name]
119 ; bindLocalNamesFV_WithFixities [name] fix_env $
122 topRecNameMaker fix_env
123 = NM (\rdr_name thing_inside ->
124 do { mod <- getModule
125 ; name <- newTopSrcBinder mod rdr_name
126 ; bindLocalNamesFV_WithFixities [name] fix_env $
128 -- Note: the bindLocalNamesFV_WithFixities is somewhat suspicious
129 -- because it binds a top-level name as a local name.
130 -- however, this binding seems to work, and it only exists for
131 -- the duration of the patterns and the continuation;
132 -- then the top-level name is added to the global env
133 -- before going on to the RHSes (see RnSource.lhs).
135 applyNameMaker :: NameMaker -> Located RdrName
136 -> (Name -> RnM (a,FreeVars)) -> RnM (a, FreeVars)
137 applyNameMaker (NM f) = f
140 -- There are various entry points to renaming patterns, depending on
141 -- (1) whether the names created should be top-level names or local names
142 -- (2) whether the scope of the names is entirely given in a continuation
143 -- (e.g., in a case or lambda, but not in a let or at the top-level,
144 -- because of the way mutually recursive bindings are handled)
145 -- (3) whether the a type signature in the pattern can bind
146 -- lexically-scoped type variables (for unpacking existential
147 -- type vars in data constructors)
148 -- (4) whether we do duplicate and unused variable checking
149 -- (5) whether there are fixity declarations associated with the names
150 -- bound by the patterns that need to be brought into scope with them.
152 -- Rather than burdening the clients of this module with all of these choices,
153 -- we export the three points in this design space that we actually need:
156 -- binds local names; the scope of the bindings is entirely in the thing_inside
157 -- allows type sigs to bind type vars
159 -- unused and duplicate checking
161 rnPatsAndThen_LocalRightwards :: HsMatchContext Name -- for error messages
163 -- the continuation gets:
164 -- the list of renamed patterns
165 -- the (overall) free vars of all of them
166 -> ([LPat Name] -> RnM (a, FreeVars))
169 rnPatsAndThen_LocalRightwards ctxt pats thing_inside
170 = do { envs_before <- getRdrEnvs
172 -- (0) bring into scope all of the type variables bound by the patterns
173 -- (1) rename the patterns, bringing into scope all of the term variables
174 -- (2) then do the thing inside.
175 ; bindPatSigTyVarsFV (collectSigTysFromPats pats) $
176 rnLPatsAndThen matchNameMaker pats $ \ pats' ->
177 do { -- Check for duplicated and shadowed names
178 -- Because we don't bind the vars all at once, we can't
179 -- check incrementally for duplicates;
180 -- Nor can we check incrementally for shadowing, else we'll
181 -- complain *twice* about duplicates e.g. f (x,x) = ...
182 ; let names = collectPatsBinders pats'
183 ; checkDupNames doc_pat names
184 ; checkShadowedNames doc_pat envs_before
185 [(nameSrcSpan name, nameOccName name) | name <- names]
186 ; thing_inside pats' } }
188 doc_pat = ptext (sLit "In") <+> pprMatchContext ctxt
192 -- binds local names; in a recursive scope that involves other bound vars
193 -- e.g let { (x, Just y) = e1; ... } in ...
194 -- does NOT allows type sig to bind type vars
196 -- no unused and duplicate checking
197 -- fixities might be coming in
198 rnBindPat :: NameMaker
201 -- free variables of the pattern,
202 -- but not including variables bound by this pattern
205 rnBindPat name_maker pat
206 = rnLPatsAndThen name_maker [pat] $ \ [pat'] ->
207 return (pat', emptyFVs)
210 -- general version: parametrized by how you make new names
211 -- invariant: what-to-do continuation only gets called with a list whose length is the same as
212 -- the part of the pattern we're currently renaming
213 rnLPatsAndThen :: NameMaker -- how to make a new variable
214 -> [LPat RdrName] -- part of pattern we're currently renaming
215 -> ([LPat Name] -> RnM (a, FreeVars)) -- what to do afterwards
216 -> RnM (a, FreeVars) -- renaming of the whole thing
218 rnLPatsAndThen var = mapFvRnCPS (rnLPatAndThen var)
222 rnLPatAndThen :: NameMaker
223 -> LPat RdrName -- part of pattern we're currently renaming
224 -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
225 -> RnM (a, FreeVars) -- renaming of the whole thing
226 rnLPatAndThen var@(NM varf) (L loc p) cont =
229 lcont = \ unlocated -> cont (reloc unlocated)
232 WildPat _ -> lcont (WildPat placeHolderType)
234 ParPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (ParPat pat')
235 LazyPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (LazyPat pat')
236 BangPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (BangPat pat')
239 varf (reloc name) $ \ newBoundName ->
240 lcont (VarPat newBoundName)
241 -- we need to bind pattern variables for view pattern expressions
242 -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
244 SigPatIn pat ty -> do
245 patsigs <- doptM Opt_PatternSignatures
247 then rnLPatAndThen var pat
248 (\ pat' -> do { (ty', fvs1) <- rnHsTypeFVs tvdoc ty
249 ; (res, fvs2) <- lcont (SigPatIn pat' ty')
250 ; return (res, fvs1 `plusFV` fvs2) })
251 else do addErr (patSigErr ty)
252 rnLPatAndThen var pat cont
254 tvdoc = text "In a pattern type-signature"
256 LitPat lit@(HsString s) ->
257 do ovlStr <- doptM Opt_OverloadedStrings
259 then rnLPatAndThen var (reloc $ mkNPat (mkHsIsString s placeHolderType) Nothing) cont
260 else do { rnLit lit; lcont (LitPat lit) } -- Same as below
262 LitPat lit -> do { rnLit lit; lcont (LitPat lit) }
264 NPat lit mb_neg eq ->
265 do { (lit', fvs1) <- rnOverLit lit
266 ; (mb_neg', fvs2) <- case mb_neg of
267 Nothing -> return (Nothing, emptyFVs)
268 Just _ -> do { (neg, fvs) <- lookupSyntaxName negateName
269 ; return (Just neg, fvs) }
270 ; (eq', fvs3) <- lookupSyntaxName eqName
271 ; (res, fvs4) <- lcont (NPat lit' mb_neg' eq')
272 ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
273 -- Needed to find equality on pattern
275 NPlusKPat name lit _ _ ->
276 varf name $ \ new_name ->
277 do { (lit', fvs1) <- rnOverLit lit
278 ; (minus, fvs2) <- lookupSyntaxName minusName
279 ; (ge, fvs3) <- lookupSyntaxName geName
280 ; (res, fvs4) <- lcont (NPlusKPat (L (nameSrcSpan new_name) new_name) lit' ge minus)
281 ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
282 -- The Report says that n+k patterns must be in Integral
285 varf name $ \ new_name ->
286 rnLPatAndThen var pat $ \ pat' ->
287 lcont (AsPat (L (nameSrcSpan new_name) new_name) pat')
289 ViewPat expr pat ty ->
290 do { vp_flag <- doptM Opt_ViewPatterns
291 ; checkErr vp_flag (badViewPat p)
292 -- because of the way we're arranging the recursive calls,
293 -- this will be in the right context
294 ; (expr', fv_expr) <- rnLExpr expr
295 ; (res, fvs_res) <- rnLPatAndThen var pat $ \ pat' ->
296 lcont (ViewPat expr' pat' ty)
297 ; return (res, fvs_res `plusFV` fv_expr) }
300 pat@(QuasiQuotePat _) -> pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
302 QuasiQuotePat qq -> do
303 (qq', _) <- rnQuasiQuote qq
304 pat' <- runQuasiQuotePat qq'
305 rnLPatAndThen var pat' $ \ (L _ pat'') ->
309 ConPatIn con stuff ->
310 -- rnConPatAndThen takes care of reconstructing the pattern
311 rnConPatAndThen var con stuff cont
314 rnLPatsAndThen var pats $ \ patslist ->
315 lcont (ListPat patslist placeHolderType)
318 do { (res, res_fvs) <- rnLPatsAndThen var pats $ \ patslist ->
319 lcont (PArrPat patslist placeHolderType)
320 ; return (res, res_fvs `plusFV` implicit_fvs) }
322 implicit_fvs = mkFVs [lengthPName, indexPName]
324 TuplePat pats boxed _ ->
325 do { checkTupSize (length pats)
326 ; rnLPatsAndThen var pats $ \ patslist ->
327 lcont (TuplePat patslist boxed placeHolderType) }
330 do { (name', fvs1) <- rnHsTypeFVs (text "In a type pattern") name
331 ; (res, fvs2) <- lcont (TypePat name')
332 ; return (res, fvs1 `plusFV` fvs2) }
335 -- helper for renaming constructor patterns
336 rnConPatAndThen :: NameMaker
337 -> Located RdrName -- the constructor
338 -> HsConPatDetails RdrName
339 -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
342 rnConPatAndThen var (con@(L loc _)) (PrefixCon pats) cont
343 = do { con' <- lookupLocatedOccRn con
344 ; (res, res_fvs) <- rnLPatsAndThen var pats $ \ pats' ->
345 cont (L loc $ ConPatIn con' (PrefixCon pats'))
346 ; return (res, res_fvs `addOneFV` unLoc con') }
348 rnConPatAndThen var (con@(L loc _)) (InfixCon pat1 pat2) cont
349 = do { con' <- lookupLocatedOccRn con
350 ; (res, res_fvs) <- rnLPatAndThen var pat1 $ \ pat1' ->
351 rnLPatAndThen var pat2 $ \ pat2' ->
352 do { fixity <- lookupFixityRn (unLoc con')
353 ; pat' <- mkConOpPatRn con' fixity pat1' pat2'
354 ; cont (L loc pat') }
355 ; return (res, res_fvs `addOneFV` unLoc con') }
357 rnConPatAndThen var (con@(L loc _)) (RecCon rpats) cont
358 = do { con' <- lookupLocatedOccRn con
359 ; (res, res_fvs) <- rnHsRecFieldsAndThen_Pattern con' var rpats $ \ rpats' ->
360 cont (L loc $ ConPatIn con' (RecCon rpats'))
361 ; return (res, res_fvs `addOneFV` unLoc con') }
363 -- what kind of record expression we're doing
364 -- the first two tell the name of the datatype constructor in question
365 -- and give a way of creating a variable to fill in a ..
366 data RnHsRecFieldsChoice a = Constructor (Located Name) (RdrName -> a)
367 | Pattern (Located Name) (RdrName -> a)
370 choiceToMessage (Constructor _ _) = "construction"
371 choiceToMessage (Pattern _ _) = "pattern"
372 choiceToMessage Update = "update"
374 doDotDot (Constructor a b) = Just (a,b)
375 doDotDot (Pattern a b) = Just (a,b)
376 doDotDot Update = Nothing
378 getChoiceName (Constructor n _) = Just n
379 getChoiceName (Pattern n _) = Just n
380 getChoiceName (Update) = Nothing
384 -- helper for renaming record patterns;
385 -- parameterized so that it can also be used for expressions
386 rnHsRecFieldsAndThen :: RnHsRecFieldsChoice field
387 -- how to rename the fields (CPSed)
388 -> (Located field -> (Located field' -> RnM (c, FreeVars))
389 -> RnM (c, FreeVars))
391 -> HsRecFields RdrName (Located field)
392 -- what to do in the scope of the field vars
393 -> (HsRecFields Name (Located field') -> RnM (c, FreeVars))
395 -- Haddock comments for record fields are renamed to Nothing here
396 rnHsRecFieldsAndThen choice rn_thing (HsRecFields fields dd) cont =
399 -- helper to collect and report duplicate record fields
400 reportDuplicateFields doingstr fields =
402 -- each list represents a RdrName that occurred more than once
403 -- (the list contains all occurrences)
404 -- invariant: each list in dup_fields is non-empty
405 dup_fields :: [[RdrName]]
406 (_, dup_fields) = removeDups compare
407 (map (unLoc . hsRecFieldId) fields)
409 -- duplicate field reporting function
410 field_dup_err dup_group = addErr (dupFieldErr doingstr (head dup_group))
412 mapM_ field_dup_err dup_fields
414 -- helper to rename each field
415 rn_field pun_ok (HsRecField field inside pun) cont = do
416 fieldname <- lookupRecordBndr (getChoiceName choice) field
417 checkErr (not pun || pun_ok) (badPun field)
418 (res, res_fvs) <- rn_thing inside $ \ inside' ->
419 cont (HsRecField fieldname inside' pun)
420 return (res, res_fvs `addOneFV` unLoc fieldname)
422 -- Compute the extra fields to be filled in by the dot-dot notation
423 dot_dot_fields fs con mk_field cont = do
424 con_fields <- lookupConstructorFields (unLoc con)
425 let missing_fields = con_fields `minusList` fs
426 loc <- getSrcSpanM -- Rather approximate
427 -- it's important that we make the RdrName fields that we morally wrote
428 -- and then rename them in the usual manner
429 -- (rather than trying to make the result of renaming directly)
430 -- because, for patterns, renaming can bind vars in the continuation
432 (map (L loc . mk_field . mkRdrUnqual . getOccName) missing_fields) $
434 let new_fs = [ HsRecField (L loc f) r False
435 | (f, r) <- missing_fields `zip` rhss ]
440 -- report duplicate fields
441 let doingstr = choiceToMessage choice
442 reportDuplicateFields doingstr fields
444 -- rename the records as written
445 -- check whether punning (implicit x=x) is allowed
446 pun_flag <- doptM Opt_RecordPuns
448 mapFvRnCPS (rn_field pun_flag) fields $ \ fields1 ->
452 Nothing -> cont (HsRecFields fields1 dd)
453 Just n -> ASSERT( n == length fields ) do
454 dd_flag <- doptM Opt_RecordWildCards
455 checkErr dd_flag (needFlagDotDot doingstr)
456 let fld_names1 = map (unLoc . hsRecFieldId) fields1
457 case doDotDot choice of
458 Nothing -> do addErr (badDotDot doingstr)
459 -- we return a junk value here so that error reporting goes on
460 cont (HsRecFields fields1 dd)
461 Just (con, mk_field) ->
462 dot_dot_fields fld_names1 con mk_field $
464 cont (HsRecFields (fields1 ++ fields2) dd)
466 needFlagDotDot str = vcat [ptext (sLit "Illegal `..' in record") <+> text str,
467 ptext (sLit "Use -XRecordWildCards to permit this")]
469 badDotDot str = ptext (sLit "You cannot use `..' in record") <+> text str
471 badPun fld = vcat [ptext (sLit "Illegal use of punning for field") <+> quotes (ppr fld),
472 ptext (sLit "Use -XRecordPuns to permit this")]
476 rnHsRecFieldsAndThen_Pattern :: Located Name
477 -> NameMaker -- new name maker
478 -> HsRecFields RdrName (LPat RdrName)
479 -> (HsRecFields Name (LPat Name) -> RnM (c, FreeVars))
481 rnHsRecFieldsAndThen_Pattern n var
482 = rnHsRecFieldsAndThen (Pattern n VarPat) (rnLPatAndThen var)
485 -- wrapper to use rnLExpr in CPS style;
486 -- because it does not bind any vars going forward, it does not need
487 -- to be written that way
488 rnLExprAndThen :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
490 -> (LHsExpr Name -> RnM (c, FreeVars))
492 rnLExprAndThen f e cont = do { (x, fvs1) <- f e
493 ; (res, fvs2) <- cont x
494 ; return (res, fvs1 `plusFV` fvs2) }
497 -- non-CPSed because exprs don't leave anything bound
498 rnHsRecFields_Con :: Located Name
499 -> (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
500 -> HsRecFields RdrName (LHsExpr RdrName)
501 -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
502 rnHsRecFields_Con n rnLExpr fields = rnHsRecFieldsAndThen (Constructor n HsVar)
503 (rnLExprAndThen rnLExpr) fields $ \ res ->
504 return (res, emptyFVs)
506 rnHsRecFields_Update :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
507 -> HsRecFields RdrName (LHsExpr RdrName)
508 -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
509 rnHsRecFields_Update rnLExpr fields = rnHsRecFieldsAndThen Update
510 (rnLExprAndThen rnLExpr) fields $ \ res ->
511 return (res, emptyFVs)
516 %************************************************************************
518 \subsubsection{Literals}
520 %************************************************************************
522 When literals occur we have to make sure
523 that the types and classes they involve
527 rnLit :: HsLit -> RnM ()
528 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
529 rnLit other = return ()
531 rnOverLit (HsIntegral i _ _) = do
532 (from_integer_name, fvs) <- lookupSyntaxName fromIntegerName
534 return (HsIntegral i from_integer_name placeHolderType, fvs)
536 extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
537 -- Big integer literals are built, using + and *,
538 -- out of small integers (DsUtils.mkIntegerLit)
539 -- [NB: plusInteger, timesInteger aren't rebindable...
540 -- they are used to construct the argument to fromInteger,
541 -- which is the rebindable one.]
543 return (HsIntegral i from_integer_name placeHolderType, fvs `plusFV` extra_fvs)
545 rnOverLit (HsFractional i _ _) = do
546 (from_rat_name, fvs) <- lookupSyntaxName fromRationalName
548 extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
549 -- We have to make sure that the Ratio type is imported with
550 -- its constructor, because literals of type Ratio t are
551 -- built with that constructor.
552 -- The Rational type is needed too, but that will come in
553 -- as part of the type for fromRational.
554 -- The plus/times integer operations may be needed to construct the numerator
555 -- and denominator (see DsUtils.mkIntegerLit)
556 return (HsFractional i from_rat_name placeHolderType, fvs `plusFV` extra_fvs)
558 rnOverLit (HsIsString s _ _) = do
559 (from_string_name, fvs) <- lookupSyntaxName fromStringName
560 return (HsIsString s from_string_name placeHolderType, fvs)
563 %************************************************************************
565 \subsubsection{Quasiquotation}
567 %************************************************************************
569 See Note [Quasi-quote overview] in TcSplice.
572 rnQuasiQuote :: HsQuasiQuote RdrName -> RnM (HsQuasiQuote Name, FreeVars)
573 rnQuasiQuote (HsQuasiQuote n quoter quoteSpan quote)
574 = do { loc <- getSrcSpanM
575 ; [n'] <- newLocalsRn [L loc n]
576 ; quoter' <- (lookupOccRn quoter)
577 -- If 'quoter' is not in scope, proceed no further
578 -- Otherwise lookupOcc adds an error messsage and returns
579 -- an "unubound name", which makes the subsequent attempt to
580 -- run the quote fail
581 ; return (HsQuasiQuote n' quoter' quoteSpan quote, unitFV quoter') }
584 %************************************************************************
586 \subsubsection{Errors}
588 %************************************************************************
591 checkTupSize :: Int -> RnM ()
592 checkTupSize tup_size
593 | tup_size <= mAX_TUPLE_SIZE
596 = addErr (sep [ptext (sLit "A") <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"),
597 nest 2 (parens (ptext (sLit "max size is") <+> int mAX_TUPLE_SIZE)),
598 nest 2 (ptext (sLit "Workaround: use nested tuples or define a data type"))])
601 = (ptext (sLit "Illegal signature in pattern:") <+> ppr ty)
602 $$ nest 4 (ptext (sLit "Use -XPatternSignatures to permit it"))
605 = hsep [ptext (sLit "duplicate field name"),
607 ptext (sLit "in record"), text str]
610 = ptext (sLit "character literal out of range: '\\") <> char c <> char '\''
612 badViewPat pat = vcat [ptext (sLit "Illegal view pattern: ") <+> ppr pat,
613 ptext (sLit "Use -XViewPatterns to enable view patterns")]