diff options
author | Zubin Duggal <zubin@cmi.ac.in> | 2022-03-12 00:07:56 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-03-23 13:39:39 -0400 |
commit | b91798be48d9fa02610b419ccea15a7dfd663823 (patch) | |
tree | fb87654ccd4a1e92e8c7a15bf454a867460869a3 /compiler/GHC/Utils/Binary.hs | |
parent | 52ffd38c610f418ee1d1a549cfdfdaa11794ea40 (diff) | |
download | haskell-b91798be48d9fa02610b419ccea15a7dfd663823.tar.gz |
hi haddock: Lex and store haddock docs in interface files
Names appearing in Haddock docstrings are lexed and renamed like any other names
appearing in the AST. We currently rename names irrespective of the namespace,
so both type and constructor names corresponding to an identifier will appear in
the docstring. Haddock will select a given name as the link destination based on
its own heuristics.
This patch also restricts the limitation of `-haddock` being incompatible with
`Opt_KeepRawTokenStream`.
The export and documenation structure is now computed in GHC and serialised in
.hi files. This can be used by haddock to directly generate doc pages without
reparsing or renaming the source. At the moment the operation of haddock
is not modified, that's left to a future patch.
Updates the haddock submodule with the minimum changes needed.
Diffstat (limited to 'compiler/GHC/Utils/Binary.hs')
-rw-r--r-- | compiler/GHC/Utils/Binary.hs | 49 |
1 files changed, 44 insertions, 5 deletions
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs index 36931b7b1f..15071c1b37 100644 --- a/compiler/GHC/Utils/Binary.hs +++ b/compiler/GHC/Utils/Binary.hs @@ -66,6 +66,8 @@ module GHC.Utils.Binary -- * Lazy Binary I/O lazyGet, lazyPut, + lazyGetMaybe, + lazyPutMaybe, -- * User data UserData(..), getUserData, setUserData, @@ -94,15 +96,19 @@ import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Unsafe as BS import Data.IORef import Data.Char ( ord, chr ) +import Data.List.NonEmpty ( NonEmpty(..)) +import qualified Data.List.NonEmpty as NonEmpty +import Data.Set ( Set ) +import qualified Data.Set as Set import Data.Time import Data.List (unfoldr) -import Data.Set (Set) -import qualified Data.Set as Set import Control.Monad ( when, (<$!>), unless, forM_ ) import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO ) import System.IO.Error ( mkIOError, eofErrorType ) import GHC.Real ( Ratio(..) ) +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap #if MIN_VERSION_base(4,15,0) import GHC.ForeignPtr ( unsafeWithForeignPtr ) #endif @@ -635,9 +641,15 @@ instance Binary a => Binary [a] where loop n = do a <- get bh; as <- loop (n-1); return (a:as) loop len -instance Binary a => Binary (Set a) where - put_ bh a = put_ bh (Set.toAscList a) - get bh = Set.fromDistinctAscList <$> get bh +-- | This instance doesn't rely on the determinism of the keys' 'Ord' instance, +-- so it works e.g. for 'Name's too. +instance (Binary a, Ord a) => Binary (Set a) where + put_ bh s = put_ bh (Set.toList s) + get bh = Set.fromList <$> get bh + +instance Binary a => Binary (NonEmpty a) where + put_ bh = put_ bh . NonEmpty.toList + get bh = NonEmpty.fromList <$> get bh instance (Ix a, Binary a, Binary b) => Binary (Array a b) where put_ bh arr = do @@ -927,6 +939,25 @@ lazyGet bh = do seekBin bh p -- skip over the object for now return a +-- | Serialize the constructor strictly but lazily serialize a value inside a +-- 'Just'. +-- +-- This way we can check for the presence of a value without deserializing the +-- value itself. +lazyPutMaybe :: Binary a => BinHandle -> Maybe a -> IO () +lazyPutMaybe bh Nothing = putWord8 bh 0 +lazyPutMaybe bh (Just x) = do + putWord8 bh 1 + lazyPut bh x + +-- | Deserialize a value serialized by 'lazyPutMaybe'. +lazyGetMaybe :: Binary a => BinHandle -> IO (Maybe a) +lazyGetMaybe bh = do + h <- getWord8 bh + case h of + 0 -> pure Nothing + _ -> Just <$> lazyGet bh + -- ----------------------------------------------------------------------------- -- UserData -- ----------------------------------------------------------------------------- @@ -1323,3 +1354,11 @@ instance Binary SrcSpan where return (RealSrcSpan ss sb) _ -> do s <- get bh return (UnhelpfulSpan s) + +-------------------------------------------------------------------------------- +-- Instances for the containers package +-------------------------------------------------------------------------------- + +instance (Binary v) => Binary (IntMap v) where + put_ bh m = put_ bh (IntMap.toList m) + get bh = IntMap.fromList <$> get bh |