projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
d0e5514
)
Add PR dictionaries to vectorisation monad
author
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Thu, 23 Aug 2007 01:45:26 +0000
(
01:45
+0000)
committer
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Thu, 23 Aug 2007 01:45:26 +0000
(
01:45
+0000)
compiler/vectorise/VectMonad.hs
patch
|
blob
|
history
diff --git
a/compiler/vectorise/VectMonad.hs
b/compiler/vectorise/VectMonad.hs
index
0a14b6c
..
11f7b53
100644
(file)
--- a/
compiler/vectorise/VectMonad.hs
+++ b/
compiler/vectorise/VectMonad.hs
@@
-23,6
+23,7
@@
module VectMonad (
lookupTyCon, defTyCon,
lookupDataCon, defDataCon,
lookupTyConPA, defTyConPA, defTyConPAs,
lookupTyCon, defTyCon,
lookupDataCon, defDataCon,
lookupTyConPA, defTyConPA, defTyConPAs,
+ lookupTyConPR,
lookupTyVarPA, defLocalTyVar, defLocalTyVarWithPA, localTyVars,
{-lookupInst,-} lookupFamInst
lookupTyVarPA, defLocalTyVar, defLocalTyVarWithPA, localTyVars,
{-lookupInst,-} lookupFamInst
@@
-90,6
+91,9
@@
data GlobalEnv = GlobalEnv {
--
, global_pa_funs :: NameEnv Var
--
, global_pa_funs :: NameEnv Var
+ -- Mapping from TyCons to their PR dfuns
+ , global_pr_funs :: NameEnv Var
+
-- External package inst-env & home-package inst-env for class
-- instances
--
-- External package inst-env & home-package inst-env for class
-- instances
--
@@
-129,6
+133,7
@@
initGlobalEnv info instEnvs famInstEnvs
, global_tycons = mapNameEnv snd $ vectInfoTyCon info
, global_datacons = mapNameEnv snd $ vectInfoDataCon info
, global_pa_funs = mapNameEnv snd $ vectInfoPADFun info
, global_tycons = mapNameEnv snd $ vectInfoTyCon info
, global_datacons = mapNameEnv snd $ vectInfoDataCon info
, global_pa_funs = mapNameEnv snd $ vectInfoPADFun info
+ , global_pr_funs = emptyVarEnv
, global_inst_env = instEnvs
, global_fam_inst_env = famInstEnvs
, global_bindings = []
, global_inst_env = instEnvs
, global_fam_inst_env = famInstEnvs
, global_bindings = []
@@
-148,6
+153,10
@@
extendPAFunsEnv :: [(Name, Var)] -> GlobalEnv -> GlobalEnv
extendPAFunsEnv ps genv
= genv { global_pa_funs = extendNameEnvList (global_pa_funs genv) ps }
extendPAFunsEnv ps genv
= genv { global_pa_funs = extendNameEnvList (global_pa_funs genv) ps }
+setPRFunsEnv :: [(Name, Var)] -> GlobalEnv -> GlobalEnv
+setPRFunsEnv ps genv
+ = genv { global_pr_funs = mkNameEnv ps }
+
emptyLocalEnv = LocalEnv {
local_vars = emptyVarEnv
, local_tyvars = []
emptyLocalEnv = LocalEnv {
local_vars = emptyVarEnv
, local_tyvars = []
@@
-355,7
+364,10
@@
defTyConPAs ps = updGEnv $ \env ->
[(tyConName tc, pa) | (tc, pa) <- ps] }
lookupTyVarPA :: Var -> VM (Maybe CoreExpr)
[(tyConName tc, pa) | (tc, pa) <- ps] }
lookupTyVarPA :: Var -> VM (Maybe CoreExpr)
-lookupTyVarPA tv = readLEnv $ \env -> lookupVarEnv (local_tyvar_pa env) tv
+lookupTyVarPA tv = readLEnv $ \env -> lookupVarEnv (local_tyvar_pa env) tv
+
+lookupTyConPR :: TyCon -> VM (Maybe Var)
+lookupTyConPR tc = readGEnv $ \env -> lookupNameEnv (global_pr_funs env) (tyConName tc)
defLocalTyVar :: TyVar -> VM ()
defLocalTyVar tv = updLEnv $ \env ->
defLocalTyVar :: TyVar -> VM ()
defLocalTyVar tv = updLEnv $ \env ->