compiler/rename/RnBinds.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnBinds]{Renaming and dependency analysis of bindings}
   5
   6 This module does renaming and dependency analysis on value bindings in
   7 the abstract syntax.  It does {\em not} do cycle-checks on class or
   8 type-synonym declarations; those cannot be done at this stage because
   9 they may be affected by renaming (which isn't fully worked out yet).
  10
  11 \begin{code}
  12 {-# OPTIONS -w #-}
  13 -- The above warning supression flag is a temporary kludge.
  14 -- While working on this module you are encouraged to remove it and fix
  15 -- any warnings in the module. See
  16 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  17 -- for details
  18
  19 module RnBinds (
  20         rnTopBinds,
  21         rnLocalBindsAndThen, rnValBindsAndThen, rnValBinds, trimWith,
  22         rnMethodBinds, renameSigs, mkSigTvFn,
  23         rnMatchGroup, rnGRHSs
  24    ) where
  25
  26 #include "HsVersions.h"
  27
  28 import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts )
  29
  30 import HsSyn
  31 import RdrHsSyn
  32 import RnHsSyn
  33 import TcRnMonad
  34 import RnTypes          ( rnHsSigType, rnLHsType, rnHsTypeFVs,
  35                           rnLPat, rnPatsAndThen, patSigErr, checkPrecMatch )
  36 import RnEnv            ( bindLocatedLocalsRn, lookupLocatedBndrRn,
  37                           lookupInstDeclBndr, newIPNameRn,
  38                           lookupLocatedSigOccRn, bindPatSigTyVarsFV,
  39                           bindLocalFixities, bindSigTyVarsFV,
  40                           warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
  41                         )
  42 import DynFlags ( DynFlag(..) )
  43 import Name
  44 import NameEnv
  45 import NameSet
  46 import PrelNames        ( isUnboundName )
  47 import RdrName          ( RdrName, rdrNameOcc )
  48 import SrcLoc           ( Located(..), unLoc )
  49 import ListSetOps       ( findDupsEq )
  50 import BasicTypes       ( RecFlag(..) )
  51 import Digraph          ( SCC(..), stronglyConnComp )
  52 import Bag
  53 import Outputable
  54 import Maybes           ( orElse )
  55 import Util             ( filterOut )
  56 import Monad            ( foldM )
  57 \end{code}
  58
  59 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
  60 -- place and can be used when complaining.
  61
  62 The code tree received by the function @rnBinds@ contains definitions
  63 in where-clauses which are all apparently mutually recursive, but which may
  64 not really depend upon each other. For example, in the top level program
  65 \begin{verbatim}
  66 f x = y where a = x
  67               y = x
  68 \end{verbatim}
  69 the definitions of @a@ and @y@ do not depend on each other at all.
  70 Unfortunately, the typechecker cannot always check such definitions.
  71 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
  72 definitions. In Proceedings of the International Symposium on Programming,
  73 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
  74 However, the typechecker usually can check definitions in which only the
  75 strongly connected components have been collected into recursive bindings.
  76 This is precisely what the function @rnBinds@ does.
  77
  78 ToDo: deal with case where a single monobinds binds the same variable
  79 twice.
  80
  81 The vertag tag is a unique @Int@; the tags only need to be unique
  82 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
  83 (heavy monad machinery not needed).
  84
  85
  86 %************************************************************************
  87 %*                                                                      *
  88 %* naming conventions                                                   *
  89 %*                                                                      *
  90 %************************************************************************
  91
  92 \subsection[name-conventions]{Name conventions}
  93
  94 The basic algorithm involves walking over the tree and returning a tuple
  95 containing the new tree plus its free variables. Some functions, such
  96 as those walking polymorphic bindings (HsBinds) and qualifier lists in
  97 list comprehensions (@Quals@), return the variables bound in local
  98 environments. These are then used to calculate the free variables of the
  99 expression evaluated in these environments.
 100
 101 Conventions for variable names are as follows:
 102 \begin{itemize}
 103 \item
 104 new code is given a prime to distinguish it from the old.
 105
 106 \item
 107 a set of variables defined in @Exp@ is written @dvExp@
 108
 109 \item
 110 a set of variables free in @Exp@ is written @fvExp@
 111 \end{itemize}
 112
 113 %************************************************************************
 114 %*                                                                      *
 115 %* analysing polymorphic bindings (HsBindGroup, HsBind)
 116 %*                                                                      *
 117 %************************************************************************
 118
 119 \subsubsection[dep-HsBinds]{Polymorphic bindings}
 120
 121 Non-recursive expressions are reconstructed without any changes at top
 122 level, although their component expressions may have to be altered.
 123 However, non-recursive expressions are currently not expected as
 124 \Haskell{} programs, and this code should not be executed.
 125
 126 Monomorphic bindings contain information that is returned in a tuple
 127 (a @FlatMonoBinds@) containing:
 128
 129 \begin{enumerate}
 130 \item
 131 a unique @Int@ that serves as the ``vertex tag'' for this binding.
 132
 133 \item
 134 the name of a function or the names in a pattern. These are a set
 135 referred to as @dvLhs@, the defined variables of the left hand side.
 136
 137 \item
 138 the free variables of the body. These are referred to as @fvBody@.
 139
 140 \item
 141 the definition's actual code. This is referred to as just @code@.
 142 \end{enumerate}
 143
 144 The function @nonRecDvFv@ returns two sets of variables. The first is
 145 the set of variables defined in the set of monomorphic bindings, while the
 146 second is the set of free variables in those bindings.
 147
 148 The set of variables defined in a non-recursive binding is just the
 149 union of all of them, as @union@ removes duplicates. However, the
 150 free variables in each successive set of cumulative bindings is the
 151 union of those in the previous set plus those of the newest binding after
 152 the defined variables of the previous set have been removed.
 153
 154 @rnMethodBinds@ deals only with the declarations in class and
 155 instance declarations.  It expects only to see @FunMonoBind@s, and
 156 it expects the global environment to contain bindings for the binders
 157 (which are all class operations).
 158
 159 %************************************************************************
 160 %*                                                                      *
 161 \subsubsection{ Top-level bindings}
 162 %*                                                                      *
 163 %************************************************************************
 164
 165 @rnTopMonoBinds@ assumes that the environment already
 166 contains bindings for the binders of this particular binding.
 167
 168 \begin{code}
 169 rnTopBinds :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
 170
 171 -- The binders of the binding are in scope already;
 172 -- the top level scope resolution does that
 173
 174 rnTopBinds binds
 175  =  do  { is_boot <- tcIsHsBoot
 176         ; if is_boot then rnTopBindsBoot binds
 177                      else rnTopBindsSrc  binds }
 178
 179 rnTopBindsBoot :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
 180 -- A hs-boot file has no bindings.
 181 -- Return a single HsBindGroup with empty binds and renamed signatures
 182 rnTopBindsBoot (ValBindsIn mbinds sigs)
 183   = do  { checkErr (isEmptyLHsBinds mbinds) (bindsInHsBootFile mbinds)
 184         ; sigs' <- renameSigs okHsBootSig sigs
 185         ; return (ValBindsOut [] sigs', usesOnly (hsSigsFVs sigs')) }
 186
 187 rnTopBindsSrc :: HsValBinds RdrName -> RnM (HsValBinds Name, DefUses)
 188 rnTopBindsSrc binds = rnValBinds noTrim binds
 189 \end{code}
 190
 191
 192
 193 %*********************************************************
 194 %*                                                      *
 195                 HsLocalBinds
 196 %*                                                      *
 197 %*********************************************************
 198
 199 \begin{code}
 200 rnLocalBindsAndThen
 201   :: HsLocalBinds RdrName
 202   -> (HsLocalBinds Name -> RnM (result, FreeVars))
 203   -> RnM (result, FreeVars)
 204 -- This version (a) assumes that the binding vars are not already in scope
 205 --              (b) removes the binders from the free vars of the thing inside
 206 -- The parser doesn't produce ThenBinds
 207 rnLocalBindsAndThen EmptyLocalBinds thing_inside
 208   = thing_inside EmptyLocalBinds
 209
 210 rnLocalBindsAndThen (HsValBinds val_binds) thing_inside
 211   = rnValBindsAndThen val_binds $ \ val_binds' ->
 212     thing_inside (HsValBinds val_binds')
 213
 214 rnLocalBindsAndThen (HsIPBinds binds) thing_inside
 215   = rnIPBinds binds                     `thenM` \ (binds',fv_binds) ->
 216     thing_inside (HsIPBinds binds')     `thenM` \ (thing, fvs_thing) ->
 217     returnM (thing, fvs_thing `plusFV` fv_binds)
 218
 219 -------------
 220 rnIPBinds (IPBinds ip_binds _no_dict_binds)
 221   = do  { (ip_binds', fvs_s) <- mapAndUnzipM (wrapLocFstM rnIPBind) ip_binds
 222         ; return (IPBinds ip_binds' emptyLHsBinds, plusFVs fvs_s) }
 223
 224 rnIPBind (IPBind n expr)
 225   = newIPNameRn  n              `thenM` \ name ->
 226     rnLExpr expr                `thenM` \ (expr',fvExpr) ->
 227     return (IPBind name expr', fvExpr)
 228 \end{code}
 229
 230
 231 %************************************************************************
 232 %*                                                                      *
 233                 ValBinds
 234 %*                                                                      *
 235 %************************************************************************
 236
 237 \begin{code}
 238 rnValBindsAndThen :: HsValBinds RdrName
 239                   -> (HsValBinds Name -> RnM (result, FreeVars))
 240                   -> RnM (result, FreeVars)
 241
 242 rnValBindsAndThen binds@(ValBindsIn mbinds sigs) thing_inside
 243   =     -- Extract all the binders in this group, and extend the
 244         -- current scope, inventing new names for the new binders
 245         -- This also checks that the names form a set
 246     bindLocatedLocalsRn doc mbinders_w_srclocs                  $ \ bndrs ->
 247
 248         -- Then install local fixity declarations
 249         -- Notice that they scope over thing_inside too
 250     bindLocalFixities [sig | L _ (FixSig sig) <- sigs ]         $
 251
 252         -- Do the business
 253     rnValBinds (trimWith bndrs) binds   `thenM` \ (binds, bind_dus) ->
 254
 255         -- Now do the "thing inside"
 256     thing_inside binds                  `thenM` \ (result,result_fvs) ->
 257
 258         -- Final error checking
 259     let
 260         all_uses = duUses bind_dus `plusFV` result_fvs
 261         -- duUses: It's important to return all the uses, not the 'real uses'
 262         -- used for warning about unused bindings.  Otherwise consider:
 263         --      x = 3
 264         --      y = let p = x in 'x'    -- NB: p not used
 265         -- If we don't "see" the dependency of 'y' on 'x', we may put the
 266         -- bindings in the wrong order, and the type checker will complain
 267         -- that x isn't in scope
 268
 269         unused_bndrs = [ b | b <- bndrs, not (b `elemNameSet` all_uses)]
 270     in
 271     warnUnusedLocalBinds unused_bndrs   `thenM_`
 272
 273     returnM (result, delListFromNameSet all_uses bndrs)
 274   where
 275     mbinders_w_srclocs = collectHsBindLocatedBinders mbinds
 276     doc = text "In the binding group for:"
 277           <+> pprWithCommas ppr (map unLoc mbinders_w_srclocs)
 278
 279 ---------------------
 280 rnValBinds :: (FreeVars -> FreeVars)
 281            -> HsValBinds RdrName
 282            -> RnM (HsValBinds Name, DefUses)
 283 -- Assumes the binders of the binding are in scope already
 284
 285 rnValBinds trim (ValBindsIn mbinds sigs)
 286   = do  { sigs' <- rename_sigs sigs
 287
 288         ; binds_w_dus <- mapBagM (rnBind (mkSigTvFn sigs') trim) mbinds
 289
 290         ; let (binds', bind_dus) = depAnalBinds binds_w_dus
 291
 292         -- We do the check-sigs after renaming the bindings,
 293         -- so that we have convenient access to the binders
 294         ; check_sigs (okBindSig (duDefs bind_dus)) sigs'
 295
 296         ; return (ValBindsOut binds' sigs',
 297                   usesOnly (hsSigsFVs sigs') `plusDU` bind_dus) }
 298
 299
 300 ---------------------
 301 depAnalBinds :: Bag (LHsBind Name, [Name], Uses)
 302              -> ([(RecFlag, LHsBinds Name)], DefUses)
 303 -- Dependency analysis; this is important so that
 304 -- unused-binding reporting is accurate
 305 depAnalBinds binds_w_dus
 306   = (map get_binds sccs, map get_du sccs)
 307   where
 308     sccs = stronglyConnComp edges
 309
 310     keyd_nodes = bagToList binds_w_dus `zip` [0::Int ..]
 311
 312     edges = [ (node, key, [key | n <- nameSetToList uses,
 313                                  Just key <- [lookupNameEnv key_map n] ])
 314             | (node@(_,_,uses), key) <- keyd_nodes ]
 315
 316     key_map :: NameEnv Int      -- Which binding it comes from
 317     key_map = mkNameEnv [(bndr, key) | ((_, bndrs, _), key) <- keyd_nodes
 318                                      , bndr <- bndrs ]
 319
 320     get_binds (AcyclicSCC (bind, _, _)) = (NonRecursive, unitBag bind)
 321     get_binds (CyclicSCC  binds_w_dus)  = (Recursive, listToBag [b | (b,d,u) <- binds_w_dus])
 322
 323     get_du (AcyclicSCC (_, bndrs, uses)) = (Just (mkNameSet bndrs), uses)
 324     get_du (CyclicSCC  binds_w_dus)      = (Just defs, uses)
 325         where
 326           defs = mkNameSet [b | (_,bs,_) <- binds_w_dus, b <- bs]
 327           uses = unionManyNameSets [u | (_,_,u) <- binds_w_dus]
 328
 329
 330 ---------------------
 331 -- Bind the top-level forall'd type variables in the sigs.
 332 -- E.g  f :: a -> a
 333 --      f = rhs
 334 --      The 'a' scopes over the rhs
 335 --
 336 -- NB: there'll usually be just one (for a function binding)
 337 --     but if there are many, one may shadow the rest; too bad!
 338 --      e.g  x :: [a] -> [a]
 339 --           y :: [(a,a)] -> a
 340 --           (x,y) = e
 341 --      In e, 'a' will be in scope, and it'll be the one from 'y'!
 342
 343 mkSigTvFn :: [LSig Name] -> (Name -> [Name])
 344 -- Return a lookup function that maps an Id Name to the names
 345 -- of the type variables that should scope over its body..
 346 mkSigTvFn sigs
 347   = \n -> lookupNameEnv env n `orElse` []
 348   where
 349     env :: NameEnv [Name]
 350     env = mkNameEnv [ (name, map hsLTyVarName ltvs)
 351                     | L _ (TypeSig (L _ name)
 352                                    (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs]
 353         -- Note the pattern-match on "Explicit"; we only bind
 354         -- type variables from signatures with an explicit top-level for-all
 355
 356 -- The trimming function trims the free vars we attach to a
 357 -- binding so that it stays reasonably small
 358 noTrim :: FreeVars -> FreeVars
 359 noTrim fvs = fvs        -- Used at top level
 360
 361 trimWith :: [Name] -> FreeVars -> FreeVars
 362 -- Nested bindings; trim by intersection with the names bound here
 363 trimWith bndrs = intersectNameSet (mkNameSet bndrs)
 364
 365 ---------------------
 366 rnBind :: (Name -> [Name])              -- Signature tyvar function
 367        -> (FreeVars -> FreeVars)        -- Trimming function for rhs free vars
 368        -> LHsBind RdrName
 369        -> RnM (LHsBind Name, [Name], Uses)
 370 rnBind sig_fn trim (L loc (PatBind { pat_lhs = pat, pat_rhs = grhss }))
 371   = setSrcSpan loc $
 372     do  { (pat', pat_fvs) <- rnLPat pat
 373
 374         ; let bndrs = collectPatBinders pat'
 375
 376         ; (grhss', fvs) <- rnGRHSs PatBindRhs grhss
 377                 -- No scoped type variables for pattern bindings
 378
 379         ; return (L loc (PatBind { pat_lhs = pat', pat_rhs = grhss',
 380                                    pat_rhs_ty = placeHolderType, bind_fvs = trim fvs }),
 381                   bndrs, pat_fvs `plusFV` fvs) }
 382
 383 rnBind sig_fn trim (L loc (FunBind { fun_id = name, fun_infix = inf, fun_matches = matches }))
 384   = setSrcSpan loc $
 385     do  { new_name <- lookupLocatedBndrRn name
 386         ; let plain_name = unLoc new_name
 387
 388         ; (matches', fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
 389                                 -- bindSigTyVars tests for Opt_ScopedTyVars
 390                              rnMatchGroup (FunRhs plain_name inf) matches
 391
 392         ; checkPrecMatch inf plain_name matches'
 393
 394         ; return (L loc (FunBind { fun_id = new_name, fun_infix = inf, fun_matches = matches',
 395                                    bind_fvs = trim fvs, fun_co_fn = idHsWrapper, fun_tick = Nothing }),
 396                   [plain_name], fvs)
 397       }
 398 \end{code}
 399
 400
 401 @rnMethodBinds@ is used for the method bindings of a class and an instance
 402 declaration.   Like @rnBinds@ but without dependency analysis.
 403
 404 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
 405 That's crucial when dealing with an instance decl:
 406 \begin{verbatim}
 407         instance Foo (T a) where
 408            op x = ...
 409 \end{verbatim}
 410 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
 411 and unless @op@ occurs we won't treat the type signature of @op@ in the class
 412 decl for @Foo@ as a source of instance-decl gates.  But we should!  Indeed,
 413 in many ways the @op@ in an instance decl is just like an occurrence, not
 414 a binder.
 415
 416 \begin{code}
 417 rnMethodBinds :: Name                   -- Class name
 418               -> (Name -> [Name])       -- Signature tyvar function
 419               -> [Name]                 -- Names for generic type variables
 420               -> LHsBinds RdrName
 421               -> RnM (LHsBinds Name, FreeVars)
 422
 423 rnMethodBinds cls sig_fn gen_tyvars binds
 424   = foldM do_one (emptyBag,emptyFVs) (bagToList binds)
 425   where do_one (binds,fvs) bind = do
 426            (bind', fvs_bind) <- rnMethodBind cls sig_fn gen_tyvars bind
 427            return (bind' `unionBags` binds, fvs_bind `plusFV` fvs)
 428
 429 rnMethodBind cls sig_fn gen_tyvars (L loc (FunBind { fun_id = name, fun_infix = inf,
 430                                                      fun_matches = MatchGroup matches _ }))
 431   = setSrcSpan loc $
 432     lookupInstDeclBndr cls name                 `thenM` \ sel_name ->
 433     let plain_name = unLoc sel_name in
 434         -- We use the selector name as the binder
 435
 436     bindSigTyVarsFV (sig_fn plain_name)                 $
 437     mapFvRn (rn_match plain_name) matches               `thenM` \ (new_matches, fvs) ->
 438     let
 439         new_group = MatchGroup new_matches placeHolderType
 440     in
 441     checkPrecMatch inf plain_name new_group             `thenM_`
 442     returnM (unitBag (L loc (FunBind {
 443                                 fun_id = sel_name, fun_infix = inf,
 444                                 fun_matches = new_group,
 445                                 bind_fvs = fvs, fun_co_fn = idHsWrapper,
 446                                 fun_tick = Nothing })),
 447              fvs `addOneFV` plain_name)
 448         -- The 'fvs' field isn't used for method binds
 449   where
 450         -- Truly gruesome; bring into scope the correct members of the generic
 451         -- type variables.  See comments in RnSource.rnSourceDecl(ClassDecl)
 452     rn_match sel_name match@(L _ (Match (L _ (TypePat ty) : _) _ _))
 453         = extendTyVarEnvFVRn gen_tvs    $
 454           rnMatch (FunRhs sel_name inf) match
 455         where
 456           tvs     = map (rdrNameOcc.unLoc) (extractHsTyRdrTyVars ty)
 457           gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs]
 458
 459     rn_match sel_name match = rnMatch (FunRhs sel_name inf) match
 460
 461
 462 -- Can't handle method pattern-bindings which bind multiple methods.
 463 rnMethodBind cls sig_fn gen_tyvars mbind@(L loc (PatBind other_pat _ _ _))
 464   = addLocErr mbind methodBindErr       `thenM_`
 465     returnM (emptyBag, emptyFVs)
 466 \end{code}
 467
 468
 469
 470 %************************************************************************
 471 %*                                                                      *
 472 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
 473 %*                                                                      *
 474 %************************************************************************
 475
 476 @renameSigs@ checks for:
 477 \begin{enumerate}
 478 \item more than one sig for one thing;
 479 \item signatures given for things not bound here;
 480 \item with suitably flaggery, that all top-level things have type signatures.
 481 \end{enumerate}
 482 %
 483 At the moment we don't gather free-var info from the types in
 484 signatures.  We'd only need this if we wanted to report unused tyvars.
 485
 486 \begin{code}
 487 renameSigs :: (LSig Name -> Bool) -> [LSig RdrName] -> RnM [LSig Name]
 488 -- Renames the signatures and performs error checks
 489 renameSigs ok_sig sigs
 490   = do  { sigs' <- rename_sigs sigs
 491         ; check_sigs ok_sig sigs'
 492         ; return sigs' }
 493
 494 ----------------------
 495 rename_sigs :: [LSig RdrName] -> RnM [LSig Name]
 496 rename_sigs sigs = mappM (wrapLocM renameSig)
 497                          (filter (not . isFixityLSig) sigs)
 498                 -- Remove fixity sigs which have been dealt with already
 499
 500 ----------------------
 501 check_sigs :: (LSig Name -> Bool) -> [LSig Name] -> RnM ()
 502 -- Used for class and instance decls, as well as regular bindings
 503 check_sigs ok_sig sigs
 504         -- Check for (a) duplicate signatures
 505         --           (b) signatures for things not in this group
 506   = do  { mappM_ unknownSigErr (filter (not . ok_sig) sigs')
 507         ; mappM_ dupSigDeclErr (findDupsEq eqHsSig sigs') }
 508   where
 509         -- Don't complain about an unbound name again
 510     sigs' = filterOut bad_name sigs
 511     bad_name sig = case sigName sig of
 512                         Just n -> isUnboundName n
 513                         other  -> False
 514
 515 -- We use lookupLocatedSigOccRn in the signatures, which is a little bit unsatisfactory
 516 -- because this won't work for:
 517 --      instance Foo T where
 518 --        {-# INLINE op #-}
 519 --        Baz.op = ...
 520 -- We'll just rename the INLINE prag to refer to whatever other 'op'
 521 -- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
 522 -- Doesn't seem worth much trouble to sort this.
 523
 524 renameSig :: Sig RdrName -> RnM (Sig Name)
 525 -- FixitSig is renamed elsewhere.
 526 renameSig (TypeSig v ty)
 527   = lookupLocatedSigOccRn v                     `thenM` \ new_v ->
 528     rnHsSigType (quotes (ppr v)) ty             `thenM` \ new_ty ->
 529     returnM (TypeSig new_v new_ty)
 530
 531 renameSig (SpecInstSig ty)
 532   = rnLHsType (text "A SPECIALISE instance pragma") ty `thenM` \ new_ty ->
 533     returnM (SpecInstSig new_ty)
 534
 535 renameSig (SpecSig v ty inl)
 536   = lookupLocatedSigOccRn v             `thenM` \ new_v ->
 537     rnHsSigType (quotes (ppr v)) ty     `thenM` \ new_ty ->
 538     returnM (SpecSig new_v new_ty inl)
 539
 540 renameSig (InlineSig v s)
 541   = lookupLocatedSigOccRn v             `thenM` \ new_v ->
 542     returnM (InlineSig new_v s)
 543 \end{code}
 544
 545
 546 ************************************************************************
 547 *                                                                       *
 548 \subsection{Match}
 549 *                                                                       *
 550 ************************************************************************
 551
 552 \begin{code}
 553 rnMatchGroup :: HsMatchContext Name -> MatchGroup RdrName -> RnM (MatchGroup Name, FreeVars)
 554 rnMatchGroup ctxt (MatchGroup ms _)
 555   = mapFvRn (rnMatch ctxt) ms   `thenM` \ (new_ms, ms_fvs) ->
 556     returnM (MatchGroup new_ms placeHolderType, ms_fvs)
 557
 558 rnMatch :: HsMatchContext Name -> LMatch RdrName -> RnM (LMatch Name, FreeVars)
 559 rnMatch ctxt  = wrapLocFstM (rnMatch' ctxt)
 560
 561 rnMatch' ctxt match@(Match pats maybe_rhs_sig grhss)
 562   =
 563         -- Deal with the rhs type signature
 564     bindPatSigTyVarsFV rhs_sig_tys      $
 565     doptM Opt_PatternSignatures `thenM` \ opt_PatternSignatures ->
 566     (case maybe_rhs_sig of
 567         Nothing -> returnM (Nothing, emptyFVs)
 568         Just ty | opt_PatternSignatures -> rnHsTypeFVs doc_sig ty       `thenM` \ (ty', ty_fvs) ->
 569                                      returnM (Just ty', ty_fvs)
 570                 | otherwise       -> addLocErr ty patSigErr     `thenM_`
 571                                      returnM (Nothing, emptyFVs)
 572     )                                   `thenM` \ (maybe_rhs_sig', ty_fvs) ->
 573
 574         -- Now the main event
 575     rnPatsAndThen ctxt pats     $ \ pats' ->
 576     rnGRHSs ctxt grhss          `thenM` \ (grhss', grhss_fvs) ->
 577
 578     returnM (Match pats' maybe_rhs_sig' grhss', grhss_fvs `plusFV` ty_fvs)
 579         -- The bindPatSigTyVarsFV and rnPatsAndThen will remove the bound FVs
 580   where
 581      rhs_sig_tys =  case maybe_rhs_sig of
 582                         Nothing -> []
 583                         Just ty -> [ty]
 584      doc_sig = text "In a result type-signature"
 585 \end{code}
 586
 587
 588 %************************************************************************
 589 %*                                                                      *
 590 \subsubsection{Guarded right-hand sides (GRHSs)}
 591 %*                                                                      *
 592 %************************************************************************
 593
 594 \begin{code}
 595 rnGRHSs :: HsMatchContext Name -> GRHSs RdrName -> RnM (GRHSs Name, FreeVars)
 596
 597 rnGRHSs ctxt (GRHSs grhss binds)
 598   = rnLocalBindsAndThen binds   $ \ binds' ->
 599     mapFvRn (rnGRHS ctxt) grhss `thenM` \ (grhss', fvGRHSs) ->
 600     returnM (GRHSs grhss' binds', fvGRHSs)
 601
 602 rnGRHS :: HsMatchContext Name -> LGRHS RdrName -> RnM (LGRHS Name, FreeVars)
 603 rnGRHS ctxt = wrapLocFstM (rnGRHS' ctxt)
 604
 605 rnGRHS' ctxt (GRHS guards rhs)
 606   = do  { pattern_guards_allowed <- doptM Opt_PatternGuards
 607         ; ((guards', rhs'), fvs) <- rnStmts (PatGuard ctxt) guards $
 608                                     rnLExpr rhs
 609
 610         ; checkM (pattern_guards_allowed || is_standard_guard guards')
 611                  (addWarn (nonStdGuardErr guards'))
 612
 613         ; return (GRHS guards' rhs', fvs) }
 614   where
 615         -- Standard Haskell 1.4 guards are just a single boolean
 616         -- expression, rather than a list of qualifiers as in the
 617         -- Glasgow extension
 618     is_standard_guard []                     = True
 619     is_standard_guard [L _ (ExprStmt _ _ _)] = True
 620     is_standard_guard other                  = False
 621 \end{code}
 622
 623 %************************************************************************
 624 %*                                                                      *
 625 \subsection{Error messages}
 626 %*                                                                      *
 627 %************************************************************************
 628
 629 \begin{code}
 630 dupSigDeclErr sigs@(L loc sig : _)
 631   = addErrAt loc $
 632         vcat [ptext SLIT("Duplicate") <+> what_it_is <> colon,
 633               nest 2 (vcat (map ppr_sig sigs))]
 634   where
 635     what_it_is = hsSigDoc sig
 636     ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig
 637
 638 unknownSigErr (L loc sig)
 639   = do  { mod <- getModule
 640         ; addErrAt loc $
 641                 vcat [sep [ptext SLIT("Misplaced") <+> what_it_is <> colon, ppr sig],
 642                       extra_stuff mod sig] }
 643   where
 644     what_it_is = hsSigDoc sig
 645     extra_stuff mod  (TypeSig (L _ n) _)
 646         | nameIsLocalOrFrom mod n
 647         = ptext SLIT("The type signature must be given where")
 648                 <+> quotes (ppr n) <+> ptext SLIT("is declared")
 649         | otherwise
 650         = ptext SLIT("You cannot give a type signature for an imported value")
 651
 652     extra_stuff mod other = empty
 653
 654 methodBindErr mbind
 655  =  hang (ptext SLIT("Pattern bindings (except simple variables) not allowed in instance declarations"))
 656        2 (ppr mbind)
 657
 658 bindsInHsBootFile mbinds
 659   = hang (ptext SLIT("Bindings in hs-boot files are not allowed"))
 660        2 (ppr mbinds)
 661
 662 nonStdGuardErr guards
 663   = hang (ptext SLIT("accepting non-standard pattern guards (use -XPatternGuards to suppress this message)"))
 664        4 (interpp'SP guards)
 665 \end{code}