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