summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorZubin Duggal <zubin@cmi.ac.in>2020-06-09 17:06:26 +0530
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-06-25 03:54:43 -0400
commit90f438724dbc1ef9e4b371034d44170738fe3224 (patch)
tree7e4ad89435b724da8935b294768310f25a7534b7
parent284001d00995c82a1f2b38f696138ad683b5364b (diff)
downloadhaskell-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.hs9
m---------utils/haddock0
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