blob: bff4b49d873bafa74ad585a2f472ad36aefa611c (
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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
module T5359b where
-----------------------------------------------------------------------------
-- Base
-----------------------------------------------------------------------------
infixr 5 :+:
infixr 6 :*:
data U = U
data a :+: b = L a | R b
data a :*: b = a :*: b
newtype Rec a = Rec a
class Representable a where
type Rep a
to :: Rep a -> a
from :: a -> Rep a
data Tree = Leaf | Bin Int Tree Tree
instance Representable Tree where
type Rep Tree = U
:+: (Rec Int :*: Rec Tree :*: Rec Tree)
from (Bin x l r) = R ((Rec x :*: Rec l :*: Rec r))
from Leaf = L (U)
to (R ((Rec x :*: (Rec l) :*: (Rec r)))) = Bin x l r
to (L (U)) = Leaf
--------------------------------------------------------------------------------
-- Generic enum
--------------------------------------------------------------------------------
class Enum' a where
enum' :: [a]
instance Enum' U where enum' = undefined
instance (Enum' a) => Enum' (Rec a) where enum' = undefined
instance (Enum' f, Enum' g) => Enum' (f :+: g) where enum' = undefined
instance (Enum' f, Enum' g) => Enum' (f :*: g) where enum' = undefined
-- This INLINE pragma is essential for the bug
{-# INLINE genum #-}
genum :: (Representable a, Enum' (Rep a)) => [a]
-- The definition of genum is essential for the bug
genum = map to enum'
instance Enum' Tree where enum' = genum
instance Enum' Int where enum' = []
-- This SPECIALISE pragma is essential for the bug
{-# SPECIALISE genum :: [Tree] #-}
|
