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
46
47
48
|
{-# LANGUAGE ScopedTypeVariables, StrictData, GADTs #-}
-- | Tests the StrictData LANGUAGE pragma.
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))) -- sanity check
------------------------------------------------------------------------
-- Support for testing for 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)
]
|
