[Removed non-functioning function tests and also copyrighted QuickCheck code snippets.
nad**20040618162112] {
hunk ./ChasingBottoms/QuickCheckWrapper.hs 1
--- | Code stolen from the QuickCheck sources and modified slightly.
-
-module ChasingBottoms.QuickCheckWrapper where
-
-import Debug.QuickCheck hiding (check)
-import qualified Random
-import qualified System.IO.Unsafe as Unsafe
-
-check :: Testable a => Config -> a -> IO Bool
-check config a =
-  do rnd <- Random.newStdGen
-     tests config (evaluate a) rnd 0 0 []
-  where
-  tests :: Monad m => Config -> Gen Result -> Random.StdGen
-                   -> Int -> Int -> [[String]] -> m Bool
-  tests config gen rnd0 ntest nfail stamps
-    | ntest == configMaxTest config = return True
-    | nfail == configMaxFail config = fail "Too many failing test cases."
-    | otherwise               =
-        do case ok result of
-             Nothing    ->
-               tests config gen rnd1 ntest (nfail+1) stamps
-             Just True  ->
-               tests config gen rnd1 (ntest+1) nfail (stamp result:stamps)
-             Just False ->
-               return False
-       where
-        result      = generate (configSize config ntest) rnd2 gen
-        (rnd1,rnd2) = Random.split rnd0
-
-testIt :: Property -> Bool
-testIt = Unsafe.unsafePerformIO . check config
-  where
-  config :: Config
-  config = Config
-    { configMaxTest = 100
-    , configMaxFail = 1000
-    , configSize    = (+ 3) . (`div` 2)
-    , configEvery   = const (const "")
-    }
rmfile ./ChasingBottoms/QuickCheckWrapper.hs
hunk ./ChasingBottoms/SemanticOrd.hs 1
-{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances -fallow-overlapping-instances #-}
+{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}
hunk ./ChasingBottoms/SemanticOrd.hs 26
-import Debug.QuickCheck
-import ChasingBottoms.QuickCheckWrapper
-
hunk ./ChasingBottoms/SemanticOrd.hs 117
--- Variant of cast.
-
-cast' :: (Typeable a, Typeable b) => a -> b
-cast' = Maybe.fromJust . cast
-
-------------------------------------------------------------------------
-
hunk ./ChasingBottoms/SemanticOrd.hs 142
+-- Variant of cast.
+
+-- cast' :: (Typeable a, Typeable b) => a -> b
+-- cast' = Maybe.fromJust . cast
+
+------------------------------------------------------------------------
+
hunk ./ChasingBottoms/SemanticOrd.hs 154
-class SemanticFunEq a where
-  (!==!), (!/=!) :: a -> a -> Bool
+-- class SemanticFunEq a where
+--   (!==!), (!/=!) :: a -> a -> Bool
hunk ./ChasingBottoms/SemanticOrd.hs 157
-  (!/=!) = \x y -> not (x !==! y)
+--   (!/=!) = \x y -> not (x !==! y)
hunk ./ChasingBottoms/SemanticOrd.hs 177
-instance (Show a, Arbitrary a, SemanticFunEq b) => SemanticFunEq (a -> b) where
-  f !==! g = case (isBottom f, isBottom g) of
-    (True, True)   -> True
-    (False, False) -> testIt (forAll arbitrary $ \x -> f x !==! g x)
-    _              -> False
+-- instance (Show a, Arbitrary a, SemanticFunEq b) => SemanticFunEq (a -> b) where
+--   f !==! g = case (isBottom f, isBottom g) of
+--     (True, True)   -> True
+--     (False, False) -> testIt (forAll arbitrary $ \x -> f x !==! g x)
+--     _              -> False
hunk ./ChasingBottoms/SemanticOrd.hs 183
-instance SemanticEq a => SemanticFunEq a where
-  a !==! b = case (isBottom a, isBottom b) of
-    (True, True)   -> True
-    (False, False) -> -- We know that we are not dealing with functions.
-                      a ==! b
-    _              -> False
+-- instance SemanticEq a => SemanticFunEq a where
+--   a !==! b = case (isBottom a, isBottom b) of
+--     (True, True)   -> True
+--     (False, False) -> -- We know that we are not dealing with functions.
+--                       a ==! b
+--     _              -> False
}