-- (Note: this is now ghomStagedK in the API.)
ghomStaged :: forall r d. Data d =>
SYB.Stage
-> r
-> (r -> r -> r)
-> GenericQ r
-> d
-> Homo r
ghomStaged stage z k f x
| checkItemStage stage x = z'
| otherwise = foldl k' b (gmapQ (ghomStaged stage z k f) x)
where
b = R (f x) []
z' = R z []
k' (R r chs) nod@(R r' chs') = R (r `k` r') (chs++[nod])
checkItemStage is from HaRe and can be found in the
download.
Without worrying about its content, here is a small sample module we parse into an AST using the GHC API
-- an example from http://blog.ezyang.com/2011/05/anatomy-of-a-thunk-leak/
module A05 ( main ) where
import Control.Exception ( evaluate )
main = evaluate (f [1..4000000] (0 :: Int, 1 :: Int))
f [] c = c
f (x:xs) c = f xs (tick x c)
tick x (c0, c1) | even x = (c0, c1 + 1)
| otherwise = (c0 + 1, c1)
This page shows the monstrous, usual output if we show the typechecked AST for the above small sample module.
We can summarise its structure thus
liftIO $ putStrLn $ showAsParens $ shapeOfStaged typechecked (((*((*(*(**)))(*(*(**)))((**(((((*)((*)(*)))((*)((*)(*))))(*))(((((*))((*))) ((*)))((((*))((*)))((*)))))(*))*)*(((*((**)*(((*(((*(*))((*(((*(*))((*(*))*)) *(*((*)((*)*)))))*))*(((*(((*((*((*((((*))((*)))(*)))(*(*))))((*))((*))(**))) *)(*((((*(*)))(((*((*(*))(*((((*))((*)))(*)))(**)(*(((*)*((*((((*))((*)))(*)) )(*((*(**)))))(*)))))))*))*))))((*(((*((*(*))((*))((*))(**)))*)(*((((*((*(*)) (*((((*))((*)))(*)))(**)(*(((*)*((*((((*))((*)))(*)))(*((*(**)))))(*)))))))(( (*(*)))*))*))))*))*)))*)((*)((*((*)((*)*)))(*((*)((*)*))))))***))*))))((*((*( *(**)))(*(*(**)))((**(((((*)((*)(*)))((*)((*)(*))))(*))(((((*))((*)))((*)))(( ((*))((*)))((*)))))(*))*)*(((*((**)*(((*(((*((**)***(*)(*((*)*))))((*(*))*))* (((*(*(*(*))))*)*)))((*(((*((*((**)***((*(*))(*(*)))(*((*)*))))))((*(*))*))*( ((*(*(*((*((*(*))(*(*))))(*((*((*((*((((((*))((*)))((*)))((((*))((*)))((*)))) (*)))(*(*))))(*(*))))))))))*)*)))*))((*((*)*))((*((*)((*)*)))(*((*)((*)*))))) )***))*))))((*(**((***(*))*)*(((*((**)*(((*(**(((*(*(*((*(((*((**)((**)*))))( *)))(*((*((*((*((((((*))((*)))((*)))((((**))((**)))((**))))(*)))(*(((((*))((* *)))(*))((*(((*)*((*((((*))((**)))(*)))(*((*(**)))))(**))))(*(((*)*((*((((*)) ((**)))(*)))(*((*(**)))))(**)))))))))(*((((*((*(((*)*((*))(**))))(*(*)))))((( *((*(((*)*((*))(**))))(*(*)))))*))*))))))))))*)*)))*)(*((*((**)((**)*)))*)))* **))*))))*))))And this page shows the result of weightedShapeOfStaged applied to the staged GHC AST. These prove that our staged version works.
Note that you do get a runtime error if you use weightedShapeOf (the unstaged version). You can see one such hole in the first line below
.
.
.
(WpHole) {!NameSet placeholder here!}
(Nothing)))]}))]}
------------------------- weightedShapeOf typechecked
test: panic! (the 'impossible' happened)
(GHC version 7.6.3 for i386-unknown-linux):
placeHolderNames
Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug
Finally, let's use filterHomo to do some pruning.
We no longer need to worry about GHC staging holes, or generic programming -- we're in the homogeneous type of our choice now -- in this case, Homo Int.
Filtering all nodes with weight at least 5
let xxx = weightedShapeOfStaged TypeChecker typechecked
liftIO $ putStrLn $ show $ filterHomo (>=5) xxx
842
841
334
332
7
5
7
5
51
49
44
20
17
8
5
8
5
23
11
7
11
7
265
264
262
260
252
229
227
225
31
26
24
22
11
6
9
7
192
190
101
99
33
31
29
19
17
12
10
7
65
63
61
5
55
53
52
50
12
10
7
30
28
27
21
12
10
7
8
6
5
88
86
84
18
16
14
65
63
61
53
52
50
12
10
7
30
28
27
21
12
10
7
8
6
5
7
5
22
19
9
7
9
7
506
257
255
7
5
7
5
51
49
44
20
17
8
5
8
5
23
11
7
11
7
188
187
185
183
175
148
40
38
24
17
15
6
6
12
10
8
6
107
105
103
34
27
25
24
22
9
6
6
67
65
63
61
59
57
11
9
45
43
42
40
35
33
28
26
23
11
7
11
7
26
6
19
9
7
9
7
248
246
244
8
6
232
231
229
227
219
203
201
199
196
194
192
190
188
186
17
15
12
11
9
5
168
166
165
163
113
111
31
29
26
11
7
14
9
79
77
11
8
65
32
30
29
22
13
11
8
8
6
5
32
30
29
22
13
11
8
8
6
5
49
47
45
21
20
18
13
11
10
23
21
20
18
13
11
10
15
13
11
9
5
And again, filtering all nodes with weight at least 50
let xxx = weightedShapeOfStaged TypeChecker typechecked
liftIO $ putStrLn $ show $ filterHomo (>=50) xxx
842
841
334
332
51
265
264
262
260
252
229
227
225
192
190
101
99
65
63
61
55
53
52
50
88
86
84
65
63
61
53
52
50
506
257
255
51
188
187
185
183
175
148
107
105
103
67
65
63
61
59
57
248
246
244
232
231
229
227
219
203
201
199
196
194
192
190
188
186
168
166
165
163
113
111
79
77
65