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

Commits:

3 changed files:

Changes:

  • compiler/GHC/Parser/PreProcess/Macro.hs
    ... ... @@ -34,6 +34,7 @@ details
    34 34
    35 35 
     import Data.Map qualified as Map
    36 36 
     import Data.Maybe
    37 
    +import Data.List (intercalate)
    37 38
    38 39 
     import Data.Semigroup qualified as S
    39 40 
     import GHC.Parser.PreProcess.Eval
    ... ... @@ -74,7 +75,7 @@ expand loc s str = do
    74 75 
                 addGhcCPPError
    75 76 
                     loc
    76 77 
                     ( hang
    77 
    -                    (text "Error evaluating CPP condition1:") -- AZ:TODO remove 1
    78 
    +                    (text "Error evaluating CPP condition:")
    78 79 
                         2
    79 80 
                         (text err <+> text "of" $+$ text str)
    80 81 
                     )
    ... ... @@ -88,7 +89,6 @@ maxExpansions = 15
    88 89
    89 90 
     expandToks :: SrcSpan -> Int -> MacroDefines -> [Token] -> PP [Token]
    90 91 
     expandToks loc 0 _ ts = do
    91 
    -    -- error $ "macro_expansion limit (" ++ show maxExpansions ++ ") hit, aborting. ts=" ++ show ts
    92 92 
         addGhcCPPError
    93 93 
             loc
    94 94 
             ( hang
    ... ... @@ -110,21 +110,35 @@ doExpandToks loc ed s (TIdentifierLParen n : ts) =
    110 110 
         -- restore it to its constituent tokens
    111 111 
         doExpandToks loc ed s (TIdentifier (init n) : TOpenParen "(" : ts)
    112 112 
     doExpandToks loc _ s (TIdentifier "defined" : ts) = do
    113 
    -    let
    114 
    -        -- See Note: [defined unary operator] below
    115 
    -
    116 
    -        rest = case getExpandArgs ts of
    117 
    -            (Just [[TIdentifier macro_name]], rest0) ->
    118 
    -                case Map.lookup macro_name s of
    119 
    -                    Nothing -> TInteger "0" : rest0
    120 
    -                    Just _ -> TInteger "1" : rest0
    121 
    -            (Nothing, TIdentifier macro_name : ts0) ->
    122 
    -                case Map.lookup macro_name s of
    123 
    -                    Nothing -> TInteger "0" : ts0
    124 
    -                    Just _ -> TInteger "1" : ts0
    125 
    -            (Nothing, _) -> error $ "defined: expected an identifier, got:" ++ show ts
    126 
    -            (Just args, _) -> error $ "defined: expected a single arg, got:" ++ show args
    127 
    -    return (True, rest)
    113 
    +    -- See Note: ['defined' unary operator] below
    114 
    +    case getExpandArgs ts of
    115 
    +        (Just [[TIdentifier macro_name]], rest0) ->
    116 
    +            case Map.lookup macro_name s of
    117 
    +                Nothing -> return (True, TInteger "0" : rest0)
    118 
    +                Just _ -> return (True, TInteger "1" : rest0)
    119 
    +        (Nothing, TIdentifier macro_name : ts0) ->
    120 
    +            case Map.lookup macro_name s of
    121 
    +                Nothing -> return (True, TInteger "0" : ts0)
    122 
    +                Just _ -> return (True, TInteger "1" : ts0)
    123 
    +        (Nothing, _) -> do
    124 
    +            addGhcCPPError
    125 
    +                loc
    126 
    +                ( hang
    127 
    +                    (text "CPP defined: expected an identifier, got:")
    128 
    +                    2
    129 
    +                    (text (concatMap t_str ts))
    130 
    +                )
    131 
    +            return (False, [])
    132 
    +        (Just args, _) -> do
    133 
    +          -- error $ "defined: expected a single arg, got:" ++ show args
    134 
    +            addGhcCPPError
    135 
    +                loc
    136 
    +                ( hang
    137 
    +                    (text "CPP defined: expected a single arg, got:")
    138 
    +                    2
    139 
    +                    (text (intercalate "," (map (concatMap t_str) args)))
    140 
    +                )
    141 
    +            return (False, [])
    128 142 
     doExpandToks loc ed s (TIdentifier n : ts) = do
    129 143 
         let
    130 144 
             (ed', expanded, ts') = case Map.lookup n s of
    ... ... @@ -144,8 +158,8 @@ doExpandToks loc ed s (t : ts) = do
    144 158 
         return (ed', t : r)
    145 159
    146 160 
     {-
    147 
    -Note: [defined unary operator]
    148 
    -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    161 
    +Note: ['defined' unary operator]
    162 
    +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    149 163
    150 164 
     From https://timsong-cpp.github.io/cppwp/n4140/cpp#cond-1
    151 165

  • testsuite/tests/ghc-cpp/GhcCpp02.hs
    ... ... @@ -12,3 +12,14 @@ foo =
    12 12 
     #if EXISTENT_MACRO(4)
    13 13 
     bar = 3
    14 14 
     #endif
    15 
    +
    16 
    +#define FOO(X) FOO(X)
    17 
    +#if FOO(3)
    18 
    +
    19 
    +#endif
    20 
    +
    21 
    +#if defined 34
    22 
    +#endif
    23 
    +
    24 
    +#if defined(A,B)
    25 
    +#endif

  • testsuite/tests/ghc-cpp/GhcCpp02.stderr
    ... ... @@ -7,3 +7,27 @@ GhcCpp02.hs:12:1: error: [GHC-93098]
    7 7 
           Parse error at line 1, column 23 of
    8 8 
           2 + NONEXISTENT_MACRO ( 4 )
    9 9
    10 
    +GhcCpp02.hs:17:1: error: [GHC-93098]
    11 
    +    Error evaluating CPP condition:
    12 
    +      Parse error at line 1, column 4 of
    13 
    +      FOO( 3 )
    14 
    +
    15 
    +GhcCpp02.hs:17:1: error: [GHC-93098]
    16 
    +    CPP macro expansion limit hit: FOO( 3 )
    17 
    +
    18 
    +GhcCpp02.hs:21:1: error: [GHC-93098]
    19 
    +    Error evaluating CPP condition:
    20 
    +      Parse error at line 1, column 0 of
    21 
    +
    22 
    +
    23 
    +GhcCpp02.hs:21:1: error: [GHC-93098]
    24 
    +    CPP defined: expected an identifier, got: 34
    25 
    +
    26 
    +GhcCpp02.hs:24:1: error: [GHC-93098]
    27 
    +    Error evaluating CPP condition:
    28 
    +      Parse error at line 1, column 0 of
    29 
    +
    30 
    +
    31 
    +GhcCpp02.hs:24:1: error: [GHC-93098]
    32 
    +    CPP defined: expected a single arg, got: A,B
    33 
    +

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