[arch-commits] Commit in ihaskell/trunk (enable-dynamic-way.patch)

[Felix Yan]

    Date: Thursday, August 25, 2022 @ 12:34:26
  Author: felixonmars
Revision: 1278483

upgpkg: ihaskell 0.10.2.2-1

Added:
  ihaskell/trunk/enable-dynamic-way.patch

--------------------------+
 enable-dynamic-way.patch |   92 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 92 insertions(+)

Added: enable-dynamic-way.patch
===================================================================
--- enable-dynamic-way.patch	                        (rev 0)
+++ enable-dynamic-way.patch	2022-08-25 12:34:26 UTC (rev 1278483)
@@ -0,0 +1,92 @@
+commit d03b9eb85f7a32683806f0bb1e29fac856a451e1
+Author: Martin Reboredo <yakoyoku at gmail.com>
+Date:   Tue Jul 19 18:05:17 2022 -0300
+
+    Dynamic way for dynamically linked RTS
+
+diff --git a/src/IHaskell/Eval/Util.hs b/src/IHaskell/Eval/Util.hs
+index dea936d..f2579f0 100644
+--- a/src/IHaskell/Eval/Util.hs
++++ b/src/IHaskell/Eval/Util.hs
+@@ -9,6 +9,7 @@ module IHaskell.Eval.Util (
+     setExtension,
+     ExtFlag(..),
+     setFlags,
++    setWayDynFlag,
+ 
+     -- * Code Evaluation
+     evalImport,
+@@ -42,6 +43,7 @@ import           GHC.Driver.Monad (modifySession)
+ import           GHC.Driver.Ppr
+ import           GHC.Driver.Session
+ import           GHC.Driver.Env.Types
++import           GHC.Platform.Ways (Way(..), hostIsDynamic)
+ import           GHC.Runtime.Context
+ import           GHC.Types.Name (pprInfixName)
+ import           GHC.Types.Name.Set
+@@ -58,6 +60,7 @@ import           GHC.Driver.CmdLine
+ import           GHC.Driver.Monad (modifySession)
+ import           GHC.Driver.Session
+ import           GHC.Driver.Types
++import           GHC.Driver.Ways (Way(..), hostIsDynamic)
+ import           GHC.Types.Name (pprInfixName)
+ import           GHC.Types.Name.Set
+ import qualified GHC.Driver.Session as DynFlags
+@@ -119,6 +122,24 @@ extensionFlag ext =
+     -- Check if a FlagSpec matches "No<ExtensionName>". In that case, we disable the extension.
+     flagMatchesNo ex fs = ex == "No" ++ flagSpecName fs
+ 
++-- | Consult the RTS to find if GHC has been built with dynamic linking and then turn on the
++-- dynamic way for GHC. Otherwise it does nothing.
++setWayDynFlag :: DynFlags
++              -> DynFlags
++setWayDynFlag =
++  if hostIsDynamic
++  then addWay WayDyn
++  else id
++#if MIN_VERSION_ghc(9,2,0)
++#else
++  where
++    addWay = addWay'
++#if MIN_VERSION_ghc(9,0,0)
++#else
++    hostIsDynamic = dynamicGhc
++#endif
++#endif
++
+ -- | Pretty-print dynamic flags (taken from 'InteractiveUI' module of `ghc-bin`)
+ pprDynFlags :: Bool       -- ^ Whether to include flags which are on by default
+             -> DynFlags
+@@ -332,7 +353,7 @@ initGhci sandboxPackages = do
+ #endif
+   let flag = flip xopt_set
+       unflag = flip xopt_unset
+-      dflags = flag ExtendedDefaultRules . unflag MonomorphismRestriction $ originalFlags
++      dflags = flag ExtendedDefaultRules . unflag MonomorphismRestriction $ setWayDynFlag originalFlags
+ #if MIN_VERSION_ghc(8,2,0)
+       pkgFlags =
+         case sandboxPackages of
+diff --git a/src/tests/IHaskell/Test/Completion.hs b/src/tests/IHaskell/Test/Completion.hs
+index e70629e..8892bf2 100644
+--- a/src/tests/IHaskell/Test/Completion.hs
++++ b/src/tests/IHaskell/Test/Completion.hs
+@@ -30,6 +30,7 @@ import           Shelly (toTextIgnore, (</>), shelly, fromText, get_env_text, Fi
+ import           IHaskell.Eval.Evaluate (Interpreter, liftIO)
+ import           IHaskell.Eval.Completion (complete, CompletionType(..), completionType,
+                                            completionTarget)
++import           IHaskell.Eval.Util (setWayDynFlag)
+ import           IHaskell.Test.Util (replace, shouldBeAmong, ghc)
+ 
+ -- | @readCompletePrompt "xs*ys"@ return @(xs, i)@ where i is the location of
+@@ -67,9 +68,9 @@ initCompleter :: Interpreter ()
+ initCompleter = do
+   flags <- getSessionDynFlags
+ #if MIN_VERSION_ghc(9,2,0)
+-  _ <- setSessionDynFlags $ flags { backend = Interpreter, ghcLink = LinkInMemory }
++  _ <- setSessionDynFlags $ setWayDynFlag flags { backend = Interpreter, ghcLink = LinkInMemory }
+ #else
+-  _ <- setSessionDynFlags $ flags { hscTarget = HscInterpreted, ghcLink = LinkInMemory }
++  _ <- setSessionDynFlags $ setWayDynFlag flags { hscTarget = HscInterpreted, ghcLink = LinkInMemory }
+ #endif
+ 
+   -- Import modules.