[Haskell-cafe] ghc overlapping instances
Isaac Dupree
isaacdupree at charter.net
Wed Dec 5 11:06:56 EST 2007
Steffen Mazanek wrote:
> Hi,
>
> Stefan and Isaac, thx for providing quick advice.
>
> @Stefan: Unfortunately I have to use a list.
> @Isaac: I do not get it. Could you please provide a short example of your
> approach?
>
> The question still remains. Which arguments do I have ghc to start with to
> get the same behavior than hugs with -98 +o (here it works).
>
> I provide my example for testing purposes:
>
> module Test where
> import Test.QuickCheck
> import Monad(liftM,liftM2)
>
> type Program = [Stmt]
> data Stmt = Text | IfElse Program Program | While Program deriving (Eq,
> Show)
>
> instance Arbitrary [Stmt] where
> arbitrary = sized genProg
> instance Arbitrary Stmt where
> arbitrary = sized genStmt
>
> genStmt::Int->Gen Stmt
> genStmt 0 = return Text
> genStmt 1 = return Text
> genStmt 2 = oneof [return Text, return (While [Text])]
> genStmt n | n>2 = oneof ([return Text,
> liftM While (genProg (n-1))]++
> [liftM2 IfElse (genProg k) (genProg
> (n-k-1))|k<-[1..n-2]])
>
> genProg::Int->Gen Program
> genProg 0 = return []
> genProg 1 = return [Text]
> genProg n | n>1 = oneof ((liftM (\x->[x]) (genStmt n)):[liftM2 (:) (genStmt
> k) (genProg (n-k))|k<-[1..n-1]])
>
> prop_ConstructParse progr = True
> where types = progr::Program
>
> main = mapM_ (\(s,a) -> putStrLn s >> a) [("flowchart construct and parse",
> test prop_ConstructParse)]
is prop_ConstructParse the only thing that breaks when you remove the
instance Arbitrary [Stmt] where arbitrary = sized genProg, or have I
missed something? If that's all, try this (untested) :
prop_ConstructParse = forAll (sized genProg) (\progr -> True)
and similarly for other properties.
Or, you _can_ use a newtype for quickcheck-only, something like this:
newtype P = P { unP :: Program }
instance Show P where show = show . unP
instance Arbitrary P where arbitrary = sized genProg . unP
prop_ConstructParse (P progr) = True
Isaac
More information about the Haskell-Cafe
mailing list