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         -- No need to extend the environment; that has been done already
 158
 159     bindPatSigTyVars (collectSigTysFromMonoBinds mbinds) $
 160         -- Hmm; by analogy with Ids, this doesn't look right
 161     let
 162         bndr_name_set = mkNameSet binder_names
 163     in
 164     renameSigsFVs (okBindSig bndr_name_set) sigs        `thenM` \ (siglist, sig_fvs) ->
 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 = nameSetToList (delListFromNameSet bndr_name_set type_sig_vars)
 174         in
 175         mappM_ missingSigWarn un_sigd_binders
 176      else
 177         returnM ()
 178     )                                           `thenM_`
 179
 180     rn_mono_binds siglist mbinds                `thenM` \ (final_binds, bind_fvs) ->
 181     returnM (final_binds, bind_fvs `plusFV` sig_fvs)
 182   where
 183     binder_rdr_names = collectMonoBinders mbinds
 184 \end{code}
 185
 186 %************************************************************************
 187 %*                                                                      *
 188 %*              Nested binds
 189 %*                                                                      *
 190 %************************************************************************
 191
 192 \subsubsection{Nested binds}
 193
 194 @rnMonoBinds@
 195 \begin{itemize}
 196 \item collects up the binders for this declaration group,
 197 \item checks that they form a set
 198 \item extends the environment to bind them to new local names
 199 \item calls @rnMonoBinds@ to do the real work
 200 \end{itemize}
 201 %
 202 \begin{code}
 203 rnMonoBinds :: RdrNameMonoBinds
 204             -> [RdrNameSig]
 205             -> (RenamedHsBinds -> RnM (result, FreeVars))
 206             -> RnM (result, FreeVars)
 207
 208 rnMonoBinds mbinds sigs thing_inside -- Non-empty monobinds
 209   =     -- Extract all the binders in this group,
 210         -- and extend current scope, inventing new names for the new binders
 211         -- This also checks that the names form a set
 212     bindLocatedLocalsRn doc mbinders_w_srclocs                  $ \ new_mbinders ->
 213     bindPatSigTyVars (collectSigTysFromMonoBinds mbinds)        $
 214     let
 215         binder_set = mkNameSet new_mbinders
 216     in
 217         -- Rename the signatures
 218     renameSigsFVs (okBindSig binder_set) sigs   `thenM` \ (siglist, sig_fvs) ->
 219
 220         -- Report the fixity declarations in this group that
 221         -- don't refer to any of the group's binders.
 222         -- Then install the fixity declarations that do apply here
 223         -- Notice that they scope over thing_inside too
 224     bindLocalFixities [sig | FixSig sig <- siglist ]    $
 225
 226     rn_mono_binds siglist mbinds           `thenM` \ (binds, bind_fvs) ->
 227
 228     -- Now do the "thing inside", and deal with the free-variable calculations
 229     thing_inside binds                     `thenM` \ (result,result_fvs) ->
 230     let
 231         all_fvs        = result_fvs `plusFV` bind_fvs `plusFV` sig_fvs
 232         unused_binders = nameSetToList (binder_set `minusNameSet` all_fvs)
 233     in
 234     warnUnusedLocalBinds unused_binders `thenM_`
 235     returnM (result, delListFromNameSet all_fvs new_mbinders)
 236   where
 237     mbinders_w_srclocs = collectLocatedMonoBinders mbinds
 238     doc = text "In the binding group for" <+> pp_bndrs mbinders_w_srclocs
 239     pp_bndrs [(b,_)] = quotes (ppr b)
 240     pp_bndrs bs      = fsep (punctuate comma [ppr b | (b,_) <- bs])
 241 \end{code}
 242
 243
 244 %************************************************************************
 245 %*                                                                      *
 246 \subsubsection{         MonoBinds -- the main work is done here}
 247 %*                                                                      *
 248 %************************************************************************
 249
 250 @rn_mono_binds@ is used by {\em both} top-level and nested bindings.
 251 It assumes that all variables bound in this group are already in scope.
 252 This is done {\em either} by pass 3 (for the top-level bindings),
 253 {\em or} by @rnMonoBinds@ (for the nested ones).
 254
 255 \begin{code}
 256 rn_mono_binds :: [RenamedSig]           -- Signatures attached to this group
 257               -> RdrNameMonoBinds
 258               -> RnM (RenamedHsBinds,   -- Dependency analysed
 259                        FreeVars)        -- Free variables
 260
 261 rn_mono_binds siglist mbinds
 262   =
 263          -- Rename the bindings, returning a MonoBindsInfo
 264          -- which is a list of indivisible vertices so far as
 265          -- the strongly-connected-components (SCC) analysis is concerned
 266     flattenMonoBinds siglist mbinds             `thenM` \ mbinds_info ->
 267
 268          -- Do the SCC analysis
 269     let
 270         edges       = mkEdges (mbinds_info `zip` [(0::Int)..])
 271         scc_result  = stronglyConnComp edges
 272         final_binds = foldr (ThenBinds . reconstructCycle) EmptyBinds scc_result
 273
 274          -- Deal with bound and free-var calculation
 275         rhs_fvs = plusFVs [fvs | (_,fvs,_,_) <- mbinds_info]
 276     in
 277     returnM (final_binds, rhs_fvs)
 278 \end{code}
 279
 280 @flattenMonoBinds@ is ever-so-slightly magical in that it sticks
 281 unique ``vertex tags'' on its output; minor plumbing required.
 282
 283 Sigh --- need to pass along the signatures for the group of bindings,
 284 in case any of them \fbox{\ ???\ }
 285
 286 \begin{code}
 287 flattenMonoBinds :: [RenamedSig]                -- Signatures
 288                  -> RdrNameMonoBinds
 289                  -> RnM [FlatMonoBindsInfo]
 290
 291 flattenMonoBinds sigs EmptyMonoBinds = returnM []
 292
 293 flattenMonoBinds sigs (AndMonoBinds bs1 bs2)
 294   = flattenMonoBinds sigs bs1   `thenM` \ flat1 ->
 295     flattenMonoBinds sigs bs2   `thenM` \ flat2 ->
 296     returnM (flat1 ++ flat2)
 297
 298 flattenMonoBinds sigs (PatMonoBind pat grhss locn)
 299   = addSrcLoc locn                      $
 300     rnPat pat                           `thenM` \ (pat', pat_fvs) ->
 301
 302          -- Find which things are bound in this group
 303     let
 304         names_bound_here = mkNameSet (collectPatBinders pat')
 305     in
 306     sigsForMe names_bound_here sigs     `thenM` \ sigs_for_me ->
 307     rnGRHSs grhss                       `thenM` \ (grhss', fvs) ->
 308     returnM
 309         [(names_bound_here,
 310           fvs `plusFV` pat_fvs,
 311           PatMonoBind pat' grhss' locn,
 312           sigs_for_me
 313          )]
 314
 315 flattenMonoBinds sigs (FunMonoBind name inf matches locn)
 316   = addSrcLoc locn                                      $
 317     lookupBndrRn name                                   `thenM` \ new_name ->
 318     let
 319         names_bound_here = unitNameSet new_name
 320     in
 321     sigsForMe names_bound_here sigs                     `thenM` \ sigs_for_me ->
 322     mapFvRn (rnMatch (FunRhs name)) matches             `thenM` \ (new_matches, fvs) ->
 323     mappM_ (checkPrecMatch inf new_name) new_matches    `thenM_`
 324     returnM
 325       [(unitNameSet new_name,
 326         fvs,
 327         FunMonoBind new_name inf new_matches locn,
 328         sigs_for_me
 329         )]
 330
 331
 332 sigsForMe names_bound_here sigs
 333   = foldlM check [] (filter (sigForThisGroup names_bound_here) sigs)
 334   where
 335     check sigs sig = case filter (eqHsSig sig) sigs of
 336                         []    -> returnM (sig:sigs)
 337                         other -> dupSigDeclErr sig      `thenM_`
 338                                  returnM sigs
 339 \end{code}
 340
 341
 342 @rnMethodBinds@ is used for the method bindings of a class and an instance
 343 declaration.   Like @rnMonoBinds@ but without dependency analysis.
 344
 345 NOTA BENE: we record each {\em binder} of a method-bind group as a free variable.
 346 That's crucial when dealing with an instance decl:
 347 \begin{verbatim}
 348         instance Foo (T a) where
 349            op x = ...
 350 \end{verbatim}
 351 This might be the {\em sole} occurrence of @op@ for an imported class @Foo@,
 352 and unless @op@ occurs we won't treat the type signature of @op@ in the class
 353 decl for @Foo@ as a source of instance-decl gates.  But we should!  Indeed,
 354 in many ways the @op@ in an instance decl is just like an occurrence, not
 355 a binder.
 356
 357 \begin{code}
 358 rnMethodBinds :: Name                   -- Class name
 359               -> [Name]                 -- Names for generic type variables
 360               -> RdrNameMonoBinds
 361               -> RnM (RenamedMonoBinds, FreeVars)
 362
 363 rnMethodBinds cls gen_tyvars EmptyMonoBinds = returnM (EmptyMonoBinds, emptyFVs)
 364
 365 rnMethodBinds cls gen_tyvars (AndMonoBinds mb1 mb2)
 366   = rnMethodBinds cls gen_tyvars mb1    `thenM` \ (mb1', fvs1) ->
 367     rnMethodBinds cls gen_tyvars mb2    `thenM` \ (mb2', fvs2) ->
 368     returnM (mb1' `AndMonoBinds` mb2', fvs1 `plusFV` fvs2)
 369
 370 rnMethodBinds cls gen_tyvars (FunMonoBind name inf matches locn)
 371   = addSrcLoc locn                                      $
 372
 373     lookupInstDeclBndr cls name                         `thenM` \ sel_name ->
 374         -- We use the selector name as the binder
 375
 376     mapFvRn rn_match matches                            `thenM` \ (new_matches, fvs) ->
 377     mappM_ (checkPrecMatch inf sel_name) new_matches    `thenM_`
 378     returnM (FunMonoBind sel_name inf new_matches locn, fvs `addOneFV` sel_name)
 379   where
 380         -- Gruesome; bring into scope the correct members of the generic type variables
 381         -- See comments in RnSource.rnSourceDecl(ClassDecl)
 382     rn_match match@(Match (TypePat ty : _) _ _)
 383         = extendTyVarEnvFVRn gen_tvs (rnMatch (FunRhs name) match)
 384         where
 385           tvs     = map rdrNameOcc (extractHsTyRdrNames ty)
 386           gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs]
 387
 388     rn_match match = rnMatch (FunRhs name) match
 389
 390
 391 -- Can't handle method pattern-bindings which bind multiple methods.
 392 rnMethodBinds cls gen_tyvars mbind@(PatMonoBind other_pat _ locn)
 393   = addSrcLoc locn (addErr (methodBindErr mbind))       `thenM_`
 394     returnM (EmptyMonoBinds, emptyFVs)
 395 \end{code}
 396
 397
 398 %************************************************************************
 399 %*                                                                      *
 400 \subsection[reconstruct-deps]{Reconstructing dependencies}
 401 %*                                                                      *
 402 %************************************************************************
 403
 404 This @MonoBinds@- and @ClassDecls@-specific code is segregated here,
 405 as the two cases are similar.
 406
 407 \begin{code}
 408 reconstructCycle :: SCC FlatMonoBindsInfo
 409                  -> RenamedHsBinds
 410
 411 reconstructCycle (AcyclicSCC (_, _, binds, sigs))
 412   = MonoBind binds sigs NonRecursive
 413
 414 reconstructCycle (CyclicSCC cycle)
 415   = MonoBind this_gp_binds this_gp_sigs Recursive
 416   where
 417     this_gp_binds      = foldr1 AndMonoBinds [binds | (_, _, binds, _) <- cycle]
 418     this_gp_sigs       = foldr1 (++)         [sigs  | (_, _, _, sigs) <- cycle]
 419 \end{code}
 420
 421 %************************************************************************
 422 %*                                                                      *
 423 \subsubsection{ Manipulating FlatMonoBindInfo}
 424 %*                                                                      *
 425 %************************************************************************
 426
 427 During analysis a @MonoBinds@ is flattened to a @FlatMonoBindsInfo@.
 428 The @RenamedMonoBinds@ is always an empty bind, a pattern binding or
 429 a function binding, and has itself been dependency-analysed and
 430 renamed.
 431
 432 \begin{code}
 433 type FlatMonoBindsInfo
 434   = (NameSet,                   -- Set of names defined in this vertex
 435      NameSet,                   -- Set of names used in this vertex
 436      RenamedMonoBinds,
 437      [RenamedSig])              -- Signatures, if any, for this vertex
 438
 439 mkEdges :: [(FlatMonoBindsInfo, VertexTag)] -> [(FlatMonoBindsInfo, VertexTag, [VertexTag])]
 440
 441 mkEdges flat_info
 442   = [ (info, tag, dest_vertices (nameSetToList names_used))
 443     | (info@(names_defined, names_used, mbind, sigs), tag) <- flat_info
 444     ]
 445   where
 446          -- An edge (v,v') indicates that v depends on v'
 447     dest_vertices src_mentions = [ target_vertex
 448                                  | ((names_defined, _, _, _), target_vertex) <- flat_info,
 449                                    mentioned_name <- src_mentions,
 450                                    mentioned_name `elemNameSet` names_defined
 451                                  ]
 452 \end{code}
 453
 454
 455 %************************************************************************
 456 %*                                                                      *
 457 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
 458 %*                                                                      *
 459 %************************************************************************
 460
 461 @renameSigs@ checks for:
 462 \begin{enumerate}
 463 \item more than one sig for one thing;
 464 \item signatures given for things not bound here;
 465 \item with suitably flaggery, that all top-level things have type signatures.
 466 \end{enumerate}
 467 %
 468 At the moment we don't gather free-var info from the types in
 469 signatures.  We'd only need this if we wanted to report unused tyvars.
 470
 471 \begin{code}
 472 renameSigsFVs ok_sig sigs
 473   = renameSigs ok_sig sigs      `thenM` \ sigs' ->
 474     returnM (sigs', hsSigsFVs sigs')
 475
 476 renameSigs ::  (RenamedSig -> Bool)             -- OK-sig predicate
 477             -> [RdrNameSig]
 478             -> RnM [RenamedSig]
 479
 480 renameSigs ok_sig [] = returnM []
 481
 482 renameSigs ok_sig sigs
 483   =      -- Rename the signatures
 484     mappM renameSig sigs        `thenM` \ sigs' ->
 485
 486         -- Check for (a) duplicate signatures
 487         --           (b) signatures for things not in this group
 488     let
 489         in_scope         = filter is_in_scope sigs'
 490         is_in_scope sig  = case sigName sig of
 491                                 Just n  -> not (isUnboundName n)
 492                                 Nothing -> True
 493         (goods, bads)    = partition ok_sig in_scope
 494     in
 495     mappM_ unknownSigErr bads                   `thenM_`
 496     returnM goods
 497
 498 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory
 499 -- because this won't work for:
 500 --      instance Foo T where
 501 --        {-# INLINE op #-}
 502 --        Baz.op = ...
 503 -- We'll just rename the INLINE prag to refer to whatever other 'op'
 504 -- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
 505 -- Doesn't seem worth much trouble to sort this.
 506
 507 renameSig :: Sig RdrName -> RnM (Sig Name)
 508 -- ClassOpSig is renamed elsewhere.
 509 renameSig (Sig v ty src_loc)
 510   = addSrcLoc src_loc $
 511     lookupSigOccRn v                            `thenM` \ new_v ->
 512     rnHsSigType (quotes (ppr v)) ty             `thenM` \ new_ty ->
 513     returnM (Sig new_v new_ty src_loc)
 514
 515 renameSig (SpecInstSig ty src_loc)
 516   = addSrcLoc src_loc $
 517     rnHsType (text "A SPECIALISE instance pragma") ty `thenM` \ new_ty ->
 518     returnM (SpecInstSig new_ty src_loc)
 519
 520 renameSig (SpecSig v ty src_loc)
 521   = addSrcLoc src_loc $
 522     lookupSigOccRn v                    `thenM` \ new_v ->
 523     rnHsSigType (quotes (ppr v)) ty     `thenM` \ new_ty ->
 524     returnM (SpecSig new_v new_ty src_loc)
 525
 526 renameSig (FixSig (FixitySig v fix src_loc))
 527   = addSrcLoc src_loc $
 528     lookupSigOccRn v            `thenM` \ new_v ->
 529     returnM (FixSig (FixitySig new_v fix src_loc))
 530
 531 renameSig (InlineSig b v p src_loc)
 532   = addSrcLoc src_loc $
 533     lookupSigOccRn v            `thenM` \ new_v ->
 534     returnM (InlineSig b new_v p src_loc)
 535 \end{code}
 536
 537
 538 %************************************************************************
 539 %*                                                                      *
 540 \subsection{Error messages}
 541 %*                                                                      *
 542 %************************************************************************
 543
 544 \begin{code}
 545 dupSigDeclErr sig
 546   = addSrcLoc loc $
 547     addErr (sep [ptext SLIT("Duplicate") <+> what_it_is <> colon,
 548                    ppr sig])
 549   where
 550     (what_it_is, loc) = hsSigDoc sig
 551
 552 unknownSigErr sig
 553   = addSrcLoc loc $
 554     addErr (sep [ptext SLIT("Misplaced") <+> what_it_is <> colon,
 555                    ppr sig])
 556   where
 557     (what_it_is, loc) = hsSigDoc sig
 558
 559 missingSigWarn var
 560   = addSrcLoc (nameSrcLoc var) $
 561     addWarn (sep [ptext SLIT("Definition but no type signature for"), quotes (ppr var)])
 562
 563 methodBindErr mbind
 564  =  hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))
 565        4 (ppr mbind)
 566 \end{code}