Add errors and assertions to Acc computations

accelerate-llvm/src/Data/Array/Accelerate/LLVM/AST.hs

@@ -70,6 +70,11 @@ data PreOpenAccCommand acc arch aenv a where
               -> acc                   arch aenv arrs2
               -> PreOpenAccCommand acc arch aenv arrs2
 
+  Aerror      :: ArraysR arrs2
+              -> Message                         arrs1
+              -> acc                   arch aenv arrs1
+              -> PreOpenAccCommand acc arch aenv arrs2
+
   Apply       :: ArraysR bs
               -> PreOpenAfun      (acc arch) aenv (as -> bs)
               -> acc                   arch  aenv as
@@ -200,6 +205,7 @@ instance HasArraysR (acc arch) => HasArraysR (PreOpenAccCommand acc arch) where
   arraysR (Apair a1 a2)                         = arraysR a1 `TupRpair` arraysR a2
   arraysR Anil                                  = TupRunit
   arraysR (Atrace _ _ a2)                       = arraysR a2
+  arraysR (Aerror repr _ _)                     = repr
   arraysR (Apply repr _ _)                      = repr
   arraysR (Aforeign repr _ _ _)                 = repr
   arraysR (Acond _ a1 _)                        = arraysR a1

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

@@ -84,6 +84,7 @@ llvmOfPreOpenAcc uid pacc aenv = evalCodeGen $
     Apair{}     -> unexpectedError
     Anil        -> unexpectedError
     Atrace{}    -> unexpectedError
+    Aerror{}    -> unexpectedError
     Use{}       -> unexpectedError
     Unit{}      -> unexpectedError
     Aforeign{}  -> unexpectedError

accelerate-llvm/src/Data/Array/Accelerate/LLVM/Compile.hs

@@ -150,6 +150,7 @@ compileOpenAcc = traverseAcc
         Apair a1 a2                 -> plain =<< liftA2 AST.Apair     <$> travA a1 <*> travA a2
         Anil                        -> plain $ pure AST.Anil
         Atrace msg a1 a2            -> plain =<< liftA2 (AST.Atrace msg) <$> travA a1 <*> travA a2
+        Aerror repr msg a           -> plain =<< liftA (AST.Aerror repr msg) <$> travA a
 
         -- Foreign arrays operations
         Aforeign repr ff afun a     -> foreignA repr ff afun a

accelerate-llvm/src/Data/Array/Accelerate/LLVM/Embed.hs

@@ -165,6 +165,7 @@ liftPreOpenAccCommand arch pacc =
     Apair a1 a2       -> [|| Apair $$(liftA a1) $$(liftA a2) ||]
     Anil              -> [|| Anil ||]
     Atrace msg a1 a2  -> [|| Atrace $$(liftMessage (arraysR a1) msg) $$(liftA a1) $$(liftA a2) ||]
+    Aerror repr msg a -> [|| Aerror $$(liftArraysR repr) $$(liftMessage (arraysR a) msg) $$(liftA a) ||]
     Apply repr f a    -> [|| Apply $$(liftArraysR repr) $$(liftAF f) $$(liftA a) ||]
     Acond p t e       -> [|| Acond $$(liftE p) $$(liftA t) $$(liftA e) ||]
     Awhile p f a      -> [|| Awhile $$(liftAF p) $$(liftAF f) $$(liftA a) ||]

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

@@ -31,7 +31,7 @@ import Data.Array.Accelerate.AST.Idx
 import Data.Array.Accelerate.AST.Var
 import Data.Array.Accelerate.Analysis.Match
 import Data.Array.Accelerate.Array.Data
-import Data.Array.Accelerate.Interpreter                        ( evalPrim, evalPrimConst, evalCoerceScalar, atraceOp )
+import Data.Array.Accelerate.Interpreter                        ( evalPrim, evalPrimConst, evalCoerceScalar, atraceOp, aerrorOp )
 import Data.Array.Accelerate.Representation.Array
 import Data.Array.Accelerate.Representation.Elt
 import Data.Array.Accelerate.Representation.Shape
@@ -285,6 +285,10 @@ executeOpenAcc !topAcc !aenv = travA topAcc
           a1' <- travA a1 >>= blockArrays repr >>= copyToHost repr
           liftIO $ atraceOp msg a1'
           travA a2
+        Aerror _ msg a1 -> do
+          let repr = arraysR a1
+          a1' <- travA a1 >>= blockArrays repr >>= copyToHost repr
+          aerrorOp msg a1'
 
         -- We need quite some type applications in the rules for acond and awhile, and cannot use do notation.
         -- For some unknown reason, GHC will "simplify" 'FutureArraysR arch a' to 'FutureR arch a', which is not sound.

accelerate-llvm/src/Data/Array/Accelerate/LLVM/Link.hs

@@ -123,6 +123,7 @@ linkOpenAcc = travA
         Acond p t e             -> Acond p         <$> travA t  <*> travA e
         Apair a1 a2             -> Apair           <$> travA a1 <*> travA a2
         Atrace msg a1 a2        -> Atrace msg      <$> travA a1 <*> travA a2
+        Aerror repr msg a1      -> Aerror repr msg <$> travA a1
         Anil                    -> return Anil
         Reshape shr s ix        -> Reshape shr s   <$> pure ix
         Aforeign s r f a        -> Aforeign s r f  <$> travA a