Compute LambdaFormInfo when using JavaScript backend.

CmmCgInfos is needed to write interface files, but the
JavaScript backend does not generate it, causing
"Name without LFInfo" warnings.

This patch adds a conservative but always correct
CmmCgInfos when the JavaScript backend is used.

Fixes #23053

5 files changed, 21 insertions, 8 deletions

diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 97a47c8df6..3321d1203f 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -204,7 +204,7 @@ import GHC.Builtin.Names
 import GHC.Builtin.Uniques ( mkPseudoUniqueE )
 
 import qualified GHC.StgToCmm as StgToCmm ( codeGen )
-import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos)
+import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos, LambdaFormInfo(..))
 
 import GHC.Cmm
 import GHC.Cmm.Info.Build
@@ -230,6 +230,7 @@ import GHC.Types.Id
 import GHC.Types.SourceError
 import GHC.Types.SafeHaskell
 import GHC.Types.ForeignStubs
+import GHC.Types.Name.Env      ( mkNameEnv )
 import GHC.Types.Var.Env       ( emptyTidyEnv )
 import GHC.Types.Error
 import GHC.Types.Fixity.Env
@@ -1872,7 +1873,19 @@ hscGenHardCode hsc_env cgguts location output_filename = do
             JSCodeOutput ->
               do
               let js_config = initStgToJSConfig dflags
-                  cmm_cg_infos  = Nothing
+
+                  -- The JavaScript backend does not create CmmCgInfos like the Cmm backend,
+                  -- but it is needed for writing the interface file. Here we compute a very
+                  -- conservative but correct value.
+                  lf_infos (StgTopLifted (StgNonRec b _)) = [(idName b, LFUnknown True)]
+                  lf_infos (StgTopLifted (StgRec bs))     = map (\(b,_) -> (idName b, LFUnknown True)) bs
+                  lf_infos (StgTopStringLit b _)          = [(idName b, LFUnlifted)]
+
+                  cmm_cg_infos  = CmmCgInfos
+                    { cgNonCafs = mempty
+                    , cgLFInfos = mkNameEnv (concatMap lf_infos stg_binds)
+                    , cgIPEStub = mempty
+                    }
                   stub_c_exists = Nothing
                   foreign_fps   = []
 
@@ -1881,7 +1894,7 @@ hscGenHardCode hsc_env cgguts location output_filename = do
 
               -- do the unfortunately effectual business
               stgToJS logger js_config stg_binds this_mod spt_entries foreign_stubs0 cost_centre_info output_filename
-              return (output_filename, stub_c_exists, foreign_fps, Just stg_cg_infos, cmm_cg_infos)
+              return (output_filename, stub_c_exists, foreign_fps, Just stg_cg_infos, Just cmm_cg_infos)
 
             _          ->
               do
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index 40904838d5..53c169ae10 100644
--- a/testsuite/tests/driver/all.T
+++ b/testsuite/tests/driver/all.T
@@ -278,7 +278,7 @@ test('T13604a',
   ], makefile_test, [])
 # omitting hpc and profasm because they affect the
 # inlining and unfoldings
-test('inline-check', [omit_ways(['hpc', 'profasm']), js_broken(22576)]
+test('inline-check', [omit_ways(['hpc', 'profasm'])]
                    , compile
 		   , ['-dinline-check foo -O -ddebug-output'])
 
diff --git a/testsuite/tests/lib/integer/all.T b/testsuite/tests/lib/integer/all.T
index df3883a762..76fee70750 100644
--- a/testsuite/tests/lib/integer/all.T
+++ b/testsuite/tests/lib/integer/all.T
@@ -5,9 +5,9 @@ test('plusMinusInteger', [omit_ways(['ghci'])], compile_and_run, [''])
 test('integerConstantFolding', normal, makefile_test, ['integerConstantFolding'])
 test('naturalConstantFolding', normal, makefile_test, ['naturalConstantFolding'])
 
-test('fromToInteger', js_broken(22576), makefile_test, ['fromToInteger'])
+test('fromToInteger', normal, makefile_test, ['fromToInteger'])
 
-test('IntegerConversionRules', [js_broken(22576)], makefile_test, ['IntegerConversionRules'])
+test('IntegerConversionRules', normal, makefile_test, ['IntegerConversionRules'])
 test('gcdInteger', normal, compile_and_run, [''])
 test('gcdeInteger', normal, compile_and_run, [''])
 test('integerPowMod', [], compile_and_run, [''])
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index bf7f4e58dd..80381ba45c 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -378,7 +378,7 @@ test('T20200a', normal, compile, ['-O2'])
 test('T20200b', normal, compile, ['-O2'])
 test('T20200KG', [extra_files(['T20200KGa.hs', 'T20200KG.hs-boot'])], multimod_compile, ['T20200KG', '-v0 -O2 -fspecialise-aggressively'])
 test('T20639', normal, compile, ['-O2'])
-test('T20894', js_broken(22576), compile, ['-dcore-lint -O1 -ddebug-output'])
+test('T20894', normal, compile, ['-dcore-lint -O1 -ddebug-output'])
 test('T19790',  normal, compile, ['-O -ddump-rule-firings'])
 
 # This one had a Lint failure due to an occurrence analysis bug
diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T
index 615dbe80bb..9da7863314 100644
--- a/testsuite/tests/stranal/should_run/all.T
+++ b/testsuite/tests/stranal/should_run/all.T
@@ -1,6 +1,6 @@
 # Run this always as we compile the test with -O0 and -O1 and check that the
 # output is correct and the same in both cases.
-test('T16197', js_broken(22576), makefile_test, [])
+test('T16197', normal, makefile_test, [])
 
 # Run the rest only in optasm way (which implies -O), we're testing the
 # strictness analyser here