Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 96 lines (77 sloc) 2.756 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
88dd956 @leepike Example tweaks.
authored
17 data Exp = C Int
18 | Add Exp Exp
19 | Div Exp Exp
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
b9f6a98 @leepike Div0 example: wibble.
authored
22 instance SubTypes Exp
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
23
88dd956 @leepike Example tweaks.
authored
24 eval :: Exp -> Maybe Int
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
25 eval (C i) = Just i
88dd956 @leepike Example tweaks.
authored
26 eval (Add e0 e1) =
27 liftM2 (+) (eval e0) (eval e1)
b9f6a98 @leepike Div0 example: wibble.
authored
28 eval (Div e0 e1) =
29 let e = eval e1 in
30 if e == Just 0 then Nothing
88dd956 @leepike Example tweaks.
authored
31 else liftM2 div (eval e0) e
32
33 instance Arbitrary Exp where
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
34 arbitrary = sized mkM
35 where
36 mkM 0 = liftM C arbitrary
b9f6a98 @leepike Div0 example: wibble.
authored
37 mkM n = oneof [ liftM2 Add mkM' mkM'
88dd956 @leepike Example tweaks.
authored
38 , liftM2 Div mkM' mkM' ]
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
39 where mkM' = mkM =<< choose (0,n-1)
40
c6516f6 @leepike paper updates.
authored
41 -- shrink (C i) = map C (shrink i)
42 -- shrink (Add e0 e1) = [e0, e1]
43 -- shrink (Div e0 e1) = [e0, e1]
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
44
f3c401f @leepike Remove unused stuff.
authored
45 -- property: so long as 0 isn't in the divisor, we won't try to divide by 0.
46 -- It's false: something might evaluate to 0 still.
b9f6a98 @leepike Div0 example: wibble.
authored
47 prop_div :: Exp -> Property
48 prop_div e = divSubTerms e ==> eval e /= Nothing
49 -- prop_div e = property $ case x of
1b20444 @leepike source wibbles.
authored
50 -- Nothing -> True
51 -- Just True -> True
52 -- _ -> False
53 -- where x = fmap (< 1) (eval e)
a5e19bf @leepike Updated README; other tweaks.
authored
54
384cba0 @leepike Use Property rather than Bool.
authored
55 -- precondition: no dividand in a subterm can be 0.
88dd956 @leepike Example tweaks.
authored
56 divSubTerms :: Exp -> Bool
57 divSubTerms (C _) = True
58 divSubTerms (Div _ (C 0)) = False
59 divSubTerms (Add e0 e1) = divSubTerms e0 && divSubTerms e1
60 divSubTerms (Div e0 e1) = divSubTerms e0 && divSubTerms e1
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
61
3afbf3e @leepike Implemented recursive generalization. Isn't so effective, as QC keeps g...
authored
62 -- div0 (A _ _) = property False
63 -- div0 _ = property True
64
b9f6a98 @leepike Div0 example: wibble.
authored
65 -- prop_test m = case eval m of
7e121eb @leepike Minor wibbles.
authored
66 -- Nothing -> True
67 -- Just i -> i < 5
b9f6a98 @leepike Div0 example: wibble.
authored
68
34aaaaa @leepike Get the examples to compile.
authored
69 divTest :: IO ()
b9f6a98 @leepike Div0 example: wibble.
authored
70 divTest = smartCheck args prop_div
71 where
72 args = scStdArgs { qcArgs = stdArgs
a5e19bf @leepike Updated README; other tweaks.
authored
73 -- { maxSuccess = 1000
74 -- , maxSize = 20 }
88dd956 @leepike Example tweaks.
authored
75 , format = PrintString
d0f1549 @leepike renaming of arguments.
authored
76 , runForall = True
1d16a53 @leepike Refactoring, modifying prettying-printing of extrapolated data.
authored
77 }
840f767 @leepike Trying to generalize from (a -> Bool) to QuickCheck.Property.
authored
78
d5bc31c @leepike Div0: helper functions.
authored
79 -- Get the minimal offending sub-value.
80 findVal :: Exp -> (Exp,Exp)
81 findVal (Div e0 e1)
82 | eval e1 == Just 0 = (e0,e1)
83 | eval e1 == Nothing = findVal e1
84 | otherwise = findVal e0
85 findVal a@(Add e0 e1)
86 | eval e0 == Nothing = findVal e0
87 | eval e1 == Nothing = findVal e1
88 | eval a == Just 0 = (a,a)
89 findVal _ = error "not possible"
90
91 divSubValue :: Exp
92 divSubValue =
93 Add (Div (C 5) (C (-12))) (Add (Add (C 2) (C 4)) (Add (C 7) (Div (C 3) (Add (C (-5)) (C 5)))))
94
95 --------------------------------------------------------------------------------
Something went wrong with that request. Please try again.