ilyakooo0/haskell.nix
1
0
Fork 0
mirror of https://github.com/ilyakooo0/haskell.nix.git synced 2024-09-11 06:55:40 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'external-static-8.10.4'

Browse Source 
Add external static plugins patch to Plutus GHC
This commit is contained in:
Shea Levy 2022-05-03 13:38:16 -04:00
commit d82e4c0e24
No known key found for this signature in database
GPG Key ID: 5C0BD6957D86FE27
18 changed files with 386 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
builder/comp-builder.nix
View File

@ -236,6 +236,7 @@ let
shellWrappers = ghcForComponent {
componentName = fullName;
inherit configFiles enableDWARF;
inherit (component) plugins;
};
# In order to let shell hooks make package-specific things like Hoogle databases

75
builder/ghc-for-component-wrapper.nix
View File

@ -13,6 +13,7 @@
, configFiles # The component's "config" derivation
, postInstall ? ""
, enableDWARF
, plugins
}:
let
@ -37,31 +38,70 @@ in runCommand "${componentName}-${ghc.name}-env" {
''
. ${makeWrapper}/nix-support/setup-hook
# Start with a ghc...
''
# Start with a ghc and remove all of the package directories
+ ''
mkdir -p $out/bin
${lndir}/bin/lndir -silent ${ghc} $out
# ... remove all of the package directories
rm -rf ${libDir}/*/
# ... but retain the lib/ghc/bin directory. This contains `unlit' and friends.
''
# ... but retain the lib/ghc/bin directory. This contains `unlit' and friends.
+ ''
ln -s ${ghc}/lib/${ghcCommand}-${ghc.version}/bin ${libDir}
# ... and the ghcjs shim's if they are available ...
''
# ... and the ghcjs shim's if they are available ...
+ ''
if [ -d ${ghc}/lib/${ghcCommand}-${ghc.version}/shims ]; then
ln -s ${ghc}/lib/${ghcCommand}-${ghc.version}/shims ${libDir}
fi
# ... and node modules ...
''
# ... and node modules ...
+ ''
if [ -d ${ghc}/lib/${ghcCommand}-${ghc.version}/ghcjs-node ]; then
ln -s ${ghc}/lib/${ghcCommand}-${ghc.version}/ghcjs-node ${libDir}
fi
# Replace the package database with the one from target package config.
''
# Replace the package database with the one from target package config.
+ ''
ln -s ${configFiles}/${packageCfgDir} $out/${packageCfgDir}
# now the tricky bit. For GHCJS (to make plugins work), we need a special
# file called ghc_libdir. That points to the build ghc's lib.
''
# Set the GHC_PLUGINS environment variable according to the plugins for the component.
# GHC will automatically load the relevant symbols from the given libraries and
# initialize them with the given arguments.
#
# GHC_PLUGINS is a `read`able [(FilePath,String,String,[String])], where the
# first component is a path to the shared library, the second is the package ID,
# the third is the module name, and the fourth is the plugin arguments.
+ ''
GHC_PLUGINS="["
LIST_PREFIX=""
${builtins.concatStringsSep "\n" (map (plugin: ''
id=$(${ghc}/bin/ghc-pkg --package-db ${plugin.library}/package.conf.d field ${plugin.library.package.identifier.name} id --simple-output)
lib_dir=$(${ghc}/bin/ghc-pkg --package-db ${plugin.library}/package.conf.d field ${plugin.library.package.identifier.name} dynamic-library-dirs --simple-output)
lib_base=$(${ghc}/bin/ghc-pkg --package-db ${plugin.library}/package.conf.d field ${plugin.library.package.identifier.name} hs-libraries --simple-output)
lib="$(echo ''${lib_dir}/lib''${lib_base}*)"
GHC_PLUGINS="''${GHC_PLUGINS}''${LIST_PREFIX}(\"''${lib}\",\"''${id}\",\"${plugin.moduleName}\",["
LIST_PREFIX=""
${builtins.concatStringsSep "\n" (map (arg: ''
GHC_PLUGINS="''${GHC_PLUGINS}''${LIST_PREFIX}\"${arg}\""
LIST_PREFIX=","
'') plugin.args)}
GHC_PLUGINS="''${GHC_PLUGINS}])"
LIST_PREFIX=","
'') plugins)}
GHC_PLUGINS="''${GHC_PLUGINS}]"
''
# now the tricky bit. For GHCJS (to make plugins work), we need a special
# file called ghc_libdir. That points to the build ghc's lib.
+ ''
echo "${ghc.buildGHC or ghc}/lib/${(ghc.buildGHC or ghc).name}" > "${libDir}/ghc_libdir"
# Wrap compiler executables with correct env variables.
# The NIX_ variables are used by the patched Paths_ghc module.
''
# Wrap compiler executables with correct env variables.
# The NIX_ variables are used by the patched Paths_ghc module.
+ ''
for prg in ${ghcCommand} ${ghcCommand}i ${ghcCommand}-${ghc.version} ${ghcCommand}i-${ghc.version}; do
if [[ -x "${ghc}/bin/$prg" ]]; then
rm -f $out/bin/$prg
@ -70,6 +110,7 @@ in runCommand "${componentName}-${ghc.name}-env" {
--set "NIX_${ghcCommandCaps}" "$out/bin/${ghcCommand}" \
--set "NIX_${ghcCommandCaps}PKG" "$out/bin/${ghcCommand}-pkg" \
--set "NIX_${ghcCommandCaps}_DOCDIR" "${docDir}" \
--set "GHC_PLUGINS" "$GHC_PLUGINS" \
--set "NIX_${ghcCommandCaps}_LIBDIR" "${libDir}"
fi
done
@ -82,11 +123,14 @@ in runCommand "${componentName}-${ghc.name}-env" {
--set "NIX_${ghcCommandCaps}" "$out/bin/${ghcCommand}" \
--set "NIX_${ghcCommandCaps}PKG" "$out/bin/${ghcCommand}-pkg" \
--set "NIX_${ghcCommandCaps}_DOCDIR" "${docDir}" \
--set "GHC_PLUGINS" "$GHC_PLUGINS" \
--set "NIX_${ghcCommandCaps}_LIBDIR" "${libDir}"
fi
done
# Wrap haddock, if the base GHC provides it.
''
# Wrap haddock, if the base GHC provides it.
+ ''
if [[ -x "${haddock}/bin/haddock" ]]; then
rm -f $out/bin/haddock
makeWrapper ${haddock}/bin/haddock $out/bin/haddock \
@ -94,9 +138,10 @@ in runCommand "${componentName}-${ghc.name}-env" {
--set "NIX_${ghcCommandCaps}_LIBDIR" "${libDir}"
fi
# Point ghc-pkg to the package database of the component using the
# --global-package-db flag.
''
# Point ghc-pkg to the package database of the component using the
# --global-package-db flag.
+ ''
for prg in ${ghcCommand}-pkg ${ghcCommand}-pkg-${ghc.version}; do
if [[ -x "${ghc}/bin/$prg" ]]; then
rm -f $out/bin/$prg

1
builder/haddock-builder.nix
View File

@ -56,6 +56,7 @@ let
componentName = fullName;
configFiles = docsConfigFiles;
inherit (componentDrv) enableDWARF;
inherit (component) plugins;
};
drv = stdenv.mkDerivation (commonAttrs // {

1
builder/shell-for.nix
View File

@ -113,6 +113,7 @@ let
ln -s ${hoogleIndex}/bin/hoogle $out/bin
'';
inherit enableDWARF;
plugins = [];
};
hoogleIndex = let

4
ci.nix
View File

@ -41,7 +41,7 @@
ghc902 = true;
ghc921 = false;
ghc922 = true;
ghc810420210212 = false;
ghc810420210212 = true;
});
systems = nixpkgsName: nixpkgs: compiler-nix-name: nixpkgs.lib.genAttrs (
nixpkgs.lib.filter (v:
@ -63,7 +63,7 @@
|| (system == "x86_64-darwin" && __elem compiler-nix-name ["ghc8107"]))) {
inherit (lib.systems.examples) ghcjs;
} // lib.optionalAttrs (system == "x86_64-linux" &&
nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc8107"])) {
nixpkgsName == "unstable" && (__elem compiler-nix-name ["ghc810420210212" "ghc8107"])) {
# Windows cross compilation is currently broken on macOS
inherit (lib.systems.examples) mingwW64;
} // lib.optionalAttrs (system == "x86_64-linux" && nixpkgsName == "unstable" && compiler-nix-name == "ghc8107") {

17
modules/package.nix
View File

@ -31,6 +31,23 @@ let
type = bool;
default = true;
};
plugins = mkOption {
type = listOf (submodule {
options = {
library = mkOption {
type = unspecified;
};
moduleName = mkOption {
type = str;
};
args = mkOption {
type = listOf str;
default = [];
};
};
});
default = [];
};
depends = mkOption {
type = listOfFilteringNulls unspecified;
default = [];

2
overlays/bootstrap.nix
View File

@ -644,7 +644,7 @@ in {
sha256 = "03li4k10hxgyxcdyyz2092wx09spr1599hi0sxbh4m889qdqgbsj";
};
ghc-patches = ghc-patches "8.10.4"
++ [ ./patches/ghc/core-field.patch ];
++ [ ./patches/ghc/core-field.patch ./patches/ghc/external-static-8.10.4.patch ];
# Avoid clashes with normal ghc8104
ghc-version = "8.10.4.20210212";

219
overlays/patches/ghc/external-static-8.10.4.patch Normal file
View File

@ -0,0 +1,219 @@
commit 43b4a6c9a6af630ae701b4c8e8f58e45b7d571bb
Author: Shea Levy <shea@shealevy.com>
Date: Sun Apr 24 23:10:11 2022 -0400
Backport !7377: external static plugins
https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7377
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 2ea0b3d5e9..587fef29ff 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -282,7 +282,7 @@ import Settings
import ToolSettings
import Foreign.C ( CInt(..) )
-import System.IO.Unsafe ( unsafeDupablePerformIO )
+import System.IO.Unsafe ( unsafeDupablePerformIO, unsafePerformIO )
import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn
, getCaretDiagnostic )
import Json
@@ -2011,7 +2011,7 @@ defaultDynFlags mySettings llvmConfig =
pluginModNameOpts = [],
frontendPluginOpts = [],
cachedPlugins = [],
- staticPlugins = [],
+ staticPlugins = unsafePerformIO initStaticPlugins,
hooks = emptyHooks,
outputFile = Nothing,
diff --git a/compiler/main/Plugins.hs b/compiler/main/Plugins.hs
index 25e69c15e5..5028b617bb 100644
--- a/compiler/main/Plugins.hs
+++ b/compiler/main/Plugins.hs
@@ -1,4 +1,8 @@
{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE MagicHash #-}
{-# LANGUAGE CPP #-}
-- | Definitions for writing /plugins/ for GHC. Plugins can hook into
@@ -45,6 +49,7 @@ module Plugins (
, LoadedPlugin(..), lpModuleName
, StaticPlugin(..)
, mapPlugins, withPlugins, withPlugins_
+ , initStaticPlugins
) where
import GhcPrelude
@@ -61,13 +66,22 @@ import DriverPhases
import Module ( ModuleName, Module(moduleName))
import Fingerprint
import Data.List (sort)
-import Outputable (Outputable(..), text, (<+>))
+import Outputable
+import Panic
--Qualified import so we can define a Semigroup instance
-- but it doesn't clash with Outputable.<>
import qualified Data.Semigroup
import Control.Monad
+import Text.Read (readMaybe)
+
+import qualified System.Environment as Env
+#if defined(HAVE_INTERNAL_INTERPRETER)
+import GHCi.ObjLink
+import GHC.Exts (addrToAny#, Ptr(..))
+import Encoding
+#endif
-- | Command line options gathered from the -PModule.Name:stuff syntax
-- are given to you as this type
@@ -262,3 +276,126 @@ data FrontendPlugin = FrontendPlugin {
}
defaultFrontendPlugin :: FrontendPlugin
defaultFrontendPlugin = FrontendPlugin { frontend = \_ _ -> return () }
+
+
+-- Note [External Static Plugins]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- GHC supports two kinds of "static" plugins:
+-- 1. internal: setup with GHC-API
+-- 2. external: setup as explained below and loaded from shared libraries
+--
+-- External static plugins can be configured with the GHC_PLUGINS global
+-- environment variable. Its syntax corresponds to the Read instance of
+-- [(FilePath,String,String,[String])]
+-- that is a list of (library path, unit-id, module name, plugin arguments)
+--
+-- Example:
+-- GHC_PLUGINS='[(".../myplugin.so","my-plugin-unit","ZiPlugin.Plugin",["Arg1","Arg3"])]'
+--
+-- Building the plugin library:
+-- 1. link with the libraries used to build the compiler you target. If you
+-- target a cross-compiler (stage2), you can't directly use it to build the
+-- plugin library. Use the stage1 compiler instead.
+--
+-- 2. if you use cabal to build the library, its unit-id will be set by cabal
+-- and will contain a hash (e.g. "my-plugin-unit-1345656546ABCDEF"). To force
+-- the unit id, use GHC's `-this-unit-id` command line flag:
+-- e.g. -this-unit-id my-plugin-unit
+-- You can set this in the .cabal file of your library with the following
+-- stanza: `ghc-options: -this-unit-id my-plugin-unit`
+--
+-- 3. To make your plugin easier to distribute, you may want to link it
+-- statically with all its dependencies. You would need to use `-shared`
+-- without `-dynamic` when building your library.
+--
+-- However, all the static dependencies have to be built with `-fPIC` and it's
+-- not done by default. See
+-- https://www.hobson.space/posts/haskell-foreign-library/ for a way to modify
+-- the compiler to do it.
+--
+-- In any case, don't link your plugin library statically with the RTS (e.g.
+-- use `-fno-link-rts`) as there are some global variables in the RTS that must
+-- be shared between the plugin and the compiler.
+--
+-- With external static plugins we don't check the type of the `plugin` closure
+-- we look up. If it's not a valid `Plugin` value, it will probably crash badly.
+--
+-- TODO:
+-- * support configuration via command-line flags
+-- * support search paths for the plugin library
+
+
+initStaticPlugins :: IO [StaticPlugin]
+initStaticPlugins = do
+ -- detect static plugins in environment variables
+ Env.lookupEnv "GHC_PLUGINS" >>= \case
+ Nothing -> return []
+ Just str -> case parseExternalStaticPlugins str of
+ Nothing -> panic "Couldn't parse `GHC_PLUGINS` environment variable"
+ Just [] -> return []
+ Just ps -> initExternalStaticPlugins ps
+
+-- | Parse external static plugin description string
+--
+-- E.g. '[(".../myplugin.so","my-plugin-unit","ZiPlugin.Plugin",["Arg1","Arg3"])]'
+parseExternalStaticPlugins :: String -> Maybe [ExternalStaticPlugin]
+parseExternalStaticPlugins s = fmap (fmap to) (readMaybe s)
+ where
+ to :: (FilePath,String,String,[String]) -> ExternalStaticPlugin
+ to (path,unit_id,mod_name,args) = ExternalStaticPlugin
+ { esp_lib = path
+ , esp_unit_id = unit_id
+ , esp_module = mod_name
+ , esp_args = args
+ }
+
+
+data ExternalStaticPlugin = ExternalStaticPlugin
+ { esp_lib :: !FilePath
+ , esp_unit_id :: !String
+ , esp_module :: !String
+ , esp_args :: ![String]
+ }
+
+initExternalStaticPlugins :: [ExternalStaticPlugin] -> IO [StaticPlugin]
+initExternalStaticPlugins _ps = do
+#if !defined(HAVE_INTERNAL_INTERPRETER)
+ panic "initExternalStaticPlugins: can't load external static plugins with GHC built without internal interpreter"
+#elif !defined(CAN_LOAD_DLL)
+ panic "initExternalStaticPlugins: loading shared libraries isn't supported by this compiler"
+#else
+ initObjLinker RetainCAFs
+ forM _ps \(ExternalStaticPlugin path unit mod_name opts) -> do
+ let ztmp = zEncodeString mod_name ++ "_plugin_closure"
+ symbol
+ | null unit = ztmp
+ | otherwise = zEncodeString unit ++ "_" ++ ztmp
+ plugin <- loadPluginLib path symbol
+ pure $ StaticPlugin (PluginWithArgs plugin opts)
+
+
+loadPluginLib :: FilePath -> String -> IO Plugin
+loadPluginLib path symbol_name = do
+ -- load library
+ loadDLL path >>= \case
+ Just errmsg -> pprPanic "loadPluginLib"
+ (vcat [ text "Can't load plugin library"
+ , text " Library path: " <> text path
+ , text " Error : " <> text errmsg
+ ])
+ Nothing -> do
+ -- resolve objects
+ resolveObjs >>= \case
+ True -> return ()
+ False -> pprPanic "loadPluginLib" (text "Unable to resolve objects")
+
+ -- lookup symbol
+ lookupSymbol symbol_name >>= \case
+ Nothing -> pprPanic "loadPluginLib"
+ (vcat [ text "Symbol not found"
+ , text " Library path: " <> text path
+ , text " Symbol : " <> text symbol_name
+ ])
+ Just (Ptr addr) -> case addrToAny# addr of
+ (# a #) -> pure a
+#endif
diff --git a/compiler/main/Plugins.hs-boot b/compiler/main/Plugins.hs-boot
index c90c6ebaf7..1a26ad4e71 100644
--- a/compiler/main/Plugins.hs-boot
+++ b/compiler/main/Plugins.hs-boot
@@ -2,9 +2,11 @@
-- exposed without importing all of its implementation.
module Plugins where
-import GhcPrelude ()
+import GhcPrelude (IO)
data Plugin
data LoadedPlugin
data StaticPlugin
+
+initStaticPlugins :: IO [StaticPlugin]

1
test/default.nix
View File

@ -203,6 +203,7 @@ let
githash = haskell-nix.callPackage ./githash { inherit compiler-nix-name; testSrc = testSrcWithGitDir; };
c-ffi = callTest ./c-ffi { inherit util compiler-nix-name; };
th-dlls = callTest ./th-dlls { inherit util compiler-nix-name; };
external-static-plugin = callTest ./external-static-plugin { inherit compiler-nix-name; };
unit = unitTests;
};

1
test/external-static-plugin/cabal.project Normal file
View File

@ -0,0 +1 @@
packages: ./**/*.cabal

27
test/external-static-plugin/default.nix Normal file
View File

@ -0,0 +1,27 @@
{ cabalProject', testSrc, compiler-nix-name, recurseIntoAttrs, haskellLib }: let
project = cabalProject' {
src = testSrc "external-static-plugin";
inherit compiler-nix-name;
modules = [ {
packages.prog.components.exes.prog.plugins = [ {
inherit (project.hsPkgs.plugin.components) library;
moduleName = "Plugin";
args = [ "f1" "f2" ];
} ];
packages.prog.postInstall = ''
test -f f1
test -f f2
'';
} ];
};
in recurseIntoAttrs {
ifdInputs = {
inherit (project) plan-nix;
};
meta.disabled = !(builtins.elem compiler-nix-name [
"ghc810420210212"
]) || haskellLib.isCrossHost;
build = project.hsPkgs.prog.components.exes.prog;
}

5
test/external-static-plugin/plugin/CHANGELOG.md Normal file
View File

@ -0,0 +1,5 @@
# Revision history for plugin
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

12
test/external-static-plugin/plugin/plugin.cabal Normal file
View File

@ -0,0 +1,12 @@
cabal-version: 2.4
name: plugin
version: 0.1.0.0
author: Shea Levy
maintainer: shea@shealevy.com
extra-source-files: CHANGELOG.md
library
exposed-modules: Plugin
build-depends: base, ghc
hs-source-dirs: src
default-language: Haskell2010

16
test/external-static-plugin/plugin/src/Plugin.hs Normal file
View File

@ -0,0 +1,16 @@
module Plugin (plugin) where
import GhcPlugins
import MonadUtils
import System.IO
import Control.Monad
plugin :: Plugin
plugin = defaultPlugin
{ installCoreToDos = install
}
install :: CorePlugin
install files passes = do
liftIO . forM files $ flip writeFile ""
pure passes

5
test/external-static-plugin/prog/CHANGELOG.md Normal file
View File

@ -0,0 +1,5 @@
# Revision history for prog
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

4
test/external-static-plugin/prog/app/Main.hs Normal file
View File

@ -0,0 +1,4 @@
module Main where
main :: IO ()
main = putStrLn "Hello, Haskell!"

12
test/external-static-plugin/prog/prog.cabal Normal file
View File

@ -0,0 +1,12 @@
cabal-version: 2.4
name: prog
version: 0.1.0.0
author: Shea Levy
maintainer: shea@shealevy.com
extra-source-files: CHANGELOG.md
executable prog
main-is: Main.hs
build-depends: base
hs-source-dirs: app
default-language: Haskell2010

2
test/haskell-language-server/stack.nix
View File

@ -22,5 +22,5 @@ in recurseIntoAttrs {
build = project.hsPkgs.haskell-language-server.components.exes.haskell-language-server;
# Haskell Language Server does not build for GHC 9 or 8.10.7 yet
meta.disabled = __elem compiler-nix-name ["ghc922" "ghc921" "ghc901" "ghc902" "ghc8107"];
meta.disabled = __elem compiler-nix-name ["ghc922" "ghc921" "ghc901" "ghc902" "ghc8107" "ghc810420210212" ];
}