1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
{-# LANGUAGE ScopedTypeVariables, StrictData, GADTs #-}
module Main where
import qualified Control.Exception as E
import System.IO.Unsafe (unsafePerformIO)
data Strict a = S a
data Strict2 b = S2 !b
data Strict3 c where
S3 :: c -> Strict3 c
data UStrict = US {-# UNPACK #-} Int
data Lazy d = L ~d
data Lazy2 e where
L2 :: ~e -> Lazy2 e
main :: IO ()
main
= do print (isBottom (S bottom))
print (isBottom (S2 bottom))
print (isBottom (US bottom))
print (isBottom (S3 bottom))
putStrLn ""
print (not (isBottom (L bottom)))
print (not (isBottom (L2 bottom)))
print (not (isBottom (Just bottom)))
bottom :: a
bottom = error "_|_"
isBottom :: a -> Bool
isBottom f
= unsafePerformIO $
(E.evaluate f >> return False) `E.catches`
[E.Handler (\ (_ :: E.ArrayException) -> return True),
E.Handler (\ (_ :: E.ErrorCall) -> return True),
E.Handler (\ (_ :: E.NoMethodError) -> return True),
E.Handler (\ (_ :: E.NonTermination) -> return True),
E.Handler (\ (_ :: E.PatternMatchFail) -> return True),
E.Handler (\ (_ :: E.RecConError) -> return True),
E.Handler (\ (_ :: E.RecSelError) -> return True),
E.Handler (\ (_ :: E.RecUpdError) -> return True)]
|
