slv on partitioned

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)

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) _

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]