Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: 53aa9b6a by Alan Zimmerman at 2025-04-27T13:28:33+01:00 Implement GHC_CPP undef - - - - - 9 changed files: - compiler/GHC/Parser/PreProcess.hs - compiler/GHC/Parser/PreProcess/ParsePP.hs - compiler/GHC/Parser/PreProcess/State.hs - testsuite/tests/ghc-cpp/GhcCpp01.hs - testsuite/tests/ghc-cpp/GhcCpp01.stderr - utils/check-cpp/Main.hs - utils/check-cpp/ParsePP.hs - utils/check-cpp/PreProcess.hs - utils/check-cpp/State.hs Changes: ===================================== compiler/GHC/Parser/PreProcess.hs ===================================== @@ -264,6 +264,8 @@ processCpp ss = do ppInclude filename Right (CppDefine name args def) -> do ppDefine (MacroName name args) def + Right (CppUndef name) -> do + ppUndef name Right (CppIf cond) -> do val <- cppCond cond ar <- pushAccepting val ===================================== compiler/GHC/Parser/PreProcess/ParsePP.hs ===================================== @@ -29,6 +29,7 @@ parseDirective s = Right toks -> case 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) (THash "#" : TIdentifier "if" : ts) -> Right $ cppIf (map t_str ts) (THash "#" : TIdentifier "ifndef" : ts) -> Right $ cppIfndef (map t_str ts) @@ -54,6 +55,9 @@ cppDefine (TIdentifierLParen n : ts) = Right $ CppDefine (init n) args def cppDefine (TIdentifier n : ts) = Right $ CppDefine n Nothing ts cppDefine (t : _) = Left $ "#define: expecting an identifier, got :" ++ show t +cppUndef :: [String] -> CppDirective +cppUndef ts = CppUndef (combineToks ts) + cppInclude :: [String] -> CppDirective cppInclude ts = CppInclude (combineToks ts) ===================================== compiler/GHC/Parser/PreProcess/State.hs ===================================== @@ -27,6 +27,7 @@ module GHC.Parser.PreProcess.State ( popContinuation, ppDefine, ppIsDefined, + ppUndef, getCppState, ghcCppEnabled, setInLinePragma, @@ -98,6 +99,7 @@ data CppDirective = CppInclude String | -- | name, optional args, replacement CppDefine String (Maybe [String]) MacroDef + | CppUndef String | CppIfdef String | CppIfndef String | CppIf String @@ -332,9 +334,25 @@ addDefine' :: PpState -> MacroName -> MacroDef -> PpState addDefine' s name def = s{pp_defines = insertMacroDef name def (pp_defines s)} +removeDefine :: String -> PP () +removeDefine name = do + accepting <- getAccepting + when accepting $ do + s <- getPpState + setPpState $ removeDefine' s name + +removeDefine' :: PpState -> String -> PpState +removeDefine' s name = + s{pp_defines = Map.delete name (pp_defines s)} + +-- ------------------------------------- + ppDefine :: MacroName -> MacroDef -> PP () ppDefine name val = addDefine name val +ppUndef :: String -> PP () +ppUndef name = removeDefine name + ppIsDefined :: MacroName -> PP Bool ppIsDefined name = do s <- getPpState ===================================== testsuite/tests/ghc-cpp/GhcCpp01.hs ===================================== @@ -18,3 +18,18 @@ x = 5 #if defined(BAR) || defined FOO y = 1 #endif + +#undef FOO +#ifdef FOO +complete junk! +#endif + +-- nested undef +#define AA +#if 0 +#undef AA +#endif + +#ifdef AA +aa = 1 +#endif ===================================== testsuite/tests/ghc-cpp/GhcCpp01.stderr ===================================== @@ -4,8 +4,7 @@ ------------------------------ -#define FOO(A,B) A + B -#define FOO(A,B,C) A + B + C +#define AA #define MIN_VERSION_Cabal(major1,major2,minor) ( ( major1 ) < 3 || ( major1 ) == 3 && ( major2 ) < 14 || ( major1 ) == 3 && ( major2 ) == 14 && ( minor ) <= 1 ) @@ -216,6 +215,29 @@ | - |#if de + +- |#endif + +- | + +- |#undef FOO + +- |#ifdef + +- |#endif + +- | + +- |-- ne +- |#define A +- |#if 0 + + +- |#endif + + | + +- |#ifdef | ------------------------------ ===================================== utils/check-cpp/Main.hs ===================================== @@ -783,6 +783,7 @@ t33 = do t34 :: IO () t34 = do dump + [ "{-# LANGUAGE GHC_CPP #-}" , "module Example4 where" , "" @@ -799,3 +800,23 @@ t34 = do , "#endif" , "" ] + +t35 :: IO () +t35 = do + dump + [ "{-# LANGUAGE GHC_CPP #-}" + , "module Example14 where" + + , "#define FOO" + , "#define FOO(X) X" + , "" + , "#undef FOO" + , "" + , "foo =" + , "#ifdef FOO" + , " 'a'" + , "#else" + , " 'b'" + , "#endif" + , "" + ] ===================================== utils/check-cpp/ParsePP.hs ===================================== @@ -29,6 +29,7 @@ parseDirective s = Right toks -> case 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) (THash "#" : TIdentifier "if" : ts) -> Right $ cppIf (map t_str ts) (THash "#" : TIdentifier "ifndef" : ts) -> Right $ cppIfndef (map t_str ts) @@ -54,6 +55,9 @@ cppDefine (TIdentifierLParen n : ts) = Right $ CppDefine (init n) args def cppDefine (TIdentifier n : ts) = Right $ CppDefine n Nothing ts cppDefine (t : _) = Left $ "#define: expecting an identifier, got :" ++ show t +cppUndef :: [String] -> CppDirective +cppUndef ts = CppUndef (combineToks ts) + cppInclude :: [String] -> CppDirective cppInclude ts = CppInclude (combineToks ts) ===================================== utils/check-cpp/PreProcess.hs ===================================== @@ -293,6 +293,8 @@ processCpp ss = do ppInclude filename Right (CppDefine name args def) -> do ppDefine (MacroName name args) def + Right (CppUndef name) -> do + ppUndef name Right (CppIf cond) -> do val <- cppCond cond ar <- pushAccepting val ===================================== utils/check-cpp/State.hs ===================================== @@ -27,6 +27,7 @@ module State ( popContinuation, ppDefine, ppIsDefined, + ppUndef, getCppState, ghcCppEnabled, setInLinePragma, @@ -99,6 +100,7 @@ data CppDirective = CppInclude String | -- | name, optional args, replacement CppDefine String (Maybe [String]) MacroDef + | CppUndef String | CppIfdef String | CppIfndef String | CppIf String @@ -333,9 +335,25 @@ addDefine' :: PpState -> MacroName -> MacroDef -> PpState addDefine' s name def = s{pp_defines = insertMacroDef name def (pp_defines s)} +removeDefine :: String -> PP () +removeDefine name = do + accepting <- getAccepting + when accepting $ do + s <- getPpState + setPpState $ removeDefine' s name + +removeDefine' :: PpState -> String -> PpState +removeDefine' s name = + s{pp_defines = Map.delete name (pp_defines s)} + +-- ------------------------------------- + ppDefine :: MacroName -> MacroDef -> PP () ppDefine name val = addDefine name val +ppUndef :: String -> PP () +ppUndef name = removeDefine name + ppIsDefined :: MacroName -> PP Bool ppIsDefined name = do s <- getPpState View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53aa9b6a95ca7b721c8ff0b90074f9da... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/53aa9b6a95ca7b721c8ff0b90074f9da... You're receiving this email because of your account on gitlab.haskell.org.