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
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 rnHsRecFields1, HsRecFieldContext(..),
28 -- Pattern Error messages that are also used elsewhere
29 checkTupSize, patSigErr
32 -- ENH: thin imports to only what is necessary for patterns
34 import {-# SOURCE #-} RnExpr ( rnLExpr )
36 import {-# SOURCE #-} TcSplice ( runQuasiQuotePat )
39 #include "HsVersions.h"
43 import TcHsSyn ( hsOverLitName )
46 import DynFlags ( DynFlag(..) )
48 import Constants ( mAX_TUPLE_SIZE )
53 import ListSetOps ( removeDups, minusList )
57 import Literal ( inCharRange )
58 import Control.Monad ( when )
62 %*********************************************************
66 %*********************************************************
70 The CpsRn monad uses continuation-passing style to support this
77 where rs::[RdrName], ns::[Name]
79 The idea is that '...blah...'
80 a) sees the bindings of ns
81 b) returns the free variables it mentions
82 so that bindNames can report unused ones
85 mapM rnPatAndThen [p1, p2, p3]
86 has a *left-to-right* scoping: it makes the binders in
90 newtype CpsRn b = CpsRn { unCpsRn :: forall r. (b -> RnM (r, FreeVars))
91 -> RnM (r, FreeVars) }
92 -- See Note [CpsRn monad]
94 instance Monad CpsRn where
95 return x = CpsRn (\k -> k x)
96 (CpsRn m) >>= mk = CpsRn (\k -> m (\v -> unCpsRn (mk v) k))
98 runCps :: CpsRn a -> RnM (a, FreeVars)
99 runCps (CpsRn m) = m (\r -> return (r, emptyFVs))
101 liftCps :: RnM a -> CpsRn a
102 liftCps rn_thing = CpsRn (\k -> rn_thing >>= k)
104 liftCpsFV :: RnM (a, FreeVars) -> CpsRn a
105 liftCpsFV rn_thing = CpsRn (\k -> do { (v,fvs1) <- rn_thing
107 ; return (r, fvs1 `plusFV` fvs2) })
109 wrapSrcSpanCps :: (a -> CpsRn b) -> Located a -> CpsRn (Located b)
110 -- Set the location, and also wrap it around the value returned
111 wrapSrcSpanCps fn (L loc a)
112 = CpsRn (\k -> setSrcSpan loc $
113 unCpsRn (fn a) $ \v ->
116 lookupConCps :: Located RdrName -> CpsRn (Located Name)
118 = CpsRn (\k -> do { con_name <- lookupLocatedOccRn con_rdr
119 ; (r, fvs) <- k con_name
120 ; return (r, fvs `plusFV` unitFV (unLoc con_name)) })
123 %*********************************************************
127 %*********************************************************
129 Externally abstract type of name makers,
130 which is how you go from a RdrName to a Name
135 Bool -- True <=> report unused bindings
136 -- (even if True, the warning only comes out
137 -- if -fwarn-unused-matches is on)
139 | LetMk -- Let bindings, incl top level
140 -- Do *not* check for unused bindings
141 (Maybe Module) -- Just m => top level of module m
142 -- Nothing => not top level
145 topRecNameMaker :: Module -> MiniFixityEnv -> NameMaker
146 topRecNameMaker mod fix_env = LetMk (Just mod) fix_env
148 localRecNameMaker :: MiniFixityEnv -> NameMaker
149 localRecNameMaker fix_env = LetMk Nothing fix_env
151 matchNameMaker :: HsMatchContext a -> NameMaker
152 matchNameMaker ctxt = LamMk report_unused
154 -- Do not report unused names in interactive contexts
155 -- i.e. when you type 'x <- e' at the GHCi prompt
156 report_unused = case ctxt of
157 StmtCtxt GhciStmt -> False
160 newName :: NameMaker -> Located RdrName -> CpsRn Name
161 newName (LamMk report_unused) rdr_name
162 = CpsRn (\ thing_inside ->
163 do { name <- newLocalBndrRn rdr_name
164 ; (res, fvs) <- bindLocalName name (thing_inside name)
165 ; when report_unused $ warnUnusedMatches [name] fvs
166 ; return (res, name `delFV` fvs) })
168 newName (LetMk mb_top fix_env) rdr_name
169 = CpsRn (\ thing_inside ->
170 do { name <- case mb_top of
171 Nothing -> newLocalBndrRn rdr_name
172 Just mod -> newTopSrcBinder mod rdr_name
173 ; bindLocalNamesFV_WithFixities [name] fix_env $
176 -- Note: the bindLocalNamesFV_WithFixities is somewhat suspicious
177 -- because it binds a top-level name as a local name.
178 -- however, this binding seems to work, and it only exists for
179 -- the duration of the patterns and the continuation;
180 -- then the top-level name is added to the global env
181 -- before going on to the RHSes (see RnSource.lhs).
185 %*********************************************************
187 External entry points
189 %*********************************************************
191 There are various entry points to renaming patterns, depending on
192 (1) whether the names created should be top-level names or local names
193 (2) whether the scope of the names is entirely given in a continuation
194 (e.g., in a case or lambda, but not in a let or at the top-level,
195 because of the way mutually recursive bindings are handled)
196 (3) whether the a type signature in the pattern can bind
197 lexically-scoped type variables (for unpacking existential
198 type vars in data constructors)
199 (4) whether we do duplicate and unused variable checking
200 (5) whether there are fixity declarations associated with the names
201 bound by the patterns that need to be brought into scope with them.
203 Rather than burdening the clients of this module with all of these choices,
204 we export the three points in this design space that we actually need:
207 -- ----------- Entry point 1: rnPats -------------------
208 -- Binds local names; the scope of the bindings is entirely in the thing_inside
209 -- * allows type sigs to bind type vars
211 -- * unused and duplicate checking
213 rnPats :: HsMatchContext Name -- for error messages
215 -> ([LPat Name] -> RnM (a, FreeVars))
217 rnPats ctxt pats thing_inside
218 = do { envs_before <- getRdrEnvs
220 -- (0) bring into scope all of the type variables bound by the patterns
221 -- (1) rename the patterns, bringing into scope all of the term variables
222 -- (2) then do the thing inside.
223 ; bindPatSigTyVarsFV (collectSigTysFromPats pats) $
224 unCpsRn (rnLPatsAndThen (matchNameMaker ctxt) pats) $ \ pats' -> do
225 { -- Check for duplicated and shadowed names
226 -- Because we don't bind the vars all at once, we can't
227 -- check incrementally for duplicates;
228 -- Nor can we check incrementally for shadowing, else we'll
229 -- complain *twice* about duplicates e.g. f (x,x) = ...
230 ; let names = collectPatsBinders pats'
231 ; addErrCtxt doc_pat $ checkDupAndShadowedNames envs_before names
232 ; thing_inside pats' } }
234 doc_pat = ptext (sLit "In") <+> pprMatchContext ctxt
237 applyNameMaker :: NameMaker -> Located RdrName -> RnM Name
238 applyNameMaker mk rdr = do { (n, _fvs) <- runCps (newName mk rdr); return n }
240 -- ----------- Entry point 2: rnBindPat -------------------
241 -- Binds local names; in a recursive scope that involves other bound vars
242 -- e.g let { (x, Just y) = e1; ... } in ...
243 -- * does NOT allows type sig to bind type vars
245 -- * no unused and duplicate checking
246 -- * fixities might be coming in
247 rnBindPat :: NameMaker
249 -> RnM (LPat Name, FreeVars)
250 -- Returned FreeVars are the free variables of the pattern,
251 -- of course excluding variables bound by this pattern
253 rnBindPat name_maker pat = runCps (rnLPatAndThen name_maker pat)
257 %*********************************************************
261 %*********************************************************
264 -- ----------- Entry point 3: rnLPatAndThen -------------------
265 -- General version: parametrized by how you make new names
267 rnLPatsAndThen :: NameMaker -> [LPat RdrName] -> CpsRn [LPat Name]
268 rnLPatsAndThen mk = mapM (rnLPatAndThen mk)
269 -- Despite the map, the monad ensures that each pattern binds
270 -- variables that may be mentioned in subsequent patterns in the list
274 rnLPatAndThen :: NameMaker -> LPat RdrName -> CpsRn (LPat Name)
275 rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat
277 rnPatAndThen :: NameMaker -> Pat RdrName -> CpsRn (Pat Name)
278 rnPatAndThen _ (WildPat _) = return (WildPat placeHolderType)
279 rnPatAndThen mk (ParPat pat) = do { pat' <- rnLPatAndThen mk pat; return (ParPat pat') }
280 rnPatAndThen mk (LazyPat pat) = do { pat' <- rnLPatAndThen mk pat; return (LazyPat pat') }
281 rnPatAndThen mk (BangPat pat) = do { pat' <- rnLPatAndThen mk pat; return (BangPat pat') }
282 rnPatAndThen mk (VarPat rdr) = do { loc <- liftCps getSrcSpanM
283 ; name <- newName mk (L loc rdr)
284 ; return (VarPat name) }
285 -- we need to bind pattern variables for view pattern expressions
286 -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
288 rnPatAndThen mk (SigPatIn pat ty)
289 = do { patsigs <- liftCps (doptM Opt_ScopedTypeVariables)
291 then do { pat' <- rnLPatAndThen mk pat
292 ; ty' <- liftCpsFV (rnHsTypeFVs tvdoc ty)
293 ; return (SigPatIn pat' ty') }
294 else do { liftCps (addErr (patSigErr ty))
295 ; rnPatAndThen mk (unLoc pat) } }
297 tvdoc = text "In a pattern type-signature"
299 rnPatAndThen mk (LitPat lit)
301 = do { ovlStr <- liftCps (doptM Opt_OverloadedStrings)
303 then rnPatAndThen mk (mkNPat (mkHsIsString s placeHolderType) Nothing)
305 | otherwise = normal_lit
307 normal_lit = do { liftCps (rnLit lit); return (LitPat lit) }
309 rnPatAndThen _ (NPat lit mb_neg _eq)
310 = do { lit' <- liftCpsFV $ rnOverLit lit
311 ; mb_neg' <- liftCpsFV $ case mb_neg of
312 Nothing -> return (Nothing, emptyFVs)
313 Just _ -> do { (neg, fvs) <- lookupSyntaxName negateName
314 ; return (Just neg, fvs) }
315 ; eq' <- liftCpsFV $ lookupSyntaxName eqName
316 ; return (NPat lit' mb_neg' eq') }
318 rnPatAndThen mk (NPlusKPat rdr lit _ _)
319 = do { new_name <- newName mk rdr
320 ; lit' <- liftCpsFV $ rnOverLit lit
321 ; minus <- liftCpsFV $ lookupSyntaxName minusName
322 ; ge <- liftCpsFV $ lookupSyntaxName geName
323 ; return (NPlusKPat (L (nameSrcSpan new_name) new_name) lit' ge minus) }
324 -- The Report says that n+k patterns must be in Integral
326 rnPatAndThen mk (AsPat rdr pat)
327 = do { new_name <- newName mk rdr
328 ; pat' <- rnLPatAndThen mk pat
329 ; return (AsPat (L (nameSrcSpan new_name) new_name) pat') }
331 rnPatAndThen mk p@(ViewPat expr pat ty)
332 = do { liftCps $ do { vp_flag <- doptM Opt_ViewPatterns
333 ; checkErr vp_flag (badViewPat p) }
334 -- Because of the way we're arranging the recursive calls,
335 -- this will be in the right context
336 ; expr' <- liftCpsFV $ rnLExpr expr
337 ; pat' <- rnLPatAndThen mk pat
338 ; return (ViewPat expr' pat' ty) }
340 rnPatAndThen mk (ConPatIn con stuff)
341 -- rnConPatAndThen takes care of reconstructing the pattern
342 = rnConPatAndThen mk con stuff
344 rnPatAndThen mk (ListPat pats _)
345 = do { pats' <- rnLPatsAndThen mk pats
346 ; return (ListPat pats' placeHolderType) }
348 rnPatAndThen mk (PArrPat pats _)
349 = do { pats' <- rnLPatsAndThen mk pats
350 ; return (PArrPat pats' placeHolderType) }
352 rnPatAndThen mk (TuplePat pats boxed _)
353 = do { liftCps $ checkTupSize (length pats)
354 ; pats' <- rnLPatsAndThen mk pats
355 ; return (TuplePat pats' boxed placeHolderType) }
357 rnPatAndThen _ (TypePat ty)
358 = do { ty' <- liftCpsFV $ rnHsTypeFVs (text "In a type pattern") ty
359 ; return (TypePat ty') }
362 rnPatAndThen _ p@(QuasiQuotePat {})
363 = pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
365 rnPatAndThen mk (QuasiQuotePat qq)
366 = do { qq' <- liftCpsFV $ rnQuasiQuote qq
367 ; pat <- liftCps $ runQuasiQuotePat qq'
368 ; L _ pat' <- rnLPatAndThen mk pat
372 rnPatAndThen _ pat = pprPanic "rnLPatAndThen" (ppr pat)
376 rnConPatAndThen :: NameMaker
377 -> Located RdrName -- the constructor
378 -> HsConPatDetails RdrName
381 rnConPatAndThen mk con (PrefixCon pats)
382 = do { con' <- lookupConCps con
383 ; pats' <- rnLPatsAndThen mk pats
384 ; return (ConPatIn con' (PrefixCon pats')) }
386 rnConPatAndThen mk con (InfixCon pat1 pat2)
387 = do { con' <- lookupConCps con
388 ; pat1' <- rnLPatAndThen mk pat1
389 ; pat2' <- rnLPatAndThen mk pat2
390 ; fixity <- liftCps $ lookupFixityRn (unLoc con')
391 ; liftCps $ mkConOpPatRn con' fixity pat1' pat2' }
393 rnConPatAndThen mk con (RecCon rpats)
394 = do { con' <- lookupConCps con
395 ; rpats' <- rnHsRecPatsAndThen mk con' rpats
396 ; return (ConPatIn con' (RecCon rpats')) }
399 rnHsRecPatsAndThen :: NameMaker
400 -> Located Name -- Constructor
401 -> HsRecFields RdrName (LPat RdrName)
402 -> CpsRn (HsRecFields Name (LPat Name))
403 rnHsRecPatsAndThen mk (L _ con) hs_rec_fields@(HsRecFields { rec_dotdot = dd })
404 = do { flds <- liftCpsFV $ rnHsRecFields1 (HsRecFieldPat con) VarPat hs_rec_fields
405 ; flds' <- mapM rn_field (flds `zip` [1..])
406 ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }
408 rn_field (fld, n') = do { arg' <- rnLPatAndThen (nested_mk dd mk n')
410 ; return (fld { hsRecFieldArg = arg' }) }
412 -- Suppress unused-match reporting for fields introduced by ".."
413 nested_mk Nothing mk _ = mk
414 nested_mk (Just _) mk@(LetMk {}) _ = mk
415 nested_mk (Just n) (LamMk report_unused) n' = LamMk (report_unused && (n' <= n))
419 %************************************************************************
423 %************************************************************************
426 data HsRecFieldContext
433 -> (RdrName -> arg) -- When punning, use this to build a new field
434 -> HsRecFields RdrName (Located arg)
435 -> RnM ([HsRecField Name (Located arg)], FreeVars)
437 -- This supprisingly complicated pass
438 -- a) looks up the field name (possibly using disambiguation)
439 -- b) fills in puns and dot-dot stuff
440 -- When we we've finished, we've renamed the LHS, but not the RHS,
441 -- of each x=e binding
443 rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
444 = do { pun_ok <- doptM Opt_RecordPuns
445 ; disambig_ok <- doptM Opt_DisambiguateRecordFields
446 ; parent <- check_disambiguation disambig_ok mb_con
447 ; flds1 <- mapM (rn_fld pun_ok parent) flds
448 ; mapM_ (addErr . dupFieldErr ctxt) dup_flds
449 ; flds2 <- rn_dotdot dotdot mb_con flds1
450 ; return (flds2, mkFVs (getFieldIds flds2)) }
452 mb_con = case ctxt of
453 HsRecFieldUpd -> Nothing
454 HsRecFieldCon con -> Just con
455 HsRecFieldPat con -> Just con
457 Nothing -> ptext (sLit "constructor field name")
458 Just con -> ptext (sLit "field of constructor") <+> quotes (ppr con)
460 name_to_arg (L loc n) = L loc (mk_arg (mkRdrUnqual (nameOccName n)))
462 rn_fld pun_ok parent (HsRecField { hsRecFieldId = fld
463 , hsRecFieldArg = arg
465 = do { fld' <- wrapLocM (lookupSubBndr parent doc) fld
467 then do { checkErr pun_ok (badPun fld)
468 ; return (name_to_arg fld') }
470 ; return (HsRecField { hsRecFieldId = fld'
471 , hsRecFieldArg = arg'
472 , hsRecPun = pun }) }
474 rn_dotdot Nothing _mb_con flds -- No ".." at all
476 rn_dotdot (Just {}) Nothing flds -- ".." on record update
477 = do { addErr (badDotDot ctxt); return flds }
478 rn_dotdot (Just n) (Just con) flds -- ".." on record con/pat
479 = ASSERT( n == length flds )
480 do { loc <- getSrcSpanM -- Rather approximate
481 ; dd_flag <- doptM Opt_RecordWildCards
482 ; checkErr dd_flag (needFlagDotDot ctxt)
484 ; con_fields <- lookupConstructorFields con
485 ; let present_flds = getFieldIds flds
486 absent_flds = con_fields `minusList` present_flds
487 extras = [ HsRecField
488 { hsRecFieldId = L loc f
489 , hsRecFieldArg = name_to_arg (L loc f)
493 ; return (flds ++ extras) }
495 check_disambiguation :: Bool -> Maybe Name -> RnM Parent
496 -- When disambiguation is on, return the parent *type constructor*
497 -- That is, the parent of the data constructor. That's the parent
498 -- to use for looking up record fields.
499 check_disambiguation disambig_ok mb_con
500 | disambig_ok, Just con <- mb_con
501 = do { env <- getGlobalRdrEnv
502 ; return (case lookupGRE_Name env con of
504 gres -> WARN( True, ppr con <+> ppr gres ) NoParent) }
505 | otherwise = return NoParent
507 dup_flds :: [[RdrName]]
508 -- Each list represents a RdrName that occurred more than once
509 -- (the list contains all occurrences)
510 -- Each list in dup_fields is non-empty
511 (_, dup_flds) = removeDups compare (getFieldIds flds)
513 getFieldIds :: [HsRecField id arg] -> [id]
514 getFieldIds flds = map (unLoc . hsRecFieldId) flds
516 needFlagDotDot :: HsRecFieldContext -> SDoc
517 needFlagDotDot ctxt = vcat [ptext (sLit "Illegal `..' in record") <+> pprRFC ctxt,
518 ptext (sLit "Use -XRecordWildCards to permit this")]
520 badDotDot :: HsRecFieldContext -> SDoc
521 badDotDot ctxt = ptext (sLit "You cannot use `..' in a record") <+> pprRFC ctxt
523 badPun :: Located RdrName -> SDoc
524 badPun fld = vcat [ptext (sLit "Illegal use of punning for field") <+> quotes (ppr fld),
525 ptext (sLit "Use -XNamedFieldPuns to permit this")]
527 dupFieldErr :: HsRecFieldContext -> [RdrName] -> SDoc
528 dupFieldErr ctxt dups
529 = hsep [ptext (sLit "duplicate field name"),
530 quotes (ppr (head dups)),
531 ptext (sLit "in record"), pprRFC ctxt]
533 pprRFC :: HsRecFieldContext -> SDoc
534 pprRFC (HsRecFieldCon {}) = ptext (sLit "construction")
535 pprRFC (HsRecFieldPat {}) = ptext (sLit "pattern")
536 pprRFC (HsRecFieldUpd {}) = ptext (sLit "update")
540 %************************************************************************
542 \subsubsection{Literals}
544 %************************************************************************
546 When literals occur we have to make sure
547 that the types and classes they involve
551 rnLit :: HsLit -> RnM ()
552 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
555 rnOverLit :: HsOverLit t -> RnM (HsOverLit Name, FreeVars)
556 rnOverLit lit@(OverLit {ol_val=val})
557 = do { let std_name = hsOverLitName val
558 ; (from_thing_name, fvs) <- lookupSyntaxName std_name
559 ; let rebindable = case from_thing_name of
560 HsVar v -> v /= std_name
561 _ -> panic "rnOverLit"
562 ; return (lit { ol_witness = from_thing_name
563 , ol_rebindable = rebindable }, fvs) }
566 %************************************************************************
568 \subsubsection{Quasiquotation}
570 %************************************************************************
572 See Note [Quasi-quote overview] in TcSplice.
575 rnQuasiQuote :: HsQuasiQuote RdrName -> RnM (HsQuasiQuote Name, FreeVars)
576 rnQuasiQuote (HsQuasiQuote n quoter quoteSpan quote)
577 = do { loc <- getSrcSpanM
578 ; n' <- newLocalBndrRn (L loc n)
579 ; quoter' <- lookupOccRn quoter
580 -- If 'quoter' is not in scope, proceed no further
581 -- Otherwise lookupOcc adds an error messsage and returns
582 -- an "unubound name", which makes the subsequent attempt to
583 -- run the quote fail
584 ; return (HsQuasiQuote n' quoter' quoteSpan quote, unitFV quoter') }
587 %************************************************************************
589 \subsubsection{Errors}
591 %************************************************************************
594 checkTupSize :: Int -> RnM ()
595 checkTupSize tup_size
596 | tup_size <= mAX_TUPLE_SIZE
599 = addErr (sep [ptext (sLit "A") <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"),
600 nest 2 (parens (ptext (sLit "max size is") <+> int mAX_TUPLE_SIZE)),
601 nest 2 (ptext (sLit "Workaround: use nested tuples or define a data type"))])
603 patSigErr :: Outputable a => a -> SDoc
605 = (ptext (sLit "Illegal signature in pattern:") <+> ppr ty)
606 $$ nest 4 (ptext (sLit "Use -XScopedTypeVariables to permit it"))
608 bogusCharError :: Char -> SDoc
610 = ptext (sLit "character literal out of range: '\\") <> char c <> char '\''
612 badViewPat :: Pat RdrName -> SDoc
613 badViewPat pat = vcat [ptext (sLit "Illegal view pattern: ") <+> ppr pat,
614 ptext (sLit "Use -XViewPatterns to enable view patterns")]