[A limited amount of function testing is possible. This will be removed
nad**20040618161440
 A limited amount of function testing is possible. This will be removed
 in the next check-in, since it's not flexible enough to warrant
 inclusion in the library; it's most likely better to make a private
 function-tester. Currently testing "(const (const not) :: Double -> Int
 -> Bool -> Bool) !==! const (const not)" takes ages since around one
 million tests are performed. Furthermore only top-level functions are
 allowed:
 > [not] !==! [const True]
 *** Exception: The generic versions of (==!) and friends do not accept non-bottom functions.
 
] {
hunk ./ChasingBottoms/SemanticOrd.hs 1
-{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-}
+{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances -fallow-overlapping-instances #-}
hunk ./ChasingBottoms/SemanticOrd.hs 11
+--
+-- One could imagine using QuickCheck for testing equality of
+-- functions, but I have not managed to tweak the type system so that
+-- it can be done transparently.
hunk ./ChasingBottoms/SemanticOrd.hs 26
+import Debug.QuickCheck
+import ChasingBottoms.QuickCheckWrapper
+
hunk ./ChasingBottoms/SemanticOrd.hs 103
+    -- cast' a `fop` cast' b
hunk ./ChasingBottoms/SemanticOrd.hs 120
+-- Variant of cast.
+
+cast' :: (Typeable a, Typeable b) => a -> b
+cast' = Maybe.fromJust . cast
+
+------------------------------------------------------------------------
+
hunk ./ChasingBottoms/SemanticOrd.hs 154
-(===!) :: Arbitrary a => (a -> b) -> (a -> b) -> Bool
-f ===! g = case (isBottom f, isBottom g) of
-  (True, True)   -> True
-  (False, False) -> 
-    forAll arbitrary $ \x -> f x ==! g x
-  _              -> False
+-- newtype EqFun = EqFun { unEqFun ::
+--   forall a b . (Data a, Data b) => a -> b -> Bool }
hunk ./ChasingBottoms/SemanticOrd.hs 157
-forAll 
+class SemanticFunEq a where
+  (!==!), (!/=!) :: a -> a -> Bool
+
+  (!/=!) = \x y -> not (x !==! y)
+
+-- instance Data a => SemanticFunEq a where
+--  x !==! y =
+--   let test :: (Arbitrary b, Show b, Data c) =>
+--               (b -> c1) -> (b -> c2) -> Bool
+--       test f g = testIt (forAll arbitrary $ \(x :: b) -> f x !==!! g x)
+--   in let ?funTest = EqFun test
+--   in x !==!! y
+
+-- (!==!!) :: (Data a, Data b, ?funTest :: EqFun) => a -> b -> Bool
+-- x !==!! y = case (isBottom x, isBottom y) of
+--   (True, True)   -> True
+--   (False, False) | isFunction x -> unEqFun ?funTest x y
+--                  | otherwise -> x =^= y && tmapQl (&&) True (!==!!) x y
+--   _              -> False
+
+-- This one works, but it only handles functions on the top level, not
+-- functions inside e.g. lists.
+
+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 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
}