summaryrefslogtreecommitdiff
path: root/compiler/vectorise/Vectorise/Utils.hs
diff options
context:
space:
mode:
authorKavon Farvardin <kavon@farvard.in>2018-09-23 15:29:37 -0500
committerKavon Farvardin <kavon@farvard.in>2018-09-23 15:29:37 -0500
commit84c2ad99582391005b5e873198b15e9e9eb4f78d (patch)
treecaa8c2f2ec7e97fbb4977263c6817c9af5025cf4 /compiler/vectorise/Vectorise/Utils.hs
parent8ddb47cfcf5776e9a3c55fd37947c8a95e00fa12 (diff)
parente68b439fe5de61b9a2ca51af472185c62ccb8b46 (diff)
downloadhaskell-wip/T13904.tar.gz
update to current master againwip/T13904
Diffstat (limited to 'compiler/vectorise/Vectorise/Utils.hs')
-rw-r--r--compiler/vectorise/Vectorise/Utils.hs165
1 files changed, 0 insertions, 165 deletions
diff --git a/compiler/vectorise/Vectorise/Utils.hs b/compiler/vectorise/Vectorise/Utils.hs
deleted file mode 100644
index 733eeb9cfd..0000000000
--- a/compiler/vectorise/Vectorise/Utils.hs
+++ /dev/null
@@ -1,165 +0,0 @@
-module Vectorise.Utils (
- module Vectorise.Utils.Base,
- module Vectorise.Utils.Closure,
- module Vectorise.Utils.Hoisting,
- module Vectorise.Utils.PADict,
- module Vectorise.Utils.Poly,
-
- -- * Annotated Exprs
- collectAnnTypeArgs,
- collectAnnDictArgs,
- collectAnnTypeBinders,
- collectAnnValBinders,
- isAnnTypeArg,
-
- -- * PD Functions
- replicatePD, emptyPD, packByTagPD,
- combinePD, liftPD,
-
- -- * Scalars
- isScalar, zipScalars, scalarClosure,
-
- -- * Naming
- newLocalVar
-) where
-
-import Vectorise.Utils.Base
-import Vectorise.Utils.Closure
-import Vectorise.Utils.Hoisting
-import Vectorise.Utils.PADict
-import Vectorise.Utils.Poly
-import Vectorise.Monad
-import Vectorise.Builtins
-import CoreSyn
-import CoreUtils
-import Id
-import Type
-import Control.Monad
-
-
--- Annotated Exprs ------------------------------------------------------------
-
-collectAnnTypeArgs :: AnnExpr b ann -> (AnnExpr b ann, [Type])
-collectAnnTypeArgs expr = go expr []
- where
- go (_, AnnApp f (_, AnnType ty)) tys = go f (ty : tys)
- go e tys = (e, tys)
-
-collectAnnDictArgs :: AnnExpr Var ann -> (AnnExpr Var ann, [AnnExpr Var ann])
-collectAnnDictArgs expr = go expr []
- where
- go e@(_, AnnApp f arg) dicts
- | isPredTy . exprType . deAnnotate $ arg = go f (arg : dicts)
- | otherwise = (e, dicts)
- go e dicts = (e, dicts)
-
-collectAnnTypeBinders :: AnnExpr Var ann -> ([Var], AnnExpr Var ann)
-collectAnnTypeBinders expr = go [] expr
- where
- go bs (_, AnnLam b e) | isTyVar b = go (b : bs) e
- go bs e = (reverse bs, e)
-
--- |Collect all consecutive value binders that are not dictionaries.
---
-collectAnnValBinders :: AnnExpr Var ann -> ([Var], AnnExpr Var ann)
-collectAnnValBinders expr = go [] expr
- where
- go bs (_, AnnLam b e) | isId b
- && (not . isPredTy . idType $ b) = go (b : bs) e
- go bs e = (reverse bs, e)
-
-isAnnTypeArg :: AnnExpr b ann -> Bool
-isAnnTypeArg (_, AnnType _) = True
-isAnnTypeArg _ = False
-
-
--- PD "Parallel Data" Functions -----------------------------------------------
---
--- Given some data that has a PA dictionary, we can convert it to its
--- representation type, perform some operation on the data, then convert it back.
---
--- In the DPH backend, the types of these functions are defined
--- in dph-common/D.A.P.Lifted/PArray.hs
---
-
--- |An empty array of the given type.
---
-emptyPD :: Type -> VM CoreExpr
-emptyPD = paMethod emptyPDVar emptyPD_PrimVar
-
--- |Produce an array containing copies of a given element.
---
-replicatePD :: CoreExpr -- ^ Number of copies in the resulting array.
- -> CoreExpr -- ^ Value to replicate.
- -> VM CoreExpr
-replicatePD len x
- = liftM (`mkApps` [len,x])
- $ paMethod replicatePDVar replicatePD_PrimVar (exprType x)
-
--- |Select some elements from an array that correspond to a particular tag value and pack them into a new
--- array.
---
--- > packByTagPD Int# [:23, 42, 95, 50, 27, 49:] 3 [:1, 2, 1, 2, 3, 2:] 2
--- > ==> [:42, 50, 49:]
---
-packByTagPD :: Type -- ^ Element type.
- -> CoreExpr -- ^ Source array.
- -> CoreExpr -- ^ Length of resulting array.
- -> CoreExpr -- ^ Tag values of elements in source array.
- -> CoreExpr -- ^ The tag value for the elements to select.
- -> VM CoreExpr
-packByTagPD ty xs len tags t
- = liftM (`mkApps` [xs, len, tags, t])
- (paMethod packByTagPDVar packByTagPD_PrimVar ty)
-
--- |Combine some arrays based on a selector. The selector says which source array to choose for each
--- element of the resulting array.
---
-combinePD :: Type -- ^ Element type
- -> CoreExpr -- ^ Length of resulting array
- -> CoreExpr -- ^ Selector.
- -> [CoreExpr] -- ^ Arrays to combine.
- -> VM CoreExpr
-combinePD ty len sel xs
- = liftM (`mkApps` (len : sel : xs))
- (paMethod (combinePDVar n) (combinePD_PrimVar n) ty)
- where
- n = length xs
-
--- |Like `replicatePD` but use the lifting context in the vectoriser state.
---
-liftPD :: CoreExpr -> VM CoreExpr
-liftPD x
- = do
- lc <- builtin liftingContext
- replicatePD (Var lc) x
-
-
--- Scalars --------------------------------------------------------------------
-
-isScalar :: Type -> VM Bool
-isScalar ty
- = do
- { scalar <- builtin scalarClass
- ; existsInst scalar [ty]
- }
-
-zipScalars :: [Type] -> Type -> VM CoreExpr
-zipScalars arg_tys res_ty
- = do
- { scalar <- builtin scalarClass
- ; (dfuns, _) <- mapAndUnzipM (\ty -> lookupInst scalar [ty]) ty_args
- ; zipf <- builtin (scalarZip $ length arg_tys)
- ; return $ Var zipf `mkTyApps` ty_args `mkApps` map Var dfuns
- }
- where
- ty_args = arg_tys ++ [res_ty]
-
-scalarClosure :: [Type] -> Type -> CoreExpr -> CoreExpr -> VM CoreExpr
-scalarClosure arg_tys res_ty scalar_fun array_fun
- = do
- { ctr <- builtin (closureCtrFun $ length arg_tys)
- ; pas <- mapM paDictOfType (init arg_tys)
- ; return $ Var ctr `mkTyApps` (arg_tys ++ [res_ty])
- `mkApps` (pas ++ [scalar_fun, array_fun])
- }