From 101829e156d386cde8c736a21bb362f5589601b0 Mon Sep 17 00:00:00 2001 From: David van Balen Date: Mon, 15 Apr 2024 14:53:54 +0200 Subject: [PATCH] slv on partitioned --- .../Array/Accelerate/LLVM/Native/CodeGen.hs | 5 ++- .../Array/Accelerate/LLVM/Native/Operation.hs | 1 + accelerate-llvm-native/test/nofib/Main.hs | 43 ++++++++----------- 3 files changed, 24 insertions(+), 25 deletions(-) diff --git a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/CodeGen.hs b/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/CodeGen.hs index 422141341..0fab7f572 100644 --- a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/CodeGen.hs +++ b/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/CodeGen.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -33,6 +34,7 @@ module Data.Array.Accelerate.LLVM.Native.CodeGen where -- accelerate +import Data.Array.Accelerate.Trafo.Operation.LiveVars import Data.Array.Accelerate.Representation.Array import Data.Array.Accelerate.Representation.Shape (shapeType, ShapeR(..), rank) import Data.Array.Accelerate.Representation.Type @@ -481,11 +483,12 @@ instance (StaticClusterAnalysis op, EnvF (JustAccumulator op) ~ EnvF op) => Stat deriving instance (Eq (BackendClusterArg2 op x y)) => Eq (BackendClusterArg2 (JustAccumulator op) x y) deriving instance (Show (BackendClusterArg2 op x y)) => Show (BackendClusterArg2 (JustAccumulator op) x y) +deriving instance (ShrinkArg (BackendClusterArg op)) => ShrinkArg (BackendClusterArg (JustAccumulator op)) toOnlyAcc :: Cluster op args -> Cluster (JustAccumulator op) args toOnlyAcc (Fused f l r) = Fused f (toOnlyAcc l) (toOnlyAcc r) -toOnlyAcc (Op (SOp (SOAOp op soa) sort) l) = Op (SOp (SOAOp (JA op) soa) sort) l +toOnlyAcc (Op (SLV (SOp (SOAOp op soa) sort) subargs) l) = Op (SLV (SOp (SOAOp (JA op) soa) sort) subargs) l pattern CJ :: f a -> Compose Maybe f a pattern CJ x = Compose (Just x) diff --git a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Operation.hs b/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Operation.hs index 8e27107b0..cc6518f27 100644 --- a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Operation.hs +++ b/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Operation.hs @@ -345,6 +345,7 @@ instance StaticClusterAnalysis NativeOp where shToVar = bcan2id shrinkOrGrow = bcan2id addTup = bcan2id + inToVar = bcan2id -- onOp propagates the backpermute information from the outputs to the inputs of each operation onOp NMap (bp :>: ArgsNil) _ _ = BCAN2 Nothing undefined :>: bcan2id bp :>: bp :>: ArgsNil onOp NBackpermute (BCAN2 (Just bp@(BP shr1 shr2 g sh)) d :>: ArgsNil) (ArgFun f :>: ArgArray In (ArrayR shrI _) _ _ :>: ArgArray Out (ArrayR shrO _) _ _ :>: ArgsNil) _ diff --git a/accelerate-llvm-native/test/nofib/Main.hs b/accelerate-llvm-native/test/nofib/Main.hs index 3e1057c98..aa771a1fb 100644 --- a/accelerate-llvm-native/test/nofib/Main.hs +++ b/accelerate-llvm-native/test/nofib/Main.hs @@ -29,26 +29,20 @@ import Data.Array.Accelerate.Trafo.Partitioning.ILP.Solve import Data.Array.Accelerate.Data.Bits import Data.Array.Accelerate.Unsafe import Control.Concurrent - +import Quickhull main :: IO () main = do - let x = A.runN @Native $ A.zipWith (+) (A.use $ A.fromList (Z:.10) [1::Int ..]) (A.use $ A.fromList (Z:.10) [0..]) - print x - putStrLn "hi" - threadDelay 10000000 - putStrLn "bye" - - -- let xs = fromList (Z :. 10) [1 :: Int ..] - -- let ys = map (+1) $ - -- use xs - -- let f = map (*2) - -- let program = awhile (map (A.>0) . asnd) (\(T2 a b) -> T2 (f a) (map (\x -> x - 1) b)) (T2 ys $ unit $ constant (100000 :: Int)) - -- -- let program xs = - -- -- -- let xs = A.use (A.fromList (A.Z A.:. 10) ([0..] :: [Int])) in - -- -- A.map fst $ A.zip (A.reverse xs) (A.reverse $ A.backpermute (A.I1 10) Prelude.id (xs :: A.Acc (A.Vector Int))) - -- -- -- let f = T2 (map (+1) ys) (map (*2) $ reverse ys) - -- -- -- let f = sum $ map (\(T2 a b) -> a + b) $ - -- -- -- zip (reverse $ map (+1) (reverse ys)) $ reverse ys + let xs = fromList (Z :. 10) [1 :: Int ..] + let ys = map (+1) $ + use xs + let f = map (*2) + let program = awhile (map (A.>0) . asnd) (\(T2 a b) -> T2 (f a) (map (\x -> x - 1) b)) (T2 ys $ unit $ constant (100000 :: Int)) + -- let program xs = + -- -- let xs = A.use (A.fromList (A.Z A.:. 10) ([0..] :: [Int])) in + -- A.map fst $ A.zip (A.reverse xs) (A.reverse $ A.backpermute (A.I1 10) Prelude.id (xs :: A.Acc (A.Vector Int))) + -- -- let f = T2 (map (+1) ys) (map (*2) $ reverse ys) + -- -- let f = sum $ map (\(T2 a b) -> a + b) $ + -- -- zip (reverse $ map (+1) (reverse ys)) $ reverse ys -- let Z_ ::. n = shape ys -- let f'' = backpermute (Z_ ::. 5 ::. 2) (\(I2 x y) -> I1 (x*y)) ys -- let f' = replicate (Z_ ::. All_ ::. n) ys @@ -60,12 +54,6 @@ main = do -- -- let xs' = f xs -- print $ f - -- waste time: If this takes long enough, the idle worker threads crash of boredom - let x :: Int -> Int - x i | i Prelude.>= 10000000 = 0 - x i = x (i+1) + 1 - print $ x 9 - -- putStrLn "generate:" -- let f = generate (I1 10) (\(I1 x0) -> 10 :: Exp Int) -- -- putStrLn $ test @UniformScheduleFun @NativeKernel f @@ -87,6 +75,13 @@ main = do -- let f = scanl1 (+) ys -- -- putStrLn $ test @UniformScheduleFun @NativeKernel f -- print $ run @Native f + + putStrLn "mapscanmap:" + let f = map (*2) $ scanl1 (+) $ map (+4) ys + putStrLn $ test @UniformScheduleFun @NativeKernel f + print $ run @Native f + + -- Prelude.print $ runNWithObj @Native ArrayReadsWrites $ quicksort $ use $ fromList (Z :. 5) [100::Int, 200, 3, 5, 4]