"impossible evaluation" error with accelerate-llvm-native

[albertov]

The following program produces an internal error in accelerate-llvm when using linear-accelerate. The same program runs fine using the reference interpreter.

{-# LANGUAGE ScopedTypeVariables #-}

import           Data.Array.Accelerate                  as A
import qualified Data.Array.Accelerate.LLVM.Native      as Native
import qualified Data.Array.Accelerate.Interpreter      as Interpreter
import           Data.Array.Accelerate.Linear.V1
import           Data.List (isInfixOf)
import           Test.Hspec

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "Native.run" $ do
    it "works with scalar" $ do
      let vec = 3.1 :: Exp (V1 Double)
      show (Native.run (unit vec)) `shouldSatisfy` isInfixOf "3.1"

    it "works with array" $ do
      let vec = A.map toV1 arr :: Acc (Array DIM1 (V1 Double))
          arr = fill (constant (Z :. 3)) (2 :: Exp Double)
      show (Native.run vec) `shouldSatisfy` isInfixOf "2"

  describe "Interpreter.run" $ do
    it "works with scalar" $ do
      let vec = 3.1 :: Exp (V1 Double)
      show (Interpreter.run (unit vec)) `shouldSatisfy` isInfixOf "3.1"

    it "works with array" $ do
      let vec = A.map toV1 arr :: Acc (Array DIM1 (V1 Double))
          arr = fill (constant (Z :. 3)) (2 :: Exp Double)
      show (Interpreter.run vec) `shouldSatisfy` isInfixOf "2"

toV1 :: forall a. Elt a => Exp a -> Exp (V1 a)
toV1 = lift1 (V1 :: Exp a -> V1 (Exp a))

The program produces the following output:

Native.run
  works with scalar
  works with array FAILED [1]
Interpreter.run
  works with scalar
  works with array

Failures:

  TestLinear.hs:20: 
  1) Native.run works with array
       uncaught exception: ErrorCall (
       *** Internal error in package accelerate ***
       *** Please submit a bug report at https://github.com/AccelerateHS/accelerate/issues
       ./Data/Array/Accelerate/LLVM/CodeGen/Exp.hs:185:18: (cvtT): impossible evaluation
       CallStack (from HasCallStack):
         error, called at ./Data/Array/Accelerate/LLVM/CodeGen/Exp.hs:185:18 in accelerate-llvm-1.0.0.0-Ld6HNMgqEqCKHiv2yHcWnt:Data.Array.Accelerate.LLVM.CodeGen.Exp)

Randomized with seed 2010085332

Finished in 0.0010 seconds
4 examples, 1 failure

[albertov]

I've removed the dependency on linear-accelerate so it's easier to reproduce:

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}

import           Data.Array.Accelerate                  as A
import           Data.Array.Accelerate.Product
import           Data.Array.Accelerate.Smart
import           Data.Array.Accelerate.Array.Sugar
import qualified Data.Array.Accelerate.LLVM.Native      as Native
import qualified Data.Array.Accelerate.Interpreter      as Interpreter
import           Data.List (isInfixOf)
import           Test.Hspec

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
  describe "Native.run" $ do
    it "works with scalar" $ do
      let vec = lift (V1 (3.1::Double)) :: Exp (V1 Double)
      show (Native.run (unit vec)) `shouldSatisfy` isInfixOf "3.1"

    it "works with array" $ do
      let vec = A.map toV1 arr :: Acc (Array DIM1 (V1 Double))
          arr = fill (constant (Z :. 3)) (2 :: Exp Double)
      show (Native.run vec) `shouldSatisfy` isInfixOf "2"

  describe "Interpreter.run" $ do
    it "works with scalar" $ do
      let vec = lift (V1 (3.1::Double)) :: Exp (V1 Double)
      show (Interpreter.run (unit vec)) `shouldSatisfy` isInfixOf "3.1"

    it "works with array" $ do
      let vec = A.map toV1 arr :: Acc (Array DIM1 (V1 Double))
          arr = fill (constant (Z :. 3)) (2 :: Exp Double)
      show (Interpreter.run vec) `shouldSatisfy` isInfixOf "2"

newtype V1 a = V1 a deriving Show

type instance EltRepr (V1 a) = EltRepr a

instance Elt a => Elt (V1 a) where
  eltType _ = eltType (undefined :: a)
  toElt = V1 . toElt
  fromElt (V1 a) = fromElt a

instance cst a => IsProduct cst (V1 a) where
  type ProdRepr (V1 a) = ((), a)
  fromProd _ (V1 x) = ((), x)
  toProd _ ((), x) = V1 x
  prod _ _ = ProdRsnoc ProdRunit

instance (Lift Exp a, Elt (Plain a)) => Lift Exp (V1 a) where
  type Plain (V1 a) = V1 (Plain a)
  lift (V1 x) = Exp . Tuple $ NilTup `SnocTup` lift x

instance Elt a => Unlift Exp (V1 (Exp a)) where
  unlift t = V1 $ Exp $ ZeroTupIdx `Prj` t

toV1 :: forall a. Elt a => Exp a -> Exp (V1 a)
toV1 = lift1 (V1 :: Exp a -> V1 (Exp a))

[tmcdonell]

Thanks for the test case! I will look into it.

[tmcdonell]

Okay, I think this is a problem with the definition of V1 in linear-accelerate. Notice how the EltRepr instance doesn't match that of ProdRepr (the missing leading ()). Changing to the following seems to fix it:

type instance EltRepr (V1 a) = ((), EltRepr a)

instance Elt a => Elt (V1 a) where
  eltType _      = PairTuple UnitTuple (eltType (undefined :: a))
  toElt ((),x)   = V1 (toElt x)
  fromElt (V1 a) = ((), fromElt a)

I'll update linear-accelerate and get you to try out the new version within your larger app to see if it fixes everything... hold tight.

[tmcdonell]

Let me know if that works for you and I'll release it as a new version

[albertov]

It does fix the problem in linear-accelerate indeed. Thanks for the quick response!

[tmcdonell]

http://hackage.haskell.org/package/linear-accelerate-0.5

Thank you for the great test case, this made it much easier to see the problem (: