ghc/compiler/typecheck/TcEnv.lhs

   1 \begin{code}
   2 module TcEnv(
   3         TcIdOcc(..), TcIdBndr, TcIdSet, tcIdType, tcIdTyVars, tcInstId,
   4         tcLookupDataCon,
   5
   6         TcEnv, GlobalValueEnv,
   7
   8         initEnv, getEnv_TyCons, getEnv_Classes,
   9
  10         tcExtendTyVarEnv, tcLookupTyVar, tcLookupTyVarBndrs,
  11
  12         tcExtendTyConEnv, tcLookupTyCon, tcLookupTyConByKey,
  13         tcExtendClassEnv, tcLookupClass, tcLookupClassByKey,
  14         tcGetTyConsAndClasses,
  15
  16         tcExtendGlobalValEnv, tcExtendLocalValEnv, tcExtendEnvWithPat,
  17         tcGetGlobalValEnv, tcSetGlobalValEnv, lookupGlobalByKey,
  18         tcLookupLocalValue, tcLookupLocalValueOK, tcLookupLocalValueByKey,
  19         tcLookupGlobalValue, tcLookupGlobalValueByKey, tcLookupGlobalValueMaybe,
  20         tcAddImportedIdInfo, tcExplicitLookupGlobal,
  21         tcLookupGlobalValueByKeyMaybe,
  22
  23         newLocalIds, newLocalId, newSpecPragmaId,
  24         tcGetGlobalTyVars, tcExtendGlobalTyVars,
  25
  26         tidyType, tidyTypes, tidyTyVar,
  27
  28         badCon, badPrimOp
  29   ) where
  30
  31 #include "HsVersions.h"
  32
  33 import HsTypes  ( getTyVarName )
  34 import Id       ( mkUserLocal, isDataConId_maybe )
  35 import MkId     ( mkSpecPragmaId )
  36 import Var      ( TyVar, Id, GenId, setVarName,
  37                   idType, setIdInfo, idInfo
  38                 )
  39 import TcType   ( TcType, TcTyVar, TcTyVarSet, TcThetaType, TcBox,
  40                   tcInstTyVars, zonkTcTyVars,
  41                   TcKind, kindToTcKind
  42                 )
  43 import VarEnv
  44 import VarSet
  45 import Type     ( Kind,
  46                   tyVarsOfType, tyVarsOfTypes, mkTyVarTy, substTy,
  47                   splitForAllTys, splitRhoTy, splitFunTys, substFlexiTy,
  48                   splitAlgTyConApp_maybe, getTyVar
  49                 )
  50 import DataCon  ( DataCon )
  51 import TyCon    ( TyCon, tyConKind, tyConArity, isSynTyCon )
  52 import Class    ( Class )
  53
  54 import TcMonad
  55
  56 import BasicTypes       ( Arity )
  57 import IdInfo           ( noIdInfo )
  58 import Name             ( Name, OccName(..), nameOccName, occNameString, mkLocalName,
  59                           maybeWiredInTyConName, maybeWiredInIdName, isLocallyDefined,
  60                           isSysLocalName,
  61                           NamedThing(..)
  62                         )
  63 import Unique           ( pprUnique10, Unique, Uniquable(..) )
  64 import FiniteMap        ( lookupFM, addToFM )
  65 import UniqFM
  66 import Unique           ( Uniquable(..) )
  67 import Util             ( zipEqual, zipWith3Equal, mapAccumL )
  68 import Bag              ( bagToList )
  69 import Maybes           ( maybeToBool )
  70 import Outputable
  71 \end{code}
  72
  73 %************************************************************************
  74 %*                                                                      *
  75 \subsection{TcId, TcIdOcc}
  76 %*                                                                      *
  77 %************************************************************************
  78
  79
  80 \begin{code}
  81 type TcIdBndr s = GenId  (TcBox s)      -- Binders are all TcTypes
  82 data TcIdOcc  s = TcId   (TcIdBndr s)   -- Bindees may be either
  83                 | RealId Id
  84
  85 type TcIdSet s  = GenIdSet (TcBox s)
  86
  87 instance Eq (TcIdOcc s) where
  88   (TcId id1)   == (TcId id2)   = id1 == id2
  89   (RealId id1) == (RealId id2) = id1 == id2
  90   _            == _            = False
  91
  92 instance Ord (TcIdOcc s) where
  93   (TcId id1)   `compare` (TcId id2)   = id1 `compare` id2
  94   (RealId id1) `compare` (RealId id2) = id1 `compare` id2
  95   (TcId _)     `compare` (RealId _)   = LT
  96   (RealId _)   `compare` (TcId _)     = GT
  97
  98 instance Outputable (TcIdOcc s) where
  99   ppr (TcId id)   = ppr id
 100   ppr (RealId id) = ppr id
 101
 102 instance NamedThing (TcIdOcc s) where
 103   getName (TcId id)   = getName id
 104   getName (RealId id) = getName id
 105
 106
 107 tcIdType :: TcIdOcc s -> TcType s
 108 tcIdType (TcId   id) = idType id
 109 tcIdType (RealId id) = pprPanic "tcIdType:" (ppr id)
 110
 111 tcIdTyVars (TcId id)  = tyVarsOfType (idType id)
 112 tcIdTyVars (RealId _) = emptyVarSet             -- Top level Ids have no free type variables
 113
 114
 115 tcLookupDataCon :: Name -> TcM s (DataCon, [TcType s], TcType s)
 116 tcLookupDataCon con_name
 117   = tcLookupGlobalValue con_name                `thenNF_Tc` \ con_id ->
 118     case isDataConId_maybe con_id of {
 119         Nothing -> failWithTc (badCon con_id);
 120         Just data_con ->
 121
 122     tcInstId con_id                     `thenNF_Tc` \ (_, _, con_tau) ->
 123              -- Ignore the con_theta; overloaded constructors only
 124              -- behave differently when called, not when used for
 125              -- matching.
 126     let
 127         (arg_tys, result_ty) = splitFunTys con_tau
 128     in
 129     ASSERT( maybeToBool (splitAlgTyConApp_maybe result_ty) )
 130     returnTc (data_con, arg_tys, result_ty) }
 131
 132 -- A useful function that takes an occurrence of a global thing
 133 -- and instantiates its type with fresh type variables
 134 tcInstId :: Id
 135          -> NF_TcM s ([TcTyVar s],      -- It's instantiated type
 136                       TcThetaType s,    --
 137                       TcType s)         --
 138
 139 tcInstId id
 140   = let
 141       (tyvars, rho) = splitForAllTys (idType id)
 142     in
 143     tcInstTyVars tyvars         `thenNF_Tc` \ (tyvars', arg_tys, tenv) ->
 144     let
 145         rho'           = substFlexiTy tenv rho
 146         (theta', tau') = splitRhoTy rho'
 147     in
 148     returnNF_Tc (tyvars', theta', tau')
 149 \end{code}
 150
 151 tidyTy tidies up a type for printing in an error message.
 152
 153 \begin{code}
 154 tidyType :: TidyTypeEnv s -> TcType s -> (TidyTypeEnv s, TcType s)
 155 tidyType env ty
 156   = (env', substTy subst' ty)
 157   where
 158     env'@(_, subst') = foldl go env (varSetElems (tyVarsOfType ty))
 159     go env tyvar     = fst (tidyTyVar env tyvar)
 160
 161 tidyTypes :: TidyTypeEnv s -> [TcType s] -> (TidyTypeEnv s, [TcType s])
 162 tidyTypes env tys = mapAccumL tidyType env tys
 163
 164 tidyTyVar :: TidyTypeEnv s -> TcTyVar s -> (TidyTypeEnv s, TcTyVar s)
 165 tidyTyVar (supply,subst) tyvar
 166   = case lookupVarEnv subst tyvar of
 167         Just ty ->      -- Already substituted
 168                    ((supply,subst), getTyVar "tidyTyVar" ty)
 169         Nothing ->      -- Make a new nice name for it
 170                    ((addToFM supply str next,
 171                      extendVarEnv subst tyvar (mkTyVarTy new_tyvar)),
 172                     new_tyvar)
 173   where
 174     tyvar_name = getName tyvar
 175     is_sys     = isSysLocalName tyvar_name
 176
 177     str | is_sys    = SLIT("$")
 178         | otherwise = occNameString (nameOccName tyvar_name)
 179
 180     next = case lookupFM supply str of
 181                 Nothing -> 0
 182                 Just n  -> n+1
 183
 184     new_tyvar = mkNewTv str is_sys next tyvar
 185
 186 mkNewTv :: FastString -> Bool -> Int -> TcTyVar s -> TcTyVar s
 187 mkNewTv str False  0 tv = tv    -- Leave first non-sys thing alone
 188 mkNewTv str is_sys n tv = setVarName tv (mkLocalName (getUnique tv)
 189                                                      (TvOcc (_PK_ ((_UNPK_ str) ++ show n))))
 190 \end{code}
 191
 192
 193 %************************************************************************
 194 %*                                                                      *
 195 \subsection{TcEnv}
 196 %*                                                                      *
 197 %************************************************************************
 198
 199 Data type declarations
 200 ~~~~~~~~~~~~~~~~~~~~~
 201
 202 \begin{code}
 203 data TcEnv s = TcEnv
 204                   (TcTyVarEnv s)
 205                   (TyConEnv s)
 206                   (ClassEnv s)
 207                   GlobalValueEnv
 208                   (ValueEnv (TcIdBndr s))       -- Locals
 209                   (TcRef s (TcTyVarSet s))      -- Free type variables of locals
 210                                                 -- ...why mutable? see notes with tcGetGlobalTyVars
 211
 212 type TcTyVarEnv s = UniqFM (TcKind s, TyVar)
 213 type TyConEnv s   = UniqFM (TcKind s, Maybe Arity, TyCon)       -- Arity present for Synonyms only
 214 type ClassEnv s   = UniqFM ([TcKind s], Class)          -- The kinds are the kinds of the args
 215                                                         -- to the class
 216 type ValueEnv id = UniqFM id
 217 type GlobalValueEnv = ValueEnv Id                       -- Globals
 218
 219 initEnv :: TcRef s (TcTyVarSet s) -> TcEnv s
 220 initEnv mut = TcEnv emptyUFM emptyUFM emptyUFM emptyUFM emptyUFM mut
 221
 222 getEnv_TyCons   (TcEnv _ ts _ _ _ _) = [tycon | (_, _, tycon) <- eltsUFM ts]
 223 getEnv_Classes  (TcEnv _ _ cs _ _ _) = [clas  | (_, clas)     <- eltsUFM cs]
 224 \end{code}
 225
 226 Type variable env
 227 ~~~~~~~~~~~~~~~~~
 228 \begin{code}
 229 tcExtendTyVarEnv :: [Name] -> [(TcKind s, TyVar)] -> TcM s r -> TcM s r
 230 tcExtendTyVarEnv names kinds_w_types scope
 231   = tcGetEnv                                    `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 232     let
 233         tve' = addListToUFM tve (zipEqual "tcTyVarScope" names kinds_w_types)
 234     in
 235     tcSetEnv (TcEnv tve' tce ce gve lve gtvs) scope
 236 \end{code}
 237
 238 The Kind, TyVar, Class and TyCon envs
 239 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 240
 241 Extending the environments.
 242
 243 \begin{code}
 244 tcExtendTyConEnv :: [(Name, (TcKind s, Maybe Arity, TyCon))] -> TcM s r -> TcM s r
 245
 246 tcExtendTyConEnv bindings scope
 247   = tcGetEnv                                    `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 248     let
 249         tce' = addListToUFM tce bindings
 250     in
 251     tcSetEnv (TcEnv tve tce' ce gve lve gtvs) scope
 252
 253
 254 tcExtendClassEnv :: [(Name, ([TcKind s], Class))] -> TcM s r -> TcM s r
 255 tcExtendClassEnv bindings scope
 256   = tcGetEnv                            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 257     let
 258         ce' = addListToUFM ce bindings
 259     in
 260     tcSetEnv (TcEnv tve tce ce' gve lve gtvs) scope
 261 \end{code}
 262
 263
 264 Looking up in the environments.
 265
 266 \begin{code}
 267 tcLookupTyVarBndrs tyvar_bndrs          -- [HsTyVar name]
 268   = mapAndUnzipNF_Tc (tcLookupTyVar . getTyVarName) tyvar_bndrs
 269
 270 tcLookupTyVar name
 271   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 272     returnNF_Tc (lookupWithDefaultUFM tve (pprPanic "tcLookupTyVar:" (ppr name)) name)
 273
 274
 275 tcLookupTyCon name
 276   =     -- Try for a wired-in tycon
 277     case maybeWiredInTyConName name of {
 278         Just tc | isSynTyCon tc -> returnTc (kind, Just (tyConArity tc), tc)
 279                 | otherwise     -> returnTc (kind, Nothing,              tc)
 280                 where {
 281                   kind = kindToTcKind (tyConKind tc)
 282                 };
 283
 284         Nothing ->
 285
 286             -- Try in the environment
 287           tcGetEnv      `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 288           case lookupUFM tce name of {
 289               Just stuff -> returnTc stuff;
 290
 291               Nothing    ->
 292
 293                 -- Could be that he's using a class name as a type constructor
 294                case lookupUFM ce name of
 295                  Just _  -> failWithTc (classAsTyConErr name)
 296                  Nothing -> pprPanic "tcLookupTyCon:" (ppr name)
 297             } }
 298
 299 tcLookupTyConByKey uniq
 300   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 301     let
 302        (kind, arity, tycon) =  lookupWithDefaultUFM_Directly tce
 303                                         (pprPanic "tcLookupTyConByKey:" (pprUnique10 uniq))
 304                                         uniq
 305     in
 306     returnNF_Tc tycon
 307
 308 tcLookupClass name
 309   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 310     case lookupUFM ce name of
 311         Just stuff         -- Common case: it's ok
 312           -> returnTc stuff
 313
 314         Nothing            -- Could be that he's using a type constructor as a class
 315           |  maybeToBool (maybeWiredInTyConName name)
 316           || maybeToBool (lookupUFM tce name)
 317           -> failWithTc (tyConAsClassErr name)
 318
 319           | otherwise      -- Wierd!  Renamer shouldn't let this happen
 320           -> pprPanic "tcLookupClass" (ppr name)
 321
 322 tcLookupClassByKey uniq
 323   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 324     let
 325         (kind, clas) = lookupWithDefaultUFM_Directly ce
 326                                 (pprPanic "tcLookupClassByKey:" (pprUnique10 uniq))
 327                                 uniq
 328     in
 329     returnNF_Tc clas
 330
 331 tcGetTyConsAndClasses :: NF_TcM s ([TyCon], [Class])
 332 tcGetTyConsAndClasses
 333   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 334     returnNF_Tc ([tc | (_, _, tc) <- eltsUFM tce],
 335                  [c  | (_, c)     <- eltsUFM ce])
 336 \end{code}
 337
 338
 339
 340 Extending and consulting the value environment
 341 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 342 \begin{code}
 343 tcExtendGlobalValEnv ids scope
 344   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 345     let
 346         gve' = addListToUFM_Directly gve [(getUnique id, id) | id <- ids]
 347     in
 348     tcSetEnv (TcEnv tve tce ce gve' lve gtvs) scope
 349
 350 tcExtendLocalValEnv names ids scope
 351   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 352     tcReadMutVar gtvs   `thenNF_Tc` \ global_tvs ->
 353     let
 354         lve' = addListToUFM lve (zipEqual "tcExtendLocalValEnv" names ids)
 355         extra_global_tyvars = tyVarsOfTypes (map idType ids)
 356         new_global_tyvars   = global_tvs `unionVarSet` extra_global_tyvars
 357     in
 358     tcNewMutVar new_global_tyvars       `thenNF_Tc` \ gtvs' ->
 359
 360     tcSetEnv (TcEnv tve tce ce gve lve' gtvs') scope
 361
 362 tcExtendEnvWithPat names_w_ids scope
 363   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 364     tcReadMutVar gtvs   `thenNF_Tc` \ global_tvs ->
 365     let
 366         names_w_ids_list    = bagToList names_w_ids
 367         lve'                = addListToUFM lve names_w_ids_list
 368         extra_global_tyvars = tyVarsOfTypes (map (idType . snd) names_w_ids_list)
 369         new_global_tyvars   = global_tvs `unionVarSet` extra_global_tyvars
 370     in
 371     tcNewMutVar new_global_tyvars       `thenNF_Tc` \ gtvs' ->
 372
 373     tcSetEnv (TcEnv tve tce ce gve lve' gtvs') scope
 374 \end{code}
 375
 376 @tcGetGlobalTyVars@ returns a fully-zonked set of tyvars free in the environment.
 377 To improve subsequent calls to the same function it writes the zonked set back into
 378 the environment.
 379
 380 \begin{code}
 381 tcGetGlobalTyVars :: NF_TcM s (TcTyVarSet s)
 382 tcGetGlobalTyVars
 383   = tcGetEnv                                            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 384     tcReadMutVar gtvs                                   `thenNF_Tc` \ global_tvs ->
 385     zonkTcTyVars (varSetElems global_tvs)               `thenNF_Tc` \ global_tys' ->
 386     let
 387         global_tvs' = (tyVarsOfTypes global_tys')
 388     in
 389     tcWriteMutVar gtvs global_tvs'                      `thenNF_Tc_`
 390     returnNF_Tc global_tvs'
 391
 392 tcExtendGlobalTyVars extra_global_tvs scope
 393   = tcGetEnv                            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 394     tcReadMutVar gtvs                   `thenNF_Tc` \ global_tvs ->
 395     let
 396         new_global_tyvars = global_tvs `unionVarSet` extra_global_tvs
 397     in
 398     tcNewMutVar new_global_tyvars       `thenNF_Tc` \ gtvs' ->
 399     tcSetEnv (TcEnv tve tce ce gve lve gtvs') scope
 400 \end{code}
 401
 402 \begin{code}
 403 tcLookupLocalValue :: Name -> NF_TcM s (Maybe (TcIdBndr s))
 404 tcLookupLocalValue name
 405   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 406     returnNF_Tc (lookupUFM lve name)
 407
 408 tcLookupLocalValueByKey :: Unique -> NF_TcM s (Maybe (TcIdBndr s))
 409 tcLookupLocalValueByKey uniq
 410   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 411     returnNF_Tc (lookupUFM_Directly lve uniq)
 412
 413 tcLookupLocalValueOK :: String -> Name -> NF_TcM s (TcIdBndr s)
 414 tcLookupLocalValueOK err name
 415   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 416     returnNF_Tc (lookupWithDefaultUFM lve (panic err) name)
 417
 418
 419 tcLookupGlobalValue :: Name -> NF_TcM s Id
 420 tcLookupGlobalValue name
 421   = case maybeWiredInIdName name of
 422         Just id -> returnNF_Tc id
 423         Nothing -> tcGetEnv             `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 424                    returnNF_Tc (lookupWithDefaultUFM gve def name)
 425   where
 426     def = pprPanic "tcLookupGlobalValue:" (ppr name)
 427
 428 tcLookupGlobalValueMaybe :: Name -> NF_TcM s (Maybe Id)
 429 tcLookupGlobalValueMaybe name
 430   = case maybeWiredInIdName name of
 431         Just id -> returnNF_Tc (Just id)
 432         Nothing -> tcGetEnv             `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 433                    returnNF_Tc (lookupUFM gve name)
 434
 435
 436 tcLookupGlobalValueByKey :: Unique -> NF_TcM s Id
 437 tcLookupGlobalValueByKey uniq
 438   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 439     returnNF_Tc (lookupGlobalByKey gve uniq)
 440
 441 lookupGlobalByKey :: GlobalValueEnv -> Unique -> Id
 442 lookupGlobalByKey gve uniq
 443   = lookupWithDefaultUFM_Directly gve def uniq
 444   where
 445 #ifdef DEBUG
 446     def = pprPanic "tcLookupGlobalValueByKey:" (pprUnique10 uniq)
 447 #else
 448     def = panic "tcLookupGlobalValueByKey"
 449 #endif
 450
 451 tcLookupGlobalValueByKeyMaybe :: Unique -> NF_TcM s (Maybe Id)
 452 tcLookupGlobalValueByKeyMaybe uniq
 453   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 454     returnNF_Tc (lookupUFM_Directly gve uniq)
 455
 456 tcGetGlobalValEnv :: NF_TcM s GlobalValueEnv
 457 tcGetGlobalValEnv
 458   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce gve lve gtvs) ->
 459     returnNF_Tc gve
 460
 461 tcSetGlobalValEnv :: GlobalValueEnv -> TcM s a -> TcM s a
 462 tcSetGlobalValEnv gve scope
 463   = tcGetEnv            `thenNF_Tc` \ (TcEnv tve tce ce _ lve gtvs) ->
 464     tcSetEnv (TcEnv tve tce ce gve lve gtvs) scope
 465
 466
 467 -- Non-monadic version, environment given explicitly
 468 tcExplicitLookupGlobal :: GlobalValueEnv -> Name -> Maybe Id
 469 tcExplicitLookupGlobal gve name
 470   = case maybeWiredInIdName name of
 471         Just id -> Just id
 472         Nothing -> lookupUFM gve name
 473
 474         -- Extract the IdInfo from an IfaceSig imported from an interface file
 475 tcAddImportedIdInfo :: GlobalValueEnv -> Id -> Id
 476 tcAddImportedIdInfo unf_env id
 477   | isLocallyDefined id         -- Don't look up locally defined Ids, because they
 478                                 -- have explicit local definitions, so we get a black hole!
 479   = id
 480   | otherwise
 481   = id `setIdInfo` new_info
 482         -- The Id must be returned without a data dependency on maybe_id
 483   where
 484     new_info = -- pprTrace "tcAdd" (ppr id) $
 485                case tcExplicitLookupGlobal unf_env (getName id) of
 486                      Nothing          -> noIdInfo
 487                      Just imported_id -> idInfo imported_id
 488                 -- ToDo: could check that types are the same
 489 \end{code}
 490
 491
 492 Constructing new Ids
 493 ~~~~~~~~~~~~~~~~~~~~
 494
 495 \begin{code}
 496 newLocalId :: OccName -> TcType s -> NF_TcM s (TcIdBndr s)
 497 newLocalId name ty
 498   = tcGetUnique         `thenNF_Tc` \ uniq ->
 499     returnNF_Tc (mkUserLocal name uniq ty)
 500
 501 newLocalIds :: [OccName] -> [TcType s] -> NF_TcM s [TcIdBndr s]
 502 newLocalIds names tys
 503   = tcGetUniques (length names) `thenNF_Tc` \ uniqs ->
 504     let
 505         new_ids            = zipWith3Equal "newLocalIds" mk_id names uniqs tys
 506         mk_id name uniq ty = mkUserLocal name uniq ty
 507     in
 508     returnNF_Tc new_ids
 509
 510 newSpecPragmaId :: Name -> TcType s -> NF_TcM s (TcIdBndr s)
 511 newSpecPragmaId name ty
 512   = tcGetUnique         `thenNF_Tc` \ uniq ->
 513     returnNF_Tc (mkSpecPragmaId (nameOccName name) uniq ty)
 514 \end{code}
 515
 516
 517 \begin{code}
 518 classAsTyConErr name
 519   = ptext SLIT("Class used as a type constructor:") <+> ppr name
 520
 521 tyConAsClassErr name
 522   = ptext SLIT("Type constructor used as a class:") <+> ppr name
 523
 524 badCon con_id
 525   = quotes (ppr con_id) <+> ptext SLIT("is not a data constructor")
 526 badPrimOp op
 527   = quotes (ppr op) <+> ptext SLIT("is not a primop")
 528 \end{code}