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 c5139cf36..422141341 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 @@ -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) diff --git a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute.hs b/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute.hs index c31f5d71b..fac8cf6dd 100644 --- a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Execute.hs +++ b/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 diff --git a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Kernel.hs b/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Kernel.hs index da484a5f2..405384db6 100644 --- a/accelerate-llvm-native/src/Data/Array/Accelerate/LLVM/Native/Kernel.hs +++ b/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 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 e5eb01981..8e27107b0 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 @@ -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)) diff --git a/accelerate-llvm-native/test/nofib/Main.hs b/accelerate-llvm-native/test/nofib/Main.hs index 1b2f95e99..f5b2045e3 100644 --- a/accelerate-llvm-native/test/nofib/Main.hs +++ b/accelerate-llvm-native/test/nofib/Main.hs @@ -35,7 +35,7 @@ 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 @@ -43,8 +43,8 @@ main = do 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)