diff --git a/source/BNFC.cabal b/source/BNFC.cabal index f43f48fc..71bcc99c 100644 --- a/source/BNFC.cabal +++ b/source/BNFC.cabal @@ -131,6 +131,7 @@ library FlexibleContexts FlexibleInstances LambdaCase + MultiWayIf NamedFieldPuns OverloadedStrings PatternGuards diff --git a/source/src/BNFC/Backend/C/CFtoBisonC.hs b/source/src/BNFC/Backend/C/CFtoBisonC.hs index d9a5719a..e852f0d9 100644 --- a/source/src/BNFC/Backend/C/CFtoBisonC.hs +++ b/source/src/BNFC/Backend/C/CFtoBisonC.hs @@ -26,20 +26,20 @@ module BNFC.Backend.C.CFtoBisonC import Prelude hiding ((<>)) -import Data.Char (toLower) -import Data.Foldable (toList) -import Data.List (intercalate, nub) -import Data.Maybe (fromMaybe) +import Data.Char ( toLower, isUpper ) +import Data.Foldable ( toList ) +import Data.List ( intercalate, nub ) +import Data.Maybe ( fromMaybe ) import qualified Data.Map as Map -import System.FilePath ((<.>)) +import System.FilePath ( (<.>) ) import BNFC.CF import BNFC.Backend.Common.NamedVariables hiding (varName) -import BNFC.Backend.C.CFtoFlexC (ParserMode(..), cParser, parserHExt, parserName, parserPackage) +import BNFC.Backend.C.CFtoFlexC (ParserMode(..), cParser, stlParser, parserHExt, parserName, parserPackage) import BNFC.Backend.CPP.STL.STLUtils -import BNFC.Options (RecordPositions(..)) +import BNFC.Options (RecordPositions(..), InPackage) import BNFC.PrettyPrint -import BNFC.Utils ((+++), whenJust) +import BNFC.Utils ((+++), for, unless, when, whenJust) --This follows the basic structure of CFtoHappy. @@ -53,11 +53,11 @@ type MetaVar = String cf2Bison :: RecordPositions -> ParserMode -> CF -> SymMap -> String cf2Bison rp mode cf env = unlines [ header mode cf - , render $ union mode $ allParserCatsNorm cf + , render $ union mode $ posCats ++ allParserCatsNorm cf , unionDependentCode mode , "%token _ERROR_" , tokens (map fst $ tokenPragmas cf) env - , declarations cf + , declarations mode cf , specialToks cf , startSymbol cf , "" @@ -66,11 +66,19 @@ cf2Bison rp mode cf env = unlines , prRules $ rulesForBison rp mode cf env , "%%" , "" + , nsStart inPackage , entryCode mode cf + , nsEnd inPackage ] where - name = fromMaybe undefined $ parserName mode + name = parserName mode + inPackage = parserPackage mode + posCats + | stlParser mode = map TokenCat $ positionCats cf + | otherwise = [] +positionCats :: CF -> [String] +positionCats cf = [ wpThing name | TokenReg name True _ <- cfgPragmas cf ] header :: ParserMode -> CF -> String header mode cf = unlines $ concat @@ -80,8 +88,8 @@ header mode cf = unlines $ concat , "%defines \"" ++ ("Bison" <.> h) ++ "\"" ] , whenJust (parserPackage mode) $ \ ns -> - [ "%name-prefix = \"" ++ ns ++ "yy\"" - , " /* From Bison 2.6: %define api.prefix {" ++ ns ++ "yy} */" + [ "%name-prefix = \"" ++ ns ++ "\"" + , " /* From Bison 2.6: %define api.prefix {" ++ ns ++ "} */" ] , [ "" , "/* Reentrant parser */" @@ -125,9 +133,12 @@ header mode cf = unlines $ concat , "" , "extern yyscan_t " ++ name ++ "_initialize_lexer(FILE * inp);" , "" - , "/* List reversal functions. */" + ] + , unless (stlParser mode) + [ "/* List reversal functions. */" , concatMap (reverseList mode) $ filter isList $ allParserCatsNorm cf - , "/* End C preamble code */" + ] + , [ "/* End C preamble code */" , "%}" ] ] @@ -138,7 +149,7 @@ header mode cf = unlines $ concat -- Found old comment: -- -- M.F. 2004-09-17 changed allEntryPoints to allCatsIdNorm. Seems to fix the [Ty2] bug. h = parserHExt mode - name = fromMaybe undefined $ parserName mode + name = parserName mode -- | Code that needs the @YYSTYPE@ defined by the @%union@ pragma. -- @@ -152,7 +163,7 @@ unionDependentCode mode = unlines , "%}" ] where - name = fromMaybe undefined $ parserName mode -- TODO + name = parserName mode errorHandler :: String -> String errorHandler name = unlines @@ -185,11 +196,11 @@ parseMethod mode cf cat = unlines $ concat , body True ] where - name = fromMaybe undefined $ parserName mode + name = parserName mode body stringParser = concat [ [ "{" , " YYSTYPE result;" - , " yyscan_t scanner = " ++ name ++ "_initialize_lexer(", file, ");" + , " yyscan_t scanner = " ++ name ++ "_initialize_lexer(" ++ file ++ ");" , " if (!scanner) {" , " fprintf(stderr, \"Failed to initialize lexer.\\n\");" , " return 0;" @@ -205,7 +216,9 @@ parseMethod mode cf cat = unlines $ concat , " }" , " else" , " { /* Success */" - , " return" +++ res ++ ";" + ] + , revOpt + , [ " return" +++ res ++ ";" , " }" , "}" ] @@ -213,13 +226,22 @@ parseMethod mode cf cat = unlines $ concat where file | stringParser = "0" | otherwise = "inp" + stl = stlParser mode ncat = normCat cat dat0 = identCat ncat dat = if cParser mode then dat0 else dat0 ++ "*" parser = identCat cat res0 = concat [ "result.", varName ncat ] - revRes = "reverse" ++ dat0 ++ "(" ++ res0 ++ ")" - res = if cat `elem` cfgReversibleCats cf then revRes else res0 + -- Reversing the result + isReversible = cat `elem` cfgReversibleCats cf + -- C and NoSTL + res + | not stl, isReversible + = "reverse" ++ dat0 ++ "(" ++ res0 ++ ")" + | otherwise = res0 + -- STL: Vectors are snoc lists + revOpt = when (stl && isList cat && not isReversible) + [ "std::reverse(" ++ res ++ "->begin(), " ++ res ++"->end());" ] --This method generates list reversal functions for each list type. reverseList :: ParserMode -> Cat -> String @@ -248,7 +270,7 @@ reverseList mode c0 = unlines -- yylval. For efficiency, we may want to only include used categories here. -- -- >>> let foo = Cat "Foo" --- >>> union Nothing [foo, ListCat foo] +-- >>> union (CParser True "") [foo, ListCat foo] -- %union -- { -- int _int; @@ -265,7 +287,7 @@ reverseList mode c0 = unlines -- ListFoo* listfoo_; -- -- >>> let foo2 = CoercCat "Foo" 2 --- >>> union (CppParser Nothing) [foo, ListCat foo, foo2, ListCat foo2] +-- >>> union (CppParser Nothing "") [foo, ListCat foo, foo2, ListCat foo2] -- %union -- { -- int _int; @@ -315,12 +337,16 @@ unionBuiltinTokens = , "char* _string;" ] ---declares non-terminal types. -declarations :: CF -> String -declarations cf = concatMap (typeNT cf) (allParserCats cf) - where --don't define internal rules - typeNT cf nt | rulesForCat cf nt /= [] = "%type <" ++ varName (normCat nt) ++ "> " ++ identCat nt ++ "\n" - typeNT _ _ = "" +-- | @%type@ declarations for non-terminal types. +declarations :: ParserMode -> CF -> String +declarations mode cf = unlines $ map typeNT $ + posCats ++ + filter (not . null . rulesForCat cf) (allParserCats cf) -- don't define internal rules + where + typeNT nt = "%type <" ++ varName nt ++ "> " ++ identCat nt + posCats + | stlParser mode = map TokenCat $ positionCats cf + | otherwise = [] --declares terminal types. -- token name "literal" @@ -359,8 +385,17 @@ startSymbol cf = "%start" +++ identCat (firstEntry cf) --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs rulesForBison :: RecordPositions -> ParserMode -> CF -> SymMap -> Rules -rulesForBison rp mode cf env = map mkOne $ ruleGroups cf where +rulesForBison rp mode cf env = map mkOne (ruleGroups cf) ++ posRules + where mkOne (cat,rules) = constructRule rp mode cf env rules cat + posRules :: Rules + posRules + | CppParser inPackage _ <- mode = for (positionCats cf) $ \ n -> (TokenCat n, + [( Map.findWithDefault n (Tokentype n) env + , addResult cf (TokenCat n) $ concat + [ "$$ = new ", nsScope inPackage, n, "($1, @$.first_line);" ] + )]) + | otherwise = [] -- For every non-terminal, we construct a set of rules. constructRule @@ -369,65 +404,108 @@ constructRule -> NonTerminal -- ^ ... this non-terminal. -> (NonTerminal,[(Pattern,Action)]) constructRule rp mode cf env rules nt = (nt,) $ - [ (p,) $ addResult $ generateAction rp mode (identCat (normCat nt)) (funRule r) b m + [ (p,) $ addResult cf nt $ generateAction rp mode (identCat (normCat nt)) (funRule r) b m | r0 <- rules , let (b,r) = if isConsFun (funRule r0) && valCat r0 `elem` cfgReversibleCats cf then (True, revSepListRule r0) else (False, r0) - , let (p,m) = generatePatterns cf env r + , let (p,m) = generatePatterns mode cf env r ] - where - -- Add action if we parse an entrypoint non-terminal: - -- Set field in result record to current parse. - addResult a = - if nt `elem` toList (allEntryPoints cf) - -- Note: Bison has only a single entrypoint, - -- but BNFC works around this by adding dedicated parse methods for all entrypoints. - -- Andreas, 2021-03-24: But see #350: bison still uses only the @%start@ non-terminal. - then concat [ a, " result->", varName (normCat nt), " = $$;" ] - else a + +-- | Add action if we parse an entrypoint non-terminal: +-- Set field in result record to current parse. +addResult :: CF -> NonTerminal -> Action -> Action +addResult cf nt a = + if nt `elem` toList (allEntryPoints cf) + -- Note: Bison has only a single entrypoint, + -- but BNFC works around this by adding dedicated parse methods for all entrypoints. + -- Andreas, 2021-03-24: But see #350: bison still uses only the @%start@ non-terminal. + then concat [ a, " result->", varName (normCat nt), " = $$;" ] + else a + +-- | Switch between STL or not. +generateAction :: IsFun a => RecordPositions -> ParserMode -> String -> a -> Bool -> [(MetaVar, Bool)] -> Action +generateAction rp = \case + CppParser ns _ -> generateActionSTL rp ns + CParser b _ -> \ nt f r -> generateActionC rp (not b) nt f r . map fst -- | Generates a string containing the semantic action. --- >>> generateAction NoRecordPositions (CParser False "") "Foo" "Bar" False ["$1"] --- "make_Bar($1);" --- >>> generateAction NoRecordPositions (CParser False "") "Foo" "_" False ["$1"] --- "$1;" --- >>> generateAction NoRecordPositions (CParser False "") "ListFoo" "[]" False [] --- "0;" --- >>> generateAction NoRecordPositions (CParser False "") "ListFoo" "(:[])" False ["$1"] --- "make_ListFoo($1, 0);" --- >>> generateAction NoRecordPositions (CParser False "") "ListFoo" "(:)" False ["$1","$2"] --- "make_ListFoo($1, $2);" --- >>> generateAction NoRecordPositions (CParser False "") "ListFoo" "(:)" True ["$1","$2"] --- "make_ListFoo($2, $1);" -generateAction :: IsFun a => RecordPositions -> ParserMode -> String -> a -> Bool -> [MetaVar] -> Action -generateAction rp mode nt f b ms - | isCoercion f = unwords ms ++ ";" ++ loc - | isNilFun f = "0;" - | isOneFun f = concat [new, nt, "(", intercalate ", " ms', ", 0);"] - | isConsFun f = concat [new, nt, "(", intercalate ", " ms', ");"] - | otherwise = concat [new, funName f, "(", intercalate ", " ms', ");", loc] +-- >>> generateActionC NoRecordPositions False "Foo" "Bar" False ["$1"] +-- "$$ = new Bar($1);" +-- >>> generateActionC NoRecordPositions True "Foo" "Bar" False ["$1"] +-- "$$ = make_Bar($1);" +-- >>> generateActionC NoRecordPositions True "Foo" "_" False ["$1"] +-- "$$ = $1;" +-- >>> generateActionC NoRecordPositions True "ListFoo" "[]" False [] +-- "$$ = 0;" +-- >>> generateActionC NoRecordPositions True "ListFoo" "(:[])" False ["$1"] +-- "$$ = make_ListFoo($1, 0);" +-- >>> generateActionC NoRecordPositions True "ListFoo" "(:)" False ["$1","$2"] +-- "$$ = make_ListFoo($1, $2);" +-- >>> generateActionC NoRecordPositions True "ListFoo" "(:)" True ["$1","$2"] +-- "$$ = make_ListFoo($2, $1);" +generateActionC :: IsFun a => RecordPositions -> Bool -> String -> a -> Bool -> [MetaVar] -> Action +generateActionC rp cParser nt f b ms + | isCoercion f = "$$ = " ++ unwords ms ++ ";" ++ loc + | isNilFun f = "$$ = 0;" + | isOneFun f = concat ["$$ = ", new nt, "(", intercalate ", " ms', ", 0);"] + | isConsFun f = concat ["$$ = ", new nt, "(", intercalate ", " ms', ");"] + | otherwise = concat ["$$ = ", new (funName f), "(", intercalate ", " ms', ");", loc] where ms' = if b then reverse ms else ms - loc = if rp == RecordPositions then " $$->line_number = @$.first_line; $$->char_number = @$.first_column;" else "" - new = if cParser mode then "make_" else "new " + loc | RecordPositions <- rp + = " $$->line_number = @$.first_line; $$->char_number = @$.first_column;" + | otherwise + = "" + new :: String -> String + new | cParser = ("make_" ++) + | otherwise = \ s -> if isUpper (head s) then "new " ++ s else s + +generateActionSTL :: IsFun a => RecordPositions -> InPackage -> String -> a -> Bool -> [(MetaVar,Bool)] -> Action +generateActionSTL rp inPackage nt f b mbs = reverses ++ + if | isCoercion f -> concat ["$$ = ", unwords ms, ";", loc] + | isNilFun f -> concat ["$$ = ", "new ", scope, nt, "();"] + | isOneFun f -> concat ["$$ = ", "new ", scope, nt, "(); $$->push_back($1);"] + | isConsFun f, b -> "$1->push_back("++ lastms ++ "); $$ = $1;" + | isConsFun f -> lastms ++ "->push_back(" ++ head ms ++ "); $$ = " ++ lastms ++ ";" ---- not left rec + | isDefinedRule f -> concat ["$$ = ", scope, funName f, "(", intercalate ", " ms, ");" ] + | otherwise -> concat ["$$ = ", "new ", scope, funName f, "(", intercalate ", " ms, ");", loc] + where + ms = map fst mbs + lastms = last ms + loc | RecordPositions <- rp + = " $$->line_number = @$.first_line; $$->char_number = @$.first_column;" + | otherwise + = "" + reverses = unwords ["std::reverse(" ++ m ++"->begin(),"++m++"->end()) ;" | (m, True) <- mbs] + scope = nsScope inPackage -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal -generatePatterns :: CF -> SymMap -> Rule -> (Pattern,[MetaVar]) -generatePatterns cf env r = case rhsRule r of +generatePatterns :: ParserMode -> CF -> SymMap -> Rule -> (Pattern,[(MetaVar,Bool)]) +generatePatterns mode cf env r = case rhsRule r of [] -> ("/* empty */",[]) its -> (unwords (map mkIt its), metas its) where - mkIt i = case i of - Left (TokenCat s) -> fromMaybe (typeName s) $ Map.lookup (Tokentype s) env + stl = stlParser mode + mkIt = \case + Left (TokenCat s) + | stl && isPositionCat cf s + -> typeName s + | otherwise -> Map.findWithDefault (typeName s) (Tokentype s) env Left c -> identCat c - Right s -> fromMaybe s $ Map.lookup (Keyword s) env - metas its = [revIf c ('$': show i) | (i,Left c) <- zip [1 :: Int ..] its] - revIf c m = if not (isConsFun (funRule r)) && elem c revs + Right s -> Map.findWithDefault s (Keyword s) env + metas its = [(revIf c ('$': show i), revert c) | (i, Left c) <- zip [1 :: Int ..] its] + -- C and C++/NoSTL: call reverse function + revIf c m = if not stl && isntCons && elem c revs then "reverse" ++ identCat (normCat c) ++ "(" ++ m ++ ")" else m -- no reversal in the left-recursive Cons rule itself - revs = cfgReversibleCats cf + -- C++/STL: flag if reversal is necessary + -- notice: reversibility with push_back vectors is the opposite + -- of right-recursive lists! + revert c = isntCons && isList c && notElem c revs + revs = cfgReversibleCats cf + isntCons = not $ isConsFun $ funRule r -- We have now constructed the patterns and actions, -- so the only thing left is to merge them into one string. @@ -436,11 +514,11 @@ prRules :: Rules -> String prRules [] = [] prRules ((_, []):rs) = prRules rs --internal rule prRules ((nt, (p,a) : ls):rs) = - unwords [nt', ":" , p, "{ $$ =", a, "}", '\n' : pr ls] ++ ";\n" ++ prRules rs + unwords [nt', ":" , p, "{", a, "}", '\n' : pr ls] ++ ";\n" ++ prRules rs where nt' = identCat nt pr [] = [] - pr ((p,a):ls) = unlines [unwords [" |", p, "{ $$ =", a , "}"]] ++ pr ls + pr ((p,a):ls) = unlines [unwords [" |", p, "{", a , "}"]] ++ pr ls --Some helper functions. resultName :: String -> String diff --git a/source/src/BNFC/Backend/C/CFtoFlexC.hs b/source/src/BNFC/Backend/C/CFtoFlexC.hs index e3ae54df..f0241c54 100644 --- a/source/src/BNFC/Backend/C/CFtoFlexC.hs +++ b/source/src/BNFC/Backend/C/CFtoFlexC.hs @@ -15,7 +15,7 @@ module BNFC.Backend.C.CFtoFlexC ( cf2flex - , ParserMode(..), parserName, parserPackage, cParser, parserHExt + , ParserMode(..), parserName, parserPackage, cParser, stlParser, parserHExt , preludeForBuffer -- C code defining a buffer for lexing string literals. , cMacros -- Lexer definitions. , commentStates -- Stream of names for lexer states for comments. @@ -41,27 +41,32 @@ import BNFC.Utils (cstring, unless, when, whenJust) data ParserMode = CParser Bool String -- ^ @C@ (@False@) or @C++ no STL@ (@True@) mode, with @name@ to use as prefix. - | CppParser InPackage -- ^ @C++@ mode, with optional package name + | CppParser InPackage String -- ^ @C++@ mode, with optional package name -parserName :: ParserMode -> Maybe String +parserName :: ParserMode -> String parserName = \case - CParser _ n -> Just n - CppParser _ -> Nothing + CParser _ n -> n + CppParser p n -> fromMaybe n p parserPackage :: ParserMode -> InPackage parserPackage = \case - CParser _ _ -> Nothing - CppParser p -> p + CParser _ _ -> Nothing + CppParser p _ -> p cParser :: ParserMode -> Bool cParser = \case - CParser b _ -> not b - CppParser _ -> False + CParser b _ -> not b + CppParser _ _ -> False + +stlParser :: ParserMode -> Bool +stlParser = \case + CParser _ _ -> False + CppParser _ _ -> True parserHExt :: ParserMode -> String parserHExt = \case - CParser b _ -> if b then "H" else "h" - CppParser _ -> "H" + CParser b _ -> if b then "H" else "h" + CppParser _ _ -> "H" -- | Entrypoint. cf2flex :: ParserMode -> CF -> (String, SymMap) -- The environment is reused by the parser. @@ -94,7 +99,7 @@ prelude stringLiterals mode = unlines $ concat , "%option extra-type=\"Buffer\"" , "" ] - , maybeToList $ ("%option prefix=\"" ++) . (++ "yy\"" ) <$> parserPackage mode + , maybeToList $ ("%option prefix=\"" ++) . (++ "\"" ) <$> parserPackage mode , when (cParser mode) [ "%top{" , "/* strdup was not in the ISO C standard before 6/2019 (C2x), but in POSIX 1003.1." @@ -110,8 +115,7 @@ prelude stringLiterals mode = unlines $ concat , "#include \"" ++ ("Bison" <.> h) ++ "\"" , "" ] - , whenJust (parserName mode) $ \ name -> - [ "#define initialize_lexer " ++ name ++ "_initialize_lexer" + , [ "#define initialize_lexer " ++ parserName mode ++ "_initialize_lexer" , "" ] , when stringLiterals $ preludeForBuffer $ "Buffer" <.> h @@ -205,11 +209,11 @@ restOfFlex inPackage cf env = unlines $ concat , "" ] , userDefTokens - , ifC catString $ lexStrings (ns ++ "yylval") (nsDefine inPackage "_STRING_") (nsDefine inPackage "_ERROR_") - , ifC catChar $ lexChars (ns ++ "yylval") (nsDefine inPackage "_CHAR_") - , ifC catDouble [ "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t " ++ ns ++ "yylval->_double = atof(yytext); return " ++ nsDefine inPackage "_DOUBLE_" ++ ";" ] - , ifC catInteger [ "{DIGIT}+ \t " ++ ns ++ "yylval->_int = atoi(yytext); return " ++ nsDefine inPackage "_INTEGER_" ++ ";" ] - , ifC catIdent [ "{LETTER}{IDENT}* \t " ++ ns ++ "yylval->_string = strdup(yytext); return " ++ nsDefine inPackage "_IDENT_" ++ ";" ] + , ifC catString $ lexStrings yylval (nsDefine inPackage "_STRING_") (nsDefine inPackage "_ERROR_") + , ifC catChar $ lexChars yylval (nsDefine inPackage "_CHAR_") + , ifC catDouble [ "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t " ++ yylval ++ "->_double = atof(yytext); return " ++ nsDefine inPackage "_DOUBLE_" ++ ";" ] + , ifC catInteger [ "{DIGIT}+ \t " ++ yylval ++ "->_int = atoi(yytext); return " ++ nsDefine inPackage "_INTEGER_" ++ ";" ] + , ifC catIdent [ "{LETTER}{IDENT}* \t " ++ yylval ++ "->_string = strdup(yytext); return " ++ nsDefine inPackage "_IDENT_" ++ ";" ] -- , [ "\\n ++" ++ ns ++ "yy_mylinenumber ;" , [ "[ \\t\\r\\n\\f] \t /* ignore white space. */;" , ". \t return " ++ nsDefine inPackage "_ERROR_" ++ ";" @@ -217,11 +221,13 @@ restOfFlex inPackage cf env = unlines $ concat ] ] where + nsDefine _ s = s + yylval = "yylval" -- (ns ++ "yylval") ifC cat s = if isUsedCat cf (TokenCat cat) then s else [] ns = nsString inPackage userDefTokens = [ "" ++ printRegFlex exp ++ - " \t " ++ ns ++ "yylval->_string = strdup(yytext); return " ++ sName name ++ ";" + " \t " ++ yylval ++ "->_string = strdup(yytext); return " ++ sName name ++ ";" | (name, exp) <- tokenPragmas cf ] where sName n = fromMaybe n $ Map.lookup (Tokentype n) env diff --git a/source/src/BNFC/Backend/CPP/STL.hs b/source/src/BNFC/Backend/CPP/STL.hs index e778f59f..bde05a59 100644 --- a/source/src/BNFC/Backend/CPP/STL.hs +++ b/source/src/BNFC/Backend/CPP/STL.hs @@ -19,12 +19,10 @@ import BNFC.CF import BNFC.Options import BNFC.Backend.Base import BNFC.Backend.C (bufferH, bufferC) -import BNFC.Backend.C.CFtoBisonC (unionBuiltinTokens) +import BNFC.Backend.C.CFtoBisonC (cf2Bison) import BNFC.Backend.C.CFtoFlexC (cf2flex, ParserMode(..)) import BNFC.Backend.CPP.Makefile import BNFC.Backend.CPP.STL.CFtoSTLAbs --- import BNFC.Backend.CPP.NoSTL.CFtoFlex -import BNFC.Backend.CPP.STL.CFtoBisonSTL import BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL import BNFC.Backend.CPP.PrettyPrinter import BNFC.Backend.CPP.STL.STLUtils @@ -37,9 +35,9 @@ makeCppStl opts cf = do mkfile "Absyn.C" cfile mkfile "Buffer.H" bufferH mkfile "Buffer.C" $ bufferC "Buffer.H" - let (flex, env) = cf2flex (CppParser $ inPackage opts) cf + let (flex, env) = cf2flex parserMode cf mkfile (name ++ ".l") flex - let bison = cf2Bison (linenumbers opts) (inPackage opts) cf env + let bison = cf2Bison (linenumbers opts) parserMode cf env mkfile (name ++ ".y") bison let header = mkHeaderFile (inPackage opts) cf (allParserCats cf) (toList $ allEntryPoints cf) (Map.elems env) mkfile "Parser.H" header @@ -61,7 +59,7 @@ makeCppStl opts cf = do prefix :: String prefix = snakeCase_ name ++ "_" parserMode :: ParserMode - parserMode = CppParser (inPackage opts) + parserMode = CppParser (inPackage opts) prefix printParseErrHeader :: Maybe String -> String printParseErrHeader inPackage = @@ -178,50 +176,18 @@ mkHeaderFile inPackage cf cats eps env = unlines $ concat , "" , "#include" , "#include" + , "#include \"Absyn.H\"" , "" , nsStart inPackage ] - , map mkForwardDec $ List.nub $ map normCat cats - , [ "typedef union" - , "{" - ] - , map (" " ++) unionBuiltinTokens - , concatMap mkVar cats - , [ "} YYSTYPE;" - , "" - ] , concatMap mkFuncs eps , [ nsEnd inPackage - , "" - , "#define " ++ nsDefine inPackage "_ERROR_" ++ " 258" - , mkDefines (259 :: Int) env - , "extern " ++ nsScope inPackage ++ "YYSTYPE " ++ nsString inPackage ++ "yylval;" , "" , "#endif" ] ] where hdef = nsDefine inPackage "PARSER_HEADER_FILE" - mkForwardDec s = "class " ++ identCat s ++ ";" - mkVar s | normCat s == s = [ " " ++ identCat s ++"*" +++ map toLower (identCat s) ++ "_;" ] - mkVar _ = [] - mkDefines n [] = mkString n - mkDefines n (s:ss) = "#define " ++ s +++ show n ++ "\n" ++ mkDefines (n+1) ss -- "nsDefine inPackage s" not needed (see cf2flex::makeSymEnv) - mkString n = if isUsedCat cf (TokenCat catString) - then ("#define " ++ nsDefine inPackage "_STRING_ " ++ show n ++ "\n") ++ mkChar (n+1) - else mkChar n - mkChar n = if isUsedCat cf (TokenCat catChar) - then ("#define " ++ nsDefine inPackage "_CHAR_ " ++ show n ++ "\n") ++ mkInteger (n+1) - else mkInteger n - mkInteger n = if isUsedCat cf (TokenCat catInteger) - then ("#define " ++ nsDefine inPackage "_INTEGER_ " ++ show n ++ "\n") ++ mkDouble (n+1) - else mkDouble n - mkDouble n = if isUsedCat cf (TokenCat catDouble) - then ("#define " ++ nsDefine inPackage "_DOUBLE_ " ++ show n ++ "\n") ++ mkIdent(n+1) - else mkIdent n - mkIdent n = if isUsedCat cf (TokenCat catIdent) - then "#define " ++ nsDefine inPackage "_IDENT_ " ++ show n ++ "\n" - else "" mkFuncs s = [ identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(FILE *inp);" , identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(const char *str);"