| ... |
... |
@@ -29,9 +29,10 @@ import GHC.Prelude |
|
29
|
29
|
|
|
30
|
30
|
import GHC.Core
|
|
31
|
31
|
import GHC.Core.Stats (CoreStats(..), exprStats)
|
|
|
32
|
+import GHC.Data.FastString (LexicalFastString(..), fastStringToShortByteString)
|
|
32
|
33
|
import GHC.Types.Fixity (LexicalFixity(..))
|
|
33
|
34
|
import GHC.Types.Literal( Literal, pprLiteral )
|
|
34
|
|
-import GHC.Types.Name( getOccString, getSrcSpan, pprInfixName, pprPrefixName )
|
|
|
35
|
+import GHC.Types.Name( getOccFS, getSrcSpan, pprInfixName, pprPrefixName )
|
|
35
|
36
|
import GHC.Types.Var
|
|
36
|
37
|
import GHC.Types.Id
|
|
37
|
38
|
import GHC.Types.Id.Info
|
| ... |
... |
@@ -51,6 +52,8 @@ import GHC.Types.SrcLoc ( SrcSpan(..), pprUserRealSpan, srcSpanStartCol |
|
51
|
52
|
import GHC.Types.Tickish
|
|
52
|
53
|
|
|
53
|
54
|
import Data.List ( sortOn )
|
|
|
55
|
+import Data.Char ( ord )
|
|
|
56
|
+import qualified Data.ByteString.Short as SBS
|
|
54
|
57
|
|
|
55
|
58
|
{-
|
|
56
|
59
|
************************************************************************
|
| ... |
... |
@@ -133,7 +136,7 @@ type DumpSortKey = |
|
133
|
136
|
, Int -- source-span start line
|
|
134
|
137
|
, Int -- source-span start column
|
|
135
|
138
|
, Int -- dollar-rank: 0 = derived ($w/$s) binder, 1 = its origin
|
|
136
|
|
- , String -- the OccName string, a lexical tiebreak
|
|
|
139
|
+ , LexicalFastString -- the OccName, compared lexically
|
|
137
|
140
|
, RhsKey -- content-based tiebreak (see 'rhsKey')
|
|
138
|
141
|
)
|
|
139
|
142
|
|
| ... |
... |
@@ -154,9 +157,9 @@ sortCoreBindingsForDump = sortOn bindKey . map sortRecMembers |
|
154
|
157
|
bindKey (Rec []) = panic "sortCoreBindingsForDump: empty Rec"
|
|
155
|
158
|
|
|
156
|
159
|
elemKey :: CoreBndr -> CoreExpr -> DumpSortKey
|
|
157
|
|
- elemKey b rhs = (bucket, line, col, dollar_rank, s, rhsKey rhs)
|
|
|
160
|
+ elemKey b rhs = (bucket, line, col, dollar_rank, LexicalFastString nm, rhsKey rhs)
|
|
158
|
161
|
where
|
|
159
|
|
- s = getOccString b
|
|
|
162
|
+ nm = getOccFS b
|
|
160
|
163
|
(bucket, line, col) = case getSrcSpan b of
|
|
161
|
164
|
RealSrcSpan rs _ -> (0, srcSpanStartLine rs, srcSpanStartCol rs)
|
|
162
|
165
|
_ -> (1, 0, 0) -- noSrcSpan: sort last
|
| ... |
... |
@@ -165,8 +168,10 @@ sortCoreBindingsForDump = sortOn bindKey . map sortRecMembers |
|
165
|
168
|
-- bar_$sfoo); rank those before their origin within a shared source span,
|
|
166
|
169
|
-- mirroring GHC's default dependency order (the wrapper calls the worker,
|
|
167
|
170
|
-- so the worker comes first).
|
|
168
|
|
- dollar_rank | '$' `elem` s = 0
|
|
169
|
|
- | otherwise = 1
|
|
|
171
|
+ dollar_rank | dollarByte `SBS.elem` fastStringToShortByteString nm = 0
|
|
|
172
|
+ | otherwise = 1
|
|
|
173
|
+
|
|
|
174
|
+ dollarByte = fromIntegral (ord '$')
|
|
170
|
175
|
|
|
171
|
176
|
-- | A content-based tie-break on a binder's right-hand side: see point 4 of
|
|
172
|
177
|
-- Note [Stable Core dump order].
|