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