spurious "non-exhaustive" pattern warnings?
Conal Elliott
conal at conal.net
Mon Mar 30 22:44:36 EDT 2009
-- Why do I get warnings about non-exhaustive pattern matches in the
-- following code? Is the compiler just not clever enough to notice that
-- the uncovered cases are all type-incorrect? (ghc 6.11.20090115)
{-# LANGUAGE TypeFamilies, EmptyDataDecls, TypeOperators
, GADTs, KindSignatures
, FlexibleInstances, FlexibleContexts
#-}
{-# OPTIONS_GHC -Wall #-}
import Control.Applicative (Applicative(..))
data Z
data S n
infixr 1 :<
data Vec :: * -> * -> * where
ZVec :: Vec Z a
(:<) :: a -> Vec n a -> Vec (S n) a
-- todo: infix op for SVec
instance Functor (Vec n) where
fmap _ ZVec = ZVec
fmap f (a :< u) = f a :< fmap f u
instance Applicative (Vec Z) where
pure _ = ZVec
ZVec <*> ZVec = ZVec
-- Warning: Pattern match(es) are non-exhaustive
-- In the definition of `<*>':
-- Patterns not matched:
-- (_ :< _) _
-- ZVec (_ :< _)
instance Applicative (Vec n) => Applicative (Vec (S n)) where
pure a = a :< pure a
(f :< fs) <*> (x :< xs) = f x :< (fs <*> xs)
-- Warning: Pattern match(es) are non-exhaustive
-- In the definition of `<*>':
-- Patterns not matched:
-- ZVec _
-- (_ :< _) ZVec
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/glasgow-haskell-users/attachments/20090330/fc1c9606/attachment.htm
More information about the Glasgow-haskell-users
mailing list