[Git][ghc/ghc][wip/torsten.schmits/T25211-foreign-objects-interpreter-way] 5 commits: rts: win32: emit additional debugging information

Torsten Schmits (@torsten.schmits) gitlab at gitlab.haskell.org
Thu Aug 29 13:10:24 UTC 2024



Torsten Schmits pushed to branch wip/torsten.schmits/T25211-foreign-objects-interpreter-way 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

- - - - -
3a5bebf8 by Matthew Pickering at 2024-08-28T14:16:42-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

- - - - -
c2525e9e by Ryan Scott at 2024-08-28T14:17:17-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.

- - - - -
2c402655 by Torsten Schmits at 2024-08-29T15:10:10+02:00
Build foreign objects for TH with interpreter's way when loading from iface

Fixes #25211

When linking bytecode for TH from interface core bindings with
`-fprefer-byte-code`, foreign sources are loaded from the interface as
well and compiled to object code in an ad-hoc manner.

The results are then loaded by the interpreter, whose way may differ
from the current build's target way.

This patch ensures that foreign objects are compiled with the
interpreter's way.

- - - - -


13 changed files:

- compiler/GHC/Driver/Main.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Demand.hs
- compiler/GHC/Unit/Module/WholeCoreBindings.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/Driver/Main.hs
=====================================
@@ -1,5 +1,4 @@
 {-# LANGUAGE LambdaCase #-}
-
 {-# LANGUAGE NondecreasingIndentation #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiWayIf #-}
@@ -295,13 +294,13 @@ import Data.Time
 
 import System.IO.Unsafe ( unsafeInterleaveIO )
 import GHC.Iface.Env ( trace_if )
+import GHC.Platform.Ways
 import GHC.Stg.InferTags.TagSig (seqTagSig)
 import GHC.StgToCmm.Utils (IPEStats)
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.DFM
 import GHC.Cmm.Config (CmmConfig)
 
-
 {- **********************************************************************
 %*                                                                      *
                 Initialisation
@@ -990,6 +989,27 @@ initModDetails hsc_env iface =
     -- in make mode, since this HMI will go into the HPT.
     genModDetails hsc_env' iface
 
+-- | Modify flags such that objects are compiled for the interpreter's way.
+-- This is necessary when building foreign objects for Template Haskell, since
+-- those are object code built outside of the pipeline, which means they aren't
+-- subject to the mechanism in 'enableCodeGenWhen' that requests dynamic build
+-- outputs for dependencies when the interpreter used for TH is dynamic but the
+-- main outputs aren't.
+-- Furthermore, the HPT only stores one set of objects with different names for
+-- bytecode linking in 'HomeModLinkable', so the usual hack for switching
+-- between ways in 'get_link_deps' doesn't work.
+compile_for_interpreter :: HscEnv -> (HscEnv -> IO a) -> IO a
+compile_for_interpreter hsc_env use =
+  use (hscUpdateFlags update hsc_env)
+  where
+    update dflags = dflags {
+      targetWays_ = adapt_way interpreterDynamic WayDyn $
+                    adapt_way interpreterProfiled WayProf $
+                    targetWays_ dflags
+      }
+
+    adapt_way want = if want (hscInterp hsc_env) then addWay else removeWay
+
 -- | If the 'Linkable' contains Core bindings loaded from an interface, replace
 -- them with a lazy IO thunk that compiles them to bytecode and foreign objects.
 --
@@ -2063,9 +2083,10 @@ generateByteCode :: HscEnv
   -> IO (CompiledByteCode, [FilePath])
 generateByteCode hsc_env cgguts mod_location = do
   (hasStub, comp_bc) <- hscInteractive hsc_env cgguts mod_location
-  stub_o <- traverse (compileForeign hsc_env LangC) hasStub
-  foreign_files_o <- traverse (uncurry (compileForeign hsc_env)) (cgi_foreign_files cgguts)
-  pure (comp_bc, maybeToList stub_o ++ foreign_files_o)
+  compile_for_interpreter hsc_env $ \ i_env -> do
+    stub_o <- traverse (compileForeign i_env LangC) hasStub
+    foreign_files_o <- traverse (uncurry (compileForeign i_env)) (cgi_foreign_files cgguts)
+    pure (comp_bc, maybeToList stub_o ++ foreign_files_o)
 
 generateFreshByteCode :: HscEnv
   -> ModuleName


=====================================
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)


=====================================
compiler/GHC/Unit/Module/WholeCoreBindings.hs
=====================================
@@ -190,13 +190,9 @@ Even if that wasn't an issue, they are compiled for the session's 'Way', not its
 associated module's, so the dynamic variant wouldn't be available when building
 only static outputs.
 
-For now, this doesn't have much of an impact, since we're only supporting
-foreign imports initially, which produce very simple objects that can easily be
-handled by the linker when 'GHC.Linker.Loader.dynLoadObjs' creates a shared
-library from all object file inputs.
-However, for more complex circumstances, we should compile foreign stubs
-specially for TH according to the interpreter 'Way', or request dynamic products
-for TH dependencies like it happens for the conventional case.
+To mitigate this, we instead build foreign objects specially for the
+interpreter, updating the build flags in 'compile_for_interpreter' to use the
+interpreter's way.
 
 Problem 4:
 


=====================================
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/2534dfe579f33b7240337e8095a350c075a54b28...2c402655553be97e8bc80d621f97b3eaf911a48a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2534dfe579f33b7240337e8095a350c075a54b28...2c402655553be97e8bc80d621f97b3eaf911a48a
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/20240829/f7a04ae8/attachment-0001.html>


More information about the ghc-commits mailing list