Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: 497d6c7e by Alan Zimmerman at 2025-05-15T22:45:53+01:00 Do not process CPP-style comments - - - - - 2 changed files: - compiler/GHC/Parser/Lexer.x - utils/check-cpp/Main.hs Changes: ===================================== compiler/GHC/Parser/Lexer.x ===================================== @@ -273,7 +273,7 @@ $tab { warnTab } -- set. "{-" / { isNormalComment } { nested_comment } -"/*" / { ifExtension GhcCppBit } { nested_comment } +-- "/*" / { ifExtension GhcCppBit } { nested_comment } -- Single-line comments are a bit tricky. Haskell 98 says that two or -- more dashes followed by a symbol should be parsed as a varsym, so we @@ -1587,6 +1587,16 @@ nested_doc_comment span buf _len _buf2 = {-# SCC "nested_doc_comment" #-} withLe dropTrailingDec "-}" = "" dropTrailingDec (x:xs) = x:dropTrailingDec xs +-- TODO:AZ delete this +nested_cpp_comment :: Action p +nested_cpp_comment span buf len _buf2 = {-# SCC "nested_comment" #-} do + l <- getLastLocIncludingComments + let endComment input (L _ comment) = commentEnd lexToken input (Nothing, ITblockComment comment l) buf span + input <- getInput + -- Include decorator in comment + let start_decorator = reverse $ lexemeToString buf len + nested_cpp_comment_logic endComment start_decorator input span + {-# INLINE nested_comment_logic #-} -- | Includes the trailing '-}' decorators -- drop the last two elements with the callback if you don't want them to be included @@ -1597,6 +1607,41 @@ nested_comment_logic -> PsSpan -> P p (PsLocated Token) nested_comment_logic endComment commentAcc input span = go commentAcc (1::Int) input + where + go commentAcc 0 input@(AI end_loc _) = do + let comment = reverse commentAcc + cspan = mkSrcSpanPs $ mkPsSpan (psSpanStart span) end_loc + lcomment = L cspan comment + endComment input lcomment + go commentAcc n input = ghcCppSet >>= \ghcCppSet -> case alexGetChar' input of + Nothing -> errBrace input (psRealSpan span) + Just ('-',input) -> case alexGetChar' input of + Nothing -> errBrace input (psRealSpan span) + Just ('\125',input) -> go ('\125':'-':commentAcc) (n-1) input -- '}' + Just (_,_) -> go ('-':commentAcc) n input + Just ('\123',input) -> case alexGetChar' input of -- '{' char + Nothing -> errBrace input (psRealSpan span) + Just ('-',input) -> go ('-':'\123':commentAcc) (n+1) input + Just (_,_) -> go ('\123':commentAcc) n input + -- See Note [Nested comment line pragmas] + Just ('\n',input) -> case alexGetChar' input of + Nothing -> errBrace input (psRealSpan span) + Just ('#',_) -> do (parsedAcc,input) <- parseNestedPragma input + go (parsedAcc ++ '\n':commentAcc) n input + Just (_,_) -> go ('\n':commentAcc) n input + Just (c,input) -> go (c:commentAcc) n input + +-- TODO:AZ delete this +{-# INLINE nested_cpp_comment_logic #-} +-- | Includes the trailing '*/' decorators +-- drop the last two elements with the callback if you don't want them to be included +nested_cpp_comment_logic + :: (AlexInput -> Located String -> P p (PsLocated Token)) -- ^ Continuation that gets the rest of the input and the lexed comment + -> String -- ^ starting value for accumulator (reversed) - When we want to include a decorator '/*' in the comment + -> AlexInput + -> PsSpan + -> P p (PsLocated Token) +nested_cpp_comment_logic endComment commentAcc input span = go commentAcc (1::Int) input where go commentAcc 0 input@(AI end_loc _) = do let comment = reverse commentAcc @@ -1629,6 +1674,7 @@ nested_comment_logic endComment commentAcc input span = go commentAcc (1::Int) i Just (_,_) -> go ('\n':commentAcc) n input (_, Just (c,input)) -> go (c:commentAcc) n input + ghcCppSet :: P p Bool ghcCppSet = do exts <- getExts ===================================== utils/check-cpp/Main.hs ===================================== @@ -868,13 +868,13 @@ t38 = do , "buildg = 1" ] --- t39 :: IO () --- t39 = do --- dump --- [ "{-# LANGUAGE GHC_CPP #-}" --- , "{- WARNING! Do not edit!!!" --- , " This code is autogenerated from src/data/*.txt! -}" --- , "module Example16 where" --- , "x='a'" --- , "" --- ] +t39 :: IO () +t39 = do + dump + [ "{-# LANGUAGE GHC_CPP #-}" + , "{- WARNING! Do not edit!!!" + , " This code is autogenerated from src/data/*.txt! -}" + , "module Example16 where" + , "x='a'" + , "" + ] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/497d6c7e1af9df6b9712a2e50af04819... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/497d6c7e1af9df6b9712a2e50af04819... You're receiving this email because of your account on gitlab.haskell.org.