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, rnMethodBinds,
  14         renameSigs, renameSigsFVs, unknownSigErr
  15    ) where
  16
  17 #include "HsVersions.h"
  18
  19
  20 import HsSyn
  21 import HsBinds          ( eqHsSig, sigName, hsSigDoc )
  22 import RdrHsSyn
  23 import RnHsSyn
  24 import TcRnMonad
  25 import RnTypes          ( rnHsSigType, rnHsType )
  26 import RnExpr           ( rnMatch, rnGRHSs, rnPat, checkPrecMatch )
  27 import RnEnv            ( bindLocatedLocalsRn, lookupBndrRn, lookupInstDeclBndr,
  28                           lookupSigOccRn, bindPatSigTyVars, bindLocalFixities,
  29                           warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
  30                         )
  31 import CmdLineOpts      ( DynFlag(..) )
  32 import Digraph          ( stronglyConnComp, SCC(..) )
  33 import Name             ( Name, nameOccName, nameSrcLoc )
  34 import NameSet
  35 import RdrName          ( RdrName, rdrNameOcc )
  36 import BasicTypes       ( RecFlag(..), FixitySig(..) )
  37 import List             ( partition )
  38 import Outputable
  39 import PrelNames        ( isUnboundName )
  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 \begin{code}
  69 type VertexTag  = Int
  70 \end{code}
  71
  72 %************************************************************************
  73 %*                                                                      *
  74 %* naming conventions                                                   *
  75 %*                                                                      *
  76 %************************************************************************
  77
  78 \subsection[name-conventions]{Name conventions}
  79
  80 The basic algorithm involves walking over the tree and returning a tuple
  81 containing the new tree plus its free variables. Some functions, such
  82 as those walking polymorphic bindings (HsBinds) and qualifier lists in
  83 list comprehensions (@Quals@), return the variables bound in local
  84 environments. These are then used to calculate the free variables of the
  85 expression evaluated in these environments.
  86
  87 Conventions for variable names are as follows:
  88 \begin{itemize}
  89 \item
  90 new code is given a prime to distinguish it from the old.
  91
  92 \item
  93 a set of variables defined in @Exp@ is written @dvExp@
  94
  95 \item
  96 a set of variables free in @Exp@ is written @fvExp@
  97 \end{itemize}
  98
  99 %************************************************************************
 100 %*                                                                      *
 101 %* analysing polymorphic bindings (HsBinds, Bind, MonoBinds)            *
 102 %*                                                                      *
 103 %************************************************************************
 104
 105 \subsubsection[dep-HsBinds]{Polymorphic bindings}
 106
 107 Non-recursive expressions are reconstructed without any changes at top
 108 level, although their component expressions may have to be altered.
 109 However, non-recursive expressions are currently not expected as
 110 \Haskell{} programs, and this code should not be executed.
 111
 112 Monomorphic bindings contain information that is returned in a tuple
 113 (a @FlatMonoBindsInfo@) containing:
 114
 115 \begin{enumerate}
 116 \item
 117 a unique @Int@ that serves as the ``vertex tag'' for this binding.
 118
 119 \item
 120 the name of a function or the names in a pattern. These are a set
 121 referred to as @dvLhs@, the defined variables of the left hand side.
 122
 123 \item
 124 the free variables of the body. These are referred to as @fvBody@.
 125
 126 \item
 127 the definition's actual code. This is referred to as just @code@.
 128 \end{enumerate}
 129
 130 The function @nonRecDvFv@ returns two sets of variables. The first is
 131 the set of variables defined in the set of monomorphic bindings, while the
 132 second is the set of free variables in those bindings.
 133
 134 The set of variables defined in a non-recursive binding is just the
 135 union of all of them, as @union@ removes duplicates. However, the
 136 free variables in each successive set of cumulative bindings is the
 137 union of those in the previous set plus those of the newest binding after
 138 the defined variables of the previous set have been removed.
 139
 140 @rnMethodBinds@ deals only with the declarations in class and
 141 instance declarations.  It expects only to see @FunMonoBind@s, and
 142 it expects the global environment to contain bindings for the binders
 143 (which are all class operations).
 144
 145 %************************************************************************
 146 %*                                                                      *
 147 \subsubsection{ Top-level bindings}
 148 %*                                                                      *
 149 %************************************************************************
 150
 151 @rnTopMonoBinds@ assumes that the environment already
 152 contains bindings for the binders of this particular binding.
 153
 154 \begin{code}
 155 rnTopMonoBinds mbinds sigs
 156  =  mappM lookupBndrRn binder_rdr_names                  `thenM` \ binder_names ->
 157     bindPatSigTyVars (collectSigTysFromMonoBinds mbinds) $
 158     let
 159         bndr_name_set = mkNameSet binder_names
 160     in
 161     renameSigsFVs (okBindSig bndr_name_set) sigs        `thenM` \ (siglist, sig_fvs) ->
 162
 163     ifOptM Opt_WarnMissingSigs (
 164         let
 165             type_sig_vars   = [n | Sig n _ _ <- siglist]
 166             un_sigd_binders = nameSetToList (delListFromNameSet bndr_name_set type_sig_vars)
 167         in
 168         mappM_ missingSigWarn un_sigd_binders
 169     )                                           `thenM_`
 170
 171     rn_mono_binds siglist mbinds                `thenM` \ (final_binds, bind_fvs) ->
 172     returnM (final_binds, bind_fvs `plusFV` sig_fvs)
 173   where
 174     binder_rdr_names = collectMonoBinders mbinds
 175 \end{code}
 176
 177 %************************************************************************
 178 %*                                                                      *
 179 %*              Nested binds
 180 %*                                                                      *
 181 %************************************************************************
 182
 183 \subsubsection{Nested binds}
 184
 185 @rnMonoBinds@
 186 \begin{itemize}
 187 \item collects up the binders for this declaration group,
 188 \item checks that they form a set
 189 \item extends the environment to bind them to new local names
 190 \item calls @rnMonoBinds@ to do the real work
 191 \end{itemize}
 192 %
 193 \begin{code}
 194 rnMonoBinds :: RdrNameMonoBinds
 195             -> [RdrNameSig]
 196             -> (RenamedHsBinds -> RnM (result, FreeVars))
 197             -> RnM (result, FreeVars)
 198
 199 rnMonoBinds mbinds sigs thing_inside -- Non-empty monobinds
 200   =     -- Extract all the binders in this group,
 201         -- and extend current scope, inventing new names for the new binders
 202         -- This also checks that the names form a set
 203     bindLocatedLocalsRn doc mbinders_w_srclocs                  $ \ new_mbinders ->
 204     bindPatSigTyVars (collectSigTysFromMonoBinds mbinds)        $
 205     let
 206         binder_set = mkNameSet new_mbinders
 207     in
 208         -- Rename the signatures
 209     renameSigsFVs (okBindSig binder_set) sigs   `thenM` \ (siglist, sig_fvs) ->
 210
 211         -- Report the fixity declarations in this group that
 212         -- don't refer to any of the group's binders.
 213         -- Then install the fixity declarations that do apply here
 214         -- Notice that they scope over thing_inside too
 215     bindLocalFixities [sig | FixSig sig <- siglist ]    $
 216
 217     rn_mono_binds siglist mbinds           `thenM` \ (binds, bind_fvs) ->
 218
 219     -- Now do the "thing inside", and deal with the free-variable calculations
 220     thing_inside binds                     `thenM` \ (result,result_fvs) ->
 221     let
 222         all_fvs        = result_fvs `plusFV` bind_fvs `plusFV` sig_fvs
 223         unused_binders = nameSetToList (binder_set `minusNameSet` all_fvs)
 224     in
 225     warnUnusedLocalBinds unused_binders `thenM_`
 226     returnM (result, delListFromNameSet all_fvs new_mbinders)
 227   where
 228     mbinders_w_srclocs = collectLocatedMonoBinders mbinds
 229     doc = text "In the binding group for" <+> pp_bndrs mbinders_w_srclocs
 230     pp_bndrs [(b,_)] = quotes (ppr b)
 231     pp_bndrs bs      = fsep (punctuate comma [ppr b | (b,_) <- bs])
 232 \end{code}
 233
 234
 235 %************************************************************************
 236 %*                                                                      *
 237 \subsubsection{         MonoBinds -- the main work is done here}
 238 %*                                                                      *
 239 %************************************************************************
 240
 241 @rn_mono_binds@ is used by {\em both} top-level and nested bindings.
 242 It assumes that all variables bound in this group are already in scope.
 243 This is done {\em either} by pass 3 (for the top-level bindings),
 244 {\em or} by @rnMonoBinds@ (for the nested ones).
 245
 246 \begin{code}
 247 rn_mono_binds :: [RenamedSig]           -- Signatures attached to this group
 248               -> RdrNameMonoBinds
 249               -> RnM (RenamedHsBinds,   -- Dependency analysed
 250                        FreeVars)        -- Free variables
 251
 252 rn_mono_binds siglist mbinds
 253   =
 254          -- Rename the bindings, returning a MonoBindsInfo
 255          -- which is a list of indivisible vertices so far as
 256          -- the strongly-connected-components (SCC) analysis is concerned
 257     flattenMonoBinds siglist mbinds             `thenM` \ mbinds_info ->
 258
 259          -- Do the SCC analysis
 260     let
 261         edges       = mkEdges (mbinds_info `zip` [(0::Int)..])
 262         scc_result  = stronglyConnComp edges
 263         final_binds = foldr (ThenBinds . reconstructCycle) EmptyBinds scc_result
 264
 265          -- Deal with bound and free-var calculation
 266         rhs_fvs = plusFVs [fvs | (_,fvs,_,_) <- mbinds_info]
 267     in
 268     returnM (final_binds, rhs_fvs)
 269 \end{code}
 270
 271 @flattenMonoBinds@ is ever-so-slightly magical in that it sticks
 272 unique ``vertex tags'' on its output; minor plumbing required.
 273
 274 Sigh --- need to pass along the signatures for the group of bindings,
 275 in case any of them \fbox{\ ???\ }
 276
 277 \begin{code}
 278 flattenMonoBinds :: [RenamedSig]                -- Signatures
 279                  -> RdrNameMonoBinds
 280                  -> RnM [FlatMonoBindsInfo]
 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 grhss                       `thenM` \ (grhss', fvs) ->
 299     returnM
 300         [(names_bound_here,
 301           fvs `plusFV` pat_fvs,
 302           PatMonoBind pat' grhss' locn,
 303           sigs_for_me
 304          )]
 305
 306 flattenMonoBinds sigs (FunMonoBind name inf matches locn)
 307   = addSrcLoc locn                                      $
 308     lookupBndrRn name                                   `thenM` \ new_name ->
 309     let
 310         names_bound_here = unitNameSet new_name
 311     in
 312     sigsForMe names_bound_here sigs                     `thenM` \ sigs_for_me ->
 313     mapFvRn (rnMatch (FunRhs name)) matches             `thenM` \ (new_matches, fvs) ->
 314     mappM_ (checkPrecMatch inf new_name) new_matches    `thenM_`
 315     returnM
 316       [(unitNameSet new_name,
 317         fvs,
 318         FunMonoBind new_name inf new_matches locn,
 319         sigs_for_me
 320         )]
 321
 322
 323 sigsForMe names_bound_here sigs
 324   = foldlM check [] (filter (sigForThisGroup names_bound_here) sigs)
 325   where
 326     check sigs sig = case filter (eqHsSig sig) sigs of
 327                         []    -> returnM (sig:sigs)
 328                         other -> dupSigDeclErr sig      `thenM_`
 329                                  returnM sigs
 330 \end{code}
 331
 332
 333 @rnMethodBinds@ is used for the method bindings of a class and an instance
 334 declaration.   Like @rnMonoBinds@ but without dependency analysis.
 335
 336 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
 337 That's crucial when dealing with an instance decl:
 338 \begin{verbatim}
 339         instance Foo (T a) where
 340            op x = ...
 341 \end{verbatim}
 342 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
 343 and unless @op@ occurs we won't treat the type signature of @op@ in the class
 344 decl for @Foo@ as a source of instance-decl gates.  But we should!  Indeed,
 345 in many ways the @op@ in an instance decl is just like an occurrence, not
 346 a binder.
 347
 348 \begin{code}
 349 rnMethodBinds :: Name                   -- Class name
 350               -> [Name]                 -- Names for generic type variables
 351               -> RdrNameMonoBinds
 352               -> RnM (RenamedMonoBinds, FreeVars)
 353
 354 rnMethodBinds cls gen_tyvars EmptyMonoBinds = returnM (EmptyMonoBinds, emptyFVs)
 355
 356 rnMethodBinds cls gen_tyvars (AndMonoBinds mb1 mb2)
 357   = rnMethodBinds cls gen_tyvars mb1    `thenM` \ (mb1', fvs1) ->
 358     rnMethodBinds cls gen_tyvars mb2    `thenM` \ (mb2', fvs2) ->
 359     returnM (mb1' `AndMonoBinds` mb2', fvs1 `plusFV` fvs2)
 360
 361 rnMethodBinds cls gen_tyvars (FunMonoBind name inf matches locn)
 362   = addSrcLoc locn                                      $
 363
 364     lookupInstDeclBndr cls name                         `thenM` \ sel_name ->
 365         -- We use the selector name as the binder
 366
 367     mapFvRn rn_match matches                            `thenM` \ (new_matches, fvs) ->
 368     mappM_ (checkPrecMatch inf sel_name) new_matches    `thenM_`
 369     returnM (FunMonoBind sel_name inf new_matches locn, fvs `addOneFV` sel_name)
 370   where
 371         -- Gruesome; bring into scope the correct members of the generic type variables
 372         -- See comments in RnSource.rnSourceDecl(ClassDecl)
 373     rn_match match@(Match (TypePat ty : _) _ _)
 374         = extendTyVarEnvFVRn gen_tvs (rnMatch (FunRhs name) match)
 375         where
 376           tvs     = map rdrNameOcc (extractHsTyRdrNames ty)
 377           gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs]
 378
 379     rn_match match = rnMatch (FunRhs name) match
 380
 381
 382 -- Can't handle method pattern-bindings which bind multiple methods.
 383 rnMethodBinds cls gen_tyvars mbind@(PatMonoBind other_pat _ locn)
 384   = addSrcLoc locn (addErr (methodBindErr mbind))       `thenM_`
 385     returnM (EmptyMonoBinds, emptyFVs)
 386 \end{code}
 387
 388
 389 %************************************************************************
 390 %*                                                                      *
 391 \subsection[reconstruct-deps]{Reconstructing dependencies}
 392 %*                                                                      *
 393 %************************************************************************
 394
 395 This @MonoBinds@- and @ClassDecls@-specific code is segregated here,
 396 as the two cases are similar.
 397
 398 \begin{code}
 399 reconstructCycle :: SCC FlatMonoBindsInfo
 400                  -> RenamedHsBinds
 401
 402 reconstructCycle (AcyclicSCC (_, _, binds, sigs))
 403   = MonoBind binds sigs NonRecursive
 404
 405 reconstructCycle (CyclicSCC cycle)
 406   = MonoBind this_gp_binds this_gp_sigs Recursive
 407   where
 408     this_gp_binds      = foldr1 AndMonoBinds [binds | (_, _, binds, _) <- cycle]
 409     this_gp_sigs       = foldr1 (++)         [sigs  | (_, _, _, sigs) <- cycle]
 410 \end{code}
 411
 412 %************************************************************************
 413 %*                                                                      *
 414 \subsubsection{ Manipulating FlatMonoBindInfo}
 415 %*                                                                      *
 416 %************************************************************************
 417
 418 During analysis a @MonoBinds@ is flattened to a @FlatMonoBindsInfo@.
 419 The @RenamedMonoBinds@ is always an empty bind, a pattern binding or
 420 a function binding, and has itself been dependency-analysed and
 421 renamed.
 422
 423 \begin{code}
 424 type FlatMonoBindsInfo
 425   = (NameSet,                   -- Set of names defined in this vertex
 426      NameSet,                   -- Set of names used in this vertex
 427      RenamedMonoBinds,
 428      [RenamedSig])              -- Signatures, if any, for this vertex
 429
 430 mkEdges :: [(FlatMonoBindsInfo, VertexTag)] -> [(FlatMonoBindsInfo, VertexTag, [VertexTag])]
 431
 432 mkEdges flat_info
 433   = [ (info, tag, dest_vertices (nameSetToList names_used))
 434     | (info@(names_defined, names_used, mbind, sigs), tag) <- flat_info
 435     ]
 436   where
 437          -- An edge (v,v') indicates that v depends on v'
 438     dest_vertices src_mentions = [ target_vertex
 439                                  | ((names_defined, _, _, _), target_vertex) <- flat_info,
 440                                    mentioned_name <- src_mentions,
 441                                    mentioned_name `elemNameSet` names_defined
 442                                  ]
 443 \end{code}
 444
 445
 446 %************************************************************************
 447 %*                                                                      *
 448 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
 449 %*                                                                      *
 450 %************************************************************************
 451
 452 @renameSigs@ checks for:
 453 \begin{enumerate}
 454 \item more than one sig for one thing;
 455 \item signatures given for things not bound here;
 456 \item with suitably flaggery, that all top-level things have type signatures.
 457 \end{enumerate}
 458 %
 459 At the moment we don't gather free-var info from the types in
 460 signatures.  We'd only need this if we wanted to report unused tyvars.
 461
 462 \begin{code}
 463 renameSigsFVs ok_sig sigs
 464   = renameSigs ok_sig sigs      `thenM` \ sigs' ->
 465     returnM (sigs', hsSigsFVs sigs')
 466
 467 renameSigs ::  (RenamedSig -> Bool)             -- OK-sig predicate
 468             -> [RdrNameSig]
 469             -> RnM [RenamedSig]
 470
 471 renameSigs ok_sig [] = returnM []
 472
 473 renameSigs ok_sig sigs
 474   =      -- Rename the signatures
 475     mappM renameSig sigs        `thenM` \ sigs' ->
 476
 477         -- Check for (a) duplicate signatures
 478         --           (b) signatures for things not in this group
 479     let
 480         in_scope         = filter is_in_scope sigs'
 481         is_in_scope sig  = case sigName sig of
 482                                 Just n  -> not (isUnboundName n)
 483                                 Nothing -> True
 484         (goods, bads)    = partition ok_sig in_scope
 485     in
 486     mappM_ unknownSigErr bads                   `thenM_`
 487     returnM goods
 488
 489 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
 490 -- because this won't work for:
 491 --      instance Foo T where
 492 --        {-# INLINE op #-}
 493 --        Baz.op = ...
 494 -- We'll just rename the INLINE prag to refer to whatever other 'op'
 495 -- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
 496 -- Doesn't seem worth much trouble to sort this.
 497
 498 renameSig :: Sig RdrName -> RnM (Sig Name)
 499 -- ClassOpSig is renamed elsewhere.
 500 renameSig (Sig v ty src_loc)
 501   = addSrcLoc src_loc $
 502     lookupSigOccRn v                            `thenM` \ new_v ->
 503     rnHsSigType (quotes (ppr v)) ty             `thenM` \ new_ty ->
 504     returnM (Sig new_v new_ty src_loc)
 505
 506 renameSig (SpecInstSig ty src_loc)
 507   = addSrcLoc src_loc $
 508     rnHsType (text "A SPECIALISE instance pragma") ty `thenM` \ new_ty ->
 509     returnM (SpecInstSig new_ty src_loc)
 510
 511 renameSig (SpecSig v ty src_loc)
 512   = addSrcLoc src_loc $
 513     lookupSigOccRn v                    `thenM` \ new_v ->
 514     rnHsSigType (quotes (ppr v)) ty     `thenM` \ new_ty ->
 515     returnM (SpecSig new_v new_ty src_loc)
 516
 517 renameSig (FixSig (FixitySig v fix src_loc))
 518   = addSrcLoc src_loc $
 519     lookupSigOccRn v            `thenM` \ new_v ->
 520     returnM (FixSig (FixitySig new_v fix src_loc))
 521
 522 renameSig (InlineSig b v p src_loc)
 523   = addSrcLoc src_loc $
 524     lookupSigOccRn v            `thenM` \ new_v ->
 525     returnM (InlineSig b new_v p src_loc)
 526 \end{code}
 527
 528
 529 %************************************************************************
 530 %*                                                                      *
 531 \subsection{Error messages}
 532 %*                                                                      *
 533 %************************************************************************
 534
 535 \begin{code}
 536 dupSigDeclErr sig
 537   = addSrcLoc loc $
 538     addErr (sep [ptext SLIT("Duplicate") <+> what_it_is <> colon,
 539                    ppr sig])
 540   where
 541     (what_it_is, loc) = hsSigDoc sig
 542
 543 unknownSigErr sig
 544   = addSrcLoc loc $
 545     addErr (sep [ptext SLIT("Misplaced") <+> what_it_is <> colon,
 546                    ppr sig])
 547   where
 548     (what_it_is, loc) = hsSigDoc sig
 549
 550 missingSigWarn var
 551   = addSrcLoc (nameSrcLoc var) $
 552     addWarn (sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)])
 553
 554 methodBindErr mbind
 555  =  hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))
 556        4 (ppr mbind)
 557 \end{code}