compiler/typecheck/Inst.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 The @Inst@ type: dictionaries or method instances
   7
   8 \begin{code}
   9 {-# OPTIONS -w #-}
  10 -- The above warning supression flag is a temporary kludge.
  11 -- While working on this module you are encouraged to remove it and fix
  12 -- any warnings in the module. See
  13 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  14 -- for details
  15
  16 module Inst (
  17         Inst,
  18
  19         pprInstances, pprDictsTheta, pprDictsInFull,    -- User error messages
  20         showLIE, pprInst, pprInsts, pprInstInFull,      -- Debugging messages
  21
  22         tidyInsts, tidyMoreInsts,
  23
  24         newDictBndr, newDictBndrs, newDictBndrsO,
  25         instCall, instStupidTheta,
  26         cloneDict,
  27         shortCutFracLit, shortCutIntLit, shortCutStringLit, newIPDict,
  28         newMethod, newMethodFromName, newMethodWithGivenTy,
  29         tcInstClassOp,
  30         tcSyntaxName, isHsVar,
  31
  32         tyVarsOfInst, tyVarsOfInsts, tyVarsOfLIE,
  33         ipNamesOfInst, ipNamesOfInsts, fdPredsOfInst, fdPredsOfInsts,
  34         getDictClassTys, dictPred,
  35
  36         lookupSimpleInst, LookupInstResult(..),
  37         tcExtendLocalInstEnv, tcGetInstEnvs, getOverlapFlag,
  38
  39         isAbstractableInst, isEqInst,
  40         isDict, isClassDict, isMethod, isImplicInst,
  41         isIPDict, isInheritableInst, isMethodOrLit,
  42         isTyVarDict, isMethodFor,
  43
  44         zonkInst, zonkInsts,
  45         instToId, instToVar, instType, instName, instToDictBind,
  46         addInstToDictBind,
  47
  48         InstOrigin(..), InstLoc, pprInstLoc,
  49
  50         mkWantedCo, mkGivenCo,
  51         fromWantedCo, fromGivenCo,
  52         eitherEqInst, mkEqInst, mkEqInsts, mkWantedEqInst,
  53         finalizeEqInst, writeWantedCoercion,
  54         eqInstType, updateEqInstCoercion,
  55         eqInstCoercion, eqInstTys
  56     ) where
  57
  58 #include "HsVersions.h"
  59
  60 import {-# SOURCE #-}   TcExpr( tcPolyExpr )
  61 import {-# SOURCE #-}   TcUnify( boxyUnify, unifyType )
  62
  63 import FastString(FastString)
  64 import HsSyn
  65 import TcHsSyn
  66 import TcRnMonad
  67 import TcEnv
  68 import InstEnv
  69 import FunDeps
  70 import TcMType
  71 import TcType
  72 import Type
  73 import TypeRep
  74 import Class
  75 import Unify
  76 import Module
  77 import Coercion
  78 import HscTypes
  79 import CoreFVs
  80 import DataCon
  81 import Id
  82 import Name
  83 import NameSet
  84 import Literal
  85 import Var      ( Var, TyVar )
  86 import qualified Var
  87 import VarEnv
  88 import VarSet
  89 import TysWiredIn
  90 import PrelNames
  91 import BasicTypes
  92 import SrcLoc
  93 import DynFlags
  94 import Bag
  95 import Maybes
  96 import Util
  97 import Outputable
  98 import Data.List
  99 import TypeRep
 100 import Class
 101
 102 import Control.Monad ( liftM )
 103 \end{code}
 104
 105
 106 Selection
 107 ~~~~~~~~~
 108 \begin{code}
 109 instName :: Inst -> Name
 110 instName (EqInst {tci_name = name}) = name
 111 instName inst = Var.varName (instToVar inst)
 112
 113 instToId :: Inst -> TcId
 114 instToId inst = WARN( not (isId id), ppr inst )
 115               id
 116               where
 117                 id = instToVar inst
 118
 119 instToVar :: Inst -> Var
 120 instToVar (LitInst {tci_name = nm, tci_ty = ty})
 121   = mkLocalId nm ty
 122 instToVar (Method {tci_id = id})
 123   = id
 124 instToVar (Dict {tci_name = nm, tci_pred = pred})
 125   | isEqPred pred = Var.mkCoVar nm (mkPredTy pred)
 126   | otherwise     = mkLocalId nm (mkPredTy pred)
 127 instToVar (ImplicInst {tci_name = nm, tci_tyvars = tvs, tci_given = givens,
 128                        tci_wanted = wanteds})
 129   = mkLocalId nm (mkImplicTy tvs givens wanteds)
 130 instToVar i@(EqInst {})
 131   = eitherEqInst i id (\(TyVarTy covar) -> covar)
 132
 133 instType :: Inst -> Type
 134 instType (LitInst {tci_ty = ty})  = ty
 135 instType (Method {tci_id = id})   = idType id
 136 instType (Dict {tci_pred = pred}) = mkPredTy pred
 137 instType imp@(ImplicInst {})      = mkImplicTy (tci_tyvars imp) (tci_given imp)
 138                                                (tci_wanted imp)
 139 -- instType i@(EqInst {tci_co = co}) = eitherEqInst i TyVarTy id
 140 instType (EqInst {tci_left = ty1, tci_right = ty2}) = mkPredTy (EqPred ty1 ty2)
 141
 142 mkImplicTy tvs givens wanteds   -- The type of an implication constraint
 143   = ASSERT( all isAbstractableInst givens )
 144     -- pprTrace "mkImplicTy" (ppr givens) $
 145     -- See [Equational Constraints in Implication Constraints]
 146     let dict_wanteds = filter (not . isEqInst) wanteds
 147     in
 148       mkForAllTys tvs $
 149       mkPhiTy (map dictPred givens) $
 150       if isSingleton dict_wanteds then
 151         instType (head dict_wanteds)
 152       else
 153         mkTupleTy Boxed (length dict_wanteds) (map instType dict_wanteds)
 154
 155 dictPred (Dict {tci_pred = pred}) = pred
 156 dictPred (EqInst {tci_left=ty1,tci_right=ty2}) = EqPred ty1 ty2
 157 dictPred inst                     = pprPanic "dictPred" (ppr inst)
 158
 159 getDictClassTys (Dict {tci_pred = pred}) = getClassPredTys pred
 160 getDictClassTys inst                     = pprPanic "getDictClassTys" (ppr inst)
 161
 162 -- fdPredsOfInst is used to get predicates that contain functional
 163 -- dependencies *or* might do so.  The "might do" part is because
 164 -- a constraint (C a b) might have a superclass with FDs
 165 -- Leaving these in is really important for the call to fdPredsOfInsts
 166 -- in TcSimplify.inferLoop, because the result is fed to 'grow',
 167 -- which is supposed to be conservative
 168 fdPredsOfInst (Dict {tci_pred = pred})       = [pred]
 169 fdPredsOfInst (Method {tci_theta = theta})   = theta
 170 fdPredsOfInst (ImplicInst {tci_given = gs,
 171                            tci_wanted = ws}) = fdPredsOfInsts (gs ++ ws)
 172 fdPredsOfInst (LitInst {})                   = []
 173 fdPredsOfInst (EqInst {})                    = []
 174
 175 fdPredsOfInsts :: [Inst] -> [PredType]
 176 fdPredsOfInsts insts = concatMap fdPredsOfInst insts
 177
 178 isInheritableInst (Dict {tci_pred = pred})     = isInheritablePred pred
 179 isInheritableInst (Method {tci_theta = theta}) = all isInheritablePred theta
 180 isInheritableInst other                        = True
 181
 182
 183 ---------------------------------
 184 -- Get the implicit parameters mentioned by these Insts
 185 -- NB: the results of these functions are insensitive to zonking
 186
 187 ipNamesOfInsts :: [Inst] -> [Name]
 188 ipNamesOfInst  :: Inst   -> [Name]
 189 ipNamesOfInsts insts = [n | inst <- insts, n <- ipNamesOfInst inst]
 190
 191 ipNamesOfInst (Dict {tci_pred = IParam n _}) = [ipNameName n]
 192 ipNamesOfInst (Method {tci_theta = theta})   = [ipNameName n | IParam n _ <- theta]
 193 ipNamesOfInst other                          = []
 194
 195 ---------------------------------
 196 tyVarsOfInst :: Inst -> TcTyVarSet
 197 tyVarsOfInst (LitInst {tci_ty = ty})  = tyVarsOfType  ty
 198 tyVarsOfInst (Dict {tci_pred = pred}) = tyVarsOfPred pred
 199 tyVarsOfInst (Method {tci_oid = id, tci_tys = tys}) = tyVarsOfTypes tys `unionVarSet` varTypeTyVars id
 200                                  -- The id might have free type variables; in the case of
 201                                  -- locally-overloaded class methods, for example
 202 tyVarsOfInst (ImplicInst {tci_tyvars = tvs, tci_given = givens, tci_wanted = wanteds})
 203   = (tyVarsOfInsts givens `unionVarSet` tyVarsOfInsts wanteds)
 204     `minusVarSet` mkVarSet tvs
 205     `unionVarSet` unionVarSets (map varTypeTyVars tvs)
 206                 -- Remember the free tyvars of a coercion
 207 tyVarsOfInst (EqInst {tci_left = ty1, tci_right = ty2}) = tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2
 208
 209 tyVarsOfInsts insts = foldr (unionVarSet . tyVarsOfInst) emptyVarSet insts
 210 tyVarsOfLIE   lie   = tyVarsOfInsts (lieToList lie)
 211
 212
 213 --------------------------
 214 instToDictBind :: Inst -> LHsExpr TcId -> TcDictBinds
 215 instToDictBind inst rhs
 216   = unitBag (L (instSpan inst) (VarBind (instToId inst) rhs))
 217
 218 addInstToDictBind :: TcDictBinds -> Inst -> LHsExpr TcId -> TcDictBinds
 219 addInstToDictBind binds inst rhs = binds `unionBags` instToDictBind inst rhs
 220 \end{code}
 221
 222 Predicates
 223 ~~~~~~~~~~
 224 \begin{code}
 225
 226 isAbstractableInst :: Inst -> Bool
 227 isAbstractableInst inst = isDict inst || isEqInst inst
 228
 229 isEqInst :: Inst -> Bool
 230 isEqInst (EqInst {}) = True
 231 isEqInst other       = False
 232
 233 isDict :: Inst -> Bool
 234 isDict (Dict {}) = True
 235 isDict other     = False
 236
 237 isClassDict :: Inst -> Bool
 238 isClassDict (Dict {tci_pred = pred}) = isClassPred pred
 239 isClassDict other                    = False
 240
 241 isTyVarDict :: Inst -> Bool
 242 isTyVarDict (Dict {tci_pred = pred}) = isTyVarClassPred pred
 243 isTyVarDict other                    = False
 244
 245 isIPDict :: Inst -> Bool
 246 isIPDict (Dict {tci_pred = pred}) = isIPPred pred
 247 isIPDict other                    = False
 248
 249 isImplicInst (ImplicInst {}) = True
 250 isImplicInst other           = False
 251
 252 isMethod :: Inst -> Bool
 253 isMethod (Method {}) = True
 254 isMethod other       = False
 255
 256 isMethodFor :: TcIdSet -> Inst -> Bool
 257 isMethodFor ids (Method {tci_oid = id}) = id `elemVarSet` ids
 258 isMethodFor ids inst                    = False
 259
 260 isMethodOrLit :: Inst -> Bool
 261 isMethodOrLit (Method {})  = True
 262 isMethodOrLit (LitInst {}) = True
 263 isMethodOrLit other        = False
 264 \end{code}
 265
 266
 267 %************************************************************************
 268 %*                                                                      *
 269 \subsection{Building dictionaries}
 270 %*                                                                      *
 271 %************************************************************************
 272
 273 -- newDictBndrs makes a dictionary at a binding site
 274 -- instCall makes a dictionary at an occurrence site
 275 --      and throws it into the LIE
 276
 277 \begin{code}
 278 ----------------
 279 newDictBndrsO :: InstOrigin -> TcThetaType -> TcM [Inst]
 280 newDictBndrsO orig theta = do { loc <- getInstLoc orig
 281                               ; newDictBndrs loc theta }
 282
 283 newDictBndrs :: InstLoc -> TcThetaType -> TcM [Inst]
 284 newDictBndrs inst_loc theta = mapM (newDictBndr inst_loc) theta
 285
 286 newDictBndr :: InstLoc -> TcPredType -> TcM Inst
 287 newDictBndr inst_loc pred@(EqPred ty1 ty2)
 288   = do { uniq <- newUnique
 289         ; let name = mkPredName uniq inst_loc pred
 290         ; return (EqInst {tci_name  = name,
 291                           tci_loc   = inst_loc,
 292                           tci_left  = ty1,
 293                           tci_right = ty2,
 294                           tci_co    = mkGivenCo $ TyVarTy (Var.mkCoVar name (PredTy pred))})
 295        }
 296 newDictBndr inst_loc pred
 297   = do  { uniq <- newUnique
 298         ; let name = mkPredName uniq inst_loc pred
 299         ; return (Dict {tci_name = name, tci_pred = pred, tci_loc = inst_loc}) }
 300
 301 ----------------
 302 instCall :: InstOrigin -> [TcType] -> TcThetaType -> TcM HsWrapper
 303 -- Instantiate the constraints of a call
 304 --      (instCall o tys theta)
 305 -- (a) Makes fresh dictionaries as necessary for the constraints (theta)
 306 -- (b) Throws these dictionaries into the LIE
 307 -- (c) Returns an HsWrapper ([.] tys dicts)
 308
 309 instCall orig tys theta
 310   = do  { loc <- getInstLoc orig
 311         ; dict_app <- instCallDicts loc theta
 312         ; return (dict_app <.> mkWpTyApps tys) }
 313
 314 ----------------
 315 instStupidTheta :: InstOrigin -> TcThetaType -> TcM ()
 316 -- Similar to instCall, but only emit the constraints in the LIE
 317 -- Used exclusively for the 'stupid theta' of a data constructor
 318 instStupidTheta orig theta
 319   = do  { loc <- getInstLoc orig
 320         ; _co <- instCallDicts loc theta        -- Discard the coercion
 321         ; return () }
 322
 323 ----------------
 324 instCallDicts :: InstLoc -> TcThetaType -> TcM HsWrapper
 325 -- Instantiates the TcTheta, puts all constraints thereby generated
 326 -- into the LIE, and returns a HsWrapper to enclose the call site.
 327 -- This is the key place where equality predicates
 328 -- are unleashed into the world
 329 instCallDicts loc [] = return idHsWrapper
 330
 331 -- instCallDicts loc (EqPred ty1 ty2 : preds)
 332 --   = do  { unifyType ty1 ty2  -- For now, we insist that they unify right away
 333 --                              -- Later on, when we do associated types,
 334 --                              -- unifyType :: Type -> Type -> TcM ([Inst], Coercion)
 335 --      ; (dicts, co_fn) <- instCallDicts loc preds
 336 --      ; return (dicts, co_fn <.> WpTyApp ty1) }
 337 --      -- We use type application to apply the function to the
 338 --      -- coercion; here ty1 *is* the appropriate identity coercion
 339
 340 instCallDicts loc (EqPred ty1 ty2 : preds)
 341   = do  { traceTc (text "instCallDicts" <+> ppr (EqPred ty1 ty2))
 342         ; coi <- boxyUnify ty1 ty2
 343 --      ; coi <- unifyType ty1 ty2
 344         ; let co = fromCoI coi ty1
 345         ; co_fn <- instCallDicts loc preds
 346         ; return (co_fn <.> WpTyApp co) }
 347
 348 instCallDicts loc (pred : preds)
 349   = do  { uniq <- newUnique
 350         ; let name = mkPredName uniq loc pred
 351               dict = Dict {tci_name = name, tci_pred = pred, tci_loc = loc}
 352         ; extendLIE dict
 353         ; co_fn <- instCallDicts loc preds
 354         ; return (co_fn <.> WpApp (instToId dict)) }
 355
 356 -------------
 357 cloneDict :: Inst -> TcM Inst
 358 cloneDict dict@(Dict nm ty loc) = do { uniq <- newUnique
 359                                      ; return (dict {tci_name = setNameUnique nm uniq}) }
 360 cloneDict eq@(EqInst {})        = return eq
 361 cloneDict other = pprPanic "cloneDict" (ppr other)
 362
 363 -- For vanilla implicit parameters, there is only one in scope
 364 -- at any time, so we used to use the name of the implicit parameter itself
 365 -- But with splittable implicit parameters there may be many in
 366 -- scope, so we make up a new namea.
 367 newIPDict :: InstOrigin -> IPName Name -> Type
 368           -> TcM (IPName Id, Inst)
 369 newIPDict orig ip_name ty
 370   = getInstLoc orig                     `thenM` \ inst_loc ->
 371     newUnique                           `thenM` \ uniq ->
 372     let
 373         pred = IParam ip_name ty
 374         name = mkPredName uniq inst_loc pred
 375         dict = Dict {tci_name = name, tci_pred = pred, tci_loc = inst_loc}
 376     in
 377     returnM (mapIPName (\n -> instToId dict) ip_name, dict)
 378 \end{code}
 379
 380
 381 \begin{code}
 382 mkPredName :: Unique -> InstLoc -> PredType -> Name
 383 mkPredName uniq loc pred_ty
 384   = mkInternalName uniq occ (instLocSpan loc)
 385   where
 386     occ = case pred_ty of
 387             ClassP cls _ -> mkDictOcc (getOccName cls)
 388             IParam ip  _ -> getOccName (ipNameName ip)
 389             EqPred ty  _ -> mkEqPredCoOcc baseOcc
 390               where
 391                 -- we use the outermost tycon of the lhs, if there is one, to
 392                 -- improve readability of Core code
 393                 baseOcc = case splitTyConApp_maybe ty of
 394                             Nothing      -> mkOccName tcName "$"
 395                             Just (tc, _) -> getOccName tc
 396 \end{code}
 397
 398 %************************************************************************
 399 %*                                                                      *
 400 \subsection{Building methods (calls of overloaded functions)}
 401 %*                                                                      *
 402 %************************************************************************
 403
 404
 405 \begin{code}
 406 newMethodFromName :: InstOrigin -> BoxyRhoType -> Name -> TcM TcId
 407 newMethodFromName origin ty name
 408   = tcLookupId name             `thenM` \ id ->
 409         -- Use tcLookupId not tcLookupGlobalId; the method is almost
 410         -- always a class op, but with -fno-implicit-prelude GHC is
 411         -- meant to find whatever thing is in scope, and that may
 412         -- be an ordinary function.
 413     getInstLoc origin           `thenM` \ loc ->
 414     tcInstClassOp loc id [ty]   `thenM` \ inst ->
 415     extendLIE inst              `thenM_`
 416     returnM (instToId inst)
 417
 418 newMethodWithGivenTy orig id tys
 419   = getInstLoc orig             `thenM` \ loc ->
 420     newMethod loc id tys        `thenM` \ inst ->
 421     extendLIE inst              `thenM_`
 422     returnM (instToId inst)
 423
 424 --------------------------------------------
 425 -- tcInstClassOp, and newMethod do *not* drop the
 426 -- Inst into the LIE; they just returns the Inst
 427 -- This is important because they are used by TcSimplify
 428 -- to simplify Insts
 429
 430 -- NB: the kind of the type variable to be instantiated
 431 --     might be a sub-kind of the type to which it is applied,
 432 --     notably when the latter is a type variable of kind ??
 433 --     Hence the call to checkKind
 434 -- A worry: is this needed anywhere else?
 435 tcInstClassOp :: InstLoc -> Id -> [TcType] -> TcM Inst
 436 tcInstClassOp inst_loc sel_id tys
 437   = let
 438         (tyvars, _rho) = tcSplitForAllTys (idType sel_id)
 439     in
 440     zipWithM_ checkKind tyvars tys      `thenM_`
 441     newMethod inst_loc sel_id tys
 442
 443 checkKind :: TyVar -> TcType -> TcM ()
 444 -- Ensure that the type has a sub-kind of the tyvar
 445 checkKind tv ty
 446   = do  { let ty1 = ty
 447                 -- ty1 <- zonkTcType ty
 448         ; if typeKind ty1 `isSubKind` Var.tyVarKind tv
 449           then return ()
 450           else
 451
 452     pprPanic "checkKind: adding kind constraint"
 453              (vcat [ppr tv <+> ppr (Var.tyVarKind tv),
 454                     ppr ty <+> ppr ty1 <+> ppr (typeKind ty1)])
 455         }
 456 --    do        { tv1 <- tcInstTyVar tv
 457 --      ; unifyType ty1 (mkTyVarTy tv1) } }
 458
 459
 460 ---------------------------
 461 newMethod inst_loc id tys
 462   = newUnique           `thenM` \ new_uniq ->
 463     let
 464         (theta,tau) = tcSplitPhiTy (applyTys (idType id) tys)
 465         meth_id     = mkUserLocal (mkMethodOcc (getOccName id)) new_uniq tau loc
 466         inst        = Method {tci_id = meth_id, tci_oid = id, tci_tys = tys,
 467                               tci_theta = theta, tci_loc = inst_loc}
 468         loc         = instLocSpan inst_loc
 469     in
 470     returnM inst
 471 \end{code}
 472
 473 \begin{code}
 474 shortCutIntLit :: Integer -> TcType -> Maybe (HsExpr TcId)
 475 shortCutIntLit i ty
 476   | isIntTy ty && inIntRange i          -- Short cut for Int
 477   = Just (HsLit (HsInt i))
 478   | isIntegerTy ty                      -- Short cut for Integer
 479   = Just (HsLit (HsInteger i ty))
 480   | otherwise = Nothing
 481
 482 shortCutFracLit :: Rational -> TcType -> Maybe (HsExpr TcId)
 483 shortCutFracLit f ty
 484   | isFloatTy ty
 485   = Just (mk_lit floatDataCon (HsFloatPrim f))
 486   | isDoubleTy ty
 487   = Just (mk_lit doubleDataCon (HsDoublePrim f))
 488   | otherwise = Nothing
 489   where
 490     mk_lit con lit = HsApp (nlHsVar (dataConWrapId con)) (nlHsLit lit)
 491
 492 shortCutStringLit :: FastString -> TcType -> Maybe (HsExpr TcId)
 493 shortCutStringLit s ty
 494   | isStringTy ty                       -- Short cut for String
 495   = Just (HsLit (HsString s))
 496   | otherwise = Nothing
 497
 498 mkIntegerLit :: Integer -> TcM (LHsExpr TcId)
 499 mkIntegerLit i
 500   = tcMetaTy integerTyConName   `thenM` \ integer_ty ->
 501     getSrcSpanM                 `thenM` \ span ->
 502     returnM (L span $ HsLit (HsInteger i integer_ty))
 503
 504 mkRatLit :: Rational -> TcM (LHsExpr TcId)
 505 mkRatLit r
 506   = tcMetaTy rationalTyConName  `thenM` \ rat_ty ->
 507     getSrcSpanM                 `thenM` \ span ->
 508     returnM (L span $ HsLit (HsRat r rat_ty))
 509
 510 mkStrLit :: FastString -> TcM (LHsExpr TcId)
 511 mkStrLit s
 512   = --tcMetaTy stringTyConName  `thenM` \ string_ty ->
 513     getSrcSpanM                 `thenM` \ span ->
 514     returnM (L span $ HsLit (HsString s))
 515
 516 isHsVar :: HsExpr Name -> Name -> Bool
 517 isHsVar (HsVar f) g = f==g
 518 isHsVar other     g = False
 519 \end{code}
 520
 521
 522 %************************************************************************
 523 %*                                                                      *
 524 \subsection{Zonking}
 525 %*                                                                      *
 526 %************************************************************************
 527
 528 Zonking makes sure that the instance types are fully zonked.
 529
 530 \begin{code}
 531 zonkInst :: Inst -> TcM Inst
 532 zonkInst dict@(Dict { tci_pred = pred})
 533   = zonkTcPredType pred                 `thenM` \ new_pred ->
 534     returnM (dict {tci_pred = new_pred})
 535
 536 zonkInst meth@(Method {tci_oid = id, tci_tys = tys, tci_theta = theta})
 537   = zonkId id                   `thenM` \ new_id ->
 538         -- Essential to zonk the id in case it's a local variable
 539         -- Can't use zonkIdOcc because the id might itself be
 540         -- an InstId, in which case it won't be in scope
 541
 542     zonkTcTypes tys             `thenM` \ new_tys ->
 543     zonkTcThetaType theta       `thenM` \ new_theta ->
 544     returnM (meth { tci_oid = new_id, tci_tys = new_tys, tci_theta = new_theta })
 545         -- No need to zonk the tci_id
 546
 547 zonkInst lit@(LitInst {tci_ty = ty})
 548   = zonkTcType ty                       `thenM` \ new_ty ->
 549     returnM (lit {tci_ty = new_ty})
 550
 551 zonkInst implic@(ImplicInst {})
 552   = ASSERT( all isImmutableTyVar (tci_tyvars implic) )
 553     do  { givens'  <- zonkInsts (tci_given  implic)
 554         ; wanteds' <- zonkInsts (tci_wanted implic)
 555         ; return (implic {tci_given = givens',tci_wanted = wanteds'}) }
 556
 557 zonkInst eqinst@(EqInst {tci_left = ty1, tci_right = ty2})
 558   = do { co' <- eitherEqInst eqinst
 559                   (\covar -> return (mkWantedCo covar))
 560                   (\co    -> liftM mkGivenCo $ zonkTcType co)
 561        ; ty1' <- zonkTcType ty1
 562        ; ty2' <- zonkTcType ty2
 563        ; return (eqinst {tci_co = co', tci_left= ty1', tci_right = ty2' })
 564        }
 565
 566 zonkInsts insts = mappM zonkInst insts
 567 \end{code}
 568
 569
 570 %************************************************************************
 571 %*                                                                      *
 572 \subsection{Printing}
 573 %*                                                                      *
 574 %************************************************************************
 575
 576 ToDo: improve these pretty-printing things.  The ``origin'' is really only
 577 relevant in error messages.
 578
 579 \begin{code}
 580 instance Outputable Inst where
 581     ppr inst = pprInst inst
 582
 583 pprDictsTheta :: [Inst] -> SDoc
 584 -- Print in type-like fashion (Eq a, Show b)
 585 -- The Inst can be an implication constraint, but not a Method or LitInst
 586 pprDictsTheta insts = parens (sep (punctuate comma (map (ppr . instType) insts)))
 587
 588 pprDictsInFull :: [Inst] -> SDoc
 589 -- Print in type-like fashion, but with source location
 590 pprDictsInFull dicts
 591   = vcat (map go dicts)
 592   where
 593     go dict = sep [quotes (ppr (instType dict)), nest 2 (pprInstArising dict)]
 594
 595 pprInsts :: [Inst] -> SDoc
 596 -- Debugging: print the evidence :: type
 597 pprInsts insts = brackets (interpp'SP insts)
 598
 599 pprInst, pprInstInFull :: Inst -> SDoc
 600 -- Debugging: print the evidence :: type
 601 pprInst i@(EqInst {tci_left = ty1, tci_right = ty2, tci_co = co})
 602         = eitherEqInst i
 603                 (\covar -> text "Wanted" <+> ppr (TyVarTy covar) <+> dcolon <+> ppr (EqPred ty1 ty2))
 604                 (\co    -> text "Given"  <+> ppr co              <+> dcolon <+> ppr (EqPred ty1 ty2))
 605 pprInst inst = ppr (instName inst) <+> dcolon
 606                 <+> (braces (ppr (instType inst)) $$
 607                      ifPprDebug implic_stuff)
 608   where
 609     implic_stuff | isImplicInst inst = ppr (tci_reft inst)
 610                  | otherwise         = empty
 611
 612 pprInstInFull inst@(EqInst {}) = pprInst inst
 613 pprInstInFull inst = sep [quotes (pprInst inst), nest 2 (pprInstArising inst)]
 614
 615 tidyInst :: TidyEnv -> Inst -> Inst
 616 tidyInst env eq@(EqInst {tci_left = lty, tci_right = rty, tci_co = co}) =
 617   eq { tci_left  = tidyType env lty
 618      , tci_right = tidyType env rty
 619      , tci_co    = either Left (Right . tidyType env) co
 620      }
 621 tidyInst env lit@(LitInst {tci_ty = ty})   = lit {tci_ty = tidyType env ty}
 622 tidyInst env dict@(Dict {tci_pred = pred}) = dict {tci_pred = tidyPred env pred}
 623 tidyInst env meth@(Method {tci_tys = tys}) = meth {tci_tys = tidyTypes env tys}
 624 tidyInst env implic@(ImplicInst {})
 625   = implic { tci_tyvars = tvs'
 626            , tci_given  = map (tidyInst env') (tci_given  implic)
 627            , tci_wanted = map (tidyInst env') (tci_wanted implic) }
 628   where
 629     (env', tvs') = mapAccumL tidyTyVarBndr env (tci_tyvars implic)
 630
 631 tidyMoreInsts :: TidyEnv -> [Inst] -> (TidyEnv, [Inst])
 632 -- This function doesn't assume that the tyvars are in scope
 633 -- so it works like tidyOpenType, returning a TidyEnv
 634 tidyMoreInsts env insts
 635   = (env', map (tidyInst env') insts)
 636   where
 637     env' = tidyFreeTyVars env (tyVarsOfInsts insts)
 638
 639 tidyInsts :: [Inst] -> (TidyEnv, [Inst])
 640 tidyInsts insts = tidyMoreInsts emptyTidyEnv insts
 641
 642 showLIE :: SDoc -> TcM ()       -- Debugging
 643 showLIE str
 644   = do { lie_var <- getLIEVar ;
 645          lie <- readMutVar lie_var ;
 646          traceTc (str <+> vcat (map pprInstInFull (lieToList lie))) }
 647 \end{code}
 648
 649
 650 %************************************************************************
 651 %*                                                                      *
 652         Extending the instance environment
 653 %*                                                                      *
 654 %************************************************************************
 655
 656 \begin{code}
 657 tcExtendLocalInstEnv :: [Instance] -> TcM a -> TcM a
 658   -- Add new locally-defined instances
 659 tcExtendLocalInstEnv dfuns thing_inside
 660  = do { traceDFuns dfuns
 661       ; env <- getGblEnv
 662       ; inst_env' <- foldlM addLocalInst (tcg_inst_env env) dfuns
 663       ; let env' = env { tcg_insts = dfuns ++ tcg_insts env,
 664                          tcg_inst_env = inst_env' }
 665       ; setGblEnv env' thing_inside }
 666
 667 addLocalInst :: InstEnv -> Instance -> TcM InstEnv
 668 -- Check that the proposed new instance is OK,
 669 -- and then add it to the home inst env
 670 addLocalInst home_ie ispec
 671   = do  {       -- Instantiate the dfun type so that we extend the instance
 672                 -- envt with completely fresh template variables
 673                 -- This is important because the template variables must
 674                 -- not overlap with anything in the things being looked up
 675                 -- (since we do unification).
 676                 -- We use tcInstSkolType because we don't want to allocate fresh
 677                 --  *meta* type variables.
 678           let dfun = instanceDFunId ispec
 679         ; (tvs', theta', tau') <- tcInstSkolType InstSkol (idType dfun)
 680         ; let   (cls, tys') = tcSplitDFunHead tau'
 681                 dfun'       = setIdType dfun (mkSigmaTy tvs' theta' tau')
 682                 ispec'      = setInstanceDFunId ispec dfun'
 683
 684                 -- Load imported instances, so that we report
 685                 -- duplicates correctly
 686         ; eps <- getEps
 687         ; let inst_envs = (eps_inst_env eps, home_ie)
 688
 689                 -- Check functional dependencies
 690         ; case checkFunDeps inst_envs ispec' of
 691                 Just specs -> funDepErr ispec' specs
 692                 Nothing    -> return ()
 693
 694                 -- Check for duplicate instance decls
 695         ; let { (matches, _) = lookupInstEnv inst_envs cls tys'
 696               ; dup_ispecs = [ dup_ispec
 697                              | (dup_ispec, _) <- matches
 698                              , let (_,_,_,dup_tys) = instanceHead dup_ispec
 699                              , isJust (tcMatchTys (mkVarSet tvs') tys' dup_tys)] }
 700                 -- Find memebers of the match list which ispec itself matches.
 701                 -- If the match is 2-way, it's a duplicate
 702         ; case dup_ispecs of
 703             dup_ispec : _ -> dupInstErr ispec' dup_ispec
 704             []            -> return ()
 705
 706                 -- OK, now extend the envt
 707         ; return (extendInstEnv home_ie ispec') }
 708
 709 getOverlapFlag :: TcM OverlapFlag
 710 getOverlapFlag
 711   = do  { dflags <- getDOpts
 712         ; let overlap_ok    = dopt Opt_OverlappingInstances dflags
 713               incoherent_ok = dopt Opt_IncoherentInstances  dflags
 714               overlap_flag | incoherent_ok = Incoherent
 715                            | overlap_ok    = OverlapOk
 716                            | otherwise     = NoOverlap
 717
 718         ; return overlap_flag }
 719
 720 traceDFuns ispecs
 721   = traceTc (hang (text "Adding instances:") 2 (vcat (map pp ispecs)))
 722   where
 723     pp ispec = ppr (instanceDFunId ispec) <+> colon <+> ppr ispec
 724         -- Print the dfun name itself too
 725
 726 funDepErr ispec ispecs
 727   = addDictLoc ispec $
 728     addErr (hang (ptext SLIT("Functional dependencies conflict between instance declarations:"))
 729                2 (pprInstances (ispec:ispecs)))
 730 dupInstErr ispec dup_ispec
 731   = addDictLoc ispec $
 732     addErr (hang (ptext SLIT("Duplicate instance declarations:"))
 733                2 (pprInstances [ispec, dup_ispec]))
 734
 735 addDictLoc ispec thing_inside
 736   = setSrcSpan (mkSrcSpan loc loc) thing_inside
 737   where
 738    loc = getSrcLoc ispec
 739 \end{code}
 740
 741
 742 %************************************************************************
 743 %*                                                                      *
 744 \subsection{Looking up Insts}
 745 %*                                                                      *
 746 %************************************************************************
 747
 748 \begin{code}
 749 data LookupInstResult
 750   = NoInstance
 751   | GenInst [Inst] (LHsExpr TcId)       -- The expression and its needed insts
 752
 753 lookupSimpleInst :: Inst -> TcM LookupInstResult
 754 -- This is "simple" in that it returns NoInstance for implication constraints
 755
 756 -- It's important that lookupInst does not put any new stuff into
 757 -- the LIE.  Instead, any Insts needed by the lookup are returned in
 758 -- the LookupInstResult, where they can be further processed by tcSimplify
 759
 760 lookupSimpleInst (EqInst {}) = return NoInstance
 761
 762 --------------------- Implications ------------------------
 763 lookupSimpleInst (ImplicInst {}) = return NoInstance
 764
 765 --------------------- Methods ------------------------
 766 lookupSimpleInst (Method {tci_oid = id, tci_tys = tys, tci_theta = theta, tci_loc = loc})
 767   = do  { (dict_app, dicts) <- getLIE $ instCallDicts loc theta
 768         ; let co_fn = dict_app <.> mkWpTyApps tys
 769         ; return (GenInst dicts (L span $ HsWrap co_fn (HsVar id))) }
 770   where
 771     span = instLocSpan loc
 772
 773 --------------------- Literals ------------------------
 774 -- Look for short cuts first: if the literal is *definitely* a
 775 -- int, integer, float or a double, generate the real thing here.
 776 -- This is essential (see nofib/spectral/nucleic).
 777 -- [Same shortcut as in newOverloadedLit, but we
 778 --  may have done some unification by now]
 779
 780 lookupSimpleInst (LitInst {tci_lit = HsIntegral i from_integer_name _, tci_ty = ty, tci_loc = loc})
 781   | Just expr <- shortCutIntLit i ty
 782   = returnM (GenInst [] (noLoc expr))
 783   | otherwise
 784   = ASSERT( from_integer_name `isHsVar` fromIntegerName )       -- A LitInst invariant
 785     tcLookupId fromIntegerName                  `thenM` \ from_integer ->
 786     tcInstClassOp loc from_integer [ty]         `thenM` \ method_inst ->
 787     mkIntegerLit i                              `thenM` \ integer_lit ->
 788     returnM (GenInst [method_inst]
 789                      (mkHsApp (L (instLocSpan loc)
 790                                  (HsVar (instToId method_inst))) integer_lit))
 791
 792 lookupSimpleInst (LitInst {tci_lit = HsFractional f from_rat_name _, tci_ty = ty, tci_loc = loc})
 793   | Just expr <- shortCutFracLit f ty
 794   = returnM (GenInst [] (noLoc expr))
 795
 796   | otherwise
 797   = ASSERT( from_rat_name `isHsVar` fromRationalName )  -- A LitInst invariant
 798     tcLookupId fromRationalName                 `thenM` \ from_rational ->
 799     tcInstClassOp loc from_rational [ty]        `thenM` \ method_inst ->
 800     mkRatLit f                                  `thenM` \ rat_lit ->
 801     returnM (GenInst [method_inst] (mkHsApp (L (instLocSpan loc)
 802                                                (HsVar (instToId method_inst))) rat_lit))
 803
 804 lookupSimpleInst (LitInst {tci_lit = HsIsString s from_string_name _, tci_ty = ty, tci_loc = loc})
 805   | Just expr <- shortCutStringLit s ty
 806   = returnM (GenInst [] (noLoc expr))
 807   | otherwise
 808   = ASSERT( from_string_name `isHsVar` fromStringName ) -- A LitInst invariant
 809     tcLookupId fromStringName                   `thenM` \ from_string ->
 810     tcInstClassOp loc from_string [ty]          `thenM` \ method_inst ->
 811     mkStrLit s                                  `thenM` \ string_lit ->
 812     returnM (GenInst [method_inst]
 813                      (mkHsApp (L (instLocSpan loc)
 814                                  (HsVar (instToId method_inst))) string_lit))
 815
 816 --------------------- Dictionaries ------------------------
 817 lookupSimpleInst (Dict {tci_pred = pred, tci_loc = loc})
 818   = do  { mb_result <- lookupPred pred
 819         ; case mb_result of {
 820             Nothing -> return NoInstance ;
 821             Just (dfun_id, mb_inst_tys) -> do
 822
 823     { use_stage <- getStage
 824     ; checkWellStaged (ptext SLIT("instance for") <+> quotes (ppr pred))
 825                       (topIdLvl dfun_id) use_stage
 826
 827         -- It's possible that not all the tyvars are in
 828         -- the substitution, tenv. For example:
 829         --      instance C X a => D X where ...
 830         -- (presumably there's a functional dependency in class C)
 831         -- Hence mb_inst_tys :: Either TyVar TcType
 832
 833     ; let inst_tv (Left tv)  = do { tv' <- tcInstTyVar tv; return (mkTyVarTy tv') }
 834           inst_tv (Right ty) = return ty
 835     ; tys <- mappM inst_tv mb_inst_tys
 836     ; let
 837         (theta, _) = tcSplitPhiTy (applyTys (idType dfun_id) tys)
 838         src_loc    = instLocSpan loc
 839         dfun       = HsVar dfun_id
 840     ; if null theta then
 841         returnM (GenInst [] (L src_loc $ HsWrap (mkWpTyApps tys) dfun))
 842       else do
 843     { (dict_app, dicts) <- getLIE $ instCallDicts loc theta -- !!!
 844     ; let co_fn = dict_app <.> mkWpTyApps tys
 845     ; returnM (GenInst dicts (L src_loc $ HsWrap co_fn dfun))
 846     }}}}
 847
 848 ---------------
 849 lookupPred :: TcPredType -> TcM (Maybe (DFunId, [Either TyVar TcType]))
 850 -- Look up a class constraint in the instance environment
 851 lookupPred pred@(ClassP clas tys)
 852   = do  { eps     <- getEps
 853         ; tcg_env <- getGblEnv
 854         ; let inst_envs = (eps_inst_env eps, tcg_inst_env tcg_env)
 855         ; case lookupInstEnv inst_envs clas tys of {
 856             ([(ispec, inst_tys)], [])
 857                 -> do   { let dfun_id = is_dfun ispec
 858                         ; traceTc (text "lookupInst success" <+>
 859                                    vcat [text "dict" <+> ppr pred,
 860                                          text "witness" <+> ppr dfun_id
 861                                          <+> ppr (idType dfun_id) ])
 862                                 -- Record that this dfun is needed
 863                         ; record_dfun_usage dfun_id
 864                         ; return (Just (dfun_id, inst_tys)) } ;
 865
 866             (matches, unifs)
 867                 -> do   { traceTc (text "lookupInst fail" <+>
 868                                    vcat [text "dict" <+> ppr pred,
 869                                          text "matches" <+> ppr matches,
 870                                          text "unifs" <+> ppr unifs])
 871                 -- In the case of overlap (multiple matches) we report
 872                 -- NoInstance here.  That has the effect of making the
 873                 -- context-simplifier return the dict as an irreducible one.
 874                 -- Then it'll be given to addNoInstanceErrs, which will do another
 875                 -- lookupInstEnv to get the detailed info about what went wrong.
 876                         ; return Nothing }
 877         }}
 878
 879 lookupPred ip_pred = return Nothing     -- Implicit parameters
 880
 881 record_dfun_usage dfun_id
 882   = do  { hsc_env <- getTopEnv
 883         ; let  dfun_name = idName dfun_id
 884                dfun_mod  = nameModule dfun_name
 885         ; if isInternalName dfun_name ||    -- Internal name => defined in this module
 886              modulePackageId dfun_mod /= thisPackage (hsc_dflags hsc_env)
 887           then return () -- internal, or in another package
 888            else do { tcg_env <- getGblEnv
 889                    ; updMutVar (tcg_inst_uses tcg_env)
 890                                (`addOneToNameSet` idName dfun_id) }}
 891
 892
 893 tcGetInstEnvs :: TcM (InstEnv, InstEnv)
 894 -- Gets both the external-package inst-env
 895 -- and the home-pkg inst env (includes module being compiled)
 896 tcGetInstEnvs = do { eps <- getEps; env <- getGblEnv;
 897                      return (eps_inst_env eps, tcg_inst_env env) }
 898 \end{code}
 899
 900
 901
 902 %************************************************************************
 903 %*                                                                      *
 904                 Re-mappable syntax
 905 %*                                                                      *
 906 %************************************************************************
 907
 908 Suppose we are doing the -fno-implicit-prelude thing, and we encounter
 909 a do-expression.  We have to find (>>) in the current environment, which is
 910 done by the rename. Then we have to check that it has the same type as
 911 Control.Monad.(>>).  Or, more precisely, a compatible type. One 'customer' had
 912 this:
 913
 914   (>>) :: HB m n mn => m a -> n b -> mn b
 915
 916 So the idea is to generate a local binding for (>>), thus:
 917
 918         let then72 :: forall a b. m a -> m b -> m b
 919             then72 = ...something involving the user's (>>)...
 920         in
 921         ...the do-expression...
 922
 923 Now the do-expression can proceed using then72, which has exactly
 924 the expected type.
 925
 926 In fact tcSyntaxName just generates the RHS for then72, because we only
 927 want an actual binding in the do-expression case. For literals, we can
 928 just use the expression inline.
 929
 930 \begin{code}
 931 tcSyntaxName :: InstOrigin
 932              -> TcType                  -- Type to instantiate it at
 933              -> (Name, HsExpr Name)     -- (Standard name, user name)
 934              -> TcM (Name, HsExpr TcId) -- (Standard name, suitable expression)
 935 --      *** NOW USED ONLY FOR CmdTop (sigh) ***
 936 -- NB: tcSyntaxName calls tcExpr, and hence can do unification.
 937 -- So we do not call it from lookupInst, which is called from tcSimplify
 938
 939 tcSyntaxName orig ty (std_nm, HsVar user_nm)
 940   | std_nm == user_nm
 941   = newMethodFromName orig ty std_nm    `thenM` \ id ->
 942     returnM (std_nm, HsVar id)
 943
 944 tcSyntaxName orig ty (std_nm, user_nm_expr)
 945   = tcLookupId std_nm           `thenM` \ std_id ->
 946     let
 947         -- C.f. newMethodAtLoc
 948         ([tv], _, tau)  = tcSplitSigmaTy (idType std_id)
 949         sigma1          = substTyWith [tv] [ty] tau
 950         -- Actually, the "tau-type" might be a sigma-type in the
 951         -- case of locally-polymorphic methods.
 952     in
 953     addErrCtxtM (syntaxNameCtxt user_nm_expr orig sigma1)       $
 954
 955         -- Check that the user-supplied thing has the
 956         -- same type as the standard one.
 957         -- Tiresome jiggling because tcCheckSigma takes a located expression
 958     getSrcSpanM                                 `thenM` \ span ->
 959     tcPolyExpr (L span user_nm_expr) sigma1     `thenM` \ expr ->
 960     returnM (std_nm, unLoc expr)
 961
 962 syntaxNameCtxt name orig ty tidy_env
 963   = getInstLoc orig             `thenM` \ inst_loc ->
 964     let
 965         msg = vcat [ptext SLIT("When checking that") <+> quotes (ppr name) <+>
 966                                 ptext SLIT("(needed by a syntactic construct)"),
 967                     nest 2 (ptext SLIT("has the required type:") <+> ppr (tidyType tidy_env ty)),
 968                     nest 2 (ptext SLIT("arising from") <+> pprInstLoc inst_loc)]
 969     in
 970     returnM (tidy_env, msg)
 971 \end{code}
 972
 973 %************************************************************************
 974 %*                                                                      *
 975                 EqInsts
 976 %*                                                                      *
 977 %************************************************************************
 978
 979 \begin{code}
 980 mkGivenCo   :: Coercion -> Either TcTyVar Coercion
 981 mkGivenCo   =  Right
 982
 983 mkWantedCo  :: TcTyVar  -> Either TcTyVar Coercion
 984 mkWantedCo  =  Left
 985
 986 fromGivenCo :: Either TcTyVar Coercion -> Coercion
 987 fromGivenCo (Right co)   = co
 988 fromGivenCo _            = panic "fromGivenCo: not a wanted coercion"
 989
 990 fromWantedCo :: String -> Either TcTyVar Coercion -> TcTyVar
 991 fromWantedCo _ (Left covar) = covar
 992 fromWantedCo msg _          = panic ("fromWantedCo: not a wanted coercion: " ++ msg)
 993
 994 eitherEqInst :: Inst                -- given or wanted EqInst
 995              -> (TcTyVar  -> a)     --  result if wanted
 996              -> (Coercion -> a)     --  result if given
 997              -> a
 998 eitherEqInst (EqInst {tci_co = either_co}) withWanted withGiven
 999         = case either_co of
1000                 Left  covar -> withWanted covar
1001                 Right co    -> withGiven  co
1002
1003 mkEqInsts :: [PredType] -> [Either TcTyVar Coercion] -> TcM [Inst]
1004 mkEqInsts preds cos = zipWithM mkEqInst preds cos
1005
1006 mkEqInst :: PredType -> Either TcTyVar Coercion -> TcM Inst
1007 mkEqInst (EqPred ty1 ty2) co
1008         = do { uniq <- newUnique
1009              ; src_span <- getSrcSpanM
1010              ; err_ctxt <- getErrCtxt
1011              ; let loc  = InstLoc EqOrigin src_span err_ctxt
1012                    name = mkName uniq src_span
1013                    inst = EqInst {tci_left = ty1, tci_right = ty2, tci_co = co, tci_loc = loc, tci_name = name}
1014              ; return inst
1015              }
1016         where mkName uniq src_span = mkInternalName uniq (mkVarOcc "co") src_span
1017
1018 mkWantedEqInst :: PredType -> TcM Inst
1019 mkWantedEqInst pred@(EqPred ty1 ty2)
1020   = do { cotv <- newMetaCoVar ty1 ty2
1021        ; mkEqInst pred (Left cotv)
1022        }
1023
1024 -- type inference:
1025 --      We want to promote the wanted EqInst to a given EqInst
1026 --      in the signature context.
1027 --      This means we have to give the coercion a name
1028 --      and fill it in as its own name.
1029 finalizeEqInst
1030         :: Inst                 -- wanted
1031         -> TcM Inst             -- given
1032 finalizeEqInst wanted@(EqInst {tci_left = ty1, tci_right = ty2, tci_name = name})
1033         = do { let var = Var.mkCoVar name (PredTy $ EqPred ty1 ty2)
1034              ; writeWantedCoercion wanted (TyVarTy var)
1035              ; let given = wanted { tci_co = mkGivenCo $ TyVarTy var }
1036              ; return given
1037              }
1038
1039 writeWantedCoercion
1040         :: Inst         -- wanted EqInst
1041         -> Coercion     -- coercion to fill the hole with
1042         -> TcM ()
1043 writeWantedCoercion wanted co
1044         = do { let cotv = fromWantedCo "writeWantedCoercion" $ tci_co wanted
1045              ; writeMetaTyVar cotv co
1046              }
1047
1048 eqInstType :: Inst -> TcType
1049 eqInstType inst = eitherEqInst inst mkTyVarTy id
1050
1051 eqInstCoercion :: Inst -> Either TcTyVar Coercion
1052 eqInstCoercion = tci_co
1053
1054 eqInstTys :: Inst -> (TcType, TcType)
1055 eqInstTys inst = (tci_left inst, tci_right inst)
1056
1057 updateEqInstCoercion :: (Either TcTyVar Coercion -> Either TcTyVar Coercion) -> Inst -> Inst
1058 updateEqInstCoercion f inst = inst {tci_co = f $ tci_co inst}
1059 \end{code}