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         all_uses     = duUses bind_dus `plusFV` result_fvs
 201         bndrs        = duDefs bind_dus
 202         real_uses    = findUses bind_dus result_fvs
 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     getModeRn                           `thenM` \ mode ->
 264     doptM Opt_WarnMissingSigs           `thenM` \ warn_missing_sigs ->
 265     (if isTopLevel top_lvl &&
 266          warn_missing_sigs &&
 267          not (isInterfaceMode mode)
 268      then let
 269             type_sig_vars   = [n | Sig n _ _ <- siglist]
 270             un_sigd_binders = filter (not . (`elem` type_sig_vars))
 271                                      (nameSetToList binders)
 272           in
 273           mappM_ missingSigWarn un_sigd_binders
 274      else
 275         returnM ()
 276     )                                           `thenM_`
 277
 278     returnM (final_binds, bind_dus `plusDU` usesOnly (hsSigsFVs siglist))
 279 \end{code}
 280
 281 @flattenMonoBinds@ is ever-so-slightly magical in that it sticks
 282 unique ``vertex tags'' on its output; minor plumbing required.
 283
 284 \begin{code}
 285 flattenMonoBinds :: [RenamedSig]                -- Signatures
 286                  -> RdrNameMonoBinds
 287                  -> RnM [FlatMonoBinds]
 288
 289 flattenMonoBinds sigs EmptyMonoBinds = returnM []
 290
 291 flattenMonoBinds sigs (AndMonoBinds bs1 bs2)
 292   = flattenMonoBinds sigs bs1   `thenM` \ flat1 ->
 293     flattenMonoBinds sigs bs2   `thenM` \ flat2 ->
 294     returnM (flat1 ++ flat2)
 295
 296 flattenMonoBinds sigs (PatMonoBind pat grhss locn)
 297   = addSrcLoc locn                      $
 298     rnPat pat                           `thenM` \ (pat', pat_fvs) ->
 299
 300          -- Find which things are bound in this group
 301     let
 302         names_bound_here = mkNameSet (collectPatBinders pat')
 303     in
 304     sigsForMe names_bound_here sigs     `thenM` \ sigs_for_me ->
 305     rnGRHSs PatBindRhs grhss            `thenM` \ (grhss', fvs) ->
 306     returnM
 307         [(names_bound_here, fvs `plusFV` pat_fvs,
 308           PatMonoBind pat' grhss' locn, sigs_for_me
 309         )]
 310
 311 flattenMonoBinds sigs (FunMonoBind name inf matches locn)
 312   = addSrcLoc locn                                      $
 313     lookupBndrRn name                                   `thenM` \ new_name ->
 314     let
 315         names_bound_here = unitNameSet new_name
 316     in
 317     sigsForMe names_bound_here sigs                     `thenM` \ sigs_for_me ->
 318     mapFvRn (rnMatch (FunRhs new_name)) matches         `thenM` \ (new_matches, fvs) ->
 319     mappM_ (checkPrecMatch inf new_name) new_matches    `thenM_`
 320     returnM
 321       [(unitNameSet new_name, fvs,
 322         FunMonoBind new_name inf new_matches locn, sigs_for_me
 323       )]
 324
 325
 326 sigsForMe names_bound_here sigs
 327   = foldlM check [] (filter (sigForThisGroup names_bound_here) sigs)
 328   where
 329     check sigs sig = case filter (eqHsSig sig) sigs of
 330                         []    -> returnM (sig:sigs)
 331                         other -> dupSigDeclErr sig      `thenM_`
 332                                  returnM sigs
 333 \end{code}
 334
 335
 336 @rnMethodBinds@ is used for the method bindings of a class and an instance
 337 declaration.   Like @rnMonoBinds@ but without dependency analysis.
 338
 339 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
 340 That's crucial when dealing with an instance decl:
 341 \begin{verbatim}
 342         instance Foo (T a) where
 343            op x = ...
 344 \end{verbatim}
 345 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
 346 and unless @op@ occurs we won't treat the type signature of @op@ in the class
 347 decl for @Foo@ as a source of instance-decl gates.  But we should!  Indeed,
 348 in many ways the @op@ in an instance decl is just like an occurrence, not
 349 a binder.
 350
 351 \begin{code}
 352 rnMethodBinds :: Name                   -- Class name
 353               -> [Name]                 -- Names for generic type variables
 354               -> RdrNameMonoBinds
 355               -> RnM (RenamedMonoBinds, FreeVars)
 356
 357 rnMethodBinds cls gen_tyvars EmptyMonoBinds = returnM (EmptyMonoBinds, emptyFVs)
 358
 359 rnMethodBinds cls gen_tyvars (AndMonoBinds mb1 mb2)
 360   = rnMethodBinds cls gen_tyvars mb1    `thenM` \ (mb1', fvs1) ->
 361     rnMethodBinds cls gen_tyvars mb2    `thenM` \ (mb2', fvs2) ->
 362     returnM (mb1' `AndMonoBinds` mb2', fvs1 `plusFV` fvs2)
 363
 364 rnMethodBinds cls gen_tyvars (FunMonoBind name inf matches locn)
 365   = addSrcLoc locn                                      $
 366
 367     lookupInstDeclBndr cls name                         `thenM` \ sel_name ->
 368         -- We use the selector name as the binder
 369
 370     mapFvRn (rn_match sel_name) matches                 `thenM` \ (new_matches, fvs) ->
 371     mappM_ (checkPrecMatch inf sel_name) new_matches    `thenM_`
 372     returnM (FunMonoBind sel_name inf new_matches locn, fvs `addOneFV` sel_name)
 373   where
 374         -- Gruesome; bring into scope the correct members of the generic type variables
 375         -- See comments in RnSource.rnSourceDecl(ClassDecl)
 376     rn_match sel_name match@(Match (TypePat ty : _) _ _)
 377         = extendTyVarEnvFVRn gen_tvs    $
 378           rnMatch (FunRhs sel_name) match
 379         where
 380           tvs     = map rdrNameOcc (extractHsTyRdrNames ty)
 381           gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs]
 382
 383     rn_match sel_name match = rnMatch (FunRhs sel_name) match
 384
 385
 386 -- Can't handle method pattern-bindings which bind multiple methods.
 387 rnMethodBinds cls gen_tyvars mbind@(PatMonoBind other_pat _ locn)
 388   = addSrcLoc locn (addErr (methodBindErr mbind))       `thenM_`
 389     returnM (EmptyMonoBinds, emptyFVs)
 390 \end{code}
 391
 392
 393 %************************************************************************
 394 %*                                                                      *
 395         Strongly connected components
 396
 397 %*                                                                      *
 398 %************************************************************************
 399
 400 During analysis a @MonoBinds@ is flattened to a @FlatMonoBinds@.
 401 The @RenamedMonoBinds@ is always an empty bind, a pattern binding or
 402 a function binding, and has itself been dependency-analysed and
 403 renamed.
 404
 405 \begin{code}
 406 type FlatMonoBinds = (Defs, Uses, RenamedMonoBinds, [RenamedSig])
 407                         -- Signatures, if any, for this vertex
 408
 409 rnSCC :: [FlatMonoBinds] -> [SCC FlatMonoBinds]
 410 rnSCC nodes = stronglyConnComp (mkEdges nodes)
 411
 412 type VertexTag  = Int
 413
 414 mkEdges :: [FlatMonoBinds] -> [(FlatMonoBinds, VertexTag, [VertexTag])]
 415         -- We keep the uses with the binding,
 416         -- so we can track unused bindings better
 417 mkEdges nodes
 418   = [ (thing, tag, dest_vertices uses)
 419     | (thing@(_, uses, _, _), tag) <- tagged_nodes
 420     ]
 421   where
 422     tagged_nodes = nodes `zip` [0::VertexTag ..]
 423
 424          -- An edge (v,v') indicates that v depends on v'
 425     dest_vertices uses = [ target_vertex
 426                          | ((defs, _, _, _), target_vertex) <- tagged_nodes,
 427                            defs `intersectsNameSet` uses
 428                          ]
 429
 430 reconstructCycle :: SCC FlatMonoBinds -> (RenamedHsBinds, (Defs,Uses))
 431 reconstructCycle (AcyclicSCC (defs, uses, binds, sigs))
 432   = (MonoBind binds sigs NonRecursive, (defs, uses))
 433 reconstructCycle (CyclicSCC cycle)
 434   = (MonoBind this_gp_binds this_gp_sigs Recursive,
 435      (unionManyNameSets defs_s, unionManyNameSets uses_s))
 436   where
 437     (defs_s, uses_s, binds_s, sigs_s) = unzip4 cycle
 438     this_gp_binds = foldr1 AndMonoBinds binds_s
 439     this_gp_sigs  = foldr1 (++)         sigs_s
 440 \end{code}
 441
 442
 443 %************************************************************************
 444 %*                                                                      *
 445 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
 446 %*                                                                      *
 447 %************************************************************************
 448
 449 @renameSigs@ checks for:
 450 \begin{enumerate}
 451 \item more than one sig for one thing;
 452 \item signatures given for things not bound here;
 453 \item with suitably flaggery, that all top-level things have type signatures.
 454 \end{enumerate}
 455 %
 456 At the moment we don't gather free-var info from the types in
 457 signatures.  We'd only need this if we wanted to report unused tyvars.
 458
 459 \begin{code}
 460 checkSigs :: (RenamedSig -> Bool)       -- OK-sig predicbate
 461           -> [RenamedSig]
 462           -> RnM ()
 463 checkSigs ok_sig sigs
 464         -- Check for (a) duplicate signatures
 465         --           (b) signatures for things not in this group
 466         -- Well, I can't see the check for (a)... ToDo!
 467   = mappM_ unknownSigErr bad_sigs
 468   where
 469     bad_sigs = filter (not . ok_sig) sigs
 470
 471 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
 472 -- because this won't work for:
 473 --      instance Foo T where
 474 --        {-# INLINE op #-}
 475 --        Baz.op = ...
 476 -- We'll just rename the INLINE prag to refer to whatever other 'op'
 477 -- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
 478 -- Doesn't seem worth much trouble to sort this.
 479
 480 renameSigs :: [Sig RdrName] -> RnM [Sig Name]
 481 renameSigs sigs = mappM renameSig (filter (not . isFixitySig) sigs)
 482         -- Remove fixity sigs which have been dealt with already
 483
 484 renameSig :: Sig RdrName -> RnM (Sig Name)
 485 -- ClassOpSig, FixitSig is renamed elsewhere.
 486 renameSig (Sig v ty src_loc)
 487   = addSrcLoc src_loc $
 488     lookupSigOccRn v                            `thenM` \ new_v ->
 489     rnHsSigType (quotes (ppr v)) ty             `thenM` \ new_ty ->
 490     returnM (Sig new_v new_ty src_loc)
 491
 492 renameSig (SpecInstSig ty src_loc)
 493   = addSrcLoc src_loc $
 494     rnHsType (text "A SPECIALISE instance pragma") ty `thenM` \ new_ty ->
 495     returnM (SpecInstSig new_ty src_loc)
 496
 497 renameSig (SpecSig v ty src_loc)
 498   = addSrcLoc src_loc $
 499     lookupSigOccRn v                    `thenM` \ new_v ->
 500     rnHsSigType (quotes (ppr v)) ty     `thenM` \ new_ty ->
 501     returnM (SpecSig new_v new_ty src_loc)
 502
 503 renameSig (InlineSig b v p src_loc)
 504   = addSrcLoc src_loc $
 505     lookupSigOccRn v            `thenM` \ new_v ->
 506     returnM (InlineSig b new_v p src_loc)
 507 \end{code}
 508
 509
 510 %************************************************************************
 511 %*                                                                      *
 512 \subsection{Error messages}
 513 %*                                                                      *
 514 %************************************************************************
 515
 516 \begin{code}
 517 dupSigDeclErr sig
 518   = addSrcLoc loc $
 519     addErr (sep [ptext SLIT("Duplicate") <+> what_it_is <> colon,
 520                    ppr sig])
 521   where
 522     (what_it_is, loc) = hsSigDoc sig
 523
 524 unknownSigErr sig
 525   = addSrcLoc loc $
 526     addErr (sep [ptext SLIT("Misplaced") <+> what_it_is <> colon,
 527                    ppr sig])
 528   where
 529     (what_it_is, loc) = hsSigDoc sig
 530
 531 missingSigWarn var
 532   = addSrcLoc (nameSrcLoc var) $
 533     addWarn (sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)])
 534
 535 methodBindErr mbind
 536  =  hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))
 537        4 (ppr mbind)
 538 \end{code}