Skip to content
Newer
Older
100644 73 lines (57 sloc) 1.82 KB
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
1 {-# LANGUAGE DeriveDataTypeable #-}
1269ec4 @leepike Use GHC.Generics to implement the SubTypes class generically.
authored
2 {-# LANGUAGE DeriveGeneric #-}
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
3
4 -- | Divide by 0 example in a simple arithmetic language.
5
6 module Div0 where
7
1d16a53 @leepike Refactoring, modifying prettying-printing of extrapolated data.
authored
8 import Test.QuickCheck
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
9 import Test.SmartCheck
10 import Control.Monad
1269ec4 @leepike Use GHC.Generics to implement the SubTypes class generically.
authored
11
12 import GHC.Generics
68bd4ad @leepike import Data.Typeable.
authored
13 import Data.Typeable
14
15 -----------------------------------------------------------------
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
16
17 data M = C Int
18 | A M M
19 | D M M
1aedbcb @leepike Remove dependence on Data.Data.
authored
20 deriving (Read, Show, Typeable, Generic)
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
21
1269ec4 @leepike Use GHC.Generics to implement the SubTypes class generically.
authored
22 instance SubTypes M
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
23
24 eval :: M -> Maybe Int
25 eval (C i) = Just i
26 eval (A a b) = do
27 i <- eval a
28 j <- eval b
29 return $ i + j
30 eval (D a b) =
31 if eval b == Just 0 then Nothing
32 else do i <- eval a
33 j <- eval b
34 return $ i `div` j
35
36 instance Arbitrary M where
37 arbitrary = sized mkM
38 where
39 mkM 0 = liftM C arbitrary
40 mkM n = oneof [ liftM2 A mkM' mkM'
41 , liftM2 D mkM' mkM' ]
42 where mkM' = mkM =<< choose (0,n-1)
43
1269ec4 @leepike Use GHC.Generics to implement the SubTypes class generically.
authored
44 -- shrink (C _) = []
45 -- shrink (A a b) = [a, b]
46 -- shrink (D a b) = [a, b]
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
47
f3c401f @leepike Remove unused stuff.
authored
48 -- property: so long as 0 isn't in the divisor, we won't try to divide by 0.
49 -- It's false: something might evaluate to 0 still.
a5e19bf @leepike Updated README; other tweaks.
authored
50 div_prop :: M -> Property
51 div_prop m = divSubTerms m ==> eval m /= Nothing
52
384cba0 @leepike Use Property rather than Bool.
authored
53 -- precondition: no dividand in a subterm can be 0.
a5e19bf @leepike Updated README; other tweaks.
authored
54 divSubTerms :: M -> Bool
55 divSubTerms (C _) = True
56 divSubTerms (D _ (C 0)) = False
57 divSubTerms (A m0 m1) = divSubTerms m0 && divSubTerms m1
58 divSubTerms (D m0 m1) = divSubTerms m0 && divSubTerms m1
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
59
3afbf3e @leepike Implemented recursive generalization. Isn't so effective, as QC keeps…
authored
60 -- div0 (A _ _) = property False
61 -- div0 _ = property True
62
34aaaaa @leepike Get the examples to compile.
authored
63 divTest :: IO ()
a5e19bf @leepike Updated README; other tweaks.
authored
64 divTest = smartCheck args div_prop
1d16a53 @leepike Refactoring, modifying prettying-printing of extrapolated data.
authored
65 where
663df16 @leepike Bug in Extrapolation.
authored
66 args = scStdArgs { qcArgs = stdArgs
a5e19bf @leepike Updated README; other tweaks.
authored
67 -- { maxSuccess = 1000
68 -- , maxSize = 20 }
663df16 @leepike Bug in Extrapolation.
authored
69 , treeShow = PrintString
1d16a53 @leepike Refactoring, modifying prettying-printing of extrapolated data.
authored
70 }
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
71
72 ---------------------------------------------------------------------------------
Something went wrong with that request. Please try again.