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 PatBindRhs 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 new_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 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 type BindWithSigs = (RenamedMonoBinds, [RenamedSig])
 410                         -- Signatures, if any, for this vertex
 411
 412 type FlatMonoBinds = (NameSet,  -- Defs
 413                       NameSet,  -- Uses
 414                       BindWithSigs)
 415
 416 rnSCC :: [FlatMonoBinds] -> [SCC BindWithSigs]
 417 rnSCC nodes = stronglyConnComp (mkEdges nodes)
 418
 419 type VertexTag  = Int
 420
 421 mkEdges :: [FlatMonoBinds] -> [(BindWithSigs, VertexTag, [VertexTag])]
 422 mkEdges nodes
 423   = [ (thing, tag, dest_vertices uses)
 424     | ((defs, uses, thing), tag) <- tagged_nodes
 425     ]
 426   where
 427     tagged_nodes = nodes `zip` [0::VertexTag ..]
 428
 429          -- An edge (v,v') indicates that v depends on v'
 430     dest_vertices uses = [ target_vertex
 431                          | ((defs, _, _), target_vertex) <- tagged_nodes,
 432                            mentioned_name <- nameSetToList uses,
 433                            mentioned_name `elemNameSet` defs
 434                          ]
 435
 436 reconstructCycle :: SCC BindWithSigs -> RenamedHsBinds
 437 reconstructCycle (AcyclicSCC (binds, sigs))
 438   = MonoBind binds sigs NonRecursive
 439 reconstructCycle (CyclicSCC cycle)
 440   = MonoBind this_gp_binds this_gp_sigs Recursive
 441   where
 442     (binds,sigs)  = unzip cycle
 443     this_gp_binds = foldr1 AndMonoBinds binds
 444     this_gp_sigs  = foldr1 (++)         sigs
 445 \end{code}
 446
 447
 448 %************************************************************************
 449 %*                                                                      *
 450 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
 451 %*                                                                      *
 452 %************************************************************************
 453
 454 @renameSigs@ checks for:
 455 \begin{enumerate}
 456 \item more than one sig for one thing;
 457 \item signatures given for things not bound here;
 458 \item with suitably flaggery, that all top-level things have type signatures.
 459 \end{enumerate}
 460 %
 461 At the moment we don't gather free-var info from the types in
 462 signatures.  We'd only need this if we wanted to report unused tyvars.
 463
 464 \begin{code}
 465 checkSigs :: (NameSet -> RenamedSig -> Bool)    -- OK-sig predicbate
 466           -> NameSet                            -- Binders of this group
 467           -> [RenamedSig]
 468           -> RnM ()
 469 checkSigs ok_sig bndrs sigs
 470         -- Check for (a) duplicate signatures
 471         --           (b) signatures for things not in this group
 472         -- Well, I can't see the check for (b)... ToDo!
 473   = mappM_ unknownSigErr bad_sigs
 474   where
 475     bad_sigs = filter (not . ok_sig bndrs) sigs
 476
 477 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
 478 -- because this won't work for:
 479 --      instance Foo T where
 480 --        {-# INLINE op #-}
 481 --        Baz.op = ...
 482 -- We'll just rename the INLINE prag to refer to whatever other 'op'
 483 -- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
 484 -- Doesn't seem worth much trouble to sort this.
 485
 486 renameSigs :: [Sig RdrName] -> RnM [Sig Name]
 487 renameSigs sigs = mappM renameSig (filter (not . isFixitySig) sigs)
 488         -- Remove fixity sigs which have been dealt with already
 489
 490 renameSig :: Sig RdrName -> RnM (Sig Name)
 491 -- ClassOpSig, FixitSig is renamed elsewhere.
 492 renameSig (Sig v ty src_loc)
 493   = addSrcLoc src_loc $
 494     lookupSigOccRn v                            `thenM` \ new_v ->
 495     rnHsSigType (quotes (ppr v)) ty             `thenM` \ new_ty ->
 496     returnM (Sig new_v new_ty src_loc)
 497
 498 renameSig (SpecInstSig ty src_loc)
 499   = addSrcLoc src_loc $
 500     rnHsType (text "A SPECIALISE instance pragma") ty `thenM` \ new_ty ->
 501     returnM (SpecInstSig new_ty src_loc)
 502
 503 renameSig (SpecSig v ty src_loc)
 504   = addSrcLoc src_loc $
 505     lookupSigOccRn v                    `thenM` \ new_v ->
 506     rnHsSigType (quotes (ppr v)) ty     `thenM` \ new_ty ->
 507     returnM (SpecSig new_v new_ty src_loc)
 508
 509 renameSig (InlineSig b v p src_loc)
 510   = addSrcLoc src_loc $
 511     lookupSigOccRn v            `thenM` \ new_v ->
 512     returnM (InlineSig b new_v p src_loc)
 513 \end{code}
 514
 515
 516 %************************************************************************
 517 %*                                                                      *
 518 \subsection{Error messages}
 519 %*                                                                      *
 520 %************************************************************************
 521
 522 \begin{code}
 523 dupSigDeclErr sig
 524   = addSrcLoc loc $
 525     addErr (sep [ptext SLIT("Duplicate") <+> what_it_is <> colon,
 526                    ppr sig])
 527   where
 528     (what_it_is, loc) = hsSigDoc sig
 529
 530 unknownSigErr sig
 531   = addSrcLoc loc $
 532     addErr (sep [ptext SLIT("Misplaced") <+> what_it_is <> colon,
 533                    ppr sig])
 534   where
 535     (what_it_is, loc) = hsSigDoc sig
 536
 537 missingSigWarn var
 538   = addSrcLoc (nameSrcLoc var) $
 539     addWarn (sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)])
 540
 541 methodBindErr mbind
 542  =  hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))
 543        4 (ppr mbind)
 544 \end{code}