From 36418c4f70d7d2b179a77925b3ad5caedb08c9b5 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sat, 20 Mar 2021 03:48:13 +0200 Subject: Specialization of Data.List --- html-test/ref/BundledPatterns.html | 2 +- html-test/ref/BundledPatterns2.html | 2 +- html-test/ref/Identifiers.html | 18 +++++++++--------- 3 files changed, 11 insertions(+), 11 deletions(-) (limited to 'html-test') diff --git a/html-test/ref/BundledPatterns.html b/html-test/ref/BundledPatterns.html index 82f58e49..8ac16a68 100644 --- a/html-test/ref/BundledPatterns.html +++ b/html-test/ref/BundledPatterns.html @@ -152,7 +152,7 @@ > subscript starting from 0 and ending at length - 1 subscript starting from 0 and ending at length - 1++, elemFoldable
  • , ++, elemFoldable, elem
  • Unqualified: 1 `elem``Foldable` [-3..3]
  • Qualified: 1 `elem` [-3..3]
  • Namespaced: `elem``Foldable`, `elem` Date: Thu, 20 May 2021 22:42:42 +0900 Subject: Update ref, the variables got renamed. (#1391) This is due to ghc/ghc!5555 which caused a change in ModDetails in case of NoBackend. Now the initModDetails is used to recreate the ModDetails from interface and in-memory ModDetails is not used. --- html-test/ref/Instances.html | 50 ++++++++++++++++++++++---------------------- 1 file changed, 25 insertions(+), 25 deletions(-) (limited to 'html-test') diff --git a/html-test/ref/Instances.html b/html-test/ref/Instances.html index 9e9f2300..e99f82e4 100644 --- a/html-test/ref/Instances.html +++ b/html-test/ref/Instances.html @@ -1300,9 +1300,9 @@ >baz :: [c] -> (forall a. a -> a) -> (b, a1. a1 -> a1) -> (b, forall c0. c0 -> [c]) -> (b, c1) c1. c1 -> [c]) -> (b, c0) #

    baz' :: b -> (forall b. b -> [c]) -> ( b1. b1 -> [c]) -> (forall b. b -> [c]) -> [(b, [c])] b1. b1 -> [c]) -> [(b, [c])] #

    baz'' :: b -> (forall b. ( b1. (forall b. b -> [c]) -> c0) -> b2. b2 -> [c]) -> c0) -> forall c1. c1 -> b #baz :: (a -> b) -> (forall a0. a0 -> a0) -> (b0, a1. a1 -> a1) -> (b0, forall c. c -> a -> b) -> (b0, c) c1. c1 -> a -> b) -> (b0, c) #

    forall b1. b1 -> a -> b) -> (forall b2. b2 -> a -> b) -> [(b0, a -> b)] b1. b1 -> a -> b) -> [(b0, a -> b)] #

    forall b2. b2 -> a -> b) -> c) -> forall c. c -> b0 c1. c1 -> b0 #

    Quux a b c -> (forall a0. a0 -> a0) -> (b0, a1. a1 -> a1) -> (b0, forall c0. c0 -> c1. c1 -> Quux a b c) -> (b0, c1) a b c) -> (b0, c0) #

    Quux a b c) -> (forall b2. b2 -> b1. b1 -> Quux a b c) -> [(b0, Quuxbaz :: (a, b, c) -> (forall a0. a0 -> a0) -> (b0, a1. a1 -> a1) -> (b0, forall c0. c0 -> (a, b, c)) -> (b0, c1) c1. c1 -> (a, b, c)) -> (b0, c0) #

    forall b1. b1 -> (a, b, c)) -> (forall b2. b2 -> (a, b, c)) -> [(b0, (a, b, c))] b1. b1 -> (a, b, c)) -> [(b0, (a, b, c))] #

    baz :: (a, [b], b, a) -> (forall a0. a0 -> a0) -> (b0, a1. a1 -> a1) -> (b0, forall c. c -> (a, [b], b, a)) -> (b0, c) c1. c1 -> (a, [b], b, a)) -> (b0, c) #

    forall b1. b1 -> (a, [b], b, a)) -> (forall b2. b2 -> (a, [b], b, a)) -> [(b0, (a, [b], b, a))] b1. b1 -> (a, [b], b, a)) -> [(b0, (a, [b], b, a))] #

    forall b2. b2 -> (a, [b], b, a)) -> c) -> forall c. c -> b0 c1. c1 -> b0 #

    Quux a b c -> (forall a0. a0 -> a0) -> (b0, a1. a1 -> a1) -> (b0, forall c0. c0 -> c1. c1 -> Quux a b c) -> (b0, c1) a b c) -> (b0, c0) #

    Quux a b c) -> (forall b2. b2 -> b1. b1 -> Quux a b c) -> [(b0, Quux Date: Mon, 11 Oct 2021 15:40:19 +0530 Subject: Enable Haddock tests in GHC windows CI (#1428) * testsuite: strip windows line endings for haddock * hyperlinker: Work around double escaping (#19236) * deterministic SCC --- haddock-api/src/Haddock/Backends/Hyperlinker.hs | 12 +++++- haddock-api/src/Haddock/Interface.hs | 54 +++++++++++++++++++++++-- haddock-test/src/Test/Haddock/Xhtml.hs | 3 +- html-test/ref/Bug1004.html | 12 +++--- html-test/ref/BundledPatterns.html | 8 ++-- html-test/ref/BundledPatterns2.html | 8 ++-- 6 files changed, 76 insertions(+), 21 deletions(-) (limited to 'html-test') diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 39be6762..68e03fd5 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -22,7 +22,7 @@ import System.FilePath import GHC.Iface.Ext.Types ( pattern HiePath, HieFile(..), HieASTs(..), HieAST(..), SourcedNodeInfo(..) ) import GHC.Iface.Ext.Binary ( readHieFile, hie_file_result ) -import GHC.Types.SrcLoc ( realSrcLocSpan, mkRealSrcLoc ) +import GHC.Types.SrcLoc ( realSrcLocSpan, mkRealSrcLoc, srcSpanFile ) import Data.Map as M import GHC.Data.FastString ( mkFastString ) import GHC.Unit.Module ( Module, moduleName ) @@ -71,7 +71,7 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = case ifaceHieFile let fileFs = mkFastString file mast | M.size asts == 1 = snd <$> M.lookupMin asts | otherwise = M.lookup (HiePath (mkFastString file)) asts - tokens = parse df file rawSrc + tokens' = parse df file rawSrc ast = fromMaybe (emptyHieAst fileFs) mast fullAst = recoverFullIfaceTypes df types ast @@ -81,6 +81,14 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = case ifaceHieFile else out verbosity verbose $ unwords [ "couldn't find ast for" , file, show (M.keys asts) ] + -- The C preprocessor can double the backslashes on tokens (see #19236), + -- which means the source spans will not be comparable and we will not + -- be able to associate the HieAST with the correct tokens. + -- + -- We work around this by setting the source span of the tokens to the file + -- name from the HieAST + let tokens = fmap (\tk -> tk {tkSpan = (tkSpan tk){srcSpanFile = srcSpanFile $ nodeSpan fullAst}}) tokens' + -- Produce and write out the hyperlinked sources writeUtf8File path . renderToString pretty . render' fullAst $ tokens Nothing -> return () diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index 2e9b2f7e..ba7d9d30 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -55,7 +55,7 @@ import qualified Data.Set as Set import GHC hiding (verbosity) import GHC.Data.FastString (unpackFS) -import GHC.Data.Graph.Directed (flattenSCCs) +import GHC.Data.Graph.Directed import GHC.Driver.Env (hscUpdateFlags, hsc_home_unit, hsc_logger, hsc_static_plugins, hsc_units) import GHC.Driver.Monad (modifySession, withTimingM) import GHC.Driver.Session hiding (verbosity) @@ -68,7 +68,7 @@ import GHC.Types.Name (nameIsFromExternalPackage, nameOccName) import GHC.Types.Name.Occurrence (isTcOcc) import GHC.Types.Name.Reader (globalRdrEnvElts, greMangledName, unQualOK) import GHC.Unit.Module.Env (ModuleSet, emptyModuleSet, mkModuleSet, unionModuleSet) -import GHC.Unit.Module.Graph (ModuleGraphNode (..)) +import GHC.Unit.Module.Graph import GHC.Unit.Module.ModSummary (emsModSummary, isBootSummary) import GHC.Unit.Types (IsBootInterface (..)) import GHC.Utils.Error (withTiming) @@ -170,13 +170,59 @@ createIfaces verbosity modules flags instIfaceMap = do moduleSet <- liftIO getModules let + -- We topologically sort the module graph including boot files, + -- so it should be acylic (hopefully we failed much earlier if this is not the case) + -- We then filter out boot modules from the resultant topological sort + -- + -- We do it this way to make 'buildHomeLinks' a bit more stable + -- 'buildHomeLinks' depends on the topological order of its input in order + -- to construct its result. In particular, modules closer to the bottom of + -- the dependency chain are to be prefered for link destinations. + -- + -- If there are cycles in the graph, then this order is indeterminate + -- (the nodes in the cycle can be ordered in any way). + -- While 'topSortModuleGraph' does guarantee stability for equivalent + -- module graphs, seemingly small changes in the ModuleGraph can have + -- big impacts on the `LinkEnv` constructed. + -- + -- For example, suppose + -- G1 = A.hs -> B.hs -> C.hs (where '->' denotes an import). + -- + -- Then suppose C.hs is changed to have a cyclic dependency on A + -- + -- G2 = A.hs -> B.hs -> C.hs -> A.hs-boot + -- + -- For G1, `C.hs` is preferred for link destinations. However, for G2, + -- the topologically sorted order not taking into account boot files (so + -- C -> A) is completely indeterminate. + -- Using boot files to resolve cycles, we end up with the original order + -- [C, B, A] (in decreasing order of preference for links) + -- + -- This exact case came up in testing for the 'base' package, where there + -- is a big module cycle involving 'Prelude' on windows, but the cycle doesn't + -- include 'Prelude' on non-windows platforms. This lead to drastically different + -- LinkEnv's (and failing haddockHtmlTests) across the platforms + -- + -- In effect, for haddock users this behaviour (using boot files to eliminate cycles) + -- means that {-# SOURCE #-} imports no longer count towards re-ordering + -- the preference of modules for linking. + -- + -- i.e. if module A imports B, then B is preferred over A, + -- but if module A {-# SOURCE #-} imports B, then we can't say the same. + -- + go (AcyclicSCC (ModuleNode ems)) + | NotBoot <- isBootSummary (emsModSummary ems) = [ems] + | otherwise = [] + go (AcyclicSCC _) = [] + go (CyclicSCC _) = error "haddock: module graph cyclic even with boot files" + ifaces :: [Interface] ifaces = [ Map.findWithDefault (error "haddock:iface") (ms_mod (emsModSummary ems)) ifaceMap - | ModuleNode ems <- flattenSCCs $ topSortModuleGraph True modGraph Nothing + | ems <- concatMap go $ topSortModuleGraph False modGraph Nothing ] return (ifaces, moduleSet) @@ -352,7 +398,7 @@ processModule1 verbosity flags ifaces inst_ifaces hsc_env mod_summary tc_gbl_env -- The interfaces are passed in in topologically sorted order, but we start -- by reversing the list so we can do a foldl. buildHomeLinks :: [Interface] -> LinkEnv -buildHomeLinks ifaces = foldl upd Map.empty (reverse ifaces) +buildHomeLinks ifaces = foldl' upd Map.empty (reverse ifaces) where upd old_env iface | OptHide `elem` ifaceOptions iface = old_env diff --git a/haddock-test/src/Test/Haddock/Xhtml.hs b/haddock-test/src/Test/Haddock/Xhtml.hs index bca2c4cc..74d8c4f7 100644 --- a/haddock-test/src/Test/Haddock/Xhtml.hs +++ b/haddock-test/src/Test/Haddock/Xhtml.hs @@ -23,8 +23,9 @@ import Data.Char ( isSpace ) newtype Xml = Xml { unXml :: String } -- | Part of parsing involves dropping the @DOCTYPE@ line +-- and windows newline endings parseXml :: String -> Maybe Xml -parseXml = Just . Xml . dropDocTypeLine +parseXml = Just . Xml . filter (/= '\r') . dropDocTypeLine where dropDocTypeLine bs | " ( (Typeable a, a, Typeable f, f, Typeable g, g, Typeable k, Data

    dataCast1 :: :: Typeable t => (forall

    dataCast2 :: :: Typeable t => (foralldata Vec :: :: Nat -> * -> * wheredata RTree :: :: Nat -> * -> * wheredata Vec :: :: Nat -> * -> * wheredata RTree :: :: Nat -> * -> * wheredata Vec :: :: Nat -> * -> * wheredata RTree :: :: Nat -> * -> * wheredata Vec :: :: Nat -> * -> * wheredata RTree :: :: Nat -> * -> * where Date: Thu, 2 Dec 2021 11:46:54 +0000 Subject: Update html-test for Data.List revert --- html-test/ref/Identifiers.html | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'html-test') diff --git a/html-test/ref/Identifiers.html b/html-test/ref/Identifiers.html index b177266d..76487140 100644 --- a/html-test/ref/Identifiers.html +++ b/html-test/ref/Identifiers.html @@ -147,7 +147,7 @@ >, Foldableelem

  • ++, Foldableelem, elemUnqualified: 1 `Foldable``elem` [-3..3]
  • Qualified: 1 `elem` [-3..3]
  • Namespaced: `Foldable``elem`, `elem` Date: Sun, 18 Oct 2020 16:25:35 +0300 Subject: Link to (~) --- haddock-api/src/Haddock/GhcUtils.hs | 1 + haddock-api/src/Haddock/Types.hs | 1 + haddock-library/src/Documentation/Haddock/Parser/Monad.hs | 1 + html-test/ref/FunArgs.html | 4 +++- html-test/ref/TypeOperators.html | 10 ++++++++-- 5 files changed, 14 insertions(+), 3 deletions(-) (limited to 'html-test') diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 85e6fcf4..3f97236a 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns, StandaloneDeriving, FlexibleInstances, ViewPatterns #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index ba86f429..7d00c5ec 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PartialTypeSignatures #-} diff --git a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs index 7c73a168..2fa79961 100644 --- a/haddock-library/src/Documentation/Haddock/Parser/Monad.hs +++ b/haddock-library/src/Documentation/Haddock/Parser/Monad.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeSynonymInstances #-} -- | diff --git a/html-test/ref/FunArgs.html b/html-test/ref/FunArgs.html index 2fac6d4e..855f1b89 100644 --- a/html-test/ref/FunArgs.html +++ b/html-test/ref/FunArgs.html @@ -230,7 +230,9 @@ >:: forall a (b :: ()) d. d ~ ' a (b :: ()) d. d ~ '()

    f :: a ~ b => a -> b :: a ~ b => a -> b #

    g :: (a ~ b, b ~ c) => a -> c :: (a ~ b, b ~ c) => a -> c #

    Date: Mon, 28 Mar 2022 15:00:51 +0300 Subject: Rename [] to List --- html-test/ref/Instances.html | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'html-test') diff --git a/html-test/ref/Instances.html b/html-test/ref/Instances.html index e99f82e4..109e866c 100644 --- a/html-test/ref/Instances.html +++ b/html-test/ref/Instances.html @@ -262,7 +262,9 @@ > Foo [] List # Bar [] (a, a) List (a, a) # Date: Fri, 29 Apr 2022 23:58:38 -0400 Subject: Update test output --- html-test/ref/Instances.html | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) (limited to 'html-test') diff --git a/html-test/ref/Instances.html b/html-test/ref/Instances.html index 109e866c..e99f82e4 100644 --- a/html-test/ref/Instances.html +++ b/html-test/ref/Instances.html @@ -262,9 +262,7 @@ > Foo List [] # Bar List (a, a) [] (a, a) # Date: Fri, 5 Aug 2022 19:07:23 -0400 Subject: Clean up build and testsuite for GHC 9.4 --- haddock-api/haddock-api.cabal | 14 +- haddock-api/src/Haddock.hs | 1 - haddock-api/src/Haddock/Backends/Hyperlinker.hs | 2 - haddock-api/src/Haddock/Interface.hs | 9 +- haddock-api/src/Haddock/Interface/Create.hs | 5 +- haddock-api/src/Haddock/Interface/LexParseRn.hs | 1 - haddock-api/src/Haddock/Interface/Specialize.hs | 1 - haddock-api/src/Haddock/InterfaceFile.hs | 13 -- html-test/ref/Bug1004.html | 200 ++++++------------------ html-test/ref/Bug310.html | 34 ---- html-test/ref/Bug548.html | 40 ++--- 11 files changed, 64 insertions(+), 256 deletions(-) (limited to 'html-test') diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal index be84f8ce..206b9aa2 100644 --- a/haddock-api/haddock-api.cabal +++ b/haddock-api/haddock-api.cabal @@ -1,10 +1,10 @@ -cabal-version: 2.0 +cabal-version: 3.0 name: haddock-api -version: 2.26.1 +version: 2.27.0 synopsis: A documentation-generation tool for Haskell libraries description: Haddock is a documentation-generation tool for Haskell libraries -license: BSD2 +license: BSD-2-Clause license-file: LICENSE author: Simon Marlow, David Waern maintainer: Alec Theriault , Alex Biehl , Simon Hengel , Mateusz Kowalczyk @@ -13,7 +13,7 @@ bug-reports: https://github.com/haskell/haddock/issues copyright: (c) Simon Marlow, David Waern category: Documentation build-type: Simple -tested-with: GHC==9.2.* +tested-with: GHC==9.4.* extra-source-files: CHANGES.md @@ -44,9 +44,9 @@ library -- this package typically supports only single major versions build-depends: base ^>= 4.16.0 - , ghc ^>= 9.3 + , ghc ^>= 9.4 , ghc-paths ^>= 0.1.0.9 - , haddock-library ^>= 1.10.0 + , haddock-library ^>= 1.10 , xhtml ^>= 3000.2.2 , parsec ^>= 3.1.13.0 @@ -180,7 +180,7 @@ test-suite spec Haddock.Backends.Hyperlinker.Parser Haddock.Backends.Hyperlinker.Types - build-depends: ghc ^>= 9.3 + build-depends: ghc ^>= 9.4 , ghc-paths ^>= 0.1.0.12 , haddock-library ^>= 1.10.0 , xhtml ^>= 3000.2.2 diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs index 989ca03f..ea664bcf 100644 --- a/haddock-api/src/Haddock.hs +++ b/haddock-api/src/Haddock.hs @@ -80,7 +80,6 @@ import GHC.Utils.Error import GHC.Utils.Logger import GHC.Types.Name.Cache import GHC.Unit -import GHC.Unit.State (lookupUnit) import GHC.Utils.Panic (handleGhcException) import GHC.Data.FastString diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 89828e30..9316da6d 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -26,8 +26,6 @@ import GHC.Types.SrcLoc ( realSrcLocSpan, mkRealSrcLoc, srcSpanFile ) import Data.Map as M import GHC.Data.FastString ( mkFastString ) import GHC.Unit.Module ( Module, moduleName ) -import GHC.Types.Name.Cache ( initNameCache ) -import GHC.Types.Unique.Supply ( mkSplitUniqSupply ) -- | Generate hyperlinked source for given interfaces. diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs index 19113107..92b727ac 100644 --- a/haddock-api/src/Haddock/Interface.hs +++ b/haddock-api/src/Haddock/Interface.hs @@ -46,7 +46,7 @@ import Haddock.Types (DocOption (..), Documentation (..), ExportItem (..), Iface import Haddock.Utils (Verbosity (..), normal, out, verbose) import Control.Monad (unless, when) -import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.IO.Class (MonadIO) import Data.IORef (atomicModifyIORef', newIORef, readIORef) import Data.List (foldl', isPrefixOf, nub) import Text.Printf (printf) @@ -54,7 +54,6 @@ import qualified Data.Map as Map import qualified Data.Set as Set import GHC hiding (verbosity) -import GHC.Data.FastString (unpackFS) import GHC.Data.Graph.Directed import GHC.Driver.Env import GHC.Driver.Monad (modifySession, withTimingM) @@ -64,13 +63,7 @@ import GHC.Plugins import GHC.Tc.Types (TcGblEnv (..), TcM) import GHC.Tc.Utils.Env (tcLookupGlobal) import GHC.Tc.Utils.Monad (getTopEnv, setGblEnv) -import GHC.Types.Name (nameIsFromExternalPackage, nameOccName) -import GHC.Types.Name.Occurrence (isTcOcc) -import GHC.Types.Name.Reader (globalRdrEnvElts, greMangledName, unQualOK) -import GHC.Unit.Module.Env (ModuleSet, emptyModuleSet, mkModuleSet, unionModuleSet) import GHC.Unit.Module.Graph -import GHC.Unit.Module.ModSummary (isBootSummary) -import GHC.Unit.Types (IsBootInterface (..)) import GHC.Utils.Error (withTiming) #if defined(mingw32_HOST_OS) diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index b832128f..e3c4a529 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -54,7 +54,7 @@ import Data.Traversable (for) import GHC hiding (lookupName) import GHC.Core.Class (ClassMinimalDef, classMinimalDef) import GHC.Core.ConLike (ConLike (..)) -import GHC.Data.FastString (bytesFS, unpackFS) +import GHC.Data.FastString (unpackFS) import GHC.Driver.Ppr (showSDoc) import GHC.HsToCore.Docs hiding (mkMaps, unionArgMaps) import GHC.IORef (readIORef) @@ -1137,8 +1137,7 @@ extractDecl declMap name decl _ -> Left "internal: extractDecl (ClsInstD)" _ -> Left ("extractDecl: Unhandled decl for " ++ getOccString name) -extractPatternSyn :: HasCallStack - => Name -> Name +extractPatternSyn :: Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn] -> Either ErrMsg (LSig GhcRn) extractPatternSyn nm t tvs cons = diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index 4e1964af..455f3314 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -39,7 +39,6 @@ import GHC.Parser.PostProcess import GHC.Driver.Ppr ( showPpr, showSDoc ) import GHC.Types.Name.Reader import GHC.Data.EnumSet as EnumSet -import GHC.Utils.Trace processDocStrings :: DynFlags -> Maybe Package -> GlobalRdrEnv -> [HsDocString] -> ErrMsgM (Maybe (MDoc Name)) diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index d1164858..ca6b9e74 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -16,7 +16,6 @@ import Haddock.Syb import Haddock.Types import GHC -import GHC.Types.Basic ( PromotionFlag(..) ) import GHC.Types.Name import GHC.Data.FastString import GHC.Builtin.Types ( listTyConName, unrestrictedFunTyConName ) diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs index f9861708..e6db49c0 100644 --- a/haddock-api/src/Haddock/InterfaceFile.hs +++ b/haddock-api/src/Haddock/InterfaceFile.hs @@ -309,19 +309,6 @@ putInterfaceFile_ bh (InterfaceFile env info ifaces) = do put_ bh info put_ bh ifaces -getInterfaceFile :: BinHandle -> Word16 -> IO InterfaceFile -getInterfaceFile bh v | v <= 38 = do - env <- get bh - let info = PackageInfo (PackageName mempty) (makeVersion []) - ifaces <- get bh - return (InterfaceFile env info ifaces) -getInterfaceFile bh _ = do - env <- get bh - info <- get bh - ifaces <- get bh - return (InterfaceFile env info ifaces) - - instance Binary InstalledInterface where put_ bh (InstalledInterface modu is_sig info docMap argMap exps visExps opts fixMap) = do diff --git a/html-test/ref/Bug1004.html b/html-test/ref/Bug1004.html index 9fe6f84e..bbe2f599 100644 --- a/html-test/ref/Bug1004.html +++ b/html-test/ref/Bug1004.html @@ -48,26 +48,6 @@ >

    Bug1004

    Synopsis

    Documentation

    ) (a :: k) #

    Lifted product of functors.

    Constructors

    Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g)

    Since: base-4.9.0.0

     Product f g a)

    Since: base-4.9.0.0

     Product f g a)

    Since: base-4.16.0.0

     Product f g a)

    Since: base-4.16.0.0

     Product f g a)

    Since: base-4.9.0.0

     Product f g a)

    Since: base-4.9.0.0

     Product f g a)

    Since: base-4.9.0.0

     Product f g a)

    Since: base-4.9.0.0

     Type)

    Since: base-4.9.0.0

     Product f g a)

    Since: base-4.9.0.0

     

    Bug310

    Synopsis

    Documentation

    Natural where ... infixl 6 #

    Addition of type-level naturals.

    Since: base-4.7.0.0

    WrappedArrow a b)

    Since: base-2.1

     WrappedArrow a b)

    Since: base-2.1

     WrappedArrow a b)

    Since: base-2.1

     Type)

    Since: base-4.7.0.0

     WrappedArrow a b c)

    Since: base-4.7.0.0

      Date: Sat, 6 Aug 2022 22:57:21 -0400 Subject: html-test: Testsuite changes for GHC 9.4.1 --- html-test/ref/Bug1004.html | 200 +++++++++++++++++++++++++++++++++++---------- html-test/ref/Bug310.html | 34 ++++++++ html-test/ref/Bug548.html | 40 ++++++--- 3 files changed, 220 insertions(+), 54 deletions(-) (limited to 'html-test') diff --git a/html-test/ref/Bug1004.html b/html-test/ref/Bug1004.html index bbe2f599..9fe6f84e 100644 --- a/html-test/ref/Bug1004.html +++ b/html-test/ref/Bug1004.html @@ -48,6 +48,26 @@ >

    Bug1004

    Synopsis

    Documentation

    ) (a :: k) #

    Lifted product of functors.

    Constructors

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g) 

    Since: base-4.9.0.0

    Product f g a) 

    Since: base-4.9.0.0

    Product f g a) 

    Since: base-4.16.0.0

    Product f g a) 

    Since: base-4.16.0.0

    Product f g a) 

    Since: base-4.9.0.0

    Product f g a) 

    Since: base-4.9.0.0

    Product f g a) 

    Since: base-4.9.0.0

    Product f g a) 

    Since: base-4.9.0.0

    Type) 

    Since: base-4.9.0.0

    Product f g a) 

    Since: base-4.9.0.0

    Bug310

    Synopsis

    Documentation

    Natural where ... infixl 6 #

    Addition of type-level naturals.

    Since: base-4.7.0.0

    WrappedArrow a b) 

    Since: base-2.1

    WrappedArrow a b) 

    Since: base-2.1

    WrappedArrow a b) 

    Since: base-2.1

    Type) 

    Since: base-4.7.0.0

    WrappedArrow a b c) 

    Since: base-4.7.0.0