projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix vectorisation of sum type constructors
[ghc-hetmet.git]
/
compiler
/
vectorise
/
VectBuiltIn.hs
diff --git
a/compiler/vectorise/VectBuiltIn.hs
b/compiler/vectorise/VectBuiltIn.hs
index
36159cf
..
e340cd1
100644
(file)
--- a/
compiler/vectorise/VectBuiltIn.hs
+++ b/
compiler/vectorise/VectBuiltIn.hs
@@
-2,7
+2,7
@@
module VectBuiltIn (
Builtins(..), sumTyCon, prodTyCon,
initBuiltins, initBuiltinTyCons, initBuiltinPAs, initBuiltinPRs,
Builtins(..), sumTyCon, prodTyCon,
initBuiltins, initBuiltinTyCons, initBuiltinPAs, initBuiltinPRs,
- primMethod
+ primMethod, primPArray
) where
#include "HsVersions.h"
) where
#include "HsVersions.h"
@@
-20,6
+20,7
@@
import NameEnv
import OccName
import TypeRep ( funTyCon )
import OccName
import TypeRep ( funTyCon )
+import Type ( Type )
import TysPrim
import TysWiredIn ( unitTyCon, tupleTyCon, intTyConName )
import PrelNames
import TysPrim
import TysWiredIn ( unitTyCon, tupleTyCon, intTyConName )
import PrelNames
@@
-44,7
+45,7
@@
data Builtins = Builtins {
, preprTyCon :: TyCon
, prTyCon :: TyCon
, prDataCon :: DataCon
, preprTyCon :: TyCon
, prTyCon :: TyCon
, prDataCon :: DataCon
- , uarrTyCon :: TyCon
+ , parrayIntPrimTyCon :: TyCon
, sumTyCons :: Array Int TyCon
, closureTyCon :: TyCon
, mkPRVar :: Var
, sumTyCons :: Array Int TyCon
, closureTyCon :: TyCon
, mkPRVar :: Var
@@
-52,6
+53,8
@@
data Builtins = Builtins {
, applyClosureVar :: Var
, mkClosurePVar :: Var
, applyClosurePVar :: Var
, applyClosureVar :: Var
, mkClosurePVar :: Var
, applyClosurePVar :: Var
+ , replicatePAIntPrimVar :: Var
+ , upToPAIntPrimVar :: Var
, lengthPAVar :: Var
, replicatePAVar :: Var
, emptyPAVar :: Var
, lengthPAVar :: Var
, replicatePAVar :: Var
, emptyPAVar :: Var
@@
-78,8
+81,8
@@
initBuiltins
let [paDataCon] = tyConDataCons paTyCon
preprTyCon <- dsLookupTyCon preprTyConName
prTyCon <- dsLookupTyCon prTyConName
let [paDataCon] = tyConDataCons paTyCon
preprTyCon <- dsLookupTyCon preprTyConName
prTyCon <- dsLookupTyCon prTyConName
- uarrTyCon <- dsLookupTyCon uarrTyConName
let [prDataCon] = tyConDataCons prTyCon
let [prDataCon] = tyConDataCons prTyCon
+ parrayIntPrimTyCon <- dsLookupTyCon parrayIntPrimTyConName
closureTyCon <- dsLookupTyCon closureTyConName
sum_tcs <- mapM (lookupExternalTyCon nDP_REPR)
closureTyCon <- dsLookupTyCon closureTyConName
sum_tcs <- mapM (lookupExternalTyCon nDP_REPR)
@@
-92,6
+95,8
@@
initBuiltins
applyClosureVar <- dsLookupGlobalId applyClosureName
mkClosurePVar <- dsLookupGlobalId mkClosurePName
applyClosurePVar <- dsLookupGlobalId applyClosurePName
applyClosureVar <- dsLookupGlobalId applyClosureName
mkClosurePVar <- dsLookupGlobalId mkClosurePName
applyClosurePVar <- dsLookupGlobalId applyClosurePName
+ replicatePAIntPrimVar <- dsLookupGlobalId replicatePAIntPrimName
+ upToPAIntPrimVar <- dsLookupGlobalId upToPAIntPrimName
lengthPAVar <- dsLookupGlobalId lengthPAName
replicatePAVar <- dsLookupGlobalId replicatePAName
emptyPAVar <- dsLookupGlobalId emptyPAName
lengthPAVar <- dsLookupGlobalId lengthPAName
replicatePAVar <- dsLookupGlobalId replicatePAName
emptyPAVar <- dsLookupGlobalId emptyPAName
@@
-108,7
+113,7
@@
initBuiltins
, preprTyCon = preprTyCon
, prTyCon = prTyCon
, prDataCon = prDataCon
, preprTyCon = preprTyCon
, prTyCon = prTyCon
, prDataCon = prDataCon
- , uarrTyCon = uarrTyCon
+ , parrayIntPrimTyCon = parrayIntPrimTyCon
, sumTyCons = sumTyCons
, closureTyCon = closureTyCon
, mkPRVar = mkPRVar
, sumTyCons = sumTyCons
, closureTyCon = closureTyCon
, mkPRVar = mkPRVar
@@
-116,6
+121,8
@@
initBuiltins
, applyClosureVar = applyClosureVar
, mkClosurePVar = mkClosurePVar
, applyClosurePVar = applyClosurePVar
, applyClosureVar = applyClosureVar
, mkClosurePVar = mkClosurePVar
, applyClosurePVar = applyClosurePVar
+ , replicatePAIntPrimVar = replicatePAIntPrimVar
+ , upToPAIntPrimVar = upToPAIntPrimVar
, lengthPAVar = lengthPAVar
, replicatePAVar = replicatePAVar
, emptyPAVar = emptyPAVar
, lengthPAVar = lengthPAVar
, replicatePAVar = replicatePAVar
, emptyPAVar = emptyPAVar
@@
-203,6
+210,14
@@
primMethod tycon method
| otherwise = return Nothing
| otherwise = return Nothing
+primPArray :: TyCon -> DsM (Maybe TyCon)
+primPArray tycon
+ | Just suffix <- lookupNameEnv prim_ty_cons (tyConName tycon)
+ = liftM Just
+ $ dsLookupTyCon =<< lookupOrig nDP_PRIM (mkOccName tcName $ "PArray" ++ suffix)
+
+ | otherwise = return Nothing
+
prim_ty_cons = mkNameEnv [mk_prim intPrimTyCon]
where
mk_prim tycon = (tyConName tycon, '_' : getOccString tycon)
prim_ty_cons = mkNameEnv [mk_prim intPrimTyCon]
where
mk_prim tycon = (tyConName tycon, '_' : getOccString tycon)