[Git][ghc/ghc][wip/js-staging] CPP: fix LINE markers. Only disable them for JS

[Sylvain Henry (@hsyl20)]

Sylvain Henry pushed to branch wip/js-staging at Glasgow Haskell Compiler / GHC


Commits:
48f77448 by Sylvain Henry at 2022-08-30T11:11:49+02:00
CPP: fix LINE markers. Only disable them for JS

- - - - -


2 changed files:

- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/StgToJS/Linker/Shims.hs


Changes:

=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -122,7 +122,10 @@ runPhase (T_CmmCpp pipe_env hsc_env input_fn) = do
         (hsc_tmpfs hsc_env)
         (hsc_dflags hsc_env)
         (hsc_unit_env hsc_env)
-        False{-not raw-}
+        (CppOpts
+          { cppUseCc       = True
+          , cppLinePragmas = True
+          })
         []
         input_fn output_fn
   return output_fn
@@ -629,7 +632,10 @@ runCppPhase hsc_env input_fn output_fn = do
            (hsc_tmpfs hsc_env)
            (hsc_dflags hsc_env)
            (hsc_unit_env hsc_env)
-           True{-raw-}
+           (CppOpts
+              { cppUseCc = False
+              , cppLinePragmas = True
+              })
            []
            input_fn output_fn
   return output_fn
@@ -970,11 +976,16 @@ offsetIncludePaths dflags (IncludeSpecs incs quotes impl) =
 -- -----------------------------------------------------------------------------
 -- Running CPP
 
+data CppOpts = CppOpts
+  { cppUseCc       :: !Bool -- ^ Use "cc -E" as preprocessor, otherwise use "cpp"
+  , cppLinePragmas :: !Bool -- ^ Enable generation of LINE pragmas
+  }
+
 -- | Run CPP
 --
 -- UnitEnv is needed to compute MIN_VERSION macros
-doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> Bool -> [Option] -> FilePath -> FilePath -> IO ()
-doCpp logger tmpfs dflags unit_env raw extra_opts input_fn output_fn = do
+doCpp :: Logger -> TmpFs -> DynFlags -> UnitEnv -> CppOpts -> [Option] -> FilePath -> FilePath -> IO ()
+doCpp logger tmpfs dflags unit_env opts extra_opts input_fn output_fn = do
     let hscpp_opts = picPOpts dflags
     let cmdline_include_paths = offsetIncludePaths dflags (includePaths dflags)
     let unit_state = ue_units unit_env
@@ -998,9 +1009,10 @@ doCpp logger tmpfs dflags unit_env raw extra_opts input_fn output_fn = do
 
     let verbFlags = getVerbFlags dflags
 
-    let cpp_prog args | raw       = GHC.SysTools.runCpp logger dflags args
-                      | otherwise = GHC.SysTools.runCc Nothing logger tmpfs dflags
-                                        (GHC.SysTools.Option "-E" : args)
+    let cpp_prog args
+          | cppUseCc opts = GHC.SysTools.runCc Nothing logger tmpfs dflags
+                                               (GHC.SysTools.Option "-E" : args)
+          | otherwise     = GHC.SysTools.runCpp logger dflags args
 
     let platform   = targetPlatform dflags
         targetArch = stringEncodeArch $ platformArch platform
@@ -1053,6 +1065,10 @@ doCpp logger tmpfs dflags unit_env raw extra_opts input_fn output_fn = do
                     return [GHC.SysTools.FileOption "-include" macro_stub]
             else return []
 
+    let line_pragmas
+          | cppLinePragmas opts = [] -- on by default
+          | otherwise           = [GHC.SysTools.Option "-P"] -- disable LINE markers
+
     cpp_prog       (   map GHC.SysTools.Option verbFlags
                     ++ map GHC.SysTools.Option include_paths
                     ++ map GHC.SysTools.Option hsSourceCppOpts
@@ -1065,13 +1081,13 @@ doCpp logger tmpfs dflags unit_env raw extra_opts input_fn output_fn = do
                     ++ map GHC.SysTools.Option io_manager_defs
                     ++ mb_macro_include
                     ++ extra_opts
+                    ++ line_pragmas
         -- Set the language mode to assembler-with-cpp when preprocessing. This
         -- alleviates some of the C99 macro rules relating to whitespace and the hash
         -- operator, which we tend to abuse. Clang in particular is not very happy
         -- about this.
                     ++ [ GHC.SysTools.Option     "-x"
                        , GHC.SysTools.Option     "assembler-with-cpp"
-                       , GHC.SysTools.Option     "-P" -- disable line markers
                        , GHC.SysTools.Option     input_fn
         -- We hackily use Option instead of FileOption here, so that the file
         -- name is not back-slashed on Windows.  cpp is capable of


=====================================
compiler/GHC/StgToJS/Linker/Shims.hs
=====================================
@@ -32,7 +32,7 @@ import           GHC.StgToJS.Linker.Utils
 
 import           System.FilePath
 import           GHC.Driver.Session
-import           GHC.Driver.Pipeline.Execute (doCpp)
+import           GHC.Driver.Pipeline.Execute (doCpp, CppOpts(..))
 
 import           GHC.Unit.Env
 import           GHC.Utils.TmpFs
@@ -166,7 +166,10 @@ tryReadShimFile logger tmpfs dflags unit_env file = do
   if needsCpp file
   then do
     let profiling = False
-        use_cpp_and_not_cc_dash_E = False
+        cpp_opts = CppOpts
+          { cppUseCc       = True
+          , cppLinePragmas = False -- LINE pragmas aren't JS compatible
+          }
         extra_opts = []
 
     -- load the shim into memory
@@ -179,7 +182,7 @@ tryReadShimFile logger tmpfs dflags unit_env file = do
            B.writeFile infile $ (commonCppDefs profiling) <> payload
            outfile <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "jspp"
            -- do the business
-           doCpp logger tmpfs dflags unit_env use_cpp_and_not_cc_dash_E extra_opts infile outfile
+           doCpp logger tmpfs dflags unit_env cpp_opts extra_opts infile outfile
            B.readFile outfile
   else parseShim file
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48f7744844bfabb4e41e2d886c25b9765e5edfca

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/48f7744844bfabb4e41e2d886c25b9765e5edfca
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/20220830/973218f8/attachment-0001.html>