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, rnBinds, rnBindsAndThen,
  14         rnMethodBinds, renameSigs, checkSigs
  15    ) where
  16
  17 #include "HsVersions.h"
  18
  19
  20 import HsSyn
  21 import HsBinds          ( hsSigDoc, eqHsSig )
  22 import RdrHsSyn
  23 import RnHsSyn
  24 import TcRnMonad
  25 import RnTypes          ( rnHsSigType, rnLHsType, rnLPat )
  26 import RnExpr           ( rnMatch, rnGRHSs, checkPrecMatch )
  27 import RnEnv            ( bindLocatedLocalsRn, lookupLocatedBndrRn,
  28                           lookupLocatedInstDeclBndr,
  29                           lookupLocatedSigOccRn, bindPatSigTyVars, bindPatSigTyVarsFV,
  30                           bindLocalFixities,
  31                           warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
  32                         )
  33 import CmdLineOpts      ( DynFlag(..) )
  34 import Digraph          ( SCC(..), stronglyConnComp )
  35 import Name             ( Name, nameOccName, nameSrcLoc )
  36 import NameSet
  37 import PrelNames        ( isUnboundName )
  38 import RdrName          ( RdrName, rdrNameOcc )
  39 import BasicTypes       ( RecFlag(..), TopLevelFlag(..), isTopLevel )
  40 import List             ( unzip4 )
  41 import SrcLoc           ( mkSrcSpan, Located(..), unLoc )
  42 import Bag
  43 import Outputable
  44
  45 import Monad            ( foldM )
  46 \end{code}
  47
  48 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
  49 -- place and can be used when complaining.
  50
  51 The code tree received by the function @rnBinds@ contains definitions
  52 in where-clauses which are all apparently mutually recursive, but which may
  53 not really depend upon each other. For example, in the top level program
  54 \begin{verbatim}
  55 f x = y where a = x
  56               y = x
  57 \end{verbatim}
  58 the definitions of @a@ and @y@ do not depend on each other at all.
  59 Unfortunately, the typechecker cannot always check such definitions.
  60 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
  61 definitions. In Proceedings of the International Symposium on Programming,
  62 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
  63 However, the typechecker usually can check definitions in which only the
  64 strongly connected components have been collected into recursive bindings.
  65 This is precisely what the function @rnBinds@ does.
  66
  67 ToDo: deal with case where a single monobinds binds the same variable
  68 twice.
  69
  70 The vertag tag is a unique @Int@; the tags only need to be unique
  71 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
  72 (heavy monad machinery not needed).
  73
  74
  75 %************************************************************************
  76 %*                                                                      *
  77 %* naming conventions                                                   *
  78 %*                                                                      *
  79 %************************************************************************
  80
  81 \subsection[name-conventions]{Name conventions}
  82
  83 The basic algorithm involves walking over the tree and returning a tuple
  84 containing the new tree plus its free variables. Some functions, such
  85 as those walking polymorphic bindings (HsBinds) and qualifier lists in
  86 list comprehensions (@Quals@), return the variables bound in local
  87 environments. These are then used to calculate the free variables of the
  88 expression evaluated in these environments.
  89
  90 Conventions for variable names are as follows:
  91 \begin{itemize}
  92 \item
  93 new code is given a prime to distinguish it from the old.
  94
  95 \item
  96 a set of variables defined in @Exp@ is written @dvExp@
  97
  98 \item
  99 a set of variables free in @Exp@ is written @fvExp@
 100 \end{itemize}
 101
 102 %************************************************************************
 103 %*                                                                      *
 104 %* analysing polymorphic bindings (HsBindGroup, HsBind)
 105 %*                                                                      *
 106 %************************************************************************
 107
 108 \subsubsection[dep-HsBinds]{Polymorphic bindings}
 109
 110 Non-recursive expressions are reconstructed without any changes at top
 111 level, although their component expressions may have to be altered.
 112 However, non-recursive expressions are currently not expected as
 113 \Haskell{} programs, and this code should not be executed.
 114
 115 Monomorphic bindings contain information that is returned in a tuple
 116 (a @FlatMonoBinds@) containing:
 117
 118 \begin{enumerate}
 119 \item
 120 a unique @Int@ that serves as the ``vertex tag'' for this binding.
 121
 122 \item
 123 the name of a function or the names in a pattern. These are a set
 124 referred to as @dvLhs@, the defined variables of the left hand side.
 125
 126 \item
 127 the free variables of the body. These are referred to as @fvBody@.
 128
 129 \item
 130 the definition's actual code. This is referred to as just @code@.
 131 \end{enumerate}
 132
 133 The function @nonRecDvFv@ returns two sets of variables. The first is
 134 the set of variables defined in the set of monomorphic bindings, while the
 135 second is the set of free variables in those bindings.
 136
 137 The set of variables defined in a non-recursive binding is just the
 138 union of all of them, as @union@ removes duplicates. However, the
 139 free variables in each successive set of cumulative bindings is the
 140 union of those in the previous set plus those of the newest binding after
 141 the defined variables of the previous set have been removed.
 142
 143 @rnMethodBinds@ deals only with the declarations in class and
 144 instance declarations.  It expects only to see @FunMonoBind@s, and
 145 it expects the global environment to contain bindings for the binders
 146 (which are all class operations).
 147
 148 %************************************************************************
 149 %*                                                                      *
 150 \subsubsection{ Top-level bindings}
 151 %*                                                                      *
 152 %************************************************************************
 153
 154 @rnTopMonoBinds@ assumes that the environment already
 155 contains bindings for the binders of this particular binding.
 156
 157 \begin{code}
 158 rnTopBinds :: Bag (LHsBind RdrName)
 159            -> [LSig RdrName]
 160            -> RnM ([HsBindGroup Name], DefUses)
 161
 162 -- The binders of the binding are in scope already;
 163 -- the top level scope resolution does that
 164
 165 rnTopBinds mbinds sigs
 166  =  bindPatSigTyVars (collectSigTysFromHsBinds (bagToList mbinds)) $ \ _ ->
 167         -- Hmm; by analogy with Ids, this doesn't look right
 168         -- Top-level bound type vars should really scope over
 169         -- everything, but we only scope them over the other bindings
 170
 171     rnBinds TopLevel mbinds sigs
 172 \end{code}
 173
 174
 175 %************************************************************************
 176 %*                                                                      *
 177 %*              Nested binds
 178 %*                                                                      *
 179 %************************************************************************
 180
 181 \begin{code}
 182 rnBindsAndThen :: Bag (LHsBind RdrName)
 183                -> [LSig RdrName]
 184                -> ([HsBindGroup Name] -> RnM (result, FreeVars))
 185                -> RnM (result, FreeVars)
 186
 187 rnBindsAndThen mbinds sigs thing_inside
 188   =     -- Extract all the binders in this group, and extend the
 189         -- current scope, inventing new names for the new binders
 190         -- This also checks that the names form a set
 191     bindLocatedLocalsRn doc mbinders_w_srclocs                  $ \ _ ->
 192     bindPatSigTyVarsFV (collectSigTysFromHsBinds (bagToList mbinds))    $
 193
 194         -- Then install local fixity declarations
 195         -- Notice that they scope over thing_inside too
 196     bindLocalFixities [sig | L _ (FixSig sig) <- sigs ]         $
 197
 198         -- Do the business
 199     rnBinds NotTopLevel mbinds sigs     `thenM` \ (binds, bind_dus) ->
 200
 201         -- Now do the "thing inside"
 202     thing_inside binds                  `thenM` \ (result,result_fvs) ->
 203
 204         -- Final error checking
 205     let
 206         all_uses     = duUses bind_dus `plusFV` result_fvs
 207         bndrs        = duDefs bind_dus
 208         unused_bndrs = nameSetToList (bndrs `minusNameSet` all_uses)
 209     in
 210     warnUnusedLocalBinds unused_bndrs   `thenM_`
 211
 212     returnM (result, all_uses `minusNameSet` bndrs)
 213         -- duUses: It's important to return all the uses, not the 'real uses' used for
 214         -- warning about unused bindings.  Otherwise consider:
 215         --      x = 3
 216         --      y = let p = x in 'x'    -- NB: p not used
 217         -- If we don't "see" the dependency of 'y' on 'x', we may put the
 218         -- bindings in the wrong order, and the type checker will complain
 219         -- that x isn't in scope
 220   where
 221     mbinders_w_srclocs = collectHsBindLocatedBinders mbinds
 222     doc = text "In the binding group for:"
 223           <+> pprWithCommas ppr (map unLoc mbinders_w_srclocs)
 224 \end{code}
 225
 226
 227 %************************************************************************
 228 %*                                                                      *
 229 \subsubsection{rnBinds -- the main work is done here}
 230 %*                                                                      *
 231 %************************************************************************
 232
 233 @rnMonoBinds@ is used by {\em both} top-level and nested bindings.
 234 It assumes that all variables bound in this group are already in scope.
 235 This is done {\em either} by pass 3 (for the top-level bindings),
 236 {\em or} by @rnMonoBinds@ (for the nested ones).
 237
 238 \begin{code}
 239 rnBinds :: TopLevelFlag
 240         -> Bag (LHsBind RdrName)
 241         -> [LSig RdrName]
 242         -> RnM ([HsBindGroup Name], DefUses)
 243
 244 -- Assumes the binders of the binding are in scope already
 245
 246 rnBinds top_lvl mbinds sigs
 247  =  renameSigs sigs                     `thenM` \ siglist ->
 248
 249          -- Rename the bindings, returning a [HsBindVertex]
 250          -- which is a list of indivisible vertices so far as
 251          -- the strongly-connected-components (SCC) analysis is concerned
 252     mkBindVertices siglist mbinds       `thenM` \ mbinds_info ->
 253
 254          -- Do the SCC analysis
 255     let
 256         scc_result  = rnSCC mbinds_info
 257         (groups, bind_dus_s) = unzip (map reconstructCycle scc_result)
 258         bind_dus    = mkDUs bind_dus_s
 259         binders     = duDefs bind_dus
 260     in
 261         -- Check for duplicate or mis-placed signatures
 262     checkSigs (okBindSig binders) siglist       `thenM_`
 263
 264         -- Warn about missing signatures,
 265         -- but only at top level, and not in interface mode
 266         -- (The latter is important when renaming bindings from 'deriving' clauses.)
 267     doptM Opt_WarnMissingSigs           `thenM` \ warn_missing_sigs ->
 268     (if isTopLevel top_lvl &&
 269          warn_missing_sigs
 270      then let
 271             type_sig_vars   = [ unLoc n | L _ (Sig n _) <- siglist]
 272             un_sigd_binders = filter (not . (`elem` type_sig_vars))
 273                                      (nameSetToList binders)
 274           in
 275           mappM_ missingSigWarn un_sigd_binders
 276      else
 277         returnM ()
 278     )                                           `thenM_`
 279
 280     returnM (groups, bind_dus `plusDU` usesOnly (hsSigsFVs siglist))
 281 \end{code}
 282
 283 @mkBindVertices@ is ever-so-slightly magical in that it sticks
 284 unique ``vertex tags'' on its output; minor plumbing required.
 285
 286 \begin{code}
 287 mkBindVertices :: [LSig Name]           -- Signatures
 288                -> Bag (LHsBind RdrName)
 289                -> RnM [BindVertex]
 290 mkBindVertices sigs = mapM (mkBindVertex sigs) . bagToList
 291
 292 mkBindVertex :: [LSig Name] -> LHsBind RdrName -> RnM BindVertex
 293 mkBindVertex sigs (L loc (PatBind pat grhss))
 294   = addSrcSpan loc $
 295     rnLPat pat                          `thenM` \ (pat', pat_fvs) ->
 296
 297          -- Find which things are bound in this group
 298     let
 299         names_bound_here = mkNameSet (collectPatBinders pat')
 300     in
 301     sigsForMe names_bound_here sigs     `thenM` \ sigs_for_me ->
 302     rnGRHSs PatBindRhs grhss            `thenM` \ (grhss', fvs) ->
 303     returnM
 304         (names_bound_here, fvs `plusFV` pat_fvs,
 305           L loc (PatBind pat' grhss'), sigs_for_me
 306         )
 307
 308 mkBindVertex sigs (L loc (FunBind name inf matches))
 309   = addSrcSpan loc $
 310     lookupLocatedBndrRn name                            `thenM` \ new_name ->
 311     let
 312         plain_name = unLoc new_name
 313         names_bound_here = unitNameSet plain_name
 314     in
 315     sigsForMe names_bound_here sigs                     `thenM` \ sigs_for_me ->
 316     mapFvRn (rnMatch (FunRhs plain_name)) matches       `thenM` \ (new_matches, fvs) ->
 317     mappM_ (checkPrecMatch inf plain_name) new_matches  `thenM_`
 318     returnM
 319       (unitNameSet plain_name, fvs,
 320         L loc (FunBind new_name inf new_matches), sigs_for_me
 321       )
 322
 323 sigsForMe names_bound_here sigs
 324   = foldlM check [] (filter (sigForThisGroup names_bound_here) sigs)
 325   where
 326         -- sigForThisGroup only returns signatures for
 327         -- which sigName returns a Just
 328     eq sig1 sig2 = eqHsSig (unLoc sig1) (unLoc sig2)
 329
 330     check sigs sig = case filter (eq sig) sigs of
 331                         []    -> returnM (sig:sigs)
 332                         other -> dupSigDeclErr sig other        `thenM_`
 333                                  returnM sigs
 334 \end{code}
 335
 336
 337 @rnMethodBinds@ is used for the method bindings of a class and an instance
 338 declaration.   Like @rnBinds@ but without dependency analysis.
 339
 340 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
 341 That's crucial when dealing with an instance decl:
 342 \begin{verbatim}
 343         instance Foo (T a) where
 344            op x = ...
 345 \end{verbatim}
 346 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
 347 and unless @op@ occurs we won't treat the type signature of @op@ in the class
 348 decl for @Foo@ as a source of instance-decl gates.  But we should!  Indeed,
 349 in many ways the @op@ in an instance decl is just like an occurrence, not
 350 a binder.
 351
 352 \begin{code}
 353 rnMethodBinds :: Name                   -- Class name
 354               -> [Name]                 -- Names for generic type variables
 355               -> (LHsBinds RdrName)
 356               -> RnM (LHsBinds Name, FreeVars)
 357
 358 rnMethodBinds cls gen_tyvars binds
 359   = foldM do_one (emptyBag,emptyFVs) (bagToList binds)
 360   where do_one (binds,fvs) bind = do
 361            (bind', fvs_bind) <- rnMethodBind cls gen_tyvars bind
 362            return (bind' `unionBags` binds, fvs_bind `plusFV` fvs)
 363
 364
 365 rnMethodBind cls gen_tyvars (L loc (FunBind name inf matches))
 366   =  addSrcSpan loc $
 367      lookupLocatedInstDeclBndr cls name                 `thenM` \ sel_name ->
 368      let plain_name = unLoc sel_name in
 369         -- We use the selector name as the binder
 370
 371     mapFvRn (rn_match plain_name) matches               `thenM` \ (new_matches, fvs) ->
 372     mappM_ (checkPrecMatch inf plain_name) new_matches  `thenM_`
 373     returnM (unitBag (L loc (FunBind sel_name inf new_matches)), fvs `addOneFV` plain_name)
 374   where
 375         -- Gruesome; bring into scope the correct members of the generic type variables
 376         -- See comments in RnSource.rnSourceDecl(ClassDecl)
 377     rn_match sel_name match@(L _ (Match (L _ (TypePat ty) : _) _ _))
 378         = extendTyVarEnvFVRn gen_tvs    $
 379           rnMatch (FunRhs sel_name) match
 380         where
 381           tvs     = map (rdrNameOcc.unLoc) (extractHsTyRdrTyVars ty)
 382           gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs]
 383
 384     rn_match sel_name match = rnMatch (FunRhs sel_name) match
 385
 386
 387 -- Can't handle method pattern-bindings which bind multiple methods.
 388 rnMethodBind cls gen_tyvars mbind@(L loc (PatBind other_pat _))
 389   = addLocErr mbind methodBindErr       `thenM_`
 390     returnM (emptyBag, emptyFVs)
 391 \end{code}
 392
 393
 394 %************************************************************************
 395 %*                                                                      *
 396         Strongly connected components
 397 %*                                                                      *
 398 %************************************************************************
 399
 400 \begin{code}
 401 type BindVertex = (Defs, Uses, LHsBind Name, [LSig Name])
 402                         -- Signatures, if any, for this vertex
 403
 404 rnSCC :: [BindVertex] -> [SCC BindVertex]
 405 rnSCC nodes = stronglyConnComp (mkEdges nodes)
 406
 407 type VertexTag  = Int
 408
 409 mkEdges :: [BindVertex] -> [(BindVertex, VertexTag, [VertexTag])]
 410         -- We keep the uses with the binding,
 411         -- so we can track unused bindings better
 412 mkEdges nodes
 413   = [ (thing, tag, dest_vertices uses)
 414     | (thing@(_, uses, _, _), tag) <- tagged_nodes
 415     ]
 416   where
 417     tagged_nodes = nodes `zip` [0::VertexTag ..]
 418
 419          -- An edge (v,v') indicates that v depends on v'
 420     dest_vertices uses = [ target_vertex
 421                          | ((defs, _, _, _), target_vertex) <- tagged_nodes,
 422                            defs `intersectsNameSet` uses
 423                          ]
 424
 425 reconstructCycle :: SCC BindVertex -> (HsBindGroup Name, (Defs,Uses))
 426 reconstructCycle (AcyclicSCC (defs, uses, bind, sigs))
 427   = (HsBindGroup (unitBag bind) sigs NonRecursive, (defs, uses))
 428 reconstructCycle (CyclicSCC cycle)
 429   = (HsBindGroup this_gp_binds this_gp_sigs Recursive,
 430      (unionManyNameSets defs_s, unionManyNameSets uses_s))
 431   where
 432     (defs_s, uses_s, binds_s, sigs_s) = unzip4 cycle
 433     this_gp_binds = listToBag binds_s
 434     this_gp_sigs  = foldr1 (++) sigs_s
 435 \end{code}
 436
 437
 438 %************************************************************************
 439 %*                                                                      *
 440 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
 441 %*                                                                      *
 442 %************************************************************************
 443
 444 @renameSigs@ checks for:
 445 \begin{enumerate}
 446 \item more than one sig for one thing;
 447 \item signatures given for things not bound here;
 448 \item with suitably flaggery, that all top-level things have type signatures.
 449 \end{enumerate}
 450 %
 451 At the moment we don't gather free-var info from the types in
 452 signatures.  We'd only need this if we wanted to report unused tyvars.
 453
 454 \begin{code}
 455 checkSigs :: (LSig Name -> Bool)        -- OK-sig predicbate
 456           -> [LSig Name]
 457           -> RnM ()
 458 checkSigs ok_sig sigs
 459         -- Check for (a) duplicate signatures
 460         --           (b) signatures for things not in this group
 461         -- Well, I can't see the check for (a)... ToDo!
 462   = mappM_ unknownSigErr (filter bad sigs)
 463   where
 464     bad sig = not (ok_sig sig) &&
 465               case sigName sig of
 466                 Just n | isUnboundName n -> False
 467                                 -- Don't complain about an unbound name again
 468                 other                    -> True
 469
 470 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
 471 -- because this won't work for:
 472 --      instance Foo T where
 473 --        {-# INLINE op #-}
 474 --        Baz.op = ...
 475 -- We'll just rename the INLINE prag to refer to whatever other 'op'
 476 -- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
 477 -- Doesn't seem worth much trouble to sort this.
 478
 479 renameSigs :: [LSig RdrName] -> RnM [LSig Name]
 480 renameSigs sigs = mappM (wrapLocM renameSig) (filter (not . isFixitySig . unLoc) sigs)
 481         -- Remove fixity sigs which have been dealt with already
 482
 483 renameSig :: Sig RdrName -> RnM (Sig Name)
 484 -- FixitSig is renamed elsewhere.
 485 renameSig (Sig v ty)
 486   = lookupLocatedSigOccRn v                     `thenM` \ new_v ->
 487     rnHsSigType (quotes (ppr v)) ty             `thenM` \ new_ty ->
 488     returnM (Sig new_v new_ty)
 489
 490 renameSig (SpecInstSig ty)
 491   = rnLHsType (text "A SPECIALISE instance pragma") ty `thenM` \ new_ty ->
 492     returnM (SpecInstSig new_ty)
 493
 494 renameSig (SpecSig v ty)
 495   = lookupLocatedSigOccRn v             `thenM` \ new_v ->
 496     rnHsSigType (quotes (ppr v)) ty     `thenM` \ new_ty ->
 497     returnM (SpecSig new_v new_ty)
 498
 499 renameSig (InlineSig b v p)
 500   = lookupLocatedSigOccRn v             `thenM` \ new_v ->
 501     returnM (InlineSig b new_v p)
 502 \end{code}
 503
 504
 505 %************************************************************************
 506 %*                                                                      *
 507 \subsection{Error messages}
 508 %*                                                                      *
 509 %************************************************************************
 510
 511 \begin{code}
 512 dupSigDeclErr (L loc sig) sigs
 513   = addErrAt loc $
 514         vcat [ptext SLIT("Duplicate") <+> what_it_is <> colon,
 515               nest 2 (vcat (map ppr_sig (L loc sig:sigs)))]
 516   where
 517     what_it_is = hsSigDoc sig
 518     ppr_sig (L loc sig) = ppr loc <> colon <+> ppr sig
 519
 520 unknownSigErr (L loc sig)
 521   = addErrAt loc $
 522         sep [ptext SLIT("Misplaced") <+> what_it_is <> colon, ppr sig]
 523   where
 524     what_it_is = hsSigDoc sig
 525
 526 missingSigWarn var
 527   = addWarnAt (mkSrcSpan loc loc) $
 528       sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)]
 529   where
 530     loc = nameSrcLoc var  -- TODO: make a proper span
 531
 532 methodBindErr mbind
 533  =  hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))
 534        4 (ppr mbind)
 535 \end{code}