
I got this error with a small example, so I thought I'd post it for you. I could only get it to work when split over two files. Main.hs: import qualified Data.Vector.Unboxed as U import Helper main = do let iters = 100 dim = 221184 y = U.replicate dim 0 :: U.Vector (ZqW M) let ans = iterate (f y) y !! iters putStr $ (show $ U.foldl1' (+) ans) Helper.hs {-# LANGUAGE FlexibleContexts, StandaloneDeriving, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} module VectorTestHelper (ZqW,f,M) where import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Generic as V import Data.Vector.Generic.Mutable as M f :: (Num r, V.Vector v r) => v r -> v r -> v r {-# SPECIALIZE f :: (Num (ZqW m Int)) => U.Vector (ZqW m Int) -> U.Vector (ZqW m Int) -> U.Vector (ZqW m Int) #-} f x y = V.zipWith (+) x y newtype ZqW p i = T i deriving (U.Unbox, Show) deriving instance (U.Unbox i) => V.Vector U.Vector (ZqW p i) deriving instance (U.Unbox i) => MVector U.MVector (ZqW p i) class Foo a b data M instance Foo M Int instance (Foo p i, Integral i) => Num (ZqW p i) where (T a) + (T b) = T $ (a+b) fromInteger x = T $ fromInteger x It's possible I'm abusing SPECIALIZE here, but I'm trying to get Unboxed vector specialization, even though I have a phantom type. (In practice, the phantom will represent a modulus and will be used in the Num instance). When compiling with GHC 7.6.2 and -O2, I get a dozen or so "match_co: needs more cases" warnings. Indeed, based on the runtime, it appears that specialization is not happening. How to actually make this work is a whole different question... -- View this message in context: http://haskell.1045720.n5.nabble.com/match-co-needs-more-cases-tp5730855p573... Sent from the Haskell - Glasgow-haskell-users mailing list archive at Nabble.com.