| ... |
... |
@@ -29,6 +29,41 @@ import GHC.Types.Var |
|
29
|
29
|
|
|
30
|
30
|
type OverloadedCallsCCState = Strict.Maybe SrcSpan
|
|
31
|
31
|
|
|
|
32
|
+{- Note [Overloaded Calls and join points]
|
|
|
33
|
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
|
|
34
|
+Currently GHC considers cost centres as destructive to
|
|
|
35
|
+join contexts. Or in other words this is not considered valid:
|
|
|
36
|
+
|
|
|
37
|
+ join f x = ...
|
|
|
38
|
+ in
|
|
|
39
|
+ ... -> scc<tick> jmp
|
|
|
40
|
+
|
|
|
41
|
+This makes the functionality of `-fprof-late-overloaded-calls` not feasible
|
|
|
42
|
+for join points in general. We used to try to work around this by putting the
|
|
|
43
|
+ticks on the rhs of the join point rather than around the jump. However beyond
|
|
|
44
|
+the loss of accuracy this was broken for recursive join points as we ended up
|
|
|
45
|
+with something like:
|
|
|
46
|
+
|
|
|
47
|
+ rec-join f x = scc<tick> ... jmp f x
|
|
|
48
|
+
|
|
|
49
|
+Which similarly is not valid as the tick once again destroys the tail call.
|
|
|
50
|
+One might think we could limit ourselves to non-recursive tail calls and do
|
|
|
51
|
+something clever like:
|
|
|
52
|
+
|
|
|
53
|
+ join f x = scc<tick> ...
|
|
|
54
|
+ in ... jmp f x
|
|
|
55
|
+
|
|
|
56
|
+And sometimes this works! But sometimes the full rhs would look something like:
|
|
|
57
|
+
|
|
|
58
|
+ join g x = ....
|
|
|
59
|
+ join f x = scc<tick> ... -> jmp g x
|
|
|
60
|
+
|
|
|
61
|
+Which, would again no longer be valid. I believe in the long run we can make
|
|
|
62
|
+cost centre ticks non-destructive to join points. Or we could keep track of
|
|
|
63
|
+where we are/are not allowed to insert a cost centre. But in the short term I will
|
|
|
64
|
+simply disable the annotation of join calls under this flag.
|
|
|
65
|
+-}
|
|
|
66
|
+
|
|
32
|
67
|
-- | Insert cost centres on function applications with dictionary arguments. The
|
|
33
|
68
|
-- source locations attached to the cost centres is approximated based on the
|
|
34
|
69
|
-- "closest" source note encountered in the traversal.
|
| ... |
... |
@@ -52,21 +87,10 @@ overloadedCallsCC = |
|
52
|
87
|
CoreBndr
|
|
53
|
88
|
-> LateCCM OverloadedCallsCCState CoreExpr
|
|
54
|
89
|
-> LateCCM OverloadedCallsCCState CoreExpr
|
|
55
|
|
- wrap_if_join b pexpr = do
|
|
|
90
|
+ wrap_if_join _b pexpr = do
|
|
|
91
|
+ -- See Note [Overloaded Calls and join points]
|
|
56
|
92
|
expr <- pexpr
|
|
57
|
|
- if isJoinId b && isOverloadedTy (exprType expr) then do
|
|
58
|
|
- let
|
|
59
|
|
- cc_name :: FastString
|
|
60
|
|
- cc_name = fsLit "join-rhs-" `appendFS` getOccFS b
|
|
61
|
|
-
|
|
62
|
|
- cc_srcspan <-
|
|
63
|
|
- fmap (Strict.fromMaybe (UnhelpfulSpan UnhelpfulNoLocationInfo)) $
|
|
64
|
|
- lift $ gets lateCCState_extra
|
|
65
|
|
-
|
|
66
|
|
- insertCC cc_name cc_srcspan expr
|
|
67
|
|
- else
|
|
68
|
|
- return expr
|
|
69
|
|
-
|
|
|
93
|
+ return expr
|
|
70
|
94
|
|
|
71
|
95
|
processExpr :: CoreExpr -> LateCCM OverloadedCallsCCState CoreExpr
|
|
72
|
96
|
processExpr expr =
|
| ... |
... |
@@ -99,6 +123,7 @@ overloadedCallsCC = |
|
99
|
123
|
|
|
100
|
124
|
-- Avoid instrumenting join points.
|
|
101
|
125
|
-- (See comment in processBind above)
|
|
|
126
|
+ -- Also see Note [Overloaded Calls and join points]
|
|
102
|
127
|
&& not (isJoinVarExpr f)
|
|
103
|
128
|
then do
|
|
104
|
129
|
-- Extract a name and source location from the function being
|