compiler/typecheck/TcHsSyn.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996-1998
   3 %
   4 \section[TcHsSyn]{Specialisations of the @HsSyn@ syntax for the typechecker}
   5
   6 This module is an extension of @HsSyn@ syntax, for use in the type
   7 checker.
   8
   9 \begin{code}
  10 module TcHsSyn (
  11         mkHsTyApp, mkHsDictApp, mkHsConApp,
  12         mkHsTyLam, mkHsDictLam, mkHsDictLet, mkHsApp,
  13         hsLitType, hsPatType, mkHsAppTy, mkSimpleHsAlt,
  14         nlHsIntLit, mkVanillaTuplePat,
  15
  16
  17         -- re-exported from TcMonad
  18         TcId, TcIdSet, TcDictBinds,
  19
  20         zonkTopDecls, zonkTopExpr, zonkTopLExpr,
  21         zonkId, zonkTopBndrs
  22   ) where
  23
  24 #include "HsVersions.h"
  25
  26 -- friends:
  27 import HsSyn    -- oodles of it
  28
  29 -- others:
  30 import Id       ( idType, setIdType, Id )
  31
  32 import TcRnMonad
  33 import Type       ( Type )
  34 import TcType     ( TcType, TcTyVar, mkTyVarTy, mkTyConApp, isImmutableTyVar )
  35 import Kind       ( isLiftedTypeKind, liftedTypeKind, isSubKind )
  36 import qualified  Type
  37 import TcMType    ( zonkQuantifiedTyVar, zonkType, zonkTcType, writeMetaTyVar )
  38 import TysPrim    ( charPrimTy, intPrimTy, floatPrimTy,
  39                     doublePrimTy, addrPrimTy
  40                   )
  41 import TysWiredIn ( charTy, stringTy, intTy,
  42                     mkListTy, mkPArrTy, mkTupleTy, unitTy,
  43                     voidTy, listTyCon, tupleTyCon )
  44 import TyCon      ( mkPrimTyCon, tyConKind, PrimRep(..) )
  45 import Kind       ( splitKindFunTys )
  46 import Name       ( Name, getOccName, mkInternalName, mkDerivedTyConOcc )
  47 import Var        ( Var, isId, isLocalVar, tyVarKind )
  48 import VarSet
  49 import VarEnv
  50 import BasicTypes ( Boxity(..), IPName(..), ipNameName, mapIPName )
  51 import Maybes     ( orElse )
  52 import Unique     ( Uniquable(..) )
  53 import SrcLoc     ( noSrcLoc, noLoc, Located(..), unLoc )
  54 import Util       ( mapSnd )
  55 import Bag
  56 import Outputable
  57 \end{code}
  58
  59
  60 %************************************************************************
  61 %*                                                                      *
  62 \subsection[mkFailurePair]{Code for pattern-matching and other failures}
  63 %*                                                                      *
  64 %************************************************************************
  65
  66 Note: If @hsPatType@ doesn't bear a strong resemblance to @exprType@,
  67 then something is wrong.
  68 \begin{code}
  69 mkVanillaTuplePat :: [OutPat Id] -> Boxity -> Pat Id
  70 -- A vanilla tuple pattern simply gets its type from its sub-patterns
  71 mkVanillaTuplePat pats box
  72   = TuplePat pats box (mkTupleTy box (length pats) (map hsPatType pats))
  73
  74 hsPatType :: OutPat Id -> Type
  75 hsPatType (L _ pat) = pat_type pat
  76
  77 pat_type (ParPat pat)              = hsPatType pat
  78 pat_type (WildPat ty)              = ty
  79 pat_type (VarPat var)              = idType var
  80 pat_type (VarPatOut var _)         = idType var
  81 pat_type (BangPat pat)             = hsPatType pat
  82 pat_type (LazyPat pat)             = hsPatType pat
  83 pat_type (LitPat lit)              = hsLitType lit
  84 pat_type (AsPat var pat)           = idType (unLoc var)
  85 pat_type (ListPat _ ty)            = mkListTy ty
  86 pat_type (PArrPat _ ty)            = mkPArrTy ty
  87 pat_type (TuplePat pats box ty)    = ty
  88 pat_type (ConPatOut _ _ _ _ _ ty)  = ty
  89 pat_type (SigPatOut pat ty)        = ty
  90 pat_type (NPat lit _ _ ty)         = ty
  91 pat_type (NPlusKPat id _ _ _)      = idType (unLoc id)
  92 pat_type (DictPat ds ms)           = case (ds ++ ms) of
  93                                        []  -> unitTy
  94                                        [d] -> idType d
  95                                        ds  -> mkTupleTy Boxed (length ds) (map idType ds)
  96
  97
  98 hsLitType :: HsLit -> TcType
  99 hsLitType (HsChar c)       = charTy
 100 hsLitType (HsCharPrim c)   = charPrimTy
 101 hsLitType (HsString str)   = stringTy
 102 hsLitType (HsStringPrim s) = addrPrimTy
 103 hsLitType (HsInt i)        = intTy
 104 hsLitType (HsIntPrim i)    = intPrimTy
 105 hsLitType (HsInteger i ty) = ty
 106 hsLitType (HsRat _ ty)     = ty
 107 hsLitType (HsFloatPrim f)  = floatPrimTy
 108 hsLitType (HsDoublePrim d) = doublePrimTy
 109 \end{code}
 110
 111
 112 %************************************************************************
 113 %*                                                                      *
 114 \subsection[BackSubst-HsBinds]{Running a substitution over @HsBinds@}
 115 %*                                                                      *
 116 %************************************************************************
 117
 118 \begin{code}
 119 -- zonkId is used *during* typechecking just to zonk the Id's type
 120 zonkId :: TcId -> TcM TcId
 121 zonkId id
 122   = zonkTcType (idType id) `thenM` \ ty' ->
 123     returnM (setIdType id ty')
 124 \end{code}
 125
 126 The rest of the zonking is done *after* typechecking.
 127 The main zonking pass runs over the bindings
 128
 129  a) to convert TcTyVars to TyVars etc, dereferencing any bindings etc
 130  b) convert unbound TcTyVar to Void
 131  c) convert each TcId to an Id by zonking its type
 132
 133 The type variables are converted by binding mutable tyvars to immutable ones
 134 and then zonking as normal.
 135
 136 The Ids are converted by binding them in the normal Tc envt; that
 137 way we maintain sharing; eg an Id is zonked at its binding site and they
 138 all occurrences of that Id point to the common zonked copy
 139
 140 It's all pretty boring stuff, because HsSyn is such a large type, and
 141 the environment manipulation is tiresome.
 142
 143 \begin{code}
 144 data ZonkEnv = ZonkEnv  (TcType -> TcM Type)    -- How to zonk a type
 145                         (IdEnv Id)              -- What variables are in scope
 146         -- Maps an Id to its zonked version; both have the same Name
 147         -- Is only consulted lazily; hence knot-tying
 148
 149 emptyZonkEnv = ZonkEnv zonkTypeZapping emptyVarEnv
 150
 151 extendZonkEnv :: ZonkEnv -> [Id] -> ZonkEnv
 152 extendZonkEnv (ZonkEnv zonk_ty env) ids
 153   = ZonkEnv zonk_ty (extendVarEnvList env [(id,id) | id <- ids])
 154
 155 extendZonkEnv1 :: ZonkEnv -> Id -> ZonkEnv
 156 extendZonkEnv1 (ZonkEnv zonk_ty env) id
 157   = ZonkEnv zonk_ty (extendVarEnv env id id)
 158
 159 setZonkType :: ZonkEnv -> (TcType -> TcM Type) -> ZonkEnv
 160 setZonkType (ZonkEnv _ env) zonk_ty = ZonkEnv zonk_ty env
 161
 162 zonkEnvIds :: ZonkEnv -> [Id]
 163 zonkEnvIds (ZonkEnv _ env) = varEnvElts env
 164
 165 zonkIdOcc :: ZonkEnv -> TcId -> Id
 166 -- Ids defined in this module should be in the envt;
 167 -- ignore others.  (Actually, data constructors are also
 168 -- not LocalVars, even when locally defined, but that is fine.)
 169 -- (Also foreign-imported things aren't currently in the ZonkEnv;
 170 --  that's ok because they don't need zonking.)
 171 --
 172 -- Actually, Template Haskell works in 'chunks' of declarations, and
 173 -- an earlier chunk won't be in the 'env' that the zonking phase
 174 -- carries around.  Instead it'll be in the tcg_gbl_env, already fully
 175 -- zonked.  There's no point in looking it up there (except for error
 176 -- checking), and it's not conveniently to hand; hence the simple
 177 -- 'orElse' case in the LocalVar branch.
 178 --
 179 -- Even without template splices, in module Main, the checking of
 180 -- 'main' is done as a separate chunk.
 181 zonkIdOcc (ZonkEnv zonk_ty env) id
 182   | isLocalVar id = lookupVarEnv env id `orElse` id
 183   | otherwise     = id
 184
 185 zonkIdOccs env ids = map (zonkIdOcc env) ids
 186
 187 -- zonkIdBndr is used *after* typechecking to get the Id's type
 188 -- to its final form.  The TyVarEnv give
 189 zonkIdBndr :: ZonkEnv -> TcId -> TcM Id
 190 zonkIdBndr env id
 191   = zonkTcTypeToType env (idType id)    `thenM` \ ty' ->
 192     returnM (setIdType id ty')
 193
 194 zonkIdBndrs :: ZonkEnv -> [TcId] -> TcM [Id]
 195 zonkIdBndrs env ids = mappM (zonkIdBndr env) ids
 196
 197 zonkTopBndrs :: [TcId] -> TcM [Id]
 198 zonkTopBndrs ids = zonkIdBndrs emptyZonkEnv ids
 199 \end{code}
 200
 201
 202 \begin{code}
 203 zonkTopExpr :: HsExpr TcId -> TcM (HsExpr Id)
 204 zonkTopExpr e = zonkExpr emptyZonkEnv e
 205
 206 zonkTopLExpr :: LHsExpr TcId -> TcM (LHsExpr Id)
 207 zonkTopLExpr e = zonkLExpr emptyZonkEnv e
 208
 209 zonkTopDecls :: LHsBinds TcId -> [LRuleDecl TcId] -> [LForeignDecl TcId]
 210              -> TcM ([Id],
 211                      Bag (LHsBind  Id),
 212                      [LForeignDecl Id],
 213                      [LRuleDecl    Id])
 214 zonkTopDecls binds rules fords
 215   = do  { (env, binds') <- zonkRecMonoBinds emptyZonkEnv binds
 216                         -- Top level is implicitly recursive
 217         ; rules' <- zonkRules env rules
 218         ; fords' <- zonkForeignExports env fords
 219         ; return (zonkEnvIds env, binds', fords', rules') }
 220
 221 ---------------------------------------------
 222 zonkLocalBinds :: ZonkEnv -> HsLocalBinds TcId -> TcM (ZonkEnv, HsLocalBinds Id)
 223 zonkLocalBinds env EmptyLocalBinds
 224   = return (env, EmptyLocalBinds)
 225
 226 zonkLocalBinds env (HsValBinds binds)
 227   = do  { (env1, new_binds) <- zonkValBinds env binds
 228         ; return (env1, HsValBinds new_binds) }
 229
 230 zonkLocalBinds env (HsIPBinds (IPBinds binds dict_binds))
 231   = mappM (wrapLocM zonk_ip_bind) binds `thenM` \ new_binds ->
 232     let
 233         env1 = extendZonkEnv env [ipNameName n | L _ (IPBind n _) <- new_binds]
 234     in
 235     zonkRecMonoBinds env1 dict_binds    `thenM` \ (env2, new_dict_binds) ->
 236     returnM (env2, HsIPBinds (IPBinds new_binds new_dict_binds))
 237   where
 238     zonk_ip_bind (IPBind n e)
 239         = mapIPNameTc (zonkIdBndr env) n        `thenM` \ n' ->
 240           zonkLExpr env e                       `thenM` \ e' ->
 241           returnM (IPBind n' e')
 242
 243
 244 ---------------------------------------------
 245 zonkValBinds :: ZonkEnv -> HsValBinds TcId -> TcM (ZonkEnv, HsValBinds Id)
 246 zonkValBinds env bs@(ValBindsIn _ _)
 247   = panic "zonkValBinds"        -- Not in typechecker output
 248 zonkValBinds env (ValBindsOut binds sigs)
 249   = do  { (env1, new_binds) <- go env binds
 250         ; return (env1, ValBindsOut new_binds sigs) }
 251   where
 252     go env []         = return (env, [])
 253     go env ((r,b):bs) = do { (env1, b')  <- zonkRecMonoBinds env b
 254                            ; (env2, bs') <- go env1 bs
 255                            ; return (env2, (r,b'):bs') }
 256
 257 ---------------------------------------------
 258 zonkRecMonoBinds :: ZonkEnv -> LHsBinds TcId -> TcM (ZonkEnv, LHsBinds Id)
 259 zonkRecMonoBinds env binds
 260  = fixM (\ ~(_, new_binds) -> do
 261         { let env1 = extendZonkEnv env (collectHsBindBinders new_binds)
 262         ; binds' <- zonkMonoBinds env1 binds
 263         ; return (env1, binds') })
 264
 265 ---------------------------------------------
 266 zonkMonoBinds :: ZonkEnv -> LHsBinds TcId -> TcM (LHsBinds Id)
 267 zonkMonoBinds env binds = mapBagM (wrapLocM (zonk_bind env)) binds
 268
 269 zonk_bind :: ZonkEnv -> HsBind TcId -> TcM (HsBind Id)
 270 zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss, pat_rhs_ty = ty})
 271   = do  { (_env, new_pat) <- zonkPat env pat            -- Env already extended
 272         ; new_grhss <- zonkGRHSs env grhss
 273         ; new_ty    <- zonkTcTypeToType env ty
 274         ; return (bind { pat_lhs = new_pat, pat_rhs = new_grhss, pat_rhs_ty = new_ty }) }
 275
 276 zonk_bind env (VarBind { var_id = var, var_rhs = expr })
 277   = zonkIdBndr env var                  `thenM` \ new_var ->
 278     zonkLExpr env expr                  `thenM` \ new_expr ->
 279     returnM (VarBind { var_id = new_var, var_rhs = new_expr })
 280
 281 zonk_bind env bind@(FunBind { fun_id = var, fun_matches = ms, fun_co_fn = co_fn })
 282   = wrapLocM (zonkIdBndr env) var       `thenM` \ new_var ->
 283     zonkCoFn env co_fn                  `thenM` \ (env1, new_co_fn) ->
 284     zonkMatchGroup env1 ms              `thenM` \ new_ms ->
 285     returnM (bind { fun_id = new_var, fun_matches = new_ms, fun_co_fn = new_co_fn })
 286
 287 zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_dicts = dicts,
 288                           abs_exports = exports, abs_binds = val_binds })
 289   = ASSERT( all isImmutableTyVar tyvars )
 290     zonkIdBndrs env dicts               `thenM` \ new_dicts ->
 291     fixM (\ ~(new_val_binds, _) ->
 292         let
 293           env1 = extendZonkEnv env new_dicts
 294           env2 = extendZonkEnv env1 (collectHsBindBinders new_val_binds)
 295         in
 296         zonkMonoBinds env2 val_binds            `thenM` \ new_val_binds ->
 297         mappM (zonkExport env2) exports         `thenM` \ new_exports ->
 298         returnM (new_val_binds, new_exports)
 299     )                                           `thenM` \ (new_val_bind, new_exports) ->
 300     returnM (AbsBinds { abs_tvs = tyvars, abs_dicts = new_dicts,
 301                         abs_exports = new_exports, abs_binds = new_val_bind })
 302   where
 303     zonkExport env (tyvars, global, local, prags)
 304         = zonkIdBndr env global                 `thenM` \ new_global ->
 305           mapM zonk_prag prags                  `thenM` \ new_prags ->
 306           returnM (tyvars, new_global, zonkIdOcc env local, new_prags)
 307     zonk_prag prag@(InlinePrag {})  = return prag
 308     zonk_prag (SpecPrag expr ty ds inl) = do { expr' <- zonkExpr env expr
 309                                              ; ty'   <- zonkTcTypeToType env ty
 310                                              ; let ds' = zonkIdOccs env ds
 311                                              ; return (SpecPrag expr' ty' ds' inl) }
 312 \end{code}
 313
 314 %************************************************************************
 315 %*                                                                      *
 316 \subsection[BackSubst-Match-GRHSs]{Match and GRHSs}
 317 %*                                                                      *
 318 %************************************************************************
 319
 320 \begin{code}
 321 zonkMatchGroup :: ZonkEnv -> MatchGroup TcId-> TcM (MatchGroup Id)
 322 zonkMatchGroup env (MatchGroup ms ty)
 323   = do  { ms' <- mapM (zonkMatch env) ms
 324         ; ty' <- zonkTcTypeToType env ty
 325         ; return (MatchGroup ms' ty') }
 326
 327 zonkMatch :: ZonkEnv -> LMatch TcId-> TcM (LMatch Id)
 328 zonkMatch env (L loc (Match pats _ grhss))
 329   = do  { (env1, new_pats) <- zonkPats env pats
 330         ; new_grhss <- zonkGRHSs env1 grhss
 331         ; return (L loc (Match new_pats Nothing new_grhss)) }
 332
 333 -------------------------------------------------------------------------
 334 zonkGRHSs :: ZonkEnv -> GRHSs TcId -> TcM (GRHSs Id)
 335
 336 zonkGRHSs env (GRHSs grhss binds)
 337   = zonkLocalBinds env binds    `thenM` \ (new_env, new_binds) ->
 338     let
 339         zonk_grhs (GRHS guarded rhs)
 340           = zonkStmts new_env guarded   `thenM` \ (env2, new_guarded) ->
 341             zonkLExpr env2 rhs          `thenM` \ new_rhs ->
 342             returnM (GRHS new_guarded new_rhs)
 343     in
 344     mappM (wrapLocM zonk_grhs) grhss    `thenM` \ new_grhss ->
 345     returnM (GRHSs new_grhss new_binds)
 346 \end{code}
 347
 348 %************************************************************************
 349 %*                                                                      *
 350 \subsection[BackSubst-HsExpr]{Running a zonkitution over a TypeCheckedExpr}
 351 %*                                                                      *
 352 %************************************************************************
 353
 354 \begin{code}
 355 zonkLExprs :: ZonkEnv -> [LHsExpr TcId] -> TcM [LHsExpr Id]
 356 zonkLExpr  :: ZonkEnv -> LHsExpr TcId   -> TcM (LHsExpr Id)
 357 zonkExpr   :: ZonkEnv -> HsExpr TcId    -> TcM (HsExpr Id)
 358
 359 zonkLExprs env exprs = mappM (zonkLExpr env) exprs
 360 zonkLExpr  env expr  = wrapLocM (zonkExpr env) expr
 361
 362 zonkExpr env (HsVar id)
 363   = returnM (HsVar (zonkIdOcc env id))
 364
 365 zonkExpr env (HsIPVar id)
 366   = returnM (HsIPVar (mapIPName (zonkIdOcc env) id))
 367
 368 zonkExpr env (HsLit (HsRat f ty))
 369   = zonkTcTypeToType env ty        `thenM` \ new_ty  ->
 370     returnM (HsLit (HsRat f new_ty))
 371
 372 zonkExpr env (HsLit lit)
 373   = returnM (HsLit lit)
 374
 375 zonkExpr env (HsOverLit lit)
 376   = do  { lit' <- zonkOverLit env lit
 377         ; return (HsOverLit lit') }
 378
 379 zonkExpr env (HsLam matches)
 380   = zonkMatchGroup env matches  `thenM` \ new_matches ->
 381     returnM (HsLam new_matches)
 382
 383 zonkExpr env (HsApp e1 e2)
 384   = zonkLExpr env e1    `thenM` \ new_e1 ->
 385     zonkLExpr env e2    `thenM` \ new_e2 ->
 386     returnM (HsApp new_e1 new_e2)
 387
 388 zonkExpr env (HsBracketOut body bs)
 389   = mappM zonk_b bs     `thenM` \ bs' ->
 390     returnM (HsBracketOut body bs')
 391   where
 392     zonk_b (n,e) = zonkLExpr env e      `thenM` \ e' ->
 393                    returnM (n,e')
 394
 395 zonkExpr env (HsSpliceE s) = WARN( True, ppr s )        -- Should not happen
 396                              returnM (HsSpliceE s)
 397
 398 zonkExpr env (OpApp e1 op fixity e2)
 399   = zonkLExpr env e1    `thenM` \ new_e1 ->
 400     zonkLExpr env op    `thenM` \ new_op ->
 401     zonkLExpr env e2    `thenM` \ new_e2 ->
 402     returnM (OpApp new_e1 new_op fixity new_e2)
 403
 404 zonkExpr env (NegApp expr op)
 405   = zonkLExpr env expr  `thenM` \ new_expr ->
 406     zonkExpr env op     `thenM` \ new_op ->
 407     returnM (NegApp new_expr new_op)
 408
 409 zonkExpr env (HsPar e)
 410   = zonkLExpr env e     `thenM` \new_e ->
 411     returnM (HsPar new_e)
 412
 413 zonkExpr env (SectionL expr op)
 414   = zonkLExpr env expr  `thenM` \ new_expr ->
 415     zonkLExpr env op            `thenM` \ new_op ->
 416     returnM (SectionL new_expr new_op)
 417
 418 zonkExpr env (SectionR op expr)
 419   = zonkLExpr env op            `thenM` \ new_op ->
 420     zonkLExpr env expr          `thenM` \ new_expr ->
 421     returnM (SectionR new_op new_expr)
 422
 423 zonkExpr env (HsCase expr ms)
 424   = zonkLExpr env expr          `thenM` \ new_expr ->
 425     zonkMatchGroup env ms       `thenM` \ new_ms ->
 426     returnM (HsCase new_expr new_ms)
 427
 428 zonkExpr env (HsIf e1 e2 e3)
 429   = zonkLExpr env e1    `thenM` \ new_e1 ->
 430     zonkLExpr env e2    `thenM` \ new_e2 ->
 431     zonkLExpr env e3    `thenM` \ new_e3 ->
 432     returnM (HsIf new_e1 new_e2 new_e3)
 433
 434 zonkExpr env (HsLet binds expr)
 435   = zonkLocalBinds env binds    `thenM` \ (new_env, new_binds) ->
 436     zonkLExpr new_env expr      `thenM` \ new_expr ->
 437     returnM (HsLet new_binds new_expr)
 438
 439 zonkExpr env (HsDo do_or_lc stmts body ty)
 440   = zonkStmts env stmts         `thenM` \ (new_env, new_stmts) ->
 441     zonkLExpr new_env body      `thenM` \ new_body ->
 442     zonkTcTypeToType env ty     `thenM` \ new_ty   ->
 443     returnM (HsDo (zonkDo env do_or_lc)
 444                   new_stmts new_body new_ty)
 445
 446 zonkExpr env (ExplicitList ty exprs)
 447   = zonkTcTypeToType env ty     `thenM` \ new_ty ->
 448     zonkLExprs env exprs        `thenM` \ new_exprs ->
 449     returnM (ExplicitList new_ty new_exprs)
 450
 451 zonkExpr env (ExplicitPArr ty exprs)
 452   = zonkTcTypeToType env ty     `thenM` \ new_ty ->
 453     zonkLExprs env exprs        `thenM` \ new_exprs ->
 454     returnM (ExplicitPArr new_ty new_exprs)
 455
 456 zonkExpr env (ExplicitTuple exprs boxed)
 457   = zonkLExprs env exprs        `thenM` \ new_exprs ->
 458     returnM (ExplicitTuple new_exprs boxed)
 459
 460 zonkExpr env (RecordCon data_con con_expr rbinds)
 461   = zonkExpr env con_expr       `thenM` \ new_con_expr ->
 462     zonkRbinds env rbinds       `thenM` \ new_rbinds ->
 463     returnM (RecordCon data_con new_con_expr new_rbinds)
 464
 465 zonkExpr env (RecordUpd expr rbinds in_ty out_ty)
 466   = zonkLExpr env expr          `thenM` \ new_expr ->
 467     zonkTcTypeToType env in_ty  `thenM` \ new_in_ty ->
 468     zonkTcTypeToType env out_ty `thenM` \ new_out_ty ->
 469     zonkRbinds env rbinds       `thenM` \ new_rbinds ->
 470     returnM (RecordUpd new_expr new_rbinds new_in_ty new_out_ty)
 471
 472 zonkExpr env (ExprWithTySigOut e ty)
 473   = do { e' <- zonkLExpr env e
 474        ; return (ExprWithTySigOut e' ty) }
 475
 476 zonkExpr env (ExprWithTySig _ _) = panic "zonkExpr env:ExprWithTySig"
 477
 478 zonkExpr env (ArithSeq expr info)
 479   = zonkExpr env expr           `thenM` \ new_expr ->
 480     zonkArithSeq env info       `thenM` \ new_info ->
 481     returnM (ArithSeq new_expr new_info)
 482
 483 zonkExpr env (PArrSeq expr info)
 484   = zonkExpr env expr           `thenM` \ new_expr ->
 485     zonkArithSeq env info       `thenM` \ new_info ->
 486     returnM (PArrSeq new_expr new_info)
 487
 488 zonkExpr env (HsSCC lbl expr)
 489   = zonkLExpr env expr  `thenM` \ new_expr ->
 490     returnM (HsSCC lbl new_expr)
 491
 492 -- hdaume: core annotations
 493 zonkExpr env (HsCoreAnn lbl expr)
 494   = zonkLExpr env expr   `thenM` \ new_expr ->
 495     returnM (HsCoreAnn lbl new_expr)
 496
 497 zonkExpr env (TyLam tyvars expr)
 498   = ASSERT( all isImmutableTyVar tyvars )
 499     zonkLExpr env expr                  `thenM` \ new_expr ->
 500     returnM (TyLam tyvars new_expr)
 501
 502 zonkExpr env (TyApp expr tys)
 503   = zonkLExpr env expr          `thenM` \ new_expr ->
 504     zonkTcTypeToTypes env tys   `thenM` \ new_tys ->
 505     returnM (TyApp new_expr new_tys)
 506
 507 zonkExpr env (DictLam dicts expr)
 508   = zonkIdBndrs env dicts       `thenM` \ new_dicts ->
 509     let
 510         env1 = extendZonkEnv env new_dicts
 511     in
 512     zonkLExpr env1 expr         `thenM` \ new_expr ->
 513     returnM (DictLam new_dicts new_expr)
 514
 515 zonkExpr env (DictApp expr dicts)
 516   = zonkLExpr env expr                  `thenM` \ new_expr ->
 517     returnM (DictApp new_expr (zonkIdOccs env dicts))
 518
 519 -- arrow notation extensions
 520 zonkExpr env (HsProc pat body)
 521   = do  { (env1, new_pat) <- zonkPat env pat
 522         ; new_body <- zonkCmdTop env1 body
 523         ; return (HsProc new_pat new_body) }
 524
 525 zonkExpr env (HsArrApp e1 e2 ty ho rl)
 526   = zonkLExpr env e1                    `thenM` \ new_e1 ->
 527     zonkLExpr env e2                    `thenM` \ new_e2 ->
 528     zonkTcTypeToType env ty             `thenM` \ new_ty ->
 529     returnM (HsArrApp new_e1 new_e2 new_ty ho rl)
 530
 531 zonkExpr env (HsArrForm op fixity args)
 532   = zonkLExpr env op                    `thenM` \ new_op ->
 533     mappM (zonkCmdTop env) args         `thenM` \ new_args ->
 534     returnM (HsArrForm new_op fixity new_args)
 535
 536 zonkExpr env (HsCoerce co_fn expr)
 537   = zonkCoFn env co_fn  `thenM` \ (env1, new_co_fn) ->
 538     zonkExpr env1 expr  `thenM` \ new_expr ->
 539     return (HsCoerce new_co_fn new_expr)
 540
 541 zonkExpr env other = pprPanic "zonkExpr" (ppr other)
 542
 543 zonkCmdTop :: ZonkEnv -> LHsCmdTop TcId -> TcM (LHsCmdTop Id)
 544 zonkCmdTop env cmd = wrapLocM (zonk_cmd_top env) cmd
 545
 546 zonk_cmd_top env (HsCmdTop cmd stack_tys ty ids)
 547   = zonkLExpr env cmd                   `thenM` \ new_cmd ->
 548     zonkTcTypeToTypes env stack_tys     `thenM` \ new_stack_tys ->
 549     zonkTcTypeToType env ty             `thenM` \ new_ty ->
 550     mapSndM (zonkExpr env) ids          `thenM` \ new_ids ->
 551     returnM (HsCmdTop new_cmd new_stack_tys new_ty new_ids)
 552
 553 -------------------------------------------------------------------------
 554 zonkCoFn :: ZonkEnv -> ExprCoFn -> TcM (ZonkEnv, ExprCoFn)
 555 zonkCoFn env CoHole = return (env, CoHole)
 556 zonkCoFn env (CoCompose c1 c2) = do { (env1, c1') <- zonkCoFn env c1
 557                                     ; (env2, c2') <- zonkCoFn env1 c2
 558                                     ; return (env2, CoCompose c1' c2') }
 559 zonkCoFn env (CoLams ids c) = do { ids' <- zonkIdBndrs env ids
 560                                  ; let env1 = extendZonkEnv env ids'
 561                                  ; (env2, c') <- zonkCoFn env1 c
 562                                  ; return (env2, CoLams ids' c') }
 563 zonkCoFn env (CoTyLams tvs c) = ASSERT( all isImmutableTyVar tvs )
 564                                 do { (env1, c') <- zonkCoFn env c
 565                                    ; return (env1, CoTyLams tvs c') }
 566 zonkCoFn env (CoApps c ids)   = do { (env1, c') <- zonkCoFn env c
 567                                    ; return (env1, CoApps c' (zonkIdOccs env ids)) }
 568 zonkCoFn env (CoTyApps c tys) = do { tys' <- zonkTcTypeToTypes env tys
 569                                    ; (env1, c') <- zonkCoFn env c
 570                                    ; return (env1, CoTyApps c' tys') }
 571 zonkCoFn env (CoLet bs c)     = do { (env1, bs') <- zonkRecMonoBinds env bs
 572                                    ; (env2, c')  <- zonkCoFn env1 c
 573                                    ; return (env2, CoLet bs' c') }
 574
 575
 576 -------------------------------------------------------------------------
 577 zonkDo :: ZonkEnv -> HsStmtContext Name -> HsStmtContext Name
 578 -- Only used for 'do', so the only Ids are in a MDoExpr table
 579 zonkDo env (MDoExpr tbl) = MDoExpr (mapSnd (zonkIdOcc env) tbl)
 580 zonkDo env do_or_lc      = do_or_lc
 581
 582 -------------------------------------------------------------------------
 583 zonkOverLit :: ZonkEnv -> HsOverLit TcId -> TcM (HsOverLit Id)
 584 zonkOverLit env (HsIntegral i e)
 585   = do  { e' <- zonkExpr env e; return (HsIntegral i e') }
 586 zonkOverLit env (HsFractional r e)
 587   = do  { e' <- zonkExpr env e; return (HsFractional r e') }
 588
 589 -------------------------------------------------------------------------
 590 zonkArithSeq :: ZonkEnv -> ArithSeqInfo TcId -> TcM (ArithSeqInfo Id)
 591
 592 zonkArithSeq env (From e)
 593   = zonkLExpr env e             `thenM` \ new_e ->
 594     returnM (From new_e)
 595
 596 zonkArithSeq env (FromThen e1 e2)
 597   = zonkLExpr env e1    `thenM` \ new_e1 ->
 598     zonkLExpr env e2    `thenM` \ new_e2 ->
 599     returnM (FromThen new_e1 new_e2)
 600
 601 zonkArithSeq env (FromTo e1 e2)
 602   = zonkLExpr env e1    `thenM` \ new_e1 ->
 603     zonkLExpr env e2    `thenM` \ new_e2 ->
 604     returnM (FromTo new_e1 new_e2)
 605
 606 zonkArithSeq env (FromThenTo e1 e2 e3)
 607   = zonkLExpr env e1    `thenM` \ new_e1 ->
 608     zonkLExpr env e2    `thenM` \ new_e2 ->
 609     zonkLExpr env e3    `thenM` \ new_e3 ->
 610     returnM (FromThenTo new_e1 new_e2 new_e3)
 611
 612
 613 -------------------------------------------------------------------------
 614 zonkStmts :: ZonkEnv -> [LStmt TcId] -> TcM (ZonkEnv, [LStmt Id])
 615 zonkStmts env []     = return (env, [])
 616 zonkStmts env (s:ss) = do { (env1, s')  <- wrapLocSndM (zonkStmt env) s
 617                           ; (env2, ss') <- zonkStmts env1 ss
 618                           ; return (env2, s' : ss') }
 619
 620 zonkStmt :: ZonkEnv -> Stmt TcId -> TcM (ZonkEnv, Stmt Id)
 621 zonkStmt env (ParStmt stmts_w_bndrs)
 622   = mappM zonk_branch stmts_w_bndrs     `thenM` \ new_stmts_w_bndrs ->
 623     let
 624         new_binders = concat (map snd new_stmts_w_bndrs)
 625         env1 = extendZonkEnv env new_binders
 626     in
 627     return (env1, ParStmt new_stmts_w_bndrs)
 628   where
 629     zonk_branch (stmts, bndrs) = zonkStmts env stmts    `thenM` \ (env1, new_stmts) ->
 630                                  returnM (new_stmts, zonkIdOccs env1 bndrs)
 631
 632 zonkStmt env (RecStmt segStmts lvs rvs rets binds)
 633   = zonkIdBndrs env rvs         `thenM` \ new_rvs ->
 634     let
 635         env1 = extendZonkEnv env new_rvs
 636     in
 637     zonkStmts env1 segStmts     `thenM` \ (env2, new_segStmts) ->
 638         -- Zonk the ret-expressions in an envt that
 639         -- has the polymorphic bindings in the envt
 640     mapM (zonkExpr env2) rets   `thenM` \ new_rets ->
 641     let
 642         new_lvs = zonkIdOccs env2 lvs
 643         env3 = extendZonkEnv env new_lvs        -- Only the lvs are needed
 644     in
 645     zonkRecMonoBinds env3 binds `thenM` \ (env4, new_binds) ->
 646     returnM (env4, RecStmt new_segStmts new_lvs new_rvs new_rets new_binds)
 647
 648 zonkStmt env (ExprStmt expr then_op ty)
 649   = zonkLExpr env expr          `thenM` \ new_expr ->
 650     zonkExpr env then_op        `thenM` \ new_then ->
 651     zonkTcTypeToType env ty     `thenM` \ new_ty ->
 652     returnM (env, ExprStmt new_expr new_then new_ty)
 653
 654 zonkStmt env (LetStmt binds)
 655   = zonkLocalBinds env binds    `thenM` \ (env1, new_binds) ->
 656     returnM (env1, LetStmt new_binds)
 657
 658 zonkStmt env (BindStmt pat expr bind_op fail_op)
 659   = do  { new_expr <- zonkLExpr env expr
 660         ; (env1, new_pat) <- zonkPat env pat
 661         ; new_bind <- zonkExpr env bind_op
 662         ; new_fail <- zonkExpr env fail_op
 663         ; return (env1, BindStmt new_pat new_expr new_bind new_fail) }
 664
 665
 666 -------------------------------------------------------------------------
 667 zonkRbinds :: ZonkEnv -> HsRecordBinds TcId -> TcM (HsRecordBinds Id)
 668
 669 zonkRbinds env rbinds
 670   = mappM zonk_rbind rbinds
 671   where
 672     zonk_rbind (field, expr)
 673       = zonkLExpr env expr      `thenM` \ new_expr ->
 674         returnM (fmap (zonkIdOcc env) field, new_expr)
 675
 676 -------------------------------------------------------------------------
 677 mapIPNameTc :: (a -> TcM b) -> IPName a -> TcM (IPName b)
 678 mapIPNameTc f (Dupable n) = f n  `thenM` \ r -> returnM (Dupable r)
 679 mapIPNameTc f (Linear  n) = f n  `thenM` \ r -> returnM (Linear r)
 680 \end{code}
 681
 682
 683 %************************************************************************
 684 %*                                                                      *
 685 \subsection[BackSubst-Pats]{Patterns}
 686 %*                                                                      *
 687 %************************************************************************
 688
 689 \begin{code}
 690 zonkPat :: ZonkEnv -> OutPat TcId -> TcM (ZonkEnv, OutPat Id)
 691 -- Extend the environment as we go, because it's possible for one
 692 -- pattern to bind something that is used in another (inside or
 693 -- to the right)
 694 zonkPat env pat = wrapLocSndM (zonk_pat env) pat
 695
 696 zonk_pat env (ParPat p)
 697   = do  { (env', p') <- zonkPat env p
 698         ; return (env', ParPat p') }
 699
 700 zonk_pat env (WildPat ty)
 701   = do  { ty' <- zonkTcTypeToType env ty
 702         ; return (env, WildPat ty') }
 703
 704 zonk_pat env (VarPat v)
 705   = do  { v' <- zonkIdBndr env v
 706         ; return (extendZonkEnv1 env v', VarPat v') }
 707
 708 zonk_pat env (VarPatOut v binds)
 709   = do  { v' <- zonkIdBndr env v
 710         ; (env', binds') <- zonkRecMonoBinds (extendZonkEnv1 env v') binds
 711         ; returnM (env', VarPatOut v' binds') }
 712
 713 zonk_pat env (LazyPat pat)
 714   = do  { (env', pat') <- zonkPat env pat
 715         ; return (env',  LazyPat pat') }
 716
 717 zonk_pat env (BangPat pat)
 718   = do  { (env', pat') <- zonkPat env pat
 719         ; return (env',  BangPat pat') }
 720
 721 zonk_pat env (AsPat (L loc v) pat)
 722   = do  { v' <- zonkIdBndr env v
 723         ; (env', pat') <- zonkPat (extendZonkEnv1 env v') pat
 724         ; return (env', AsPat (L loc v') pat') }
 725
 726 zonk_pat env (ListPat pats ty)
 727   = do  { ty' <- zonkTcTypeToType env ty
 728         ; (env', pats') <- zonkPats env pats
 729         ; return (env', ListPat pats' ty') }
 730
 731 zonk_pat env (PArrPat pats ty)
 732   = do  { ty' <- zonkTcTypeToType env ty
 733         ; (env', pats') <- zonkPats env pats
 734         ; return (env', PArrPat pats' ty') }
 735
 736 zonk_pat env (TuplePat pats boxed ty)
 737   = do  { ty' <- zonkTcTypeToType env ty
 738         ; (env', pats') <- zonkPats env pats
 739         ; return (env', TuplePat pats' boxed ty') }
 740
 741 zonk_pat env (ConPatOut n tvs dicts binds stuff ty)
 742   = ASSERT( all isImmutableTyVar tvs )
 743     do  { new_ty <- zonkTcTypeToType env ty
 744         ; new_dicts <- zonkIdBndrs env dicts
 745         ; let env1 = extendZonkEnv env new_dicts
 746         ; (env2, new_binds) <- zonkRecMonoBinds env1 binds
 747         ; (env', new_stuff) <- zonkConStuff env2 stuff
 748         ; returnM (env', ConPatOut n tvs new_dicts new_binds new_stuff new_ty) }
 749
 750 zonk_pat env (LitPat lit) = return (env, LitPat lit)
 751
 752 zonk_pat env (SigPatOut pat ty)
 753   = do  { ty' <- zonkTcTypeToType env ty
 754         ; (env', pat') <- zonkPat env pat
 755         ; return (env', SigPatOut pat' ty') }
 756
 757 zonk_pat env (NPat lit mb_neg eq_expr ty)
 758   = do  { lit' <- zonkOverLit env lit
 759         ; mb_neg' <- case mb_neg of
 760                         Nothing  -> return Nothing
 761                         Just neg -> do { neg' <- zonkExpr env neg
 762                                        ; return (Just neg') }
 763         ; eq_expr' <- zonkExpr env eq_expr
 764         ; ty' <- zonkTcTypeToType env ty
 765         ; return (env, NPat lit' mb_neg' eq_expr' ty') }
 766
 767 zonk_pat env (NPlusKPat (L loc n) lit e1 e2)
 768   = do  { n' <- zonkIdBndr env n
 769         ; lit' <- zonkOverLit env lit
 770         ; e1' <- zonkExpr env e1
 771         ; e2' <- zonkExpr env e2
 772         ; return (extendZonkEnv1 env n', NPlusKPat (L loc n') lit' e1' e2') }
 773
 774 zonk_pat env (DictPat ds ms)
 775   = do  { ds' <- zonkIdBndrs env ds
 776         ; ms' <- zonkIdBndrs env ms
 777         ; return (extendZonkEnv env (ds' ++ ms'), DictPat ds' ms') }
 778
 779 ---------------------------
 780 zonkConStuff env (PrefixCon pats)
 781   = do  { (env', pats') <- zonkPats env pats
 782         ; return (env', PrefixCon pats') }
 783
 784 zonkConStuff env (InfixCon p1 p2)
 785   = do  { (env1, p1') <- zonkPat env  p1
 786         ; (env', p2') <- zonkPat env1 p2
 787         ; return (env', InfixCon p1' p2') }
 788
 789 zonkConStuff env (RecCon rpats)
 790   = do  { (env', pats') <- zonkPats env pats
 791         ; returnM (env', RecCon (fields `zip` pats')) }
 792   where
 793     (fields, pats) = unzip rpats
 794
 795 ---------------------------
 796 zonkPats env []         = return (env, [])
 797 zonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat
 798                              ; (env', pats') <- zonkPats env1 pats
 799                              ; return (env', pat':pats') }
 800 \end{code}
 801
 802 %************************************************************************
 803 %*                                                                      *
 804 \subsection[BackSubst-Foreign]{Foreign exports}
 805 %*                                                                      *
 806 %************************************************************************
 807
 808
 809 \begin{code}
 810 zonkForeignExports :: ZonkEnv -> [LForeignDecl TcId] -> TcM [LForeignDecl Id]
 811 zonkForeignExports env ls = mappM (wrapLocM (zonkForeignExport env)) ls
 812
 813 zonkForeignExport :: ZonkEnv -> ForeignDecl TcId -> TcM (ForeignDecl Id)
 814 zonkForeignExport env (ForeignExport i hs_ty spec isDeprec) =
 815    returnM (ForeignExport (fmap (zonkIdOcc env) i) undefined spec isDeprec)
 816 zonkForeignExport env for_imp
 817   = returnM for_imp     -- Foreign imports don't need zonking
 818 \end{code}
 819
 820 \begin{code}
 821 zonkRules :: ZonkEnv -> [LRuleDecl TcId] -> TcM [LRuleDecl Id]
 822 zonkRules env rs = mappM (wrapLocM (zonkRule env)) rs
 823
 824 zonkRule :: ZonkEnv -> RuleDecl TcId -> TcM (RuleDecl Id)
 825 zonkRule env (HsRule name act (vars::[RuleBndr TcId]) lhs fv_lhs rhs fv_rhs)
 826   = mappM zonk_bndr vars                `thenM` \ new_bndrs ->
 827     newMutVar emptyVarSet               `thenM` \ unbound_tv_set ->
 828     let
 829         env_rhs = extendZonkEnv env [id | b <- new_bndrs, let id = unLoc b, isId id]
 830         -- Type variables don't need an envt
 831         -- They are bound through the mutable mechanism
 832
 833         env_lhs = setZonkType env_rhs (zonkTypeCollecting unbound_tv_set)
 834         -- We need to gather the type variables mentioned on the LHS so we can
 835         -- quantify over them.  Example:
 836         --   data T a = C
 837         --
 838         --   foo :: T a -> Int
 839         --   foo C = 1
 840         --
 841         --   {-# RULES "myrule"  foo C = 1 #-}
 842         --
 843         -- After type checking the LHS becomes (foo a (C a))
 844         -- and we do not want to zap the unbound tyvar 'a' to (), because
 845         -- that limits the applicability of the rule.  Instead, we
 846         -- want to quantify over it!
 847         --
 848         -- It's easiest to find the free tyvars here. Attempts to do so earlier
 849         -- are tiresome, because (a) the data type is big and (b) finding the
 850         -- free type vars of an expression is necessarily monadic operation.
 851         --      (consider /\a -> f @ b, where b is side-effected to a)
 852     in
 853     zonkLExpr env_lhs lhs               `thenM` \ new_lhs ->
 854     zonkLExpr env_rhs rhs               `thenM` \ new_rhs ->
 855
 856     readMutVar unbound_tv_set           `thenM` \ unbound_tvs ->
 857     let
 858         final_bndrs :: [Located Var]
 859         final_bndrs = map noLoc (varSetElems unbound_tvs) ++ new_bndrs
 860     in
 861     returnM (HsRule name act (map RuleBndr final_bndrs) new_lhs fv_lhs new_rhs fv_rhs)
 862                 -- I hate this map RuleBndr stuff
 863   where
 864    zonk_bndr (RuleBndr v)
 865         | isId (unLoc v) = wrapLocM (zonkIdBndr env)   v
 866         | otherwise      = ASSERT( isImmutableTyVar (unLoc v) )
 867                            return v
 868 \end{code}
 869
 870
 871 %************************************************************************
 872 %*                                                                      *
 873 \subsection[BackSubst-Foreign]{Foreign exports}
 874 %*                                                                      *
 875 %************************************************************************
 876
 877 \begin{code}
 878 zonkTcTypeToType :: ZonkEnv -> TcType -> TcM Type
 879 zonkTcTypeToType (ZonkEnv zonk_ty _) ty = zonk_ty ty
 880
 881 zonkTcTypeToTypes :: ZonkEnv -> [TcType] -> TcM [Type]
 882 zonkTcTypeToTypes env tys = mapM (zonkTcTypeToType env) tys
 883
 884 zonkTypeCollecting :: TcRef TyVarSet -> TcType -> TcM Type
 885 -- This variant collects unbound type variables in a mutable variable
 886 zonkTypeCollecting unbound_tv_set
 887   = zonkType zonk_unbound_tyvar
 888   where
 889     zonk_unbound_tyvar tv
 890         = zonkQuantifiedTyVar tv                                `thenM` \ tv' ->
 891           readMutVar unbound_tv_set                             `thenM` \ tv_set ->
 892           writeMutVar unbound_tv_set (extendVarSet tv_set tv')  `thenM_`
 893           return (mkTyVarTy tv')
 894
 895 zonkTypeZapping :: TcType -> TcM Type
 896 -- This variant is used for everything except the LHS of rules
 897 -- It zaps unbound type variables to (), or some other arbitrary type
 898 zonkTypeZapping ty
 899   = zonkType zonk_unbound_tyvar ty
 900   where
 901         -- Zonk a mutable but unbound type variable to an arbitrary type
 902         -- We know it's unbound even though we don't carry an environment,
 903         -- because at the binding site for a type variable we bind the
 904         -- mutable tyvar to a fresh immutable one.  So the mutable store
 905         -- plays the role of an environment.  If we come across a mutable
 906         -- type variable that isn't so bound, it must be completely free.
 907     zonk_unbound_tyvar tv = do { writeMetaTyVar tv ty; return ty }
 908                           where
 909                             ty = mkArbitraryType tv
 910
 911
 912 -- When the type checker finds a type variable with no binding,
 913 -- which means it can be instantiated with an arbitrary type, it
 914 -- usually instantiates it to Void.  Eg.
 915 --
 916 --      length []
 917 -- ===>
 918 --      length Void (Nil Void)
 919 --
 920 -- But in really obscure programs, the type variable might have
 921 -- a kind other than *, so we need to invent a suitably-kinded type.
 922 --
 923 -- This commit uses
 924 --      Void for kind *
 925 --      List for kind *->*
 926 --      Tuple for kind *->...*->*
 927 --
 928 -- which deals with most cases.  (Previously, it only dealt with
 929 -- kind *.)
 930 --
 931 -- In the other cases, it just makes up a TyCon with a suitable
 932 -- kind.  If this gets into an interface file, anyone reading that
 933 -- file won't understand it.  This is fixable (by making the client
 934 -- of the interface file make up a TyCon too) but it is tiresome and
 935 -- never happens, so I am leaving it
 936
 937 mkArbitraryType :: TcTyVar -> Type
 938 -- Make up an arbitrary type whose kind is the same as the tyvar.
 939 -- We'll use this to instantiate the (unbound) tyvar.
 940 mkArbitraryType tv
 941   | liftedTypeKind `isSubKind` kind = voidTy            -- The vastly common case
 942   | otherwise                       = mkTyConApp tycon []
 943   where
 944     kind       = tyVarKind tv
 945     (args,res) = splitKindFunTys kind
 946
 947     tycon | kind == tyConKind listTyCon         --  *->*
 948           = listTyCon                           -- No tuples this size
 949
 950           | all isLiftedTypeKind args && isLiftedTypeKind res
 951           = tupleTyCon Boxed (length args)      --  *-> ... ->*->*
 952
 953           | otherwise
 954           = pprTrace "Urk! Inventing strangely-kinded void TyCon:" (ppr tc_name $$ ppr kind) $
 955             mkPrimTyCon tc_name kind 0 [] VoidRep
 956                 -- Same name as the tyvar, apart from making it start with a colon (sigh)
 957                 -- I dread to think what will happen if this gets out into an
 958                 -- interface file.  Catastrophe likely.  Major sigh.
 959
 960     tc_name = mkInternalName (getUnique tv) (mkDerivedTyConOcc (getOccName tv)) noSrcLoc
 961 \end{code}