Cheng Shao pushed to branch wip/no-dlist at Glasgow Haskell Compiler / GHC
Commits:
-
9f4f8a7a
by Cheng Shao at 2025-12-08T10:33:08+01:00
2 changed files:
Changes:
| ... | ... | @@ -21,6 +21,7 @@ import Data.Char (chr, ord) |
| 21 | 21 | import qualified Data.Foldable1 as Foldable1
|
| 22 | 22 | import qualified Data.List.NonEmpty as NonEmpty
|
| 23 | 23 | import Data.Maybe (listToMaybe, mapMaybe)
|
| 24 | +import GHC.Data.OrdList (fromOL, nilOL, snocOL)
|
|
| 24 | 25 | import GHC.Data.StringBuffer (StringBuffer)
|
| 25 | 26 | import qualified GHC.Data.StringBuffer as StringBuffer
|
| 26 | 27 | import GHC.Parser.CharClass (
|
| ... | ... | @@ -169,16 +170,16 @@ collapseGaps = go |
| 169 | 170 | [] -> panic "gap unexpectedly ended"
|
| 170 | 171 | |
| 171 | 172 | resolveEscapes :: HasChar c => [c] -> Either (c, LexErr) [c]
|
| 172 | -resolveEscapes = go dlistEmpty
|
|
| 173 | +resolveEscapes = go nilOL
|
|
| 173 | 174 | where
|
| 174 | 175 | go !acc = \case
|
| 175 | - [] -> pure $ dlistToList acc
|
|
| 176 | + [] -> pure $ fromOL acc
|
|
| 176 | 177 | Char '\\' : Char '&' : cs -> go acc cs
|
| 177 | 178 | backslash@(Char '\\') : cs ->
|
| 178 | 179 | case resolveEscapeChar cs of
|
| 179 | - Right (esc, cs') -> go (acc `dlistSnoc` setChar esc backslash) cs'
|
|
| 180 | + Right (esc, cs') -> go (acc `snocOL` setChar esc backslash) cs'
|
|
| 180 | 181 | Left (c, e) -> Left (c, e)
|
| 181 | - c : cs -> go (acc `dlistSnoc` c) cs
|
|
| 182 | + c : cs -> go (acc `snocOL` c) cs
|
|
| 182 | 183 | |
| 183 | 184 | -- -----------------------------------------------------------------------------
|
| 184 | 185 | -- Escape characters
|
| ... | ... | @@ -422,17 +423,3 @@ It's more precisely defined with the following algorithm: |
| 422 | 423 | * Lines with only whitespace characters
|
| 423 | 424 | 3. Calculate the longest prefix of whitespace shared by all lines in the remaining list
|
| 424 | 425 | -} |
| 425 | - |
|
| 426 | --- -----------------------------------------------------------------------------
|
|
| 427 | --- DList
|
|
| 428 | - |
|
| 429 | -newtype DList a = DList ([a] -> [a])
|
|
| 430 | - |
|
| 431 | -dlistEmpty :: DList a
|
|
| 432 | -dlistEmpty = DList id
|
|
| 433 | - |
|
| 434 | -dlistToList :: DList a -> [a]
|
|
| 435 | -dlistToList (DList f) = f []
|
|
| 436 | - |
|
| 437 | -dlistSnoc :: DList a -> a -> DList a
|
|
| 438 | -dlistSnoc (DList f) x = DList (f . (x :)) |
| ... | ... | @@ -11,6 +11,7 @@ import GHC.IO (unsafePerformIO) |
| 11 | 11 | #endif
|
| 12 | 12 | |
| 13 | 13 | import Data.Char
|
| 14 | +import Data.Foldable
|
|
| 14 | 15 | import GHC.Prelude
|
| 15 | 16 | import GHC.Platform
|
| 16 | 17 | import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile)
|
| ... | ... | @@ -18,6 +19,7 @@ import GHC.Types.Unique.DSM |
| 18 | 19 | import GHC.Unit.Module
|
| 19 | 20 | import GHC.Utils.Outputable
|
| 20 | 21 | import GHC.Data.FastString (fastStringToShortText, unpackFS, LexicalFastString(..))
|
| 22 | +import GHC.Data.OrdList (OrdList, nilOL, snocOL)
|
|
| 21 | 23 | |
| 22 | 24 | import GHC.Cmm
|
| 23 | 25 | import GHC.Cmm.CLabel
|
| ... | ... | @@ -286,7 +288,7 @@ data CgInfoProvEnt = CgInfoProvEnt |
| 286 | 288 | , ipeSrcSpan :: !StrTabOffset
|
| 287 | 289 | }
|
| 288 | 290 | |
| 289 | -data StringTable = StringTable { stStrings :: DList ShortText
|
|
| 291 | +data StringTable = StringTable { stStrings :: !(OrdList ShortText)
|
|
| 290 | 292 | , stLength :: !Int
|
| 291 | 293 | , stLookup :: !(M.Map ShortText StrTabOffset)
|
| 292 | 294 | }
|
| ... | ... | @@ -295,7 +297,7 @@ type StrTabOffset = Word32 |
| 295 | 297 | |
| 296 | 298 | emptyStringTable :: StringTable
|
| 297 | 299 | emptyStringTable =
|
| 298 | - StringTable { stStrings = emptyDList
|
|
| 300 | + StringTable { stStrings = nilOL
|
|
| 299 | 301 | , stLength = 0
|
| 300 | 302 | , stLookup = M.empty
|
| 301 | 303 | }
|
| ... | ... | @@ -303,7 +305,7 @@ emptyStringTable = |
| 303 | 305 | getStringTableStrings :: StringTable -> BS.ByteString
|
| 304 | 306 | getStringTableStrings st =
|
| 305 | 307 | BSL.toStrict $ BSB.toLazyByteString
|
| 306 | - $ foldMap f $ dlistToList (stStrings st)
|
|
| 308 | + $ foldMap' f $ stStrings st
|
|
| 307 | 309 | where
|
| 308 | 310 | f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0
|
| 309 | 311 | |
| ... | ... | @@ -312,7 +314,7 @@ lookupStringTable str = state $ \st -> |
| 312 | 314 | case M.lookup str (stLookup st) of
|
| 313 | 315 | Just off -> (off, st)
|
| 314 | 316 | Nothing ->
|
| 315 | - let !st' = st { stStrings = stStrings st `snoc` str
|
|
| 317 | + let !st' = st { stStrings = stStrings st `snocOL` str
|
|
| 316 | 318 | , stLength = stLength st + ST.byteLength str + 1
|
| 317 | 319 | , stLookup = M.insert str res (stLookup st)
|
| 318 | 320 | }
|
| ... | ... | @@ -359,14 +361,3 @@ foreign import ccall unsafe "ZSTD_compressBound" |
| 359 | 361 | |
| 360 | 362 | defaultCompressionLevel :: Int
|
| 361 | 363 | defaultCompressionLevel = 3 |
| 362 | - |
|
| 363 | -newtype DList a = DList ([a] -> [a])
|
|
| 364 | - |
|
| 365 | -emptyDList :: DList a
|
|
| 366 | -emptyDList = DList id
|
|
| 367 | - |
|
| 368 | -snoc :: DList a -> a -> DList a
|
|
| 369 | -snoc (DList f) x = DList (f . (x:))
|
|
| 370 | - |
|
| 371 | -dlistToList :: DList a -> [a]
|
|
| 372 | -dlistToList (DList f) = f [] |