@@ -0,0 +1,219 @@
1+commit 43b4a6c9a6af630ae701b4c8e8f58e45b7d571bb
2+Author: Shea Levy <shea@shealevy.com>
3+Date: Sun Apr 24 23:10:11 2022 -0400
5+ Backport !7377: external static plugins
7+ https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7377
9+diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
10+index 2ea0b3d5e9..587fef29ff 100644
11+--- a/compiler/main/DynFlags.hs
12++++ b/compiler/main/DynFlags.hs
13+@@ -282,7 +282,7 @@ import Settings
16+ import Foreign.C ( CInt(..) )
17+-import System.IO.Unsafe ( unsafeDupablePerformIO )
18++import System.IO.Unsafe ( unsafeDupablePerformIO, unsafePerformIO )
19+ import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn
20+ , getCaretDiagnostic )
22+@@ -2011,7 +2011,7 @@ defaultDynFlags mySettings llvmConfig =
23+ pluginModNameOpts = [],
24+ frontendPluginOpts = [],
27++ staticPlugins = unsafePerformIO initStaticPlugins,
30+ outputFile = Nothing,
31+diff --git a/compiler/main/Plugins.hs b/compiler/main/Plugins.hs
32+index 25e69c15e5..5028b617bb 100644
33+--- a/compiler/main/Plugins.hs
34++++ b/compiler/main/Plugins.hs
36+ {-# LANGUAGE RankNTypes #-}
37++{-# LANGUAGE LambdaCase #-}
38++{-# LANGUAGE BlockArguments #-}
39++{-# LANGUAGE UnboxedTuples #-}
40++{-# LANGUAGE MagicHash #-}
43+ -- | Definitions for writing /plugins/ for GHC. Plugins can hook into
44+@@ -45,6 +49,7 @@ module Plugins (
45+ , LoadedPlugin(..), lpModuleName
47+ , mapPlugins, withPlugins, withPlugins_
52+@@ -61,13 +66,22 @@ import DriverPhases
53+ import Module ( ModuleName, Module(moduleName))
55+ import Data.List (sort)
56+-import Outputable (Outputable(..), text, (<+>))
60+ --Qualified import so we can define a Semigroup instance
61+ -- but it doesn't clash with Outputable.<>
62+ import qualified Data.Semigroup
65++import Text.Read (readMaybe)
67++import qualified System.Environment as Env
68++#if defined(HAVE_INTERNAL_INTERPRETER)
70++import GHC.Exts (addrToAny#, Ptr(..))
74+ -- | Command line options gathered from the -PModule.Name:stuff syntax
75+ -- are given to you as this type
76+@@ -262,3 +276,126 @@ data FrontendPlugin = FrontendPlugin {
78+ defaultFrontendPlugin :: FrontendPlugin
79+ defaultFrontendPlugin = FrontendPlugin { frontend = \_ _ -> return () }
82++-- Note [External Static Plugins]
83++-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
84++-- GHC supports two kinds of "static" plugins:
85++-- 1. internal: setup with GHC-API
86++-- 2. external: setup as explained below and loaded from shared libraries
88++-- External static plugins can be configured with the GHC_PLUGINS global
89++-- environment variable. Its syntax corresponds to the Read instance of
90++-- [(FilePath,String,String,[String])]
91++-- that is a list of (library path, unit-id, module name, plugin arguments)
94++-- GHC_PLUGINS='[(".../myplugin.so","my-plugin-unit","ZiPlugin.Plugin",["Arg1","Arg3"])]'
96++-- Building the plugin library:
97++-- 1. link with the libraries used to build the compiler you target. If you
98++-- target a cross-compiler (stage2), you can't directly use it to build the
99++-- plugin library. Use the stage1 compiler instead.
101++-- 2. if you use cabal to build the library, its unit-id will be set by cabal
102++-- and will contain a hash (e.g. "my-plugin-unit-1345656546ABCDEF"). To force
103++-- the unit id, use GHC's `-this-unit-id` command line flag:
104++-- e.g. -this-unit-id my-plugin-unit
105++-- You can set this in the .cabal file of your library with the following
106++-- stanza: `ghc-options: -this-unit-id my-plugin-unit`
108++-- 3. To make your plugin easier to distribute, you may want to link it
109++-- statically with all its dependencies. You would need to use `-shared`
110++-- without `-dynamic` when building your library.
112++-- However, all the static dependencies have to be built with `-fPIC` and it's
113++-- not done by default. See
114++-- https://www.hobson.space/posts/haskell-foreign-library/ for a way to modify
115++-- the compiler to do it.
117++-- In any case, don't link your plugin library statically with the RTS (e.g.
118++-- use `-fno-link-rts`) as there are some global variables in the RTS that must
119++-- be shared between the plugin and the compiler.
121++-- With external static plugins we don't check the type of the `plugin` closure
122++-- we look up. If it's not a valid `Plugin` value, it will probably crash badly.
125++-- * support configuration via command-line flags
126++-- * support search paths for the plugin library
129++initStaticPlugins :: IO [StaticPlugin]
130++initStaticPlugins = do
131++ -- detect static plugins in environment variables
132++ Env.lookupEnv "GHC_PLUGINS" >>= \case
133++ Nothing -> return []
134++ Just str -> case parseExternalStaticPlugins str of
135++ Nothing -> panic "Couldn't parse `GHC_PLUGINS` environment variable"
136++ Just [] -> return []
137++ Just ps -> initExternalStaticPlugins ps
139++-- | Parse external static plugin description string
141++-- E.g. '[(".../myplugin.so","my-plugin-unit","ZiPlugin.Plugin",["Arg1","Arg3"])]'
142++parseExternalStaticPlugins :: String -> Maybe [ExternalStaticPlugin]
143++parseExternalStaticPlugins s = fmap (fmap to) (readMaybe s)
145++ to :: (FilePath,String,String,[String]) -> ExternalStaticPlugin
146++ to (path,unit_id,mod_name,args) = ExternalStaticPlugin
148++ , esp_unit_id = unit_id
149++ , esp_module = mod_name
154++data ExternalStaticPlugin = ExternalStaticPlugin
155++ { esp_lib :: !FilePath
156++ , esp_unit_id :: !String
157++ , esp_module :: !String
158++ , esp_args :: ![String]
161++initExternalStaticPlugins :: [ExternalStaticPlugin] -> IO [StaticPlugin]
162++initExternalStaticPlugins _ps = do
163++#if !defined(HAVE_INTERNAL_INTERPRETER)
164++ panic "initExternalStaticPlugins: can't load external static plugins with GHC built without internal interpreter"
165++#elif !defined(CAN_LOAD_DLL)
166++ panic "initExternalStaticPlugins: loading shared libraries isn't supported by this compiler"
168++ initObjLinker RetainCAFs
169++ forM _ps \(ExternalStaticPlugin path unit mod_name opts) -> do
170++ let ztmp = zEncodeString mod_name ++ "_plugin_closure"
173++ | otherwise = zEncodeString unit ++ "_" ++ ztmp
174++ plugin <- loadPluginLib path symbol
175++ pure $ StaticPlugin (PluginWithArgs plugin opts)
178++loadPluginLib :: FilePath -> String -> IO Plugin
179++loadPluginLib path symbol_name = do
181++ loadDLL path >>= \case
182++ Just errmsg -> pprPanic "loadPluginLib"
183++ (vcat [ text "Can't load plugin library"
184++ , text " Library path: " <> text path
185++ , text " Error : " <> text errmsg
189++ resolveObjs >>= \case
191++ False -> pprPanic "loadPluginLib" (text "Unable to resolve objects")
194++ lookupSymbol symbol_name >>= \case
195++ Nothing -> pprPanic "loadPluginLib"
196++ (vcat [ text "Symbol not found"
197++ , text " Library path: " <> text path
198++ , text " Symbol : " <> text symbol_name
200++ Just (Ptr addr) -> case addrToAny# addr of
203+diff --git a/compiler/main/Plugins.hs-boot b/compiler/main/Plugins.hs-boot
204+index c90c6ebaf7..1a26ad4e71 100644
205+--- a/compiler/main/Plugins.hs-boot
206++++ b/compiler/main/Plugins.hs-boot
208+ -- exposed without importing all of its implementation.
209+ module Plugins where
211+-import GhcPrelude ()
212++import GhcPrelude (IO)
219++initStaticPlugins :: IO [StaticPlugin]