lookupVar, defGlobalVar,
lookupTyCon, defTyCon,
lookupDataCon, defDataCon,
- lookupTyConPA, defTyConPA,
+ lookupTyConPA, defTyConPA, defTyConRdrPAs,
lookupTyVarPA, defLocalTyVar, defLocalTyVarWithPA, localTyVars,
lookupInst, lookupFamInst
defTyConPA tc pa = updGEnv $ \env ->
env { global_pa_funs = extendNameEnv (global_pa_funs env) (tyConName tc) pa }
+defTyConRdrPAs :: [(Name, RdrName)] -> VM ()
+defTyConRdrPAs ps
+ = do
+ pas <- mapM lookupRdrVar rdr_names
+ updGEnv $ \env ->
+ env { global_pa_funs = extendNameEnvList (global_pa_funs env)
+ (zip tcs pas) }
+ where
+ (tcs, rdr_names) = unzip ps
+
lookupTyVarPA :: Var -> VM (Maybe CoreExpr)
lookupTyVarPA tv = readLEnv $ \env -> lookupVarEnv (local_tyvar_pa env) tv
import Var
import VarEnv
import VarSet
-import Name ( mkSysTvName, getName )
+import Name ( Name, mkSysTvName, getName )
import NameEnv
import Id
import MkId ( unwrapFamInstScrut )
import OccName
+import RdrName ( RdrName, mkRdrQual )
+import Module ( mkModuleNameFS )
import DsMonad hiding (mapAndUnzipM)
import DsUtils ( mkCoreTup, mkCoreTupTy )
import FastString
import Control.Monad ( liftM, liftM2, zipWithM, mapAndUnzipM )
+mkNDPVar :: FastString -> RdrName
+mkNDPVar fs = mkRdrQual nDP_BUILTIN (mkVarOccFS fs)
+
+builtin_PAs :: [(Name, RdrName)]
+builtin_PAs = [(intTyConName, mkNDPVar FSLIT("dPA_Int"))]
+
vectorise :: HscEnv -> UniqSupply -> RuleBase -> ModGuts
-> IO (SimplCount, ModGuts)
vectorise hsc_env _ _ guts
vectModule :: ModGuts -> VM ModGuts
vectModule guts
= do
+ defTyConRdrPAs builtin_PAs
(types', fam_insts, pa_insts) <- vectTypeEnv (mg_types guts)
let insts = map painstInstance pa_insts