hadrian: Introduce `static` flavour

5 files changed, 94 insertions, 2 deletions

diff --git a/hadrian/doc/flavours.md b/hadrian/doc/flavours.md
index d88122ea3f..0f2af1bbf5 100644
--- a/hadrian/doc/flavours.md
+++ b/hadrian/doc/flavours.md
@@ -154,6 +154,17 @@ when compiling the `compiler` library, and `hsGhc` when compiling/linking the GH
     <td>-O</td>
     <td>-O</td>
   </tr>
+  <tr>
+    <th>static</td>
+    <td>-O<br>-H64m<br>-fPIC -static</td>
+    <td>-O<br>-H64m<br>-fPIC -static</td>
+    <td></td>
+    <td>-O2</td>
+    <td>-O2</td>
+    <td>-O2</td>
+    <td>-O<br>-optl -static</td>
+    <td>-O2<br>-optl -static</td>
+  </tr>
 </table>
 
 ## Flavour transformers
@@ -231,6 +242,16 @@ The supported transformers are listed below:
     </tr>
 </table>
 
+### Static
+
+The `static` flavour does not strictly follow the groupings in the table
+above because it links all the executables statically, not just GHC
+itself, and because it passes `-optc -static` when delegating to a C
+compiler.  It also adds the `-dynamic-system-linker` cabal flag to the
+`ghc` package build and only adds static flags when building in a
+non-dynamic _way_.  Some of the considerations for a static build aren't
+a great fit for the flavour system, so it's a little bit hacky.
+
 ## Ways
 
 Libraries and GHC can be built in different _ways_, e.g. with or without profiling
@@ -266,6 +287,19 @@ information. The following table lists ways that are built in different flavours
     </td>
 </tr>
 <tr>
+    <th>static</td>
+    <td>vanilla</td>
+    <td>vanilla<br>profiling</td>
+    <td>logging<br>debug<br>threaded<br>threadedDebug<br>threadedLogging
+    </td>
+    <td>
+        logging<br>debug<br>threaded<br>threadedDebug<br>
+        threadedLogging<br>threadedProfiling
+    </td>
+    <td>Only in<br>prof<br>flavour</td>
+    <td>Only in<br>prof<br>flavour</td>
+</tr>
+<tr>
     <th>quick<br>quick-validate<br>quick-debug</th>
     <td>vanilla</td>
     <td>vanilla<br>dynamic</td>
diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal
index aaedeca80c..2df0ef9c30 100644
--- a/hadrian/hadrian.cabal
+++ b/hadrian/hadrian.cabal
@@ -112,6 +112,7 @@ executable hadrian
                        , Settings.Flavours.Quick
                        , Settings.Flavours.QuickCross
                        , Settings.Flavours.Quickest
+                       , Settings.Flavours.Static
                        , Settings.Flavours.Validate
                        , Settings.Packages
                        , Settings.Parser
diff --git a/hadrian/src/Settings.hs b/hadrian/src/Settings.hs
index 8957443cf2..9a6cf16140 100755
--- a/hadrian/src/Settings.hs
+++ b/hadrian/src/Settings.hs
@@ -21,6 +21,7 @@ import Settings.Flavours.Performance
 import Settings.Flavours.Quick
 import Settings.Flavours.Quickest
 import Settings.Flavours.QuickCross
+import Settings.Flavours.Static
 import Settings.Flavours.Validate
 
 
@@ -55,7 +56,8 @@ hadrianFlavours =
     , quickFlavour, quickValidateFlavour, quickDebugFlavour
     , quickestFlavour
     , quickCrossFlavour
-    , ghcInGhciFlavour, validateFlavour, slowValidateFlavour ]
+    , ghcInGhciFlavour, validateFlavour, slowValidateFlavour
+    , staticFlavour ]
 
 -- | This action looks up a flavour with the name given on the
 --   command line with @--flavour@, defaulting to 'userDefaultFlavour'
diff --git a/hadrian/src/Settings/Flavours/Performance.hs b/hadrian/src/Settings/Flavours/Performance.hs
index aee5ddf6ca..fc46920703 100644
--- a/hadrian/src/Settings/Flavours/Performance.hs
+++ b/hadrian/src/Settings/Flavours/Performance.hs
@@ -1,4 +1,4 @@
-module Settings.Flavours.Performance (performanceFlavour) where
+module Settings.Flavours.Performance (performanceFlavour, performanceArgs) where
 
 import Expression
 import Flavour
diff --git a/hadrian/src/Settings/Flavours/Static.hs b/hadrian/src/Settings/Flavours/Static.hs
new file mode 100644
index 0000000000..fc4ba05f92
--- /dev/null
+++ b/hadrian/src/Settings/Flavours/Static.hs
@@ -0,0 +1,55 @@
+module Settings.Flavours.Static (staticFlavour) where
+
+import Expression
+import Flavour
+import Packages
+import {-# SOURCE #-} Settings.Default
+
+import Settings.Flavours.Performance (performanceArgs)
+
+-- Please update doc/flavours.md when changing this file.
+
+-- |Produce statically-linked executables.  Also compiles libraries
+-- suitable for static linking.
+staticFlavour :: Flavour
+staticFlavour = defaultFlavour
+    { name = "static"
+    , args = defaultBuilderArgs <> performanceArgs <> defaultPackageArgs <> staticExec
+    , dynamicGhcPrograms = return False
+    , libraryWays = prune $ libraryWays defaultFlavour
+    , rtsWays = prune $ rtsWays defaultFlavour
+    }
+
+-- Remove any Way that contains a WayUnit of Dynamic
+prune :: Ways -> Ways
+prune = fmap $ filter staticCompatible
+
+staticCompatible :: Way -> Bool
+staticCompatible = not . wayUnit Dynamic
+
+staticExec :: Args
+{- Some packages, especially iserv, seem to force a set of build ways,
+ - including some that are dynamic (in Rules.BinaryDist).  Trying to
+ - build statically and dynamically at the same time breaks the build,
+ - so we respect that overriding of the Ways.  Any code that overrides
+ - the Ways will need to include a Way that's not explicitly dynamic
+ - (like "vanilla").
+ -}
+staticExec = staticCompatible <$> getWay ? mconcat
+    {-
+     - Disable dynamic linking by the built ghc executable because the
+     - statically-linked musl doesn't support dynamic linking, but will
+     - try and fail.
+     -}
+    [ package compiler ? builder (Cabal Flags) ? arg "-dynamic-system-linker"
+    {-
+     - The final executables don't work unless the libraries linked into
+     - it are compiled with "-fPIC."  The PI stands for "position
+     - independent" and generates libraries that work when inlined into
+     - an executable (where their position is not at the beginning of
+     - the file).
+     -}
+    , builder (Ghc CompileHs) ? pure [ "-fPIC", "-static" ]
+    , builder (Ghc CompileCWithGhc) ? pure [ "-fPIC", "-optc", "-static"]
+    , builder (Ghc LinkHs) ? pure [ "-optl", "-static" ]
+    ]