[Git][ghc/ghc][wip/az/ghc-cpp] Layering is now correct
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Mon Feb 3 20:46:58 UTC 2025
Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC
Commits:
ecec1b0f by Alan Zimmerman at 2025-02-03T20:46:34+00:00
Layering is now correct
- GHC lexer, emits CPP tokens
- accumulated in Preprocessor state
- Lexed by CPP lexer, CPP command extracted, tokens concated with
spaces (to get rid of token pasting via comments)
- if directive lexed and parsed by CPP lexer/parser, and evaluated
- - - - -
10 changed files:
- compiler/GHC/Parser/PreProcess.hs
- utils/check-cpp/Lexer.x
- utils/check-cpp/Macro.hs
- utils/check-cpp/Main.hs
- utils/check-cpp/ParsePP.hs
- utils/check-cpp/Parser.hs
- utils/check-cpp/Parser.y
- utils/check-cpp/ParserM.hs
- utils/check-cpp/PreProcess.hs
- utils/check-cpp/Types.hs
Changes:
=====================================
compiler/GHC/Parser/PreProcess.hs
=====================================
@@ -76,7 +76,7 @@ data CppDirective
type MacroArgs = [String]
data MacroName = MacroName String (Maybe MacroArgs)
deriving (Show, Eq, Ord)
-type MacroDef = [String]
+type MacroDef = String
-- ---------------------------------------------------------------------
@@ -321,7 +321,7 @@ parseDefine :: FastString -> Maybe (String, [String])
parseDefine fs = r
where
-- r = Just (cleanTokenString s, "")
- r = case regularParse cppDefinition (unpackFS fs) of
+ r = case parseCppParser cppDefinition (unpackFS fs) of
Left _ -> Nothing
Right v -> Just v
@@ -333,7 +333,6 @@ See Note [GhcCPP Initial Processing]
cppInitial :: [FastString] -> String
cppInitial fs = r
where
- -- go fs' = reverse $ drop 2 $ reverse $ unpackFS fs'
r = concatMap unpackFS fs
{-
=====================================
utils/check-cpp/Lexer.x
=====================================
@@ -16,105 +16,85 @@ import Control.Monad
words :-
- <0,def,expr> $white+ ;
-----------------------------------------
- <0> "#" { mkTv THash }
- <0> "define" { \i -> do {setStartCode def; mkTv TDefine i} }
- <0> "include" { mkTv TInclude }
- <0> "ifdef" { mkTv TIfdef }
- <0> "ifndef" { mkTv TIfndef }
- <0> "if" { \i -> do {setStartCode other; mkTv TIf i} }
- <0> "else" { mkTv TElse }
- <0> "endif" { mkTv TEndif }
- <0> () { begin expr }
-
+ <0> $white+ ;
---------------------------------------
--- In a define. Params only, then other
- <def> "(" { mkTv TOpenParen }
- <def> "," { mkTv TComma }
- <def> ")" { mkTv TCloseParen }
- <def> [a-z][a-zA-Z0-9\#_]* { mkTv TLowerName }
- <def> [A-Z][a-zA-Z0-9\#_]* { mkTv TUpperName }
- <def> () { begin other }
----------------------------------------
-
- <expr> "{" { mkTv TOpenBrace }
- <expr> "}" { mkTv TCloseBrace }
- <expr> "[" { mkTv TOpenBracket }
- <expr> "]" { mkTv TCloseBracket }
- <expr> "#" { mkTv THash }
- <expr> "##" { mkTv THashHash }
- <expr> "(" { mkTv TOpenParen }
- <expr> ")" { mkTv TCloseParen }
- <expr> "<:" { mkTv TLtColon }
- <expr> ":>" { mkTv TColonGt}
- <expr> "<%" { mkTv TLtPercent }
- <expr> "%>" { mkTv TPercentGt }
- <expr> "%:" { mkTv TPercentColon }
- <expr> "%:%:" { mkTv TPercentColonTwice }
- <expr> ";" { mkTv TSemi }
- <expr> ":" { mkTv TColon }
- <expr> "..." { mkTv TDotDotDot }
- <expr> "new" { mkTv TNew }
- <expr> "delete" { mkTv TDelete }
- <expr> "?" { mkTv TQuestion }
- <expr> "::" { mkTv TColonColon}
- <expr> "." { mkTv TDot }
- <expr> ".*" { mkTv TDotStar }
- <expr> "+" { mkTv TPlus }
- <expr> "-" { mkTv TMinus }
- <expr> "*" { mkTv TStar }
- <expr> "/" { mkTv TSlash }
- <expr> "%" { mkTv TPercent }
- <expr> "^" { mkTv TUpArrow }
- <expr> "&" { mkTv TAmpersand }
- <expr> "|" { mkTv TPipe }
- <expr> "~" { mkTv TTilde }
- <expr> "!" { mkTv TExclamation }
- <expr> "=" { mkTv TEqual }
- <expr> "<" { mkTv TOpenAngle }
- <expr> ">" { mkTv TCloseAngle }
- <expr> "+=" { mkTv TPlusEqual }
- <expr> "-=" { mkTv TMinusEqual }
- <expr> "*=" { mkTv TStarEqual }
- <expr> "/=" { mkTv TSlashEqual }
- <expr> "%=" { mkTv TPercentEqual }
- <expr> "^=" { mkTv TUpEqual }
- <expr> "&=" { mkTv TAmpersandEqual }
- <expr> "|=" { mkTv TPipeEqual }
- <expr> "<<" { mkTv TLtLt }
- <expr> ">>" { mkTv TGtGt }
- <expr> ">>=" { mkTv TGtGtEqual }
- <expr> "<<=" { mkTv TLtLtEqual }
- <expr> "==" { mkTv TEqualEqual }
- <expr> "!=" { mkTv TExclaimEqual }
- <expr> "<=" { mkTv TLtEqual }
- <expr> ">=" { mkTv TGtEqual }
- <expr> "&&" { mkTv TAmpersandTwice }
- <expr> "||" { mkTv TPipePipe }
- <expr> "++" { mkTv TPlusPlus }
- <expr> "--" { mkTv TMinusMinus }
- <expr> "," { mkTv TComma }
- <expr> "->*" { mkTv TMinusGtStar }
- <expr> "->" { mkTv TMinusGt }
- <expr> "and" { mkTv TAnd }
- <expr> "and_eq" { mkTv TAndEq }
- <expr> "bitand" { mkTv TBitand }
- <expr> "bitor" { mkTv TBitor }
- <expr> "compl" { mkTv TCompl }
- <expr> "not" { mkTv TNot }
- <expr> "not_eq" { mkTv TNotEq }
- <expr> "or" { mkTv TOr }
- <expr> "or_eq" { mkTv TOrEq }
- <expr> "xor" { mkTv TXor }
- <expr> "xor_eq" { mkTv TXorEq }
+ <0> "{" { mkTv TOpenBrace }
+ <0> "}" { mkTv TCloseBrace }
+ <0> "[" { mkTv TOpenBracket }
+ <0> "]" { mkTv TCloseBracket }
+ <0> "#" { mkTv THash }
+ <0> "##" { mkTv THashHash }
+ <0> "(" { mkTv TOpenParen }
+ <0> ")" { mkTv TCloseParen }
+ <0> "<:" { mkTv TLtColon }
+ <0> ":>" { mkTv TColonGt}
+ <0> "<%" { mkTv TLtPercent }
+ <0> "%>" { mkTv TPercentGt }
+ <0> "%:" { mkTv TPercentColon }
+ <0> "%:%:" { mkTv TPercentColonTwice }
+ <0> ";" { mkTv TSemi }
+ <0> ":" { mkTv TColon }
+ <0> "..." { mkTv TDotDotDot }
+ <0> "new" { mkTv TNew }
+ <0> "delete" { mkTv TDelete }
+ <0> "?" { mkTv TQuestion }
+ <0> "::" { mkTv TColonColon}
+ <0> "." { mkTv TDot }
+ <0> ".*" { mkTv TDotStar }
+ <0> "+" { mkTv TPlus }
+ <0> "-" { mkTv TMinus }
+ <0> "*" { mkTv TStar }
+ <0> "/" { mkTv TSlash }
+ <0> "%" { mkTv TPercent }
+ <0> "^" { mkTv TUpArrow }
+ <0> "&" { mkTv TAmpersand }
+ <0> "|" { mkTv TPipe }
+ <0> "~" { mkTv TTilde }
+ <0> "!" { mkTv TExclamation }
+ <0> "=" { mkTv TEqual }
+ <0> "<" { mkTv TOpenAngle }
+ <0> ">" { mkTv TCloseAngle }
+ <0> "+=" { mkTv TPlusEqual }
+ <0> "-=" { mkTv TMinusEqual }
+ <0> "*=" { mkTv TStarEqual }
+ <0> "/=" { mkTv TSlashEqual }
+ <0> "%=" { mkTv TPercentEqual }
+ <0> "^=" { mkTv TUpEqual }
+ <0> "&=" { mkTv TAmpersandEqual }
+ <0> "|=" { mkTv TPipeEqual }
+ <0> "<<" { mkTv TLtLt }
+ <0> ">>" { mkTv TGtGt }
+ <0> ">>=" { mkTv TGtGtEqual }
+ <0> "<<=" { mkTv TLtLtEqual }
+ <0> "==" { mkTv TEqualEqual }
+ <0> "!=" { mkTv TExclaimEqual }
+ <0> "<=" { mkTv TLtEqual }
+ <0> ">=" { mkTv TGtEqual }
+ <0> "&&" { mkTv TAmpersandTwice }
+ <0> "||" { mkTv TPipePipe }
+ <0> "++" { mkTv TPlusPlus }
+ <0> "--" { mkTv TMinusMinus }
+ <0> "," { mkTv TComma }
+ <0> "->*" { mkTv TMinusGtStar }
+ <0> "->" { mkTv TMinusGt }
+ <0> "and" { mkTv TAnd }
+ <0> "and_eq" { mkTv TAndEq }
+ <0> "bitand" { mkTv TBitand }
+ <0> "bitor" { mkTv TBitor }
+ <0> "compl" { mkTv TCompl }
+ <0> "not" { mkTv TNot }
+ <0> "not_eq" { mkTv TNotEq }
+ <0> "or" { mkTv TOr }
+ <0> "or_eq" { mkTv TOrEq }
+ <0> "xor" { mkTv TXor }
+ <0> "xor_eq" { mkTv TXorEq }
----------------------------------------
- <expr> [a-z][a-zA-Z0-9\#_]* { mkTv TLowerName }
- <expr> [A-Z][a-zA-Z0-9\#_]* { mkTv TUpperName }
- <expr> \-? [0-9][0-9]* { mkTv TInteger }
- <expr> \" [^\"]* \" { mkTv (TString . tail . init) }
- <expr> () { begin other }
+ <0> [a-z][a-zA-Z0-9\#_]* { mkTv TLowerName }
+ <0> [A-Z][a-zA-Z0-9\#_]* { mkTv TUpperName }
+ <0> \-? [0-9][0-9]* { mkTv TInteger }
+ <0> \" [^\"]* \" { mkTv (TString . tail . init) }
+ <0> () { begin other }
<other> .+ { \i -> do {setStartCode 0;
mkTv TOther i} }
=====================================
utils/check-cpp/Macro.hs
=====================================
@@ -26,7 +26,6 @@ import qualified Data.Map as Map
import Data.Maybe
import Eval
-import Lexer
import ParsePP
import ParserM
import Parser
@@ -41,10 +40,10 @@ process s str = (s0, o)
Left _ -> undefined
Right r -> r
s0 = case o of
- CppDefine name toks -> define s name toks
+ CppDefine name rhs -> define s name rhs
CppInclude _ -> undefined
CppIfdef name -> ifdef s name
- CppIf str -> cppIf s str
+ CppIf ifstr -> cppIf s ifstr
CppIfndef name -> ifndef s name
CppElse -> undefined
CppEndif -> undefined
@@ -72,7 +71,7 @@ cppIf s str = r
expanded = expand s str
-- toks0 = cppLex expanded
-- r = error (show toks0)
- v = case parseCppParser plusTimesExpr expanded of
+ v = case Parser.parseExpr expanded of
Left err -> error $ show err
Right tree -> eval tree
-- We evaluate to an Int, which we convert to a bool
@@ -80,13 +79,6 @@ cppIf s str = r
-- ---------------------------------------------------------------------
-cppLex :: String -> Either String [Token]
-cppLex s = case lexCppTokenStream s init_state of
- Left err -> Left err
- Right (_inp, _st, toks) -> Right toks
-
--- ---------------------------------------------------------------------
-
expand :: PpState -> String -> String
expand s str = expanded
where
@@ -94,15 +86,15 @@ expand s str = expanded
toks = case cppLex str of
Left err -> error err
Right tks -> tks
- expanded = unwords $ concatMap (expandOne s) toks
+ expanded = concatMap (expandOne s) toks
-expandOne :: PpState -> Token -> [String]
+expandOne :: PpState -> Token -> String
expandOne s tok = r
where
-- TODO: protect against looking up `define`
r =
fromMaybe
- [t_str tok]
+ (t_str tok)
(Map.lookup (MacroName (t_str tok) Nothing) (pp_defines s))
-- ---------------------------------------------------------------------
=====================================
utils/check-cpp/Main.hs
=====================================
@@ -25,8 +25,8 @@ import GHC.Types.SrcLoc
import GHC.Utils.Error
import GHC.Utils.Outputable
+import ParsePP
import ParseSimulate
-import Parser
import PreProcess
import Types
@@ -34,8 +34,8 @@ import Types
showAst :: (Data a) => a -> String
showAst ast =
- showSDocUnsafe
- $ showAstData BlankSrcSpanFile NoBlankEpAnnotations ast
+ showSDocUnsafe $
+ showAstData BlankSrcSpanFile NoBlankEpAnnotations ast
-- =====================================================================
@@ -59,8 +59,9 @@ parseString libdir includes str = ghcWrapper libdir $ do
strGetToks :: Includes -> Lexer.ParserOpts -> FilePath -> String -> [Located Token]
strGetToks includes popts filename str = reverse $ lexAll pstate
--- strGetToks includes popts filename str = reverse $ lexAll (trace ("pstate=" ++ show initState) pstate)
where
+ -- strGetToks includes popts filename str = reverse $ lexAll (trace ("pstate=" ++ show initState) pstate)
+
includeMap = Map.fromList $ map (\(k, v) -> (k, stringToStringBuffer (intercalate "\n" v))) includes
initState = initPpState{pp_includes = includeMap}
pstate = Lexer.initParserState initState popts buf loc
@@ -79,12 +80,11 @@ strGetToks includes popts filename str = reverse $ lexAll pstate
showErrorMessages :: Messages GhcMessage -> String
showErrorMessages msgs =
- renderWithContext defaultSDocContext
- $ vcat
- $ pprMsgEnvelopeBagWithLocDefault
- $ getMessages
- $ msgs
-
+ renderWithContext defaultSDocContext $
+ vcat $
+ pprMsgEnvelopeBagWithLocDefault $
+ getMessages $
+ msgs
strParserWrapper ::
-- | Haskell module source text (full Unicode is supported)
@@ -95,9 +95,9 @@ strParserWrapper ::
FilePath ->
[Located Token]
strParserWrapper str dflags filename =
- case strParser str dflags filename of
- (_, Left _err) -> error "oops"
- (_, Right toks) -> toks
+ case strParser str dflags filename of
+ (_, Left _err) -> error "oops"
+ (_, Right toks) -> toks
{- | Parse a file, using the emulated haskell parser, returning the
resulting tokens only
@@ -143,8 +143,8 @@ initDynFlags = do
-- | Internal function. Default runner of GHC.Ghc action in IO.
ghcWrapper :: LibDir -> GHC.Ghc a -> IO a
ghcWrapper libdir a =
- GHC.defaultErrorHandler GHC.defaultFatalMessager GHC.defaultFlushOut
- $ GHC.runGhc (Just libdir) a
+ GHC.defaultErrorHandler GHC.defaultFatalMessager GHC.defaultFlushOut $
+ GHC.runGhc (Just libdir) a
-- ---------------------------------------------------------------------
@@ -180,6 +180,7 @@ t0 = do
, "#endif"
, ""
]
+ -- x = 1
t1 :: IO ()
t1 = do
@@ -187,6 +188,7 @@ t1 = do
[ "data X = X"
, ""
]
+ -- data X = X
t2 :: IO ()
t2 = do
@@ -198,6 +200,7 @@ t2 = do
, "x = 5"
, "#endif"
]
+ -- x = 5
t3 :: IO ()
t3 = do
@@ -218,6 +221,9 @@ t3 = do
, ""
, "foo = putStrLn x"
]
+ -- y = 1
+ -- x = "hello"
+ -- foo = putStrLn x
t3a :: IO ()
t3a = do
@@ -236,6 +242,8 @@ t3a = do
, ""
, "foo = putStrLn x"
]
+ -- x = "hello"
+ -- foo = putStrLn x
t4 :: IO ()
t4 = do
@@ -257,6 +265,7 @@ t4 = do
, "x = \"no version\""
, "#endif"
]
+ -- x = "got version"
t5 :: IO ()
t5 = do
@@ -267,6 +276,7 @@ t5 = do
, " (major1) == 1 && (major2) == 7 && (minor) <= 0)"
, "x = x"
]
+ -- x = x
t6 :: IO ()
t6 = do
@@ -280,12 +290,13 @@ t6 = do
, "#endif"
, ""
]
+ -- x = "got version"
-t7 :: Maybe (String, [String])
-t7 = parseDefine (mkFastString "#define VERSION_ghc_exactprint \"1.7.0.1\"")
+-- t7 :: Maybe (String, [String])
+t7 = parseDirective "#define VERSION_ghc_exactprint \"1.7.0.1\""
-t8 :: Maybe (String, [String])
-t8 = parseDefine (mkFastString "#define MIN_VERSION_ghc_exactprint(major1,major2,minor) ( (major1) < 1 || (major1) == 1 && (major2) < 7 || (major1) == 1 && (major2) == 7 && (minor) <= 0)")
+-- t8 :: Maybe (String, [String])
+t8 = parseDirective "#define MIN_VERSION_ghc_exactprint(major1,major2,minor) ( (major1) < 1 || (major1) == 1 && (major2) < 7 || (major1) == 1 && (major2) == 7 && (minor) <= 0)"
t9 :: Either String CppDirective
t9 = parseDirective "#define VERSION_ghc_exactprint \"1.7.0.1\""
@@ -302,6 +313,7 @@ t10 = do
, "x = 2"
, "#endif"
]
+ -- x = 1
testIncludes :: Includes
testIncludes =
@@ -325,6 +337,4 @@ t11 = do
, "x = 5"
, "#endif"
]
-
-t12 :: Either String CppDirective
-t12 = parseDirective "#define VERSION_ghc_exactprint \"1.7.0.1\""
+ -- x = 1
=====================================
utils/check-cpp/ParsePP.hs
=====================================
@@ -1,8 +1,10 @@
module ParsePP (
- parseCppParser,
- plusTimesExpr,
+ -- parseCppParser,
+ -- plusTimesExpr,
+ cppLex,
+ parseDirective,
-- testing, delete
- cppDefinition,
+ -- cppDefinition,
) where
import Data.Char
@@ -19,9 +21,12 @@ import qualified Text.Parsec.Expr as E
import Text.Parsec.Language (emptyDef)
import Text.Parsec.Prim as PS hiding (token)
import qualified Text.Parsec.Token as P
+import Data.List
import qualified Parser
import Types
+import ParserM (Token(..),init_state)
+import Lexer
-- =====================================================================
-- First parse to CPP tokens, using a C++-like language spec
@@ -52,94 +57,128 @@ exprDef =
type CppParser = Parsec String ()
--- parseDirective :: String -> Either String CppDirective
--- parseDirective = Parser.parseDirective
-
-parseDirectiveOld :: String -> Either Parsec.ParseError CppDirective
-parseDirectiveOld = parseCppParser cppDirective
-
-parseCppParser :: CppParser a -> String -> Either Parsec.ParseError a
-parseCppParser p = PS.parse p ""
-
--- TODO: delete this
-cppDefinition :: CppParser (String, [String])
-cppDefinition = do
- _ <- PS.char '#'
- _ <- whiteSpace
- eToken "define"
- name <- cppToken
- definition <- cppTokens
- return (name, definition)
-
-cppDirective :: CppParser CppDirective
-cppDirective = do
- _ <- PS.char '#'
- _ <- whiteSpace
- choice
- [ cppKw "define" >> cmdDefinition
- , try $ cppKw "include" >> cmdInclude
- , try $ cppKw "ifdef" >> cmdIfdef
- , try $ cppKw "ifndef" >> cmdIfndef
- -- , try $ cppKw "if" >> cmdIf
- , try $ cppKw "else" >> return CppElse
- , cppKw "endif" >> return CppEndif
- -- , cppKw "elif" CppElifKw
- -- , cppKw "undef" CppUndefKw
- -- , cppKw "error" CppErrorKw
- ]
-
-cmdInclude :: CppParser CppDirective
-cmdInclude = do
- _ <- string "\""
- filename <- many1 (satisfy (\c -> not (isSpace c || c == '"')))
- _ <- string "\""
- return $ CppInclude filename
-
-cmdDefinition :: CppParser CppDirective
-cmdDefinition = do
- name <- cppToken
- CppDefine name <$> cppTokens
-
-cmdIfdef :: CppParser CppDirective
-cmdIfdef = CppIfdef <$> cppToken
-
-cmdIfndef :: CppParser CppDirective
-cmdIfndef = CppIfndef <$> cppToken
+-- Parse a CPP directive, using tokens from the CPP lexer
+parseDirective :: String -> Either String CppDirective
+parseDirective s =
+ case cppLex s of
+ Left e -> Left e
+ Right toks ->
+ case map t_str toks of
+ ("#":"define":ts) -> cppDefine ts
+ ("#":"include":ts) -> Right $ cppInclude ts
+ ("#":"if":ts) -> Right $ cppIf ts
+ ("#":"ifndef":ts) -> Right $ cppIfndef ts
+ ("#":"ifdef":ts) -> Right $ cppIfdef ts
+ ("#":"else":ts) -> Right $ cppElse ts
+ ("#":"endif":ts) -> Right $ cppEndif ts
+ other -> Left ("unexpected directive: " ++ (intercalate " " other))
+
+
+cppDefine [] = Left "error:empty #define directive"
+cppDefine (n:ts) = Right $ CppDefine n (intercalate " " ts)
+
+cppInclude ts = CppInclude (intercalate " " ts)
+cppIf ts = CppIf (intercalate " " ts)
+cppIfdef ts = CppIfdef (intercalate " " ts)
+cppIfndef ts = CppIfndef (intercalate " " ts)
+cppElse _ts = CppElse
+cppEndif _ts = CppEndif
+
+
+-- ---------------------------------------------------------------------
+
+cppLex :: String -> Either String [Token]
+cppLex s = case lexCppTokenStream s init_state of
+ Left err -> Left err
+ Right (_inp, _st, toks) -> Right toks
+
+-- ---------------------------------------------------------------------
+
+-- parseDirectiveOld :: String -> Either Parsec.ParseError CppDirective
+-- parseDirectiveOld = parseCppParser cppDirective
+
+-- parseCppParser :: CppParser a -> String -> Either Parsec.ParseError a
+-- parseCppParser p = PS.parse p ""
+
+-- -- TODO: delete this
+-- cppDefinition :: CppParser (String, [String])
+-- cppDefinition = do
+-- _ <- PS.char '#'
+-- _ <- whiteSpace
+-- eToken "define"
+-- name <- cppToken
+-- definition <- cppTokens
+-- return (name, definition)
+
+-- cppDirective :: CppParser CppDirective
+-- cppDirective = do
+-- _ <- PS.char '#'
+-- _ <- whiteSpace
+-- choice
+-- [ cppKw "define" >> cmdDefinition
+-- , try $ cppKw "include" >> cmdInclude
+-- , try $ cppKw "ifdef" >> cmdIfdef
+-- , try $ cppKw "ifndef" >> cmdIfndef
+-- -- , try $ cppKw "if" >> cmdIf
+-- , try $ cppKw "else" >> return CppElse
+-- , cppKw "endif" >> return CppEndif
+-- -- , cppKw "elif" CppElifKw
+-- -- , cppKw "undef" CppUndefKw
+-- -- , cppKw "error" CppErrorKw
+-- ]
+
+-- cmdInclude :: CppParser CppDirective
+-- cmdInclude = do
+-- _ <- string "\""
+-- filename <- many1 (satisfy (\c -> not (isSpace c || c == '"')))
+-- _ <- string "\""
+-- return $ CppInclude filename
+
+-- cmdDefinition :: CppParser CppDirective
+-- cmdDefinition = do
+-- name <- cppToken
+-- CppDefine name <$> cppTokens
+
+-- cmdIfdef :: CppParser CppDirective
+-- cmdIfdef = CppIfdef <$> cppToken
+
+-- cmdIfndef :: CppParser CppDirective
+-- cmdIfndef = CppIfndef <$> cppToken
-- cmdIf :: CppParser CppDirective
-- cmdIf = CppIf <$> cppTokens
-cppKw :: String -> CppParser ()
-cppKw kw = void $ lexeme (PS.string kw)
+-- cppKw :: String -> CppParser ()
+-- cppKw kw = void $ lexeme (PS.string kw)
-cppComment :: CppParser ()
-cppComment = do
- _ <- PS.string "/*"
- _ <- PS.manyTill PS.anyChar (PS.try (PS.string "*/"))
- return ()
+-- cppComment :: CppParser ()
+-- cppComment = do
+-- _ <- PS.string "/*"
+-- _ <- PS.manyTill PS.anyChar (PS.try (PS.string "*/"))
+-- return ()
-whiteSpace :: CppParser ()
-whiteSpace = do
- _ <- PS.many (PS.choice [cppComment, void PS.space])
- return ()
+-- whiteSpace :: CppParser ()
+-- whiteSpace = do
+-- _ <- PS.many (PS.choice [cppComment, void PS.space])
+-- return ()
-lexeme :: CppParser a -> CppParser a
-lexeme p = p <* whiteSpace
+-- lexeme :: CppParser a -> CppParser a
+-- lexeme p = p <* whiteSpace
-cppToken :: CppParser String
-cppToken = lexeme (PS.many1 (PS.satisfy (not . isSpace)))
+-- cppToken :: CppParser String
+-- cppToken = lexeme (PS.many1 (PS.satisfy (not . isSpace)))
-cppTokens :: CppParser [String]
-cppTokens = PS.many cppToken
+-- cppTokens :: CppParser [String]
+-- cppTokens = PS.many cppToken
--- -------------------------------------
+-- -- -------------------------------------
-plusTimesExpr :: CppParser Expr
-plusTimesExpr = E.buildExpressionParser eTable eTerm
+-- plusTimesExpr :: CppParser Expr
+-- plusTimesExpr = E.buildExpressionParser eTable eTerm
-eTable :: [[E.Operator String () Data.Functor.Identity.Identity Expr]]
-eTable =
- []
+-- eTable :: [[E.Operator String () Data.Functor.Identity.Identity Expr]]
+-- eTable =
+-- []
-- -- Via https://learn.microsoft.com/en-us/cpp/cpp/cpp-built-in-operators-precedence-and-associativity?view=msvc-170
-- [ [E.Infix (Times <$ symbol "*") E.AssocLeft]
-- , [E.Infix (Plus <$ symbol "+") E.AssocLeft]
@@ -154,17 +193,17 @@ eTable =
-- , [E.Infix (BinOp LogicalOr <$ symbol "||") E.AssocLeft]
-- ]
-eTerm :: CppParser Expr
-eTerm =
- eVariable -- <|> pteNum
- <|> pteParens
- <|> eInteger
+-- eTerm :: CppParser Expr
+-- eTerm =
+-- eVariable -- <|> pteNum
+-- <|> pteParens
+-- <|> eInteger
-pteParens :: CppParser Expr
-pteParens = Parens <$> between (symbol "(") (symbol ")") plusTimesExpr
+-- pteParens :: CppParser Expr
+-- pteParens = Parens <$> between (symbol "(") (symbol ")") plusTimesExpr
-symbol :: String -> CppParser String
-symbol s = lexeme $ string s
+-- symbol :: String -> CppParser String
+-- symbol s = lexeme $ string s
-- -- -------------------------------------
@@ -189,26 +228,26 @@ symbol s = lexeme $ string s
-- op <- P.operator (trace "foo" lexer)
-- return $ trace ("op=" ++ show op) LogicalOr
--- TODO: Do we need this? the expression should be fully expanded by
--- the time we get it
-eVariable :: CppParser Expr
-eVariable = do
- v <- P.identifier lexer
- return $ Var v
+-- -- TODO: Do we need this? the expression should be fully expanded by
+-- -- the time we get it
+-- eVariable :: CppParser Expr
+-- eVariable = do
+-- v <- P.identifier lexer
+-- return $ Var v
-eToken :: String -> CppParser ()
-eToken = P.reserved lexer
+-- eToken :: String -> CppParser ()
+-- eToken = P.reserved lexer
-eInteger :: CppParser Expr
-eInteger = IntVal <$> integer
+-- eInteger :: CppParser Expr
+-- eInteger = IntVal <$> integer
-integer :: CppParser Int
-integer = read <$> lexeme (many1 digit)
+-- integer :: CppParser Int
+-- integer = read <$> lexeme (many1 digit)
-- ---------------------------------------------------------------------
doATest :: String -> Either String CppDirective
-doATest str = Parser.parseDirective str
+doATest str = parseDirective str
-- doATest str = parseDirectiveOld str
t0 :: Either String CppDirective
@@ -236,4 +275,4 @@ t2 = doATest "# if ((m1) < 1 || (m1) == 1 && (m2) < 7 || (m1) == 1 && (m2) ==
-- (Comp CmpLtE (Var "m") (IntVal 0)))))
t3 :: Either String CppDirective
-t3 = Parser.parseDirective "# if FOO == 4"
+t3 = parseDirective "# if FOO == 4"
=====================================
utils/check-cpp/Parser.hs
=====================================
@@ -11,7 +11,7 @@
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE PartialTypeSignatures #-}
#endif
-module Parser (parseDirective, parseExpr) where
+module Parser (parseExpr) where
import Lexer (lex_tok)
import ParserM (Token(..), ParserM, run_parser, get_pos, show_pos,
@@ -44,30 +44,29 @@ import Control.Monad (ap)
data HappyAbsSyn t7
= HappyTerminal (Token)
| HappyErrorToken Happy_Prelude.Int
- | HappyAbsSyn6 (CppDirective)
+ | HappyAbsSyn5 (Expr)
| HappyAbsSyn7 t7
- | HappyAbsSyn9 ([String])
- | HappyAbsSyn14 (Expr)
{-# NOINLINE happyTokenStrings #-}
-happyTokenStrings = ["'{'","'}'","'['","']'","'#'","'##'","'('","')'","'<:'","':>'","'<%'","'%>'","'%:'","'%:%:'","';'","':'","'...'","'new'","'delete'","'?'","'::'","'.'","'.*'","'+'","'-'","'*'","'/'","'%'","'^'","'&'","'|'","'~'","'!'","'='","'<'","'>'","'+='","'-='","'*='","'/='","'%='","'^='","'&='","'|='","'<<'","'>>'","'>>='","'<<='","'=='","'!='","'<='","'>='","'&&'","'||'","'++'","'--'","','","'->*'","'->'","'and'","'and_eq'","'bitand'","'bitor'","'compl'","'not'","'not_eq'","'or'","'or_eq'","'xor'","'xor_eq'","lower_name","upper_name","integer","string","other","'define'","'include'","'if'","'ifdef'","'ifndef'","'else'","'endif'","%eof"]
+happyTokenStrings = ["'{'","'}'","'['","']'","'#'","'##'","'('","')'","'<:'","':>'","'<%'","'%>'","'%:'","'%:%:'","';'","':'","'...'","'new'","'delete'","'?'","'::'","'.'","'.*'","'+'","'-'","'*'","'/'","'%'","'^'","'&'","'|'","'~'","'!'","'='","'<'","'>'","'+='","'-='","'*='","'/='","'%='","'^='","'&='","'|='","'<<'","'>>'","'>>='","'<<='","'=='","'!='","'<='","'>='","'&&'","'||'","'++'","'--'","','","'->*'","'->'","'and'","'and_eq'","'bitand'","'bitor'","'compl'","'not'","'not_eq'","'or'","'or_eq'","'xor'","'xor_eq'","lower_name","upper_name","integer","string","other","%eof"]
happyActOffsets :: HappyAddr
-happyActOffsets = HappyA# "\x09\x00\x00\x00\x09\x00\x00\x00\x0d\x00\x00\x00\xcc\xff\xff\xff\xc6\xff\xff\xff\xb7\xff\xff\xff\xc6\xff\xff\xff\xcd\xff\xff\xff\xd0\xff\xff\xff\xd1\xff\xff\xff\xcd\xff\xff\xff\xcd\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xff\xff\x00\x00\x00\x00\xcd\xff\xff\xff\x00\x00\x00\x00\xe2\xff\xff\xff\x15\x00\x00\x00\xf9\xff\xff\xff\xcd\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xf9\xff\xff\xff\xf9\xff\xff\xff\xf9\xff\xff\xff\xf9\xff\xff\xff\xf9\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+happyActOffsets = HappyA# "\xf9\xff\xff\xff\xe2\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xe0\xff\xff\xff\xf9\xff\xff\xff\x00\x00\x00\x00\xfa\xff\xff\xff\xf9\xff\xff\xff\xf9\xff\xff\xff\xf9\xff\xff\xff\xf9\xff\xff\xff\xf9\xff\xff\xff\xf9\xff\xff\xff\xf9\xff\xff\xff\xe6\xff\xff\xff\x01\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xec\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
happyGotoOffsets :: HappyAddr
-happyGotoOffsets = HappyA# "\x1f\x00\x00\x00\x20\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x16\x00\x00\x00\x1d\x00\x00\x00\x1b\x00\x00\x00\x0c\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x1a\x00\x00\x00\x1c\x00\x00\x00\x1e\x00\x00\x00\x21\x00\x00\x00\x22\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+happyGotoOffsets = HappyA# "\x06\x00\x00\x00\x49\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x0c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x22\x00\x00\x00\x27\x00\x00\x00\x37\x00\x00\x00\x3a\x00\x00\x00\x3d\x00\x00\x00\x44\x00\x00\x00\x47\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
happyDefActions :: HappyAddr
-happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf8\xff\xff\xff\xf7\xff\xff\xff\xed\xff\xff\xff\xfa\xff\xff\xff\xf6\xff\xff\xff\xf5\xff\xff\xff\xee\xff\xff\xff\xfb\xff\xff\xff\xf9\xff\xff\xff\xec\xff\xff\xff\xfc\xff\xff\xff\xef\xff\xff\xff\xf2\xff\xff\xff\xfd\xff\xff\xff\x00\x00\x00\x00\xf4\xff\xff\xff\xf1\xff\xff\xff\x00\x00\x00\x00\xdb\xff\xff\xff\x00\x00\x00\x00\xf0\xff\xff\xff\xf3\xff\xff\xff\xdb\xff\xff\xff\xdb\xff\xff\xff\xdb\xff\xff\xff\xdb\xff\xff\xff\xdb\xff\xff\xff\xdc\xff\xff\xff\xdd\xff\xff\xff\xde\xff\xff\xff\xdf\xff\xff\xff\xe0\xff\xff\xff"#
+happyDefActions = HappyA# "\x00\x00\x00\x00\x00\x00\x00\x00\xfe\xff\xff\xff\xf4\xff\xff\xff\xf3\xff\xff\xff\xf2\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\xfd\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xfb\xff\xff\xff\xfa\xff\xff\xff\xf7\xff\xff\xff\xf5\xff\xff\xff\xf9\xff\xff\xff\xf8\xff\xff\xff\xf6\xff\xff\xff\xfc\xff\xff\xff"#
happyCheck :: HappyAddr
-happyCheck = HappyA# "\xff\xff\xff\xff\x08\x00\x00\x00\x09\x00\x00\x00\x08\x00\x00\x00\x4d\x00\x00\x00\x4e\x00\x00\x00\x4f\x00\x00\x00\x50\x00\x00\x00\x51\x00\x00\x00\x52\x00\x00\x00\x53\x00\x00\x00\x01\x00\x00\x00\x01\x00\x00\x00\x01\x00\x00\x00\x03\x00\x00\x00\x06\x00\x00\x00\x06\x00\x00\x00\x05\x00\x00\x00\x01\x00\x00\x00\x06\x00\x00\x00\x03\x00\x00\x00\x48\x00\x00\x00\x49\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x4d\x00\x00\x00\x54\x00\x00\x00\x4b\x00\x00\x00\x3a\x00\x00\x00\x4c\x00\x00\x00\x09\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x04\x00\x00\x00\x07\x00\x00\x00\x0a\x00\x00\x00\x0a\x00\x00\x00\xff\xff\xff\xff\x0a\x00\x00\x00\xff\xff\xff\xff\x0a\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x00\x00\x00\x0a\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x48\x00\x00\x00\x49\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\x4c\x00\x00\x00\xff\xff\xff\xff\x4c\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
+happyCheck = HappyA# "\xff\xff\xff\xff\x08\x00\x00\x00\xff\xff\xff\xff\x09\x00\x00\x00\x24\x00\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\xff\xff\xff\xff\x24\x00\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\xff\xff\xff\xff\x24\x00\x00\x00\x25\x00\x00\x00\x32\x00\x00\x00\xff\xff\xff\xff\x34\x00\x00\x00\x35\x00\x00\x00\x36\x00\x00\x00\x37\x00\x00\x00\x32\x00\x00\x00\xff\xff\xff\xff\x34\x00\x00\x00\x35\x00\x00\x00\x36\x00\x00\x00\xff\xff\xff\xff\x24\x00\x00\x00\x25\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x24\x00\x00\x00\x25\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x48\x00\x00\x00\x49\x00\x00\x00\x32\x00\x00\x00\x4d\x00\x00\x00\x34\x00\x00\x00\x35\x00\x00\x00\x36\x00\x00\x00\x37\x00\x00\x00\xff\xff\xff\xff\x32\x00\x00\x00\xff\xff\xff\xff\x34\x00\x00\x00\x35\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\xff\xff\xff\xff\x48\x00\x00\x00\x49\x00\x00\x00\x4a\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#
happyTable :: HappyAddr
-happyTable = HappyA# "\x00\x00\x00\x00\x23\x00\x00\x00\x24\x00\x00\x00\x1b\x00\x00\x00\x08\x00\x00\x00\x09\x00\x00\x00\x0a\x00\x00\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x0d\x00\x00\x00\x0e\x00\x00\x00\x0e\x00\x00\x00\x1c\x00\x00\x00\x12\x00\x00\x00\x1d\x00\x00\x00\x06\x00\x00\x00\x0f\x00\x00\x00\x13\x00\x00\x00\x1c\x00\x00\x00\x04\x00\x00\x00\x20\x00\x00\x00\x11\x00\x00\x00\x12\x00\x00\x00\x18\x00\x00\x00\x19\x00\x00\x00\x08\x00\x00\x00\xff\xff\xff\xff\x18\x00\x00\x00\x20\x00\x00\x00\x16\x00\x00\x00\x1f\x00\x00\x00\x06\x00\x00\x00\x04\x00\x00\x00\x16\x00\x00\x00\x14\x00\x00\x00\x21\x00\x00\x00\x2b\x00\x00\x00\x00\x00\x00\x00\x2a\x00\x00\x00\x00\x00\x00\x00\x29\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x28\x00\x00\x00\x27\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x25\x00\x00\x00\x26\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x27\x00\x00\x00\x00\x00\x00\x00\x1c\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
+happyTable = HappyA# "\x00\x00\x00\x00\x08\x00\x00\x00\x00\x00\x00\x00\x19\x00\x00\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x06\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x09\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x00\x00\x10\x00\x00\x00\x11\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x00\x00\x10\x00\x00\x00\x00\x00\x00\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x00\x00\x17\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x0b\x00\x00\x00\x0c\x00\x00\x00\x16\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x0d\x00\x00\x00\xff\xff\xff\xff\x0e\x00\x00\x00\x0f\x00\x00\x00\x10\x00\x00\x00\x11\x00\x00\x00\x00\x00\x00\x00\x0d\x00\x00\x00\x00\x00\x00\x00\x0e\x00\x00\x00\x0f\x00\x00\x00\x15\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x14\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x13\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x05\x00\x00\x00\x06\x00\x00\x00\x09\x00\x00\x00\x12\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x11\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x02\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#
-happyReduceArr = Happy_Data_Array.array (2, 36) [
+happyReduceArr = Happy_Data_Array.array (1, 13) [
+ (1 , happyReduce_1),
(2 , happyReduce_2),
(3 , happyReduce_3),
(4 , happyReduce_4),
@@ -79,64 +78,49 @@ happyReduceArr = Happy_Data_Array.array (2, 36) [
(10 , happyReduce_10),
(11 , happyReduce_11),
(12 , happyReduce_12),
- (13 , happyReduce_13),
- (14 , happyReduce_14),
- (15 , happyReduce_15),
- (16 , happyReduce_16),
- (17 , happyReduce_17),
- (18 , happyReduce_18),
- (19 , happyReduce_19),
- (20 , happyReduce_20),
- (21 , happyReduce_21),
- (22 , happyReduce_22),
- (23 , happyReduce_23),
- (24 , happyReduce_24),
- (25 , happyReduce_25),
- (26 , happyReduce_26),
- (27 , happyReduce_27),
- (28 , happyReduce_28),
- (29 , happyReduce_29),
- (30 , happyReduce_30),
- (31 , happyReduce_31),
- (32 , happyReduce_32),
- (33 , happyReduce_33),
- (34 , happyReduce_34),
- (35 , happyReduce_35),
- (36 , happyReduce_36)
+ (13 , happyReduce_13)
]
happyRuleArr :: HappyAddr
-happyRuleArr = HappyA# "\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x00\x00\x00\x00\x02\x00\x00\x00\x01\x00\x00\x00\x01\x00\x00\x00\x01\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x02\x00\x00\x00\x02\x00\x00\x00\x05\x00\x00\x00\x02\x00\x00\x00\x01\x00\x00\x00\x03\x00\x00\x00\x01\x00\x00\x00\x03\x00\x00\x00\x03\x00\x00\x00\x04\x00\x00\x00\x01\x00\x00\x00\x05\x00\x00\x00\x01\x00\x00\x00\x06\x00\x00\x00\x01\x00\x00\x00\x07\x00\x00\x00\x01\x00\x00\x00\x08\x00\x00\x00\x01\x00\x00\x00\x08\x00\x00\x00\x01\x00\x00\x00\x08\x00\x00\x00\x03\x00\x00\x00\x08\x00\x00\x00\x03\x00\x00\x00\x08\x00\x00\x00\x03\x00\x00\x00\x08\x00\x00\x00\x03\x00\x00\x00\x08\x00\x00\x00\x03\x00\x00\x00\x08\x00\x00\x00\x03\x00\x00\x00\x08\x00\x00\x00\x03\x00\x00\x00\x08\x00\x00\x00\x03\x00\x00\x00\x09\x00\x00\x00\x01\x00\x00\x00\x0a\x00\x00\x00\x02\x00\x00\x00\x0a\x00\x00\x00\x02\x00\x00\x00\x0a\x00\x00\x00\x02\x00\x00\x00\x0a\x00\x00\x00\x02\x00\x00\x00\x0a\x00\x00\x00\x02\x00\x00\x00\x0a\x00\x00\x00\x00\x00\x00\x00"#
+happyRuleArr = HappyA# "\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x01\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x00\x00\x00\x00\x03\x00\x00\x00\x01\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x01\x00\x00\x00\x02\x00\x00\x00\x01\x00\x00\x00"#
happyCatchStates :: [Happy_Prelude.Int]
happyCatchStates = []
-happy_n_terms = 85 :: Happy_Prelude.Int
-happy_n_nonterms = 11 :: Happy_Prelude.Int
+happy_n_terms = 78 :: Happy_Prelude.Int
+happy_n_nonterms = 3 :: Happy_Prelude.Int
-happy_n_starts = 2 :: Happy_Prelude.Int
+happy_n_starts = 1 :: Happy_Prelude.Int
+
+#if __GLASGOW_HASKELL__ >= 710
+happyReduce_1 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
+#endif
+happyReduce_1 = happySpecReduce_1 0# happyReduction_1
+happyReduction_1 (HappyAbsSyn5 happy_var_1)
+ = HappyAbsSyn5
+ (happy_var_1
+ )
+happyReduction_1 _ = notHappyAtAll
#if __GLASGOW_HASKELL__ >= 710
happyReduce_2 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
-happyReduce_2 = happySpecReduce_3 0# happyReduction_2
-happyReduction_2 (HappyAbsSyn6 happy_var_3)
- _
- _
- = HappyAbsSyn6
- (happy_var_3
+happyReduce_2 = happySpecReduce_1 0# happyReduction_2
+happyReduction_2 (HappyTerminal happy_var_1)
+ = HappyAbsSyn5
+ (IntVal (read $ t_str happy_var_1)
)
-happyReduction_2 _ _ _ = notHappyAtAll
+happyReduction_2 _ = notHappyAtAll
#if __GLASGOW_HASKELL__ >= 710
happyReduce_3 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
happyReduce_3 = happySpecReduce_3 0# happyReduction_3
-happyReduction_3 (HappyAbsSyn6 happy_var_3)
+happyReduction_3 _
+ (HappyAbsSyn5 happy_var_2)
_
- _
- = HappyAbsSyn6
- (happy_var_3
+ = HappyAbsSyn5
+ (happy_var_2
)
happyReduction_3 _ _ _ = notHappyAtAll
@@ -144,11 +128,11 @@ happyReduction_3 _ _ _ = notHappyAtAll
happyReduce_4 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
happyReduce_4 = happySpecReduce_3 0# happyReduction_4
-happyReduction_4 (HappyAbsSyn6 happy_var_3)
+happyReduction_4 (HappyAbsSyn5 happy_var_3)
_
- _
- = HappyAbsSyn6
- (happy_var_3
+ (HappyAbsSyn5 happy_var_1)
+ = HappyAbsSyn5
+ (Logic LogicalOr happy_var_1 happy_var_3
)
happyReduction_4 _ _ _ = notHappyAtAll
@@ -156,11 +140,11 @@ happyReduction_4 _ _ _ = notHappyAtAll
happyReduce_5 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
happyReduce_5 = happySpecReduce_3 0# happyReduction_5
-happyReduction_5 (HappyAbsSyn6 happy_var_3)
- _
+happyReduction_5 (HappyAbsSyn5 happy_var_3)
_
- = HappyAbsSyn6
- (happy_var_3
+ (HappyAbsSyn5 happy_var_1)
+ = HappyAbsSyn5
+ (Logic LogicalAnd happy_var_1 happy_var_3
)
happyReduction_5 _ _ _ = notHappyAtAll
@@ -168,342 +152,94 @@ happyReduction_5 _ _ _ = notHappyAtAll
happyReduce_6 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
happyReduce_6 = happySpecReduce_3 0# happyReduction_6
-happyReduction_6 (HappyAbsSyn6 happy_var_3)
- _
+happyReduction_6 (HappyAbsSyn5 happy_var_3)
_
- = HappyAbsSyn6
- (happy_var_3
+ (HappyAbsSyn5 happy_var_1)
+ = HappyAbsSyn5
+ (Comp CmpEqual happy_var_1 happy_var_3
)
happyReduction_6 _ _ _ = notHappyAtAll
#if __GLASGOW_HASKELL__ >= 710
happyReduce_7 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
-happyReduce_7 = happySpecReduce_2 0# happyReduction_7
-happyReduction_7 _
- _
- = HappyAbsSyn6
- (CppElse
- )
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_8 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_8 = happySpecReduce_2 0# happyReduction_8
-happyReduction_8 _
- _
- = HappyAbsSyn6
- (CppEndif
- )
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_9 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_9 = happySpecReduce_1 1# happyReduction_9
-happyReduction_9 (HappyTerminal happy_var_1)
- = HappyAbsSyn7
- (t_str happy_var_1
- )
-happyReduction_9 _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_10 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_10 = happySpecReduce_1 1# happyReduction_10
-happyReduction_10 (HappyTerminal happy_var_1)
- = HappyAbsSyn7
- (t_str happy_var_1
- )
-happyReduction_10 _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_11 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_11 = happySpecReduce_2 2# happyReduction_11
-happyReduction_11 (HappyTerminal happy_var_2)
- (HappyAbsSyn7 happy_var_1)
- = HappyAbsSyn6
- (CppDefine happy_var_1 [t_str happy_var_2]
- )
-happyReduction_11 _ _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_12 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_12 = happyReduce 5# 2# happyReduction_12
-happyReduction_12 ((HappyAbsSyn9 happy_var_5) `HappyStk`
- (HappyTerminal happy_var_4) `HappyStk`
- (HappyAbsSyn9 happy_var_3) `HappyStk`
- (HappyTerminal happy_var_2) `HappyStk`
- (HappyAbsSyn7 happy_var_1) `HappyStk`
- happyRest)
- = HappyAbsSyn6
- (CppDefine happy_var_1 (((t_str happy_var_2):happy_var_3) ++ (t_str happy_var_4:(reverse happy_var_5)))
- ) `HappyStk` happyRest
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_13 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_13 = happySpecReduce_1 2# happyReduction_13
-happyReduction_13 (HappyAbsSyn7 happy_var_1)
- = HappyAbsSyn6
- (CppDefine happy_var_1 []
- )
-happyReduction_13 _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_14 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_14 = happySpecReduce_1 3# happyReduction_14
-happyReduction_14 (HappyAbsSyn7 happy_var_1)
- = HappyAbsSyn9
- ([happy_var_1]
- )
-happyReduction_14 _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_15 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_15 = happySpecReduce_3 3# happyReduction_15
-happyReduction_15 (HappyAbsSyn9 happy_var_3)
- _
- (HappyAbsSyn7 happy_var_1)
- = HappyAbsSyn9
- ((happy_var_1 : "," : happy_var_3)
- )
-happyReduction_15 _ _ _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_16 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_16 = happySpecReduce_1 4# happyReduction_16
-happyReduction_16 (HappyTerminal happy_var_1)
- = HappyAbsSyn6
- (CppInclude (t_str happy_var_1)
- )
-happyReduction_16 _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_17 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_17 = happySpecReduce_1 5# happyReduction_17
-happyReduction_17 (HappyAbsSyn7 happy_var_1)
- = HappyAbsSyn6
- (CppIfdef happy_var_1
- )
-happyReduction_17 _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_18 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_18 = happySpecReduce_1 6# happyReduction_18
-happyReduction_18 (HappyAbsSyn7 happy_var_1)
- = HappyAbsSyn6
- (CppIfndef happy_var_1
- )
-happyReduction_18 _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_19 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_19 = happySpecReduce_1 7# happyReduction_19
-happyReduction_19 (HappyTerminal happy_var_1)
- = HappyAbsSyn6
- (CppIf (t_str happy_var_1)
- )
-happyReduction_19 _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_20 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_20 = happySpecReduce_1 8# happyReduction_20
-happyReduction_20 (HappyAbsSyn14 happy_var_1)
- = HappyAbsSyn14
- (happy_var_1
- )
-happyReduction_20 _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_21 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_21 = happySpecReduce_1 8# happyReduction_21
-happyReduction_21 (HappyTerminal happy_var_1)
- = HappyAbsSyn14
- (IntVal (read $ t_str happy_var_1)
- )
-happyReduction_21 _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_22 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_22 = happySpecReduce_3 8# happyReduction_22
-happyReduction_22 _
- (HappyAbsSyn14 happy_var_2)
- _
- = HappyAbsSyn14
- (happy_var_2
- )
-happyReduction_22 _ _ _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_23 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_23 = happySpecReduce_3 8# happyReduction_23
-happyReduction_23 (HappyAbsSyn14 happy_var_3)
- _
- (HappyAbsSyn14 happy_var_1)
- = HappyAbsSyn14
- (Logic LogicalOr happy_var_1 happy_var_3
- )
-happyReduction_23 _ _ _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_24 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_24 = happySpecReduce_3 8# happyReduction_24
-happyReduction_24 (HappyAbsSyn14 happy_var_3)
- _
- (HappyAbsSyn14 happy_var_1)
- = HappyAbsSyn14
- (Logic LogicalAnd happy_var_1 happy_var_3
- )
-happyReduction_24 _ _ _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_25 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_25 = happySpecReduce_3 8# happyReduction_25
-happyReduction_25 (HappyAbsSyn14 happy_var_3)
+happyReduce_7 = happySpecReduce_3 0# happyReduction_7
+happyReduction_7 (HappyAbsSyn5 happy_var_3)
_
- (HappyAbsSyn14 happy_var_1)
- = HappyAbsSyn14
- (Comp CmpEqual happy_var_1 happy_var_3
- )
-happyReduction_25 _ _ _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_26 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_26 = happySpecReduce_3 8# happyReduction_26
-happyReduction_26 (HappyAbsSyn14 happy_var_3)
- _
- (HappyAbsSyn14 happy_var_1)
- = HappyAbsSyn14
+ (HappyAbsSyn5 happy_var_1)
+ = HappyAbsSyn5
(Comp CmpGt happy_var_1 happy_var_3
)
-happyReduction_26 _ _ _ = notHappyAtAll
+happyReduction_7 _ _ _ = notHappyAtAll
#if __GLASGOW_HASKELL__ >= 710
-happyReduce_27 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
+happyReduce_8 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
-happyReduce_27 = happySpecReduce_3 8# happyReduction_27
-happyReduction_27 (HappyAbsSyn14 happy_var_3)
+happyReduce_8 = happySpecReduce_3 0# happyReduction_8
+happyReduction_8 (HappyAbsSyn5 happy_var_3)
_
- (HappyAbsSyn14 happy_var_1)
- = HappyAbsSyn14
+ (HappyAbsSyn5 happy_var_1)
+ = HappyAbsSyn5
(Comp CmpGtE happy_var_1 happy_var_3
)
-happyReduction_27 _ _ _ = notHappyAtAll
+happyReduction_8 _ _ _ = notHappyAtAll
#if __GLASGOW_HASKELL__ >= 710
-happyReduce_28 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
+happyReduce_9 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
-happyReduce_28 = happySpecReduce_3 8# happyReduction_28
-happyReduction_28 (HappyAbsSyn14 happy_var_3)
+happyReduce_9 = happySpecReduce_3 0# happyReduction_9
+happyReduction_9 (HappyAbsSyn5 happy_var_3)
_
- (HappyAbsSyn14 happy_var_1)
- = HappyAbsSyn14
+ (HappyAbsSyn5 happy_var_1)
+ = HappyAbsSyn5
(Comp CmpLt happy_var_1 happy_var_3
)
-happyReduction_28 _ _ _ = notHappyAtAll
+happyReduction_9 _ _ _ = notHappyAtAll
#if __GLASGOW_HASKELL__ >= 710
-happyReduce_29 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
+happyReduce_10 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
-happyReduce_29 = happySpecReduce_3 8# happyReduction_29
-happyReduction_29 (HappyAbsSyn14 happy_var_3)
+happyReduce_10 = happySpecReduce_3 0# happyReduction_10
+happyReduction_10 (HappyAbsSyn5 happy_var_3)
_
- (HappyAbsSyn14 happy_var_1)
- = HappyAbsSyn14
+ (HappyAbsSyn5 happy_var_1)
+ = HappyAbsSyn5
(Comp CmpLtE happy_var_1 happy_var_3
)
-happyReduction_29 _ _ _ = notHappyAtAll
+happyReduction_10 _ _ _ = notHappyAtAll
#if __GLASGOW_HASKELL__ >= 710
-happyReduce_30 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
+happyReduce_11 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
-happyReduce_30 = happySpecReduce_1 9# happyReduction_30
-happyReduction_30 (HappyAbsSyn7 happy_var_1)
- = HappyAbsSyn14
+happyReduce_11 = happySpecReduce_1 1# happyReduction_11
+happyReduction_11 (HappyAbsSyn7 happy_var_1)
+ = HappyAbsSyn5
(Var happy_var_1
)
-happyReduction_30 _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_31 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_31 = happySpecReduce_2 10# happyReduction_31
-happyReduction_31 (HappyAbsSyn9 happy_var_2)
- (HappyTerminal happy_var_1)
- = HappyAbsSyn9
- (t_str happy_var_1 : happy_var_2
- )
-happyReduction_31 _ _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_32 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_32 = happySpecReduce_2 10# happyReduction_32
-happyReduction_32 (HappyAbsSyn9 happy_var_2)
- (HappyTerminal happy_var_1)
- = HappyAbsSyn9
- (t_str happy_var_1 : happy_var_2
- )
-happyReduction_32 _ _ = notHappyAtAll
+happyReduction_11 _ = notHappyAtAll
#if __GLASGOW_HASKELL__ >= 710
-happyReduce_33 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_33 = happySpecReduce_2 10# happyReduction_33
-happyReduction_33 (HappyAbsSyn9 happy_var_2)
- (HappyTerminal happy_var_1)
- = HappyAbsSyn9
- (t_str happy_var_1 : happy_var_2
- )
-happyReduction_33 _ _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_34 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
-#endif
-happyReduce_34 = happySpecReduce_2 10# happyReduction_34
-happyReduction_34 (HappyAbsSyn9 happy_var_2)
- (HappyTerminal happy_var_1)
- = HappyAbsSyn9
- (t_str happy_var_1 : happy_var_2
- )
-happyReduction_34 _ _ = notHappyAtAll
-
-#if __GLASGOW_HASKELL__ >= 710
-happyReduce_35 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
+happyReduce_12 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
-happyReduce_35 = happySpecReduce_2 10# happyReduction_35
-happyReduction_35 (HappyAbsSyn9 happy_var_2)
- (HappyTerminal happy_var_1)
- = HappyAbsSyn9
- (t_str happy_var_1 : happy_var_2
+happyReduce_12 = happySpecReduce_1 2# happyReduction_12
+happyReduction_12 (HappyTerminal happy_var_1)
+ = HappyAbsSyn7
+ (t_str happy_var_1
)
-happyReduction_35 _ _ = notHappyAtAll
+happyReduction_12 _ = notHappyAtAll
#if __GLASGOW_HASKELL__ >= 710
-happyReduce_36 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
+happyReduce_13 :: () => Happy_GHC_Exts.Int# -> Token -> Happy_GHC_Exts.Int# -> Happy_IntList -> HappyStk (HappyAbsSyn _) -> ParserM (HappyAbsSyn _)
#endif
-happyReduce_36 = happySpecReduce_0 10# happyReduction_36
-happyReduction_36 = HappyAbsSyn9
- ([]
+happyReduce_13 = happySpecReduce_1 2# happyReduction_13
+happyReduction_13 (HappyTerminal happy_var_1)
+ = HappyAbsSyn7
+ (t_str happy_var_1
)
+happyReduction_13 _ = notHappyAtAll
happyTerminalToTok term = case term of {
- TEOF "" -> 84#;
+ TEOF "" -> 77#;
TOpenBrace {} -> 2#;
TCloseBrace {} -> 3#;
TOpenBracket {} -> 4#;
@@ -579,13 +315,6 @@ happyTerminalToTok term = case term of {
TInteger {} -> 74#;
TString {} -> 75#;
TOther {} -> 76#;
- TDefine {} -> 77#;
- TInclude {} -> 78#;
- TIf {} -> 79#;
- TIfdef {} -> 80#;
- TIfndef {} -> 81#;
- TElse {} -> 82#;
- TEndif {} -> 83#;
_ -> -1#;
}
{-# NOINLINE happyTerminalToTok #-}
@@ -595,9 +324,9 @@ happyLex kend kmore = lex_tok (\tk -> case tk of {
_ -> kmore (happyTerminalToTok tk) tk })
{-# INLINE happyLex #-}
-happyNewToken action sts stk = happyLex (\tk -> happyDoAction 84# tk action sts stk) (\i tk -> happyDoAction i tk action sts stk)
+happyNewToken action sts stk = happyLex (\tk -> happyDoAction 77# tk action sts stk) (\i tk -> happyDoAction i tk action sts stk)
-happyReport 84# = happyReport'
+happyReport 77# = happyReport'
happyReport _ = happyReport'
@@ -626,20 +355,14 @@ happyReport' = (\tokens expected resume -> happyError)
happyAbort :: () => (ParserM a)
happyAbort = Happy_Prelude.error "Called abort handler in non-resumptive parser"
-directive = happySomeParser where
- happySomeParser = happyThen (happyParse 0#) (\x -> case x of {HappyAbsSyn6 z -> happyReturn z; _other -> notHappyAtAll })
-
expr = happySomeParser where
- happySomeParser = happyThen (happyParse 1#) (\x -> case x of {HappyAbsSyn6 z -> happyReturn z; _other -> notHappyAtAll })
+ happySomeParser = happyThen (happyParse 0#) (\x -> case x of {HappyAbsSyn5 z -> happyReturn z; _other -> notHappyAtAll })
happySeq = happyDontSeq
-- parseExpr :: String -> Either String Expr
parseExpr = run_parser expr
-
-parseDirective :: String -> Either String CppDirective
-parseDirective = run_parser directive
#define HAPPY_DEBUG 1
-- $Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp $
=====================================
utils/check-cpp/Parser.y
=====================================
@@ -1,5 +1,5 @@
{
-module Parser (parseDirective, parseExpr) where
+module Parser (parseExpr) where
import Lexer (lex_tok)
import ParserM (Token(..), ParserM, run_parser, get_pos, show_pos,
@@ -9,7 +9,6 @@ import Types
import qualified GHC.Internal.Data.Tuple as Happy_Prelude
}
-%name directive
%name expr
%expect 0
%tokentype { Token }
@@ -95,16 +94,9 @@ import qualified GHC.Internal.Data.Tuple as Happy_Prelude
string { TString {} }
other { TOther {} }
- 'define' { TDefine {} }
- 'include' { TInclude {} }
- 'if' { TIf {} }
- 'ifdef' { TIfdef {} }
- 'ifndef' { TIfndef {} }
- 'else' { TElse {} }
- 'endif' { TEndif {} }
-
-
-- Operator precedence. Earlier in the table is lower
+-- Note: this seems to require all the operators to appear in the same
+-- rule.
%left '||'
%left '&&'
%left '=='
@@ -114,39 +106,6 @@ import qualified GHC.Internal.Data.Tuple as Happy_Prelude
%%
-directive :: { CppDirective }
-directive : '#' 'define' define { $3 }
- | '#' 'include' include { $3 }
- | '#' 'ifdef' ifdef { $3 }
- | '#' 'ifndef' ifndef { $3 }
- | '#' 'if' if { $3 }
- | '#' 'else' { CppElse }
- | '#' 'endif' { CppEndif }
-
-name : lower_name { t_str $1 }
- | upper_name { t_str $1 }
-
-define :: { CppDirective }
-define : name other { CppDefine $1 [t_str $2] }
- | name '(' args ')' rest { CppDefine $1 (((t_str $2):$3) ++ (t_str $4:(reverse $5))) }
- | name { CppDefine $1 [] }
-
-args :: { [String] }
-args : name { [$1] }
- | name ',' args { ($1 : "," : $3) }
-
-include :: { CppDirective }
-include : string { CppInclude (t_str $1) }
-
-ifdef :: { CppDirective }
-ifdef : name { CppIfdef $1 }
-
-ifndef :: { CppDirective }
-ifndef : name { CppIfndef $1 }
-
-if :: { CppDirective }
-if : other { CppIf (t_str $1) }
-
expr :: { Expr }
expr : variable { $1 }
| integer { IntVal (read $ t_str $1) }
@@ -162,27 +121,10 @@ expr : variable { $1 }
variable :: {Expr}
variable : name { Var $1 }
-
--- The lexer has a specific context for processing a #define
--- directive, to allow parameters to be parsed, before swallowing the
--- balance into an 'other' token with the rest of the string. It stays
--- in this context until it sees something that is not one of the
--- prefix tokens.
---
--- So when getting the rest, accumulate the possible prefix tokens
--- explicitly.
-rest :: { [String] }
-rest : '(' rest { t_str $1 : $2 }
- | ')' rest { t_str $1 : $2 }
- | lower_name rest { t_str $1 : $2 }
- | upper_name rest { t_str $1 : $2 }
- | other rest { t_str $1 : $2 }
- | {- -} { [] }
+name : lower_name { t_str $1 }
+ | upper_name { t_str $1 }
{
-- parseExpr :: String -> Either String Expr
parseExpr = run_parser expr
-
-parseDirective :: String -> Either String CppDirective
-parseDirective = run_parser directive
}
=====================================
utils/check-cpp/ParserM.hs
=====================================
@@ -165,14 +165,6 @@ data Token
| TString {t_str :: String}
| TInteger {t_str :: String}
| TOther {t_str :: String}
- -- Command names
- | TDefine {t_str :: String}
- | TInclude {t_str :: String}
- | TIfdef {t_str :: String}
- | TIfndef {t_str :: String}
- | TIf {t_str :: String}
- | TElse {t_str :: String}
- | TEndif {t_str :: String}
deriving (Show)
-- Actions
=====================================
utils/check-cpp/PreProcess.hs
=====================================
@@ -17,7 +17,6 @@ import Debug.Trace
import Macro
import ParsePP
-import Parser
import Types
-- ---------------------------------------------------------------------
@@ -241,7 +240,7 @@ ppInclude filename = do
-- return $ trace ("ppInclude:filename=[" ++ filename ++ "]") ()
-ppDefine :: String -> [String] -> PP ()
+ppDefine :: String -> String -> PP ()
ppDefine name val = P $ \s ->
-- POk s{pp = (pp s){pp_defines = Set.insert (cleanTokenString def) (pp_defines (pp s))}} ()
POk s{pp = (pp s){pp_defines = Map.insert (trace ("ppDefine:def=[" ++ name ++ "]") (MacroName name Nothing)) val (pp_defines (pp s))}} ()
@@ -267,13 +266,13 @@ cleanTokenString fs = r
ss = dropWhile (\c -> not $ isSpace c) (unpackFS fs)
r = init ss
-parseDefine :: FastString -> Maybe (String, [String])
-parseDefine fs = r
- where
- -- r = Just (cleanTokenString s, "")
- r = case parseCppParser cppDefinition (unpackFS fs) of
- Left _ -> Nothing
- Right v -> Just v
+-- parseDefine :: FastString -> Maybe (String, [String])
+-- parseDefine fs = r
+-- where
+-- -- r = Just (cleanTokenString s, "")
+-- r = case parseCppParser cppDefinition (unpackFS fs) of
+-- Left _ -> Nothing
+-- Right v -> Just v
-- =====================================================================
=====================================
utils/check-cpp/Types.hs
=====================================
@@ -36,7 +36,7 @@ data PpState = PpState
data CppDirective
= CppInclude String
- | CppDefine String [String]
+ | CppDefine String String
| CppIfdef String
| CppIfndef String
| CppIf String
@@ -49,7 +49,7 @@ data CppDirective
type MacroArgs = [String]
data MacroName = MacroName String (Maybe MacroArgs)
deriving (Show, Eq, Ord)
-type MacroDef = [String]
+type MacroDef = String
-- data PpState = PpState
-- { pp_defines :: !(Map MacroName MacroDef)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecec1b0fe0fd71216876cbd1ae8dd86eedc21480
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ecec1b0fe0fd71216876cbd1ae8dd86eedc21480
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20250203/cad72ef1/attachment-0001.html>
More information about the ghc-commits
mailing list