[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: GHCi debugger: drop record name spaces for Ids
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Aug 21 19:15:40 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
c29b2b5a by sheaf at 2024-08-21T13:11:30-04:00
GHCi debugger: drop record name spaces for Ids
When binding new local variables at a breakpoint, we should create
Ids with variable namespace, and not record field namespace. Otherwise
the rest of the compiler falls over because the IdDetails are wrong.
Fixes #25109
- - - - -
bd82ac9f by Hécate Kleidukos at 2024-08-21T13:12:12-04:00
base: Final deprecation of GHC.Pack
The timeline mandated by #21461 has come to its term and after two years
and four minor releases, we are finally removing GHC.Pack from base.
Closes #21536
- - - - -
5092dbff by Sylvain Henry at 2024-08-21T13:12:54-04:00
JS: support rubbish static literals (#25177)
Support for rubbish dynamic literals was added in #24664. This patch
does the same for static literals.
Fix #25177
- - - - -
b5a2c061 by Phil de Joux at 2024-08-21T13:13:33-04:00
haddock docs: prefix comes before, postfix comes after
- - - - -
9eef4e9a by Marcin Szamotulski at 2024-08-21T15:15:24-04:00
haddock: include package info with --show-interface
- - - - -
b750f94d by Andreas Klebinger at 2024-08-21T15:15:25-04:00
Document the (x86) SIMD macros.
Fixes #25021.
- - - - -
25 changed files:
- + a.out
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/StgToJS/Literal.hs
- compiler/GHC/SysTools/Cpp.hs
- compiler/GHC/Types/Id.hs
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/phases.rst
- libraries/base/base.cabal
- libraries/base/changelog.md
- − libraries/base/src/GHC/Pack.hs
- + testsuite/tests/codeGen/should_compile/T25177.hs
- + testsuite/tests/codeGen/should_compile/T25177.stderr
- testsuite/tests/codeGen/should_compile/all.T
- + testsuite/tests/ghci.debugger/scripts/T25109.hs
- + testsuite/tests/ghci.debugger/scripts/T25109.script
- + testsuite/tests/ghci.debugger/scripts/T25109.stdout
- testsuite/tests/ghci.debugger/scripts/all.T
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- utils/haddock/CHANGES.md
- utils/haddock/doc/common-errors.rst
- utils/haddock/doc/markup.rst
- utils/haddock/haddock-api/src/Haddock/Interface/Json.hs
Changes:
=====================================
a.out
=====================================
Binary files /dev/null and b/a.out differ
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -625,8 +625,10 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just ibi) = do
-- saved/restored, but not the linker state. See #1743, test break026.
mkNewId :: OccName -> Type -> Id -> IO Id
mkNewId occ ty old_id
- = do { name <- newInteractiveBinder hsc_env occ (getSrcSpan old_id)
- ; return (Id.mkVanillaGlobalWithInfo name ty (idInfo old_id)) }
+ = do { name <- newInteractiveBinder hsc_env (mkVarOccFS (occNameFS occ)) (getSrcSpan old_id)
+ -- NB: use variable namespace.
+ -- Don't use record field namespaces, lest we cause #25109.
+ ; return $ Id.mkVanillaGlobalWithInfo name ty (idInfo old_id) }
newTyVars :: UniqSupply -> [TcTyVar] -> Subst
-- Similarly, clone the type variables mentioned in the types
=====================================
compiler/GHC/StgToJS/Literal.hs
=====================================
@@ -115,7 +115,24 @@ genStaticLit = \case
LitDouble r -> return [ DoubleLit . SaneDouble . r2d $ r ]
LitLabel name fod -> return [ LabelLit (fod == IsFunction) (mkRawSymbol True name)
, IntLit 0 ]
- l -> pprPanic "genStaticLit" (ppr l)
+ LitRubbish _ rep ->
+ let prim_reps = runtimeRepPrimRep (text "GHC.StgToJS.Literal.genStaticLit") rep
+ in case expectOnly "GHC.StgToJS.Literal.genStaticLit" prim_reps of -- Note [Post-unarisation invariants]
+ BoxedRep _ -> pure [ NullLit ]
+ AddrRep -> pure [ NullLit, IntLit 0 ]
+ IntRep -> pure [ IntLit 0 ]
+ Int8Rep -> pure [ IntLit 0 ]
+ Int16Rep -> pure [ IntLit 0 ]
+ Int32Rep -> pure [ IntLit 0 ]
+ Int64Rep -> pure [ IntLit 0, IntLit 0 ]
+ WordRep -> pure [ IntLit 0 ]
+ Word8Rep -> pure [ IntLit 0 ]
+ Word16Rep -> pure [ IntLit 0 ]
+ Word32Rep -> pure [ IntLit 0 ]
+ Word64Rep -> pure [ IntLit 0, IntLit 0 ]
+ FloatRep -> pure [ DoubleLit (SaneDouble 0) ]
+ DoubleRep -> pure [ DoubleLit (SaneDouble 0) ]
+ VecRep {} -> pprPanic "GHC.StgToJS.Literal.genStaticLit: LitRubbish(VecRep) isn't supported" (ppr rep)
-- make an unsigned 32 bit number from this unsigned one, lower 32 bits
toU32Expr :: Integer -> JStgExpr
=====================================
compiler/GHC/SysTools/Cpp.hs
=====================================
@@ -106,6 +106,9 @@ command line looks like:
-- See Note [Preprocessing invocations].
--
-- UnitEnv is needed to compute MIN_VERSION macros
+--
+-- If you change the macros defined by this function make sure to update the
+-- user guide.
doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> FilePath -> FilePath -> IO ()
doCpp logger tmpfs dflags unit_env opts input_fn output_fn = do
let hscpp_opts = picPOpts dflags
=====================================
compiler/GHC/Types/Id.hs
=====================================
@@ -301,26 +301,28 @@ mkGlobalId :: IdDetails -> Name -> Type -> IdInfo -> Id
mkGlobalId = Var.mkGlobalVar
-- | Make a global 'Id' without any extra information at all
-mkVanillaGlobal :: Name -> Type -> Id
+mkVanillaGlobal :: HasDebugCallStack => Name -> Type -> Id
mkVanillaGlobal name ty = mkVanillaGlobalWithInfo name ty vanillaIdInfo
-- | Make a global 'Id' with no global information but some generic 'IdInfo'
-mkVanillaGlobalWithInfo :: Name -> Type -> IdInfo -> Id
-mkVanillaGlobalWithInfo = mkGlobalId VanillaId
-
+mkVanillaGlobalWithInfo :: HasDebugCallStack => Name -> Type -> IdInfo -> Id
+mkVanillaGlobalWithInfo nm =
+ assertPpr (not $ isFieldNameSpace $ nameNameSpace nm)
+ (text "mkVanillaGlobalWithInfo called on record field:" <+> ppr nm) $
+ mkGlobalId VanillaId nm
-- | For an explanation of global vs. local 'Id's, see "GHC.Types.Var#globalvslocal"
mkLocalId :: HasDebugCallStack => Name -> Mult -> Type -> Id
mkLocalId name w ty = mkLocalIdWithInfo name w (assert (not (isCoVarType ty)) ty) vanillaIdInfo
-- | Make a local CoVar
-mkLocalCoVar :: Name -> Type -> CoVar
+mkLocalCoVar :: HasDebugCallStack => Name -> Type -> CoVar
mkLocalCoVar name ty
= assert (isCoVarType ty) $
Var.mkLocalVar CoVarId name ManyTy ty vanillaIdInfo
-- | Like 'mkLocalId', but checks the type to see if it should make a covar
-mkLocalIdOrCoVar :: Name -> Mult -> Type -> Id
+mkLocalIdOrCoVar :: HasDebugCallStack => Name -> Mult -> Type -> Id
mkLocalIdOrCoVar name w ty
-- We should assert (eqType w Many) in the isCoVarType case.
-- However, currently this assertion does not hold.
@@ -344,7 +346,10 @@ mkExportedLocalId details name ty = Var.mkExportedLocalVar details name ty vanil
-- Note [Free type variables]
mkExportedVanillaId :: Name -> Type -> Id
-mkExportedVanillaId name ty = Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
+mkExportedVanillaId name ty =
+ assertPpr (not $ isFieldNameSpace $ nameNameSpace name)
+ (text "mkExportedVanillaId called on record field:" <+> ppr name) $
+ Var.mkExportedLocalVar VanillaId name ty vanillaIdInfo
-- Note [Free type variables]
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -157,6 +157,7 @@ Runtime system
https://github.com/haskell/core-libraries-committee/issues/231
https://github.com/haskell/core-libraries-committee/issues/261
+- The `deprecation process of GHC.Pack <https://gitlab.haskell.org/ghc/ghc/-/issues/21461>` has come its term. The module has now been removed from ``base``.
``ghc-prim`` library
~~~~~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/phases.rst
=====================================
@@ -523,7 +523,7 @@ defined by your local GHC installation, the following trick is useful:
``arch_HOST_ARCH=1``
This define allows conditional compilation based on the host
architecture, where⟨arch⟩ is the name of the current architecture
- (eg. ``i386``, ``x86_64``, ``powerpc``, ``sparc``, etc.).
+ (eg. ``i386``, ``x86_64``, ``aarch64``, ``powerpc``, ``sparc``, etc.).
``VERSION_pkgname``
This macro is available starting GHC 8.0. It is defined for every
@@ -539,6 +539,16 @@ defined by your local GHC installation, the following trick is useful:
later. It is identical in behavior to the ``MIN_VERSION_pkgname``
macros that Cabal defines.
+SIMD macros
+ .. index::
+ single: SIMD Macros
+
+ These are defined conditionally based on the SIMD
+ flags used for compilation:
+
+ ``__SSE__``, ``__SSE2__``, ``__SSE4_2__``, ``__FMA__``,
+ ``__AVX__``, ``__AVX2__``, ``__AVX512CD__``, ``__AVX512ER__``, ``__AVX512F__``, ``__AVX512PF__``,
+
.. _cpp-string-gaps:
CPP and string gaps
=====================================
libraries/base/base.cabal
=====================================
@@ -217,7 +217,6 @@ Library
, GHC.Num
, GHC.OldList
, GHC.OverloadedLabels
- , GHC.Pack
, GHC.Profiling
, GHC.Ptr
, GHC.Read
=====================================
libraries/base/changelog.md
=====================================
@@ -18,6 +18,7 @@
* Add exception type metadata to default exception handler output.
([CLC proposal #231](https://github.com/haskell/core-libraries-committee/issues/231)
and [CLC proposal #261](https://github.com/haskell/core-libraries-committee/issues/261))
+ * The [deprecation process of GHC.Pack](https://gitlab.haskell.org/ghc/ghc/-/issues/21461) has come its term. The module has now been removed from `base`.
## 4.20.0.0 May 2024
* Shipped with GHC 9.10.1
=====================================
libraries/base/src/GHC/Pack.hs deleted
=====================================
@@ -1,37 +0,0 @@
-{-# LANGUAGE MagicHash #-}
-{-# OPTIONS_HADDOCK not-home #-}
-
--- |
---
--- Module : GHC.Pack
--- Copyright : (c) The University of Glasgow 1997-2002
--- License : see libraries/base/LICENSE
---
--- Maintainer : ghc-devs at haskell.org
--- Stability : internal
--- Portability : non-portable (GHC Extensions)
---
--- ⚠ Warning: Starting @base-4.18@, this module is being deprecated.
--- See https://gitlab.haskell.org/ghc/ghc/-/issues/21461 for more information.
---
---
---
--- This module provides a small set of low-level functions for packing
--- and unpacking a chunk of bytes. Used by code emitted by the compiler
--- plus the prelude libraries.
---
--- The programmer level view of packed strings is provided by a GHC
--- system library PackedString.
---
-
-module GHC.Pack
- {-# DEPRECATED "The exports of this module should be instead imported from GHC.Exts" #-}
- (packCString#,
- unpackCString,
- unpackCString#,
- unpackNBytes#,
- unpackFoldrCString#,
- unpackAppendCString#
- ) where
-
-import GHC.Internal.Pack
=====================================
testsuite/tests/codeGen/should_compile/T25177.hs
=====================================
@@ -0,0 +1,32 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedSums #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+-- only export bar!
+module T25177 (bar) where
+
+import GHC.Exts
+
+data D = D !Word# !Int#
+
+{-# OPAQUE foo #-}
+-- foo has an absent demand on D's Int#
+foo :: D -> Word
+foo (D a _) = W# a
+
+
+bar :: Int# -> IO ()
+bar !x = do
+ -- we allocate a D:
+ -- - used twice: otherwise it is inlined
+ -- - whose second arg:
+ -- - has an absent demand
+ -- - is an unboxed Int# (hence won't be replaced by an "absentError blah"
+ -- but by a LitRubbish)
+ --
+ -- GHC should detect that `17# +# x` is absent. Then it should lift `d` to the
+ -- top-level. This is checked by dumping Core with -ddump-simpl.
+ let d = D 10## (17# +# x)
+ let !r1 = foo d -- luckily CSE doesn't kick in before floating-out `d`...
+ let !r2 = foo d -- otherwise, pass a additional dummy argument to `foo`
+ pure ()
=====================================
testsuite/tests/codeGen/should_compile/T25177.stderr
=====================================
@@ -0,0 +1,17 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 25, types: 31, coercions: 6, joins: 0/0}
+
+foo = \ ds -> case ds of { D a ds1 -> W# a }
+
+d = D 10## RUBBISH(IntRep)
+
+lvl = foo d
+
+bar1 = \ _ eta -> case lvl of { W# ipv -> (# eta, () #) }
+
+bar = bar1 `cast` <Co:6> :: ...
+
+
+
=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -138,3 +138,6 @@ test('callee-no-local', [
compile,
['-ddump-cmm-raw']
)
+
+# dump Core to ensure that d is defined as: d = D 10## RUBBISH(IntRep)
+test('T25177', normal, compile, ['-O2 -dno-typeable-binds -ddump-simpl -dsuppress-all -dsuppress-uniques -v0'])
=====================================
testsuite/tests/ghci.debugger/scripts/T25109.hs
=====================================
@@ -0,0 +1,10 @@
+module T25109 where
+
+data R = R { fld :: Int }
+
+foo :: R -> IO ()
+foo r = case fld r of
+ !i -> print i
+
+main :: IO ()
+main = foo (R 1)
=====================================
testsuite/tests/ghci.debugger/scripts/T25109.script
=====================================
@@ -0,0 +1,7 @@
+:l T25109.hs
+:break foo
+main
+:step
+:step
+:step
+:step
=====================================
testsuite/tests/ghci.debugger/scripts/T25109.stdout
=====================================
@@ -0,0 +1,15 @@
+Breakpoint 0 activated at T25109.hs:(6,9)-(7,15)
+Stopped in T25109.foo, T25109.hs:(6,9)-(7,15)
+_result :: IO () = _
+r :: R = _
+Stopped in T25109.foo, T25109.hs:6:14-18
+_result :: Int = _
+r :: R = _
+Stopped in T25109.main, T25109.hs:10:13-15
+_result :: R = _
+Stopped in T25109.fld, T25109.hs:3:14-16
+_result :: Int = _
+fld :: Int = 1
+Stopped in T25109.foo, T25109.hs:7:9-15
+_result :: IO () = _
+i :: Int = 1
=====================================
testsuite/tests/ghci.debugger/scripts/all.T
=====================================
@@ -142,3 +142,4 @@ test('break030',
test('T23057', [only_ghci, extra_hc_opts('-fno-break-points')], ghci_script, ['T23057.script'])
test('T24306', normal, ghci_script, ['T24306.script'])
test('T24712', normal, ghci_script, ['T24712.script'])
+test('T25109', normal, ghci_script, ['T25109.script'])
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -9027,15 +9027,6 @@ module GHC.OverloadedLabels where
fromLabel :: a
{-# MINIMAL fromLabel #-}
-module GHC.Pack where
- -- Safety: None
- packCString# :: [GHC.Types.Char] -> GHC.Prim.ByteArray#
- unpackAppendCString# :: GHC.Prim.Addr# -> [GHC.Types.Char] -> [GHC.Types.Char]
- unpackCString :: forall a. GHC.Internal.Ptr.Ptr a -> [GHC.Types.Char]
- unpackCString# :: GHC.Prim.Addr# -> [GHC.Types.Char]
- unpackFoldrCString# :: forall a. GHC.Prim.Addr# -> (GHC.Types.Char -> a -> a) -> a -> a
- unpackNBytes# :: GHC.Prim.Addr# -> GHC.Prim.Int# -> [GHC.Types.Char]
-
module GHC.Profiling where
-- Safety: Safe
requestHeapCensus :: GHC.Types.IO ()
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -12069,15 +12069,6 @@ module GHC.OverloadedLabels where
fromLabel :: a
{-# MINIMAL fromLabel #-}
-module GHC.Pack where
- -- Safety: None
- packCString# :: [GHC.Types.Char] -> GHC.Prim.ByteArray#
- unpackAppendCString# :: GHC.Prim.Addr# -> [GHC.Types.Char] -> [GHC.Types.Char]
- unpackCString :: forall a. GHC.Internal.Ptr.Ptr a -> [GHC.Types.Char]
- unpackCString# :: GHC.Prim.Addr# -> [GHC.Types.Char]
- unpackFoldrCString# :: forall a. GHC.Prim.Addr# -> (GHC.Types.Char -> a -> a) -> a -> a
- unpackNBytes# :: GHC.Prim.Addr# -> GHC.Prim.Int# -> [GHC.Types.Char]
-
module GHC.Profiling where
-- Safety: Safe
requestHeapCensus :: GHC.Types.IO ()
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -9251,15 +9251,6 @@ module GHC.OverloadedLabels where
fromLabel :: a
{-# MINIMAL fromLabel #-}
-module GHC.Pack where
- -- Safety: None
- packCString# :: [GHC.Types.Char] -> GHC.Prim.ByteArray#
- unpackAppendCString# :: GHC.Prim.Addr# -> [GHC.Types.Char] -> [GHC.Types.Char]
- unpackCString :: forall a. GHC.Internal.Ptr.Ptr a -> [GHC.Types.Char]
- unpackCString# :: GHC.Prim.Addr# -> [GHC.Types.Char]
- unpackFoldrCString# :: forall a. GHC.Prim.Addr# -> (GHC.Types.Char -> a -> a) -> a -> a
- unpackNBytes# :: GHC.Prim.Addr# -> GHC.Prim.Int# -> [GHC.Types.Char]
-
module GHC.Profiling where
-- Safety: Safe
requestHeapCensus :: GHC.Types.IO ()
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -9027,15 +9027,6 @@ module GHC.OverloadedLabels where
fromLabel :: a
{-# MINIMAL fromLabel #-}
-module GHC.Pack where
- -- Safety: None
- packCString# :: [GHC.Types.Char] -> GHC.Prim.ByteArray#
- unpackAppendCString# :: GHC.Prim.Addr# -> [GHC.Types.Char] -> [GHC.Types.Char]
- unpackCString :: forall a. GHC.Internal.Ptr.Ptr a -> [GHC.Types.Char]
- unpackCString# :: GHC.Prim.Addr# -> [GHC.Types.Char]
- unpackFoldrCString# :: forall a. GHC.Prim.Addr# -> (GHC.Types.Char -> a -> a) -> a -> a
- unpackNBytes# :: GHC.Prim.Addr# -> GHC.Prim.Int# -> [GHC.Types.Char]
-
module GHC.Profiling where
-- Safety: Safe
requestHeapCensus :: GHC.Types.IO ()
=====================================
utils/haddock/CHANGES.md
=====================================
@@ -5,6 +5,8 @@
* Fix large margin on top of small headings
+ * Include `package_info` with haddock's `--show-interface` option.
+
## Changes in 2.28.0
* `hi-haddock` is integrated, which means docstrings are no longer extracted
through typchecked module results. Instead, docstrings are taken from Haskell
=====================================
utils/haddock/doc/common-errors.rst
=====================================
@@ -4,7 +4,8 @@ Common Errors
``parse error on input ‘-- | xxx’``
-----------------------------------
-This is probably caused by the ``-- | xxx`` comment not following a declaration. I.e. use ``-- xxx`` instead. See :ref:`top-level-declaration`.
+This is probably caused by the ``-- | xxx`` comment not being **before** a
+declaration, see :ref:`top-level-declaration`.
``parse error on input ‘-- $ xxx’``
-----------------------------------
=====================================
utils/haddock/doc/markup.rst
=====================================
@@ -13,27 +13,26 @@ modules being processed.
Documenting a Top-Level Declaration
-----------------------------------
-The simplest example of a documentation annotation is for documenting
-any top-level declaration (function type signature, type declaration, or
-class declaration). For example, if the source file contains the
-following type signature: ::
+A Haddock documentation annotation is a comment that begins with ``-- |`` or
+``-- ^``. Seen as ordinary comments, these are ignored by the Haskell compiler.
- square :: Int -> Int
- square x = x * x
+We can document top-level declarations, such as ``square``, by **adding** a ``--
+|`` comment **before** the declaration or a ``-- ^`` comment **after** the
+declaration (each shown as a diff).
-Then we can document it like this: ::
+.. code-block:: diff
- -- |The 'square' function squares an integer.
- square :: Int -> Int
- square x = x * x
+ + -- |The 'square' function squares an integer.
+ square :: Int -> Int
+ square x = x * x
-The ``-- |`` syntax begins a documentation annotation, which applies
-to the *following* declaration in the source file. Note that the
-annotation is just a comment in Haskell — it will be ignored by the
-Haskell compiler.
+.. code-block:: diff
-The declaration following a documentation annotation should be one of
-the following:
+ square :: Int -> Int
+ + -- ^The 'square' function squares an integer.
+ square x = x * x
+
+These annotations can document declarations that are:
- A type signature for a top-level function,
@@ -55,15 +54,7 @@ the following:
- A ``data instance`` or ``type instance`` declaration.
-If the annotation is followed by a different kind of declaration, it
-will probably be ignored by Haddock.
-
-Some people like to write their documentation *after* the declaration;
-this is possible in Haddock too: ::
-
- square :: Int -> Int
- -- ^The 'square' function squares an integer.
- square x = x * x
+Other kinds of declaration will probably be ignored by Haddock.
Since Haddock uses the GHC API internally, it can infer types for
top-level functions without type signatures. However, you're
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Json.hs
=====================================
@@ -21,7 +21,8 @@ import Haddock.Types
jsonInterfaceFile :: InterfaceFile -> JsonDoc
jsonInterfaceFile InterfaceFile{..} =
jsonObject
- [ ("link_env", jsonMap nameStableString (jsonString . moduleNameString . moduleName) ifLinkEnv)
+ [ ("package_info", jsonPackageInfo ifPackageInfo)
+ , ("link_env", jsonMap nameStableString (jsonString . moduleNameString . moduleName) ifLinkEnv)
, ("inst_ifaces", jsonArray (map jsonInstalledInterface ifInstalledIfaces))
]
@@ -53,6 +54,9 @@ jsonHaddockModInfo HaddockModInfo{..} =
, ("extensions", jsonArray (map (jsonString . show) hmi_extensions))
]
+jsonPackageInfo :: PackageInfo -> JsonDoc
+jsonPackageInfo = jsonString . ppPackageInfo
+
jsonMap :: (a -> String) -> (b -> JsonDoc) -> Map a b -> JsonDoc
jsonMap f g = jsonObject . map (f *** g) . Map.toList
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4f08f0deab670a754def90f80060246df9d85df6...b750f94d66da349970511ab02269695f42de68db
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4f08f0deab670a754def90f80060246df9d85df6...b750f94d66da349970511ab02269695f42de68db
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240821/ce9cc841/attachment-0001.html>
More information about the ghc-commits
mailing list