Add Javascript backend

Add JS backend adapted from the GHCJS project by Luite Stegeman.

Some features haven't been ported or implemented yet. Tests for these
features have been disabled with an associated gitlab ticket.

Bump array submodule

Work funded by IOG.

Co-authored-by: Jeffrey Young <jeffrey.young@iohk.io>
Co-authored-by: Luite Stegeman <stegeman@gmail.com>
Co-authored-by: Josh Meredith <joshmeredith2008@gmail.com>

18 files changed, 185 insertions, 57 deletions

diff --git a/hadrian/bindist/config.mk.in b/hadrian/bindist/config.mk.in
index c76c1c9414..ee8366a26f 100644
--- a/hadrian/bindist/config.mk.in
+++ b/hadrian/bindist/config.mk.in
@@ -128,6 +128,8 @@ GhcUnregisterised     = @Unregisterised@
 ifeq "$(TargetArch_CPP)" "arm"
 # We don't support load/store barriers pre-ARMv7. See #10433.
 ArchSupportsSMP=$(if $(filter $(ARM_ISA),ARMv5 ARMv6),NO,YES)
+else ifeq "$(TargetArch_CPP)" "js"
+ArchSupportsSMP=NO
 else
 ArchSupportsSMP=$(strip $(patsubst $(TargetArch_CPP), YES, $(findstring $(TargetArch_CPP), i386 x86_64 sparc powerpc powerpc64 powerpc64le s390x aarch64 riscv64)))
 endif
diff --git a/hadrian/doc/flavours.md b/hadrian/doc/flavours.md
index 8c24f4993c..9aeabcc49d 100644
--- a/hadrian/doc/flavours.md
+++ b/hadrian/doc/flavours.md
@@ -240,6 +240,11 @@ The supported transformers are listed below:
             e.g., loading libraries during TemplateHaskell evaluations.</td>
     </tr>
     <tr>
+        <td><code>no_dynamic_libs</code></td>
+        <td>Just like `no_dynamic_ghc`, this transformer ensures statically-linked libraries
+        </td>
+    </tr>
+    <tr>
         <td><code>no_profiled_libs</code></td>
         <td>Disables building of libraries in profiled build ways.</td>
     </tr>
diff --git a/hadrian/src/Context.hs b/hadrian/src/Context.hs
index b3608657ca..b8fb5fca26 100644
--- a/hadrian/src/Context.hs
+++ b/hadrian/src/Context.hs
@@ -9,7 +9,7 @@ module Context (
     contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, pkgSetupConfigDir,
     pkgHaddockFile, pkgRegisteredLibraryFile, pkgRegisteredLibraryFileName,
     pkgLibraryFile, pkgGhciLibraryFile,
-    pkgConfFile, pkgStampFile, objectPath, contextPath, getContextPath, libPath, distDir,
+    pkgConfFile, pkgStampFile, resourcePath, objectPath, contextPath, getContextPath, libPath, distDir,
     haddockStatsFilesDir
     ) where
 
@@ -163,3 +163,10 @@ objectPath context@Context {..} src = do
                | "*hs*" ?== extension = path -/- obj
                | otherwise            = path -/- extension -/- obj
     return result
+
+
+resourcePath :: Context -> FilePath -> Action FilePath
+resourcePath context src = do
+    path <- buildPath context
+    let extension = drop 1 $ takeExtension src
+    return (path -/- extension -/- src)
diff --git a/hadrian/src/Expression.hs b/hadrian/src/Expression.hs
index 14b08cb0e9..db437013b4 100644
--- a/hadrian/src/Expression.hs
+++ b/hadrian/src/Expression.hs
@@ -9,7 +9,7 @@ module Expression (
 
     -- ** Predicates
     (?), stage, stage0, stage1, stage2, notStage0, threadedBootstrapper,
-     package, notPackage, packageOneOf,
+     package, notPackage, packageOneOf, cross, notCross,
      libraryPackage, builder, way, input, inputs, output, outputs,
 
     -- ** Evaluation
@@ -151,3 +151,9 @@ cabalFlag pred flagName = do
     ifM (toPredicate pred) (arg flagName) (arg $ "-"<>flagName)
 
 infixr 3 `cabalFlag`
+
+cross :: Predicate
+cross = expr (flag CrossCompiling)
+
+notCross :: Predicate
+notCross = notM cross
diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs
index b13cb2f365..58baa7c3a9 100644
--- a/hadrian/src/Flavour.hs
+++ b/hadrian/src/Flavour.hs
@@ -11,9 +11,12 @@ module Flavour
   , viaLlvmBackend
   , enableProfiledGhc
   , disableDynamicGhcPrograms
+  , disableDynamicLibs
   , disableProfiledLibs
   , enableLinting
   , enableHaddock
+  , useNativeBignum
+  , omitPragmas
 
   , completeSetting
   , applySettings
@@ -39,25 +42,27 @@ import Oracles.Setting
 
 flavourTransformers :: Map String (Flavour -> Flavour)
 flavourTransformers = M.fromList
-    [ "werror" =: werror
-    , "debug_info" =: enableDebugInfo
-    , "ticky_ghc" =: enableTickyGhc
-    , "split_sections" =: splitSections
+    [ "werror"           =: werror
+    , "debug_info"       =: enableDebugInfo
+    , "ticky_ghc"        =: enableTickyGhc
+    , "split_sections"   =: splitSections
     , "thread_sanitizer" =: enableThreadSanitizer
-    , "llvm" =: viaLlvmBackend
-    , "profiled_ghc" =: enableProfiledGhc
-    , "no_dynamic_ghc" =: disableDynamicGhcPrograms
+    , "llvm"             =: viaLlvmBackend
+    , "profiled_ghc"     =: enableProfiledGhc
+    , "no_dynamic_ghc"   =: disableDynamicGhcPrograms
+    , "no_dynamic_libs"  =: disableDynamicLibs
+    , "native_bignum"    =: useNativeBignum
     , "no_profiled_libs" =: disableProfiledLibs
-    , "omit_pragmas" =: omitPragmas
-    , "ipe" =: enableIPE
-    , "fully_static" =: fullyStatic
-    , "collect_timings" =: collectTimings
-    , "assertions" =: enableAssertions
-    , "debug_ghc" =: debugGhc Stage1
+    , "omit_pragmas"     =: omitPragmas
+    , "ipe"              =: enableIPE
+    , "fully_static"     =: fullyStatic
+    , "collect_timings"  =: collectTimings
+    , "assertions"       =: enableAssertions
+    , "debug_ghc"        =: debugGhc Stage1
     , "debug_stage1_ghc" =: debugGhc stage0InTree
-    , "lint" =: enableLinting
-    , "haddock" =: enableHaddock
-    , "late_ccs" =: enableLateCCS
+    , "lint"             =: enableLinting
+    , "haddock"          =: enableHaddock
+    , "late_ccs"         =: enableLateCCS
     ]
   where (=:) = (,)
 
@@ -70,7 +75,7 @@ parseFlavour :: [Flavour]  -- ^ base flavours
 parseFlavour baseFlavours transformers str =
     case P.runParser parser () "" str of
       Left perr -> Left $ unlines $
-                    [ "error parsing flavour specifier: " ++ show perr
+                   [ "error parsing flavour specifier: " ++ show perr
                     , ""
                     , "known flavours:"
                     ] ++
@@ -92,13 +97,14 @@ parseFlavour baseFlavours transformers str =
     baseFlavour =
         P.choice [ f <$ P.try (P.string (name f))
                  | f <- reverse (sortOn name baseFlavours)
-                 ]      -- needed to parse e.g. "quick-debug" before "quick"
+                 ]      -- reverse&sort needed to parse e.g. "quick-debug" before "quick"
 
     flavourTrans :: Parser (Flavour -> Flavour)
     flavourTrans = do
         void $ P.char '+'
         P.choice [ trans <$ P.try (P.string nm)
-                 | (nm, trans) <- M.toList transformers
+                 | (nm, trans) <- reverse $ sortOn fst $ M.toList transformers
+                      -- reverse&sort needed to parse e.g. "ticky_ghc0" before "ticky_ghc"
                  ]
 
 -- | Add arguments to the 'args' of a 'Flavour'.
@@ -137,20 +143,21 @@ enableDebugInfo = addArgs $ notStage0 ? mconcat
 -- | Enable the ticky-ticky profiler in stage2 GHC
 enableTickyGhc :: Flavour -> Flavour
 enableTickyGhc =
-    addArgs $ stage1 ? mconcat
-      [ builder (Ghc CompileHs) ? ticky
-      , builder (Ghc LinkHs) ? ticky
-      ]
-  where
-    ticky = mconcat
-      [ arg "-ticky"
-      , arg "-ticky-allocd"
-      , arg "-ticky-dyn-thunk"
-      -- You generally need STG dumps to interpret ticky profiles
-      , arg "-ddump-to-file"
-      , arg "-ddump-stg-final"
+    addArgs $ orM [stage1, cross] ? mconcat
+      [ builder (Ghc CompileHs) ? tickyArgs
+      , builder (Ghc LinkHs) ? tickyArgs
       ]
 
+tickyArgs :: Args
+tickyArgs = mconcat
+  [ arg "-ticky"
+  , arg "-ticky-allocd"
+  , arg "-ticky-dyn-thunk"
+  -- You generally need STG dumps to interpret ticky profiles
+  , arg "-ddump-to-file"
+  , arg "-ddump-stg-final"
+  ]
+
 -- | Enable Core, STG, and (not C--) linting in all compilations with the stage1 compiler.
 enableLinting :: Flavour -> Flavour
 enableLinting =
@@ -228,6 +235,16 @@ disableDynamicGhcPrograms :: Flavour -> Flavour
 disableDynamicGhcPrograms flavour = flavour { dynamicGhcPrograms = pure False }
 
 -- | Don't build libraries in profiled 'Way's.
+disableDynamicLibs :: Flavour -> Flavour
+disableDynamicLibs flavour =
+  flavour { libraryWays = prune $ libraryWays flavour
+          }
+  where
+    prune :: Ways -> Ways
+    prune = fmap $ Set.filter (not . wayUnit Dynamic)
+
+
+-- | Don't build libraries in profiled 'Way's.
 disableProfiledLibs :: Flavour -> Flavour
 disableProfiledLibs flavour =
     flavour { libraryWays = prune $ libraryWays flavour
@@ -237,6 +254,11 @@ disableProfiledLibs flavour =
     prune :: Ways -> Ways
     prune = fmap $ Set.filter (not . wayUnit Profiling)
 
+useNativeBignum :: Flavour -> Flavour
+useNativeBignum flavour =
+  flavour { bignumBackend = "native"
+          }
+
 -- | Build stage2 compiler with -fomit-interface-pragmas to reduce
 -- recompilation.
 omitPragmas :: Flavour -> Flavour
diff --git a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
index eea23de1c7..dfb4924889 100644
--- a/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
+++ b/hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
@@ -281,6 +281,7 @@ resolveContextData context@Context {..} = do
           , cSrcs           = C.cSources        buildInfo ++ [ ms | Just (_,ms) <- pure main_src, CMain   <- pure (classifyMain ms)]
           , cxxSrcs         = C.cxxSources      buildInfo ++ [ ms | Just (_,ms) <- pure main_src, CppMain <- pure (classifyMain ms)]
           , cmmSrcs         = C.cmmSources      buildInfo
+          , jsSrcs          = C.jsSources       buildInfo
           , hcOpts          = C.programDefaultArgs ghcProg
               ++ C.hcOptions C.GHC buildInfo
               ++ C.languageToFlags   (C.compiler lbi') (C.defaultLanguage buildInfo)
diff --git a/hadrian/src/Hadrian/Haskell/Cabal/Type.hs b/hadrian/src/Hadrian/Haskell/Cabal/Type.hs
index 756f5082bf..a35ca7df0e 100644
--- a/hadrian/src/Hadrian/Haskell/Cabal/Type.hs
+++ b/hadrian/src/Hadrian/Haskell/Cabal/Type.hs
@@ -56,6 +56,7 @@ data ContextData = ContextData
     , cSrcs              :: [String]
     , cxxSrcs            :: [String]
     , cmmSrcs            :: [String]
+    , jsSrcs             :: [String]
     , hcOpts             :: [String]
     , asmOpts            :: [String]
     , ccOpts             :: [String]
diff --git a/hadrian/src/Oracles/Flag.hs b/hadrian/src/Oracles/Flag.hs
index a929b77e68..41fc723b44 100644
--- a/hadrian/src/Oracles/Flag.hs
+++ b/hadrian/src/Oracles/Flag.hs
@@ -95,14 +95,15 @@ platformSupportsSharedLibs = do
     wasm          <- anyTargetArch [ "wasm32" ]
     ppc_linux     <- anyTargetPlatform [ "powerpc-unknown-linux" ]
     solaris       <- anyTargetPlatform [ "i386-unknown-solaris2" ]
+    javascript    <- anyTargetArch     [ "js" ]
     solarisBroken <- flag SolarisBrokenShld
-    return $ not (windows || wasm || ppc_linux || solaris && solarisBroken)
+    return $ not (windows || wasm || javascript || ppc_linux || solaris && solarisBroken)
 
 -- | Does the target support threaded RTS?
 targetSupportsThreadedRts :: Action Bool
 targetSupportsThreadedRts = do
-    wasm <- anyTargetArch [ "wasm32" ]
-    return $ not wasm
+    bad_arch <- anyTargetArch [ "wasm32", "js" ]
+    return $ not bad_arch
 
 -- | Does the target support the -N RTS flag?
 targetSupportsSMP :: Action Bool
diff --git a/hadrian/src/Oracles/Setting.hs b/hadrian/src/Oracles/Setting.hs
index 28926c7763..e064d7a5c1 100644
--- a/hadrian/src/Oracles/Setting.hs
+++ b/hadrian/src/Oracles/Setting.hs
@@ -11,7 +11,7 @@ module Oracles.Setting (
 
     -- ** Target platform things
     anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
-    isElfTarget, isOsxTarget, isWinTarget,
+    isElfTarget, isOsxTarget, isWinTarget, isJsTarget,
     ArmVersion(..),
     targetArmVersion,
     ghcWithInterpreter
@@ -257,6 +257,9 @@ anyTargetOs = matchSetting TargetOs
 isWinTarget :: Action Bool
 isWinTarget = anyTargetOs ["mingw32"]
 
+isJsTarget :: Action Bool
+isJsTarget = anyTargetArch ["js"]
+
 isOsxTarget :: Action Bool
 isOsxTarget = anyTargetOs ["darwin"]
 
diff --git a/hadrian/src/Rules/Compile.hs b/hadrian/src/Rules/Compile.hs
index ff1f9f214b..93d24314ea 100644
--- a/hadrian/src/Rules/Compile.hs
+++ b/hadrian/src/Rules/Compile.hs
@@ -48,6 +48,9 @@ compilePackage rs = do
       [ root -/- "**/build/S/**/*." ++ wayPat ++ "o"
         | wayPat <- wayPats] |%> compileNonHsObject rs Asm
 
+      [ root -/- "**/build/js/**/*." ++ wayPat ++ "o"
+        | wayPat <- wayPats] |%> compileNonHsObject rs JS
+
       -- All else is haskell.
       -- These come last as they overlap with the above rules' file patterns.
 
@@ -115,11 +118,12 @@ compilePackage rs = do
 -}
 
 -- | Non Haskell source languages that we compile to get object files.
-data SourceLang = Asm | C | Cmm | Cxx deriving (Eq, Show)
+data SourceLang = Asm | C | Cmm | Cxx | JS deriving (Eq, Show)
 
 parseSourceLang :: Parsec.Parsec String () SourceLang
 parseSourceLang = Parsec.choice
-  [ Parsec.char 'c' *> Parsec.choice
+  [ Parsec.string "js" *>  pure JS
+  , Parsec.char 'c' *> Parsec.choice
       [ Parsec.string "mm" *> pure Cmm
       , Parsec.string "pp" *> pure Cxx
       , pure C
@@ -238,6 +242,7 @@ compileNonHsObject rs lang path = do
       C   -> obj2src "c"   (const False)      ctx path
       Cmm -> obj2src "cmm" isGeneratedCmmFile ctx path
       Cxx -> obj2src "cpp" (const False) ctx path
+      JS  -> obj2src "js" (const False) ctx path
   need [src]
   needDependencies lang ctx src (path <.> "d")
   buildWithResources rs $ target ctx (builder stage) [src] [path]
diff --git a/hadrian/src/Rules/Generate.hs b/hadrian/src/Rules/Generate.hs
index a44ca510d2..2c02407d31 100644
--- a/hadrian/src/Rules/Generate.hs
+++ b/hadrian/src/Rules/Generate.hs
@@ -42,15 +42,23 @@ rtsDependencies :: Expr [FilePath]
 rtsDependencies = do
     stage   <- getStage
     rtsPath <- expr (rtsBuildPath stage)
+    jsTarget <- expr isJsTarget
     useSystemFfi <- expr (flag UseSystemFfi)
 
-    let headers =
+    let -- headers common to native and JS RTS
+        common_headers =
             [ "ghcautoconf.h", "ghcplatform.h"
             , "DerivedConstants.h"
-            , "rts" -/- "EventTypes.h"
+            ]
+        -- headers specific to the native RTS
+        native_headers =
+            [ "rts" -/- "EventTypes.h"
             , "rts" -/- "EventLogConstants.h"
             ]
             ++ (if useSystemFfi then [] else libffiHeaderFiles)
+        headers
+          | jsTarget  = common_headers
+          | otherwise = common_headers ++ native_headers
     pure $ ((rtsPath -/- "include") -/-) <$> headers
 
 genapplyDependencies :: Expr [FilePath]
diff --git a/hadrian/src/Rules/Libffi.hs b/hadrian/src/Rules/Libffi.hs
index c0a27128ca..61aa133038 100644
--- a/hadrian/src/Rules/Libffi.hs
+++ b/hadrian/src/Rules/Libffi.hs
@@ -68,8 +68,10 @@ dynLibManifest = dynLibManifest' buildRoot
 -- | Need the (locally built) libffi library.
 needLibffi :: Stage -> Action ()
 needLibffi stage = do
-    manifest <- dynLibManifest stage
-    need [manifest]
+    jsTarget <- isJsTarget
+    unless jsTarget $ do
+        manifest <- dynLibManifest stage
+        need [manifest]
 
 -- | Context for @libffi@.
 libffiContext :: Stage -> Action Context
@@ -155,7 +157,11 @@ needLibfffiArchive buildPath = do
 libffiRules :: Rules ()
 libffiRules = do
   _ <- addOracleCache $ \ (LibffiDynLibs stage)
-                         -> readFileLines =<< dynLibManifest stage
+                         -> do
+                              jsTarget <- isJsTarget
+                              if jsTarget
+                                then return []
+                                else readFileLines =<< dynLibManifest stage
   forM_ [Stage1, Stage2, Stage3] $ \stage -> do
     root <- buildRootRules
     let path       = root -/- stageString stage
diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs
index d50f283cfe..2e63f1768f 100644
--- a/hadrian/src/Rules/Library.hs
+++ b/hadrian/src/Rules/Library.hs
@@ -172,10 +172,11 @@ nonHsObjects context = do
     asmObjs <- mapM (objectPath context) asmSrcs
     cObjs   <- cObjects context
     cxxObjs <- cxxObjects context
+    jsObjs  <- jsObjects context
     cmmSrcs <- interpretInContext context (getContextData cmmSrcs)
     cmmObjs <- mapM (objectPath context) cmmSrcs
     eObjs   <- extraObjects context
-    return $ asmObjs ++ cObjs ++ cxxObjs ++ cmmObjs ++ eObjs
+    return $ asmObjs ++ cObjs ++ cxxObjs ++ cmmObjs ++ jsObjs ++ eObjs
 
 -- | Return all the Cxx object files needed to build the given library context.
 cxxObjects :: Context -> Action [FilePath]
@@ -192,6 +193,12 @@ cObjects context = do
         then objs
         else filter ((`notElem` ["Evac_thr", "Scav_thr"]) . takeBaseName) objs
 
+-- | Return all the JS object files to be included in the library.
+jsObjects :: Context -> Action [FilePath]
+jsObjects context = do
+  srcs <- interpretInContext context (getContextData jsSrcs)
+  mapM (objectPath context) srcs
+
 -- | Return extra object files needed to build the given library context. The
 -- resulting list is currently non-empty only when the package from the
 -- 'Context' is @ghc-bignum@ built with in-tree GMP backend.
diff --git a/hadrian/src/Rules/Program.hs b/hadrian/src/Rules/Program.hs
index 71cccd628f..09965ee64c 100644
--- a/hadrian/src/Rules/Program.hs
+++ b/hadrian/src/Rules/Program.hs
@@ -120,10 +120,12 @@ buildBinary rs bin context@Context {..} = do
     asmObjs <- mapM (objectPath context) asmSrcs
     cSrcs   <- interpretInContext context (getContextData cSrcs)
     cxxSrcs <- interpretInContext context (getContextData cxxSrcs)
+    jsSrcs  <- interpretInContext context (getContextData jsSrcs)
     cObjs   <- mapM (objectPath context) cSrcs
     cxxObjs <- mapM (objectPath context) cxxSrcs
+    jsObjs  <- mapM (objectPath context) jsSrcs
     hsObjs  <- hsObjects context
-    let binDeps = asmObjs ++ cObjs ++ cxxObjs ++ hsObjs
+    let binDeps = asmObjs ++ cObjs ++ cxxObjs ++ jsObjs ++ hsObjs
     need binDeps
     buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
     synopsis <- pkgSynopsis package
diff --git a/hadrian/src/Rules/Register.hs b/hadrian/src/Rules/Register.hs
index 2574130c9c..e716204614 100644
--- a/hadrian/src/Rules/Register.hs
+++ b/hadrian/src/Rules/Register.hs
@@ -6,6 +6,7 @@ module Rules.Register (
 import Base
 import Context
 import Expression ( getContextData )
+import Oracles.Setting
 import Hadrian.BuildPath
 import Hadrian.Expression
 import Hadrian.Haskell.Cabal
@@ -136,15 +137,26 @@ buildConfFinal rs context@Context {..} _conf = do
     path <- buildPath context
 
     -- Special package cases (these should ideally be rolled into Cabal).
-    when (package == rts) $
+    when (package == rts) $ do
+        jsTarget <- isJsTarget
+
         -- If Cabal knew about "generated-headers", we could read them from the
         -- 'configuredCabal' information, and just "need" them here.
-        need [ path -/- "include/DerivedConstants.h"
-             , path -/- "include/ghcautoconf.h"
-             , path -/- "include/ghcplatform.h"
-             , path -/- "include/rts/EventLogConstants.h"
+        let common_headers =
+              [ path -/- "include/DerivedConstants.h"
+              , path -/- "include/ghcautoconf.h"
+              , path -/- "include/ghcplatform.h"
+              ]
+            -- headers only required for the native RTS
+            native_headers =
+             [ path -/- "include/rts/EventLogConstants.h"
              , path -/- "include/rts/EventTypes.h"
              ]
+            headers
+              | jsTarget  = common_headers
+              | otherwise = common_headers ++ native_headers
+
+        need headers
 
     -- we need to generate this file for GMP
     when (package == ghcBignum) $ do
diff --git a/hadrian/src/Rules/Rts.hs b/hadrian/src/Rules/Rts.hs
index e08c2a856f..adcc7f51cc 100644
--- a/hadrian/src/Rules/Rts.hs
+++ b/hadrian/src/Rules/Rts.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE MultiWayIf #-}
+
 module Rules.Rts (rtsRules, needRtsLibffiTargets, needRtsSymLinks) where
 
 import qualified Data.Set as Set
@@ -121,13 +123,14 @@ needRtsLibffiTargets :: Stage -> Action [FilePath]
 needRtsLibffiTargets stage = do
     rtsPath      <- rtsBuildPath stage
     useSystemFfi <- flag UseSystemFfi
+    jsTarget     <- isJsTarget
 
     -- Header files (in the rts build dir).
     let headers = fmap ((rtsPath -/- "include") -/-) libffiHeaderFiles
 
-    if useSystemFfi
-    then return []
-    else do
+    if | jsTarget     -> return []
+       | useSystemFfi -> return []
+       | otherwise    -> do
         -- Need Libffi
         -- This returns the dynamic library files (in the Libffi build dir).
         needLibffi stage
diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs
index f1fb204c88..0c8bd0059d 100644
--- a/hadrian/src/Rules/Test.hs
+++ b/hadrian/src/Rules/Test.hs
@@ -9,6 +9,7 @@ import Expression
 import Flavour
 import Hadrian.Haskell.Cabal.Type (packageDependencies)
 import Hadrian.Oracles.Cabal (readPackageData)
+import Hadrian.Oracles.Path (fixAbsolutePathOnWindows)
 import Oracles.Setting
 import Oracles.TestSettings
 import Oracles.Flag
@@ -191,9 +192,32 @@ testRules = do
         -- Prepare Ghc configuration file for input compiler.
         need [root -/- timeoutPath]
 
+        cross <- flag CrossCompiling
 
-        ghcPath <- getCompilerPath testCompilerArg
+        -- get relative path for the given program in the given stage
+        let relative_path_stage s p = programPath =<< programContext s p
+        let make_absolute rel_path = do
+              abs_path <- liftIO (IO.makeAbsolute rel_path)
+              fixAbsolutePathOnWindows abs_path
+
+        rel_ghc_pkg     <- relative_path_stage Stage1 ghcPkg
+        rel_hsc2hs      <- relative_path_stage Stage1 hsc2hs
+        rel_hp2ps       <- relative_path_stage Stage1 hp2ps
+        rel_haddock     <- relative_path_stage (Stage0 InTreeLibs) haddock
+        rel_hpc         <- relative_path_stage (Stage0 InTreeLibs) hpc
+        rel_runghc      <- relative_path_stage (Stage0 InTreeLibs) runGhc
 
+        -- force stage0 program building for cross
+        when cross $ need [rel_hpc, rel_haddock, rel_runghc]
+
+        prog_ghc_pkg     <- make_absolute rel_ghc_pkg
+        prog_hsc2hs      <- make_absolute rel_hsc2hs
+        prog_hp2ps       <- make_absolute rel_hp2ps
+        prog_haddock     <- make_absolute rel_haddock
+        prog_hpc         <- make_absolute rel_hpc
+        prog_runghc      <- make_absolute rel_runghc
+
+        ghcPath <- getCompilerPath testCompilerArg
 
         makePath        <- builderPath $ Make ""
         top             <- topDirectory
@@ -222,6 +246,15 @@ testRules = do
             setEnv "TEST_HC_OPTS_INTERACTIVE" ghciFlags
             setEnv "TEST_CC" ccPath
             setEnv "TEST_CC_OPTS" ccFlags
+
+            when cross $ do
+              setEnv "GHC_PKG"   prog_ghc_pkg
+              setEnv "HSC2HS"    prog_hsc2hs
+              setEnv "HP2PS_ABS" prog_hp2ps
+              setEnv "HPC"       prog_hpc
+              setEnv "HADDOCK"   prog_haddock
+              setEnv "RUNGHC"    prog_runghc
+
             setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath)
             setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath)
             setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath)
diff --git a/hadrian/src/Settings/Flavours/Performance.hs b/hadrian/src/Settings/Flavours/Performance.hs
index fc46920703..21de3c72fe 100644
--- a/hadrian/src/Settings/Flavours/Performance.hs
+++ b/hadrian/src/Settings/Flavours/Performance.hs
@@ -13,6 +13,10 @@ performanceFlavour = defaultFlavour
 performanceArgs :: Args
 performanceArgs = sourceArgs SourceArgs
     { hsDefault  = pure ["-O", "-H64m"]
-    , hsLibrary  = notStage0 ? arg "-O2"
+    , hsLibrary  = orM [notStage0, cross] ? arg "-O2"
     , hsCompiler = pure ["-O2"]
-    , hsGhc      = mconcat [stage0 ? arg "-O", notStage0 ? arg "-O2"] }
+    , hsGhc      = mconcat
+                    [ andM [stage0, notCross] ? arg "-O"
+                    , orM  [notStage0, cross] ? arg "-O2"
+                    ]
+    }