blob: af193ecb97fe8d12741fff657e64290de0262ff8 (
plain)
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
|
module Main where
-- This test used to fail in GHC 5.04.2. See rev. 1.22 of
-- libraries/base/GHC/Base.lhs for the fix.
data FourArrow = A | B | C | D | E | ABE | AC | BD | CDE
deriving (Eq)
dom E = ABE
cod A = AC
cod B = BD
cod C = CDE
cod D = CDE
cod E = CDE
cod ABE = ABE
cod AC = AC
cod BD = BD
cod CDE = CDE
----
bceFour :: FourArrow -> FourArrow -> String
bceFour f g
| dom f == dom g && cod f == cod g
= "it works"
| otherwise = error ("Four.bceFour: precondition fails:"
++ "arrows not parallel"
++ "\n")
main = print (bceFour E E)
|