[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: rts: win32: emit additional debugging information
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Aug 28 13:26:41 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
63a27091 by doyougnu at 2024-08-26T20:39:30-04:00
rts: win32: emit additional debugging information
-- migration from haskell.nix
- - - - -
aaab3d10 by Vladislav Zavialov at 2024-08-26T20:40:06-04:00
Only export defaults when NamedDefaults are enabled (#25206)
This is a reinterpretation of GHC Proposal #409 that avoids a breaking
change introduced in fa0dbaca6c "Implements the Exportable Named Default proposal"
Consider a module M that has no explicit export list:
module M where
default (Rational)
Should it export the default (Rational)?
The proposal says "yes", and there's a test case for that:
default/DefaultImport04.hs
However, as it turns out, this change in behavior breaks existing
programs, e.g. the colour-2.3.6 package can no longer be compiled,
as reported in #25206.
In this patch, we make implicit exports of defaults conditional on
the NamedDefaults extension. This fix is unintrusive and compliant
with the existing proposal text (i.e. it does not require a proposal
amendment). Should the proposal be amended, we can go for a simpler
solution, such as requiring all defaults to be exported explicitly.
Test case: testsuite/tests/default/T25206.hs
- - - - -
41041eb7 by Matthew Pickering at 2024-08-28T09:26:34-04:00
simplifier: Fix space leak during demand analysis
The lazy structure (a list) in a strict field in `DmdType` is not fully
forced which leads to a very large thunk build-up.
It seems there is likely still more work to be done here as it seems we
may be trading space usage for work done. For now, this is the right
choice as rather than using all the memory on my computer, compilation
just takes a little bit longer.
See #25196
- - - - -
9c0ddce1 by Ryan Scott at 2024-08-28T09:26:34-04:00
Add missing parenthesizeHsType in cvtp's InvisP case
We need to ensure that when we convert an `InvisP` (invisible type pattern) to
a `Pat`, we parenthesize it (at precedence `appPrec`) so that patterns such as
`@(a :: k)` will parse correctly when roundtripped back through the parser.
Fixes #25209.
- - - - -
11 changed files:
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Demand.hs
- rts/linker/PEi386.c
- + testsuite/tests/default/T25206.hs
- + testsuite/tests/default/T25206.stderr
- + testsuite/tests/default/T25206_helper.hs
- testsuite/tests/default/all.T
- + testsuite/tests/th/T25209.hs
- + testsuite/tests/th/T25209.stderr
- testsuite/tests/th/all.T
Changes:
=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -237,7 +237,15 @@ rnExports explicit_mod exports
Nothing -> Nothing
Just _ -> map drop_defaults <$> rn_exports
, tcg_default_exports = case exports of
- Nothing -> filterDefaultEnv ((Just this_mod ==) . cd_module) defaults
+ Nothing ->
+ if xopt LangExt.NamedDefaults dflags then
+ -- NamedDefaults on: implicitly export the defaults declared in this module.
+ -- Test case: default/DefaultImport04.hs
+ filterDefaultEnv ((Just this_mod ==) . cd_module) defaults
+ else
+ -- NamedDefaults off: do not export any defaults (fixes #25206).
+ -- Test case: default/T25206.hs
+ emptyDefaultEnv
_ -> foldMap (foldMap sndOf3) rn_exports
, tcg_dus = tcg_dus tcg_env `plusDU`
usesOnly final_ns
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1519,7 +1519,7 @@ cvtp (ViewP e p) = do { e' <- cvtl e; p' <- cvtPat p
; wrapParLA gParPat $ ViewPat noAnn e' p'}
cvtp (TypeP t) = do { t' <- cvtType t
; return $ EmbTyPat noAnn (mkHsTyPat t') }
-cvtp (InvisP t) = do { t' <- cvtType t
+cvtp (InvisP t) = do { t' <- parenthesizeHsType appPrec <$> cvtType t
; pure (InvisPat noAnn (mkHsTyPat t'))}
cvtp (OrP ps) = do { ps' <- cvtPats ps
; pure (OrPat noExtField ps')}
=====================================
compiler/GHC/Types/Demand.hs
=====================================
@@ -1913,7 +1913,7 @@ multDmdType :: Card -> DmdType -> DmdType
multDmdType n (DmdType fv args)
= -- pprTrace "multDmdType" (ppr n $$ ppr fv $$ ppr (multDmdEnv n fv)) $
DmdType (multDmdEnv n fv)
- (map (multDmd n) args)
+ (strictMap (multDmd n) args)
peelFV :: DmdType -> Var -> (DmdType, Demand)
peelFV (DmdType fv ds) id = -- pprTrace "rfv" (ppr id <+> ppr dmd $$ ppr fv)
=====================================
rts/linker/PEi386.c
=====================================
@@ -456,10 +456,12 @@ static OpenedDLL* opened_dlls = NULL;
/* Adds a DLL instance to the list of DLLs in which to search for symbols. */
static void addDLLHandle(pathchar* dll_name, HINSTANCE instance) {
+ IF_DEBUG(linker, debugBelch("addDLLHandle(%" PATH_FMT ")...\n", dll_name));
/* At this point, we actually know what was loaded.
So bail out if it's already been loaded. */
if (checkIfDllLoaded(instance))
{
+ IF_DEBUG(linker, debugBelch("already loaded: addDLLHandle(%" PATH_FMT ")\n", dll_name));
return;
}
@@ -505,6 +507,7 @@ static void addDLLHandle(pathchar* dll_name, HINSTANCE instance) {
stgFree(module);
imports++;
} while (imports->Name);
+ IF_DEBUG(linker, debugBelch("done: addDLLHandle(%" PATH_FMT ")\n", dll_name));
}
static OpenedDLL* findLoadedDll(HINSTANCE instance)
=====================================
testsuite/tests/default/T25206.hs
=====================================
@@ -0,0 +1,7 @@
+module T25206 where
+
+import T25206_helper ()
+
+mod1 x = pf
+ where
+ (_,pf) = properFraction x
=====================================
testsuite/tests/default/T25206.stderr
=====================================
@@ -0,0 +1,2 @@
+[1 of 2] Compiling T25206_helper ( T25206_helper.hs, T25206_helper.o )
+[2 of 2] Compiling T25206 ( T25206.hs, T25206.o )
=====================================
testsuite/tests/default/T25206_helper.hs
=====================================
@@ -0,0 +1,3 @@
+module T25206_helper where
+
+default (Rational)
=====================================
testsuite/tests/default/all.T
=====================================
@@ -30,3 +30,4 @@ test('default-fail05', normal, compile_fail, [''])
test('default-fail06', normal, compile_fail, [''])
test('default-fail07', normal, compile_fail, [''])
test('default-fail08', normal, compile_fail, [''])
+test('T25206', [extra_files(['T25206_helper.hs'])], multimod_compile, ['T25206', ''])
=====================================
testsuite/tests/th/T25209.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeAbstractions #-}
+module T25209 where
+
+import Data.Proxy
+
+$([d| f :: Proxy a -> Proxy a
+ f @(a :: k) p = p
+ |])
=====================================
testsuite/tests/th/T25209.stderr
=====================================
@@ -0,0 +1,6 @@
+T25209.hs:(7,2)-(9,7): Splicing declarations
+ [d| f :: Proxy a -> Proxy a
+ f @(a :: k) p = p |]
+ ======>
+ f :: Proxy a -> Proxy a
+ f @(a :: k) p = p
=====================================
testsuite/tests/th/all.T
=====================================
@@ -622,4 +622,5 @@ test('T24572a', normal, compile, [''])
test('T24572b', normal, compile_fail, [''])
test('T24572c', normal, compile_fail, [''])
test('T24572d', normal, compile, [''])
+test('T25209', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('TH_MultilineStrings', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06d5abc370f4b55d7c94288b4b4ac2e883aa3ee1...9c0ddce1eab8e4bbb8117328911cac63ae67a9ba
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/06d5abc370f4b55d7c94288b4b4ac2e883aa3ee1...9c0ddce1eab8e4bbb8117328911cac63ae67a9ba
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/20240828/3824750d/attachment-0001.html>
More information about the ghc-commits
mailing list