summaryrefslogtreecommitdiff
path: root/testsuite/tests/cpranal/sigs/RecDataConCPR.hs
blob: c26ae1264fba44448949d66d74237f49dfc8f68f (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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
{-# OPTIONS_GHC -O2 -fforce-recomp #-}
{-# LANGUAGE TypeFamilies #-}

-- | Serves as a unit test for isRecDataCon.
-- See Note [CPR for recursive data constructors] for similar examples.
module RecDataConCPR where

import Control.Monad.Trans.State
import Control.Monad.ST
import Data.Char

import {-# SOURCE #-} RecDataConCPRa

replicateOne :: Int -> [Int]
replicateOne 1 = [1]
replicateOne n = 1 : replicateOne (n-1)

data T = T (Int, (Bool, Char)) -- NonRec
t :: Char -> Bool -> Int -> T
t a b c = T (c, (b, a))

data U = U [Int] -- NonRec

u :: Int -> U
u x = U (replicate x 1000)

data U2 = U2 [U2] -- Rec

u2 :: Int -> U2
u2 x = U2 (replicate 1000 (u2 (x-1)))

data R0 = R0 R1 | R0End Int -- Rec, but out of fuel (and thus considered NonRec)
data R1 = R1 R2
data R2 = R2 R3
data R3 = R3 R4
data R4 = R4 R5
data R5 = R5 R6
data R6 = R6 R7
data R7 = R7 R8
data R8 = R8 R9
data R9 = R9 R0

r :: Bool -> Int -> R0
r False x = r True x
r True  x = R0 (R1 (R2 (R3 (R4 (R5 (R6 (R7 (R8 (R9 (R0End x))))))))))

data R20 = R20 R21 | R20End Int -- Rec
data R21 = R21 R20

r2 :: Bool -> Int -> R20
r2 False x = r2 True x
r2 True  x = R20 (R21 (R20End 4))

newtype Fix f = Fix (f (Fix f)) -- Rec

fixx :: Int -> Fix Maybe
fixx 0 = Fix Nothing
fixx n = Fix (Just (fixx (n-1)))

data N = N (Fix (Either Int)) -- NonRec
data M = M (Fix (Either M)) -- Rec

n :: Int -> N
n = N . go
  where
    go 0 = Fix (Left 42)
    go n = Fix (Right (go (n-1)))

m :: Int -> M
m = M . go
  where
    go 0 = Fix (Left (m 42))
    go n = Fix (Right (go (n-1)))

data F = F (F -> Int) -- NonRec
f :: Int -> F
f n = F (const n)

data G = G (Int -> G) -- NonRec
g :: Int -> G
g n = G (\m -> g (n+m))

newtype MyM s a = MyM (StateT Int (ST s) a) -- NonRec
myM :: Int -> MyM s Int
myM 0 = MyM $ pure 42
myM n = myM (n-1)

type S = (Int, Bool) -- NonRec
s :: Int -> S
s n = (n, True)

type family E a
type instance E Int = Char
type instance E (a,b) = (E a, E b)
type instance E Char = Blub
data Blah = Blah (E (Int, (Int, Int))) -- NonRec
data Blub = Blub (E (Char, Int))       -- Rec
data Blub2 = Blub2 (E (Bool, Int))       -- Rec, because stuck

blah :: Int -> Blah
blah n = Blah (chr n, (chr (n+1), chr (n+2)))

blub :: Int -> Blub
blub n = Blub (blub (n-1), chr n)

blub2 :: Int -> Blub2
blub2 n = Blub2 (undefined :: E Bool, chr n)

-- Now for abstract TyCons, point (7) of the Note:
data BootNonRec1 = BootNonRec1 BootNonRec2 -- in RecDataConCPRa.hs-boot
data BootRec1 = BootRec1 BootRec2 -- in RecDataConCPRa.hs-boot, recurses back

bootNonRec :: Int -> BootNonRec2 -> BootNonRec1 -- Nothing, thus like NonRec
bootNonRec x b2 = BootNonRec1 b2

bootRec :: Int -> BootRec2 -> BootRec1 -- Nothing, thus like NonRec
bootRec x b2 = BootRec1 b2