Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: 4acbeff0 by Alan Zimmerman at 2025-05-06T22:42:27+01:00 Process comments in CPP directives - - - - - 9 changed files: - compiler/GHC/Parser/PreProcess/Lexer.x - compiler/GHC/Parser/PreProcess/ParsePP.hs - compiler/GHC/Parser/PreProcess/ParserM.hs - testsuite/tests/ghc-cpp/GhcCpp01.hs - testsuite/tests/ghc-cpp/GhcCpp01.stderr - utils/check-cpp/Lexer.x - utils/check-cpp/Main.hs - utils/check-cpp/ParsePP.hs - utils/check-cpp/ParserM.hs Changes: ===================================== compiler/GHC/Parser/PreProcess/Lexer.x ===================================== @@ -22,6 +22,8 @@ words :- <0> $white+ ; --------------------------------------- + <0> "//" .* { mkTv TComment } + <0> "/*" .* "*/" { mkTv TComment } <0> "{" { mkTv TOpenBrace } <0> "}" { mkTv TCloseBrace } <0> "[" { mkTv TOpenBracket } ===================================== compiler/GHC/Parser/PreProcess/ParsePP.hs ===================================== @@ -27,7 +27,7 @@ parseDirective s = case cppLex True s of Left e -> Left e Right toks -> - case toks of + case map deComment toks of (THash "#" : TIdentifier "define" : ts) -> cppDefine ts (THash "#" : TIdentifier "undef" : ts) -> Right $ cppUndef (map t_str ts) (THash "#" : TIdentifier "include" : ts) -> Right $ cppInclude (map t_str ts) @@ -112,6 +112,13 @@ cppLex sd s = case lexCppTokenStream s (init_state {scanning_directive = sd}) of Left err -> Left err Right (_inp, _st, toks) -> Right toks +-- Each comment is replaced with a space +-- https://timsong-cpp.github.io/cppwp/n4140/lex#phases-1.3 +deComment :: Token -> Token +deComment (TComment _) = TComment " " +deComment t = t + + -- --------------------------------------------------------------------- doATest :: String -> Either String CppDirective ===================================== compiler/GHC/Parser/PreProcess/ParserM.hs ===================================== @@ -91,6 +91,8 @@ init_state = data Token = TEOF {t_str :: String} + | -- https://timsong-cpp.github.io/cppwp/n4140/lex.comment + TComment {t_str :: String} | TIdentifier {t_str :: String} | TIdentifierLParen {t_str :: String} | TInteger {t_str :: String} ===================================== testsuite/tests/ghc-cpp/GhcCpp01.hs ===================================== @@ -18,13 +18,13 @@ y = 1 #endif #undef FOO -#ifdef FOO +#ifdef FOO /* Check for FOO */ complete junk! #endif -- nested undef #define AA -#if 0 +#if /* hard code for now */ 0 #undef AA #endif ===================================== testsuite/tests/ghc-cpp/GhcCpp01.stderr ===================================== @@ -217,13 +217,13 @@ - |#endif - |#undef FOO -- |#ifdef FOO +- |#ifdef FOO /* Check for FOO */ - |complete junk! - |#endif - |-- nested undef - |#define AA -- |#if 0 +- |#if /* hard code for now */ 0 - |#undef AA - |#endif ===================================== utils/check-cpp/Lexer.x ===================================== @@ -21,6 +21,8 @@ words :- <0> $white+ ; --------------------------------------- + <0> "//" .* { mkTv TComment } + <0> "/*" .* "*/" { mkTv TComment } <0> "{" { mkTv TOpenBrace } <0> "}" { mkTv TCloseBrace } <0> "[" { mkTv TOpenBracket } ===================================== utils/check-cpp/Main.hs ===================================== @@ -838,3 +838,18 @@ t36 = do , "#endif" , "" ] + +t37 :: IO () +t37 = do + dump + [ "{-# LANGUAGE GHC_CPP #-}" + , "module Example14 where" + , "" + , "foo =" + , "#if 1 /* and a comment */" + , " 'a'" + , "#else" + , " 'b'" + , "#endif" + , "" + ] ===================================== utils/check-cpp/ParsePP.hs ===================================== @@ -27,7 +27,7 @@ parseDirective s = case cppLex True s of Left e -> Left e Right toks -> - case toks of + case map deComment toks of (THash "#" : TIdentifier "define" : ts) -> cppDefine ts (THash "#" : TIdentifier "undef" : ts) -> Right $ cppUndef (map t_str ts) (THash "#" : TIdentifier "include" : ts) -> Right $ cppInclude (map t_str ts) @@ -112,6 +112,13 @@ cppLex sd s = case lexCppTokenStream s (init_state {scanning_directive = sd}) of Left err -> Left err Right (_inp, _st, toks) -> Right toks +-- Each comment is replaced with a space +-- https://timsong-cpp.github.io/cppwp/n4140/lex#phases-1.3 +deComment :: Token -> Token +deComment (TComment _) = TComment " " +deComment t = t + + -- --------------------------------------------------------------------- doATest :: String -> Either String CppDirective ===================================== utils/check-cpp/ParserM.hs ===================================== @@ -91,6 +91,8 @@ init_state = data Token = TEOF {t_str :: String} + | -- https://timsong-cpp.github.io/cppwp/n4140/lex.comment + TComment {t_str :: String} | TIdentifier {t_str :: String} | TIdentifierLParen {t_str :: String} | TInteger {t_str :: String} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4acbeff0a067efe77bbb040baca3c1d5... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4acbeff0a067efe77bbb040baca3c1d5... You're receiving this email because of your account on gitlab.haskell.org.