Commit e12e8c14 authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au
Browse files

Support for using built-in PA dictionaries for some types

parent 97b95db0
......@@ -21,7 +21,7 @@ module VectMonad (
lookupVar, defGlobalVar,
lookupTyCon, defTyCon,
lookupDataCon, defDataCon,
lookupTyConPA, defTyConPA,
lookupTyConPA, defTyConPA, defTyConRdrPAs,
lookupTyVarPA, defLocalTyVar, defLocalTyVarWithPA, localTyVars,
lookupInst, lookupFamInst
......@@ -413,6 +413,16 @@ defTyConPA :: TyCon -> Var -> VM ()
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
......
......@@ -25,11 +25,13 @@ import InstEnv ( extendInstEnvList )
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 )
......@@ -44,6 +46,12 @@ import Outputable
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
......@@ -60,6 +68,7 @@ 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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment