module QuickCheck where
import Test.QuickCheck
import Control.Monad(liftM,liftM2,liftM3)
import Data.List(sort,insert)
import Data.Maybe (fromMaybe)
import Data.Map(Map)
import qualified Data.Map as Map
prop_revapp :: [Int] -> [Int] -> Bool
prop_revapp xs ys = reverse (xs ++ ys) == reverse xs ++ reverse ys
prop_revapp_ok :: [Int] -> [Int] -> Bool
prop_revapp_ok xs ys = reverse (xs ++ ys) == reverse ys ++ reverse xs
quickCheckN n = quickCheckWith $ stdArgs { maxSuccess = n }
qsort [] = []
qsort (x:xs) = qsort lhs ++ [x] ++ qsort rhs
where lhs = [y | y <- xs, y < x] -- this is a "list comprehension"
rhs = [z | z <- xs, z > x]
isOrdered :: Ord a => [a] -> Bool
isOrdered = undefined
prop_qsort_isOrdered :: [Int] -> Bool
prop_qsort_isOrdered = undefined
prop_qsort_idemp :: [Int] -> Bool
prop_qsort_idemp xs = qsort (qsort xs) == qsort xs
prop_qsort_min :: [Int] -> Bool
prop_qsort_min xs = head (qsort xs) == minimum xs
prop_qsort_nn_min :: [Int] -> Property
prop_qsort_nn_min xs =
not (null xs) ==> head (qsort xs) == minimum xs
prop_qsort_nn_max :: [Int] -> Property
prop_qsort_nn_max xs =
not (null xs) ==> head (reverse (qsort xs)) == maximum xs
prop_qsort_sort :: [Int] -> Bool
prop_qsort_sort xs = qsort xs == sort xs
isDistinct :: Eq a => [a] -> Bool
isDistinct = undefined
prop_qsort_distinct :: [Int] -> Bool
prop_qsort_distinct = isDistinct . qsort
prop_qsort_distinct_sort :: [Int] -> Property
prop_qsort_distinct_sort xs =
(isDistinct xs) ==> qsort xs == sort xs
isort :: Ord a => [a] -> [a]
isort = foldr insert []
prop_isort_sort :: [Int] -> Bool
prop_isort_sort xs = isort xs == sort xs
prop_insert_ordered' :: Int -> [Int] -> Bool
prop_insert_ordered' x xs = isOrdered (insert x xs)
prop_insert_ordered :: Int -> [Int] -> Property
prop_insert_ordered x xs =
isOrdered xs ==> isOrdered (insert x xs)
prop_insert_ordered_vacuous :: Int -> [Int] -> Bool
prop_insert_ordered_vacuous x xs =
not (isOrdered xs) || isOrdered (insert x xs)
prop_insert_ordered_vacuous' :: Int -> [Int] -> Property
prop_insert_ordered_vacuous' x xs =
collect (length xs) $
classify (isOrdered xs) "ord" $
classify (not (isOrdered xs)) "not-ord" $
not (isOrdered xs) || isOrdered (insert x xs)
genList1 :: (Arbitrary a) => Gen [a]
genList1 = liftM2 (:) arbitrary genList1
genList2 :: (Arbitrary a) => Gen [a]
genList2 = oneof [ return []
, liftM2 (:) arbitrary genList2]
genList3 :: (Arbitrary a) => Gen [a]
genList3 = frequency [ (1, return [])
, (7, liftM2 (:) arbitrary genList3) ]
genOrdList :: (Arbitrary a, Ord a) => Gen [a]
genOrdList = genList3 >>= return . sort
prop_insert :: Int -> Property
prop_insert x = forAll genOrdList $ \xs -> isOrdered xs && isOrdered (insert x xs)
data Expression =
Var Variable
| Val Value
| Op Bop Expression Expression
deriving (Eq, Ord)
newtype Variable = V String deriving (Eq, Ord)
data Value =
IntVal Int
| BoolVal Bool
deriving (Eq, Ord)
data Bop =
Plus -- + :: Int -> Int -> Int
| Minus -- - :: Int -> Int -> Int
| Times -- * :: Int -> Int -> Int
| Gt -- > :: Int -> Int -> Bool
| Ge -- >= :: Int -> Int -> Bool
| Lt -- < :: Int -> Int -> Bool
| Le -- <= :: Int -> Int -> Bool
deriving (Eq, Ord)
instance Show Variable where
show (V x) = x
instance Show Value where
show (IntVal x) = show x
show (BoolVal x) = show x
instance Show Bop where
show b = case b of
Plus -> "+"
Minus -> "-"
Times -> "*"
Gt -> ">"
Ge -> ">="
Lt -> "<"
Le -> "<="
instance Show Expression where
showsPrec d (Var x) = showsPrec d x
showsPrec d (Val x) = showsPrec d x
showsPrec d (Op bop e1 e2) = showParen (d > op_prec) $
showsPrec (op_prec + 1) e1 .
showsPrec d bop .
showsPrec (op_prec + 1) e2
where op_prec = precedence bop
precedence :: Bop -> Int
precedence Times = 8
precedence Plus = 7
precedence Minus = 7
precedence Gt = 6
precedence Ge = 6
precedence Lt = 6
precedence Le = 6
type Store = Map Variable Value
evalBop :: Bop -> Value -> Value -> Value
evalBop Plus (IntVal v1) (IntVal v2) = IntVal (v1 + v2)
evalBop Times (IntVal v1) (IntVal v2) = IntVal (v1 * v2)
evalBop Minus (IntVal v1) (IntVal v2) = IntVal (v1 - v2)
evalBop Gt (IntVal v1) (IntVal v2) = BoolVal (v1 > v2)
evalBop Ge (IntVal v1) (IntVal v2) = BoolVal (v1 >= v2)
evalBop Lt (IntVal v1) (IntVal v2) = BoolVal (v1 < v2)
evalBop Le (IntVal v1) (IntVal v2) = BoolVal (v1 <= v2)
evalBop _ _ _ = IntVal 0
eval :: Expression -> Store -> Value
eval = undefined
instance Arbitrary Variable where
arbitrary = undefined
instance Arbitrary Value where
arbitrary = undefined
instance Arbitrary Bop where
arbitrary = elements [Plus, Times, Minus, Gt, Ge, Lt, Le]
instance Arbitrary Expression where
arbitrary = undefined
instance (Ord a, Arbitrary a, Arbitrary b) => Arbitrary (Map a b) where
arbitrary = undefined
(===) :: Expression -> Expression -> Property
e1 === e2 = forAll arbitrary $ \st -> eval e1 st == eval e2 st
prop_add_zero_elim :: Variable -> Expression -> Property
prop_add_zero_elim x e =
(Op Plus e $ Val (IntVal 0)) === e
prop_sub_zero_elim :: Variable -> Expression -> Property
prop_sub_zero_elim x e =
(Op Minus e $ Val (IntVal 0)) === e
arbnE :: Int -> Gen Expression
arbnE n = frequency [ (1, liftM Var arbitrary),
(1, liftM Val arbitrary),
(n, liftM3 Op arbitrary (arbnE (n `div` 2)) (arbnE (n `div` 2))) ]
-- instance Arbitrary Expression where
-- arbitrary = sized arbnE
intE :: Gen Expression
intE = sized arbnEI
where arbnEI 0 = oneof [ liftM Var arbitrary
, liftM (Val . IntVal) arbitrary ]
arbnEI n = oneof [ liftM Var arbitrary
, liftM (Val . IntVal) arbitrary
, liftM2 (Op Plus) (arbnEI n_by_2) (arbnEI n_by_2)
, liftM2 (Op Times) (arbnEI n_by_2) (arbnEI n_by_2)
, liftM2 (Op Minus) (arbnEI n_by_2) (arbnEI n_by_2)
]
where n_by_2 = n `div` 2
prop_add_zero_elim' :: Property
prop_add_zero_elim' =
forAll intE $ \e -> (Op Plus e $ Val (IntVal 0)) === e
prop_const_prop :: Variable -> Expression -> Store -> Bool
prop_const_prop x e s = eval (Var x) s' == eval e s' where
s' = Map.insert x (eval e s) s
{-
instance Arbitrary Expression where
arbitrary = sized arbnE
shrink = undefined
-}