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