diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index d5a3176c9b865107121c4018f4cf053b6982deaa..f365341aeffe7c1f156cd4bb4c7316aba287bb3c 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 7949299d4781196188337785761551a61fad6d36..32997addd5d15ccd8a0be6a38fb2066531a4b526 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 0000000000000000000000000000000000000000..aef678c9345fe43ebdcb87ca95cea3a1f50fac99 --- /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 ad3e129b187bdfc800d3573ad9b05a55c0bad5ae..8b594a713b88f00f2dd0ab0492c647b889e6f79e 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 0000000000000000000000000000000000000000..2f7dca42630dcff192085f36e1ca6d8b6a65b5d9 --- /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 3b3933654e1aed994f676578000159ea0d7d6d92..d42db951df80a75e5239e6c4466efdea00a54c00 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