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