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