Commit d1beebb8 authored by Simon Jakobi's avatar Simon Jakobi Committed by Ben Gamari

Make HsDocString a newtype of ByteString

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
parent 471b2a09
{-# 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
......@@ -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 }
......
......@@ -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
Subproject commit 46ff2306f580c44915a6f3adb652f02b7f4edfe9
Subproject commit 90ad5b5c3a1d8532babac7934ee5189c09ef484b
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment