Merge branch 'new-pipeline-ivo' into new-pipeline

# Conflicts:
#	accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/CodeGen.hs

accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/CodeGen.hs

@@ -351,9 +351,6 @@ unsafeToExpVars (TupRsingle (Var g idx)) = case g of
   GroundRbuffer _ -> error "unsafeToExpVars on a buffer"
   GroundRscalar t -> TupRsingle (Var t idx)
 
-instance SLVOperation NativeOp where
-  slvOperation = const Nothing
-
 maybeTy :: TypeR a -> TypeR (PrimMaybe a)
 maybeTy ty = TupRpair (TupRsingle scalarTypeWord8) (TupRpair TupRunit ty)
 

accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute.hs

@@ -100,12 +100,12 @@ executeSchedule !workers !threadIdx !env = \case
     executeSchedule workers threadIdx env next
   Awhile io step input next -> do
     executeAwhile workers threadIdx env io step (prjVars input env) next
-  Fork a (Effect (SignalAwait signals) b) -> do
-    scheduleAfter workers (map (`prj` env) signals) $ Job $ \threadIdx' -> executeSchedule workers threadIdx' env b
-    executeSchedule workers threadIdx env a
-  Fork a b -> do
-    schedule workers $ Job $ \threadIdx' -> executeSchedule workers threadIdx' env b
-    executeSchedule workers threadIdx env a
+  Spawn (Effect (SignalAwait signals) a) b -> do
+    scheduleAfter workers (map (`prj` env) signals) $ Job $ \threadIdx' -> executeSchedule workers threadIdx' env a
+    executeSchedule workers threadIdx env b
+  Spawn a b -> do
+    schedule workers $ Job $ \threadIdx' -> executeSchedule workers threadIdx' env a
+    executeSchedule workers threadIdx env b
 
 executeBinding :: Workers -> NativeEnv env -> BasesR t -> Binding env t -> IO (Values t)
 executeBinding workers !env tp = \case

accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Kernel.hs

@@ -33,6 +33,7 @@ import Data.Array.Accelerate.AST.Schedule.Uniform
 import Data.Array.Accelerate.Backend
 import Data.Array.Accelerate.Error
 import Data.Array.Accelerate.Lifetime
+import Data.Array.Accelerate.Pretty.Schedule
 
 import Data.Array.Accelerate.LLVM.State
 import Data.Array.Accelerate.LLVM.Native.State
@@ -55,6 +56,7 @@ import Data.Typeable
 import Foreign.LibFFI
 import Foreign.Ptr
 import Prettyprinter
+import Data.String
 import LLVM.AST.Type.Downcast
 import LLVM.AST.Type.Representation
 
@@ -89,4 +91,8 @@ instance IsKernel NativeKernel where
   kernelMetadata kernel = NativeKernelMetadata $ sizeOfEnv kernel
 
 instance PrettyKernel NativeKernel where
-  prettyKernel = PrettyKernelBody True $ \_ kernel -> viaShow $ kernelId kernel
+  prettyKernel = PrettyKernelFun go
+    where
+      go :: OpenKernelFun NativeKernel env t -> Adoc
+      go (KernelFunLam _ f) = go f
+      go (KernelFunBody kernel) = fromString $ take 16 $ show $ kernelId kernel

accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Operation.hs

@@ -173,11 +173,11 @@ instance SimplifyOperation NativeOp where
   detectCopy matchVars' NBackpermute = detectBackpermuteCopies matchVars'
   detectCopy _ _                     = const []
 
--- instance SLVOperation NativeOp where
---   slvOperation NGenerate    = defaultSlvGenerate    NGenerate
---   slvOperation NMap         = defaultSlvMap         NMap
---   slvOperation NBackpermute = defaultSlvBackpermute NBackpermute
---   slvOperation _ = Nothing
+instance SLVOperation NativeOp where
+  slvOperation NGenerate    = defaultSlvGenerate    NGenerate
+  slvOperation NMap         = defaultSlvMap         NMap
+  slvOperation NBackpermute = defaultSlvBackpermute NBackpermute
+  slvOperation _ = Nothing
 
 instance EncodeOperation NativeOp where
   encodeOperation NMap         = intHost $(hashQ ("Map" :: String))

accelerate-llvm-native/test/nofib/Main.hs

@@ -35,16 +35,16 @@ main = do
   let ys = map (\x -> T2 x x) $ 
             use xs
 
-
+  let program = let xs = A.use (A.fromList (A.Z A.:. 10) ([0..] :: [Int])) in 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
   let f = zip (reverse ys) ys
-  putStrLn $ test @UniformScheduleFun @NativeKernel $ backpermute (Z_ ::. 5) (\x->x) (reverse ys)
-  -- print $ run @Native $ f
+  putStrLn $ test @UniformScheduleFun @NativeKernel $ program -- backpermute (Z_ ::. 5) (\x->x) (reverse ys)
+  print $ runN @Native $ program
 
   -- putStrLn "generate:"
   -- let f = generate (I1 10) (\(I1 x0) -> 10 :: Exp Int)