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
13 module RnPat (-- main entry points
14 rnPatsAndThen_LocalRightwards, rnBindPat,
16 NameMaker, applyNameMaker, -- a utility for making names:
17 localRecNameMaker, topRecNameMaker, -- sometimes we want to make local names,
18 -- sometimes we want to make top (qualified) names.
20 rnHsRecFields_Con, rnHsRecFields_Update, --rename record fields in a constructor
29 -- Pattern Error messages that are also used elsewhere
30 checkTupSize, patSigErr
33 -- ENH: thin imports to only what is necessary for patterns
35 import {-# SOURCE #-} RnExpr ( rnLExpr )
37 import {-# SOURCE #-} TcSplice ( runQuasiQuotePat )
40 #include "HsVersions.h"
46 import DynFlags ( DynFlag(..) )
48 import Constants ( mAX_TUPLE_SIZE )
52 import ListSetOps ( removeDups, minusList )
56 import Literal ( inIntRange, inCharRange )
60 *********************************************************
64 *********************************************************
67 -- externally abstract type of name makers,
68 -- which is how you go from a RdrName to a Name
69 data NameMaker = NM (forall a. Located RdrName -> (Name -> RnM (a, FreeVars))
72 matchNameMaker :: NameMaker
74 = NM (\ rdr_name thing_inside ->
75 do { names@[name] <- newLocalsRn [rdr_name]
76 ; bindLocalNamesFV names $ do
77 { (res, fvs) <- thing_inside name
78 ; warnUnusedMatches names fvs
79 ; return (res, fvs) }})
81 topRecNameMaker, localRecNameMaker
82 :: MiniFixityEnv -> NameMaker
84 -- topNameMaker and localBindMaker do not check for unused binding
85 localRecNameMaker fix_env
86 = NM (\ rdr_name thing_inside ->
87 do { [name] <- newLocalsRn [rdr_name]
88 ; bindLocalNamesFV_WithFixities [name] fix_env $
91 topRecNameMaker fix_env
92 = NM (\rdr_name thing_inside ->
94 ; name <- newTopSrcBinder mod rdr_name
95 ; bindLocalNamesFV_WithFixities [name] fix_env $
97 -- Note: the bindLocalNamesFV_WithFixities is somewhat suspicious
98 -- because it binds a top-level name as a local name.
99 -- however, this binding seems to work, and it only exists for
100 -- the duration of the patterns and the continuation;
101 -- then the top-level name is added to the global env
102 -- before going on to the RHSes (see RnSource.lhs).
104 applyNameMaker :: NameMaker -> Located RdrName
105 -> (Name -> RnM (a,FreeVars)) -> RnM (a, FreeVars)
106 applyNameMaker (NM f) = f
109 -- There are various entry points to renaming patterns, depending on
110 -- (1) whether the names created should be top-level names or local names
111 -- (2) whether the scope of the names is entirely given in a continuation
112 -- (e.g., in a case or lambda, but not in a let or at the top-level,
113 -- because of the way mutually recursive bindings are handled)
114 -- (3) whether the a type signature in the pattern can bind
115 -- lexically-scoped type variables (for unpacking existential
116 -- type vars in data constructors)
117 -- (4) whether we do duplicate and unused variable checking
118 -- (5) whether there are fixity declarations associated with the names
119 -- bound by the patterns that need to be brought into scope with them.
121 -- Rather than burdening the clients of this module with all of these choices,
122 -- we export the three points in this design space that we actually need:
125 -- binds local names; the scope of the bindings is entirely in the thing_inside
126 -- allows type sigs to bind type vars
128 -- unused and duplicate checking
130 rnPatsAndThen_LocalRightwards :: HsMatchContext Name -- for error messages
132 -- the continuation gets:
133 -- the list of renamed patterns
134 -- the (overall) free vars of all of them
135 -> ([LPat Name] -> RnM (a, FreeVars))
138 rnPatsAndThen_LocalRightwards ctxt pats thing_inside
139 = do { envs_before <- getRdrEnvs
141 -- (0) bring into scope all of the type variables bound by the patterns
142 -- (1) rename the patterns, bringing into scope all of the term variables
143 -- (2) then do the thing inside.
144 ; bindPatSigTyVarsFV (collectSigTysFromPats pats) $
145 rnLPatsAndThen matchNameMaker pats $ \ pats' ->
146 do { -- Check for duplicated and shadowed names
147 -- Because we don't bind the vars all at once, we can't
148 -- check incrementally for duplicates;
149 -- Nor can we check incrementally for shadowing, else we'll
150 -- complain *twice* about duplicates e.g. f (x,x) = ...
151 ; let names = collectPatsBinders pats'
152 ; checkDupNames doc_pat names
153 ; checkShadowedNames doc_pat envs_before
154 [(nameSrcSpan name, nameOccName name) | name <- names]
155 ; thing_inside pats' } }
157 doc_pat = ptext (sLit "In") <+> pprMatchContext ctxt
161 -- binds local names; in a recursive scope that involves other bound vars
162 -- e.g let { (x, Just y) = e1; ... } in ...
163 -- does NOT allows type sig to bind type vars
165 -- no unused and duplicate checking
166 -- fixities might be coming in
167 rnBindPat :: NameMaker
170 -- free variables of the pattern,
171 -- but not including variables bound by this pattern
174 rnBindPat name_maker pat
175 = rnLPatsAndThen name_maker [pat] $ \ [pat'] ->
176 return (pat', emptyFVs)
179 -- general version: parametrized by how you make new names
180 -- invariant: what-to-do continuation only gets called with a list whose length is the same as
181 -- the part of the pattern we're currently renaming
182 rnLPatsAndThen :: NameMaker -- how to make a new variable
183 -> [LPat RdrName] -- part of pattern we're currently renaming
184 -> ([LPat Name] -> RnM (a, FreeVars)) -- what to do afterwards
185 -> RnM (a, FreeVars) -- renaming of the whole thing
187 rnLPatsAndThen var = mapFvRnCPS (rnLPatAndThen var)
191 rnLPatAndThen :: NameMaker
192 -> LPat RdrName -- part of pattern we're currently renaming
193 -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
194 -> RnM (a, FreeVars) -- renaming of the whole thing
195 rnLPatAndThen var@(NM varf) (L loc p) cont =
198 lcont = \ unlocated -> cont (reloc unlocated)
201 WildPat _ -> lcont (WildPat placeHolderType)
203 ParPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (ParPat pat')
204 LazyPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (LazyPat pat')
205 BangPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (BangPat pat')
208 varf (reloc name) $ \ newBoundName ->
209 lcont (VarPat newBoundName)
210 -- we need to bind pattern variables for view pattern expressions
211 -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
213 SigPatIn pat ty -> do
214 patsigs <- doptM Opt_PatternSignatures
216 then rnLPatAndThen var pat
217 (\ pat' -> do { (ty', fvs1) <- rnHsTypeFVs tvdoc ty
218 ; (res, fvs2) <- lcont (SigPatIn pat' ty')
219 ; return (res, fvs1 `plusFV` fvs2) })
220 else do addErr (patSigErr ty)
221 rnLPatAndThen var pat cont
223 tvdoc = text "In a pattern type-signature"
225 LitPat lit@(HsString s) ->
226 do ovlStr <- doptM Opt_OverloadedStrings
228 then rnLPatAndThen var (reloc $ mkNPat (mkHsIsString s placeHolderType) Nothing) cont
229 else do { rnLit lit; lcont (LitPat lit) } -- Same as below
231 LitPat lit -> do { rnLit lit; lcont (LitPat lit) }
233 NPat lit mb_neg _eq ->
234 do { (lit', fvs1) <- rnOverLit lit
235 ; (mb_neg', fvs2) <- case mb_neg of
236 Nothing -> return (Nothing, emptyFVs)
237 Just _ -> do { (neg, fvs) <- lookupSyntaxName negateName
238 ; return (Just neg, fvs) }
239 ; (eq', fvs3) <- lookupSyntaxName eqName
240 ; (res, fvs4) <- lcont (NPat lit' mb_neg' eq')
241 ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
242 -- Needed to find equality on pattern
244 NPlusKPat name lit _ _ ->
245 varf name $ \ new_name ->
246 do { (lit', fvs1) <- rnOverLit lit
247 ; (minus, fvs2) <- lookupSyntaxName minusName
248 ; (ge, fvs3) <- lookupSyntaxName geName
249 ; (res, fvs4) <- lcont (NPlusKPat (L (nameSrcSpan new_name) new_name) lit' ge minus)
250 ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
251 -- The Report says that n+k patterns must be in Integral
254 varf name $ \ new_name ->
255 rnLPatAndThen var pat $ \ pat' ->
256 lcont (AsPat (L (nameSrcSpan new_name) new_name) pat')
258 ViewPat expr pat ty ->
259 do { vp_flag <- doptM Opt_ViewPatterns
260 ; checkErr vp_flag (badViewPat p)
261 -- because of the way we're arranging the recursive calls,
262 -- this will be in the right context
263 ; (expr', fv_expr) <- rnLExpr expr
264 ; (res, fvs_res) <- rnLPatAndThen var pat $ \ pat' ->
265 lcont (ViewPat expr' pat' ty)
266 ; return (res, fvs_res `plusFV` fv_expr) }
269 (QuasiQuotePat _) -> pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
271 QuasiQuotePat qq -> do
272 (qq', _) <- rnQuasiQuote qq
273 pat' <- runQuasiQuotePat qq'
274 rnLPatAndThen var pat' $ \ (L _ pat'') ->
278 ConPatIn con stuff ->
279 -- rnConPatAndThen takes care of reconstructing the pattern
280 rnConPatAndThen var con stuff cont
283 rnLPatsAndThen var pats $ \ patslist ->
284 lcont (ListPat patslist placeHolderType)
287 do { (res, res_fvs) <- rnLPatsAndThen var pats $ \ patslist ->
288 lcont (PArrPat patslist placeHolderType)
289 ; return (res, res_fvs `plusFV` implicit_fvs) }
291 implicit_fvs = mkFVs [lengthPName, indexPName]
293 TuplePat pats boxed _ ->
294 do { checkTupSize (length pats)
295 ; rnLPatsAndThen var pats $ \ patslist ->
296 lcont (TuplePat patslist boxed placeHolderType) }
299 do { (name', fvs1) <- rnHsTypeFVs (text "In a type pattern") name
300 ; (res, fvs2) <- lcont (TypePat name')
301 ; return (res, fvs1 `plusFV` fvs2) }
303 p -> pprPanic "rnLPatAndThen" (ppr p)
306 -- helper for renaming constructor patterns
307 rnConPatAndThen :: NameMaker
308 -> Located RdrName -- the constructor
309 -> HsConPatDetails RdrName
310 -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
313 rnConPatAndThen var (con@(L loc _)) (PrefixCon pats) cont
314 = do { con' <- lookupLocatedOccRn con
315 ; (res, res_fvs) <- rnLPatsAndThen var pats $ \ pats' ->
316 cont (L loc $ ConPatIn con' (PrefixCon pats'))
317 ; return (res, res_fvs `addOneFV` unLoc con') }
319 rnConPatAndThen var (con@(L loc _)) (InfixCon pat1 pat2) cont
320 = do { con' <- lookupLocatedOccRn con
321 ; (res, res_fvs) <- rnLPatAndThen var pat1 $ \ pat1' ->
322 rnLPatAndThen var pat2 $ \ pat2' ->
323 do { fixity <- lookupFixityRn (unLoc con')
324 ; pat' <- mkConOpPatRn con' fixity pat1' pat2'
325 ; cont (L loc pat') }
326 ; return (res, res_fvs `addOneFV` unLoc con') }
328 rnConPatAndThen var (con@(L loc _)) (RecCon rpats) cont
329 = do { con' <- lookupLocatedOccRn con
330 ; (res, res_fvs) <- rnHsRecFieldsAndThen_Pattern con' var rpats $ \ rpats' ->
331 cont (L loc $ ConPatIn con' (RecCon rpats'))
332 ; return (res, res_fvs `addOneFV` unLoc con') }
334 -- what kind of record expression we're doing
335 -- the first two tell the name of the datatype constructor in question
336 -- and give a way of creating a variable to fill in a ..
337 data RnHsRecFieldsChoice a = Constructor (Located Name) (RdrName -> a)
338 | Pattern (Located Name) (RdrName -> a)
341 choiceToMessage :: RnHsRecFieldsChoice t -> String
342 choiceToMessage (Constructor _ _) = "construction"
343 choiceToMessage (Pattern _ _) = "pattern"
344 choiceToMessage Update = "update"
346 doDotDot :: RnHsRecFieldsChoice t -> Maybe (Located Name, RdrName -> t)
347 doDotDot (Constructor a b) = Just (a,b)
348 doDotDot (Pattern a b) = Just (a,b)
349 doDotDot Update = Nothing
351 getChoiceName :: RnHsRecFieldsChoice field -> Maybe (Located Name)
352 getChoiceName (Constructor n _) = Just n
353 getChoiceName (Pattern n _) = Just n
354 getChoiceName (Update) = Nothing
358 -- helper for renaming record patterns;
359 -- parameterized so that it can also be used for expressions
360 rnHsRecFieldsAndThen :: RnHsRecFieldsChoice field
361 -- how to rename the fields (CPSed)
362 -> (Located field -> (Located field' -> RnM (c, FreeVars))
363 -> RnM (c, FreeVars))
365 -> HsRecFields RdrName (Located field)
366 -- what to do in the scope of the field vars
367 -> (HsRecFields Name (Located field') -> RnM (c, FreeVars))
369 -- Haddock comments for record fields are renamed to Nothing here
370 rnHsRecFieldsAndThen choice rn_thing (HsRecFields fields dd) cont =
373 -- helper to collect and report duplicate record fields
374 reportDuplicateFields doingstr fields =
376 -- each list represents a RdrName that occurred more than once
377 -- (the list contains all occurrences)
378 -- invariant: each list in dup_fields is non-empty
379 dup_fields :: [[RdrName]]
380 (_, dup_fields) = removeDups compare
381 (map (unLoc . hsRecFieldId) fields)
383 -- duplicate field reporting function
384 field_dup_err dup_group = addErr (dupFieldErr doingstr (head dup_group))
386 mapM_ field_dup_err dup_fields
388 -- helper to rename each field
389 rn_field pun_ok (HsRecField field inside pun) cont = do
390 fieldname <- lookupRecordBndr (getChoiceName choice) field
391 checkErr (not pun || pun_ok) (badPun field)
392 (res, res_fvs) <- rn_thing inside $ \ inside' ->
393 cont (HsRecField fieldname inside' pun)
394 return (res, res_fvs `addOneFV` unLoc fieldname)
396 -- Compute the extra fields to be filled in by the dot-dot notation
397 dot_dot_fields fs con mk_field cont = do
398 con_fields <- lookupConstructorFields (unLoc con)
399 let missing_fields = con_fields `minusList` fs
400 loc <- getSrcSpanM -- Rather approximate
401 -- it's important that we make the RdrName fields that we morally wrote
402 -- and then rename them in the usual manner
403 -- (rather than trying to make the result of renaming directly)
404 -- because, for patterns, renaming can bind vars in the continuation
406 (map (L loc . mk_field . mkRdrUnqual . getOccName) missing_fields) $
408 let new_fs = [ HsRecField (L loc f) r False
409 | (f, r) <- missing_fields `zip` rhss ]
414 -- report duplicate fields
415 let doingstr = choiceToMessage choice
416 reportDuplicateFields doingstr fields
418 -- rename the records as written
419 -- check whether punning (implicit x=x) is allowed
420 pun_flag <- doptM Opt_RecordPuns
422 mapFvRnCPS (rn_field pun_flag) fields $ \ fields1 ->
426 Nothing -> cont (HsRecFields fields1 dd)
427 Just n -> ASSERT( n == length fields ) do
428 dd_flag <- doptM Opt_RecordWildCards
429 checkErr dd_flag (needFlagDotDot doingstr)
430 let fld_names1 = map (unLoc . hsRecFieldId) fields1
431 case doDotDot choice of
432 Nothing -> do addErr (badDotDot doingstr)
433 -- we return a junk value here so that error reporting goes on
434 cont (HsRecFields fields1 dd)
435 Just (con, mk_field) ->
436 dot_dot_fields fld_names1 con mk_field $
438 cont (HsRecFields (fields1 ++ fields2) dd)
440 needFlagDotDot :: String -> SDoc
441 needFlagDotDot str = vcat [ptext (sLit "Illegal `..' in record") <+> text str,
442 ptext (sLit "Use -XRecordWildCards to permit this")]
444 badDotDot :: String -> SDoc
445 badDotDot str = ptext (sLit "You cannot use `..' in record") <+> text str
447 badPun :: Located RdrName -> SDoc
448 badPun fld = vcat [ptext (sLit "Illegal use of punning for field") <+> quotes (ppr fld),
449 ptext (sLit "Use -XRecordPuns to permit this")]
453 rnHsRecFieldsAndThen_Pattern :: Located Name
454 -> NameMaker -- new name maker
455 -> HsRecFields RdrName (LPat RdrName)
456 -> (HsRecFields Name (LPat Name) -> RnM (c, FreeVars))
458 rnHsRecFieldsAndThen_Pattern n var
459 = rnHsRecFieldsAndThen (Pattern n VarPat) (rnLPatAndThen var)
462 -- wrapper to use rnLExpr in CPS style;
463 -- because it does not bind any vars going forward, it does not need
464 -- to be written that way
465 rnLExprAndThen :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
467 -> (LHsExpr Name -> RnM (c, FreeVars))
469 rnLExprAndThen f e cont = do { (x, fvs1) <- f e
470 ; (res, fvs2) <- cont x
471 ; return (res, fvs1 `plusFV` fvs2) }
474 -- non-CPSed because exprs don't leave anything bound
475 rnHsRecFields_Con :: Located Name
476 -> (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
477 -> HsRecFields RdrName (LHsExpr RdrName)
478 -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
479 rnHsRecFields_Con n rnLExpr fields = rnHsRecFieldsAndThen (Constructor n HsVar)
480 (rnLExprAndThen rnLExpr) fields $ \ res ->
481 return (res, emptyFVs)
483 rnHsRecFields_Update :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
484 -> HsRecFields RdrName (LHsExpr RdrName)
485 -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
486 rnHsRecFields_Update rnLExpr fields = rnHsRecFieldsAndThen Update
487 (rnLExprAndThen rnLExpr) fields $ \ res ->
488 return (res, emptyFVs)
493 %************************************************************************
495 \subsubsection{Literals}
497 %************************************************************************
499 When literals occur we have to make sure
500 that the types and classes they involve
504 rnLit :: HsLit -> RnM ()
505 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
508 rnOverLit :: HsOverLit t -> RnM (HsOverLit Name, FreeVars)
509 rnOverLit (HsIntegral i _ _) = do
510 (from_integer_name, fvs) <- lookupSyntaxName fromIntegerName
512 return (HsIntegral i from_integer_name placeHolderType, fvs)
514 extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
515 -- Big integer literals are built, using + and *,
516 -- out of small integers (DsUtils.mkIntegerLit)
517 -- [NB: plusInteger, timesInteger aren't rebindable...
518 -- they are used to construct the argument to fromInteger,
519 -- which is the rebindable one.]
521 return (HsIntegral i from_integer_name placeHolderType, fvs `plusFV` extra_fvs)
523 rnOverLit (HsFractional i _ _) = do
524 (from_rat_name, fvs) <- lookupSyntaxName fromRationalName
526 extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
527 -- We have to make sure that the Ratio type is imported with
528 -- its constructor, because literals of type Ratio t are
529 -- built with that constructor.
530 -- The Rational type is needed too, but that will come in
531 -- as part of the type for fromRational.
532 -- The plus/times integer operations may be needed to construct the numerator
533 -- and denominator (see DsUtils.mkIntegerLit)
534 return (HsFractional i from_rat_name placeHolderType, fvs `plusFV` extra_fvs)
536 rnOverLit (HsIsString s _ _) = do
537 (from_string_name, fvs) <- lookupSyntaxName fromStringName
538 return (HsIsString s from_string_name placeHolderType, fvs)
541 %************************************************************************
543 \subsubsection{Quasiquotation}
545 %************************************************************************
547 See Note [Quasi-quote overview] in TcSplice.
550 rnQuasiQuote :: HsQuasiQuote RdrName -> RnM (HsQuasiQuote Name, FreeVars)
551 rnQuasiQuote (HsQuasiQuote n quoter quoteSpan quote)
552 = do { loc <- getSrcSpanM
553 ; [n'] <- newLocalsRn [L loc n]
554 ; quoter' <- (lookupOccRn quoter)
555 -- If 'quoter' is not in scope, proceed no further
556 -- Otherwise lookupOcc adds an error messsage and returns
557 -- an "unubound name", which makes the subsequent attempt to
558 -- run the quote fail
559 ; return (HsQuasiQuote n' quoter' quoteSpan quote, unitFV quoter') }
562 %************************************************************************
564 \subsubsection{Errors}
566 %************************************************************************
569 checkTupSize :: Int -> RnM ()
570 checkTupSize tup_size
571 | tup_size <= mAX_TUPLE_SIZE
574 = addErr (sep [ptext (sLit "A") <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"),
575 nest 2 (parens (ptext (sLit "max size is") <+> int mAX_TUPLE_SIZE)),
576 nest 2 (ptext (sLit "Workaround: use nested tuples or define a data type"))])
578 patSigErr :: Outputable a => a -> SDoc
580 = (ptext (sLit "Illegal signature in pattern:") <+> ppr ty)
581 $$ nest 4 (ptext (sLit "Use -XPatternSignatures to permit it"))
583 dupFieldErr :: String -> RdrName -> SDoc
585 = hsep [ptext (sLit "duplicate field name"),
587 ptext (sLit "in record"), text str]
589 bogusCharError :: Char -> SDoc
591 = ptext (sLit "character literal out of range: '\\") <> char c <> char '\''
593 badViewPat :: Pat RdrName -> SDoc
594 badViewPat pat = vcat [ptext (sLit "Illegal view pattern: ") <+> ppr pat,
595 ptext (sLit "Use -XViewPatterns to enable view patterns")]