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