Make HsDocString a newtype of ByteString
authorSimon Jakobi <simon.jakobi@gmail.com>
Thu, 31 May 2018 00:38:18 +0000 (20:38 -0400)
committerBen Gamari <ben@smart-cactus.org>
Thu, 31 May 2018 02:05:37 +0000 (22:05 -0400)
Docstrings don't profit from FastString's interning, so we switch to
a different type that doesn't incur this overhead.

Updates the haddock submodule.

Reviewers: alexbiehl, bgamari

Reviewed By: alexbiehl, bgamari

Subscribers: rwbarton, thomie, mpickering, carter

GHC Trac Issues: #15157

Differential Revision: https://phabricator.haskell.org/D4743

compiler/hsSyn/HsDoc.hs
compiler/parser/Parser.y
compiler/rename/RnHsDoc.hs
utils/haddock

index 7c6bdd9..cbe1d94 100644 (file)
@@ -1,32 +1,61 @@
 {-# LANGUAGE CPP, DeriveDataTypeable #-}
 
-module HsDoc (
-  HsDocString(..),
-  LHsDocString,
-  ppr_mbDoc
+module HsDoc
+  ( HsDocString
+  , LHsDocString
+  , mkHsDocString
+  , mkHsDocStringUtf8ByteString
+  , unpackHDS
+  , hsDocStringToByteString
+  , ppr_mbDoc
   ) where
 
 #include "HsVersions.h"
 
 import GhcPrelude
 
+import Encoding
+import FastFunctions
 import Outputable
 import SrcLoc
-import FastString
 
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Internal as BS
 import Data.Data
+import Foreign
 
 -- | Haskell Documentation String
-newtype HsDocString = HsDocString FastString
+--
+-- Internally this is a UTF8-Encoded 'ByteString'.
+newtype HsDocString = HsDocString ByteString
   deriving (Eq, Show, Data)
 
 -- | Located Haskell Documentation String
 type LHsDocString = Located HsDocString
 
 instance Outputable HsDocString where
-  ppr (HsDocString fs) = ftext fs
+  ppr = text . unpackHDS
+
+mkHsDocString :: String -> HsDocString
+mkHsDocString s =
+  inlinePerformIO $ do
+    let len = utf8EncodedLength s
+    buf <- mallocForeignPtrBytes len
+    withForeignPtr buf $ \ptr -> do
+      utf8EncodeString ptr s
+      pure (HsDocString (BS.fromForeignPtr buf 0 len))
+
+-- | Create a 'HsDocString' from a UTF8-encoded 'ByteString'.
+mkHsDocStringUtf8ByteString :: ByteString -> HsDocString
+mkHsDocStringUtf8ByteString = HsDocString
+
+unpackHDS :: HsDocString -> String
+unpackHDS = utf8DecodeByteString . hsDocStringToByteString
+
+-- | Return the contents of a 'HsDocString' as a UTF8-encoded 'ByteString'.
+hsDocStringToByteString :: HsDocString -> ByteString
+hsDocStringToByteString (HsDocString bs) = bs
 
 ppr_mbDoc :: Maybe LHsDocString -> SDoc
 ppr_mbDoc (Just doc) = ppr doc
 ppr_mbDoc Nothing    = empty
-
index 4c66fd7..c6face8 100644 (file)
@@ -3470,24 +3470,24 @@ bars :: { ([SrcSpan],Int) }     -- One or more bars
 -- Documentation comments
 
 docnext :: { LHsDocString }
-  : DOCNEXT {% return (sL1 $1 (HsDocString (mkFastString (getDOCNEXT $1)))) }
+  : DOCNEXT {% return (sL1 $1 (mkHsDocString (getDOCNEXT $1))) }
 
 docprev :: { LHsDocString }
-  : DOCPREV {% return (sL1 $1 (HsDocString (mkFastString (getDOCPREV $1)))) }
+  : DOCPREV {% return (sL1 $1 (mkHsDocString (getDOCPREV $1))) }
 
 docnamed :: { Located (String, HsDocString) }
   : DOCNAMED {%
       let string = getDOCNAMED $1
           (name, rest) = break isSpace string
-      in return (sL1 $1 (name, HsDocString (mkFastString rest))) }
+      in return (sL1 $1 (name, mkHsDocString rest)) }
 
 docsection :: { Located (Int, HsDocString) }
   : DOCSECTION {% let (n, doc) = getDOCSECTION $1 in
-        return (sL1 $1 (n, HsDocString (mkFastString doc))) }
+        return (sL1 $1 (n, mkHsDocString doc)) }
 
 moduleheader :: { Maybe LHsDocString }
         : DOCNEXT {% let string = getDOCNEXT $1 in
-                     return (Just (sL1 $1 (HsDocString (mkFastString string)))) }
+                     return (Just (sL1 $1 (mkHsDocString string))) }
 
 maybe_docprev :: { Maybe LHsDocString }
         : docprev                       { Just $1 }
index ac0731d..ac2589d 100644 (file)
@@ -21,5 +21,5 @@ rnLHsDoc (L pos doc) = do
   return (L pos doc')
 
 rnHsDoc :: HsDocString -> RnM HsDocString
-rnHsDoc (HsDocString s) = return (HsDocString s)
+rnHsDoc = pure
 
index 46ff230..90ad5b5 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 46ff2306f580c44915a6f3adb652f02b7f4edfe9
+Subproject commit 90ad5b5c3a1d8532babac7934ee5189c09ef484b