projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Support for using built-in PA dictionaries for some types
[ghc-hetmet.git]
/
compiler
/
vectorise
/
Vectorise.hs
diff --git
a/compiler/vectorise/Vectorise.hs
b/compiler/vectorise/Vectorise.hs
index
bbfa562
..
bb5aa0d
100644
(file)
--- a/
compiler/vectorise/Vectorise.hs
+++ b/
compiler/vectorise/Vectorise.hs
@@
-25,11
+25,13
@@
import InstEnv ( extendInstEnvList )
import Var
import VarEnv
import VarSet
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 NameEnv
import Id
import MkId ( unwrapFamInstScrut )
import OccName
+import RdrName ( RdrName, mkRdrQual )
+import Module ( mkModuleNameFS )
import DsMonad hiding (mapAndUnzipM)
import DsUtils ( mkCoreTup, mkCoreTupTy )
import DsMonad hiding (mapAndUnzipM)
import DsUtils ( mkCoreTup, mkCoreTupTy )
@@
-44,6
+46,12
@@
import Outputable
import FastString
import Control.Monad ( liftM, liftM2, zipWithM, mapAndUnzipM )
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
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
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
(types', fam_insts, pa_insts) <- vectTypeEnv (mg_types guts)
let insts = map painstInstance pa_insts