From 264876eb45fdd389e22d5c83eeaf7d13d595c245 Mon Sep 17 00:00:00 2001 From: normalcoder <normalcoder@gmail.com> Date: Sat, 4 Nov 2023 17:34:49 +0100 Subject: [PATCH] Add GHC.Driver.TrailingComma --- compiler/GHC/Driver/Make.hs | 4 ++-- compiler/GHC/Driver/Pipeline/Execute.hs | 4 ++-- compiler/GHC/Driver/SourcePatch.hs | 22 ++++++++++++++++++++++ compiler/GHC/Driver/StringInterpolation.hs | 13 ------------- compiler/GHC/Driver/TrailingComma.hs | 12 ++++++++++++ compiler/ghc.cabal.in | 2 ++ 6 files changed, 40 insertions(+), 17 deletions(-) create mode 100644 compiler/GHC/Driver/SourcePatch.hs create mode 100644 compiler/GHC/Driver/TrailingComma.hs diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index d5a3176c9b86..f365341aeffe 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -154,7 +154,7 @@ import GHC.Types.Unique.DFM (udfmRestrictKeysSet) import GHC.Types.Unique import GHC.Iface.Errors.Types -import GHC.Driver.StringInterpolation +import GHC.Driver.SourcePatch import qualified GHC.Data.Word64Set as W @@ -2311,7 +2311,7 @@ getPreprocessedImports getPreprocessedImports hsc_env src_fn mb_phase maybe_buf = do (pi_local_dflags, pi_hspp_fn) <- ExceptT $ preprocess hsc_env src_fn (fst <$> maybe_buf) mb_phase - pi_hspp_buf <- liftIO $ interpolateStringsInBuffer =<< hGetStringBuffer pi_hspp_fn + pi_hspp_buf <- liftIO $ patchSourceInBuffer =<< hGetStringBuffer pi_hspp_fn (pi_srcimps', pi_theimps', pi_ghc_prim_import, L pi_mod_name_loc pi_mod_name) <- ExceptT $ do let imp_prelude = xopt LangExt.ImplicitPrelude pi_local_dflags diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs index 7949299d4781..32997addd5d1 100644 --- a/compiler/GHC/Driver/Pipeline/Execute.hs +++ b/compiler/GHC/Driver/Pipeline/Execute.hs @@ -77,7 +77,7 @@ import GHC.Driver.Config.Finder import GHC.Rename.Names import GHC.StgToJS.Linker.Linker (embedJsFile) -import GHC.Driver.StringInterpolation +import GHC.Driver.SourcePatch import Language.Haskell.Syntax.Module.Name import GHC.Unit.Home.ModInfo @@ -675,7 +675,7 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do -- gather the imports and module name (hspp_buf,mod_name,imps,src_imps, ghc_prim_imp) <- do - buf <- interpolateStringsInBuffer =<< hGetStringBuffer input_fn + buf <- patchSourceInBuffer =<< hGetStringBuffer input_fn let imp_prelude = xopt LangExt.ImplicitPrelude dflags popts = initParserOpts dflags rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env) diff --git a/compiler/GHC/Driver/SourcePatch.hs b/compiler/GHC/Driver/SourcePatch.hs new file mode 100644 index 000000000000..aef678c9345f --- /dev/null +++ b/compiler/GHC/Driver/SourcePatch.hs @@ -0,0 +1,22 @@ +module GHC.Driver.SourcePatch where + +import GHC.Prelude +import GHC.Data.StringBuffer + +import Foreign.C.String (peekCStringLen) +import Foreign.ForeignPtr +import Foreign.Ptr + +import GHC.Driver.StringInterpolation +import GHC.Driver.TrailingComma + +patchSourceInBuffer :: StringBuffer -> IO StringBuffer +patchSourceInBuffer buf = do + (stringToStringBuffer . patchSource) <$> stringBufferToString buf + +stringBufferToString :: StringBuffer -> IO String +stringBufferToString (StringBuffer buf len _) = do + withForeignPtr buf $ \p -> peekCStringLen (castPtr p, len) + +patchSource :: String -> String +patchSource = removeTrailingCommas . interpolateStrings diff --git a/compiler/GHC/Driver/StringInterpolation.hs b/compiler/GHC/Driver/StringInterpolation.hs index ad3e129b187b..8b594a713b88 100644 --- a/compiler/GHC/Driver/StringInterpolation.hs +++ b/compiler/GHC/Driver/StringInterpolation.hs @@ -1,19 +1,6 @@ module GHC.Driver.StringInterpolation where import GHC.Prelude -import GHC.Data.StringBuffer - -import Foreign.C.String (peekCStringLen) -import Foreign.ForeignPtr -import Foreign.Ptr - -interpolateStringsInBuffer :: StringBuffer -> IO StringBuffer -interpolateStringsInBuffer buf = do - (stringToStringBuffer . interpolateStrings) <$> stringBufferToString buf - -stringBufferToString :: StringBuffer -> IO String -stringBufferToString (StringBuffer buf len _) = do - withForeignPtr buf $ \p -> peekCStringLen (castPtr p, len) interpolateStrings :: String -> String interpolateStrings s = go s WaitingForString diff --git a/compiler/GHC/Driver/TrailingComma.hs b/compiler/GHC/Driver/TrailingComma.hs new file mode 100644 index 000000000000..2f7dca42630d --- /dev/null +++ b/compiler/GHC/Driver/TrailingComma.hs @@ -0,0 +1,12 @@ +module GHC.Driver.TrailingComma where + +import GHC.Prelude + +removeTrailingCommas :: String -> String +removeTrailingCommas s = go s + where + go s = case s of + "" -> "" + ',':'\n':'}':s -> '\n':'}':go s + ',':'\n':']':s -> '\n':' ':']':go s + c:s -> c:go s diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 3b3933654e1a..d42db951df80 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -502,7 +502,9 @@ Library GHC.Driver.Plugins.External GHC.Driver.Ppr GHC.Driver.Session + GHC.Driver.SourcePatch GHC.Driver.StringInterpolation + GHC.Driver.TrailingComma GHC.Hs GHC.Hs.Binds GHC.Hs.Decls -- GitLab