blob: ddbdb04750f768dfa8972ddbc5883207ff8c162d (
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
|
{-# LANGUAGE TemplateHaskell #-}
module T7919A where
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Language.Haskell.TH
-- on x86-64 with 7.6.3 it works with size 510 and fails with size 511
size = 512
dataName = mkName "Large"
stepName = mkName "step"
-- data Large = Large Int ... Int -- generate 'size' fields, not strict
largeData =
dataD
(cxt [])
(dataName)
[]
Nothing
[normalC dataName
(replicate size (((,) <$> bang noSourceUnpackedness
noSourceStrictness) `ap` [t| Int |]))]
(cxt [])
conE' :: Name -> [ExpQ] -> ExpQ
conE' n es = foldl appE (conE n) es
varName s i = mkName (s ++ show (((i - 1) `mod` size) + 1))
-- step (Large i1 ... in) =
-- let
-- j1 = i1 + j4
-- ...
-- jn = in + j(3n + 1 `mod` n)
-- in
-- Large j1 ... jn
largeStep =
funD
stepName
[clause
[conP dataName (map (\ i -> varP (varName "i" i)) [1..size])]
(normalB
(letE
(map (\ i -> valD (varP (varName "j" i)) (normalB [| $(varE (varName "i" i)) + $(varE $ varName "i" (i * 3 + 1)) |]) []) [1..size])
(tupE [conE' dataName (map (\ i -> varE (varName "j" i)) [1..size]), varE $ varName "j" 1])
)
)
[]
]
-- test = let step ... in runSteps step 100000 (Large 1 ... 1)
largeLet =
valD
(varP (mkName "test"))
(normalB (letE [largeStep] [| runSteps $(varE stepName) 100000 $(conE' dataName (map (const $ litE $ integerL 1) [1..size]))|]))
[]
allDecs =
sequence [largeData, largeLet]
runSteps :: (state -> (state, Int)) -> Int -> state -> [Int]
runSteps f n i | n <= 0 = []
| otherwise = case f i of
(i', r) -> {-i' `deepseq`-} (r : runSteps f (n - 1) i')
-- could use deepseq here to avoid the space leak, but it's not necessary
|
