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