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>

2 files changed, 26 insertions, 21 deletions

diff --git a/compiler/GHC/Linker/Static.hs b/compiler/GHC/Linker/Static.hs
index b81b286d54..2bbe6dfc17 100644
--- a/compiler/GHC/Linker/Static.hs
+++ b/compiler/GHC/Linker/Static.hs
@@ -64,23 +64,27 @@ it is supported by both gcc and clang. Anecdotally nvcc supports
 -}
 
 linkBinary :: Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
-linkBinary logger tmpfs dflags unit_env o_files dep_units = do
+linkBinary = linkBinary' False
+
+linkBinary' :: Bool -> Logger -> TmpFs -> DynFlags -> UnitEnv -> [FilePath] -> [UnitId] -> IO ()
+linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do
     let platform   = ue_platform unit_env
         unit_state = ue_units unit_env
         toolSettings' = toolSettings dflags
         verbFlags = getVerbFlags dflags
-        output_fn = exeFileName platform False (outputFile_ dflags)
+        arch_os   = platformArchOS platform
+        output_fn = exeFileName arch_os staticLink (outputFile_ dflags)
         namever   = ghcNameVersion dflags
         ways_     = ways dflags
 
-    -- get the full list of packages to link with, by combining the
-    -- explicit packages with the auto packages and all of their
-    -- dependencies, and eliminating duplicates.
-
     full_output_fn <- if isAbsolute output_fn
                       then return output_fn
                       else do d <- getCurrentDirectory
                               return $ normalise (d </> output_fn)
+
+    -- get the full list of packages to link with, by combining the
+    -- explicit packages with the auto packages and all of their
+    -- dependencies, and eliminating duplicates.
     pkgs <- mayThrowUnitErr (preloadUnitsInfo' unit_env dep_units)
     let pkg_lib_paths     = collectLibraryDirs ways_ pkgs
     let pkg_lib_path_opts = concatMap get_pkg_lib_path_opts pkg_lib_paths
@@ -267,7 +271,8 @@ linkStaticLib logger dflags unit_env o_files dep_units = do
   let platform  = ue_platform unit_env
       extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
       modules = o_files ++ extra_ld_inputs
-      output_fn = exeFileName platform True (outputFile_ dflags)
+      arch_os = platformArchOS platform
+      output_fn = exeFileName arch_os True (outputFile_ dflags)
       namever = ghcNameVersion dflags
       ways_   = ways dflags
 
diff --git a/compiler/GHC/Linker/Static/Utils.hs b/compiler/GHC/Linker/Static/Utils.hs
index 6439d197d8..787147caac 100644
--- a/compiler/GHC/Linker/Static/Utils.hs
+++ b/compiler/GHC/Linker/Static/Utils.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE MultiWayIf #-}
+
 module GHC.Linker.Static.Utils where
 
 import GHC.Prelude
@@ -12,20 +14,18 @@ import System.FilePath
 -- Use the provided filename (if any), otherwise use "main.exe" (Windows),
 -- "a.out (otherwise without StaticLink set), "liba.a". In every case, add the
 -- extension if it is missing.
-exeFileName :: Platform -> Bool -> Maybe FilePath -> FilePath
-exeFileName platform staticLink output_fn
-  | Just s <- output_fn =
-      case platformOS platform of
-          OSMinGW32 -> s <?.> "exe"
-          _         -> if staticLink
-                         then s <?.> "a"
-                         else s
-  | otherwise =
-      if platformOS platform == OSMinGW32
-      then "main.exe"
-      else if staticLink
-           then "liba.a"
-           else "a.out"
+exeFileName :: ArchOS -> Bool -> Maybe FilePath -> FilePath
+exeFileName (ArchOS arch os) staticLink output_fn
+  | Just s <- output_fn = if
+      | OSMinGW32      <- os   -> s <?.> "exe"
+      | ArchJavaScript <- arch -> s <?.> "jsexe"
+      | staticLink             -> s <?.> "a"
+      | otherwise              -> s
+  | otherwise = if
+      | OSMinGW32      <- os   -> "main.exe"
+      | ArchJavaScript <- arch -> "main.jsexe"
+      | staticLink             -> "liba.a"
+      | otherwise              -> "a.out"
  where s <?.> ext | null (takeExtension s) = s <.> ext
                   | otherwise              = s