module Vectorise.Monad.InstEnv (
lookupInst,
lookupFamInst
) where
import Vectorise.Monad.Global
import Vectorise.Monad.Base
import Vectorise.Env
import FamInstEnv
import InstEnv
import Class
import Type
import TyCon
import Outputable
#include "HsVersions.h"
getInstEnv :: VM (InstEnv, InstEnv)
getInstEnv = readGEnv global_inst_env
getFamInstEnv :: VM FamInstEnvs
getFamInstEnv = readGEnv global_fam_inst_env
lookupInst :: Class -> [Type] -> VM (DFunId, [Type])
lookupInst cls tys
= do { instEnv <- getInstEnv
; case lookupInstEnv instEnv cls tys of
([(inst, inst_tys)], _)
| noFlexiVar -> return (instanceDFunId inst, inst_tys')
| otherwise -> pprPanic "VectMonad.lookupInst: flexi var: "
(ppr $ mkTyConApp (classTyCon cls) tys)
where
inst_tys' = [ty | Right ty <- inst_tys]
noFlexiVar = all isRight inst_tys
_other ->
pprPanic "VectMonad.lookupInst: not found " (ppr cls <+> ppr tys)
}
where
isRight (Left _) = False
isRight (Right _) = True
lookupFamInst :: TyCon -> [Type] -> VM (TyCon, [Type])
lookupFamInst tycon tys
= ASSERT( isFamilyTyCon tycon )
do { instEnv <- getFamInstEnv
; case lookupFamInstEnv instEnv tycon tys of
[(fam_inst, rep_tys)] -> return (famInstTyCon fam_inst, rep_tys)
_other ->
pprPanic "VectMonad.lookupFamInst: not found: "
(ppr $ mkTyConApp tycon tys)
}