tcLookupLocatedGlobal, tcLookupGlobal,
tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
- tcLookupLocatedClass,
+ tcLookupLocatedClass, tcLookupFamInst,
-- Local environment
tcExtendKindEnv, tcExtendKindEnvTvs,
import VarEnv
import RdrName
import InstEnv
+import FamInstEnv
import DataCon
import TyCon
import Class
tcLookupLocatedTyCon :: Located Name -> TcM TyCon
tcLookupLocatedTyCon = addLocM tcLookupTyCon
+
+-- Look up the representation tycon of a family instance.
+--
+tcLookupFamInst :: TyCon -> [Type] -> TcM TyCon
+tcLookupFamInst tycon tys
+ = do { env <- getGblEnv
+ ; eps <- getEps
+ ; let instEnv = (eps_fam_inst_env eps, tcg_fam_inst_env env)
+ ; case lookupFamInstEnvExact instEnv tycon tys of
+ Nothing -> famInstNotFound tycon tys
+ Just famInst -> return $ famInstTyCon famInst
+ }
\end{code}
%************************************************************************
-- I don't think I have to refine the set of global type variables in scope
-- Reason: the refinement never increases that set
refineEnvironment reft thing_inside
+ | isEmptyRefinement reft -- Common case
+ = thing_inside
+ | otherwise
= do { env <- getLclEnv
; let le' = mapNameEnv refine (tcl_env env)
; setLclEnv (env {tcl_env = le'}) thing_inside }
wrongThingErr expected thing name
= failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+>
ptext SLIT("used as a") <+> text expected)
+
+famInstNotFound tycon tys
+ = failWithTc (quotes famInst <+> ptext SLIT("is not in scope"))
+ where
+ famInst = ppr tycon <+> hsep (map pprParendType tys)
\end{code}