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