[Git][ghc/ghc][wip/az/ghc-cpp] Trying my alternative pragma syntax.
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Sun Feb 23 22:37:19 UTC 2025
Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC
Commits:
b91a28c1 by Alan Zimmerman at 2025-02-23T22:36:06+00:00
Trying my alternative pragma syntax.
It works, but dumpGhcCpp is broken, I suspect from the ITcpp token
span update.
- - - - -
6 changed files:
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PreProcess.hs
- + utils/check-cpp/Example3.hs
- + utils/check-cpp/Example4.hs
Changes:
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -535,7 +535,7 @@ hscParse' mod_summary
NoBlankEpAnnotations
rdr_module)
liftIO $ putDumpFileMaybe logger Opt_D_dump_ghc_cpp "After GHC_CPP"
- FormatHaskell (dumpGhcCpp p_state)
+ FormatHaskell (dumpGhcCpp dflags p_state)
liftIO $ putDumpFileMaybe logger Opt_D_source_stats "Source Statistics"
FormatText (ppSourceStats False rdr_module)
@@ -2690,7 +2690,7 @@ hscParseThingWithLocation source linenumber parser str = do
liftIO $ putDumpFileMaybe logger Opt_D_dump_parsed_ast "Parser AST"
FormatHaskell (showAstData NoBlankSrcSpan NoBlankEpAnnotations thing)
liftIO $ putDumpFileMaybe logger Opt_D_dump_ghc_cpp "After GHC_CPP"
- FormatHaskell (dumpGhcCpp p_state)
+ FormatHaskell (dumpGhcCpp dflags p_state)
return thing
hscTidy :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails)
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -3592,6 +3592,10 @@ makeDynFlagsConsistent dflags
, Nothing <- outputFile dflags
= pgmError "--output must be specified when using --merge-objs"
+ | xopt LangExt.Cpp dflags && xopt LangExt.GhcCpp dflags
+ = loop (xopt_unset dflags LangExt.Cpp)
+ "Disabling CPP, because GHC_CPP is also enabled"
+
| otherwise = (dflags, mempty)
where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")
loop updated_dflags warning
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -408,11 +408,16 @@ $unigraphic / { isSmartQuote } { smart_quote_error }
-- ToDo: should only be valid inside a pragma:
"#-}" { endPrag }
+ -- TODO: distinguish from the case above, to match the only allowed option, GHC_CPP
+ "!-}" { endPrag }
}
<option_prags> {
"{-#" $whitechar* $pragmachar+ / { known_pragma fileHeaderPrags }
{ dispatch_pragmas fileHeaderPrags }
+ -- TODO: distinguish from case above, to check the end properly
+ "{-!" $whitechar* $pragmachar+ / { known_pragma fileHeaderPrags }
+ { dispatch_pragmas fileHeaderPrags }
}
<0> {
=====================================
compiler/GHC/Parser/PreProcess.hs
=====================================
@@ -19,6 +19,8 @@ import Debug.Trace (trace)
import GHC.Data.FastString
import GHC.Data.Strict qualified as Strict
import GHC.Data.StringBuffer
+import GHC.Driver.DynFlags (DynFlags, xopt)
+import GHC.LanguageExtensions qualified as LangExt
import GHC.Parser.Errors.Ppr ()
import GHC.Parser.Lexer (P (..), PState (..), ParseResult (..), Token (..))
import GHC.Parser.Lexer qualified as Lexer
@@ -33,9 +35,12 @@ import GHC.Utils.Panic.Plain (panic)
-- ---------------------------------------------------------------------
-dumpGhcCpp :: PState PpState -> SDoc
-dumpGhcCpp pst = text $ sepa ++ defines ++ sepa ++ final ++ sepa
+ttrace x s = trace s x
+
+dumpGhcCpp :: DynFlags -> PState PpState -> SDoc
+dumpGhcCpp dflags pst = text $ sepa ++ defines ++ sepa ++ final ++ sepa
where
+ ghc_cpp_enabled = xopt LangExt.GhcCpp dflags
-- Note: pst is the state /before/ the parser runs, so we can use it to lex.
(pst_final, bare_toks) = lexAll pst
comments = reverse (Lexer.comment_q pst_final)
@@ -43,13 +48,21 @@ dumpGhcCpp pst = text $ sepa ++ defines ++ sepa ++ final ++ sepa
to_tok (L (EpaSpan l) _) = L l (ITunknown "-")
to_tok (L (EpaDelta l _ _) _) = L l (ITunknown "-")
comments_as_toks = map to_tok comments
- defines = showDefines (pp_defines (pp pst_final))
+ defines =
+ showDefines ((pp_defines (pp pst_final))
+ `ttrace` ("dumpGhcCpp: (pp_defines (pp pst_final))" ++ show (pp_defines (pp pst_final))))
sepa = "\n------------------------------\n"
startLoc = mkRealSrcLoc (srcLocFile (psRealLoc $ loc pst)) 1 1
buf1 = (buffer pst){cur = 0}
- all_toks = sortBy cmpBs (bare_toks ++ comments_as_toks)
- toks = addSourceToTokens startLoc buf1 all_toks
- final = renderCombinedToks toks
+ all_toks =
+ sortBy cmpBs ((bare_toks ++ comments_as_toks)
+ `ttrace` ("dumpGhcCpp: comments_as_toks" ++ show comments_as_toks))
+ toks =
+ addSourceToTokens startLoc buf1 (all_toks
+ `ttrace` ("dumpGhcCpp: all_toks" ++ show all_toks))
+ final =
+ renderCombinedToks (toks
+ `ttrace` ("dumpGhcCpp: toks" ++ show toks))
cmpBs :: Located Token -> Located Token -> Ordering
cmpBs (L (RealSrcSpan _ (Strict.Just bs1)) _) (L (RealSrcSpan _ (Strict.Just bs2)) _) =
=====================================
utils/check-cpp/Example3.hs
=====================================
@@ -0,0 +1,26 @@
+{-# LANGUAGE GHC_CPP #-}
+{-# OPTIONS -ddump-ghc-cpp -dkeep-comments #-}
+module Example3 where
+
+/* package ghc-exactprint-1.7.0.1 */
+#ifndef VERSION_ghc_exactprint
+#define VERSION_ghc_exactprint "1.7.0.1"
+#endif /* VERSION_ghc_exactprint */
+#ifndef MIN_VERSION_ghc_exactprint
+#define MIN_VERSION_ghc_exactprint(major1,major2,minor) (\
+ (major1) < 1 || \
+ (major1) == 1 && (major2) < 7 || \
+ (major1) == 1 && (major2) == 7 && (minor) <= 0)
+#endif /* MIN_VERSION_ghc_exactprint */
+
+#ifdef VERSION_ghc_exactprint
+x = "got version"
+#else
+x = "no version"
+#endif
+
+#if MIN_VERSION_ghc(9,13,0)
+y = 1
+#else
+y = 2
+#endif
=====================================
utils/check-cpp/Example4.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE CPP #-}
+{-! LANGUAGE GHC_CPP !-}
+{-# OPTIONS -ddump-ghc-cpp -dkeep-comments #-}
+
+module Example4 where
+
+x :: Int
+x = 1
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b91a28c1027428a2ef7170451b312b7be6cd83b1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b91a28c1027428a2ef7170451b312b7be6cd83b1
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/20250223/90283cd2/attachment-0001.html>
More information about the ghc-commits
mailing list