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:
49dca6a
)
Fix vectorisation of sum type constructors
author
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Thu, 30 Aug 2007 03:52:25 +0000
(
03:52
+0000)
committer
Roman Leshchinskiy
<rl@cse.unsw.edu.au>
Thu, 30 Aug 2007 03:52:25 +0000
(
03:52
+0000)
compiler/prelude/PrelNames.lhs
patch
|
blob
|
history
compiler/vectorise/VectBuiltIn.hs
patch
|
blob
|
history
compiler/vectorise/VectType.hs
patch
|
blob
|
history
compiler/vectorise/VectUtils.hs
patch
|
blob
|
history
diff --git
a/compiler/prelude/PrelNames.lhs
b/compiler/prelude/PrelNames.lhs
index
1f09675
..
2740d26
100644
(file)
--- a/
compiler/prelude/PrelNames.lhs
+++ b/
compiler/prelude/PrelNames.lhs
@@
-223,6
+223,7
@@
ndpNames = [ parrayTyConName, paTyConName, preprTyConName, prTyConName
, closureTyConName
, mkClosureName, applyClosureName
, mkClosurePName, applyClosurePName
, closureTyConName
, mkClosureName, applyClosureName
, mkClosurePName, applyClosurePName
+ , replicatePAIntPrimName, upToPAIntPrimName
, lengthPAName, replicatePAName, emptyPAName, packPAName,
combinePAName ]
\end{code}
, lengthPAName, replicatePAName, emptyPAName, packPAName,
combinePAName ]
\end{code}
@@
-702,6
+703,9
@@
prTyConName = tcQual nDP_PARRAY FSLIT("PR") prTyConKey
parrayIntPrimTyConName = tcQual nDP_PRIM FSLIT("PArray_Int#")
parrayIntPrimTyConKey
mkPRName = varQual nDP_PARRAY FSLIT("mkPR") mkPRIdKey
parrayIntPrimTyConName = tcQual nDP_PRIM FSLIT("PArray_Int#")
parrayIntPrimTyConKey
mkPRName = varQual nDP_PARRAY FSLIT("mkPR") mkPRIdKey
+replicatePAIntPrimName = varQual nDP_PRIM FSLIT("replicatePA_Int#")
+ replicatePAIntPrimIdKey
+upToPAIntPrimName = varQual nDP_PRIM FSLIT("upToPA_Int#") upToPAIntPrimIdKey
lengthPAName = varQual nDP_PARRAY FSLIT("lengthPA") lengthPAIdKey
replicatePAName = varQual nDP_PARRAY FSLIT("replicatePA") replicatePAIdKey
emptyPAName = varQual nDP_PARRAY FSLIT("emptyPA") emptyPAIdKey
lengthPAName = varQual nDP_PARRAY FSLIT("lengthPA") lengthPAIdKey
replicatePAName = varQual nDP_PARRAY FSLIT("replicatePA") replicatePAIdKey
emptyPAName = varQual nDP_PARRAY FSLIT("emptyPA") emptyPAIdKey
@@
-1090,6
+1094,8
@@
emptyPAIdKey = mkPreludeMiscIdUnique 133
packPAIdKey = mkPreludeMiscIdUnique 134
combinePAIdKey = mkPreludeMiscIdUnique 135
mkPRIdKey = mkPreludeMiscIdUnique 136
packPAIdKey = mkPreludeMiscIdUnique 134
combinePAIdKey = mkPreludeMiscIdUnique 135
mkPRIdKey = mkPreludeMiscIdUnique 136
+replicatePAIntPrimIdKey = mkPreludeMiscIdUnique 137
+upToPAIntPrimIdKey = mkPreludeMiscIdUnique 138
---------------- Template Haskell -------------------
-- USES IdUniques 200-399
---------------- Template Haskell -------------------
-- USES IdUniques 200-399
diff --git
a/compiler/vectorise/VectBuiltIn.hs
b/compiler/vectorise/VectBuiltIn.hs
index
2338d87
..
e340cd1
100644
(file)
--- a/
compiler/vectorise/VectBuiltIn.hs
+++ b/
compiler/vectorise/VectBuiltIn.hs
@@
-53,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
@@
-93,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
@@
-117,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
diff --git
a/compiler/vectorise/VectType.hs
b/compiler/vectorise/VectType.hs
index
0e397ba
..
ba64d3b
100644
(file)
--- a/
compiler/vectorise/VectType.hs
+++ b/
compiler/vectorise/VectType.hs
@@
-297,6
+297,11
@@
arrShapeVars repr = mapM (newLocalVar FSLIT("sh")) =<< arrShapeTys repr
replicateShape :: Repr -> CoreExpr -> CoreExpr -> VM [CoreExpr]
replicateShape (ProdRepr {}) len _ = return [len]
replicateShape :: Repr -> CoreExpr -> CoreExpr -> VM [CoreExpr]
replicateShape (ProdRepr {}) len _ = return [len]
+replicateShape (SumRepr {}) len tag
+ = do
+ rep <- builtin replicatePAIntPrimVar
+ up <- builtin upToPAIntPrimVar
+ return [len, Var rep `mkApps` [len, tag], Var up `App` len]
arrReprElemTys :: Repr -> [[Type]]
arrReprElemTys (SumRepr { sum_components = prods })
arrReprElemTys :: Repr -> [[Type]]
arrReprElemTys (SumRepr { sum_components = prods })
diff --git
a/compiler/vectorise/VectUtils.hs
b/compiler/vectorise/VectUtils.hs
index
b9c4597
..
958c5e6
100644
(file)
--- a/
compiler/vectorise/VectUtils.hs
+++ b/
compiler/vectorise/VectUtils.hs
@@
-68,7
+68,7
@@
isAnnTypeArg (_, AnnType t) = True
isAnnTypeArg _ = False
mkDataConTag :: DataCon -> CoreExpr
isAnnTypeArg _ = False
mkDataConTag :: DataCon -> CoreExpr
-mkDataConTag dc = mkConApp intDataCon [mkIntLitInt $ dataConTag dc]
+mkDataConTag = mkIntLitInt . dataConTag
splitUnTy :: String -> Name -> Type -> Type
splitUnTy s name ty
splitUnTy :: String -> Name -> Type -> Type
splitUnTy s name ty