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

Commits:

13 changed files:

Changes:

  • compiler/GHC/Parser/PreProcess/Lexer.x
    ... ... @@ -92,10 +92,11 @@ words :-
    92 92 
         <0>         "xor"                { mkTv TXor }
    93 93 
         <0>         "xor_eq"             { mkTv TXorEq }
    94 94 
     ----------------------------------------
    95 
    -    <0>         [a-zA-Z_][a-zA-Z0-9_]* { mkTv TIdentifier }
    96 
    -    <0>         \-? [0-9][0-9]*        { mkTv TInteger  }
    97 
    -    <0>         \" [^\"]* \"           { mkTv (TString . tail . init) }
    98 
    -    <0>         ()                     { begin other }
    95 
    +    <0>         [a-zA-Z_][a-zA-Z0-9_]*\( { mkTv TIdentifierLParen }
    96 
    +    <0>         [a-zA-Z_][a-zA-Z0-9_]*   { mkTv TIdentifier }
    97 
    +    <0>         \-? [0-9][0-9]*          { mkTv TInteger  }
    98 
    +    <0>         \" [^\"]* \"             { mkTv (TString . tail . init) }
    99 
    +    <0>         ()                       { begin other }
    99 100
    100 101 
         <other>     .+                   { \i -> do {setStartCode 0;
    101 102 
                                                      mkTv TOther i} }

  • compiler/GHC/Parser/PreProcess/Macro.hs
    ... ... @@ -71,14 +71,18 @@ expandToks :: MacroDefines -> [Token] -> [Token]
    71 71 
     expandToks s ts =
    72 72 
         let
    73 73 
             (expansionDone, r) = doExpandToks False s ts
    74 
    -     in
    74 
    +    in
    75 75 
             if expansionDone
    76 76 
                 then expandToks s r
    77 77 
                 else r
    78 78
    79 79 
     doExpandToks :: Bool -> MacroDefines -> [Token] -> (Bool, [Token])
    80 80 
     doExpandToks ed _ [] = (ed, [])
    81 
    -doExpandToks _ s (TIdentifier "defined" : ts) = (True, rest)
    81 
    +doExpandToks ed s (TIdentifierLParen n: ts) =
    82 
    +  -- TIdentifierLParen has no meaning here (only in a #define), so
    83 
    +  -- restore it to its constituent tokens
    84 
    +  doExpandToks ed s (TIdentifier n:TOpenParen "(":ts)
    85 
    +doExpandToks _  s (TIdentifier "defined" : ts) = (True, rest)
    82 86 
       -- See Note: [defined unary operator] below
    83 87 
       where
    84 88 
         rest = case getExpandArgs ts of

  • compiler/GHC/Parser/PreProcess/ParsePP.hs
    ... ... @@ -7,6 +7,7 @@ module GHC.Parser.PreProcess.ParsePP (
    7 7 
         t1,
    8 8 
         t2,
    9 9 
         t3,
    10 
    +    t4,
    10 11 
     ) where
    11 12
    12 13 
     import Data.List (intercalate)
    ... ... @@ -47,9 +48,10 @@ combineToks ss = intercalate " " ss
    47 48
    48 49 
     cppDefine :: [Token] -> Either String CppDirective
    49 50 
     cppDefine [] = Left "error:empty #define directive"
    50 
    -cppDefine (TIdentifier n : ts) = Right $ CppDefine n args def
    51 
    +cppDefine (TIdentifierLParen n : ts) = Right $ CppDefine n args def
    51 52 
       where
    52 53 
         (args, def) = getArgs ts
    54 
    +cppDefine (TIdentifier n : ts) = Right $ CppDefine n Nothing ts
    53 55 
     cppDefine (t : _) = Left $ "#define: expecting an identifier, got :" ++ show t
    54 56
    55 57 
     cppInclude :: [String] -> CppDirective
    ... ... @@ -79,14 +81,14 @@ cppDumpState _ts = CppDumpState
    79 81 
     -- ---------------------------------------------------------------------
    80 82
    81 83 
     -- Crack out the arguments to a #define. This is of the form of
    82 
    --- comma-separated identifiers between parens
    84 
    +-- comma-separated identifiers between parens, where we have already
    85 
    +-- seen the opening paren.
    83 86 
     getArgs :: [Token] -> (Maybe [String], [Token])
    84 87 
     getArgs [] = (Nothing, [])
    85 
    -getArgs (TOpenParen _ : ts) =
    88 
    +getArgs ts =
    86 89 
         case parseDefineArgs [] ts of
    87 90 
             Left err -> error err
    88 91 
             Right (args, rest) -> (Just (reverse args), rest)
    89 
    -getArgs ts = (Nothing, ts)
    90 92
    91 93 
     parseDefineArgs ::
    92 94 
         [String] ->
    ... ... @@ -138,3 +140,5 @@ t2 = doATest "# if ((m1) < 1 || (m1) == 1 && (m2) < 7 || (m1) == 1 && (m2) ==
    138 140
    139 141 
     t3 :: Either String CppDirective
    140 142 
     t3 = parseDirective "# if FOO == 4"
    143 
    +
    144 
    +t4 = cppLex "#define foo(X) X"

  • compiler/GHC/Parser/PreProcess/Parser.y
    ... ... @@ -92,6 +92,7 @@ import GHC.Prelude
    92 92 
         'xor_eq'           { TXorEq {} }
    93 93
    94 94 
         identifier         { TIdentifier {} }
    95 
    +    identifierLP       { TIdentifierLParen {} }
    95 96 
         integer            { TInteger {} }
    96 97 
         string             { TString {} }
    97 98 
         other              { TOther {} }

  • compiler/GHC/Parser/PreProcess/ParserM.hs
    ... ... @@ -91,6 +91,7 @@ init_state =
    91 91 
     data Token
    92 92 
         = TEOF {t_str :: String}
    93 93 
         | TIdentifier {t_str :: String}
    94 
    +    | TIdentifierLParen {t_str :: String}
    94 95 
         | TInteger {t_str :: String}
    95 96 
         | -- preprocessing-op-or-punc
    96 97 
           -- https://timsong-cpp.github.io/cppwp/n4140/lex.operators#nt:preprocessing-op-or-punc

  • utils/check-cpp/Eval.hs
    ... ... @@ -8,7 +8,7 @@ eval :: Expr -> Int
    8 8 
     eval (Parens e) = eval e
    9 9 
     eval (Not e) = fromBool $ not (toBool $ eval e)
    10 10 
     -- eval (Var v) = error $ "need to look up :" ++ v
    11 
    -eval (Var v) = 0 -- Spec says remaining identifiers are replaces with zero
    11 
    +eval (Var _) = 0 -- Spec says remaining identifiers are replaces with zero
    12 12 
     eval (IntVal i) = i
    13 13 
     eval (Plus e1 e2) = (eval e1) + (eval e2)
    14 14 
     eval (Minus e1 e2) = (eval e1) - (eval e2)

  • utils/check-cpp/Lexer.x
    ... ... @@ -90,10 +90,11 @@ words :-
    90 90 
         <0>         "xor"                { mkTv TXor }
    91 91 
         <0>         "xor_eq"             { mkTv TXorEq }
    92 92 
     ----------------------------------------
    93 
    -    <0>         [a-zA-Z_][a-zA-Z0-9_]* { mkTv TIdentifier }
    94 
    -    <0>         \-? [0-9][0-9]*        { mkTv TInteger  }
    95 
    -    <0>         \" [^\"]* \"           { mkTv (TString . tail . init) }
    96 
    -    <0>         ()                     { begin other }
    93 
    +    <0>         [a-zA-Z_][a-zA-Z0-9_]*\( { mkTv TIdentifierLParen }
    94 
    +    <0>         [a-zA-Z_][a-zA-Z0-9_]*   { mkTv TIdentifier }
    95 
    +    <0>         \-? [0-9][0-9]*          { mkTv TInteger  }
    96 
    +    <0>         \" [^\"]* \"             { mkTv (TString . tail . init) }
    97 
    +    <0>         ()                       { begin other }
    97 98
    98 99 
         <other>     .+                   { \i -> do {setStartCode 0;
    99 100 
                                                      mkTv TOther i} }

  • utils/check-cpp/Macro.hs
    ... ... @@ -70,13 +70,17 @@ expandToks :: MacroDefines -> [Token] -> [Token]
    70 70 
     expandToks s ts =
    71 71 
         let
    72 72 
             (expansionDone, r) = doExpandToks False s ts
    73 
    -     in
    73 
    +    in
    74 74 
             if expansionDone
    75 75 
                 then expandToks s r
    76 76 
                 else r
    77 77
    78 78 
     doExpandToks :: Bool -> MacroDefines -> [Token] -> (Bool, [Token])
    79 79 
     doExpandToks ed _ [] = (ed, [])
    80 
    +doExpandToks ed s (TIdentifierLParen n: ts) =
    81 
    +  -- TIdentifierLParen has no meaning here (only in a #define), so
    82 
    +  -- restore it to its constituent tokens
    83 
    +  doExpandToks ed s (TIdentifier n:TOpenParen "(":ts)
    80 84 
     doExpandToks _  s (TIdentifier "defined" : ts) = (True, rest)
    81 85 
       -- See Note: [defined unary operator] below
    82 86 
       where

  • utils/check-cpp/Main.hs
    ... ... @@ -280,6 +280,7 @@ t2 = do
    280 280 
             , "#else"
    281 281 
             , "x = 5"
    282 282 
             , "#endif"
    283 
    +        , ""
    283 284 
             ]
    284 285
    285 286 
     -- x = 5
    ... ... @@ -348,6 +349,7 @@ t4 = do
    348 349 
             , "#else"
    349 350 
             , "x = \"no version\""
    350 351 
             , "#endif"
    352 
    +        , ""
    351 353 
             ]
    352 354
    353 355 
     -- x = "got version"
    ... ... @@ -399,6 +401,7 @@ t10 = do
    399 401 
             , "#else"
    400 402 
             , "x = 2"
    401 403 
             , "#endif"
    404 
    +        , ""
    402 405 
             ]
    403 406
    404 407 
     -- x = 1
    ... ... @@ -424,6 +427,7 @@ t11 = do
    424 427 
             , "#else"
    425 428 
             , "x = 5"
    426 429 
             , "#endif"
    430 
    +        , ""
    427 431 
             ]
    428 432
    429 433 
     -- x = 1
    ... ... @@ -438,6 +442,7 @@ t12 = do
    438 442 
             , "#else"
    439 443 
             , "x = 5"
    440 444 
             , "#endif"
    445 
    +        , ""
    441 446 
             ]
    442 447
    443 448 
     -- x = 1
    ... ... @@ -450,6 +455,7 @@ t13 = do
    450 455 
             , "#else"
    451 456 
             , "x = 5"
    452 457 
             , "#endif"
    458 
    +        , ""
    453 459 
             ]
    454 460
    455 461 
     -- x = 1
    ... ... @@ -473,6 +479,7 @@ t14 = do
    473 479 
             , "#else"
    474 480 
             , "z = 5"
    475 481 
             , "#endif"
    482 
    +        , ""
    476 483 
             ]
    477 484
    478 485 
     -- x = 1
    ... ... @@ -496,6 +503,7 @@ t16 = do
    496 503 
             , "#else"
    497 504 
             , "x = 5"
    498 505 
             , "#endif"
    506 
    +        , ""
    499 507 
             ]
    500 508
    501 509 
     -- x = 1
    ... ... @@ -509,6 +517,7 @@ t17 = do
    509 517 
             , "#else"
    510 518 
             , "x = 5"
    511 519 
             , "#endif"
    520 
    +        , ""
    512 521 
             ]
    513 522
    514 523 
     -- x = 1
    ... ... @@ -525,6 +534,7 @@ t18 = do
    525 534 
             , "#else"
    526 535 
             , "x = 5"
    527 536 
             , "#endif"
    537 
    +        , ""
    528 538 
             ]
    529 539
    530 540 
     t19 :: IO ()
    ... ... @@ -593,6 +603,7 @@ t22 = do
    593 603 
             , "also ignored"
    594 604 
             , "#endif"
    595 605 
             , "#endif"
    606 
    +        , ""
    596 607 
             ]
    597 608
    598 609 
     t23 :: IO ()
    ... ... @@ -606,6 +617,7 @@ t23 = do
    606 617 
             , "#else"
    607 618 
             , "x = 2"
    608 619 
             , "#endif"
    620 
    +        , ""
    609 621 
             ]
    610 622
    611 623 
     t24 :: IO ()
    ... ... @@ -619,6 +631,7 @@ t24 = do
    619 631 
             , "#else"
    620 632 
             , "x = 2"
    621 633 
             , "#endif"
    634 
    +        , ""
    622 635 
             ]
    623 636
    624 637 
     t25 :: IO ()
    ... ... @@ -632,6 +645,7 @@ t25 = do
    632 645 
             , "#else"
    633 646 
             , "x = 2"
    634 647 
             , "#endif"
    648 
    +        , ""
    635 649 
             ]
    636 650
    637 651 
     t26 :: IO ()
    ... ... @@ -662,6 +676,7 @@ t27 = do
    662 676 
             , "#ifdef DEBUG"
    663 677 
             , "                                 hiding (rev)"
    664 678 
             , "#endif"
    679 
    +        , ""
    665 680 
             ]
    666 681
    667 682 
     t28 :: IO ()

  • utils/check-cpp/ParsePP.hs
    ... ... @@ -48,9 +48,10 @@ combineToks ss = intercalate " " ss
    48 48
    49 49 
     cppDefine :: [Token] -> Either String CppDirective
    50 50 
     cppDefine [] = Left "error:empty #define directive"
    51 
    -cppDefine (TIdentifier n : ts) = Right $ CppDefine n args def
    51 
    +cppDefine (TIdentifierLParen n : ts) = Right $ CppDefine n args def
    52 52 
       where
    53 53 
         (args, def) = getArgs ts
    54 
    +cppDefine (TIdentifier n : ts) = Right $ CppDefine n Nothing ts
    54 55 
     cppDefine (t : _) = Left $ "#define: expecting an identifier, got :" ++ show t
    55 56
    56 57 
     cppInclude :: [String] -> CppDirective
    ... ... @@ -80,14 +81,14 @@ cppDumpState _ts = CppDumpState
    80 81 
     -- ---------------------------------------------------------------------
    81 82
    82 83 
     -- Crack out the arguments to a #define. This is of the form of
    83 
    --- comma-separated identifiers between parens
    84 
    +-- comma-separated identifiers between parens, where we have already
    85 
    +-- seen the opening paren.
    84 86 
     getArgs :: [Token] -> (Maybe [String], [Token])
    85 87 
     getArgs [] = (Nothing, [])
    86 
    -getArgs (TOpenParen _ : ts) =
    88 
    +getArgs ts =
    87 89 
         case parseDefineArgs [] ts of
    88 90 
             Left err -> error err
    89 91 
             Right (args, rest) -> (Just (reverse args), rest)
    90 
    -getArgs ts = (Nothing, ts)
    91 92
    92 93 
     parseDefineArgs ::
    93 94 
         [String] ->
    ... ... @@ -139,3 +140,5 @@ t2 = doATest "# if ((m1) < 1 || (m1) == 1 && (m2) < 7 || (m1) == 1 && (m2) ==
    139 140
    140 141 
     t3 :: Either String CppDirective
    141 142 
     t3 = parseDirective "# if FOO == 4"
    143 
    +
    144 
    +t4 = cppLex "#define foo(X) X"

  • utils/check-cpp/Parser.y
    ... ... @@ -91,6 +91,7 @@ import qualified GHC.Internal.Data.Tuple as Happy_Prelude
    91 91 
         'xor_eq'           { TXorEq {} }
    92 92
    93 93 
         identifier         { TIdentifier {} }
    94 
    +    identifierLP       { TIdentifierLParen {} }
    94 95 
         integer            { TInteger {} }
    95 96 
         string             { TString {} }
    96 97 
         other              { TOther {} }

  • utils/check-cpp/ParserM.hs
    ... ... @@ -91,6 +91,7 @@ init_state =
    91 91 
     data Token
    92 92 
         = TEOF {t_str :: String}
    93 93 
         | TIdentifier {t_str :: String}
    94 
    +    | TIdentifierLParen {t_str :: String}
    94 95 
         | TInteger {t_str :: String}
    95 96 
         | -- preprocessing-op-or-punc
    96 97 
           -- https://timsong-cpp.github.io/cppwp/n4140/lex.operators#nt:preprocessing-op-or-punc

  • utils/check-cpp/State.hs
    ... ... @@ -191,7 +191,7 @@ setAccepting on = do
    191 191 
       let possible_accepting = parent_on && on
    192 192 
       let (new_group_state, accepting) =
    193 193 
             case (group_state, possible_accepting) of
    194 
    -          (PpNoGroup, v) -> error "setAccepting for state PpNoGroup"
    194 
    +          (PpNoGroup, _) -> error "setAccepting for state PpNoGroup"
    195 195 
               (PpInGroupStillInactive, True) -> (PpInGroupHasBeenActive, True)
    196 196 
               (PpInGroupStillInactive, False) -> (PpInGroupStillInactive, False)
    197 197 
               (PpInGroupHasBeenActive, _) -> (PpInGroupHasBeenActive, False)
    ... ... @@ -317,7 +317,7 @@ addDefine name def = do
    317 317
    318 318 
     addDefine' :: PpState -> MacroName -> MacroDef -> PpState
    319 319 
     addDefine' s name def =
    320 
    -    s{pp_defines = insertMacroDef name def (pp_defines s)}
    320 
    +    s{ pp_defines = insertMacroDef name def (pp_defines s)}
    321 321
    322 322 
     ppDefine :: MacroName -> MacroDef -> PP ()
    323 323 
     ppDefine name val = addDefine name val

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