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