Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC

Commits:

9 changed files:

Changes:

  • compiler/GHC/Parser/PreProcess.hs
    ... ... @@ -264,6 +264,8 @@ processCpp ss = do
    264 264 
                         ppInclude filename
    265 265 
                     Right (CppDefine name args def) -> do
    266 266 
                         ppDefine (MacroName name args) def
    267 
    +                Right (CppUndef name) -> do
    268 
    +                    ppUndef name
    267 269 
                     Right (CppIf cond) -> do
    268 270 
                         val <- cppCond cond
    269 271 
                         ar <- pushAccepting val

  • compiler/GHC/Parser/PreProcess/ParsePP.hs
    ... ... @@ -29,6 +29,7 @@ parseDirective s =
    29 29 
             Right toks ->
    30 30 
                 case toks of
    31 31 
                     (THash "#" : TIdentifier "define" : ts) -> cppDefine ts
    32 
    +                (THash "#" : TIdentifier "undef" : ts) -> Right $ cppUndef (map t_str ts)
    32 33 
                     (THash "#" : TIdentifier "include" : ts) -> Right $ cppInclude (map t_str ts)
    33 34 
                     (THash "#" : TIdentifier "if" : ts) -> Right $ cppIf (map t_str ts)
    34 35 
                     (THash "#" : TIdentifier "ifndef" : ts) -> Right $ cppIfndef (map t_str ts)
    ... ... @@ -54,6 +55,9 @@ cppDefine (TIdentifierLParen n : ts) = Right $ CppDefine (init n) args def
    54 55 
     cppDefine (TIdentifier n : ts) = Right $ CppDefine n Nothing ts
    55 56 
     cppDefine (t : _) = Left $ "#define: expecting an identifier, got :" ++ show t
    56 57
    58 
    +cppUndef :: [String] -> CppDirective
    59 
    +cppUndef ts = CppUndef (combineToks ts)
    60 
    +
    57 61 
     cppInclude :: [String] -> CppDirective
    58 62 
     cppInclude ts = CppInclude (combineToks ts)
    59 63

  • compiler/GHC/Parser/PreProcess/State.hs
    ... ... @@ -27,6 +27,7 @@ module GHC.Parser.PreProcess.State (
    27 27 
         popContinuation,
    28 28 
         ppDefine,
    29 29 
         ppIsDefined,
    30 
    +    ppUndef,
    30 31 
         getCppState,
    31 32 
         ghcCppEnabled,
    32 33 
         setInLinePragma,
    ... ... @@ -98,6 +99,7 @@ data CppDirective
    98 99 
         = CppInclude String
    99 100 
         | -- | name, optional args, replacement
    100 101 
           CppDefine String (Maybe [String]) MacroDef
    102 
    +    | CppUndef String
    101 103 
         | CppIfdef String
    102 104 
         | CppIfndef String
    103 105 
         | CppIf String
    ... ... @@ -332,9 +334,25 @@ addDefine' :: PpState -> MacroName -> MacroDef -> PpState
    332 334 
     addDefine' s name def =
    333 335 
         s{pp_defines = insertMacroDef name def (pp_defines s)}
    334 336
    337 
    +removeDefine :: String -> PP ()
    338 
    +removeDefine name = do
    339 
    +    accepting <- getAccepting
    340 
    +    when accepting $ do
    341 
    +        s <- getPpState
    342 
    +        setPpState $ removeDefine' s name
    343 
    +
    344 
    +removeDefine' :: PpState -> String -> PpState
    345 
    +removeDefine' s name =
    346 
    +    s{pp_defines = Map.delete name (pp_defines s)}
    347 
    +
    348 
    +-- -------------------------------------
    349 
    +
    335 350 
     ppDefine :: MacroName -> MacroDef -> PP ()
    336 351 
     ppDefine name val = addDefine name val
    337 352
    353 
    +ppUndef :: String -> PP ()
    354 
    +ppUndef name = removeDefine name
    355 
    +
    338 356 
     ppIsDefined :: MacroName -> PP Bool
    339 357 
     ppIsDefined name = do
    340 358 
         s <- getPpState

  • testsuite/tests/ghc-cpp/GhcCpp01.hs
    ... ... @@ -18,3 +18,18 @@ x = 5
    18 18 
     #if defined(BAR) || defined FOO
    19 19 
     y = 1
    20 20 
     #endif
    21 
    +
    22 
    +#undef FOO
    23 
    +#ifdef FOO
    24 
    +complete junk!
    25 
    +#endif
    26 
    +
    27 
    +-- nested undef
    28 
    +#define AA
    29 
    +#if 0
    30 
    +#undef AA
    31 
    +#endif
    32 
    +
    33 
    +#ifdef AA
    34 
    +aa = 1
    35 
    +#endif

  • testsuite/tests/ghc-cpp/GhcCpp01.stderr
    ... ... @@ -4,8 +4,7 @@
    4 4 
     ------------------------------
    5 5
    6 6
    7 
    -#define FOO(A,B) A + B
    8 
    -#define FOO(A,B,C) A + B + C
    7 
    +#define AA
    9 8
    10 9
    11 10 
     #define MIN_VERSION_Cabal(major1,major2,minor) ( ( major1 ) < 3 || ( major1 ) == 3 && ( major2 ) < 14 || ( major1 ) == 3 && ( major2 ) == 14 && ( minor ) <= 1 )
    ... ... @@ -216,6 +215,29 @@
    216 215 
       |
    217 216
    218 217 
     - |#if de
    218 
    +
    219 
    +- |#endif
    220 
    +
    221 
    +- |
    222 
    +
    223 
    +- |#undef FOO
    224 
    +
    225 
    +- |#ifdef
    226 
    +
    227 
    +- |#endif
    228 
    +
    229 
    +- |
    230 
    +
    231 
    +- |-- ne
    232 
    +- |#define A
    233 
    +- |#if 0
    234 
    +
    235 
    +
    236 
    +- |#endif
    237 
    +
    238 
    +  |
    239 
    +
    240 
    +- |#ifdef
    219 241 
       |
    220 242 
     ------------------------------
    221 243

  • utils/check-cpp/Main.hs
    ... ... @@ -783,6 +783,7 @@ t33 = do
    783 783 
     t34 :: IO ()
    784 784 
     t34 = do
    785 785 
         dump
    786 
    +
    786 787 
             [ "{-# LANGUAGE GHC_CPP #-}"
    787 788 
             , "module Example4 where"
    788 789 
             , ""
    ... ... @@ -799,3 +800,23 @@ t34 = do
    799 800 
             , "#endif"
    800 801 
             , ""
    801 802 
             ]
    803 
    +
    804 
    +t35 :: IO ()
    805 
    +t35 = do
    806 
    +    dump
    807 
    +        [ "{-# LANGUAGE GHC_CPP #-}"
    808 
    +        , "module Example14 where"
    809 
    +
    810 
    +        , "#define FOO"
    811 
    +        , "#define FOO(X) X"
    812 
    +        , ""
    813 
    +        , "#undef FOO"
    814 
    +        , ""
    815 
    +        , "foo ="
    816 
    +        , "#ifdef FOO"
    817 
    +        , "  'a'"
    818 
    +        , "#else"
    819 
    +        , "  'b'"
    820 
    +        , "#endif"
    821 
    +        , ""
    822 
    +        ]

  • utils/check-cpp/ParsePP.hs
    ... ... @@ -29,6 +29,7 @@ parseDirective s =
    29 29 
             Right toks ->
    30 30 
                 case toks of
    31 31 
                     (THash "#" : TIdentifier "define" : ts) -> cppDefine ts
    32 
    +                (THash "#" : TIdentifier "undef" : ts) -> Right $ cppUndef (map t_str ts)
    32 33 
                     (THash "#" : TIdentifier "include" : ts) -> Right $ cppInclude (map t_str ts)
    33 34 
                     (THash "#" : TIdentifier "if" : ts) -> Right $ cppIf (map t_str ts)
    34 35 
                     (THash "#" : TIdentifier "ifndef" : ts) -> Right $ cppIfndef (map t_str ts)
    ... ... @@ -54,6 +55,9 @@ cppDefine (TIdentifierLParen n : ts) = Right $ CppDefine (init n) args def
    54 55 
     cppDefine (TIdentifier n : ts) = Right $ CppDefine n Nothing ts
    55 56 
     cppDefine (t : _) = Left $ "#define: expecting an identifier, got :" ++ show t
    56 57
    58 
    +cppUndef :: [String] -> CppDirective
    59 
    +cppUndef ts = CppUndef (combineToks ts)
    60 
    +
    57 61 
     cppInclude :: [String] -> CppDirective
    58 62 
     cppInclude ts = CppInclude (combineToks ts)
    59 63

  • utils/check-cpp/PreProcess.hs
    ... ... @@ -293,6 +293,8 @@ processCpp ss = do
    293 293 
                         ppInclude filename
    294 294 
                     Right (CppDefine name args def) -> do
    295 295 
                         ppDefine (MacroName name args) def
    296 
    +                Right (CppUndef name) -> do
    297 
    +                    ppUndef name
    296 298 
                     Right (CppIf cond) -> do
    297 299 
                         val <- cppCond cond
    298 300 
                         ar <- pushAccepting val

  • utils/check-cpp/State.hs
    ... ... @@ -27,6 +27,7 @@ module State (
    27 27 
         popContinuation,
    28 28 
         ppDefine,
    29 29 
         ppIsDefined,
    30 
    +    ppUndef,
    30 31 
         getCppState,
    31 32 
         ghcCppEnabled,
    32 33 
         setInLinePragma,
    ... ... @@ -99,6 +100,7 @@ data CppDirective
    99 100 
         = CppInclude String
    100 101 
         | -- | name, optional args, replacement
    101 102 
           CppDefine String (Maybe [String]) MacroDef
    103 
    +    | CppUndef String
    102 104 
         | CppIfdef String
    103 105 
         | CppIfndef String
    104 106 
         | CppIf String
    ... ... @@ -333,9 +335,25 @@ addDefine' :: PpState -> MacroName -> MacroDef -> PpState
    333 335 
     addDefine' s name def =
    334 336 
         s{pp_defines = insertMacroDef name def (pp_defines s)}
    335 337
    338 
    +removeDefine :: String -> PP ()
    339 
    +removeDefine name = do
    340 
    +    accepting <- getAccepting
    341 
    +    when accepting $ do
    342 
    +        s <- getPpState
    343 
    +        setPpState $ removeDefine' s name
    344 
    +
    345 
    +removeDefine' :: PpState -> String -> PpState
    346 
    +removeDefine' s name =
    347 
    +    s{pp_defines = Map.delete name (pp_defines s)}
    348 
    +
    349 
    +-- -------------------------------------
    350 
    +
    336 351 
     ppDefine :: MacroName -> MacroDef -> PP ()
    337 352 
     ppDefine name val = addDefine name val
    338 353
    354 
    +ppUndef :: String -> PP ()
    355 
    +ppUndef name = removeDefine name
    356 
    +
    339 357 
     ppIsDefined :: MacroName -> PP Bool
    340 358 
     ppIsDefined name = do
    341 359 
         s <- getPpState

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help