Commit cc25d52e authored by Sylvain Henry's avatar Sylvain Henry
Browse files

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: doyougnu's avatarJeffrey Young <jeffrey.young@iohk.io>
Co-authored-by: Luite Stegeman's avatarLuite Stegeman <stegeman@gmail.com>
Co-authored-by: Josh Meredith's avatarJosh Meredith <joshmeredith2008@gmail.com>
parent def47dd3
Pipeline #59637 canceled with stages
......@@ -17,6 +17,9 @@ variables:
# Overridden by individual jobs
CONFIGURE_ARGS: ""
# Overridden by individual jobs
CONFIGURE_WRAPPER: ""
GIT_SUBMODULE_STRATEGY: "normal"
# Makes ci.sh isolate CABAL_DIR
......
......@@ -65,6 +65,7 @@ Environment variables affecting both build systems:
"decreases", or "all")
HERMETIC Take measures to avoid looking at anything in \$HOME
CONFIGURE_ARGS Arguments passed to configure script.
CONFIGURE_WRAPPER Wrapper for the configure script (e.g. Emscripten's emconfigure).
ENABLE_NUMA Whether to enable numa support for the build (disabled by default)
INSTALL_CONFIGURE_ARGS
Arguments passed to the binary distribution configure script
......@@ -249,6 +250,11 @@ function setup() {
cp -Rf "$CABAL_CACHE"/* "$CABAL_DIR"
fi
case "${CONFIGURE_WRAPPER:-}" in
emconfigure) time_it "setup" setup_emscripten ;;
*) ;;
esac
case $toolchain_source in
extracted) time_it "setup" setup_toolchain ;;
*) ;;
......@@ -365,6 +371,14 @@ function setup_toolchain() {
$cabal_install alex --constraint="alex>=$MIN_ALEX_VERSION"
}
function setup_emscripten() {
git clone https://github.com/emscripten-core/emsdk.git
cd emsdk
./emsdk install latest
./emsdk activate latest
cd ..
}
function cleanup_submodules() {
start_section "clean submodules"
if [ -d .git ]; then
......@@ -402,6 +416,11 @@ EOF
}
function configure() {
case "${CONFIGURE_WRAPPER:-}" in
emconfigure) source emsdk/emsdk_env.sh ;;
*) ;;
esac
if [[ -z "${NO_BOOT:-}" ]]; then
start_section "booting"
run python3 boot
......@@ -421,7 +440,7 @@ function configure() {
start_section "configuring"
# See https://stackoverflow.com/questions/7577052 for a rationale for the
# args[@] symbol-soup below.
run ./configure \
run ${CONFIGURE_WRAPPER:-} ./configure \
--enable-tarballs-autodownload \
"${args[@]+"${args[@]}"}" \
GHC="$GHC" \
......@@ -528,6 +547,11 @@ function make_install_destdir() {
# install the binary distribution in directory $1 to $2.
function install_bindist() {
case "${CONFIGURE_WRAPPER:-}" in
emconfigure) source emsdk/emsdk_env.sh ;;
*) ;;
esac
local bindist="$1"
local instdir="$2"
pushd "$bindist"
......@@ -545,7 +569,7 @@ function install_bindist() {
args+=( "--target=$CROSS_TARGET" "--host=$CROSS_TARGET" )
fi
run ./configure \
run ${CONFIGURE_WRAPPER:-} ./configure \
--prefix="$instdir" \
"${args[@]+"${args[@]}"}"
make_install_destdir "$TOP"/destdir "$instdir"
......@@ -575,19 +599,17 @@ function test_hadrian() {
fi
if [ -n "${CROSS_TARGET:-}" ]; then
if [ -n "${CROSS_EMULATOR:-}" ]; then
local instdir="$TOP/_build/install"
local test_compiler="$instdir/bin/${cross_prefix}ghc$exe"
install_bindist _build/bindist/ghc-*/ "$instdir"
echo 'main = putStrLn "hello world"' > expected
run "$test_compiler" -package ghc "$TOP/.gitlab/hello.hs" -o hello
$CROSS_EMULATOR ./hello > actual
run diff expected actual
else
info "Cannot test cross-compiled build without CROSS_EMULATOR being set."
return
fi
if [[ "${CROSS_EMULATOR:-}" == "NOT_SET" ]]; then
info "Cannot test cross-compiled build without CROSS_EMULATOR being set."
return
elif [ -n "${CROSS_TARGET:-}" ]; then
local instdir="$TOP/_build/install"
local test_compiler="$instdir/bin/${cross_prefix}ghc$exe"
install_bindist _build/bindist/ghc-*/ "$instdir"
echo 'main = putStrLn "hello world"' > expected
run "$test_compiler" -package ghc "$TOP/.gitlab/hello.hs" -o hello
${CROSS_EMULATOR:-} ./hello > actual
run diff expected actual
elif [[ -n "${REINSTALL_GHC:-}" ]]; then
run_hadrian \
test \
......@@ -598,10 +620,11 @@ function test_hadrian() {
"runtest.opts+=${RUNTEST_ARGS:-}" || fail "hadrian cabal-install test"
else
local instdir="$TOP/_build/install"
local test_compiler="$instdir/bin/ghc$exe"
local test_compiler="$instdir/bin/${cross_prefix}ghc$exe"
install_bindist _build/bindist/ghc-*/ "$instdir"
if [[ "${WINDOWS_HOST}" == "no" ]]; then
if [[ "${WINDOWS_HOST}" == "no" ]] && [ -z "${CROSS_TARGET:-}" ]
then
run_hadrian \
test \
--test-root-dirs=testsuite/tests/stage1 \
......@@ -610,10 +633,14 @@ function test_hadrian() {
info "STAGE1_TEST=$?"
fi
# Ensure the resulting compiler has the correct bignum-flavour
test_compiler_backend=$(${test_compiler} -e "GHC.Num.Backend.backendName")
if [ $test_compiler_backend != "\"$BIGNUM_BACKEND\"" ]; then
fail "Test compiler has a different BIGNUM_BACKEND ($test_compiler_backend) thean requested ($BIGNUM_BACKEND)"
# Ensure the resulting compiler has the correct bignum-flavour,
# except for cross-compilers as they may not support the interpreter
if [ -z "${CROSS_TARGET:-}" ]
then
test_compiler_backend=$(${test_compiler} -e "GHC.Num.Backend.backendName")
if [ $test_compiler_backend != "\"$BIGNUM_BACKEND\"" ]; then
fail "Test compiler has a different BIGNUM_BACKEND ($test_compiler_backend) thean requested ($BIGNUM_BACKEND)"
fi
fi
# If we are doing a release job, check the compiler can build a profiled executable
......
......@@ -109,6 +109,11 @@ bignumString :: BignumBackend -> String
bignumString Gmp = "gmp"
bignumString Native = "native"
data CrossEmulator
= NoEmulator
| NoEmulatorNeeded
| Emulator String
-- | A BuildConfig records all the options which can be modified to affect the
-- bindists produced by the compiler.
data BuildConfig
......@@ -120,7 +125,8 @@ data BuildConfig
, withAssertions :: Bool
, withNuma :: Bool
, crossTarget :: Maybe String
, crossEmulator :: Maybe String
, crossEmulator :: CrossEmulator
, configureWrapper :: Maybe String
, fullyStatic :: Bool
, tablesNextToCode :: Bool
, threadSanitiser :: Bool
......@@ -163,7 +169,8 @@ vanilla = BuildConfig
, withAssertions = False
, withNuma = False
, crossTarget = Nothing
, crossEmulator = Nothing
, crossEmulator = NoEmulator
, configureWrapper = Nothing
, fullyStatic = False
, tablesNextToCode = True
, threadSanitiser = False
......@@ -195,11 +202,13 @@ staticNativeInt :: BuildConfig
staticNativeInt = static { bignumBackend = Native }
crossConfig :: String -- ^ target triple
-> Maybe String -- ^ emulator for testing
-> CrossEmulator -- ^ emulator for testing
-> Maybe String -- ^ Configure wrapper
-> BuildConfig
crossConfig triple emulator =
crossConfig triple emulator configure_wrapper =
vanilla { crossTarget = Just triple
, crossEmulator = emulator
, configureWrapper = configure_wrapper
}
llvm :: BuildConfig
......@@ -636,8 +645,14 @@ job arch opsys buildConfig = (jobName, Job {..})
, "BUILD_FLAVOUR" =: flavourString jobFlavour
, "BIGNUM_BACKEND" =: bignumString (bignumBackend buildConfig)
, "CONFIGURE_ARGS" =: configureArgsStr buildConfig
, maybe mempty ("CONFIGURE_WRAPPER" =:) (configureWrapper buildConfig)
, maybe mempty ("CROSS_TARGET" =:) (crossTarget buildConfig)
, maybe mempty ("CROSS_EMULATOR" =:) (crossEmulator buildConfig)
, case crossEmulator buildConfig of
NoEmulator -> case crossTarget buildConfig of
Nothing -> mempty
Just _ -> "CROSS_EMULATOR" =: "NOT_SET" -- we need an emulator but it isn't set. Won't run the testsuite
Emulator s -> "CROSS_EMULATOR" =: s
NoEmulatorNeeded -> mempty
, if withNuma buildConfig then "ENABLE_NUMA" =: "1" else mempty
]
......@@ -813,7 +828,11 @@ jobs = Map.fromList $ concatMap flattenJobGroup $
, standardBuilds I386 (Linux Debian9)
, allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) static)
, disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))
, validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Just "qemu-aarch64 -L /usr/aarch64-linux-gnu"))
, validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing)
, validateBuilds Amd64 (Linux Debian11) (crossConfig "js-unknown-ghcjs" NoEmulatorNeeded (Just "emconfigure")
)
{ bignumBackend = Native
}
]
where
......
......@@ -1328,6 +1328,67 @@
"XZ_OPT": "-9"
}
},
"nightly-x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh clean",
"cat ci_timings"
],
"allow_failure": false,
"artifacts": {
"expire_in": "8 weeks",
"paths": [
"ghc-x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate.tar.xz",
"junit.xml"
],
"reports": {
"junit": "junit.xml"
},
"when": "always"
},
"cache": {
"key": "x86_64-linux-deb11-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
"image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
"needs": [
{
"artifacts": false,
"job": "hadrian-ghc-in-ghci"
}
],
"rules": [
{
"if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")",
"when": "on_success"
}
],
"script": [
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
".gitlab/ci.sh build_hadrian",
".gitlab/ci.sh test_hadrian"
],
"stage": "full-build",
"tags": [
"x86_64-linux"
],
"variables": {
"BIGNUM_BACKEND": "native",
"BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate",
"BUILD_FLAVOUR": "validate",
"CONFIGURE_ARGS": "--with-intree-gmp",
"CONFIGURE_WRAPPER": "emconfigure",
"CROSS_TARGET": "js-unknown-ghcjs",
"TEST_ENV": "x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate",
"XZ_OPT": "-9"
}
},
"nightly-x86_64-linux-deb11-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
......@@ -3810,6 +3871,66 @@
"TEST_ENV": "x86_64-linux-deb11-cross_aarch64-linux-gnu-validate"
}
},
"x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
".gitlab/ci.sh clean",
"cat ci_timings"
],
"allow_failure": false,
"artifacts": {
"expire_in": "2 weeks",
"paths": [
"ghc-x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate.tar.xz",
"junit.xml"
],
"reports": {
"junit": "junit.xml"
},
"when": "always"
},
"cache": {
"key": "x86_64-linux-deb11-$CACHE_REV",
"paths": [
"cabal-cache",
"toolchain"
]
},
"dependencies": [],
"image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb11:$DOCKER_REV",
"needs": [
{
"artifacts": false,
"job": "hadrian-ghc-in-ghci"
}
],
"rules": [
{
"if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")",
"when": "on_success"
}
],
"script": [
"sudo chown ghc:ghc -R .",
".gitlab/ci.sh setup",
".gitlab/ci.sh configure",
".gitlab/ci.sh build_hadrian",
".gitlab/ci.sh test_hadrian"
],
"stage": "full-build",
"tags": [
"x86_64-linux"
],
"variables": {
"BIGNUM_BACKEND": "native",
"BIN_DIST_NAME": "ghc-x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate",
"BUILD_FLAVOUR": "validate",
"CONFIGURE_ARGS": "--with-intree-gmp",
"CONFIGURE_WRAPPER": "emconfigure",
"CROSS_TARGET": "js-unknown-ghcjs",
"TEST_ENV": "x86_64-linux-deb11-int_native-cross_js-unknown-ghcjs-validate"
}
},
"x86_64-linux-deb11-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
......
......@@ -5,6 +5,7 @@
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
module GHC.Builtin.PrimOps (
PrimOp(..), PrimOpVecCat(..), allThePrimOps,
......@@ -18,7 +19,7 @@ module GHC.Builtin.PrimOps (
primOpOutOfLine, primOpCodeSize,
primOpOkForSpeculation, primOpOkForSideEffects,
primOpIsCheap, primOpFixity, primOpDocs,
primOpIsDiv,
primOpIsDiv, primOpIsReallyInline,
getPrimOpResultInfo, isComparisonPrimOp, PrimOpResultInfo(..),
......@@ -807,3 +808,12 @@ data PrimCall = PrimCall CLabelString Unit
instance Outputable PrimCall where
ppr (PrimCall lbl pkgId)
= text "__primcall" <+> ppr pkgId <+> ppr lbl
-- | Indicate if a primop is really inline: that is, it isn't out-of-line and it
-- isn't SeqOp/DataToTagOp which are two primops that evaluate their argument
-- hence induce thread/stack/heap changes.
primOpIsReallyInline :: PrimOp -> Bool
primOpIsReallyInline = \case
SeqOp -> False
DataToTagOp -> False
p -> not (primOpOutOfLine p)
......@@ -7,6 +7,7 @@
module GHC.Data.Graph.Directed (
Graph, graphFromEdgedVerticesOrd, graphFromEdgedVerticesUniq,
graphFromVerticesAndAdjacency,
SCC(..), Node(..), flattenSCC, flattenSCCs,
stronglyConnCompG,
......@@ -547,3 +548,21 @@ classifyEdges root getSucc edges =
ends'' = addToUFM ends' n time''
in
(time'' + 1, starts'', ends'')
graphFromVerticesAndAdjacency
:: Ord key
=> [Node key payload]
-> [(key, key)] -- First component is source vertex key,
-- second is target vertex key (thing depended on)
-- Unlike the other interface I insist they correspond to
-- actual vertices because the alternative hides bugs. I can't
-- do the same thing for the other one for backcompat reasons.
-> Graph (Node key payload)
graphFromVerticesAndAdjacency [] _ = emptyGraph
graphFromVerticesAndAdjacency vertices edges = Graph graph vertex_node (key_vertex . key_extractor)
where key_extractor = node_key
(bounds, vertex_node, key_vertex, _) = reduceNodesIntoVerticesOrd vertices key_extractor
key_vertex_pair (a, b) = (expectJust "graphFromVerticesAndAdjacency" $ key_vertex a,
expectJust "graphFromVerticesAndAdjacency" $ key_vertex b)
reduced_edges = map key_vertex_pair edges
graph = buildG bounds reduced_edges
This diff is collapsed.
......@@ -27,6 +27,7 @@ data BackendName
= NCG -- ^ Names the native code generator backend.
| LLVM -- ^ Names the LLVM backend.
| ViaC -- ^ Names the Via-C backend.
| JavaScript -- ^ Names the JS backend.
| Interpreter -- ^ Names the ByteCode interpreter.
| NoBackend -- ^ Names the `-fno-code` backend.
deriving (Eq, Show)
......@@ -28,9 +28,9 @@ import GHC.Cmm
import GHC.Cmm.CLabel
import GHC.Driver.Session
import GHC.Driver.Config.Finder (initFinderOpts)
import GHC.Driver.Config.CmmToAsm (initNCGConfig)
import GHC.Driver.Config.CmmToLlvm (initLlvmCgConfig)
import GHC.Driver.Config.Finder ( initFinderOpts )
import GHC.Driver.Config.CmmToAsm ( initNCGConfig )
import GHC.Driver.Config.CmmToLlvm ( initLlvmCgConfig )
import GHC.Driver.LlvmConfigCache (LlvmConfigCache)
import GHC.Driver.Ppr
import GHC.Driver.Backend
......@@ -45,8 +45,9 @@ import GHC.Utils.TmpFs
import GHC.Utils.Error
import GHC.Utils.Outputable
import GHC.Utils.Logger
import GHC.Utils.Exception (bracket)
import GHC.Utils.Exception ( bracket )
import GHC.Utils.Ppr (Mode(..))
import GHC.Utils.Panic.Plain ( pgmError )
import GHC.Unit
import GHC.Unit.Finder ( mkStubPaths )
......@@ -125,6 +126,7 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g
final_stream
ViaCCodeOutput -> outputC logger dflags filenm final_stream pkg_deps
LlvmCodeOutput -> outputLlvm logger llvm_config dflags filenm final_stream
JSCodeOutput -> outputJS logger llvm_config dflags filenm final_stream
; stubs_exist <- outputForeignStubs logger tmpfs dflags unit_state this_mod location stubs
; return (filenm, stubs_exist, foreign_fps, a)
}
......@@ -216,6 +218,18 @@ outputLlvm logger llvm_config dflags filenm cmm_stream = do
\f -> {-# SCC "llvm_CodeGen" #-}
llvmCodeGen logger lcg_config f cmm_stream
{-
************************************************************************
* *
\subsection{JavaScript}
* *
************************************************************************
-}
outputJS :: Logger -> LlvmConfigCache -> DynFlags -> FilePath -> Stream IO RawCmmGroup a -> IO a
outputJS _ _ _ _ _ = pgmError $ "codeOutput: Hit JavaScript case. We should never reach here!"
++ "\nThe JS backend should shortcircuit to StgToJS after Stg."
++ "\nIf you reached this point then you've somehow made it to Cmm!"
{-
************************************************************************
* *
......
......@@ -63,8 +63,9 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
b_blob = if not ncg then Nothing else binBlobThreshold dflags
(ncg, llvm) = case backendPrimitiveImplementation bk_end of
GenericPrimitives -> (False, False)
NcgPrimitives -> (True, False)
LlvmPrimitives -> (False, True)
JSPrimitives -> (False, False)
NcgPrimitives -> (True, False)
LlvmPrimitives -> (False, True)
x86ish = case platformArch platform of
ArchX86 -> True
ArchX86_64 -> True
......
module GHC.Driver.Config.StgToJS
( initStgToJSConfig
)
where
import GHC.StgToJS.Types
import GHC.Driver.Session
import GHC.Platform.Ways
import GHC.Utils.Outputable
import GHC.Prelude
-- | Initialize StgToJS settings from DynFlags
initStgToJSConfig :: DynFlags -> StgToJSConfig
initStgToJSConfig dflags = StgToJSConfig
-- flags
{ csInlinePush = False
, csInlineBlackhole = False
, csInlineLoadRegs = False
, csInlineEnter = False
, csInlineAlloc = False
, csTraceRts = False
, csAssertRts = False
, csBoundsCheck = gopt Opt_DoBoundsChecking dflags
, csDebugAlloc = False
, csTraceForeign = False
, csProf = ways dflags `hasWay` WayProf
, csRuntimeAssert = False
-- settings
, csContext = initSDocContext dflags defaultDumpStyle
}
......@@ -77,6 +77,7 @@ data DumpFlag
| Opt_D_dump_asm_stats
| Opt_D_dump_c_backend
| Opt_D_dump_llvm
| Opt_D_dump_js
| Opt_D_dump_core_stats
| Opt_D_dump_deriv
| Opt_D_dump_ds
......
......@@ -132,6 +132,7 @@ import GHC.Driver.Config.Stg.Pipeline (initStgPipelineOpts)
import GHC.Driver.Config.StgToCmm (initStgToCmmConfig)
import GHC.Driver.Config.Cmm (initCmmConfig)
import GHC.Driver.LlvmConfigCache (initLlvmConfigCache)
import GHC.Driver.Config.StgToJS (initStgToJSConfig)
import GHC.Driver.Config.Diagnostic
import GHC.Driver.Config.Tidy
import GHC.Driver.Hooks
......@@ -153,6 +154,7 @@ import GHC.Hs.Stats ( ppSourceStats )
import GHC.HsToCore
import GHC.StgToByteCode ( byteCodeGen )
import GHC.StgToJS ( stgToJS )
import GHC.IfaceToCore ( typecheckIface, typecheckWholeCoreBindings )
......@@ -1789,7 +1791,9 @@ hscGenHardCode hsc_env cgguts location output_filename = do
cg_foreign = foreign_stubs0,
cg_foreign_files = foreign_files,
cg_dep_pkgs = dependencies,
cg_hpc_info = hpc_info } = cgguts
cg_hpc_info = hpc_info,
cg_spt_entries = spt_entries
} = cgguts
dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
hooks = hsc_hooks hsc_env
......@@ -1849,38 +1853,53 @@ hscGenHardCode hsc_env cgguts location output_filename = do
------------------ Code generation ------------------
-- The back-end is streamed: each top-level function goes
-- from Stg all the way to asm before dealing with the next
-- top-level function, so showPass isn't very useful here.
-- Hence we have one showPass for the whole backend, the
-- next showPass after this will be "Assembler".
withTiming logger
(text "CodeGen"<+>brackets (ppr this_mod))
(const ()) $ do
cmms <- {-# SCC "StgToCmm" #-}
doCodeGen hsc_env this_mod denv data_tycons
cost_centre_info
stg_binds hpc_info
------------------ Code output -----------------------
rawcmms0 <- {-# SCC "cmmToRawCmm" #-}
case cmmToRawCmmHook hooks of
Nothing -> cmmToRawCmm logger profile cmms
Just h -> h dflags (Just this_mod) cmms
let dump a = do
unless (null a) $
putDumpFileMaybe logger Opt_D_dump_cmm_raw "Raw Cmm" FormatCMM (pdoc platform a)
return a
rawcmms1 = Stream.mapM dump rawcmms0
let foreign_stubs st = foreign_stubs0 `appendStubC` prof_init
`appendStubC` cgIPEStub st
(output_filename, (_stub_h_exists, stub_c_exists), foreign_fps, cmm_cg_infos)
<- {-# SCC "codeOutput" #-}
codeOutput logger tmpfs llvm_config dflags (hsc_units hsc_env) this_mod output_filename location
foreign_stubs foreign_files dependencies rawcmms1
return ( output_filename, stub_c_exists, foreign_fps
, Just stg_cg_infos, Just cmm_cg_infos)
-- top-level function, so withTiming isn't very useful here.
-- Hence we have one withTiming for the whole backend, the
-- next withTiming after this will be "Assembler" (hard code only).
withTiming logger (text "CodeGen"<+>brackets (ppr this_mod)) (const ())
$ case backendCodeOutput (backend dflags) of
JSCodeOutput ->
do
let js_config = initStgToJSConfig dflags
cmm_cg_infos = Nothing
stub_c_exists = Nothing
foreign_fps = []
putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG
(pprGenStgTopBindings (initStgPprOpts dflags) stg_binds)
-- do the unfortunately effectual business