match_co: needs more cases

crockeea ecrockett0 at gmail.com
Thu Nov 7 19:11:36 UTC 2013


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-tp5730855p5739541.html
Sent from the Haskell - Glasgow-haskell-users mailing list archive at Nabble.com.


More information about the Glasgow-haskell-users mailing list