diff options
author | Zubin Duggal <zubin@cmi.ac.in> | 2020-06-09 17:06:26 +0530 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-06-25 03:54:43 -0400 |
commit | 90f438724dbc1ef9e4b371034d44170738fe3224 (patch) | |
tree | 7e4ad89435b724da8935b294768310f25a7534b7 | |
parent | 284001d00995c82a1f2b38f696138ad683b5364b (diff) | |
download | haskell-90f438724dbc1ef9e4b371034d44170738fe3224.tar.gz |
Export everything from HsToCore.
This lets us reuse these functions in haddock, avoiding synchronization bugs.
Also fixed some divergences with haddock in that file
Updates haddock submodule
-rw-r--r-- | compiler/GHC/HsToCore/Docs.hs | 9 | ||||
m--------- | utils/haddock | 0 |
2 files changed, 7 insertions, 2 deletions
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs index 2cbc95c7b8..50f8f87aca 100644 --- a/compiler/GHC/HsToCore/Docs.hs +++ b/compiler/GHC/HsToCore/Docs.hs @@ -3,10 +3,11 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE BangPatterns #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} -module GHC.HsToCore.Docs (extractDocs) where +module GHC.HsToCore.Docs where import GHC.Prelude import GHC.Data.Bag @@ -147,6 +148,9 @@ getInstLoc = \case -- ^^^ DataFamInstD _ (DataFamInstDecl { dfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = L l _ }}}) -> l + -- Since CoAxioms' Names refer to the whole line for type family instances + -- in particular, we need to dig a bit deeper to pull out the entire + -- equation. This does not happen for data family instances, for some reason. TyFamInstD _ (TyFamInstDecl { tfid_eqn = HsIB { hsib_body = FamEqn { feqn_tycon = L l _ }}}) -> l @@ -214,6 +218,7 @@ conArgDocs con = case getConArgs con of go n = M.fromList . catMaybes . zipWith f [n..] where f n (HsDocTy _ _ lds) = Just (n, unLoc lds) + f n (HsBangTy _ _ (L _ (HsDocTy _ _ lds))) = Just (n, unLoc lds) f _ _ = Nothing ret = case con of @@ -251,7 +256,7 @@ nubByName f ns = go emptyNameSet ns go _ [] = [] go s (x:xs) | y `elemNameSet` s = go s xs - | otherwise = let s' = extendNameSet s y + | otherwise = let !s' = extendNameSet s y in x : go s' xs where y = f x diff --git a/utils/haddock b/utils/haddock -Subproject 02a1def8d147da88a0433726590f8586f486c76 +Subproject 45add0d8a39172d17e822b762508685d7b43363 |