ghc/compiler/rename/RnSource.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnSource]{Main pass of renamer}
   5
   6 \begin{code}
   7 module RnSource ( rnTyClDecl, rnIfaceRuleDecl, rnInstDecl, rnSourceDecls,
   8         ) where
   9
  10 #include "HsVersions.h"
  11
  12 import RnExpr
  13 import HsSyn
  14 import HscTypes         ( GlobalRdrEnv, AvailEnv )
  15 import RdrName          ( RdrName, isRdrDataCon, elemRdrEnv )
  16 import RdrHsSyn         ( RdrNameConDecl, RdrNameTyClDecl,
  17                           extractGenericPatTyVars
  18                         )
  19 import RnHsSyn
  20 import HsCore
  21
  22 import RnTypes          ( rnHsType, rnHsSigType, rnHsTypeFVs, rnContext )
  23
  24 import RnBinds          ( rnTopBinds, rnMethodBinds, renameSigs, renameSigsFVs )
  25 import RnEnv            ( lookupTopBndrRn, lookupOccRn, lookupIfaceName,
  26                           lookupSysBinder, newLocalsRn,
  27                           bindLocalsFVRn, bindPatSigTyVars,
  28                           bindTyVarsRn, extendTyVarEnvFVRn,
  29                           bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
  30                           checkDupOrQualNames, checkDupNames, mapFvRn
  31                         )
  32 import RnMonad
  33
  34 import Class            ( FunDep, DefMeth (..) )
  35 import TyCon            ( DataConDetails(..), visibleDataCons )
  36 import DataCon          ( dataConWorkId )
  37 import Name             ( Name, NamedThing(..) )
  38 import NameSet
  39 import PrelNames        ( deRefStablePtrName, newStablePtrName,
  40                           bindIOName, returnIOName
  41                         )
  42 import TysWiredIn       ( tupleCon )
  43 import List             ( partition )
  44 import Outputable
  45 import SrcLoc           ( SrcLoc )
  46 import CmdLineOpts      ( DynFlag(..) )
  47                                 -- Warn of unused for-all'd tyvars
  48 import Maybes           ( maybeToBool )
  49 import Maybe            ( maybe )
  50 \end{code}
  51
  52 @rnSourceDecl@ `renames' declarations.
  53 It simultaneously performs dependency analysis and precedence parsing.
  54 It also does the following error checks:
  55 \begin{enumerate}
  56 \item
  57 Checks that tyvars are used properly. This includes checking
  58 for undefined tyvars, and tyvars in contexts that are ambiguous.
  59 (Some of this checking has now been moved to module @TcMonoType@,
  60 since we don't have functional dependency information at this point.)
  61 \item
  62 Checks that all variable occurences are defined.
  63 \item
  64 Checks the @(..)@ etc constraints in the export list.
  65 \end{enumerate}
  66
  67
  68 %*********************************************************
  69 %*                                                      *
  70 \subsection{Source code declarations}
  71 %*                                                      *
  72 %*********************************************************
  73
  74 \begin{code}
  75 rnSourceDecls :: GlobalRdrEnv -> AvailEnv -> LocalFixityEnv -> RnMode
  76               -> [RdrNameHsDecl]
  77               -> RnMG ([RenamedHsDecl], FreeVars)
  78         -- The decls get reversed, but that's ok
  79
  80 rnSourceDecls gbl_env avails local_fixity_env mode decls
  81   = initRnMS gbl_env avails emptyRdrEnv local_fixity_env mode (go emptyFVs [] decls)
  82   where
  83         -- Fixity and deprecations have been dealt with already; ignore them
  84     go fvs ds' []             = returnRn (ds', fvs)
  85     go fvs ds' (FixD _:ds)    = go fvs ds' ds
  86     go fvs ds' (DeprecD _:ds) = go fvs ds' ds
  87     go fvs ds' (d:ds)         = rnSourceDecl d  `thenRn` \(d', fvs') ->
  88                                 go (fvs `plusFV` fvs') (d':ds') ds
  89
  90
  91 rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
  92
  93 rnSourceDecl (ValD binds) = rnTopBinds binds    `thenRn` \ (new_binds, fvs) ->
  94                             returnRn (ValD new_binds, fvs)
  95
  96 rnSourceDecl (TyClD tycl_decl)
  97   = rnTyClDecl tycl_decl                        `thenRn` \ new_decl ->
  98     finishSourceTyClDecl tycl_decl new_decl     `thenRn` \ (new_decl', fvs) ->
  99     returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
 100
 101 rnSourceDecl (InstD inst)
 102   = rnInstDecl inst                     `thenRn` \ new_inst ->
 103     finishSourceInstDecl inst new_inst  `thenRn` \ (new_inst', fvs) ->
 104     returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
 105
 106 rnSourceDecl (RuleD rule)
 107   = rnHsRuleDecl rule           `thenRn` \ (new_rule, fvs) ->
 108     returnRn (RuleD new_rule, fvs)
 109
 110 rnSourceDecl (ForD ford)
 111   = rnHsForeignDecl ford                `thenRn` \ (new_ford, fvs) ->
 112     returnRn (ForD new_ford, fvs)
 113
 114 rnSourceDecl (DefD (DefaultDecl tys src_loc))
 115   = pushSrcLocRn src_loc $
 116     mapFvRn (rnHsTypeFVs doc_str) tys           `thenRn` \ (tys', fvs) ->
 117     returnRn (DefD (DefaultDecl tys' src_loc), fvs)
 118   where
 119     doc_str = text "In a `default' declaration"
 120 \end{code}
 121
 122
 123 %*********************************************************
 124 %*                                                      *
 125 \subsection{Foreign declarations}
 126 %*                                                      *
 127 %*********************************************************
 128
 129 \begin{code}
 130 rnHsForeignDecl (ForeignImport name ty spec isDeprec src_loc)
 131   = pushSrcLocRn src_loc                $
 132     lookupTopBndrRn name                `thenRn` \ name' ->
 133     rnHsTypeFVs (fo_decl_msg name) ty   `thenRn` \ (ty', fvs) ->
 134     returnRn (ForeignImport name' ty' spec isDeprec src_loc,
 135               fvs `plusFV` extras spec)
 136   where
 137     extras (CImport _ _ _ _ CWrapper) = mkFVs [newStablePtrName,
 138                                                deRefStablePtrName,
 139                                                bindIOName, returnIOName]
 140     extras _                          = emptyFVs
 141
 142 rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
 143   = pushSrcLocRn src_loc                        $
 144     lookupOccRn name                            `thenRn` \ name' ->
 145     rnHsTypeFVs (fo_decl_msg name) ty           `thenRn` \ (ty', fvs) ->
 146     returnRn (ForeignExport name' ty' spec isDeprec src_loc,
 147               mkFVs [bindIOName, returnIOName] `plusFV` fvs)
 148
 149 fo_decl_msg name = ptext SLIT("The foreign declaration for") <+> ppr name
 150 \end{code}
 151
 152
 153 %*********************************************************
 154 %*                                                      *
 155 \subsection{Instance declarations}
 156 %*                                                      *
 157 %*********************************************************
 158
 159 \begin{code}
 160 rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
 161         -- Used for both source and interface file decls
 162   = pushSrcLocRn src_loc $
 163     rnHsSigType (text "an instance decl") inst_ty       `thenRn` \ inst_ty' ->
 164
 165     (case maybe_dfun_rdr_name of
 166         Nothing            -> returnRn Nothing
 167         Just dfun_rdr_name -> lookupIfaceName dfun_rdr_name     `thenRn` \ dfun_name ->
 168                               returnRn (Just dfun_name)
 169     )                                                   `thenRn` \ maybe_dfun_name ->
 170
 171     -- The typechecker checks that all the bindings are for the right class.
 172     returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
 173
 174 -- Compare finishSourceTyClDecl
 175 finishSourceInstDecl (InstDecl _       mbinds uprags _               _      )
 176                      (InstDecl inst_ty _      _      maybe_dfun_name src_loc)
 177         -- Used for both source decls only
 178   = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
 179     let
 180         meth_doc    = text "In the bindings in an instance declaration"
 181         meth_names  = collectLocatedMonoBinders mbinds
 182         (inst_tyvars, (cls,_)) = getHsInstHead inst_ty
 183         -- (Slightly strangely) the forall-d tyvars scope over
 184         -- the method bindings too
 185     in
 186
 187         -- Rename the bindings
 188         -- NB meth_names can be qualified!
 189     checkDupNames meth_doc meth_names           `thenRn_`
 190     extendTyVarEnvForMethodBinds inst_tyvars (
 191         rnMethodBinds cls [] mbinds
 192     )                                           `thenRn` \ (mbinds', meth_fvs) ->
 193     let
 194         binders    = collectMonoBinders mbinds'
 195         binder_set = mkNameSet binders
 196     in
 197         -- Rename the prags and signatures.
 198         -- Note that the type variables are not in scope here,
 199         -- so that      instance Eq a => Eq (T a) where
 200         --                      {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
 201         -- works OK.
 202         --
 203         -- But the (unqualified) method names are in scope
 204     bindLocalNames binders (
 205        renameSigsFVs (okInstDclSig binder_set) uprags
 206     )                                                   `thenRn` \ (uprags', prag_fvs) ->
 207
 208     returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
 209               meth_fvs `plusFV` prag_fvs)
 210 \end{code}
 211
 212 %*********************************************************
 213 %*                                                      *
 214 \subsection{Rules}
 215 %*                                                      *
 216 %*********************************************************
 217
 218 \begin{code}
 219 rnIfaceRuleDecl (IfaceRule rule_name act vars fn args rhs src_loc)
 220   = pushSrcLocRn src_loc        $
 221     lookupOccRn fn              `thenRn` \ fn' ->
 222     rnCoreBndrs vars            $ \ vars' ->
 223     mapRn rnCoreExpr args       `thenRn` \ args' ->
 224     rnCoreExpr rhs              `thenRn` \ rhs' ->
 225     returnRn (IfaceRule rule_name act vars' fn' args' rhs' src_loc)
 226
 227 rnIfaceRuleDecl (IfaceRuleOut fn rule)          -- Builtin rules come this way
 228   = lookupOccRn fn              `thenRn` \ fn' ->
 229     returnRn (IfaceRuleOut fn' rule)
 230
 231 rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
 232   = pushSrcLocRn src_loc                                $
 233     bindPatSigTyVars (collectRuleBndrSigTys vars)       $
 234
 235     bindLocalsFVRn doc (map get_var vars)       $ \ ids ->
 236     mapFvRn rn_var (vars `zip` ids)             `thenRn` \ (vars', fv_vars) ->
 237
 238     rnExpr lhs                                  `thenRn` \ (lhs', fv_lhs) ->
 239     rnExpr rhs                                  `thenRn` \ (rhs', fv_rhs) ->
 240     checkRn (validRuleLhs ids lhs')
 241             (badRuleLhsErr rule_name lhs')      `thenRn_`
 242     let
 243         bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs)]
 244     in
 245     mapRn (addErrRn . badRuleVar rule_name) bad_vars    `thenRn_`
 246     returnRn (HsRule rule_name act vars' lhs' rhs' src_loc,
 247               fv_vars `plusFV` fv_lhs `plusFV` fv_rhs)
 248   where
 249     doc = text "In the transformation rule" <+> ptext rule_name
 250
 251     get_var (RuleBndr v)      = v
 252     get_var (RuleBndrSig v _) = v
 253
 254     rn_var (RuleBndr v, id)      = returnRn (RuleBndr id, emptyFVs)
 255     rn_var (RuleBndrSig v t, id) = rnHsTypeFVs doc t    `thenRn` \ (t', fvs) ->
 256                                    returnRn (RuleBndrSig id t', fvs)
 257 \end{code}
 258
 259
 260 %*********************************************************
 261 %*                                                      *
 262 \subsection{Type, class and iface sig declarations}
 263 %*                                                      *
 264 %*********************************************************
 265
 266 @rnTyDecl@ uses the `global name function' to create a new type
 267 declaration in which local names have been replaced by their original
 268 names, reporting any unknown names.
 269
 270 Renaming type variables is a pain. Because they now contain uniques,
 271 it is necessary to pass in an association list which maps a parsed
 272 tyvar to its @Name@ representation.
 273 In some cases (type signatures of values),
 274 it is even necessary to go over the type first
 275 in order to get the set of tyvars used by it, make an assoc list,
 276 and then go over it again to rename the tyvars!
 277 However, we can also do some scoping checks at the same time.
 278
 279 \begin{code}
 280 rnTyClDecl (IfaceSig {tcdName = name, tcdType = ty, tcdIdInfo = id_infos, tcdLoc = loc})
 281   = pushSrcLocRn loc $
 282     lookupTopBndrRn name                `thenRn` \ name' ->
 283     rnHsType doc_str ty                 `thenRn` \ ty' ->
 284     mapRn rnIdInfo id_infos             `thenRn` \ id_infos' ->
 285     returnRn (IfaceSig {tcdName = name', tcdType = ty', tcdIdInfo = id_infos', tcdLoc = loc})
 286   where
 287     doc_str = text "In the interface signature for" <+> quotes (ppr name)
 288
 289 rnTyClDecl (CoreDecl {tcdName = name, tcdType = ty, tcdRhs = rhs, tcdLoc = loc})
 290   = pushSrcLocRn loc $
 291     lookupTopBndrRn name                `thenRn` \ name' ->
 292     rnHsType doc_str ty                 `thenRn` \ ty' ->
 293     rnCoreExpr rhs                      `thenRn` \ rhs' ->
 294     returnRn (CoreDecl {tcdName = name', tcdType = ty', tcdRhs = rhs', tcdLoc = loc})
 295   where
 296     doc_str = text "In the Core declaration for" <+> quotes (ppr name)
 297
 298 rnTyClDecl (ForeignType {tcdName = name, tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
 299   = pushSrcLocRn loc                    $
 300     lookupTopBndrRn name                `thenRn` \ name' ->
 301     returnRn (ForeignType {tcdName = name', tcdFoType = fo_type, tcdExtName = ext_name, tcdLoc = loc})
 302
 303 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdName = tycon,
 304                     tcdTyVars = tyvars, tcdCons = condecls,
 305                     tcdDerivs = derivs, tcdLoc = src_loc, tcdSysNames = sys_names})
 306   = pushSrcLocRn src_loc $
 307     lookupTopBndrRn tycon                       `thenRn` \ tycon' ->
 308     bindTyVarsRn data_doc tyvars                $ \ tyvars' ->
 309     rnContext data_doc context                  `thenRn` \ context' ->
 310     rn_derivs derivs                            `thenRn` \ derivs' ->
 311     checkDupOrQualNames data_doc con_names      `thenRn_`
 312
 313     rnConDecls tycon' condecls                  `thenRn` \ condecls' ->
 314     mapRn lookupSysBinder sys_names             `thenRn` \ sys_names' ->
 315     returnRn (TyData {tcdND = new_or_data, tcdCtxt = context', tcdName = tycon',
 316                       tcdTyVars = tyvars', tcdCons = condecls',
 317                       tcdDerivs = derivs', tcdLoc = src_loc, tcdSysNames = sys_names'})
 318   where
 319     data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
 320     con_names = map conDeclName (visibleDataCons condecls)
 321
 322     rn_derivs Nothing   = returnRn Nothing
 323     rn_derivs (Just ds) = rnContext data_doc ds `thenRn` \ ds' -> returnRn (Just ds')
 324
 325 rnTyClDecl (TySynonym {tcdName = name, tcdTyVars = tyvars, tcdSynRhs = ty, tcdLoc = src_loc})
 326   = pushSrcLocRn src_loc $
 327     lookupTopBndrRn name                        `thenRn` \ name' ->
 328     bindTyVarsRn syn_doc tyvars                 $ \ tyvars' ->
 329     rnHsType syn_doc ty                         `thenRn` \ ty' ->
 330     returnRn (TySynonym {tcdName = name', tcdTyVars = tyvars', tcdSynRhs = ty', tcdLoc = src_loc})
 331   where
 332     syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
 333
 334 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
 335                        tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
 336                        tcdSysNames = names, tcdLoc = src_loc})
 337         -- Used for both source and interface file decls
 338   = pushSrcLocRn src_loc $
 339
 340     lookupTopBndrRn cname                       `thenRn` \ cname' ->
 341
 342         -- Deal with the implicit tycon and datacon name
 343         -- They aren't in scope (because they aren't visible to the user)
 344         -- and what we want to do is simply look them up in the cache;
 345         -- we jolly well ought to get a 'hit' there!
 346     mapRn lookupSysBinder names                 `thenRn` \ names' ->
 347
 348         -- Tyvars scope over superclass context and method signatures
 349     bindTyVarsRn cls_doc tyvars                 $ \ tyvars' ->
 350
 351         -- Check the superclasses
 352     rnContext cls_doc context                   `thenRn` \ context' ->
 353
 354         -- Check the functional dependencies
 355     rnFds cls_doc fds                           `thenRn` \ fds' ->
 356
 357         -- Check the signatures
 358         -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
 359     let
 360         (op_sigs, non_op_sigs) = partition isClassOpSig sigs
 361         sig_rdr_names_w_locs   = [(op,locn) | ClassOpSig op _ _ locn <- sigs]
 362     in
 363     checkDupOrQualNames sig_doc sig_rdr_names_w_locs    `thenRn_`
 364     mapRn (rnClassOp cname' fds') op_sigs               `thenRn` \ sigs' ->
 365     let
 366         binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
 367     in
 368     renameSigs (okClsDclSig binders) non_op_sigs          `thenRn` \ non_ops' ->
 369
 370         -- Typechecker is responsible for checking that we only
 371         -- give default-method bindings for things in this class.
 372         -- The renamer *could* check this for class decls, but can't
 373         -- for instance decls.
 374
 375     returnRn (ClassDecl { tcdCtxt = context', tcdName = cname', tcdTyVars = tyvars',
 376                           tcdFDs = fds', tcdSigs = non_ops' ++ sigs', tcdMeths = Nothing,
 377                           tcdSysNames = names', tcdLoc = src_loc})
 378   where
 379     cls_doc  = text "In the declaration for class"      <+> ppr cname
 380     sig_doc  = text "In the signatures for class"       <+> ppr cname
 381
 382 rnClassOp clas clas_fds sig@(ClassOpSig op dm_stuff ty locn)
 383   = pushSrcLocRn locn $
 384     lookupTopBndrRn op                  `thenRn` \ op_name ->
 385
 386         -- Check the signature
 387     rnHsSigType (quotes (ppr op)) ty    `thenRn` \ new_ty ->
 388
 389         -- Make the default-method name
 390     (case dm_stuff of
 391         DefMeth dm_rdr_name
 392             ->  -- Imported class that has a default method decl
 393                 -- See comments with tname, snames, above
 394                 lookupSysBinder dm_rdr_name     `thenRn` \ dm_name ->
 395                 returnRn (DefMeth dm_name)
 396                         -- An imported class decl for a class decl that had an explicit default
 397                         -- method, mentions, rather than defines,
 398                         -- the default method, so we must arrange to pull it in
 399
 400         GenDefMeth -> returnRn GenDefMeth
 401         NoDefMeth  -> returnRn NoDefMeth
 402     )                                           `thenRn` \ dm_stuff' ->
 403
 404     returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
 405
 406 finishSourceTyClDecl :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
 407         -- Used for source file decls only
 408         -- Renames the default-bindings of a class decl
 409 finishSourceTyClDecl (ClassDecl {tcdMeths = Just mbinds, tcdLoc = src_loc})     -- Get mbinds from here
 410          rn_cls_decl@(ClassDecl {tcdName = cls, tcdTyVars = tyvars})            -- Everything else is here
 411   -- There are some default-method bindings (abeit possibly empty) so
 412   -- this is a source-code class declaration
 413   =     -- The newLocals call is tiresome: given a generic class decl
 414         --      class C a where
 415         --        op :: a -> a
 416         --        op {| x+y |} (Inl a) = ...
 417         --        op {| x+y |} (Inr b) = ...
 418         --        op {| a*b |} (a*b)   = ...
 419         -- we want to name both "x" tyvars with the same unique, so that they are
 420         -- easy to group together in the typechecker.
 421         -- Hence the
 422     pushSrcLocRn src_loc                                $
 423     extendTyVarEnvForMethodBinds tyvars                 $
 424     getLocalNameEnv                                     `thenRn` \ name_env ->
 425     let
 426         meth_rdr_names_w_locs = collectLocatedMonoBinders mbinds
 427         gen_rdr_tyvars_w_locs = [(tv,src_loc) | tv <- extractGenericPatTyVars mbinds,
 428                                                 not (tv `elemRdrEnv` name_env)]
 429     in
 430     checkDupOrQualNames meth_doc meth_rdr_names_w_locs  `thenRn_`
 431     newLocalsRn gen_rdr_tyvars_w_locs                   `thenRn` \ gen_tyvars ->
 432     rnMethodBinds cls gen_tyvars mbinds                 `thenRn` \ (mbinds', meth_fvs) ->
 433     returnRn (rn_cls_decl {tcdMeths = Just mbinds'}, meth_fvs)
 434   where
 435     meth_doc = text "In the default-methods for class"  <+> ppr (tcdName rn_cls_decl)
 436
 437 finishSourceTyClDecl _ tycl_decl@(TyData {tcdDerivs = derivings})
 438   -- Derivings are returned here so that they don't form part of the tyClDeclFVs.
 439   -- This is important, because tyClDeclFVs should contain only the
 440   -- FVs that are `needed' by the interface file declaration, and
 441   -- derivings do not appear in this.  It also means that the tcGroups
 442   -- are smaller, which turned out to be important for the usage inference. KSW 2002-02.
 443   = returnRn (tycl_decl,
 444               maybe emptyFVs extractHsCtxtTyNames derivings)
 445
 446 finishSourceTyClDecl _ tycl_decl = returnRn (tycl_decl, emptyFVs)
 447         -- Not a class declaration
 448 \end{code}
 449
 450 For the method bindings in class and instance decls, we extend the
 451 type variable environment iff -fglasgow-exts
 452
 453 \begin{code}
 454 extendTyVarEnvForMethodBinds tyvars thing_inside
 455   = doptRn Opt_GlasgowExts                      `thenRn` \ opt_GlasgowExts ->
 456     if opt_GlasgowExts then
 457         extendTyVarEnvFVRn (map hsTyVarName tyvars) thing_inside
 458     else
 459         thing_inside
 460 \end{code}
 461
 462
 463 %*********************************************************
 464 %*                                                      *
 465 \subsection{Support code for type/data declarations}
 466 %*                                                      *
 467 %*********************************************************
 468
 469 \begin{code}
 470 conDeclName :: RdrNameConDecl -> (RdrName, SrcLoc)
 471 conDeclName (ConDecl n _ _ _ _ l) = (n,l)
 472
 473 rnConDecls :: Name -> DataConDetails RdrNameConDecl -> RnMS (DataConDetails RenamedConDecl)
 474 rnConDecls tycon Unknown     = returnRn Unknown
 475 rnConDecls tycon (HasCons n) = returnRn (HasCons n)
 476 rnConDecls tycon (DataCons condecls)
 477   =     -- Check that there's at least one condecl,
 478         -- or else we're reading an interface file, or -fglasgow-exts
 479     (if null condecls then
 480         doptRn Opt_GlasgowExts  `thenRn` \ glaExts ->
 481         getModeRn               `thenRn` \ mode ->
 482         checkRn (glaExts || isInterfaceMode mode)
 483                 (emptyConDeclsErr tycon)
 484      else returnRn ()
 485     )                                           `thenRn_`
 486
 487     mapRn rnConDecl condecls                    `thenRn` \ condecls' ->
 488     returnRn (DataCons condecls')
 489
 490 rnConDecl :: RdrNameConDecl -> RnMS RenamedConDecl
 491 rnConDecl (ConDecl name wkr tvs cxt details locn)
 492   = pushSrcLocRn locn $
 493     checkConName name           `thenRn_`
 494     lookupTopBndrRn name        `thenRn` \ new_name ->
 495
 496     lookupSysBinder wkr         `thenRn` \ new_wkr ->
 497         -- See comments with ClassDecl
 498
 499     bindTyVarsRn doc tvs                $ \ new_tyvars ->
 500     rnContext doc cxt                   `thenRn` \ new_context ->
 501     rnConDetails doc locn details       `thenRn` \ new_details ->
 502     returnRn (ConDecl new_name new_wkr new_tyvars new_context new_details locn)
 503   where
 504     doc = text "In the definition of data constructor" <+> quotes (ppr name)
 505
 506 rnConDetails doc locn (VanillaCon tys)
 507   = mapRn (rnBangTy doc) tys    `thenRn` \ new_tys  ->
 508     returnRn (VanillaCon new_tys)
 509
 510 rnConDetails doc locn (InfixCon ty1 ty2)
 511   = rnBangTy doc ty1            `thenRn` \ new_ty1 ->
 512     rnBangTy doc ty2            `thenRn` \ new_ty2 ->
 513     returnRn (InfixCon new_ty1 new_ty2)
 514
 515 rnConDetails doc locn (RecCon fields)
 516   = checkDupOrQualNames doc field_names `thenRn_`
 517     mapRn (rnField doc) fields          `thenRn` \ new_fields ->
 518     returnRn (RecCon new_fields)
 519   where
 520     field_names = [(fld, locn) | (flds, _) <- fields, fld <- flds]
 521
 522 rnField doc (names, ty)
 523   = mapRn lookupTopBndrRn names `thenRn` \ new_names ->
 524     rnBangTy doc ty             `thenRn` \ new_ty ->
 525     returnRn (new_names, new_ty)
 526
 527 rnBangTy doc (BangType s ty)
 528   = rnHsType doc ty             `thenRn` \ new_ty ->
 529     returnRn (BangType s new_ty)
 530
 531 -- This data decl will parse OK
 532 --      data T = a Int
 533 -- treating "a" as the constructor.
 534 -- It is really hard to make the parser spot this malformation.
 535 -- So the renamer has to check that the constructor is legal
 536 --
 537 -- We can get an operator as the constructor, even in the prefix form:
 538 --      data T = :% Int Int
 539 -- from interface files, which always print in prefix form
 540
 541 checkConName name
 542   = checkRn (isRdrDataCon name)
 543             (badDataCon name)
 544 \end{code}
 545
 546
 547 %*********************************************************
 548 %*                                                      *
 549 \subsection{Support code to rename types}
 550 %*                                                      *
 551 %*********************************************************
 552
 553 \begin{code}
 554 rnFds :: SDoc -> [FunDep RdrName] -> RnMS [FunDep Name]
 555
 556 rnFds doc fds
 557   = mapRn rn_fds fds
 558   where
 559     rn_fds (tys1, tys2)
 560       = rnHsTyVars doc tys1             `thenRn` \ tys1' ->
 561         rnHsTyVars doc tys2             `thenRn` \ tys2' ->
 562         returnRn (tys1', tys2')
 563
 564 rnHsTyVars doc tvs  = mapRn (rnHsTyvar doc) tvs
 565 rnHsTyvar doc tyvar = lookupOccRn tyvar
 566 \end{code}
 567
 568 %*********************************************************
 569 %*                                                       *
 570 \subsection{IdInfo}
 571 %*                                                       *
 572 %*********************************************************
 573
 574 \begin{code}
 575 rnIdInfo (HsWorker worker arity)
 576   = lookupOccRn worker                  `thenRn` \ worker' ->
 577     returnRn (HsWorker worker' arity)
 578
 579 rnIdInfo (HsUnfold inline expr) = rnCoreExpr expr `thenRn` \ expr' ->
 580                                   returnRn (HsUnfold inline expr')
 581 rnIdInfo (HsStrictness str)     = returnRn (HsStrictness str)
 582 rnIdInfo (HsArity arity)        = returnRn (HsArity arity)
 583 rnIdInfo HsNoCafRefs            = returnRn HsNoCafRefs
 584 \end{code}
 585
 586 @UfCore@ expressions.
 587
 588 \begin{code}
 589 rnCoreExpr (UfType ty)
 590   = rnHsType (text "unfolding type") ty `thenRn` \ ty' ->
 591     returnRn (UfType ty')
 592
 593 rnCoreExpr (UfVar v)
 594   = lookupOccRn v       `thenRn` \ v' ->
 595     returnRn (UfVar v')
 596
 597 rnCoreExpr (UfLit l)
 598   = returnRn (UfLit l)
 599
 600 rnCoreExpr (UfLitLit l ty)
 601   = rnHsType (text "litlit") ty `thenRn` \ ty' ->
 602     returnRn (UfLitLit l ty')
 603
 604 rnCoreExpr (UfFCall cc ty)
 605   = rnHsType (text "ccall") ty  `thenRn` \ ty' ->
 606     returnRn (UfFCall cc ty')
 607
 608 rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
 609   = mapRn rnCoreExpr args               `thenRn` \ args' ->
 610     returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
 611   where
 612     tup_name = getName (dataConWorkId (tupleCon boxity arity))
 613         -- Get the *worker* name and use that
 614
 615 rnCoreExpr (UfApp fun arg)
 616   = rnCoreExpr fun              `thenRn` \ fun' ->
 617     rnCoreExpr arg              `thenRn` \ arg' ->
 618     returnRn (UfApp fun' arg')
 619
 620 rnCoreExpr (UfCase scrut bndr alts)
 621   = rnCoreExpr scrut                    `thenRn` \ scrut' ->
 622     bindCoreLocalRn bndr                $ \ bndr' ->
 623     mapRn rnCoreAlt alts                `thenRn` \ alts' ->
 624     returnRn (UfCase scrut' bndr' alts')
 625
 626 rnCoreExpr (UfNote note expr)
 627   = rnNote note                 `thenRn` \ note' ->
 628     rnCoreExpr expr             `thenRn` \ expr' ->
 629     returnRn  (UfNote note' expr')
 630
 631 rnCoreExpr (UfLam bndr body)
 632   = rnCoreBndr bndr             $ \ bndr' ->
 633     rnCoreExpr body             `thenRn` \ body' ->
 634     returnRn (UfLam bndr' body')
 635
 636 rnCoreExpr (UfLet (UfNonRec bndr rhs) body)
 637   = rnCoreExpr rhs              `thenRn` \ rhs' ->
 638     rnCoreBndr bndr             $ \ bndr' ->
 639     rnCoreExpr body             `thenRn` \ body' ->
 640     returnRn (UfLet (UfNonRec bndr' rhs') body')
 641
 642 rnCoreExpr (UfLet (UfRec pairs) body)
 643   = rnCoreBndrs bndrs           $ \ bndrs' ->
 644     mapRn rnCoreExpr rhss       `thenRn` \ rhss' ->
 645     rnCoreExpr body             `thenRn` \ body' ->
 646     returnRn (UfLet (UfRec (bndrs' `zip` rhss')) body')
 647   where
 648     (bndrs, rhss) = unzip pairs
 649 \end{code}
 650
 651 \begin{code}
 652 rnCoreBndr (UfValBinder name ty) thing_inside
 653   = rnHsType doc ty             `thenRn` \ ty' ->
 654     bindCoreLocalRn name        $ \ name' ->
 655     thing_inside (UfValBinder name' ty')
 656   where
 657     doc = text "unfolding id"
 658
 659 rnCoreBndr (UfTyBinder name kind) thing_inside
 660   = bindCoreLocalRn name                $ \ name' ->
 661     thing_inside (UfTyBinder name' kind)
 662
 663 rnCoreBndrs []     thing_inside = thing_inside []
 664 rnCoreBndrs (b:bs) thing_inside = rnCoreBndr b          $ \ name' ->
 665                                   rnCoreBndrs bs        $ \ names' ->
 666                                   thing_inside (name':names')
 667 \end{code}
 668
 669 \begin{code}
 670 rnCoreAlt (con, bndrs, rhs)
 671   = rnUfCon con                         `thenRn` \ con' ->
 672     bindCoreLocalsRn bndrs              $ \ bndrs' ->
 673     rnCoreExpr rhs                      `thenRn` \ rhs' ->
 674     returnRn (con', bndrs', rhs')
 675
 676 rnNote (UfCoerce ty)
 677   = rnHsType (text "unfolding coerce") ty       `thenRn` \ ty' ->
 678     returnRn (UfCoerce ty')
 679
 680 rnNote (UfSCC cc)   = returnRn (UfSCC cc)
 681 rnNote UfInlineCall = returnRn UfInlineCall
 682 rnNote UfInlineMe   = returnRn UfInlineMe
 683
 684
 685 rnUfCon UfDefault
 686   = returnRn UfDefault
 687
 688 rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
 689   = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
 690   where
 691     tup_name = getName (tupleCon boxity arity)
 692
 693 rnUfCon (UfDataAlt con)
 694   = lookupOccRn con             `thenRn` \ con' ->
 695     returnRn (UfDataAlt con')
 696
 697 rnUfCon (UfLitAlt lit)
 698   = returnRn (UfLitAlt lit)
 699
 700 rnUfCon (UfLitLitAlt lit ty)
 701   = rnHsType (text "litlit") ty         `thenRn` \ ty' ->
 702     returnRn (UfLitLitAlt lit ty')
 703 \end{code}
 704
 705 %*********************************************************
 706 %*                                                       *
 707 \subsection{Rule shapes}
 708 %*                                                       *
 709 %*********************************************************
 710
 711 Check the shape of a transformation rule LHS.  Currently
 712 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
 713 not one of the @forall@'d variables.
 714
 715 \begin{code}
 716 validRuleLhs foralls lhs
 717   = check lhs
 718   where
 719     check (OpApp _ op _ _)                = check op
 720     check (HsApp e1 e2)                   = check e1
 721     check (HsVar v) | v `notElem` foralls = True
 722     check other                           = False
 723 \end{code}
 724
 725
 726 %*********************************************************
 727 %*                                                       *
 728 \subsection{Errors}
 729 %*                                                       *
 730 %*********************************************************
 731
 732 \begin{code}
 733 badDataCon name
 734    = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
 735
 736 badRuleLhsErr name lhs
 737   = sep [ptext SLIT("Rule") <+> ptext name <> colon,
 738          nest 4 (ptext SLIT("Illegal left-hand side:") <+> ppr lhs)]
 739     $$
 740     ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
 741
 742 badRuleVar name var
 743   = sep [ptext SLIT("Rule") <+> doubleQuotes (ptext name) <> colon,
 744          ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
 745                 ptext SLIT("does not appear on left hand side")]
 746
 747 emptyConDeclsErr tycon
 748   = sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
 749          nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
 750 \end{code}