[Git][ghc/ghc][wip/andreask/ppr_prelude] Get rid of Data.FastString.Type
Andreas Klebinger (@AndreasK)
gitlab at gitlab.haskell.org
Tue Nov 1 16:24:27 UTC 2022
Andreas Klebinger pushed to branch wip/andreask/ppr_prelude at Glasgow Haskell Compiler / GHC
Commits:
8cc72d3e by Andreas Klebinger at 2022-11-01T17:20:51+01:00
Get rid of Data.FastString.Type
- - - - -
5 changed files:
- compiler/GHC/Data/FastString.hs
- − compiler/GHC/Data/FastString/Type.hs
- compiler/GHC/Types/Name/Occurrence.hs-boot
- compiler/Language/Haskell/Syntax/Module/Name/Type.hs
- compiler/ghc.cabal.in
Changes:
=====================================
compiler/GHC/Data/FastString.hs
=====================================
@@ -8,7 +8,6 @@
{-# LANGUAGE UnliftedFFITypes #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
-{-# OPTIONS_GHC -Wno-orphans #-} -- See Note [Exporting pprTrace from GHC.Prelude]
-- We always optimise this, otherwise performance of a non-optimised
-- compiler is severely affected
@@ -109,9 +108,7 @@ module GHC.Data.FastString
lengthPS
) where
-import GHC.Prelude.Basic
-
-import GHC.Data.FastString.Type
+import GHC.Prelude.Basic as Prelude
import GHC.Utils.Encoding
import GHC.Utils.IO.Unsafe
@@ -171,7 +168,9 @@ hashFastString :: FastString -> Int
hashFastString fs = hashStr $ fs_sbs fs
-- -----------------------------------------------------------------------------
--- FastZString
+
+newtype FastZString = FastZString ByteString
+ deriving NFData
hPutFZS :: Handle -> FastZString -> IO ()
hPutFZS handle (FastZString bs) = BS.hPut handle bs
@@ -187,7 +186,28 @@ mkFastZStringString :: String -> FastZString
mkFastZStringString str = FastZString (BSC.pack str)
-- -----------------------------------------------------------------------------
--- FastString
+
+{-| A 'FastString' is a UTF-8 encoded string together with a unique ID. All
+'FastString's are stored in a global hashtable to support fast O(1)
+comparison.
+
+It is also associated with a lazy reference to the Z-encoding
+of this string which is used by the compiler internally.
+-}
+data FastString = FastString {
+ uniq :: {-# UNPACK #-} !Int, -- unique id
+ n_chars :: {-# UNPACK #-} !Int, -- number of chars
+ fs_sbs :: {-# UNPACK #-} !ShortByteString,
+ fs_zenc :: FastZString
+ -- ^ Lazily computed Z-encoding of this string. See Note [Z-Encoding] in
+ -- GHC.Utils.Encoding.
+ --
+ -- Since 'FastString's are globally memoized this is computed at most
+ -- once for any given string.
+ }
+
+instance Eq FastString where
+ f1 == f2 = uniq f1 == uniq f2
-- We don't provide any "Ord FastString" instance to force you to think about
-- which ordering you want:
@@ -633,6 +653,9 @@ hPutFS handle fs = BS.hPut handle $ bytesFS fs
-- -----------------------------------------------------------------------------
-- PtrStrings, here for convenience only.
+-- | A 'PtrString' is a pointer to some array of Latin-1 encoded chars.
+data PtrString = PtrString !(Ptr Word8) !Int
+
-- | Wrap an unboxed address into a 'PtrString'.
mkPtrString# :: Addr# -> PtrString
{-# INLINE mkPtrString# #-}
=====================================
compiler/GHC/Data/FastString/Type.hs deleted
=====================================
@@ -1,99 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-
-{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
--- We always optimise this, otherwise performance of a non-optimised
--- compiler is severely affected
-
--- |
--- There are two principal string types used internally by GHC:
---
--- ['FastString']
---
--- * A compact, hash-consed, representation of character strings.
--- * Generated by 'fsLit'.
--- * You can get a 'GHC.Types.Unique.Unique' from them.
--- * Equality test is O(1) (it uses the Unique).
--- * Comparison is O(1) or O(n):
--- * O(n) but deterministic with lexical comparison (`lexicalCompareFS`)
--- * O(1) but non-deterministic with Unique comparison (`uniqCompareFS`)
--- * Turn into 'GHC.Utils.Outputable.SDoc' with 'GHC.Utils.Outputable.ftext'.
---
--- ['PtrString']
---
--- * Pointer and size of a Latin-1 encoded string.
--- * Practically no operations.
--- * Outputting them is fast.
--- * Generated by 'mkPtrString#'.
--- * Length of string literals (mkPtrString# "abc"#) is computed statically
--- * Turn into 'GHC.Utils.Outputable.SDoc' with 'GHC.Utils.Outputable.ptext'
--- * Requires manual memory management.
--- Improper use may lead to memory leaks or dangling pointers.
--- * It assumes Latin-1 as the encoding, therefore it cannot represent
--- arbitrary Unicode strings.
---
--- Use 'PtrString' unless you want the facilities of 'FastString'.
-module GHC.Data.FastString.Type
- (
- -- * FastZString
- FastZString(..),
-
- -- * FastStrings
- FastString(..), -- not abstract, for now.
-
- -- * PtrStrings
- PtrString (..),
-
- ) where
-
-import GHC.Prelude.Basic
-
-import Control.DeepSeq
-import Data.ByteString (ByteString)
-import Data.ByteString.Short (ShortByteString)
-#if !MIN_VERSION_bytestring(0,11,0)
-import qualified Data.ByteString.Short.Internal as SBS
-#endif
-
-import Data.Word
-import Foreign
-
--- -----------------------------------------------------------------------------
-
-newtype FastZString = FastZString ByteString
- deriving NFData
-
--- -----------------------------------------------------------------------------
-
-{-| A 'FastString' is a UTF-8 encoded string together with a unique ID. All
-'FastString's are stored in a global hashtable to support fast O(1)
-comparison.
-
-It is also associated with a lazy reference to the Z-encoding
-of this string which is used by the compiler internally.
--}
-data FastString = FastString {
- uniq :: {-# UNPACK #-} !Int, -- unique id
- n_chars :: {-# UNPACK #-} !Int, -- number of chars
- fs_sbs :: {-# UNPACK #-} !ShortByteString,
- fs_zenc :: FastZString
- -- ^ Lazily computed Z-encoding of this string. See Note [Z-Encoding] in
- -- GHC.Utils.Encoding.
- --
- -- Since 'FastString's are globally memoized this is computed at most
- -- once for any given string.
- }
-
-instance Eq FastString where
- f1 == f2 = uniq f1 == uniq f2
-
--- -----------------------------------------------------------------------------
-
--- | A 'PtrString' is a pointer to some array of Latin-1 encoded chars.
-data PtrString = PtrString !(Ptr Word8) !Int
\ No newline at end of file
=====================================
compiler/GHC/Types/Name/Occurrence.hs-boot
=====================================
@@ -1,6 +1,6 @@
module GHC.Types.Name.Occurrence where
-import GHC.Data.FastString.Type ( FastString )
+import GHC.Data.FastString ( FastString )
data OccName
=====================================
compiler/Language/Haskell/Syntax/Module/Name/Type.hs
=====================================
@@ -2,7 +2,7 @@ module Language.Haskell.Syntax.Module.Name.Type where
import Prelude
-import GHC.Data.FastString.Type ( FastString )
+import GHC.Data.FastString ( FastString )
-- | A ModuleName is essentially a simple string, e.g. @Data.List at .
newtype ModuleName = ModuleName FastString deriving (Eq)
\ No newline at end of file
=====================================
compiler/ghc.cabal.in
=====================================
@@ -370,7 +370,6 @@ Library
GHC.Data.FastMutInt
GHC.Data.FastString
GHC.Data.FastString.Env
- GHC.Data.FastString.Type
GHC.Data.FiniteMap
GHC.Data.Graph.Base
GHC.Data.Graph.Color
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8cc72d3e654f5d3fea585db95583b21f8c6fa6e8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8cc72d3e654f5d3fea585db95583b21f8c6fa6e8
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221101/46c40cf1/attachment-0001.html>
More information about the ghc-commits
mailing list