[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 11 commits: Fix #21979 - compact-share failing with -O
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Thu Aug 18 07:23:20 UTC 2022
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
f6a5524a by Andreas Klebinger at 2022-08-16T14:34:11-04:00
Fix #21979 - compact-share failing with -O
I don't have good reason to believe the optimization level should affect
if sharing works or not here. So limit the test to the normal way.
- - - - -
68154a9d by Ben Gamari at 2022-08-16T14:34:47-04:00
users-guide: Fix reference to dead llvm-version substitution
Fixes #22052.
- - - - -
28c60d26 by Ben Gamari at 2022-08-16T14:34:47-04:00
users-guide: Fix incorrect reference to `:extension: role
- - - - -
71102c8f by Ben Gamari at 2022-08-16T14:34:47-04:00
users-guide: Add :ghc-flag: reference
- - - - -
385f420b by Ben Gamari at 2022-08-16T14:34:47-04:00
hadrian: Place manpage in docroot
This relocates it from docs/ to doc/
- - - - -
84598f2e by Ben Gamari at 2022-08-16T14:34:47-04:00
Bump haddock submodule
Includes merge of `main` into `ghc-head` as well as some Haddock users
guide fixes.
- - - - -
59ce787c by Ben Gamari at 2022-08-16T14:34:47-04:00
base: Add changelog entries from ghc-9.2
Closes #21922.
- - - - -
a14e6ae3 by Ben Gamari at 2022-08-16T14:34:47-04:00
relnotes: Add "included libraries" section
As noted in #21988, some users rely on this.
- - - - -
a4212edc by Ben Gamari at 2022-08-16T14:34:47-04:00
users-guide: Rephrase the rewrite rule documentation
Previously the wording was a tad unclear. Fix this.
Closes #21114.
- - - - -
3e493dfd by Peter Becich at 2022-08-17T08:43:21+01:00
Implement Response File support for HPC
This is an improvement to HPC authored by Richard Wallace
(https://github.com/purefn) and myself. I have received permission from
him to attempt to upstream it. This improvement was originally
implemented as a patch to HPC via input-output-hk/haskell.nix:
https://github.com/input-output-hk/haskell.nix/pull/1464
Paraphrasing Richard, HPC currently requires all inputs as command line arguments.
With large projects this can result in an argument list too long error.
I have only seen this error in Nix, but I assume it can occur is a plain Unix environment.
This MR adds the standard response file syntax support to HPC. For
example you can now pass a file to the command line which contains the
arguments.
```
hpc @response_file_1 @response_file_2 ...
The contents of a Response File must have this format:
COMMAND ...
example:
report my_library.tix --include=ModuleA --include=ModuleB
```
Updates hpc submodule
Co-authored-by: Richard Wallace <rwallace at thewallacepack.net>
Fixes #22050
- - - - -
36926cef by Simon Peyton Jones at 2022-08-18T03:22:59-04:00
Be more careful in chooseInferredQuantifiers
This fixes #22065. We were failing to retain a quantifier that
was mentioned in the kind of another retained quantifier.
Easy to fix.
- - - - -
23 changed files:
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Types/Var.hs
- docs/users_guide/9.6.1-notes.rst
- docs/users_guide/exts/gadt_syntax.rst
- docs/users_guide/exts/rewrite_rules.rst
- docs/users_guide/phases.rst
- hadrian/src/Rules/Documentation.hs
- libraries/base/changelog.md
- libraries/ghc-compact/tests/all.T
- libraries/hpc
- + testsuite/tests/partial-sigs/should_compile/T16152.hs
- + testsuite/tests/partial-sigs/should_compile/T16152.stderr
- + testsuite/tests/partial-sigs/should_compile/T22065.hs
- + testsuite/tests/partial-sigs/should_compile/T22065.stderr
- testsuite/tests/partial-sigs/should_compile/all.T
- utils/haddock
- utils/hpc/HpcCombine.hs
- utils/hpc/HpcDraft.hs
- utils/hpc/HpcMarkup.hs
- utils/hpc/HpcOverlay.hs
- utils/hpc/HpcReport.hs
- utils/hpc/HpcShowTix.hs
- utils/hpc/Main.hs
Changes:
=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -43,6 +43,7 @@ import GHC.Tc.Solver
import GHC.Tc.Types.Evidence
import GHC.Tc.Types.Constraint
import GHC.Core.Predicate
+import GHC.Core.TyCo.Ppr( pprTyVars )
import GHC.Tc.Gen.HsType
import GHC.Tc.Gen.Pat
import GHC.Tc.Utils.TcMType
@@ -59,7 +60,7 @@ import GHC.Types.SourceText
import GHC.Types.Id
import GHC.Types.Var as Var
import GHC.Types.Var.Set
-import GHC.Types.Var.Env( TidyEnv )
+import GHC.Types.Var.Env( TidyEnv, TyVarEnv, mkVarEnv, lookupVarEnv )
import GHC.Unit.Module
import GHC.Types.Name
import GHC.Types.Name.Set
@@ -934,7 +935,8 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs
; let psig_qtvs = map binderVar psig_qtv_bndrs
psig_qtv_set = mkVarSet psig_qtvs
psig_qtv_prs = psig_qtv_nms `zip` psig_qtvs
-
+ psig_bndr_map :: TyVarEnv InvisTVBinder
+ psig_bndr_map = mkVarEnv [ (binderVar tvb, tvb) | tvb <- psig_qtv_bndrs ]
-- Check whether the quantified variables of the
-- partial signature have been unified together
@@ -950,32 +952,35 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs
; annotated_theta <- zonkTcTypes annotated_theta
; (free_tvs, my_theta) <- choose_psig_context psig_qtv_set annotated_theta wcx
+ -- NB: free_tvs includes tau_tvs
+
+ ; let (_,final_qtvs) = foldr (choose_qtv psig_bndr_map) (free_tvs, []) qtvs
+ -- Pulling from qtvs maintains original order
+ -- NB: qtvs is already in dependency order
- ; let keep_me = free_tvs `unionVarSet` psig_qtv_set
- final_qtvs = [ mkTyVarBinder vis tv
- | tv <- qtvs -- Pulling from qtvs maintains original order
- , tv `elemVarSet` keep_me
- , let vis = case lookupVarBndr tv psig_qtv_bndrs of
- Just spec -> spec
- Nothing -> InferredSpec ]
+ ; traceTc "chooseInferredQuantifiers" $
+ vcat [ text "qtvs" <+> pprTyVars qtvs
+ , text "psig_qtv_bndrs" <+> ppr psig_qtv_bndrs
+ , text "free_tvs" <+> ppr free_tvs
+ , text "final_tvs" <+> ppr final_qtvs ]
; return (final_qtvs, my_theta) }
where
- report_dup_tyvar_tv_err (n1,n2)
- = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty)
-
- report_mono_sig_tv_err (n,tv)
- = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty)
- where
- m_unif_ty = listToMaybe
- [ rhs
- -- recall that residuals are always implications
- | residual_implic <- bagToList $ wc_impl residual
- , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic)
- , let residual_pred = ctPred residual_ct
- , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ]
- , Just lhs_tv <- [ tcGetTyVar_maybe lhs ]
- , lhs_tv == tv ]
+ choose_qtv :: TyVarEnv InvisTVBinder -> TcTyVar
+ -> (TcTyVarSet, [InvisTVBinder]) -> (TcTyVarSet, [InvisTVBinder])
+ -- Pick which of the original qtvs should be retained
+ -- Keep it if (a) it is mentioned in the body of the type (free_tvs)
+ -- (b) it is a forall'd variable of the partial signature (psig_qtv_bndrs)
+ -- (c) it is mentioned in the kind of a retained qtv (#22065)
+ choose_qtv psig_bndr_map tv (free_tvs, qtvs)
+ | Just psig_bndr <- lookupVarEnv psig_bndr_map tv
+ = (free_tvs', psig_bndr : qtvs)
+ | tv `elemVarSet` free_tvs
+ = (free_tvs', mkTyVarBinder InferredSpec tv : qtvs)
+ | otherwise -- Do not pick it
+ = (free_tvs, qtvs)
+ where
+ free_tvs' = free_tvs `unionVarSet` tyCoVarsOfType (tyVarKind tv)
choose_psig_context :: VarSet -> TcThetaType -> Maybe TcType
-> TcM (VarSet, TcThetaType)
@@ -1019,6 +1024,22 @@ chooseInferredQuantifiers residual inferred_theta tau_tvs qtvs
-- Return (annotated_theta ++ diff_theta)
-- See Note [Extra-constraints wildcards]
+ report_dup_tyvar_tv_err (n1,n2)
+ = addErrTc (TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty)
+
+ report_mono_sig_tv_err (n,tv)
+ = addErrTc (TcRnPartialTypeSigBadQuantifier n fn_name m_unif_ty hs_ty)
+ where
+ m_unif_ty = listToMaybe
+ [ rhs
+ -- recall that residuals are always implications
+ | residual_implic <- bagToList $ wc_impl residual
+ , residual_ct <- bagToList $ wc_simple (ic_wanted residual_implic)
+ , let residual_pred = ctPred residual_ct
+ , Just (Nominal, lhs, rhs) <- [ getEqPredTys_maybe residual_pred ]
+ , Just lhs_tv <- [ tcGetTyVar_maybe lhs ]
+ , lhs_tv == tv ]
+
mk_ctuple preds = mkBoxedTupleTy preds
-- Hack alert! See GHC.Tc.Gen.HsType:
-- Note [Extra-constraint holes in partial type signatures]
=====================================
compiler/GHC/Types/Var.hs
=====================================
@@ -79,7 +79,7 @@ module GHC.Types.Var (
mkTyVarBinder, mkTyVarBinders,
isTyVarBinder,
tyVarSpecToBinder, tyVarSpecToBinders, tyVarReqToBinder, tyVarReqToBinders,
- mapVarBndr, mapVarBndrs, lookupVarBndr,
+ mapVarBndr, mapVarBndrs,
-- ** Constructing TyVar's
mkTyVar, mkTcTyVar,
@@ -696,11 +696,6 @@ mapVarBndr f (Bndr v fl) = Bndr (f v) fl
mapVarBndrs :: (var -> var') -> [VarBndr var flag] -> [VarBndr var' flag]
mapVarBndrs f = map (mapVarBndr f)
-lookupVarBndr :: Eq var => var -> [VarBndr var flag] -> Maybe flag
-lookupVarBndr var bndrs = lookup var zipped_bndrs
- where
- zipped_bndrs = map (\(Bndr v f) -> (v,f)) bndrs
-
instance Outputable tv => Outputable (VarBndr tv ArgFlag) where
ppr (Bndr v Required) = ppr v
ppr (Bndr v Specified) = char '@' <> ppr v
=====================================
docs/users_guide/9.6.1-notes.rst
=====================================
@@ -87,3 +87,50 @@ Compiler
``ghc-heap`` library
~~~~~~~~~~~~~~~~~~~~
+
+
+Included libraries
+------------------
+
+The package database provided with this distribution also contains a number of
+packages other than GHC itself. See the changelogs provided with these packages
+for further change information.
+
+.. ghc-package-list::
+
+ libraries/array/array.cabal: Dependency of ``ghc`` library
+ libraries/base/base.cabal: Core library
+ libraries/binary/binary.cabal: Dependency of ``ghc`` library
+ libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library
+ libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library
+ libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library
+ libraries/directory/directory.cabal: Dependency of ``ghc`` library
+ libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library
+ libraries/filepath/filepath.cabal: Dependency of ``ghc`` library
+ compiler/ghc.cabal: The compiler itself
+ libraries/ghci/ghci.cabal: The REPL interface
+ libraries/ghc-boot/ghc-boot.cabal: Internal compiler library
+ libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library
+ libraries/ghc-compact/ghc-compact.cabal: Core library
+ libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library
+ libraries/ghc-prim/ghc-prim.cabal: Core library
+ libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable
+ libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable
+ libraries/integer-gmp/integer-gmp.cabal: Core library
+ libraries/libiserv/libiserv.cabal: Internal compiler library
+ libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library
+ libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library
+ libraries/pretty/pretty.cabal: Dependency of ``ghc`` library
+ libraries/process/process.cabal: Dependency of ``ghc`` library
+ libraries/stm/stm.cabal: Dependency of ``haskeline`` library
+ libraries/template-haskell/template-haskell.cabal: Core library
+ libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library
+ libraries/text/text.cabal: Dependency of ``Cabal`` library
+ libraries/time/time.cabal: Dependency of ``ghc`` library
+ libraries/transformers/transformers.cabal: Dependency of ``ghc`` library
+ libraries/unix/unix.cabal: Dependency of ``ghc`` library
+ libraries/Win32/Win32.cabal: Dependency of ``ghc`` library
+ libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable
+
=====================================
docs/users_guide/exts/gadt_syntax.rst
=====================================
@@ -6,7 +6,7 @@ Declaring data types with explicit constructor signatures
.. extension:: GADTSyntax
:shortdesc: Enable generalised algebraic data type syntax.
- :implied by: :extensions:`GADTs`
+ :implied by: :extension:`GADTs`
:since: 7.2.1
:status: Included in :extension:`GHC2021`
=====================================
docs/users_guide/exts/rewrite_rules.rst
=====================================
@@ -438,8 +438,8 @@ earlier versions of GHC. For example, suppose that: ::
where ``intLookup`` is an implementation of ``genericLookup`` that works
very fast for keys of type ``Int``. You might wish to tell GHC to use
``intLookup`` instead of ``genericLookup`` whenever the latter was
-called with type ``Table Int b -> Int -> b``. It used to be possible to
-write ::
+called with type ``Table Int b -> Int -> b``. It used to be possible to write a
+:pragma:`SPECIALIZE` pragma with a right-hand-side: ::
{-# SPECIALIZE genericLookup :: Table Int b -> Int -> b = intLookup #-}
=====================================
docs/users_guide/phases.rst
=====================================
@@ -467,7 +467,7 @@ defined by your local GHC installation, the following trick is useful:
.. index::
single: __GLASGOW_HASKELL_LLVM__
- Only defined when ``-fllvm`` is specified. When GHC is using version
+ Only defined when `:ghc-flag:`-fllvm` is specified. When GHC is using version
``x.y.z`` of LLVM, the value of ``__GLASGOW_HASKELL_LLVM__`` is the
integer ⟨xyy⟩ (if ⟨y⟩ is a single digit, then a leading zero
is added, so for example when using version 3.7 of LLVM,
@@ -614,8 +614,8 @@ Options affecting code generation
.. note::
- Note that this GHC release expects an LLVM version in the |llvm-version|
- release series.
+ Note that this GHC release expects an LLVM version between |llvm-version-min|
+ and |llvm-version-max|.
.. ghc-flag:: -fno-code
:shortdesc: Omit code generation
=====================================
hadrian/src/Rules/Documentation.hs
=====================================
@@ -41,7 +41,7 @@ archiveRoot :: FilePath
archiveRoot = docRoot -/- "archives"
manPageBuildPath :: FilePath
-manPageBuildPath = "docs/users_guide/build-man/ghc.1"
+manPageBuildPath = docRoot -/- "users_guide/build-man/ghc.1"
-- TODO: Get rid of this hack.
docContext :: Context
=====================================
libraries/base/changelog.md
=====================================
@@ -22,7 +22,7 @@
* `GHC.Conc.Sync.threadLabel` was added, allowing the user to query the label
of a given `ThreadId`.
-## 4.17.0.0 *TBA*
+## 4.17.0.0 *August 2022*
* Add explicitly bidirectional `pattern TypeRep` to `Type.Reflection`.
@@ -66,14 +66,55 @@
A [migration guide](https://github.com/haskell/core-libraries-committee/blob/main/guides/no-monadfail-st-inst.md)
is available.
- * Add functions `traceWith`, `traceShowWith`, `traceEventWith` to
- `Debug.Trace`, per
- [CLC #36](https://github.com/haskell/core-libraries-committee/issues/36).
-
* Re-export `augment` and `build` function from `GHC.List`
* Re-export the `IsList` typeclass from the new `GHC.IsList` module.
+ * There's a new special function ``withDict`` in ``GHC.Exts``: ::
+
+ withDict :: forall {rr :: RuntimeRep} cls meth (r :: TYPE rr). WithDict cls meth => meth -> (cls => r) -> r
+
+ where ``cls`` must be a class containing exactly one method, whose type
+ must be ``meth``.
+
+ This function converts ``meth`` to a type class dictionary.
+ It removes the need for ``unsafeCoerce`` in implementation of reflection
+ libraries. It should be used with care, because it can introduce
+ incoherent instances.
+
+ For example, the ``withTypeable`` function from the
+ ``Type.Reflection`` module can now be defined as: ::
+
+ withTypeable :: forall k (a :: k) rep (r :: TYPE rep). ()
+ => TypeRep a -> (Typeable a => r) -> r
+ withTypeable rep k = withDict @(Typeable a) rep k
+
+ Note that the explicit type application is required, as the call to
+ ``withDict`` would be ambiguous otherwise.
+
+ This replaces the old ``GHC.Exts.magicDict``, which required
+ an intermediate data type and was less reliable.
+
+ * `Data.Word.Word64` and `Data.Int.Int64` are now always represented by
+ `Word64#` and `Int64#`, respectively. Previously on 32-bit platforms these
+ were rather represented by `Word#` and `Int#`. See GHC #11953.
+
+## 4.16.3.0 *May 2022*
+
+ * Shipped with GHC 9.2.4
+
+ * winio: make consoleReadNonBlocking not wait for any events at all.
+
+ * winio: Add support to console handles to handleToHANDLE
+
+## 4.16.2.0 *May 2022*
+
+ * Shipped with GHC 9.2.2
+
+ * Export GHC.Event.Internal on Windows (#21245)
+
+ # Documentation Fixes
+
## 4.16.1.0 *Feb 2022*
* Shipped with GHC 9.2.2
@@ -498,7 +539,7 @@
in constant space when applied to lists. (#10830)
* `mkFunTy`, `mkAppTy`, and `mkTyConApp` from `Data.Typeable` no longer exist.
- This functionality is superseded by the interfaces provided by
+ This functionality is superceded by the interfaces provided by
`Type.Reflection`.
* `mkTyCon3` is no longer exported by `Data.Typeable`. This function is
=====================================
libraries/ghc-compact/tests/all.T
=====================================
@@ -16,8 +16,8 @@ test('compact_pinned', exit_code(1), compile_and_run, [''])
test('compact_gc', [fragile_for(17253, ['ghci']), ignore_stdout], compile_and_run, [''])
# this test computes closure sizes and those are affected
# by the ghci and prof ways, because of BCOs and profiling headers.
-test('compact_share', omit_ways(['ghci', 'profasm', 'profthreaded']),
- compile_and_run, [''])
+# Optimization levels slightly change what is/isn't shared so only run in normal mode
+test('compact_share', only_ways(['normal']), compile_and_run, [''])
test('compact_bench', [ ignore_stdout, extra_run_opts('100') ],
compile_and_run, [''])
test('T17044', normal, compile_and_run, [''])
=====================================
libraries/hpc
=====================================
@@ -1 +1 @@
-Subproject commit 7d400662546a262b64af49b5707db22e20b8b9d9
+Subproject commit 76d1a0473d405e194d0c92a1cbeb6c019bbb57cd
=====================================
testsuite/tests/partial-sigs/should_compile/T16152.hs
=====================================
@@ -0,0 +1,8 @@
+{-# Language PartialTypeSignatures #-}
+{-# Language PolyKinds #-}
+{-# Language ScopedTypeVariables #-}
+
+module T16152 where
+
+top :: forall f. _
+top = undefined
=====================================
testsuite/tests/partial-sigs/should_compile/T16152.stderr
=====================================
@@ -0,0 +1,7 @@
+
+T16152.hs:7:18: warning: [-Wpartial-type-signatures (in -Wdefault)]
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of top :: w
+ at T16152.hs:8:1-15
+ • In the type signature: top :: forall f. _
=====================================
testsuite/tests/partial-sigs/should_compile/T22065.hs
=====================================
@@ -0,0 +1,30 @@
+{-# Options_GHC -dcore-lint #-}
+{-# Language PartialTypeSignatures #-}
+
+module T22065 where
+
+data Foo where
+ Apply :: (x -> Int) -> x -> Foo
+
+foo :: Foo
+foo = Apply f x :: forall a. _ where
+
+ f :: [_] -> Int
+ f = length @[] @_
+
+ x :: [_]
+ x = mempty @[_]
+
+{-
+Smaller version I used when debuggging
+
+apply :: (x->Int) -> x -> Bool
+apply = apply
+
+foo :: Bool
+foo = apply f x :: forall a. _
+ where
+ f = length @[]
+ x = mempty
+
+-}
=====================================
testsuite/tests/partial-sigs/should_compile/T22065.stderr
=====================================
@@ -0,0 +1,53 @@
+
+T22065.hs:10:30: warning: [-Wpartial-type-signatures (in -Wdefault)]
+ • Found type wildcard ‘_’ standing for ‘Foo’
+ • In an expression type signature: forall a. _
+ In the expression: Apply f x :: forall a. _
+ In an equation for ‘foo’:
+ foo
+ = Apply f x :: forall a. _
+ where
+ f :: [_] -> Int
+ f = length @[] @_
+ x :: [_]
+ x = mempty @[_]
+ • Relevant bindings include
+ f :: forall {w}. [w] -> Int (bound at T22065.hs:13:3)
+ x :: forall {w}. [w] (bound at T22065.hs:16:3)
+ foo :: Foo (bound at T22065.hs:10:1)
+
+T22065.hs:12:9: warning: [-Wpartial-type-signatures (in -Wdefault)]
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of f :: [w] -> Int
+ at T22065.hs:13:3-19
+ • In the type ‘[_] -> Int’
+ In the type signature: f :: [_] -> Int
+ In an equation for ‘foo’:
+ foo
+ = Apply f x :: forall a. _
+ where
+ f :: [_] -> Int
+ f = length @[] @_
+ x :: [_]
+ x = mempty @[_]
+ • Relevant bindings include
+ x :: forall {w}. [w] (bound at T22065.hs:16:3)
+ foo :: Foo (bound at T22065.hs:10:1)
+
+T22065.hs:15:9: warning: [-Wpartial-type-signatures (in -Wdefault)]
+ • Found type wildcard ‘_’ standing for ‘w’
+ Where: ‘w’ is a rigid type variable bound by
+ the inferred type of x :: [w]
+ at T22065.hs:16:3-17
+ • In the type ‘[_]’
+ In the type signature: x :: [_]
+ In an equation for ‘foo’:
+ foo
+ = Apply f x :: forall a. _
+ where
+ f :: [_] -> Int
+ f = length @[] @_
+ x :: [_]
+ x = mempty @[_]
+ • Relevant bindings include foo :: Foo (bound at T22065.hs:10:1)
=====================================
testsuite/tests/partial-sigs/should_compile/all.T
=====================================
@@ -105,3 +105,5 @@ test('T20921', normal, compile, [''])
test('T21719', normal, compile, [''])
test('InstanceGivenOverlap3', expect_broken(20076), compile, [''])
test('T21667', normal, compile, [''])
+test('T22065', normal, compile, [''])
+test('T16152', normal, compile, [''])
=====================================
utils/haddock
=====================================
@@ -1 +1 @@
-Subproject commit 4f8a875dec5db8795286a557779f3eb684718be6
+Subproject commit a9a312991e55ab99a8dee36a6747f4fc5d5b7c67
=====================================
utils/hpc/HpcCombine.hs
=====================================
@@ -195,4 +195,3 @@ instance Strict Tix where
instance Strict TixModule where
strict (TixModule m1 p1 i1 t1) =
((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1)
-
=====================================
utils/hpc/HpcDraft.hs
=====================================
@@ -142,4 +142,3 @@ findNotTickedFromTree (Node (_, []) children) = findNotTickedFromList children
findNotTickedFromList :: [MixEntryDom [(BoxLabel,Bool)]] -> [PleaseTick]
findNotTickedFromList = concatMap findNotTickedFromTree
-
=====================================
utils/hpc/HpcMarkup.hs
=====================================
@@ -483,4 +483,3 @@ red,green,yellow :: String
red = "#f20913"
green = "#60de51"
yellow = "yellow"
-
=====================================
utils/hpc/HpcOverlay.hs
=====================================
@@ -155,5 +155,3 @@ addParentToTree path (Node (pos,a) children) =
addParentToList :: [a] -> [MixEntryDom [a]] -> [MixEntryDom ([a],[a])]
addParentToList path nodes = map (addParentToTree path) nodes
-
-
=====================================
utils/hpc/HpcReport.hs
=====================================
@@ -275,5 +275,3 @@ report_options
. resetHpcDirsOpt
. xmlOutputOpt
. verbosityOpt
-
-
=====================================
utils/hpc/HpcShowTix.hs
=====================================
@@ -61,4 +61,3 @@ showtix_main flags (prog:modNames) = do
]
return ()
-
=====================================
utils/hpc/Main.hs
=====================================
@@ -1,10 +1,17 @@
+{-# LANGUAGE ScopedTypeVariables, TupleSections #-}
-- (c) 2007 Andy Gill
-- Main driver for Hpc
+import Control.Monad (forM, forM_, when)
+import Data.Bifunctor (bimap)
+import Data.List (intercalate, partition, uncons)
+import Data.List.NonEmpty (NonEmpty((:|)))
+import Data.Maybe (catMaybes, isJust)
import Data.Version
import System.Environment
import System.Exit
import System.Console.GetOpt
+import System.Directory (doesPathExist)
import HpcFlags
import HpcReport
@@ -16,7 +23,7 @@ import HpcOverlay
import Paths_hpc_bin
helpList :: IO ()
-helpList =
+helpList = do
putStrLn $
"Usage: hpc COMMAND ...\n\n" ++
section "Commands" help ++
@@ -25,6 +32,15 @@ helpList =
section "Coverage Overlays" overlays ++
section "Others" other ++
""
+ putStrLn ""
+ putStrLn "or: hpc @response_file_1 @response_file_2 ..."
+ putStrLn ""
+ putStrLn "The contents of a Response File must have this format:"
+ putStrLn "COMMAND ..."
+ putStrLn ""
+ putStrLn "example:"
+ putStrLn "report my_library.tix --include=ModuleA \\"
+ putStrLn "--include=ModuleB"
where
help = ["help"]
reporting = ["report","markup"]
@@ -47,13 +63,74 @@ section msg cmds = msg ++ ":\n"
dispatch :: [String] -> IO ()
dispatch [] = do
- helpList
- exitWith ExitSuccess
+ helpList
+ exitWith ExitSuccess
dispatch (txt:args0) = do
- case lookup txt hooks' of
- Just plugin -> parse plugin args0
- _ -> parse help_plugin (txt:args0)
+ case lookup txt hooks' of
+ Just plugin -> parse plugin args0
+ _ -> case getResponseFileName txt of
+ Nothing -> parse help_plugin (txt:args0)
+ Just firstResponseFileName -> do
+ let
+ (responseFileNames', nonResponseFileNames) = partitionFileNames args0
+ -- if arguments are combination of Response Files and non-Response Files, exit with error
+ when (length nonResponseFileNames > 0) $ do
+ let
+ putStrLn $ "First argument '" <> txt <> "' is a Response File, " <>
+ "followed by non-Response File(s): '" <> intercalate "', '" nonResponseFileNames <> "'"
+ putStrLn $ "When first argument is a Response File, " <>
+ "all arguments should be Response Files."
+ exitFailure
+ let
+ responseFileNames :: NonEmpty FilePath
+ responseFileNames = firstResponseFileName :| responseFileNames'
+
+ forM_ responseFileNames $ \responseFileName -> do
+ exists <- doesPathExist responseFileName
+ when (not exists) $ do
+ putStrLn $ "Response File '" <> responseFileName <> "' does not exist"
+ exitFailure
+
+ -- read all Response Files
+ responseFileNamesAndText :: NonEmpty (FilePath, String) <-
+ forM responseFileNames $ \responseFileName ->
+ fmap (responseFileName, ) (readFile responseFileName)
+ forM_ responseFileNamesAndText $ \(responseFileName, responseFileText) ->
+ -- parse first word of Response File, which should be a command
+ case uncons $ words responseFileText of
+ Nothing -> do
+ putStrLn $ "Response File '" <> responseFileName <> "' has no command"
+ exitFailure
+ Just (responseFileCommand, args1) -> case lookup responseFileCommand hooks' of
+ -- check command for validity
+ -- It is important than a Response File cannot specify another Response File;
+ -- this is prevented
+ Nothing -> do
+ putStrLn $ "Response File '" <> responseFileName <>
+ "' command '" <> responseFileCommand <> "' invalid"
+ exitFailure
+ Just plugin -> do
+ putStrLn $ "Response File '" <> responseFileName <> "':"
+ parse plugin args1
+
where
+ getResponseFileName :: String -> Maybe FilePath
+ getResponseFileName s = do
+ (firstChar, filename) <- uncons s
+ if firstChar == '@'
+ then pure filename
+ else Nothing
+
+ -- first member of tuple is list of Response File names,
+ -- second member of tuple is list of all other arguments
+ partitionFileNames :: [String] -> ([FilePath], [String])
+ partitionFileNames xs = let
+ hasFileName :: [(String, Maybe FilePath)]
+ hasFileName = fmap (\x -> (x, getResponseFileName x)) xs
+ (fileNames, nonFileNames) :: ([Maybe FilePath], [String]) =
+ bimap (fmap snd) (fmap fst) $ partition (isJust . snd) hasFileName
+ in (catMaybes fileNames, nonFileNames)
+
parse plugin args =
case getOpt Permute (options plugin []) args of
(_,_,errs) | not (null errs)
@@ -66,7 +143,7 @@ dispatch (txt:args0) = do
exitFailure
(o,ns,_) -> do
let flags = final_flags plugin
- $ foldr (.) id o
+ . foldr (.) id o
$ init_flags plugin
implementation plugin flags ns
@@ -112,7 +189,7 @@ help_main _ [] = do
help_main _ (sub_txt:_) = do
case lookup sub_txt hooks' of
Nothing -> do
- putStrLn $ "no such hpc command : " ++ sub_txt
+ putStrLn $ "no such HPC command: " <> sub_txt
exitFailure
Just plugin' -> do
command_usage plugin'
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1993fd7c296a0b43946a18bd98b8457815c5548...36926cef23cc3daa756868488e39e0c386216f76
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e1993fd7c296a0b43946a18bd98b8457815c5548...36926cef23cc3daa756868488e39e0c386216f76
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/20220818/bd249f3d/attachment-0001.html>
More information about the ghc-commits
mailing list