[Git][ghc/ghc][master] JS: fix support for -outputdir (#22641)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Dec 23 04:39:31 UTC 2022
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
99757ce8 by Sylvain Henry at 2022-12-22T23:39:13-05:00
JS: fix support for -outputdir (#22641)
The `-outputdir` option wasn't correctly handled with the JS backend
because the same code path was used to handle both objects produced by
the JS backend and foreign .js files. Now we clearly distinguish the
two in the pipeline, fixing the bug.
- - - - -
4 changed files:
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Pipeline/Phases.hs
- compiler/GHC/StgToJS/Linker/Linker.hs
Changes:
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -607,7 +607,7 @@ compileForeign hsc_env lang stub_c = do
LangObjc -> viaCPipeline Cobjc
LangObjcxx -> viaCPipeline Cobjcxx
LangAsm -> \pe hsc_env ml fp -> asPipeline True pe hsc_env ml fp
- LangJs -> \pe hsc_env ml fp -> Just <$> jsPipeline pe hsc_env ml fp
+ LangJs -> \pe hsc_env ml fp -> Just <$> foreignJsPipeline pe hsc_env ml fp
#if __GLASGOW_HASKELL__ < 811
RawObject -> panic "compileForeign: should be unreachable"
#endif
@@ -639,7 +639,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do
let src = ppr (mkHomeModule home_unit mod_name) <+> text "= 0;"
writeFile empty_stub (showSDoc dflags (pprCode src))
let pipe_env = (mkPipeEnv NoStop empty_stub Nothing Persistent) { src_basename = basename}
- pipeline = Just <$> jsPipeline pipe_env hsc_env (Just location) empty_stub
+ pipeline = Just <$> foreignJsPipeline pipe_env hsc_env (Just location) empty_stub
_ <- runPipeline (hsc_hooks hsc_env) pipeline
pure ()
@@ -858,6 +858,10 @@ jsPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m Fil
jsPipeline pipe_env hsc_env location input_fn = do
use (T_Js pipe_env hsc_env location input_fn)
+foreignJsPipeline :: P m => PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m FilePath
+foreignJsPipeline pipe_env hsc_env location input_fn = do
+ use (T_ForeignJs pipe_env hsc_env location input_fn)
+
hscPostBackendPipeline :: P m => PipeEnv -> HscEnv -> HscSource -> Backend -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
hscPostBackendPipeline _ _ HsBootFile _ _ _ = return Nothing
hscPostBackendPipeline _ _ HsigFile _ _ _ = return Nothing
@@ -928,7 +932,7 @@ pipelineStart pipe_env hsc_env input_fn mb_phase =
fromPhase StopLn = return (Just input_fn)
fromPhase CmmCpp = Just <$> cmmCppPipeline pipe_env hsc_env input_fn
fromPhase Cmm = Just <$> cmmPipeline pipe_env hsc_env input_fn
- fromPhase Js = Just <$> jsPipeline pipe_env hsc_env Nothing input_fn
+ fromPhase Js = Just <$> foreignJsPipeline pipe_env hsc_env Nothing input_fn
fromPhase MergeForeign = panic "fromPhase: MergeForeign"
{-
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -127,7 +127,10 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do
})
input_fn output_fn
return output_fn
-runPhase (T_Js pipe_env hsc_env _mb_location js_src) = runJsPhase pipe_env hsc_env js_src
+runPhase (T_Js pipe_env hsc_env location js_src) =
+ runJsPhase pipe_env hsc_env location js_src
+runPhase (T_ForeignJs pipe_env hsc_env location js_src) =
+ runForeignJsPhase pipe_env hsc_env location js_src
runPhase (T_Cmm pipe_env hsc_env input_fn) = do
let dflags = hsc_dflags hsc_env
let next_phase = hscPostBackendPhase HsSrcFile (backend dflags)
@@ -374,31 +377,27 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
-- to ensure these timestamps abide by the proper ordering.
-- | Run the JS Backend postHsc phase.
-runJsPhase :: PipeEnv -> HscEnv -> FilePath -> IO FilePath
-runJsPhase pipe_env hsc_env input_fn = do
+runJsPhase :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
+runJsPhase _pipe_env hsc_env _location input_fn = do
+ let dflags = hsc_dflags hsc_env
+ let logger = hsc_logger hsc_env
+
+ -- The object file is already generated. We only touch it to ensure the
+ -- timestamp is refreshed, see Note [JS Backend .o file procedure].
+ touchObjectFile logger dflags input_fn
+
+ return input_fn
+
+-- | Deal with foreign JS files (embed them into .o files)
+runForeignJsPhase :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> IO FilePath
+runForeignJsPhase pipe_env hsc_env _location input_fn = do
let dflags = hsc_dflags hsc_env
let logger = hsc_logger hsc_env
let tmpfs = hsc_tmpfs hsc_env
let unit_env = hsc_unit_env hsc_env
output_fn <- phaseOutputFilenameNew StopLn pipe_env hsc_env Nothing
-
- -- if the input filename is the same as the output, then we've probably
- -- generated the object ourselves. In this case, we touch the object file to
- -- ensure the timestamp is refreshed, see Note [JS Backend .o file procedure]. If
- -- they are not the same then we embed the .js file into a .o file with the
- -- addition of a header
- --
- -- We need to canonicalize the paths, otherwise the comparison can return
- -- wrong results (e.g. with Cabal using paths containing "build/./Foo/..."
- -- that are compared to "build/Foo/...").
- --
- cin <- canonicalizePath input_fn
- cout <- canonicalizePath output_fn
- if (not (equalFilePath cin cout))
- then embedJsFile logger dflags tmpfs unit_env input_fn output_fn
- else touchObjectFile logger dflags output_fn
-
+ embedJsFile logger dflags tmpfs unit_env input_fn output_fn
return output_fn
=====================================
compiler/GHC/Driver/Pipeline/Phases.hs
=====================================
@@ -45,6 +45,7 @@ data TPhase res where
T_Cc :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> TPhase FilePath
T_As :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> TPhase FilePath
T_Js :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> TPhase FilePath
+ T_ForeignJs :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> TPhase FilePath
T_LlvmOpt :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
T_LlvmLlc :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
T_LlvmMangle :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath
=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -806,45 +806,35 @@ embedJsFile logger dflags tmpfs unit_env input_fn output_fn = do
-- the header lets the linker recognize processed JavaScript files
-- But don't add JavaScript header to object files!
- is_js_obj <- if True
- then pure False
- else isJsObjectFile input_fn
- -- FIXME (Sylvain 2022-09): this call makes the
- -- testsuite go into a loop, I don't know why yet!
- -- Disabling it for now.
-
- if is_js_obj
- then copyWithHeader "" input_fn output_fn
- else do
- -- header appended to JS files stored as .o to recognize them.
- let header = "//JavaScript\n"
- jsFileNeedsCpp input_fn >>= \case
- False -> copyWithHeader header input_fn output_fn
- True -> do
-
- -- append common CPP definitions to the .js file.
- -- They define macros that avoid directly wiring zencoded names
- -- in RTS JS files
- pp_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js"
- payload <- B.readFile input_fn
- B.writeFile pp_fn (commonCppDefs profiling <> payload)
-
- -- run CPP on the input JS file
- js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js"
- let
- cpp_opts = CppOpts
- { cppUseCc = True
- , cppLinePragmas = False -- LINE pragmas aren't JS compatible
- }
- doCpp logger
- tmpfs
- dflags
- unit_env
- cpp_opts
- pp_fn
- js_fn
- -- add header to recognize the object as a JS file
- copyWithHeader header js_fn output_fn
+ -- header appended to JS files stored as .o to recognize them.
+ let header = "//JavaScript\n"
+ jsFileNeedsCpp input_fn >>= \case
+ False -> copyWithHeader header input_fn output_fn
+ True -> do
+
+ -- append common CPP definitions to the .js file.
+ -- They define macros that avoid directly wiring zencoded names
+ -- in RTS JS files
+ pp_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js"
+ payload <- B.readFile input_fn
+ B.writeFile pp_fn (commonCppDefs profiling <> payload)
+
+ -- run CPP on the input JS file
+ js_fn <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "js"
+ let
+ cpp_opts = CppOpts
+ { cppUseCc = True
+ , cppLinePragmas = False -- LINE pragmas aren't JS compatible
+ }
+ doCpp logger
+ tmpfs
+ dflags
+ unit_env
+ cpp_opts
+ pp_fn
+ js_fn
+ -- add header to recognize the object as a JS file
+ copyWithHeader header js_fn output_fn
jsFileNeedsCpp :: FilePath -> IO Bool
jsFileNeedsCpp fn = do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99757ce8e32d9809c71b09583aa881943a450086
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/99757ce8e32d9809c71b09583aa881943a450086
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221222/eba60587/attachment-0001.html>
More information about the ghc-commits
mailing list