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