From 070772f008bcb5edb63f3f2c2c5f10c4eb9cb008 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Fri, 24 Sep 2021 22:49:44 +0200 Subject: Potentially generate some code for Generate --- SC/Defs.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'SC/Defs.hs') diff --git a/SC/Defs.hs b/SC/Defs.hs index bb8e03f..fac4e33 100644 --- a/SC/Defs.hs +++ b/SC/Defs.hs @@ -4,6 +4,7 @@ module SC.Defs where import Data.Array.Accelerate.AST.Idx import Data.Array.Accelerate.Representation.Array +import Data.Array.Accelerate.Representation.Shape import Data.Array.Accelerate.Type import qualified Language.C as C @@ -59,6 +60,9 @@ type ANames = ITup TypedAName type Exprs = ITup C.Expr +itupEvars :: ITup TypedName t -> Exprs t +itupEvars = itupmap (\(TypedName _ n) -> C.EVar n) + -- Type is the pointer type of the type that this name is supposed to be according to the type index. data TypedAName = TypedAName C.Type Name @@ -84,6 +88,20 @@ shnamesList :: ShNames sh -> [TypedName] shnamesList ShZ = [] shnamesList (ShS n shns) = TypedName (C.TInt C.B64) n : shnamesList shns +makeShNames :: ShapeR sh -> ITup TypedName sh -> ShNames sh +makeShNames ShapeRz ITupIgnore = ShZ +makeShNames (ShapeRsnoc sht) (ITupPair ns (ITupSingle (TypedName _ n))) = + ShS n (makeShNames sht ns) +makeShNames _ _ = error "wat" + +fromShNames :: ShNames sh -> ITup TypedName sh +fromShNames ShZ = ITupIgnore +fromShNames (ShS n ns) = ITupPair (fromShNames ns) (ITupSingle (TypedName (C.TInt C.B64) n)) + +shNamesShape :: ShNames sh -> ShapeR sh +shNamesShape ShZ = ShapeRz +shNamesShape (ShS _ ns) = ShapeRsnoc (shNamesShape ns) + -- GENERATING VARIABLE NAMES -- ------------------------- -- cgit v1.2.3-70-g09d2