Permalink
Browse files

source wibbles.

  • Loading branch information...
leepike committed Dec 4, 2012
1 parent 4494f30 commit 1b204445e7864156f6a5f3d64f785d0ef65f75f3
Showing with 15 additions and 15 deletions.
  1. +10 −10 examples/Div0.hs
  2. +5 −5 src/Test/SmartCheck/Reduce.hs
View
@@ -27,7 +27,7 @@ eval (Add e0 e1) =
liftM2 (+) (eval e0) (eval e1)
eval (Div e0 e1) =
let e = eval e1 in
- if e == Just 0 then Nothing
+ if e == Just 0 then trace ("dom " ++ show e1) Nothing
else liftM2 div (eval e0) e
instance Arbitrary Exp where
@@ -38,19 +38,19 @@ instance Arbitrary Exp where
, liftM2 Div mkM' mkM' ]
where mkM' = mkM =<< choose (0,n-1)
- shrink (C i) = map C (shrink i)
- shrink (Add e0 e1) = [e0, e1]
- shrink (Div e0 e1) = [e0, e1]
+ -- shrink (C i) = map C (shrink i)
+ -- shrink (Add e0 e1) = [e0, e1]
+ -- shrink (Div e0 e1) = [e0, e1]
-- property: so long as 0 isn't in the divisor, we won't try to divide by 0.
-- It's false: something might evaluate to 0 still.
div_prop :: Exp -> Property
---div_prop e = divSubTerms e ==> eval e /= Nothing
-div_prop e = property $ case x of
- Nothing -> True
- Just True -> True
- _ -> False
- where x = fmap (< 1) (eval e)
+div_prop e = divSubTerms e ==> eval e /= Nothing
+-- div_prop e = property $ case x of
+-- Nothing -> True
+-- Just True -> True
+-- _ -> False
+-- where x = fmap (< 1) (eval e)
-- precondition: no dividand in a subterm can be 0.
divSubTerms :: Exp -> Bool
@@ -15,7 +15,7 @@ import Data.Typeable
import Data.Tree
import Data.Maybe
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
-- Smarter than shrinks. Does substitution. m is a value that failed QC that's
-- been shrunk. We substitute successive children with strictly smaller (and
@@ -30,7 +30,7 @@ smartRun args res prop = do
print new
return new
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
-- | Breadth-first traversal of d, trying to shrink it with *strictly* smaller
-- children. We replace d whenever a successful shrink is found and try again.
@@ -92,7 +92,7 @@ smartShrink args d prop =
extractAndTest :: a -> IO (Maybe a)
extractAndTest y = do
res <- resultify notProp y
- return $ resultToMaybe res
+ return $ traceShow resultToMaybe res
resultToMaybe :: Result a -> Maybe a
resultToMaybe res =
@@ -101,7 +101,7 @@ resultToMaybe res =
FailedProp -> Nothing
Result n -> Just n
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------
-- | Get the maximum depth of d's subforest at idx. Intuitively, it's the
-- maximum number of constructors you have *below* the constructor at idx. So
@@ -123,4 +123,4 @@ subValSize d idx = maybe 0 id (fmap depth forestIdx)
forestIdx :: Maybe [Tree Bool]
forestIdx = fmap subForest $ getIdxForest (mkSubstForest d True) idx
----------------------------------------------------------------------------------
+--------------------------------------------------------------------------------

0 comments on commit 1b20444

Please sign in to comment.