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

Vectorisation utilities

parent fd399de2
...@@ -11,7 +11,7 @@ module VectMonad ( ...@@ -11,7 +11,7 @@ module VectMonad (
noV, tryV, maybeV, traceMaybeV, orElseV, fixV, localV, closedV, initV, noV, tryV, maybeV, traceMaybeV, orElseV, fixV, localV, closedV, initV,
liftDs, liftDs,
cloneName, cloneId, cloneName, cloneId, cloneVar,
newExportedVar, newLocalVar, newDummyVar, newTyVar, newExportedVar, newLocalVar, newDummyVar, newTyVar,
Builtins(..), sumTyCon, prodTyCon, Builtins(..), sumTyCon, prodTyCon,
...@@ -301,6 +301,9 @@ cloneId mk_occ id ty ...@@ -301,6 +301,9 @@ cloneId mk_occ id ty
| otherwise = Id.mkLocalId name ty | otherwise = Id.mkLocalId name ty
return id' return id'
cloneVar :: Var -> VM Var
cloneVar var = liftM (setIdUnique var) (liftDs newUnique)
newExportedVar :: OccName -> Type -> VM Var newExportedVar :: OccName -> Type -> VM Var
newExportedVar occ_name ty newExportedVar occ_name ty
= do = do
......
...@@ -6,7 +6,8 @@ ...@@ -6,7 +6,8 @@
-- for details -- for details
module VectType ( vectTyCon, vectType, vectTypeEnv, module VectType ( vectTyCon, vectType, vectTypeEnv,
PAInstance, buildPADict ) mkRepr, arrShapeTys, arrShapeVars, arrSelector,
PAInstance, buildPADict )
where where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -362,6 +363,10 @@ replicateShape (IdRepr _) _ _ = return [] ...@@ -362,6 +363,10 @@ replicateShape (IdRepr _) _ _ = return []
replicateShape (VoidRepr {}) len _ = return [len] replicateShape (VoidRepr {}) len _ = return [len]
replicateShape (EnumRepr {}) len _ = return [len] replicateShape (EnumRepr {}) len _ = return [len]
arrSelector :: Repr -> [a] -> a
arrSelector (SumRepr {}) [_, sel, _] = sel
arrSelector _ _ = panic "arrSelector"
emptyArrRepr :: Repr -> VM [CoreExpr] emptyArrRepr :: Repr -> VM [CoreExpr]
emptyArrRepr (SumRepr { sum_components = prods }) emptyArrRepr (SumRepr { sum_components = prods })
= liftM concat $ mapM emptyArrRepr prods = liftM concat $ mapM emptyArrRepr prods
......
...@@ -8,7 +8,9 @@ ...@@ -8,7 +8,9 @@
module VectUtils ( module VectUtils (
collectAnnTypeBinders, collectAnnTypeArgs, isAnnTypeArg, collectAnnTypeBinders, collectAnnTypeArgs, isAnnTypeArg,
collectAnnValBinders, collectAnnValBinders,
mkDataConTag, mkDataConTagLit, dataConTagZ, mkDataConTag, mkDataConTagLit,
newLocalVVar,
mkBuiltinCo, mkBuiltinCo,
mkPADictType, mkPArrayType, mkPReprType, mkPADictType, mkPArrayType, mkPReprType,
...@@ -74,12 +76,14 @@ isAnnTypeArg :: AnnExpr b ann -> Bool ...@@ -74,12 +76,14 @@ isAnnTypeArg :: AnnExpr b ann -> Bool
isAnnTypeArg (_, AnnType t) = True isAnnTypeArg (_, AnnType t) = True
isAnnTypeArg _ = False isAnnTypeArg _ = False
dataConTagZ :: DataCon -> Int
dataConTagZ con = dataConTag con - fIRST_TAG
mkDataConTagLit :: DataCon -> Literal mkDataConTagLit :: DataCon -> Literal
mkDataConTagLit con mkDataConTagLit = mkMachInt . toInteger . dataConTagZ
= mkMachInt . toInteger $ dataConTag con - fIRST_TAG
mkDataConTag :: DataCon -> CoreExpr mkDataConTag :: DataCon -> CoreExpr
mkDataConTag con = mkIntLitInt (dataConTag con - fIRST_TAG) mkDataConTag = mkIntLitInt . dataConTagZ
splitPrimTyCon :: Type -> Maybe TyCon splitPrimTyCon :: Type -> Maybe TyCon
splitPrimTyCon ty splitPrimTyCon 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