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

Fix vectorisation of sum type constructors

parent 49dca6ac
...@@ -223,6 +223,7 @@ ndpNames = [ parrayTyConName, paTyConName, preprTyConName, prTyConName ...@@ -223,6 +223,7 @@ ndpNames = [ parrayTyConName, paTyConName, preprTyConName, prTyConName
, closureTyConName , closureTyConName
, mkClosureName, applyClosureName , mkClosureName, applyClosureName
, mkClosurePName, applyClosurePName , mkClosurePName, applyClosurePName
, replicatePAIntPrimName, upToPAIntPrimName
, lengthPAName, replicatePAName, emptyPAName, packPAName, , lengthPAName, replicatePAName, emptyPAName, packPAName,
combinePAName ] combinePAName ]
\end{code} \end{code}
...@@ -702,6 +703,9 @@ prTyConName = tcQual nDP_PARRAY FSLIT("PR") prTyConKey ...@@ -702,6 +703,9 @@ prTyConName = tcQual nDP_PARRAY FSLIT("PR") prTyConKey
parrayIntPrimTyConName = tcQual nDP_PRIM FSLIT("PArray_Int#") parrayIntPrimTyConName = tcQual nDP_PRIM FSLIT("PArray_Int#")
parrayIntPrimTyConKey parrayIntPrimTyConKey
mkPRName = varQual nDP_PARRAY FSLIT("mkPR") mkPRIdKey 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 lengthPAName = varQual nDP_PARRAY FSLIT("lengthPA") lengthPAIdKey
replicatePAName = varQual nDP_PARRAY FSLIT("replicatePA") replicatePAIdKey replicatePAName = varQual nDP_PARRAY FSLIT("replicatePA") replicatePAIdKey
emptyPAName = varQual nDP_PARRAY FSLIT("emptyPA") emptyPAIdKey emptyPAName = varQual nDP_PARRAY FSLIT("emptyPA") emptyPAIdKey
...@@ -1090,6 +1094,8 @@ emptyPAIdKey = mkPreludeMiscIdUnique 133 ...@@ -1090,6 +1094,8 @@ emptyPAIdKey = mkPreludeMiscIdUnique 133
packPAIdKey = mkPreludeMiscIdUnique 134 packPAIdKey = mkPreludeMiscIdUnique 134
combinePAIdKey = mkPreludeMiscIdUnique 135 combinePAIdKey = mkPreludeMiscIdUnique 135
mkPRIdKey = mkPreludeMiscIdUnique 136 mkPRIdKey = mkPreludeMiscIdUnique 136
replicatePAIntPrimIdKey = mkPreludeMiscIdUnique 137
upToPAIntPrimIdKey = mkPreludeMiscIdUnique 138
---------------- Template Haskell ------------------- ---------------- Template Haskell -------------------
-- USES IdUniques 200-399 -- USES IdUniques 200-399
......
...@@ -53,6 +53,8 @@ data Builtins = Builtins { ...@@ -53,6 +53,8 @@ data Builtins = Builtins {
, applyClosureVar :: Var , applyClosureVar :: Var
, mkClosurePVar :: Var , mkClosurePVar :: Var
, applyClosurePVar :: Var , applyClosurePVar :: Var
, replicatePAIntPrimVar :: Var
, upToPAIntPrimVar :: Var
, lengthPAVar :: Var , lengthPAVar :: Var
, replicatePAVar :: Var , replicatePAVar :: Var
, emptyPAVar :: Var , emptyPAVar :: Var
...@@ -93,6 +95,8 @@ initBuiltins ...@@ -93,6 +95,8 @@ initBuiltins
applyClosureVar <- dsLookupGlobalId applyClosureName applyClosureVar <- dsLookupGlobalId applyClosureName
mkClosurePVar <- dsLookupGlobalId mkClosurePName mkClosurePVar <- dsLookupGlobalId mkClosurePName
applyClosurePVar <- dsLookupGlobalId applyClosurePName applyClosurePVar <- dsLookupGlobalId applyClosurePName
replicatePAIntPrimVar <- dsLookupGlobalId replicatePAIntPrimName
upToPAIntPrimVar <- dsLookupGlobalId upToPAIntPrimName
lengthPAVar <- dsLookupGlobalId lengthPAName lengthPAVar <- dsLookupGlobalId lengthPAName
replicatePAVar <- dsLookupGlobalId replicatePAName replicatePAVar <- dsLookupGlobalId replicatePAName
emptyPAVar <- dsLookupGlobalId emptyPAName emptyPAVar <- dsLookupGlobalId emptyPAName
...@@ -117,6 +121,8 @@ initBuiltins ...@@ -117,6 +121,8 @@ initBuiltins
, applyClosureVar = applyClosureVar , applyClosureVar = applyClosureVar
, mkClosurePVar = mkClosurePVar , mkClosurePVar = mkClosurePVar
, applyClosurePVar = applyClosurePVar , applyClosurePVar = applyClosurePVar
, replicatePAIntPrimVar = replicatePAIntPrimVar
, upToPAIntPrimVar = upToPAIntPrimVar
, lengthPAVar = lengthPAVar , lengthPAVar = lengthPAVar
, replicatePAVar = replicatePAVar , replicatePAVar = replicatePAVar
, emptyPAVar = emptyPAVar , emptyPAVar = emptyPAVar
......
...@@ -297,6 +297,11 @@ arrShapeVars repr = mapM (newLocalVar FSLIT("sh")) =<< arrShapeTys repr ...@@ -297,6 +297,11 @@ arrShapeVars repr = mapM (newLocalVar FSLIT("sh")) =<< arrShapeTys repr
replicateShape :: Repr -> CoreExpr -> CoreExpr -> VM [CoreExpr] replicateShape :: Repr -> CoreExpr -> CoreExpr -> VM [CoreExpr]
replicateShape (ProdRepr {}) len _ = return [len] 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 :: Repr -> [[Type]]
arrReprElemTys (SumRepr { sum_components = prods }) arrReprElemTys (SumRepr { sum_components = prods })
......
...@@ -68,7 +68,7 @@ isAnnTypeArg (_, AnnType t) = True ...@@ -68,7 +68,7 @@ isAnnTypeArg (_, AnnType t) = True
isAnnTypeArg _ = False isAnnTypeArg _ = False
mkDataConTag :: DataCon -> CoreExpr mkDataConTag :: DataCon -> CoreExpr
mkDataConTag dc = mkConApp intDataCon [mkIntLitInt $ dataConTag dc] mkDataConTag = mkIntLitInt . dataConTag
splitUnTy :: String -> Name -> Type -> Type splitUnTy :: String -> Name -> Type -> Type
splitUnTy s name ty splitUnTy s name ty
......
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