Ticket #6117: test.hs

File test.hs, 1.7 KB (added by jun0, 2 years ago)
Line 
1{-# LANGUAGE FlexibleContexts #-}
2
3{-
4[Summary of the program] Ring is defined as a subclass of Semigroup,
5inheriting multiplication.  Additive is a wrapper that extracts the additive
6structure of Ring and reifies it as Semigroup.  For simplicity, the code omits
7ring operations (+ and *) and defines only the additive and multiplicative
8identities.
9
10[The bug] If there is a cyclic class hierarchy like
11
12    class B a => Semigroup a                  where ...
13    class Semigroup (Additive a) => Ring a    where ...
14    instance Ring a => Semigroup (Additive a) where ...
15
16then uses of B's methods on (Additive a) in the method implementations of the
17third declaration "instance Ring a => Semigroup (Additive a)" will:
18
19    1. be accepted by the compiler even in cases where B (Additive a) is not
20       derivable.
21    2. result in <<loop>>.
22 -}
23
24class B a where
25    b :: a
26class B a => Semigroup a where
27    unit :: a
28class (Semigroup a, Semigroup (Additive a)) => Ring a where
29    zero :: a
30newtype Additive a = Additive a
31
32-- The source compiles whether with or without this instance declaration in GHC
33-- 7.2.1 - 7.4.1 and produces <<loop>>.
34--
35-- GHC 7.0.4 rejects this source without this declaration and produces
36-- terminating code with the declaration.
37instance B a => B (Additive a) where
38   b = Additive b
39
40instance Ring a => Semigroup (Additive a) where
41    unit = b -- Use a method of type (B a => ...) with a instantiated as
42             -- (Additive a).  This causes <<loop>>.
43
44
45-- Now try to instantiate Ring and evaluate `unit'.
46instance B Int where
47    b = 1234567890
48instance Semigroup Int where
49    unit = 1
50instance Ring Int where
51    zero = 0
52main = case (unit :: Additive Int) of -- Force the additive identity of Int.
53         Additive x -> print x