From e2a670752a2f0534ac97543569acc79c282a8617 Mon Sep 17 00:00:00 2001 From: Sylvain Henry Date: Tue, 31 May 2022 14:34:16 +0200 Subject: Linker: remove JS Shims,tiny GHC.Linker refactor --- compiler/GHC/StgToJS/Linker/Linker.hs | 42 ++++++++++++++++++++++++++--------- 1 file changed, 32 insertions(+), 10 deletions(-) diff --git a/compiler/GHC/StgToJS/Linker/Linker.hs b/compiler/GHC/StgToJS/Linker/Linker.hs index 066a673297..9b6c0ca2d3 100644 --- a/compiler/GHC/StgToJS/Linker/Linker.hs +++ b/compiler/GHC/StgToJS/Linker/Linker.hs @@ -195,10 +195,13 @@ link env lc_cfg cfg logger dflags unit_env out include pkgs objFiles jsFiles isR BL.writeFile (out "rts.js") (BLC.pack (T.unpack rtsDeclsText) <> BL.fromChunks withRts <> BLC.pack (T.unpack $ rtsText cfg)) - lla' <- mapM (tryReadShimFile dflags) lla - llarch' <- mapM (readShimsArchive dflags) llarch - BL.writeFile (out "lib" <.> jsExt) - (BL.fromChunks $ llarch' ++ lla') + -- FIXME (Sylvain, 2022-05): disable shims + -- lla' <- mapM (tryReadShimFile dflags) lla + -- llarch' <- mapM (readShimsArchive dflags) llarch + -- let lib_js = BL.fromChunks $ llarch' ++ lla' + let lib_js = BL.empty + BL.writeFile (out "lib" <.> jsExt) lib_js + if genBase then generateBase out lbase else when ( not (lcOnlyOut lc_cfg) @@ -211,7 +214,8 @@ link env lc_cfg cfg logger dflags unit_env out include pkgs objFiles jsFiles isR writeHtml top out writeRunMain top out writeRunner lc_cfg out - writeWebAppManifest top out + -- FIXME (Sylvain 2022-05): disabled for now + -- writeWebAppManifest top out writeExterns out -- | link in memory @@ -382,9 +386,9 @@ combineFiles :: JSLinkConfig -> IO () combineFiles cfg top fp = do files <- mapM (B.readFile.(fp)) ["rts.js", "lib.js", "out.js"] - runMain <- if lcNoHsMain cfg - then pure mempty - else B.readFile (top "runmain.js") + let runMain + | lcNoHsMain cfg = mempty + | otherwise = runMainJS writeBinaryFile (fp"all.js") (mconcat (files ++ [runMain])) -- | write the index.html file that loads the program if it does not exit @@ -394,10 +398,25 @@ writeHtml :: FilePath -- ^ top level library directory writeHtml top out = do e <- doesFileExist htmlFile unless e $ - B.readFile (top "template.html") >>= B.writeFile htmlFile + B.writeFile htmlFile templateHtml where htmlFile = out "index.html" + +templateHtml :: B.ByteString +templateHtml = + "\ + \\ + \ \ + \ \ + \ \ + \ \ + \ \ + \ \ + \ \ + \ \ + \" + -- | write the runmain.js file that will be run with defer so that it runs after -- index.html is loaded writeRunMain :: FilePath -- ^ top level library directory @@ -406,10 +425,13 @@ writeRunMain :: FilePath -- ^ top level library directory writeRunMain top out = do e <- doesFileExist runMainFile unless e $ - B.readFile (top "runmain.js") >>= B.writeFile runMainFile + B.writeFile runMainFile runMainJS where runMainFile = out "runmain.js" +runMainJS :: B.ByteString +runMainJS = "h$main(h$mainZCZCMainzimain);\n" + -- FIXME: Jeff (2022,03): Use Newtypes instead of Strings for these directories writeRunner :: JSLinkConfig -- ^ Settings -> FilePath -- ^ Output directory -- cgit v1.2.1