[Git][ghc/ghc][wip/js-staging] Remove now useless changes to Ppr

Sylvain Henry (@hsyl20) gitlab at gitlab.haskell.org
Tue Oct 25 12:10:05 UTC 2022



Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC


Commits:
82ee55da by Sylvain Henry at 2022-10-25T13:58:33+02:00
Remove now useless changes to Ppr

- - - - -


3 changed files:

- compiler/GHC/Utils/BufHandle.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/GHC/Utils/Ppr.hs


Changes:

=====================================
compiler/GHC/Utils/BufHandle.hs
=====================================
@@ -20,7 +20,6 @@ module GHC.Utils.BufHandle (
         bPutFS,
         bPutFZS,
         bPutPtrString,
-        bPutShortText,
         bPutReplicate,
         bFlush,
   ) where
@@ -29,7 +28,6 @@ import GHC.Prelude
 
 import GHC.Data.FastString
 import GHC.Data.FastMutInt
-import GHC.Data.ShortText as ST
 
 import Control.Monad    ( when )
 import Data.ByteString (ByteString)
@@ -86,10 +84,6 @@ bPutFZS b fs = bPutBS b $ fastZStringToByteString fs
 bPutBS :: BufHandle -> ByteString -> IO ()
 bPutBS b bs = BS.unsafeUseAsCStringLen bs $ bPutCStringLen b
 
-bPutShortText :: BufHandle -> ShortText -> IO ()
-bPutShortText b t = bPutStr b (ST.unpack t)
-  -- TODO: optimize this! Don't pass through String
-
 bPutCStringLen :: BufHandle -> CStringLen -> IO ()
 bPutCStringLen b@(BufHandle buf r hdl) cstr@(ptr, len) = do
   i <- readFastMutInt r


=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -115,7 +115,6 @@ import {-# SOURCE #-}   GHC.Types.Name.Occurrence( OccName )
 
 import GHC.Utils.BufHandle (BufHandle)
 import GHC.Data.FastString
-import GHC.Data.ShortText (ShortText)
 import qualified GHC.Utils.Ppr as Pretty
 import qualified GHC.Utils.Ppr.Colour as Col
 import GHC.Utils.Ppr       ( Doc, Mode(..) )
@@ -642,7 +641,6 @@ empty    :: SDoc
 char     :: Char       -> SDoc
 text     :: String     -> SDoc
 ftext    :: FastString -> SDoc
-stext    :: ShortText  -> SDoc
 ptext    :: PtrString  -> SDoc
 ztext    :: FastZString -> SDoc
 int      :: Int        -> SDoc
@@ -662,8 +660,6 @@ text s      = docToSDoc $ Pretty.text s
 
 {-# INLINE CONLIKE ftext #-}
 ftext s     = docToSDoc $ Pretty.ftext s
-{-# INLINE CONLIKE stext #-}
-stext s     = docToSDoc $ Pretty.stext s
 {-# INLINE CONLIKE ptext #-}
 ptext s     = docToSDoc $ Pretty.ptext s
 {-# INLINE CONLIKE ztext #-}
@@ -1022,9 +1018,6 @@ instance Outputable FastString where
 deriving newtype instance Outputable NonDetFastString
 deriving newtype instance Outputable LexicalFastString
 
-instance Outputable ShortText where
-    ppr s = stext s
-
 instance (Outputable key, Outputable elt) => Outputable (M.Map key elt) where
     ppr m = ppr (M.toList m)
 


=====================================
compiler/GHC/Utils/Ppr.hs
=====================================
@@ -71,7 +71,7 @@ module GHC.Utils.Ppr (
         -- * Constructing documents
 
         -- ** Converting values into documents
-        char, text, ftext, stext, ptext, ztext, sizedText, zeroWidthText, emptyText,
+        char, text, ftext, ptext, ztext, sizedText, zeroWidthText, emptyText,
         int, integer, float, double, rational, hex,
 
         -- ** Simple derived documents
@@ -115,7 +115,6 @@ import GHC.Prelude hiding (error)
 
 import GHC.Utils.BufHandle
 import GHC.Data.FastString
-import GHC.Data.ShortText as ST
 import GHC.Utils.Panic.Plain
 import System.IO
 import Numeric (showHex)
@@ -264,14 +263,14 @@ type RDoc = Doc
 --
 -- A TextDetails represents a fragment of text that will be
 -- output at some point.
-data TextDetails
-  = Chr  {-# UNPACK #-} !Char                     -- ^ A single Char fragment
-  | Str  String                                   -- ^ A whole String fragment
-  | SText ShortText                               -- ^ A ShortText
-  | PStr FastString                               -- a hashed string
-  | ZStr FastZString                              -- a z-encoded string
-  | LStr {-# UNPACK #-} !PtrString                -- a '\0'-terminated array of bytes
-  | RStr {-# UNPACK #-} !Int {-# UNPACK #-} !Char -- a repeated character (e.g., ' ')
+data TextDetails = Chr  {-# UNPACK #-} !Char -- ^ A single Char fragment
+                 | Str  String -- ^ A whole String fragment
+                 | PStr FastString                      -- a hashed string
+                 | ZStr FastZString                     -- a z-encoded string
+                 | LStr {-# UNPACK #-} !PtrString
+                   -- a '\0'-terminated array of bytes
+                 | RStr {-# UNPACK #-} !Int {-# UNPACK #-} !Char
+                   -- a repeated character (e.g., ' ')
 
 instance Show Doc where
   showsPrec _ doc cont = fullRender (mode style) (lineLength style)
@@ -319,10 +318,6 @@ text s = textBeside_ (Str s) (length s) Empty
 ftext :: FastString -> Doc
 ftext s = textBeside_ (PStr s) (lengthFS s) Empty
 
-stext :: ShortText -> Doc
-stext s = textBeside_ (SText s) (codepointLength s) Empty
-
-
 ptext :: PtrString -> Doc
 ptext s = textBeside_ (LStr s) (lengthPS s) Empty
 
@@ -966,7 +961,6 @@ txtPrinter :: TextDetails -> String -> String
 txtPrinter (Chr c)    s  = c:s
 txtPrinter (Str s1)   s2 = s1 ++ s2
 txtPrinter (PStr s1)  s2 = unpackFS s1 ++ s2
-txtPrinter (SText s1) s2 = ST.unpack s1 ++ s2
 txtPrinter (ZStr s1)  s2 = zString s1 ++ s2
 txtPrinter (LStr s1)  s2 = unpackPtrString s1 ++ s2
 txtPrinter (RStr n c) s2 = replicate n c ++ s2
@@ -1090,7 +1084,6 @@ printDoc_ mode pprCols hdl doc
   where
     put (Chr c)    next = hPutChar hdl c >> next
     put (Str s)    next = hPutStr  hdl s >> next
-    put (SText s)  next = hPutStr  hdl (ST.unpack s) >> next
     put (PStr s)   next = hPutStr  hdl (unpackFS s) >> next
                           -- NB. not hPutFS, we want this to go through
                           -- the I/O library's encoding layer. (#3398)
@@ -1146,20 +1139,19 @@ bufLeftRender :: BufHandle -> Doc -> IO ()
 bufLeftRender b doc = layLeft b (reduceDoc doc)
 
 layLeft :: BufHandle -> Doc -> IO ()
-layLeft !_ NoDoc              = error "layLeft: NoDoc"
-layLeft b (Union p q)         = layLeft b $! first p q
-layLeft b (Nest _ p)          = layLeft b $! p
-layLeft b Empty               = bPutChar b '\n'
-layLeft b (NilAbove !p)       = bPutChar b '\n' >> layLeft b p
-layLeft b (TextBeside !s _ p) = put b s >> layLeft b p
+layLeft !_ NoDoc             = error "layLeft: NoDoc"
+layLeft b (Union p q)        = layLeft b $! first p q
+layLeft b (Nest _ p)         = layLeft b $! p
+layLeft b Empty              = bPutChar b '\n'
+layLeft b (NilAbove p)       = bPutChar b '\n' >> layLeft b p
+layLeft b (TextBeside s _ p) = put b s >> layLeft b p
  where
-    put !b (Chr c)    = bPutChar b c
-    put  b (Str s)    = bPutStr  b s
-    put  b (PStr s)   = bPutFS   b s
-    put  b (ZStr s)   = bPutFZS  b s
-    put  b (LStr s)   = bPutPtrString b s
-    put  b (SText s)  = bPutShortText b s
-    put  b (RStr n c) = bPutReplicate b n c
+    put !b (Chr c)   = bPutChar b c
+    put b (Str s)    = bPutStr  b s
+    put b (PStr s)   = bPutFS   b s
+    put b (ZStr s)   = bPutFZS  b s
+    put b (LStr s)   = bPutPtrString b s
+    put b (RStr n c) = bPutReplicate b n c
 layLeft _ _                  = panic "layLeft: Unhandled case"
 
 -- Define error=panic, for easier comparison with libraries/pretty.



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82ee55da370f41560062453fc33616aa31647bdb

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82ee55da370f41560062453fc33616aa31647bdb
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/20221025/cb52d621/attachment-0001.html>


More information about the ghc-commits mailing list