diff --git a/Makefile b/Makefile index f2e69ca0..e0f48ad3 100644 --- a/Makefile +++ b/Makefile @@ -13,4 +13,6 @@ internal-tests : test : cd testing && cabal v1-install && bnfc-system-tests && cd .. +tag : + cd ./source && hasktags --etags . #EOF diff --git a/source/src/BNFC/Backend/C.hs b/source/src/BNFC/Backend/C.hs index a35ed0e1..747c497a 100644 --- a/source/src/BNFC/Backend/C.hs +++ b/source/src/BNFC/Backend/C.hs @@ -62,7 +62,7 @@ makeC opts cf = do makefile :: String -> String -> String -> Doc makefile name prefix basename = vcat [ "CC = gcc -g" - , "CCFLAGS = --ansi -W -Wall -Wsign-conversion -Wno-unused-parameter -Wno-unused-function -Wno-unneeded-internal-declaration ${CC_OPTS}" + , "CCFLAGS = --ansi -W -Wall -Wsign-conversion -Wno-unused-parameter -Wno-unused-function ${CC_OPTS}" -- The @#define _POSIX_C_SOURCE 200809L@ is now placed locally in -- the generated lexer. -- , "CCFLAGS = --ansi -W -Wall -Wno-unused-parameter -Wno-unused-function -Wno-unneeded-internal-declaration -D_POSIX_C_SOURCE=200809L ${CC_OPTS}" diff --git a/source/src/BNFC/Backend/C/CFtoBisonC.hs b/source/src/BNFC/Backend/C/CFtoBisonC.hs index 3e6d0fb8..a85f4996 100644 --- a/source/src/BNFC/Backend/C/CFtoBisonC.hs +++ b/source/src/BNFC/Backend/C/CFtoBisonC.hs @@ -22,6 +22,7 @@ module BNFC.Backend.C.CFtoBisonC , resultName, typeName, varName , specialToks, startSymbol , unionBuiltinTokens + , positionCats ) where @@ -30,17 +31,18 @@ import Prelude hiding ((<>)) import Data.Char ( toLower, isUpper ) import Data.Foldable ( toList ) import Data.List ( intercalate, nub ) +import Data.Maybe ( fromMaybe, isJust ) import qualified Data.Map as Map import System.FilePath ( (<.>) ) import BNFC.CF import BNFC.Backend.Common.NamedVariables hiding (varName) -import BNFC.Backend.C.CFtoFlexC (ParserMode(..), cParser, stlParser, parserHExt, parserName, parserPackage) +import BNFC.Backend.C.CFtoFlexC (ParserMode(..), cParser, stlParser, parserHExt, parserName, parserPackage, isBisonUseUnion, isBisonUseVariant, beyondAnsi) import BNFC.Backend.CPP.Naming import BNFC.Backend.CPP.STL.STLUtils -import BNFC.Options (RecordPositions(..), InPackage) +import BNFC.Options (RecordPositions(..), InPackage, Ansi(..)) import BNFC.PrettyPrint -import BNFC.Utils ((+++), table, applyWhen, for, unless, when, whenJust) +import BNFC.Utils ((+++), table, applyWhen, for, unless, when, whenJust, camelCase_) --This follows the basic structure of CFtoHappy. @@ -54,14 +56,57 @@ type MetaVar = String cf2Bison :: RecordPositions -> ParserMode -> CF -> SymMap -> String cf2Bison rp mode cf env = unlines [ header mode cf - , render $ union mode $ posCats ++ allParserCatsNorm cf - , "" - , unionDependentCode mode - , unlines $ table " " $ concat - [ [ ["%token", "_ERROR_" ] ] - , tokens (map fst $ tokenPragmas cf) env - , specialToks cf - ] + , case isBisonUseUnion mode of { + -- + -- C and CPP(Ansi) ParserMode will genrate following bison code: + -- + -- %union + -- { + -- char* _string; + -- Program* program_; + -- } + -- ... + -- %token _ERROR_ + -- %token _STAR /* * */ + -- ... + -- %token<_string> _STRING_ + -- %token<_int> _INTEGER_ + -- %token<_string> _IDENT_ + -- + -- %type Program + -- + True -> unlines [ + render $ union mode $ posCats ++ allParserCatsNorm cf -- '%union' directive + , "" + , unionDependentCode mode -- yyerror, yyparse part for '%union' + , unlines $ table " " $ concat + [ [ ["%token", "_ERROR_" ] ] -- define %tokens /* x */ + , tokens mode (map fst $ tokenPragmas cf) env -- user-defined regex %tokens + , specialToks mode cf -- built-in %tokens + ]] + ; + -- + -- CPP(BeyondAnsi) ParserMode will genrate following bison code: + -- + -- /** NO union directive ! result will be stored into driver class */ + -- ... + -- %token _ERROR_ + -- %token _STAR /* * */ + -- ... + -- %token _STRING_ + -- %token _ INTEGER_ + -- %token _IDENT_ + -- + -- %type > Program + -- + False -> unlines [ + unlines $ table " " $ concat + [ [ ["%token", "_ERROR_" ] ] -- define %tokens /* x */ + , tokens mode (map fst $ tokenPragmas cf) env -- user-defined regex %tokens + , specialToks mode cf -- built-in %tokens + ]] + ; + } , declarations mode cf , startSymbol cf , "" @@ -70,90 +115,147 @@ cf2Bison rp mode cf env = unlines , prRules $ rulesForBison rp mode cf env , "%%" , "" - , nsStart inPackage - , entryCode mode cf - , nsEnd inPackage + , nsStart ns + , if (beyondAnsi mode) then + unlines [ + "void " ++nsScope parserNs++camelCaseName++ "Parser::error(const " ++nsScope parserNs++camelCaseName++ "Parser::location_type& l, const std::string& m)" + , "{" + , " driver.error(*scanner.loc, m);" + , "}"] + else + entryCode mode cf -- entryCode for beyondAndi is in Driver + , nsEnd ns ] where - inPackage = parserPackage mode - posCats - | stlParser mode = map TokenCat $ positionCats cf - | otherwise = [] + inPackage = parserPackage mode + posCats + | stlParser mode = map TokenCat $ positionCats cf + | otherwise = [] + name = parserName mode + camelCaseName = camelCase_ name + ns = inPackage -- bnfc -p "package" + parserNs = case ns of + Just _ -> Nothing; -- Using above namespace, so not necessary parser name namespace + Nothing -> Just name; -- Using namespace generated by bison (see Makefile) positionCats :: CF -> [String] positionCats cf = [ wpThing name | TokenReg name True _ <- cfgPragmas cf ] header :: ParserMode -> CF -> String -header mode cf = unlines $ concat - [ [ "/* Parser definition to be used with Bison. */" - , "" - , "/* Generate header file for lexer. */" - , "%defines \"" ++ ("Bison" <.> h) ++ "\"" - ] - , whenJust (parserPackage mode) $ \ ns -> - [ "%name-prefix = \"" ++ ns ++ "\"" - , " /* From Bison 2.6: %define api.prefix {" ++ ns ++ "} */" - ] - , [ "" - , "/* Reentrant parser */" - , "%pure_parser" - , " /* From Bison 2.3b (2008): %define api.pure full */" - -- The flag %pure_parser is deprecated with a warning since Bison 3.4, - -- but older Bisons like 2.3 (2006, shipped with macOS) don't recognize - -- %define api.pure full - , "%lex-param { yyscan_t scanner }" - , "%parse-param { yyscan_t scanner }" - , "" - , concat [ "/* Turn on line/column tracking in the ", name, "lloc structure: */" ] - , "%locations" - , "" - , "/* Argument to the parser to be filled with the parsed tree. */" - , "%parse-param { YYSTYPE *result }" - , "" - , "%{" - , "/* Begin C preamble code */" - , "" - ] - -- Andreas, 2021-08-26, issue #377: Some C++ compilers want "algorithm". - -- Fixing regression introduced in 2.9.2. - , when (stlParser mode) - [ "#include /* for std::reverse */" -- mandatory e.g. with GNU C++ 11 - ] - , [ "#include " - , "#include " - , "#include " - , "#include \"" ++ ("Absyn" <.> h) ++ "\"" - , "" - , "#define YYMAXDEPTH 10000000" -- default maximum stack size is 10000, but right-recursion needs O(n) stack - , "" - , "/* The type yyscan_t is defined by flex, but we need it in the parser already. */" - , "#ifndef YY_TYPEDEF_YY_SCANNER_T" - , "#define YY_TYPEDEF_YY_SCANNER_T" - , "typedef void* yyscan_t;" - , "#endif" - , "" - -- , "typedef struct " ++ name ++ "_buffer_state *YY_BUFFER_STATE;" - , "typedef struct yy_buffer_state *YY_BUFFER_STATE;" - , "extern YY_BUFFER_STATE " ++ name ++ "_scan_string(const char *str, yyscan_t scanner);" - , "extern void " ++ name ++ "_delete_buffer(YY_BUFFER_STATE buf, yyscan_t scanner);" - , "" - , "extern void " ++ name ++ "lex_destroy(yyscan_t scanner);" - , "extern char* " ++ name ++ "get_text(yyscan_t scanner);" - , "" - , "extern yyscan_t " ++ name ++ "_initialize_lexer(FILE * inp);" - , "" - ] - , unless (stlParser mode) - [ "/* List reversal functions. */" - , concatMap (reverseList mode) $ filter isList $ allParserCatsNorm cf - ] - , [ "/* End C preamble code */" - , "%}" - ] +header mode cf = unlines $ concat [ + -- + -- Common header + -- + [ "/* Parser definition to be used with Bison. */" + , "" + , "/* Generate header file for lexer. */" + , "%defines \"" ++ ("Bison" <.> hExt) ++ "\"" + ] + , when (and (beyondAnsi mode, isJust ns)) + [ "%define api.namespace {" ++ nsString ns ++ "}" + , "/* Specify the namespace for the C++ parser class. */"] + , if beyondAnsi mode then + -- Bison c++ beyond ansi mode + ["" + , "/* Reentrant parser */" + , "/* lalr1.cc always pure parser. needless to define %define api.pure full */" + , "" + , "%define api.parser.class {" ++ camelCaseName ++ "Parser}" + , "%code top {" + , "#include " + , "}" + , "%code requires{" + , "#include \"Absyn" ++ hExt ++ "\"" + , "" + , " " ++ nsStart ns + , " class " ++ camelCaseName ++ "Scanner;" + , " class " ++ camelCaseName ++ "Driver;" + , " " ++ nsEnd ns + , "}" + , "%parse-param { " ++ nsScope ns ++ camelCaseName ++ "Scanner &scanner }" + , "%parse-param { " ++ nsScope ns ++ camelCaseName ++ "Driver &driver }" + , "" + , "/* Turn on line/column tracking in the " ++name++ "lloc structure: */" + , "%locations" + , "/* variant based implementation of semantic values for C++ */" + , "%require \"3.2\"" + , "%define api.value.type variant" + , "/* 'yacc.c' does not support variant, so use skeleton 'lalr1.cc' */" + , "%skeleton \"lalr1.cc\"" + , "" + , "%code{" + , "/* Begin C++ preamble code */" + , "#include /* for std::reverse */" + , "#include " + , "#include " + , "#include " + , "" + , "/* include for all driver functions */" + , "#include \"Driver.hh\"" + , "" + , "#undef yylex" + , "#define yylex scanner.lex" + , "}" + , "" + ] + else + -- Bison c/c++ ansi mode + ["" + , "/* Reentrant parser */" + , "%pure_parser" + , "/* From Bison 2.3b (2008): %define api.pure full */" + , "/* The flag %pure_parser is deprecated with a warning since Bison 3.4, */" + , "/* but older Bisons like 2.3 (2006, shipped with macOS) don't recognize %define api.pure full */" + , "" + , "%lex-param { yyscan_t scanner }" + , "%parse-param { yyscan_t scanner }" + , "" + , "/* Turn on line/column tracking in the " ++name++ "lloc structure: */" + , "%locations" + , "/* Argument to the parser to be filled with the parsed tree. */" + , "%parse-param { YYSTYPE *result }" + , "" + , "%{" + , "/* Begin C preamble code */" + , "" + -- Andreas, 2021-08-26, issue #377: Some C++ compilers want "algorithm". + -- Fixing regression introduced in 2.9.2. + , when (stlParser mode) + "#include /* for std::reverse */" -- mandatory e.g. with GNU C++ 11 + , "#include " + , "#include " + , "#include " + , "#include \"" ++ ("Absyn" <.> hExt) ++ "\"" + , "" + , "#define YYMAXDEPTH 10000000" -- default maximum stack size is 10000, but right-recursion needs O(n) stack + , "" + , "/* The type yyscan_t is defined by flex, but we need it in the parser already. */" + , "#ifndef YY_TYPEDEF_YY_SCANNER_T" + , "#define YY_TYPEDEF_YY_SCANNER_T" + , "typedef void* yyscan_t;" + , "#endif" + , "" + , "typedef struct yy_buffer_state *YY_BUFFER_STATE;" + , "extern YY_BUFFER_STATE " ++ name ++ "_scan_string(const char *str, yyscan_t scanner);" + , "extern void " ++ name ++ "_delete_buffer(YY_BUFFER_STATE buf, yyscan_t scanner);" + , "" + , "extern void " ++ name ++ "lex_destroy(yyscan_t scanner);" + , "extern char* " ++ name ++ "get_text(yyscan_t scanner);" + , "" + , "extern yyscan_t " ++ name ++ "_initialize_lexer(FILE * inp);" + , "" + , unless (stlParser mode) + unlines [ "/* List reversal functions. */" + , concatMap (reverseList mode) $ filter isList $ allParserCatsNorm cf] + , "/* End C preamble code */" + , "%}" + ] ] where - h = parserHExt mode - name = parserName mode + hExt = "." ++ parserHExt mode + name = parserName mode + camelCaseName = camelCase_ name + ns = parserPackage mode -- | Code that needs the @YYSTYPE@ defined by the @%union@ pragma. -- @@ -290,7 +392,7 @@ reverseList mode c0 = unlines -- ListFoo* listfoo_; -- -- >>> let foo2 = CoercCat "Foo" 2 --- >>> union (CppParser Nothing "") [foo, ListCat foo, foo2, ListCat foo2] +-- >>> union (CppParser Nothing "" Ansi) [foo, ListCat foo, foo2, ListCat foo2] -- %union -- { -- int _int; @@ -323,22 +425,29 @@ unionBuiltinTokens = declarations :: ParserMode -> CF -> String declarations mode cf = unlines $ map typeNT $ posCats ++ - filter (not . null . rulesForCat cf) (allParserCats cf) -- don't define internal rules + -- don't define internal rules + filter (not . null . rulesForCat cf) (allParserCats cf) where - typeNT nt = "%type <" ++ varName nt ++ "> " ++ identCat nt - posCats - | stlParser mode = map TokenCat $ positionCats cf - | otherwise = [] + typeNT nt = if isBisonUseVariant mode then + "%type > " ++ identCat nt + else + "%type <" ++ varName nt ++ "> " ++ identCat nt + posCats + | stlParser mode = map TokenCat $ positionCats cf + | otherwise = [] --declares terminal types. -- token name "literal" -- "Syntax error messages passed to yyerror from the parser will reference the literal string instead of the token name." -- https://www.gnu.org/software/bison/manual/html_node/Token-Decl.html -tokens :: [UserDef] -> SymMap -> [[String]] -tokens user env = map declTok $ Map.toList env +tokens :: ParserMode -> [UserDef] -> SymMap -> [[String]] +tokens mode userDefs env = map declTok $ Map.toList env where + stringType = case isBisonUseVariant mode of + True -> ""; + False -> "<_string>"; declTok (Keyword s, r) = tok "" s r - declTok (Tokentype s, r) = tok (if s `elem` user then "<_string>" else "") s r + declTok (Tokentype s, r) = tok (if s `elem` userDefs then stringType else "") s r tok t s r = [ "%token" ++ t, r, " /* " ++ cStringEscape s ++ " */" ] -- | Escape characters inside a C string. @@ -350,16 +459,21 @@ cStringEscape = concatMap escChar | otherwise = [c] -- | Produces a table with the built-in token types. -specialToks :: CF -> [[String]] -specialToks cf = concat - [ ifC catString [ "%token<_string>", "_STRING_" ] - , ifC catChar [ "%token<_char> ", "_CHAR_" ] - , ifC catInteger [ "%token<_int> ", "_INTEGER_" ] - , ifC catDouble [ "%token<_double>", "_DOUBLE_" ] - , ifC catIdent [ "%token<_string>", "_IDENT_" ] +specialToks :: ParserMode -> CF -> [[String]] +specialToks mode cf = concat + [ ifC catString [ "%token"++stringToken, "_STRING_" ] + , ifC catChar [ "%token"++charToken++" ", "_CHAR_" ] + , ifC catInteger [ "%token"++intToken++" ", "_INTEGER_" ] + , ifC catDouble [ "%token"++doubleToken, "_DOUBLE_" ] + , ifC catIdent [ "%token"++stringToken, "_IDENT_" ] ] where ifC cat s = if isUsedCat cf (TokenCat cat) then [s] else [] + stringToken = if isBisonUseVariant mode then "" else "<_string>" + charToken = if isBisonUseVariant mode then "" else "<_char>" + intToken = if isBisonUseVariant mode then "" else "<_int>" + doubleToken = if isBisonUseVariant mode then "" else "<_double>" + -- | Bison only supports a single entrypoint. startSymbol :: CF -> String @@ -371,12 +485,18 @@ rulesForBison :: RecordPositions -> ParserMode -> CF -> SymMap -> Rules rulesForBison rp mode cf env = map mkOne (ruleGroups cf) ++ posRules where mkOne (cat,rules) = constructRule rp mode cf env rules cat + scope = nsScope (parserPackage mode) posRules :: Rules posRules - | CppParser inPackage _ <- mode = for (positionCats cf) $ \ n -> (TokenCat n, + | CppParser inPackage _ Ansi <- 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);" ] + , addResult mode cf (TokenCat n) $ concat + [ "$$ = new ", scope, n, "($1, @$.first_line);" ] + )]) + | CppParser inPackage _ BeyondAnsi <- mode = for (positionCats cf) $ \ n -> (TokenCat n, + [( Map.findWithDefault n (Tokentype n) env + , addResult mode cf (TokenCat n) $ concat + [ "$$ = std::make_shared<", scope, n, ">($1, @$.begin.line);" ] )]) | otherwise = [] @@ -387,7 +507,7 @@ constructRule -> NonTerminal -- ^ ... this non-terminal. -> (NonTerminal,[(Pattern,Action)]) constructRule rp mode cf env rules nt = (nt,) $ - [ (p,) $ addResult cf nt $ generateAction rp mode (identCat (normCat nt)) (funRule r) b m + [ (p,) $ addResult mode 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) @@ -397,14 +517,16 @@ constructRule rp mode cf env rules nt = (nt,) $ -- | 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 +addResult :: ParserMode -> CF -> NonTerminal -> Action -> Action +addResult mode cf nt a = + if nt `elem` toList (allEntryPoints cf) then + -- 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. + case beyondAnsi mode of + False -> concat [ a, " result->", varName (normCat nt), " = $$;" ] + True -> concat [ a, " driver.", varName (normCat nt), " = $$;" ] + else a -- | Switch between STL or not. generateAction :: IsFun a @@ -416,7 +538,8 @@ generateAction :: IsFun a -> [(MetaVar, Bool)] -- ^ Meta-vars; should the list referenced by the var be reversed? -> Action generateAction rp = \case - CppParser ns _ -> generateActionSTL rp ns + CppParser ns _ Ansi -> generateActionSTL rp ns + CppParser ns _ BeyondAnsi -> generateActionSTLBeyondAnsi rp ns CParser b _ -> \ nt f r -> generateActionC rp (not b) nt f r . map fst -- | Generates a string containing the semantic action. @@ -471,6 +594,28 @@ generateActionSTL rp inPackage nt f b mbs = reverses ++ reverses = unwords ["std::reverse(" ++ m ++"->begin(),"++m++"->end()) ;" | (m, True) <- mbs] scope = nsScope inPackage +generateActionSTLBeyondAnsi :: IsFun a => RecordPositions -> InPackage -> String -> a -> Bool -> [(MetaVar,Bool)] -> Action +generateActionSTLBeyondAnsi rp inPackage nt f b mbs = reverses ++ + if | isCoercion f -> concat ["$$ = ", unwords ms, ";", loc] + | isNilFun f -> concat ["$$ = ", "std::make_shared<", scope, nt, ">();"] + | isOneFun f -> concat ["$$ = ", "std::make_shared<", scope, nt, ">(); $$->cons(", head ms, ");"] + | isConsFun f -> concat [lst, "->cons(", el, "); $$ = ", lst, ";"] + | isDefinedRule f -> concat ["$$ = ", scope, sanitizeCpp (funName f), "(", intercalate ", " ms, ");" ] + | otherwise -> concat ["$$ = ", "std::make_shared<", scope, funName f, ">(", (intercalate ", " ms), ");", loc] + where + -- ms = ["$1", "$1", ...]; + -- Bison's semantic value of the n-th symbol of the right-hand side of the rule. + ms = map fst mbs + -- The following match only happens in the cons case: + [el, lst] = applyWhen b reverse ms -- b: left-recursion transformed? + loc | RecordPositions <- rp + = " $$->line_number = @$.begin.line; $$->char_number = @$.begin.column;" + | otherwise + = "" + reverses = unwords [m ++"->reverse();" | (m, True) <- mbs] + scope = nsScope inPackage + + -- Generate patterns and a set of metavariables indicating -- where in the pattern the non-terminal generatePatterns :: ParserMode -> CF -> SymMap -> Rule -> (Pattern,[(MetaVar,Bool)]) diff --git a/source/src/BNFC/Backend/C/CFtoFlexC.hs b/source/src/BNFC/Backend/C/CFtoFlexC.hs index c50a6252..c18f2366 100644 --- a/source/src/BNFC/Backend/C/CFtoFlexC.hs +++ b/source/src/BNFC/Backend/C/CFtoFlexC.hs @@ -17,7 +17,7 @@ module BNFC.Backend.C.CFtoFlexC ( cf2flex - , ParserMode(..), parserName, parserPackage, cParser, stlParser, parserHExt + , ParserMode(..), parserName, parserPackage, reentrant, cParser, stlParser, parserHExt, variant, beyondAnsi, isBisonUseUnion, isBisonUseVariant , preludeForBuffer -- C code defining a buffer for lexing string literals. , cMacros -- Lexer definitions. , commentStates -- Stream of names for lexer states for comments. @@ -38,47 +38,80 @@ import BNFC.CF import BNFC.Backend.C.Common ( posixC ) import BNFC.Backend.C.RegToFlex import BNFC.Backend.Common.NamedVariables -import BNFC.Options ( InPackage ) +import BNFC.Backend.CPP.STL.STLUtils +import BNFC.Options ( InPackage, Ansi(..) ) import BNFC.PrettyPrint -import BNFC.Utils ( cstring, symbolToName, unless, when ) +import BNFC.Utils ( cstring, symbolToName, unless, when, camelCase_ ) data ParserMode - = CParser Bool String -- ^ @C@ (@False@) or @C++ no STL@ (@True@) mode, with @name@ to use as prefix. - | CppParser InPackage String -- ^ @C++@ mode, with optional package name + = CParser Bool String -- ^ @C@ (@False@) or @C++ no STL@ (@True@) mode, with @name@ to use as prefix. + | CppParser InPackage String Ansi -- ^ @C++@ mode, with optional package name, --ansi or -std=c++14 parserName :: ParserMode -> String parserName = \case CParser _ n -> n - CppParser p n -> fromMaybe n p + CppParser p n _ -> fromMaybe n p parserPackage :: ParserMode -> InPackage parserPackage = \case CParser _ _ -> Nothing - CppParser p _ -> p + CppParser p _ _ -> p + +reentrant :: ParserMode -> String +reentrant = \case + CParser _ _ -> "%pure_parser"; + CppParser _ _ ansi | ansi == BeyondAnsi -> "/* \"lalr1.cc\" is always pure parser. needless to define %define api.pure full */" + | otherwise -> "%pure_parser"; + +variant :: ParserMode -> [String] +variant = \case + CppParser _ _ ansi | ansi == BeyondAnsi -> [ + "/* variant based implementation of semantic values for C++ */" + ,"%require \"3.2\"" + ,"%define api.value.type variant" + ,"/* 'yacc.c' does not support variant, so use skeleton 'lalr1.cc' */" + ,"%skeleton \"lalr1.cc\""] + _ -> [] + +beyondAnsi :: ParserMode -> Bool +beyondAnsi = \case + CppParser _ _ ansi | ansi == BeyondAnsi -> True + _ -> False + +isBisonUseUnion :: ParserMode -> Bool +isBisonUseUnion = \case + CppParser _ _ ansi | ansi == BeyondAnsi -> False + _ -> True + +isBisonUseVariant :: ParserMode -> Bool +isBisonUseVariant = \case + CppParser _ _ ansi | ansi == BeyondAnsi -> True + _ -> False cParser :: ParserMode -> Bool cParser = \case CParser b _ -> not b - CppParser _ _ -> False + CppParser _ _ _ -> False stlParser :: ParserMode -> Bool stlParser = \case CParser _ _ -> False - CppParser _ _ -> True + CppParser _ _ _ -> True parserHExt :: ParserMode -> String parserHExt = \case CParser b _ -> if b then "H" else "h" - CppParser _ _ -> "H" + CppParser _ _ ansi | ansi == BeyondAnsi -> "hh" + | otherwise -> "h" -- | Entrypoint. cf2flex :: ParserMode -> CF -> (String, SymMap) -- The environment is reused by the parser. cf2flex mode cf = (, env) $ unlines [ prelude stringLiterals mode , cMacros cf - , lexSymbols env1 - , restOfFlex (parserPackage mode) cf env - , footer -- mode + , lexSymbols mode env1 + , restOfFlex mode cf env + , footer mode ] where env = Map.fromList env2 @@ -93,11 +126,20 @@ prelude :: Bool -> ParserMode -> String prelude stringLiterals mode = unlines $ concat [ [ "/* Lexer definition for use with FLex */" , "" - -- noinput and nounput are most often unused - -- https://stackoverflow.com/questions/39075510/option-noinput-nounput-what-are-they-for - , "%option noyywrap noinput nounput" - , "%option reentrant bison-bridge bison-locations" - , "" + , if (beyondAnsi mode) then + unlines + [ + -- note: bison bridge not supported for the C++ scanner. + "%option nodefault noyywrap c++" + ] + else + unlines + -- noinput and nounput are most often unused + -- https://stackoverflow.com/questions/39075510/option-noinput-nounput-what-are-they-for + [ "%option noyywrap noinput nounput" + , "%option reentrant bison-bridge bison-locations" + , "" + ] ] , when stringLiterals [ "/* Additional data for the lexer: a buffer for lexing string literals. */" @@ -111,7 +153,20 @@ prelude stringLiterals mode = unlines $ concat , posixC , [ "}" ] ] + , when (beyondAnsi mode) + [ "%top{" + , "#include " + , "}" + ] , [ "%{" + , when (beyondAnsi mode) unlines + [ + "#include \"Scanner.hh\"" -- #include for the class inheriting "yyFlexLexer" + , "" + , "/* using \"token\" to make the returns for the tokens shorter to type */" + , "using token = " ++nsScope parserNs ++ camelCaseName++ "Parser::token;" + , "" + ] , "#include \"" ++ ("Absyn" <.> h) ++ "\"" , "#include \"" ++ ("Bison" <.> h) ++ "\"" , "" @@ -119,65 +174,94 @@ prelude stringLiterals mode = unlines $ concat , [ "#define initialize_lexer " ++ parserName mode ++ "_initialize_lexer" , "" ] - , when stringLiterals $ preludeForBuffer $ "Buffer" <.> h + , when stringLiterals $ preludeForBuffer mode $ "Buffer" <.> h -- https://www.gnu.org/software/bison/manual/html_node/Token-Locations.html -- Flex is responsible for keeping tracking of the yylloc for Bison. -- Flex also doesn't do this automatically so we need this function -- https://stackoverflow.com/a/22125500/425756 - , [ "static void update_loc(YYLTYPE* loc, char* text)" - , "{" - , " loc->first_line = loc->last_line;" - , " loc->first_column = loc->last_column;" - , " int i = 0;" -- put this here as @for (int i...)@ is only allowed in C99 - , " for (; text[i] != '\\0'; ++i) {" - , " if (text[i] == '\\n') {" -- Checking for \n is good enough to also support \r\n (but not \r) - , " ++loc->last_line;" - , " loc->last_column = 0; " - , " } else {" - , " ++loc->last_column; " - , " }" - , " }" - , "}" - , "#define YY_USER_ACTION update_loc(yylloc, yytext);" - , "" - , "%}" - ] + , if beyondAnsi mode then + [ "/* update location on matching */" + , "#define YY_USER_ACTION \\" + , "loc->begin.line = loc->end.line; \\" + , "loc->begin.column = loc->end.column; \\" + , "for(int i = 0; yytext[i] != '\\0'; i++) { \\" + , " if(yytext[i] == '\\n') { \\" + , " loc->end.line++; \\" + , " loc->end.column = 0; \\" + , " } \\" + , " else { \\" + , " loc->end.column++; \\" + , " } \\" + , "}" + , "%}" + ] + else + [ "static void update_loc(YYLTYPE* loc, char* text)" + , "{" + , " loc->first_line = loc->last_line;" + , " loc->first_column = loc->last_column;" + , " int i = 0;" -- put this here as @for (int i...)@ is only allowed in C99 + , " for (; text[i] != '\\0'; ++i) {" + , " if (text[i] == '\\n') {" -- Checking for \n is good enough to also support \r\n (but not \r) + , " ++loc->last_line;" + , " loc->last_column = 0; " + , " } else {" + , " ++loc->last_column; " + , " }" + , " }" + , "}" + , "#define YY_USER_ACTION update_loc(yylloc, yytext);" + , "" + , "%}" + ] ] where - h = parserHExt mode + h = parserHExt mode + name = parserName mode + camelCaseName = camelCase_ name + ns = parserPackage mode -- bnfc -p "package" + parserNs = case ns of + Just _ -> ns; -- Using above namespace + Nothing -> Just name; -- Using namespace generated by bison (see Makefile) + -- | Part of the lexer prelude needed when string literals are to be lexed. -- Defines an interface to the Buffer. -preludeForBuffer :: String -> [String] -preludeForBuffer bufferH = - [ "/* BEGIN extensible string buffer */" - , "" - , "#include \"" ++ bufferH ++ "\"" - , "" - , "/* The initial size of the buffer to lex string literals. */" - , "#define LITERAL_BUFFER_INITIAL_SIZE 1024" - , "" - , "/* The pointer to the literal buffer. */" - , "#define literal_buffer yyextra" - , "" - , "/* Initialize the literal buffer. */" - , "#define LITERAL_BUFFER_CREATE() literal_buffer = newBuffer(LITERAL_BUFFER_INITIAL_SIZE)" - , "" - , "/* Append characters at the end of the buffer. */" - , "#define LITERAL_BUFFER_APPEND(s) bufferAppendString(literal_buffer, s)" - , "" - , "/* Append a character at the end of the buffer. */" - , "#define LITERAL_BUFFER_APPEND_CHAR(c) bufferAppendChar(literal_buffer, c)" - , "" - , "/* Release the buffer, returning a pointer to its content. */" - , "#define LITERAL_BUFFER_HARVEST() releaseBuffer(literal_buffer)" - , "" - , "/* In exceptional cases, e.g. when reaching EOF, we have to free the buffer. */" - , "#define LITERAL_BUFFER_FREE() freeBuffer(literal_buffer)" - , "" - , "/* END extensible string buffer */" - , "" - ] +preludeForBuffer :: ParserMode -> String -> [String] +preludeForBuffer mode bufferH = + ["/* BEGIN extensible string buffer */" + , "" + , "#include \"" ++ bufferH ++ "\"" + , "" + , "/* The initial size of the buffer to lex string literals. */" + , "#define LITERAL_BUFFER_INITIAL_SIZE 1024" + , "" + , "/* The pointer to the literal buffer. */" + , if (beyondAnsi mode) then + -- yyextra is not available in C++ lexer + -- https://stackoverflow.com/questions/51065292/how-to-use-yyextra-in-c + "Buffer literal_buffer = nullptr;" + else + "#define literal_buffer yyextra" + , "" + , "/* Initialize the literal buffer. */" + , "#define LITERAL_BUFFER_CREATE() literal_buffer = newBuffer(LITERAL_BUFFER_INITIAL_SIZE)" + , "" + , "/* Append characters at the end of the buffer. */" + , "#define LITERAL_BUFFER_APPEND(s) bufferAppendString(literal_buffer, s)" + , "" + , "/* Append a character at the end of the buffer. */" + , "#define LITERAL_BUFFER_APPEND_CHAR(c) bufferAppendChar(literal_buffer, c)" + , "" + , "/* Release the buffer, returning a pointer to its content. */" + , "#define LITERAL_BUFFER_HARVEST() releaseBuffer(literal_buffer)" + , "" + , "/* In exceptional cases, e.g. when reaching EOF, we have to free the buffer. */" + , "#define LITERAL_BUFFER_FREE() freeBuffer(literal_buffer)" + , "" + , "/* END extensible string buffer */" + , "" + ] -- For now all categories are included. -- Optimally only the ones that are used should be generated. @@ -196,42 +280,99 @@ cMacros cf = unlines , "%% /* Rules. */" ] -lexSymbols :: KeywordEnv -> String -lexSymbols ss = concatMap transSym ss +lexSymbols :: ParserMode -> KeywordEnv -> String +lexSymbols mode ss = concatMap transSym ss where transSym (s,r) = - "\"" ++ s' ++ "\" \t return " ++ r ++ ";\n" + "\"" ++ s' ++ "\" \t return " ++ prefix ++ r ++ ";\n" where s' = escapeChars s + prefix = if (beyondAnsi mode) then "token::" else "" -restOfFlex :: InPackage -> CF -> SymMap -> String -restOfFlex _inPackage cf env = unlines $ concat +restOfFlex :: ParserMode -> CF -> SymMap -> String +restOfFlex mode cf env = unlines $ concat [ [ render $ lexComments $ comments cf , "" ] , userDefTokens - , ifC catString $ lexStrings "yylval" "_STRING_" "_ERROR_" - , ifC catChar $ lexChars "yylval" "_CHAR_" - , ifC catDouble [ "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t yylval->_double = atof(yytext); return _DOUBLE_;" ] - , ifC catInteger [ "{DIGIT}+ \t yylval->_int = atoi(yytext); return _INTEGER_;" ] - , ifC catIdent [ "{LETTER}{IDENT}* \t yylval->_string = strdup(yytext); return _IDENT_;" ] + , ifC catString $ lexStrings mode (prefix++"_STRING_") (prefix++"_ERROR_") + , ifC catChar $ lexChars mode "yylval" (prefix++"_CHAR_") + , ifC catDouble [ "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t " ++ (yylvalCopy mode "double" "yytext") ++ " return " ++prefix++ "_DOUBLE_;" ] + , ifC catInteger [ "{DIGIT}+ \t " ++ (yylvalCopy mode "int" "yytext") ++ " return " ++prefix++ "_INTEGER_;" ] + , ifC catIdent [ "{LETTER}{IDENT}* \t " ++ (yylvalCopy mode "string" "yytext") ++ " return " ++prefix++ "_IDENT_;" ] , [ "[ \\t\\r\\n\\f] \t /* ignore white space. */;" - , ". \t return _ERROR_;" + , ". \t return " ++prefix++ "_ERROR_;" , "" , "%% /* Initialization code. */" ] + , when (beyondAnsi mode) + [ + nsStart ns + , "" + , "" ++camelCaseName++ "Scanner::" ++camelCaseName++ "Scanner(std::istream *in)" + , " : yyFlexLexer(in)" + , "{" + , " loc = new " ++ nsScope parserNs ++camelCaseName++ "Parser::location_type();" + , "}" + , "" + , "" ++camelCaseName++ "Scanner::~" ++camelCaseName++ "Scanner()" + , "{" + , " delete loc;" + , " delete yylval;" + , "}" + , "" + , "/* This implementation of " ++camelCaseName++ "FlexLexer::yylex() is required to fill the" + , " * vtable of the class " ++camelCaseName++ "FlexLexer. We define the scanner's main yylex" + , " * function via YY_DECL to reside in the Scanner class instead. */" + , "" + , nsEnd ns + , "" + , "#ifdef yylex" + , "#undef yylex" + , "#endif" + , "" + , "int yyFlexLexer::yylex()" + , "{" + , " std::cerr << \"in yyFlexLexer::yylex() !\" << std::endl;" + , " return 0;" + , "}" + ] ] where - ifC cat s = if isUsedCat cf (TokenCat cat) then s else [] - userDefTokens = - [ "" ++ printRegFlex exp ++ - " \t yylval->_string = strdup(yytext); return " ++ sName name ++ ";" - | (name, exp) <- tokenPragmas cf - ] - where sName n = fromMaybe n $ Map.lookup (Tokentype n) env + name = parserName mode + camelCaseName = camelCase_ name + ns = parserPackage mode + parserNs = case ns of -- bnfc -p "package" + Just _ -> Nothing; -- Using above namespace, so not necessary parser name namespace + Nothing -> Just name; -- Using namespace generated by bison (see Makefile) + prefix = if (beyondAnsi mode) then "token::" else "" + ifC cat s = if isUsedCat cf (TokenCat cat) then s else [] + userDefTokens = + [ "" ++ printRegFlex exp ++ + " \t " ++ (yylvalCopy mode "string" "yytext") ++ " return " ++ prefix ++ (sName name) ++ ";" + | (name, exp) <- tokenPragmas cf + ] + where sName n = fromMaybe n $ Map.lookup (Tokentype n) env -footer :: String -footer = unlines +-- | switch yylval->emplace and yylval->_x = conv(yytext) +yylvalCopy :: ParserMode -> String -> String -> String +yylvalCopy mode typeStr arg = + case (beyondAnsi mode, typeStr) of + (True , "string") -> "yylval->emplace(" ++arg++ ");" + (True , "int") -> "yylval->emplace(atoi(" ++arg++ "));" + (True , "double") -> "yylval->emplace(atof(" ++arg++ "));" + (True , _ ) -> "yylval->emplace<" ++typeStr++ ">(" ++arg++ ");" + (False, "string") -> "yylval->_string = strdup(" ++arg++ ");" + (False, "int" ) -> "yylval->_int = atoi(" ++arg++ ");" + (False, "double") -> "yylval->_double = atof(" ++arg++ ");" + (False, _ ) -> "" + +footer :: ParserMode -> String +footer mode = + if beyondAnsi mode then + "" -- TODO: Add required code later + else + unlines $ [ "yyscan_t initialize_lexer(FILE *inp)" , "{" , " yyscan_t scanner;" @@ -242,11 +383,11 @@ footer = unlines ] -- | Lexing of strings, converting escaped characters. -lexStrings :: String -> String -> String -> [String] -lexStrings yylval stringToken errorToken = +lexStrings :: ParserMode -> String -> String -> [String] +lexStrings mode stringToken errorToken = [ "\"\\\"\" \t LITERAL_BUFFER_CREATE(); BEGIN STRING;" , "\\\\ \t BEGIN ESCAPED;" - , "\\\" \t " ++ yylval ++ "->_string = LITERAL_BUFFER_HARVEST(); BEGIN INITIAL; return " ++ stringToken ++ ";" + , "\\\" \t " ++ (yylvalCopy mode "string" "LITERAL_BUFFER_HARVEST()") ++ " BEGIN INITIAL; return " ++ stringToken ++ ";" , ". \t LITERAL_BUFFER_APPEND_CHAR(yytext[0]);" , "f \t LITERAL_BUFFER_APPEND_CHAR('\\f'); BEGIN STRING;" , "n \t LITERAL_BUFFER_APPEND_CHAR('\\n'); BEGIN STRING;" @@ -259,8 +400,20 @@ lexStrings yylval stringToken errorToken = ] -- | Lexing of characters, converting escaped characters. -lexChars :: String -> String -> [String] -lexChars yylval charToken = +lexChars :: ParserMode -> String -> String -> [String] +lexChars mode yylval charToken = + if isBisonUseVariant mode then + [ "\"'\" \tBEGIN CHAR;" + , "\\\\ \t BEGIN CHARESC;" + , "[^'] \t BEGIN CHAREND; " ++ yylval ++ "->emplace(yytext[0]); return " ++ charToken ++ ";" + , "f \t BEGIN CHAREND; " ++ yylval ++ "->emplace('\\f'); return " ++ charToken ++ ";" + , "n \t BEGIN CHAREND; " ++ yylval ++ "->emplace('\\n'); return " ++ charToken ++ ";" + , "r \t BEGIN CHAREND; " ++ yylval ++ "->emplace('\\r'); return " ++ charToken ++ ";" + , "t \t BEGIN CHAREND; " ++ yylval ++ "->emplace('\\t'); return " ++ charToken ++ ";" + , ". \t BEGIN CHAREND; " ++ yylval ++ "->emplace(yytext[0]); return " ++ charToken ++ ";" + , "\"'\" \t BEGIN INITIAL;" + ] + else [ "\"'\" \tBEGIN CHAR;" , "\\\\ \t BEGIN CHARESC;" , "[^'] \t BEGIN CHAREND; " ++ yylval ++ "->_char = yytext[0]; return " ++ charToken ++ ";" diff --git a/source/src/BNFC/Backend/CPP/Common.hs b/source/src/BNFC/Backend/CPP/Common.hs index 89708db2..5977d99f 100644 --- a/source/src/BNFC/Backend/CPP/Common.hs +++ b/source/src/BNFC/Backend/CPP/Common.hs @@ -9,7 +9,7 @@ import Data.List ( intercalate ) import BNFC.CF import BNFC.TypeChecker - +import BNFC.Options ( Ansi ) import BNFC.Backend.C ( comment ) import BNFC.Backend.CPP.Naming @@ -21,8 +21,8 @@ commentWithEmacsModeHint = comment . ("-*- c++ -*- " ++) -- | C++ code for the @define@d constructors. -- -- @definedRules Nothing@ only prints the header. -definedRules :: Maybe ListConstructors -> CF -> String -> String -definedRules mlc cf banner +definedRules :: CppStdMode -> Maybe ListConstructors -> CF -> String -> String +definedRules mode mlc cf banner | null theLines = [] | otherwise = unlines $ banner : "" : theLines where @@ -42,13 +42,26 @@ definedRules mlc cf banner header = cppType t ++ " " ++ sanitizeCpp (funName f) ++ "(" ++ intercalate ", " (map cppArg args) ++ ")" + -- if ansi mode: T* + -- if beyond ansi mode: shared_ptr + wrapSharedPtrByMode :: String -> String + wrapSharedPtrByMode x = case mode of + CppStdAnsi _ -> x ++ "*" + CppStdBeyondAnsi _ -> wrapSharedPtr x + -- ansi mode: new T + -- beyond ansi mode: std::make_shared + wrapInstantiateByMode :: String -> String + wrapInstantiateByMode x = case mode of + CppStdAnsi _ -> "new " ++ x + CppStdBeyondAnsi _ -> wrapMakeShared x + cppType :: Base -> String - cppType (ListT (BaseT x)) = "List" ++ x ++ "*" - cppType (ListT t) = cppType t ++ "*" + cppType (ListT (BaseT x)) = wrapSharedPtrByMode ("List" ++ x) + cppType (ListT t) = wrapSharedPtrByMode (cppType t) cppType (BaseT x) | x `elem` baseTokenCatNames = x | isToken x ctx = "String" - | otherwise = x ++ "*" + | otherwise = wrapSharedPtrByMode x cppArg :: (String, Base) -> String cppArg (x,t) = cppType t ++ " " ++ x ++ "_" @@ -63,7 +76,7 @@ definedRules mlc cf banner App t _ [e] | isToken t ctx -> loop e App x _ es - | isUpper (head x) -> call ("new " ++ x) es + | isUpper (head x) -> call (wrapInstantiateByMode x) es | x `elem` args -> call (x ++ "_") es | otherwise -> call (sanitizeCpp x) es LitInt n -> show n @@ -72,3 +85,20 @@ definedRules mlc cf banner LitString s -> show s call x es = x ++ "(" ++ intercalate ", " (map loop es) ++ ")" + + +data CppStdMode + = CppStdAnsi Ansi -- ^ @Ansi@ mode. + | CppStdBeyondAnsi Ansi -- ^ @BeyondAnsi@ mode. + +wrapPointerIf :: Bool -> String -> String +wrapPointerIf b v = if b then "*" ++ v else v + +wrapSharedPtrIf :: Bool -> String -> String +wrapSharedPtrIf b v = if b then "std::shared_ptr<" ++v++">" else v + +wrapSharedPtr :: String -> String +wrapSharedPtr v = "std::shared_ptr<" ++v++">" + +wrapMakeShared :: String -> String +wrapMakeShared v = "std::make_shared<" ++v++">" diff --git a/source/src/BNFC/Backend/CPP/Makefile.hs b/source/src/BNFC/Backend/CPP/Makefile.hs index 464c5d82..f0c8b098 100644 --- a/source/src/BNFC/Backend/CPP/Makefile.hs +++ b/source/src/BNFC/Backend/CPP/Makefile.hs @@ -1,14 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} module BNFC.Backend.CPP.Makefile (makefile) where - +import BNFC.Options import BNFC.Backend.Common.Makefile import BNFC.PrettyPrint +import BNFC.Utils (when) + -makefile :: String -> String -> String -> Doc -makefile prefix name basename = vcat +makefile :: String -> String -> SharedOptions -> String -> Doc +makefile prefix name opts basename = + vcat $ [ mkVar "CC" "g++ -g" - , mkVar "CCFLAGS" "--ansi -W -Wall -Wsign-conversion -Wno-unused-parameter -Wno-unused-function -Wno-unneeded-internal-declaration" + , mkVar "CCFLAGS" (compileOpt ++ " -W -Wall -Wsign-conversion -Wno-unused-parameter -Wno-unused-function -Wno-unneeded-internal-declaration") , "" , mkVar "FLEX" "flex" , mkVar "FLEX_OPTS" ("-P" ++ prefix) @@ -16,7 +19,10 @@ makefile prefix name basename = vcat , mkVar "BISON" "bison" , mkVar "BISON_OPTS" ("-t -p" ++ prefix) , "" - , mkVar "OBJS" "Absyn.o Buffer.o Lexer.o Parser.o Printer.o" + , if isBeyondAnsiCpp then + mkVar "OBJS" "Absyn.o Buffer.o Lexer.o Parser.o Driver.o Printer.o" + else + mkVar "OBJS" "Absyn.o Buffer.o Lexer.o Parser.o Printer.o" , "" , mkRule ".PHONY" ["clean", "distclean"] [] @@ -28,13 +34,16 @@ makefile prefix name basename = vcat [ name ++ e | e <- [".aux", ".log", ".pdf",".dvi", ".ps", ""]] ] , mkRule "distclean" ["clean"] [ "rm -f " ++ unwords - [ "Absyn.C", "Absyn.H" - , "Buffer.C", "Buffer.H" - , "Test.C" - , "Bison.H", "Parser.C", "Parser.H", "ParserError.H", name ++ ".y" - , "Lexer.C", name ++ ".l" - , "Skeleton.C", "Skeleton.H" - , "Printer.C", "Printer.H" + [ "Absyn" ++ cppExt, "Absyn" ++ hExt + , "Buffer" ++ cppExt, "Buffer" ++ hExt + , "Test" ++ cppExt + , "Bison" ++ hExt, "Parser" ++ cppExt, "Parser" ++ hExt, "ParserError" ++ hExt, name ++ parserExt + , "Lexer" ++ cppExt, name ++ lexerExt + , "Skeleton" ++ cppExt, "Skeleton" ++ hExt + , "Printer" ++ cppExt, "Printer" ++ hExt + , "Driver" ++ cppExt, "Driver" ++ hExt + , "Scanner" ++ hExt + , "location" ++ hExt , basename , name ++ ".tex" ] @@ -42,25 +51,36 @@ makefile prefix name basename = vcat , mkRule testName [ "${OBJS}", "Test.o" ] [ "@echo \"Linking " ++ testName ++ "...\"" , "${CC} ${OBJS} Test.o -o " ++ testName ] - , mkRule "Absyn.o" [ "Absyn.C", "Absyn.H" ] - [ "${CC} ${CCFLAGS} -c Absyn.C" ] - , mkRule "Buffer.o" [ "Buffer.C", "Buffer.H" ] - [ "${CC} ${CCFLAGS} -c Buffer.C " ] - , mkRule "Lexer.C" [ name ++ ".l" ] - [ "${FLEX} ${FLEX_OPTS} -oLexer.C " ++ name ++ ".l" ] - , mkRule "Parser.C Bison.H" [ name ++ ".y" ] - [ "${BISON} ${BISON_OPTS} " ++ name ++ ".y -o Parser.C" ] + , mkRule "Absyn.o" [ "Absyn" ++ cppExt, "Absyn" ++ hExt ] + [ "${CC} ${CCFLAGS} -c Absyn" ++ cppExt ] + , when isBeyondAnsiCpp + mkRule "Driver.o" [ "Driver" ++ cppExt, "Driver" ++ hExt ] + [ "${CC} ${CCFLAGS} -c Driver" ++ cppExt ] + , mkRule "Buffer.o" [ "Buffer" ++ cppExt, "Buffer" ++ hExt ] + [ "${CC} ${CCFLAGS} -c Buffer" ++ cppExt ] + , mkRule ("Lexer" ++ cppExt) [ name ++ lexerExt ] + [ "${FLEX} ${FLEX_OPTS} -oLexer" ++ cppExt ++ " " ++ name ++ lexerExt ] + , mkRule ("Parser" ++ cppExt++ " Bison" ++ hExt) [ name ++ parserExt ] + [ "${BISON} ${BISON_OPTS} " ++ name ++ parserExt ++ " -o Parser" ++ cppExt ] , mkRule "Lexer.o" [ "CCFLAGS+=-Wno-sign-conversion" ] [] - , mkRule "Lexer.o" [ "Lexer.C", "Bison.H" ] - [ "${CC} ${CCFLAGS} -c Lexer.C " ] - , mkRule "Parser.o" [ "Parser.C", "Absyn.H", "Bison.H" ] - [ "${CC} ${CCFLAGS} -c Parser.C" ] - , mkRule "Printer.o" [ "Printer.C", "Printer.H", "Absyn.H" ] - [ "${CC} ${CCFLAGS} -c Printer.C" ] - , mkRule "Skeleton.o" [ "Skeleton.C", "Skeleton.H", "Absyn.H" ] - [ "${CC} ${CCFLAGS} -Wno-unused-parameter -c Skeleton.C" ] - , mkRule "Test.o" [ "Test.C", "Parser.H", "Printer.H", "Absyn.H" ] - [ "${CC} ${CCFLAGS} -c Test.C" ] + , mkRule "Lexer.o" [ "Lexer" ++ cppExt, "Bison" ++ hExt ] + [ "${CC} ${CCFLAGS} -c Lexer" ++ cppExt ] + , mkRule "Parser.o" [ "Parser" ++ cppExt, "Absyn" ++ hExt, "Bison" ++ hExt ] + [ "${CC} ${CCFLAGS} -c Parser" ++ cppExt ] + , mkRule "Printer.o" [ "Printer" ++ cppExt, "Printer" ++ hExt, "Absyn" ++ hExt ] + [ "${CC} ${CCFLAGS} -c Printer" ++ cppExt ] + , mkRule "Skeleton.o" [ "Skeleton" ++ cppExt, "Skeleton" ++ hExt, "Absyn" ++ hExt ] + [ "${CC} ${CCFLAGS} -Wno-unused-parameter -c Skeleton" ++ cppExt ] + , mkRule "Test.o" [ "Test" ++ cppExt, "Parser" ++ hExt, "Printer" ++ hExt, "Absyn" ++ hExt ] + [ "${CC} ${CCFLAGS} -c Test" ++ cppExt ] ] - where testName = "Test" ++ name + where + testName = "Test" ++ name + isBeyondAnsiCpp = and [ansi opts == BeyondAnsi, target opts == TargetCpp] + (compileOpt, lexerExt, parserExt, cppExt, hExt) = + case (ansi opts, target opts) of + (_, TargetCppNoStl) -> ("--ansi" , ".l" , ".y" , ".C ", ".H" ) + (Ansi, TargetCpp) -> ("--ansi" , ".l" , ".y" , ".c ", ".h" ) + (BeyondAnsi, _) -> ("-std=c++14", ".ll", ".yy", ".cc", ".hh") + (_, _) -> ("", "", "", "", "") diff --git a/source/src/BNFC/Backend/CPP/NoSTL.hs b/source/src/BNFC/Backend/CPP/NoSTL.hs index 2eda55e7..382f0b39 100644 --- a/source/src/BNFC/Backend/CPP/NoSTL.hs +++ b/source/src/BNFC/Backend/CPP/NoSTL.hs @@ -6,6 +6,7 @@ module BNFC.Backend.CPP.NoSTL (makeCppNoStl) where import Data.Foldable (toList) +import qualified Data.Map as Map import BNFC.Utils import BNFC.CF @@ -14,7 +15,7 @@ import BNFC.Backend.Base import BNFC.Backend.C ( bufferH, bufferC, comment, testfileHeader ) import BNFC.Backend.C.CFtoBisonC ( cf2Bison ) import BNFC.Backend.C.CFtoFlexC ( cf2flex, ParserMode(..) ) -import BNFC.Backend.CPP.Common ( commentWithEmacsModeHint ) +import BNFC.Backend.CPP.Common ( commentWithEmacsModeHint, CppStdMode(..) ) import BNFC.Backend.CPP.Makefile import BNFC.Backend.CPP.NoSTL.CFtoCPPAbs import BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL @@ -32,15 +33,15 @@ makeCppNoStl opts cf = do mkCppFileWithHint (name ++ ".l") flex mkCppFileWithHint (name ++ ".y") $ cf2Bison (linenumbers opts) parserMode cf env mkCppFile "Parser.H" $ - mkHeaderFile (toList $ allEntryPoints cf) - let (skelH, skelC) = cf2CVisitSkel False Nothing cf + mkHeaderFile cf (allParserCats cf) (toList $ allEntryPoints cf) (Map.elems env) + let (skelH, skelC) = cf2CVisitSkel opts False Nothing cf mkCppFile "Skeleton.H" skelH mkCppFile "Skeleton.C" skelC - let (prinH, prinC) = cf2CPPPrinter False Nothing cf + let (prinH, prinC) = cf2CPPPrinter (CppStdAnsi Ansi) False Nothing cf ".H" mkCppFile "Printer.H" prinH mkCppFile "Printer.C" prinC mkCppFile "Test.C" (cpptest cf) - Makefile.mkMakefile opts $ makefile prefix name + Makefile.mkMakefile opts $ makefile prefix name opts where name :: String name = lang opts @@ -126,8 +127,7 @@ cpptest cf = unlines $ concat dat = identCat $ normCat cat def = identCat cat -mkHeaderFile :: [Cat] -> String -mkHeaderFile eps = unlines $ concat +mkHeaderFile _cf _cats eps _env = unlines $ concat [ [ "#ifndef PARSER_HEADER_FILE" , "#define PARSER_HEADER_FILE" , "" diff --git a/source/src/BNFC/Backend/CPP/NoSTL/CFtoCPPAbs.hs b/source/src/BNFC/Backend/CPP/NoSTL/CFtoCPPAbs.hs index c3a31134..d5aec77c 100644 --- a/source/src/BNFC/Backend/CPP/NoSTL/CFtoCPPAbs.hs +++ b/source/src/BNFC/Backend/CPP/NoSTL/CFtoCPPAbs.hs @@ -31,13 +31,12 @@ import BNFC.Utils ( (+++), (++++) ) import BNFC.Backend.Common.NamedVariables import BNFC.Backend.Common.OOAbstract import BNFC.Backend.CPP.Common - +import BNFC.Options --The result is two files (.H file, .C file) cf2CPPAbs :: String -> CF -> (String, String) cf2CPPAbs _ cf = (mkHFile cf, mkCFile cf) - {- **** Header (.H) File Functions **** -} --Makes the Header file. @@ -58,7 +57,7 @@ mkHFile cf = unlines "/******************** Abstract Syntax Classes ********************/\n", concatMap (prDataH user) (getAbstractSyntax cf), "", - definedRules Nothing cf + definedRules (CppStdAnsi Ansi) Nothing cf "/******************** Defined Constructors ********************/", "", "#endif" @@ -229,7 +228,7 @@ mkCFile cf = unlines [ header, concatMap (prDataC user) (getAbstractSyntax cf), - definedRules (Just $ LC nil cons) cf + definedRules (CppStdAnsi Ansi) (Just $ LC nil cons) cf "/******************** Defined Constructors ********************/" ] where diff --git a/source/src/BNFC/Backend/CPP/PrettyPrinter.hs b/source/src/BNFC/Backend/CPP/PrettyPrinter.hs index 915a5b6a..aeb2709f 100644 --- a/source/src/BNFC/Backend/CPP/PrettyPrinter.hs +++ b/source/src/BNFC/Backend/CPP/PrettyPrinter.hs @@ -29,18 +29,21 @@ import Data.Char (toLower) import BNFC.CF import BNFC.Utils import BNFC.Backend.Common +import BNFC.Backend.Common.OOAbstract import BNFC.Backend.Common.NamedVariables import BNFC.Backend.Common.StrUtils (renderCharOrString) +import BNFC.Backend.CPP.Common (CppStdMode(..)) import BNFC.Backend.CPP.STL.STLUtils import BNFC.PrettyPrint +import BNFC.Options() --Produces (.H file, .C file) -cf2CPPPrinter :: Bool -> Maybe String -> CF -> (String, String) -cf2CPPPrinter useStl inPackage cf = - (mkHFile useStl inPackage cf groups, mkCFile useStl inPackage cf groups) - where +cf2CPPPrinter :: CppStdMode -> Bool -> Maybe String -> CF -> String -> (String, String) +cf2CPPPrinter mode useStl inPackage cf hExt = + (mkHFile mode useStl inPackage cf groups hExt, mkCFile mode useStl inPackage cf groups hExt) + where groups = when useStl (positionRules cf) -- CPP/NoSTL treats position tokens as just tokens - ++ fixCoercions (ruleGroupsInternals cf) + ++ fixCoercions (ruleGroupsInternals cf) positionRules :: CF -> [(Cat,[Rule])] positionRules cf = @@ -51,8 +54,8 @@ positionRules cf = {- **** Header (.H) File Methods **** -} --An extremely large function to make the Header File -mkHFile :: Bool -> Maybe String -> CF -> [(Cat,[Rule])] -> String -mkHFile useStl inPackage cf groups = unlines +mkHFile :: CppStdMode -> Bool -> Maybe String -> CF -> [(Cat,[Rule])] -> String -> String +mkHFile mode useStl inPackage cf groups hExt = unlines [ printHeader , content , classFooter @@ -67,7 +70,7 @@ mkHFile useStl inPackage cf groups = unlines "#ifndef " ++ hdef, "#define " ++ hdef, "", - "#include \"Absyn.H\"", + "#include \"Absyn" ++hExt++ "\"", "#include ", "#include ", "#include ", @@ -100,7 +103,7 @@ mkHFile useStl inPackage cf groups = unlines " char *print(Visitable *v);" ] hdef = nsDefine inPackage "PRINTER_HEADER" - content = concatMap (prDataH useStl) groups + content = concatMap (prDataH mode useStl) groups classFooter = unlines $ [ " void visitInteger(Integer i);", @@ -185,53 +188,63 @@ mkHFile useStl inPackage cf groups = unlines ] --Prints all the required method names and their parameters. -prDataH :: Bool -> (Cat, [Rule]) -> String -prDataH useSTL (cat, rules) - | isList cat = unlines $ concat +prDataH :: CppStdMode -> Bool -> (Cat, [Rule]) -> String +prDataH mode useSTL (cat, rules) + | isList cat = unlines $ concat [ [ concat [ " void visit", cl, "(", cl, " *p);" ] ] - , when useSTL - [ concat [ " void iter", cl, "(", itty, " i, ", itty, " j);" ] ] - ] - | otherwise = abstract ++ concatMap prRuleH rules - where - cl = identCat (normCat cat) - itty = concat [ cl, "::", "const_iterator" ] - abstract = case lookupRule (noPosition $ catToStr cat) rules of - Just _ -> "" - Nothing -> " void visit" ++ cl ++ "(" ++ cl ++ " *p); /* abstract class */\n" + , when useSTL + [ concat [ " void iter", cl, "(", itty, " i, ", itty, " j);" ] ] + ] + | otherwise = abstract ++ concatMap prRuleH rules + where + beyondAnsi = case mode of + CppStdBeyondAnsi _ -> True + CppStdAnsi _ -> False + cl = identCat (normCat cat) + prRuleH = if beyondAnsi then prRuleHBeyondAnsi else prRuleHAnsi + itty = concat [ cl, "::", "const_iterator" ] + abstract = case lookupRule (noPosition $ catToStr cat) rules of + Just _ -> "" + Nothing -> " void visit" ++ cl ++ "(" ++ cl ++ " *p); /* abstract class */\n" --Prints all the methods to visit a rule. -prRuleH :: IsFun f => Rul f -> String -prRuleH (Rule fun _ _ _) | isProperLabel fun = concat +prRuleHAnsi :: IsFun f => Rul f -> String +prRuleHAnsi (Rule fun _ _ _) | isProperLabel fun = concat + [" void visit", funName fun, "(", funName fun, " *p);\n"] +prRuleHAnsi _ = "" + +prRuleHBeyondAnsi :: IsFun f => Rul f -> String +prRuleHBeyondAnsi (Rule fun _ _ _) | isProperLabel fun = concat [" void visit", funName fun, "(", funName fun, " *p);\n"] -prRuleH _ = "" +prRuleHBeyondAnsi _ = "" {- **** Implementation (.C) File Methods **** -} --This makes the .C file by a similar method. -mkCFile :: Bool -> Maybe String -> CF -> [(Cat,[Rule])] -> String -mkCFile useStl inPackage cf groups = concat +mkCFile :: CppStdMode -> Bool -> Maybe String -> CF -> [(Cat,[Rule])] -> String -> String +mkCFile mode useStl inPackage cf groups hExt = concat [ header, nsStart inPackage ++ "\n", prRender useStl, printEntries, - concatMap (prPrintData useStl inPackage cf) groups, + concatMap (prPrintData useStl mode inPackage cf) groups, printBasics, printTokens, showEntries, - concatMap (prShowData useStl) groups, + concatMap (prShowData useStl mode cabs) groups, showBasics, showTokens, nsEnd inPackage ++ "\n" ] where + cabs = cf2cabs cf header = unlines [ "/*** Pretty Printer and Abstract Syntax Viewer ***/", "", "#include ", - "#include \"Printer.H\"", + "#include \"Printer" ++hExt++ "\"", "#define INDENT_WIDTH 2", "" ] @@ -246,6 +259,10 @@ mkCFile useStl inPackage cf groups = concat "", "PrintAbsyn::~PrintAbsyn(void)", "{", + " if (buf_ && strlen(buf_) > 0)", + " {", + " delete[] buf_;", + " }", "}", "", "char *PrintAbsyn::print(Visitable *v)", @@ -267,6 +284,10 @@ mkCFile useStl inPackage cf groups = concat "", "ShowAbsyn::~ShowAbsyn(void)", "{", + " if (buf_ && strlen(buf_) > 0)", + " {", + " delete[] buf_;", + " }", "}", "", "char *ShowAbsyn::show(Visitable *v)", @@ -376,33 +397,31 @@ mkCFile useStl inPackage cf groups = concat {- **** Pretty Printer Methods **** -} -- | Generates methods for the Pretty Printer. -prPrintData :: Bool -> Maybe String -> CF -> (Cat, [Rule]) -> String -prPrintData True {- use STL -} _ _ (cat@(ListCat _), rules) = - render $ genPrintVisitorList (cat, rules) -prPrintData False {- use STL -} _ _ (cat@(ListCat _), rules) = - genPrintVisitorListNoStl (cat, rules) --- Not a list : -prPrintData _ _inPackage cf (TokenCat cat, _rules) | isPositionCat cf cat = unlines $ - -- a position token - [ "void PrintAbsyn::visit" ++ cat ++ "(" ++ cat ++ " *p)" - , "{" - , " visitIdent(p->string_);" - , "}" - , "" - ] -prPrintData _ inPackage _cf (cat, rules) = -- Not a list - abstract ++ concatMap (prPrintRule inPackage) rules +prPrintData :: Bool -> CppStdMode -> Maybe String -> CF -> (Cat, [Rule]) -> String + +prPrintData True mode _ cf (cat@(ListCat _), rules) = + render $ genPrintVisitorList (mode, cat, rules, cf) + +prPrintData False mode _ cf (cat@(ListCat _), rules) = + genPrintVisitorListNoStl (mode, cf2cabs cf, cat, rules) + +prPrintData _ _ _inPackage cf (TokenCat cat, _rules) | + isPositionCat cf cat = genPositionToken cat + +prPrintData _ mode inPackage cf (cat, rules) = + abstract ++ concatMap (prPrintRule mode cabs inPackage) rules where - cl = identCat (normCat cat) - abstract = case lookupRule (noPosition $ catToStr cat) rules of - Just _ -> "" - Nothing -> "void PrintAbsyn::visit" ++ cl ++ "(" ++ cl +++ "*p) {} //abstract class\n\n" + cl = identCat (normCat cat) + cabs = cf2cabs cf + abstract = case lookupRule (noPosition $ catToStr cat) rules of + Just _ -> "" + Nothing -> "void PrintAbsyn::visit" ++ cl ++ "(" ++ cl +++ "*p) {} //abstract class\n\n" -- | Generate pretty printer visitor for a list category (STL version). -- -genPrintVisitorList :: (Cat, [Rule]) -> Doc -genPrintVisitorList (cat@(ListCat _), rules) = vcat - [ "void PrintAbsyn::visit" <> lty <> parens (lty <+> "*" <> vname) +genPrintVisitorList :: (CppStdMode, Cat, [Rule], CF) -> Doc +genPrintVisitorList (mode, cat@(ListCat _), rules, cf) = vcat + [ "void PrintAbsyn::visit" <> lty <> parens (ltyarg <> "*" <+> varg) , codeblock 2 [ "iter" <> lty <> parens (vname <> "->begin()" <> comma <+> vname <> "->end()") <> semi ] , "" @@ -418,7 +437,7 @@ genPrintVisitorList (cat@(ListCat _), rules) = vcat , "else" ] , unless (null docs1) - [ "if (i == j-1)" + [ "if (i == " <> prevJ <> ")" , "{ /* last */" , nest 2 $ vcat docs1 , "}" @@ -433,39 +452,63 @@ genPrintVisitorList (cat@(ListCat _), rules) = vcat , "" ] where - cl = identCat (normCat cat) - lty = text cl -- List type - itty = lty <> "::const_iterator" -- Iterator type - vname = text $ map toLower cl - prules = sortRulesByPrecedence rules - swRules f = switchByPrecedence "_i_" $ - map (second $ sep . prListRule_) $ - uniqOn fst $ filter f prules - -- Discard duplicates, can only handle one rule per precedence. - docs0 = swRules isNilFun - docs1 = swRules isOneFun - docs2 = swRules isConsFun + cabs = cf2cabs cf + primitives = [c | (c,_) <- basetypes] ++ tokentypes cabs + cl = identCat (normCat cat) + lty = text cl -- List type + ltyarg = text cl -- List type arg + itty = lty <> "::const_iterator" -- Iterator type + vname = text $ map toLower cl + varg = text $ (map toLower cl) + prules = sortRulesByPrecedence rules + -- Discard duplicates, can only handle one rule per precedence. + swRules f = switchByPrecedence "_i_" $ map (second $ sep . prListRuleFn) $ uniqOn fst $ filter f prules + docs0 = swRules isNilFun + docs1 = swRules isOneFun + docs2 = swRules isConsFun + + -- | Only render the rhs (items) of a list rule. + prListRuleFn :: IsFun a => Rul a -> [Doc] + prListRuleFn (Rule _ _ items _) = for items $ \case + Right t -> "render(" <> text (snd (renderCharOrString t)) <> ");" + Left c + | Just{} <- maybeTokenCat c + -> "visit" <> dat <> "(" <> visitArg <> ");" + | isList c -> "iter" <> dat <> "(" <> nextArg <> ");" + | otherwise -> "(*i)->accept(this);" + where + dat = text $ identCat $ normCat c + bas = show dat + isPrimitive = elem bas primitives + nextArg = case mode of + CppStdBeyondAnsi _ -> "std::next(i,1), j" + CppStdAnsi _ -> "i+1, j" + visitArg = case (mode, isPrimitive) of + (CppStdBeyondAnsi _, _) -> "*i->get()" + (CppStdAnsi _, _) -> "*i" + + prevJ = case mode of + CppStdBeyondAnsi _ -> "std::prev(j, 1)" + CppStdAnsi _ -> "j-1" genPrintVisitorList _ = error "genPrintVisitorList expects a ListCat" --- | Only render the rhs (items) of a list rule. +genPositionToken :: String -> String +genPositionToken cat = unlines $ + -- a position token + [ "void PrintAbsyn::visit" ++ cat ++ "(" ++ cat ++ " *p)" + , "{" + , " visitIdent(p->string_);" + , "}" + , "" + ] -prListRule_ :: IsFun a => Rul a -> [Doc] -prListRule_ (Rule _ _ items _) = for items $ \case - Right t -> "render(" <> text (snd (renderCharOrString t)) <> ");" - Left c - | Just{} <- maybeTokenCat c - -> "visit" <> dat <> "(*i);" - | isList c -> "iter" <> dat <> "(i+1, j);" - | otherwise -> "(*i)->accept(this);" - where - dat = text $ identCat $ normCat c -- This is the only part of the pretty printer that differs significantly -- between the versions with and without STL. -- The present version has been adapted from CFtoCPrinter. -genPrintVisitorListNoStl :: (Cat, [Rule]) -> String -genPrintVisitorListNoStl (cat@(ListCat _), rules) = unlines $ concat +genPrintVisitorListNoStl :: (CppStdMode, CAbs, Cat, [Rule]) -> String +genPrintVisitorListNoStl (mode, cabs, cat@(ListCat _), rules) = unlines $ concat [ [ "void PrintAbsyn::visit" ++ cl ++ "("++ cl ++ " *" ++ vname ++ ")" , "{" , " if (" ++ vname +++ "== 0)" @@ -491,26 +534,32 @@ genPrintVisitorListNoStl (cat@(ListCat _), rules) = unlines $ concat ] ] where - cl = identCat (normCat cat) - vname = map toLower cl - pre = vname ++ "->" - prules = sortRulesByPrecedence rules - swRules f = switchByPrecedence "_i_" $ - map (second $ sep . map text . prPrintRule_ pre) $ - uniqOn fst $ filter f prules - -- Discard duplicates, can only handle one rule per precedence. + prPrintRuleFn :: IsFun a => String -> Rul a -> [String] + prPrintRuleFn pre (Rule _ _ items _) = map (prPrintItem mode cabs pre) $ numVars items + + cl = identCat (normCat cat) + vname = map toLower cl + pre = vname ++ "->" + prules = sortRulesByPrecedence rules + swRules f = switchByPrecedence "_i_" $ + map (second $ sep . map text . prPrintRuleFn pre) $ + uniqOn fst $ filter f prules + -- Discard duplicates, can only handle one rule per precedence. + + + genPrintVisitorListNoStl _ = error "genPrintVisitorListNoStl expects a ListCat" --Pretty Printer methods for a rule. -prPrintRule :: Maybe String -> Rule -> String -prPrintRule inPackage r@(Rule fun _ _ _) | isProperLabel fun = unlines $ concat - [ [ "void PrintAbsyn::visit" ++ funName fun ++ "(" ++ funName fun +++ "*" ++ fnm ++ ")" +prPrintRule :: CppStdMode -> CAbs -> Maybe String -> Rule -> String +prPrintRule mode cabs inPackage r@(Rule fun _ _ _) | isProperLabel fun = unlines $ concat + [ [ "void PrintAbsyn::visit" ++ visitFunName ++ "(" ++ vararg +++ fnm ++ ")" , "{" , " int oldi = _i_;" , parenCode "_L_PAREN" , "" ] - , prPrintRule_ (fnm ++ "->") r + , prPrintRuleFn (fnm ++ "->") r , [ "" , parenCode "_R_PAREN" , " _i_ = oldi;" @@ -519,32 +568,42 @@ prPrintRule inPackage r@(Rule fun _ _ _) | isProperLabel fun = unlines $ concat ] ] where - p = precRule r - parenCode x = " if (oldi > " ++ show p ++ ") render(" ++ nsDefine inPackage x ++ ");" - fnm = "p" --old names could cause conflicts -prPrintRule _ _ = "" + visitFunName = funName fun + vararg = funName fun ++ "*" + p = precRule r + parenCode x = " if (oldi > " ++ show p ++ ") render(" ++ nsDefine inPackage x ++ ");" + fnm = "p" --old names could cause conflicts + + prPrintRuleFn :: IsFun a => String -> Rul a -> [String] + prPrintRuleFn pre (Rule _ _ items _) = map (prPrintItem mode cabs pre) $ numVars items -prPrintRule_ :: IsFun a => String -> Rul a -> [String] -prPrintRule_ pre (Rule _ _ items _) = map (prPrintItem pre) $ numVars items +prPrintRule _ _ _ _ = "" -- note: this is otherwise pattern, is there any good code style? --This goes on to recurse to the instance variables. -prPrintItem :: String -> Either (Cat, Doc) String -> String -prPrintItem _ (Right t) = " render(" ++ snd (renderCharOrString t) ++ ");" -prPrintItem pre (Left (c, nt)) - | Just t <- maybeTokenCat c - = " visit" ++ t ++ "(" ++ pre ++ s ++ ");" - | isList c = " " ++ setI (precCat c) ++ - "visit" ++ elt ++ "(" ++ pre ++ s ++ ");" - | otherwise = " " ++ setI (precCat c) ++ pre ++ s ++ "->accept(this);" +prPrintItem :: CppStdMode -> CAbs -> String -> Either (Cat, Doc) String -> String +prPrintItem _ _ _ (Right t) = " render(" ++ snd (renderCharOrString t) ++ ");" +prPrintItem mode cabs pre (Left (c, nt)) + | Just t <- maybeTokenCat c = " visit" ++ t ++ "(" ++ pre ++ visitArg ++ ");" + | isList c = " " ++ setI (precCat c) ++ "visit" ++ elt ++ "(" ++ pre ++ visitArg ++ ");" + | otherwise = " " ++ setI (precCat c) ++ pre ++ s ++ "->accept(this);" where - s = render nt - elt = identCat $ normCat c + elt = identCat $ normCat c + s = render nt + primitives = [c | (c,_) <- basetypes] ++ tokentypes cabs + visitArg = case (mode, maybeTokenCat c) of + (CppStdBeyondAnsi _, Just t) + | not $ elem t primitives -> s ++ ".get()" -- not primitive + | otherwise -> s -- primitive + (CppStdBeyondAnsi _, Nothing) + | otherwise -> s ++ ".get()" -- list is not primitive + (CppStdAnsi _, _) -> s -- ansi using raw pointer + {- **** Abstract Syntax Tree Printer **** -} --This prints the functions for Abstract Syntax tree printing. -prShowData :: Bool -> (Cat, [Rule]) -> String -prShowData True (cat@(ListCat c), _) = unlines +prShowData :: Bool -> CppStdMode -> CAbs -> (Cat, [Rule]) -> String +prShowData True mode _ (cat@(ListCat c), _) = unlines [ "void ShowAbsyn::visit" ++ cl ++ "("++ cl ++ " *" ++ vname ++ ")", "{", @@ -552,17 +611,24 @@ prShowData True (cat@(ListCat c), _) = unlines vname++"->begin() ; i != " ++vname ++"->end() ; ++i)", " {", if isTokenCat c - then " visit" ++ baseName cl ++ "(*i) ;" + then " visit" ++ baseName cl ++ "(" ++visitArg++ ") ;" else " (*i)->accept(this);", - " if (i != " ++ vname ++ "->end() - 1) bufAppend(\", \");", + case mode of + CppStdBeyondAnsi _ -> " if (i != std::prev(" ++ vname ++ "->end(), 1)) bufAppend(\", \");" + CppStdAnsi _ -> " if (i != " ++ vname ++ "->end() - 1) bufAppend(\", \");", " }", "}", "" ] where - cl = identCat (normCat cat) + cl = identCat (normCat cat) vname = map toLower cl -prShowData False (cat@(ListCat c), _) = + visitArg = case mode of + CppStdBeyondAnsi _ -> "*i->get()" + _ -> "*i" + + +prShowData False _ _ (cat@(ListCat c), _) = unlines [ "void ShowAbsyn::visit" ++ cl ++ "("++ cl ++ " *" ++ vname ++ ")", @@ -585,63 +651,67 @@ prShowData False (cat@(ListCat c), _) = "" ] where - cl = identCat (normCat cat) - ecl = identCat (normCatOfList cat) - vname = map toLower cl + cl = identCat (normCat cat) + ecl = identCat (normCatOfList cat) + vname = map toLower cl member = map toLower ecl ++ "_" visitMember | Just t <- maybeTokenCat c = " visit" ++ t ++ "(" ++ vname ++ "->" ++ member ++ ");" | otherwise = " " ++ vname ++ "->" ++ member ++ "->accept(this);" -prShowData _ (cat, rules) = --Not a list: - abstract ++ concatMap prShowRule rules + +prShowData _ mode cabs (cat, rules) = -- Not a list: + abstract ++ unlines [prShowRule rule isBeyondAnsi cabs | rule <- rules] where + isBeyondAnsi = case mode of + CppStdBeyondAnsi _ -> True + CppStdAnsi _ -> False cl = identCat (normCat cat) abstract = case lookupRule (noPosition $ catToStr cat) rules of Just _ -> "" - Nothing -> "void ShowAbsyn::visit" ++ cl ++ "(" ++ cl ++ " *p) {} //abstract class\n\n" + Nothing -> "void ShowAbsyn::visit" ++ cl ++ "(" ++ cl ++ " *p) {} //abstract class\n\n" --This prints all the methods for Abstract Syntax tree rules. -prShowRule :: IsFun f => Rul f -> String -prShowRule (Rule f _ cats _) | isProperLabel f = concat +prShowRule :: IsFun f => Rul f -> Bool -> CAbs -> String +prShowRule (Rule f _ cats _) isBeyondAnsi cabs | isProperLabel f = concat [ - "void ShowAbsyn::visit" ++ fun ++ "(" ++ fun +++ "*" ++ fnm ++ ")\n", - "{\n", - lparen, - " bufAppend(\"" ++ fun ++ "\");\n", - optspace, - cats', - rparen, - "}\n" + "void ShowAbsyn::visit" ++ fun ++ "(" ++ vararg +++ fnm ++ ")\n", + "{\n", + lparen, + " bufAppend(\"" ++ fun ++ "\");\n", + optspace, + cats', + rparen, + "}\n" ] - where + where fun = funName f + fnm = "p" --other names could cause conflicts + vararg = funName fun ++ "*" (optspace, lparen, rparen, cats') | null [ () | Left _ <- cats ] -- @all isRight cats@, but Data.Either.isRight requires base >= 4.7 = ("", "", "", "") | otherwise = (" bufAppend(' ');\n", " bufAppend('(');\n"," bufAppend(')');\n" - , concat (insertSpaces (map (prShowCat fnm) (numVars cats)))) + , concat (insertSpaces (map prShowCatFn (numVars cats)))) insertSpaces [] = [] insertSpaces (x:[]) = [x] insertSpaces (x:xs) = if x == "" then insertSpaces xs else x : " bufAppend(' ');\n" : insertSpaces xs - fnm = "p" --other names could cause conflicts -prShowRule _ = "" + -- To set cpp information, use partial application of function + prShowCatFn = prShowCat fnm isBeyondAnsi cabs + +prShowRule _ _ _ = "" -- This recurses to the instance variables of a class. -prShowCat :: String -> Either (Cat, Doc) String -> String -prShowCat _ (Right _) = "" -prShowCat fnm (Left (cat, nt)) +prShowCat :: String -> Bool -> CAbs -> Either (Cat, Doc) String -> String +prShowCat _ _ _ (Right _) = "" +prShowCat fnm isBeyondAnsi cabs (Left (cat, nt)) | Just t <- maybeTokenCat cat = - unlines - [ " visit" ++ t ++ "(" ++ fnm ++ "->" ++ s ++ ");" - ] + " visit" ++ t ++ "(" ++ fnm ++ "->" ++ visitArg ++ ");" | catToStr (normCat $ strToCat s) /= s = - unlines - [ accept - ] + unlines [ accept ] | otherwise = unlines [ " bufAppend('[');" @@ -649,8 +719,16 @@ prShowCat fnm (Left (cat, nt)) , " bufAppend(']');" ] where - s = render nt - accept = " " ++ fnm ++ "->" ++ s ++ "->accept(this);" + s = render nt + accept = " " ++ fnm ++ "->" ++ s ++ "->accept(this);" + primitives = [c | (c,_) <- basetypes] ++ tokentypes cabs + visitArg = case (isBeyondAnsi, maybeTokenCat cat) of + (True, Just t) + | not $ elem t primitives -> s ++ ".get()" -- not primitive + | otherwise -> s -- primitive + (True, Nothing) + | otherwise -> s ++ ".get()" -- list is not primitive + (False, _) -> s -- ansi using raw pointer {- **** Helper Functions Section **** -} diff --git a/source/src/BNFC/Backend/CPP/STL.hs b/source/src/BNFC/Backend/CPP/STL.hs index d46f11e3..5639697f 100644 --- a/source/src/BNFC/Backend/CPP/STL.hs +++ b/source/src/BNFC/Backend/CPP/STL.hs @@ -10,15 +10,20 @@ module BNFC.Backend.CPP.STL (makeCppStl,) where import Data.Foldable (toList) +import Data.List ( nub ) +import qualified Data.Map as Map +import Data.Maybe() import BNFC.Utils import BNFC.CF import BNFC.Options +import BNFC.PrettyPrint +import BNFC.Backend.Common.OOAbstract import BNFC.Backend.Base import BNFC.Backend.C ( bufferH, bufferC, comment, testfileHeader ) -import BNFC.Backend.C.CFtoBisonC ( cf2Bison ) -import BNFC.Backend.C.CFtoFlexC ( cf2flex, ParserMode(..) ) -import BNFC.Backend.CPP.Common ( commentWithEmacsModeHint ) +import BNFC.Backend.C.CFtoBisonC ( cf2Bison, unionBuiltinTokens, positionCats, varName ) +import BNFC.Backend.C.CFtoFlexC ( cf2flex, ParserMode(..), beyondAnsi, parserPackage, parserName, stlParser ) +import BNFC.Backend.CPP.Common ( commentWithEmacsModeHint, wrapSharedPtr ) import BNFC.Backend.CPP.Makefile import BNFC.Backend.CPP.STL.CFtoSTLAbs import BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL @@ -28,25 +33,35 @@ import qualified BNFC.Backend.Common.Makefile as Makefile makeCppStl :: SharedOptions -> CF -> MkFiles () makeCppStl opts cf = do - let (hfile, cfile) = cf2CPPAbs (linenumbers opts) (inPackage opts) name cf - mkCppFile "Absyn.H" hfile - mkCppFile "Absyn.C" cfile - mkCppFile "Buffer.H" bufferH - mkCppFile "Buffer.C" $ bufferC "Buffer.H" - let (flex, env) = cf2flex parserMode cf - mkCppFileWithHint (name ++ ".l") flex - mkCppFileWithHint (name ++ ".y") $ cf2Bison (linenumbers opts) parserMode cf env - mkCppFile "Parser.H" $ - mkHeaderFile (inPackage opts) (toList $ allEntryPoints cf) - mkCppFile "ParserError.H" $ printParseErrHeader (inPackage opts) - let (skelH, skelC) = cf2CVisitSkel True (inPackage opts) cf - mkCppFile "Skeleton.H" skelH - mkCppFile "Skeleton.C" skelC - let (prinH, prinC) = cf2CPPPrinter True (inPackage opts) cf - mkCppFile "Printer.H" prinH - mkCppFile "Printer.C" prinC - mkCppFile "Test.C" (cpptest (inPackage opts) cf) - Makefile.mkMakefile opts $ makefile prefix name + let (hfile, cfile) = cf2CPPAbs (linenumbers opts) cppStdMode (inPackage opts) name cf + mkCppFile ("Absyn" ++ hExt) hfile + mkCppFile ("Absyn" ++ cppExt) cfile + mkCppFile ("Buffer" ++ hExt) bufferH + mkCppFile ("Buffer" ++ cppExt) $ bufferC ("Buffer" ++ hExt) + -- Generate xxx.ll file + let (flex, env) = cf2flex parserMode cf + mkCppFileWithHint (name ++ lexerExt) flex + -- Generate xxx.yy file + mkCppFileWithHint (name ++ parserExt) $ cf2Bison (linenumbers opts) parserMode cf env + mkCppFile ("Parser" ++ hExt) $ + mkHeaderFile parserMode hExt (inPackage opts) cf (allParserCats cf) (toList $ allEntryPoints cf) (Map.elems env) + mkCppFile ("ParserError" ++ hExt) $ printParseErrHeader (inPackage opts) + let (skelH, skelC) = cf2CVisitSkel opts True (inPackage opts) cf + mkCppFile ("Skeleton" ++ hExt) skelH + mkCppFile ("Skeleton" ++ cppExt) skelC + let (prinH, prinC) = cf2CPPPrinter cppStdMode True (inPackage opts) cf hExt + mkCppFile ("Printer" ++ hExt) prinH + mkCppFile ("Printer" ++ cppExt) prinC + mkCppFile ("Test" ++ cppExt) (cpptest parserMode (inPackage opts) cf hExt) + + case (ansi opts) of + BeyondAnsi -> do + mkCppFile ("Driver" ++ cppExt) $ driverC parserMode cf ("Driver" ++ hExt) + mkCppFile ("Driver" ++ hExt) $ driverH parserMode cf cats + mkCppFile ("Scanner" ++ hExt) $ scannerH parserMode; + _ -> + return(); + Makefile.mkMakefile opts $ makefile prefix name opts where name :: String name = lang opts @@ -56,9 +71,21 @@ makeCppStl opts cf = do prefix :: String prefix = snakeCase_ name ++ "_" parserMode :: ParserMode - parserMode = CppParser (inPackage opts) prefix + parserMode = CppParser (inPackage opts) prefix (ansi opts) mkCppFile x = mkfile x comment mkCppFileWithHint x = mkfile x commentWithEmacsModeHint + -- Switch C++ generator module + cppStdMode :: CppStdMode + cppStdMode = if Ansi == ansi opts then CppStdAnsi (ansi opts) else CppStdBeyondAnsi (ansi opts) + lexerExt = if Ansi == ansi opts then ".l" else ".ll" + parserExt = if Ansi == ansi opts then ".y" else ".yy" + cppExt = if Ansi == ansi opts then ".c" else ".cc" + hExt = if Ansi == ansi opts then ".h" else ".hh" + posCats + | stlParser parserMode = map TokenCat $ positionCats cf + | otherwise = [] + cats = posCats ++ allParserCatsNorm cf + printParseErrHeader :: Maybe String -> String printParseErrHeader inPackage = @@ -84,78 +111,134 @@ printParseErrHeader inPackage = , nsEnd inPackage ] -cpptest :: Maybe String -> CF -> String -cpptest inPackage cf = unlines $ concat +cpptest :: ParserMode -> Maybe String -> CF -> String -> String +cpptest mode inPackage cf hExt = unlines $ concat [ testfileHeader - , [ "", - "#include ", - "#include ", - "#include ", - "#include \"Parser.H\"", - "#include \"Printer.H\"", - "#include \"Absyn.H\"", - "#include \"ParserError.H\"", - "", - "void usage() {", - " printf(\"usage: Call with one of the following argument " ++ - "combinations:\\n\");", - " printf(\"\\t--help\\t\\tDisplay this help message.\\n\");", - " printf(\"\\t(no arguments)\\tParse stdin verbosely.\\n\");", - " printf(\"\\t(files)\\t\\tParse content of files verbosely.\\n\");", - " printf(\"\\t-s (files)\\tSilent mode. Parse content of files " ++ - "silently.\\n\");", - "}", - "", - "int main(int argc, char ** argv)", - "{", - " FILE *input;", - " int quiet = 0;", - " char *filename = NULL;", - "", - " if (argc > 1) {", - " if (strcmp(argv[1], \"-s\") == 0) {", - " quiet = 1;", - " if (argc > 2) {", - " filename = argv[2];", - " } else {", - " input = stdin;", - " }", - " } else {", - " filename = argv[1];", - " }", - " }", - "", - " if (filename) {", - " input = fopen(filename, \"r\");", - " if (!input) {", - " usage();", - " exit(1);", - " }", - " } else input = stdin;", - " /* The default entry point is used. For other options see Parser.H */", - " " ++ scope ++ dat ++ " *parse_tree = NULL;", - " try { ", - " parse_tree = " ++ scope ++ "p" ++ def ++ "(input);", - " } catch( " ++ scope ++ "parse_error &e) {", - " std::cerr << \"Parse error on line \" << e.getLine() << \"\\n\"; ", - " }", - " if (parse_tree)", - " {", - " printf(\"\\nParse Successful!\\n\");", - " if (!quiet) {", - " printf(\"\\n[Abstract Syntax]\\n\");", - " " ++ scope ++ "ShowAbsyn *s = new " ++ scope ++ "ShowAbsyn();", - " printf(\"%s\\n\\n\", s->show(parse_tree));", - " printf(\"[Linearized Tree]\\n\");", - " " ++ scope ++ "PrintAbsyn *p = new " ++ scope ++ "PrintAbsyn();", - " printf(\"%s\\n\\n\", p->print(parse_tree));", - " }", - " delete(parse_tree);", - " return 0;", - " }", - " return 1;", - "}", - "" + , [ "" + , "#include " + , "#include " + , "#include " + , if beyondAnsi mode then + unlines [ + "#include " + , "#include " + , "#include \"Driver" ++hExt++ "\"" + ] + else + "#include \"Parser" ++hExt++ "\"" + , "#include \"Printer" ++hExt++ "\"" + , "#include \"Absyn" ++hExt++ "\"" + , "#include \"ParserError" ++hExt++ "\"" + , "" + , "void usage() {" + , " printf(\"usage: Call with one of the following argument combinations:\\n\");" + , " printf(\"\\t--help\\t\\tDisplay this help message.\\n\");" + , " printf(\"\\t(no arguments)\\tParse stdin verbosely.\\n\");" + , " printf(\"\\t(files)\\t\\tParse content of files verbosely.\\n\");" + , " printf(\"\\t-s (files)\\tSilent mode. Parse content of files silently.\\n\");" + , "}" + , "" + , "int main(int argc, char ** argv)" + , if beyondAnsi mode then + unlines [ + "{" + , " int quiet = 0;" + , " char *filename = NULL;" + , "" + , " if (argc > 1) {" + , " if (strcmp(argv[1], \"-s\") == 0) {" + , " quiet = 1;" + , " if (argc > 2) {" + , " filename = argv[2];" + , " }" + , " } else {" + , " filename = argv[1];" + , " }" + , " }" + , "" + , " /* The default entry point is used. For other options see Parser.H */" + , " " ++ (wrapSharedPtr $ scope ++ dat) ++ " parse_tree = nullptr;" + , " try { " + , "" + , " auto driver = std::make_unique<" ++nsScope driverNS++camelCaseName++ "Driver>();" + , " if (filename) {" + , " std::ifstream input(filename);" + , " if ( ! input.good() ) {" + , " usage();" + , " exit(1);" + , " }" + , " parse_tree = driver->p" ++ def ++ "(input);" + , " } else {" + , " parse_tree = driver->p" ++ def ++ "(std::cin);" + , " }" + ] + else + unlines [ + "{" + , " FILE *input;" + , " int quiet = 0;" + , " char *filename = NULL;" + , "" + , " if (argc > 1) {" + , " if (strcmp(argv[1], \"-s\") == 0) {" + , " quiet = 1;" + , " if (argc > 2) {" + , " filename = argv[2];" + , " } else {" + , " input = stdin;" + , " }" + , " } else {" + , " filename = argv[1];" + , " }" + , " }" + , "" + , " if (filename) {" + , " input = fopen(filename, \"r\");" + , " if (!input) {" + , " usage();" + , " exit(1);" + , " }" + , " } else input = stdin;" + , "" + , " /* The default entry point is used. For other options see Parser.H */" + , " " ++ scope ++ dat ++ " *parse_tree = NULL;" + , " try { " + ," parse_tree = p" ++ def ++ "(input);" + ] + , " } catch( " ++ scope ++ "parse_error &e) {" + , " std::cerr << \"Parse error on line \" << e.getLine() << \"\\n\"; " + , " }" + , "" + , " if (parse_tree)" + , " {" + , " printf(\"\\nParse Successful!\\n\");" + , if beyondAnsi mode then + unlines [ + " if (!quiet) {" + , " printf(\"\\n[Abstract Syntax]\\n\");" + , " auto s = std::make_unique<" ++nsScope ns++"ShowAbsyn>(" ++nsScope ns++"ShowAbsyn());" + , " printf(\"%s\\n\\n\", s->show(parse_tree.get()));" + , " printf(\"[Linearized Tree]\\n\");" + , " auto p = std::make_unique<" ++nsScope ns++"PrintAbsyn>(" ++nsScope ns++"PrintAbsyn());" + , " printf(\"%s\\n\\n\", p->print(parse_tree.get()));" + , " }" + ] + else + unlines [ + " if (!quiet) {" + , " printf(\"\\n[Abstract Syntax]\\n\");" + , " " ++nsScope ns++"ShowAbsyn *s = new " ++nsScope ns++"ShowAbsyn();" + , " printf(\"%s\\n\\n\", s->show(parse_tree));" + , " printf(\"[Linearized Tree]\\n\");" + , " " ++nsScope ns++"PrintAbsyn *p = new " ++nsScope ns++"PrintAbsyn();" + , " printf(\"%s\\n\\n\", p->print(parse_tree));" + , " }" + , " delete(parse_tree);" + ] + , " return 0;" + , " }" + , " return 1;" + , "}" ] ] where @@ -163,17 +246,24 @@ cpptest inPackage cf = unlines $ concat dat = identCat $ normCat cat def = identCat cat scope = nsScope inPackage + name = parserName mode + camelCaseName = camelCase_ name + ns = inPackage + driverNS = inPackage -mkHeaderFile :: Maybe String -> [Cat] -> String -mkHeaderFile inPackage eps = unlines $ concat +mkHeaderFile :: ParserMode -> String -> Maybe String -> CF -> [Cat] -> [Cat] -> [String] -> String +mkHeaderFile mode hExt inPackage _cf _cats eps _env = unlines $ concat [ [ "#ifndef " ++ hdef , "#define " ++ hdef , "" - , "#include" - , "#include" - , "#include" - , "#include \"Absyn.H\"" - , "" + , "#include " + , "#include " + , "#include " + , "#include \"Absyn" ++ hExt ++ "\"" + , if beyondAnsi mode then + "#include \"Bison" ++ hExt ++ "\"" + else + "" , nsStart inPackage ] , concatMap mkFuncs eps @@ -184,7 +274,257 @@ mkHeaderFile inPackage eps = unlines $ concat ] where hdef = nsDefine inPackage "PARSER_HEADER_FILE" - mkFuncs s = - [ identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(FILE *inp);" - , identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(const char *str);" - ] + mkFuncs s = if beyondAnsi mode then + [ identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(std::istream &stream);" ] + else + [ identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(FILE *inp);" + , identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(const char *str);" + ] + + + +-- | C++ lexer/parser driver + +driverH :: ParserMode -> CF -> [Cat] -> String +driverH mode cf cats = unlines + [ "#ifndef __DRIVER_H__" + , "#define __DRIVER_H__ 1" + + , "#include " + , "#include " + , "#include " + , "#include " + , "" + , "#include \"Scanner.hh\"" + , "#include \"Parser.hh\"" + , "" + , nsStart ns + , "" + , "class " ++camelCaseName++ "Driver{" + , "public:" + , " " ++camelCaseName++ "Driver() = default;" + , " virtual ~ " ++camelCaseName++ "Driver();" + , "" + , " /**" + , " * parser parsed values defined by bnfc" + , " */" + -- bnfc builtin tokens + , unlines [ prettyShow (" " ++ tok) | tok <- unionBuiltinTokens ] + -- user defined tokens + , unlines [ prettyShow (" std::shared_ptr<" ++ identCat tok ++ ">"+++ varName tok ++";") | tok <- normCats ] + , "" + , unlines [ mkStreamEntry ep | ep <- entryPoints ] + , "" + , " /**" + , " * parse - parse from a file" + , " * @param filename - valid string with input file" + , " */" + , " void parse(const char *filename);" + , " /**" + , " * parse - parse from a c++ input stream" + , " * @param is - std::istream&, valid input stream" + , " */" + , " void parse(std::istream &iss);" + , " /** Error handling with associated line number. This can be modified to output the error. */" + , " void error(const " ++nsScope parserNs++camelCaseName++ "Parser::location_type& l, const std::string& m);" + , "" + , " std::ostream& print(std::ostream &stream);" + , "" + , " // debug flags" + , " bool trace_scanning = false;" + , " bool trace_parsing = false;" + , "" + , " std::unique_ptr<" ++camelCaseName++ "Scanner> scanner = nullptr;" + , " std::unique_ptr<" ++ nsScope parserNs ++camelCaseName++ "Parser> parser = nullptr;" + , "" + , "private:" + , " void parse_helper( std::istream &stream );" + , "" + , "};" + , "" + , nsEnd ns + , "#endif /* END __DRIVER_H__ */" + ] + where + name = parserName mode + camelCaseName = camelCase_ name + ns = parserPackage mode -- bnfc -p "package" + parserNs = case ns of + Just ns -> Just ns; -- Using above namespace + Nothing -> Just name; -- Using namespace generated by bison (see Makefile) + normCats = nub (map normCat cats) + entryPoints = toList (allEntryPoints cf) + mkStreamEntry s = + " " ++ (wrapSharedPtr $ identCat (normCat s)) +++ "p" ++ identCat s ++ "(std::istream &stream);" + + +-- | C++ lexer/parser driver + +driverC :: ParserMode -> CF -> String -> String +driverC mode cf _ = unlines + [ "#include " + , "#include " + , "#include " + , "" + , "#include \"Driver.hh\"" + , nsStart ns + , "" + , "" ++camelCaseName++ "Driver::~" ++camelCaseName++ "Driver()" + , "{" + , "}" + , " " + , "void " + , camelCaseName++ "Driver::parse( const char * const filename )" + , "{" + , " /**" + , " * Remember, if you want to have checks in release mode" + , " * then this needs to be an if statement " + , " */" + , " assert( filename != nullptr );" + , " std::ifstream in_file( filename );" + , " if( ! in_file.good() )" + , " {" + , " exit( EXIT_FAILURE );" + , " }" + , " parse_helper( in_file );" + , " return;" + , "}" + , " " + , "void" + , camelCaseName++ "Driver::parse( std::istream &stream )" + , "{" + , " if( ! stream.good() && stream.eof() ) {" + , " return;" + , " }" + , " parse_helper( stream ); " + , " return;" + , "}" + , " " + , "void" + , camelCaseName++ "Driver::error( const " ++nsScope parserNs++camelCaseName++ "Parser::location_type& l, const std::string& m )" + , "{" + , " std::cerr << \"error: \"" + , " << scanner->loc->begin.line << \",\" << scanner->loc->begin.column" + , " << \": \"" + , " << m" + , " << \" at \" << std::string(scanner->YYText())" + , " << std::endl;" + , "}" + , "" + , "void " + , camelCaseName++ "Driver::parse_helper( std::istream &stream )" + , "{" + , "" + , " scanner.reset();" + , " try {" + , " scanner = std::make_unique<" ++camelCaseName++ "Scanner>( &stream );" + , " scanner->set_debug(trace_scanning);" + , " } catch( std::bad_alloc &ba ) {" + , " std::cerr << \"Failed to allocate scanner: (\"" + , " << ba.what() " + , " << \"), exiting!!\\n\";" + , " exit( EXIT_FAILURE );" + , " }" + , "" + , " parser.reset(); " + , " try {" + , " parser = std::make_unique<" ++nsScope parserNs++camelCaseName++ "Parser>((*scanner), (*this));" + , " } catch( std::bad_alloc &ba ) {" + , " std::cerr << \"Failed to allocate parser: (\"" + , " << ba.what() " + , " << \"), exiting!!\\n\";" + , " exit( EXIT_FAILURE );" + , " }" + , " const int accept( 0 );" + , "" + , " parser->set_debug_level (trace_parsing);" + , " if( parser->parse() != accept ) {" + , " exit( EXIT_FAILURE );" + , " }" + , " return;" + , "}" + , "" + , unlines [ mkStreamEntry ep | ep <- entryPoints ] + , nsEnd ns + ] + where + name = parserName mode + camelCaseName = camelCase_ name + ns = parserPackage mode -- bnfc -p "package" + parserNs = case ns of + Just _ -> ns; -- Using above namespace, so not necessary parser name namespace + Nothing -> Just name; -- Using namespace generated by bison (see Makefile) + entryPoints = toList (allEntryPoints cf) + reversibleCats = cfgReversibleCats cf + + mkStreamEntry s = + unlines [ + (wrapSharedPtr $ identCat (normCat s)) + , camelCaseName++ "Driver::p" ++ identCat s ++ "(std::istream &stream)" + , "{" + , " parse_helper( stream );" + , if isList s && not (s `elem` reversibleCats) then + " this->" ++ varName s++ "->reverse();" + else + "" + , " return this->" ++ varName s++ ";" + , "}" + ] + +-- | C++ lexer def (scanner.hh) + +scannerH :: ParserMode -> String +scannerH mode = unlines + [ "#ifndef __SCANNER_H__" + , "#define __SCANNER_H__ 1" + , "" + , "// Flex expects the signature of yylex to be defined in the macro YY_DECL, and" + , "// the C++ parser expects it to be declared." + , "#ifndef YY_DECL" + , "#define YY_DECL \\" + , " int \\" + , " " ++ nsScope ns ++camelCaseName++ "Scanner::lex( \\" + , " " ++ nsScope parserNs ++camelCaseName++ "Parser::semantic_type* const yylval, \\" + , " " ++ nsScope parserNs ++camelCaseName++ "Parser::location_type* yylloc \\" + , " )" + , "#endif" + , "" + -- Inherit from yyFlexLexer, create a subclass with naming "XXXScanner" + -- https://stackoverflow.com/a/40665154/2565527 + , "#if !defined(yyFlexLexerOnce)" + , "# include \"FlexLexer.h\"" + , "#endif" + , "" + , "#include \"Bison.hh\"" + , "#include \"location.hh\"" + , "" + , nsStart ns + , "" + , "class " ++camelCaseName++ "Scanner : public yyFlexLexer {" + , "public:" + , "" + , " " ++camelCaseName++ "Scanner(std::istream *in);" + , " virtual ~" ++camelCaseName++ "Scanner();" + , "" + , " virtual" + , " int lex( " ++ nsScope parserNs ++camelCaseName++ "Parser::semantic_type * const lval," + , " " ++ nsScope parserNs ++camelCaseName++ "Parser::location_type *location );" + , " // YY_DECL defined in .ll file. Method body created by flex in Lexer.cc" + , "" + , " /* yyval ptr */" + , " " ++ nsScope parserNs ++camelCaseName++ "Parser::semantic_type *yylval = nullptr;" + , " /* location ptr */" + , " " ++ nsScope parserNs ++camelCaseName++ "Parser::location_type *loc = nullptr;" + , "};" + , "" + , nsEnd ns + , "" + , "#endif /* END __SCANNER_H__ */" + ] + where + name = parserName mode + camelCaseName = camelCase_ name + ns = parserPackage mode -- bnfc -p "package" + parserNs = case ns of + Just _ -> Nothing; -- Using above namespace, so not necessary parser name namespace + Nothing -> Just name; -- Using namespace generated by bison (see Makefile) diff --git a/source/src/BNFC/Backend/CPP/STL/CFtoCVisitSkelSTL.hs b/source/src/BNFC/Backend/CPP/STL/CFtoCVisitSkelSTL.hs index c663928f..6a7ba093 100644 --- a/source/src/BNFC/Backend/CPP/STL/CFtoCVisitSkelSTL.hs +++ b/source/src/BNFC/Backend/CPP/STL/CFtoCVisitSkelSTL.hs @@ -17,30 +17,36 @@ module BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL (cf2CVisitSkel) where import Data.Char import BNFC.CF +import BNFC.Options import BNFC.Utils ((+++), unless) import BNFC.Backend.Common.OOAbstract import BNFC.Backend.CPP.Naming +import BNFC.Backend.CPP.Common (CppStdMode(..)) import BNFC.Backend.CPP.STL.STLUtils ---Produces (.H file, .C file) -cf2CVisitSkel :: Bool -> Maybe String -> CF -> (String, String) -cf2CVisitSkel useSTL inPackage cf = - ( mkHFile useSTL inPackage cab - , mkCFile useSTL inPackage cab +--Produces (header file, c/c++ file) +cf2CVisitSkel :: SharedOptions -> Bool -> Maybe String -> CF -> (String, String) +cf2CVisitSkel opts useSTL inPackage cf = + ( mkHFile mode useSTL hExt inPackage cab + , mkCFile mode useSTL hExt inPackage cab ) where - cab = cf2cabs cf + cab = cf2cabs cf + (mode, hExt) = case (ansi opts, useSTL) of + (BeyondAnsi, True ) -> ( CppStdBeyondAnsi (ansi opts), ".hh" ) + ( Ansi, True ) -> ( CppStdAnsi (ansi opts) , ".h" ) + (_ , False) -> ( CppStdAnsi (ansi opts) , ".H" ) -- **** Header (.H) File Functions **** --Generates the Header File -mkHFile :: Bool -> Maybe String -> CAbs -> String -mkHFile useSTL inPackage cf = unlines [ +mkHFile :: CppStdMode -> Bool -> String -> Maybe String -> CAbs -> String +mkHFile _ useSTL hExt inPackage cf = unlines [ "#ifndef " ++ hdef, "#define " ++ hdef, "/* You might want to change the above name. */", "", - "#include \"Absyn.H\"", + "#include \"Absyn" ++hExt++ "\"", "", nsStart inPackage, "class Skeleton : public Visitor", @@ -70,17 +76,16 @@ basics useSTL cf = concat -- **** Implementation (.C) File Functions **** --Makes the .C File -mkCFile :: Bool -> Maybe String -> CAbs -> String -mkCFile useSTL inPackage cf = unlines [ - headerC, +mkCFile :: CppStdMode -> Bool -> String -> Maybe String -> CAbs -> String +mkCFile mode useSTL hExt inPackage cf = unlines [ + headerC hExt, nsStart inPackage, unlines [ - "void Skeleton::visit" ++ t ++ "(" ++ - t ++ " *t) {} //abstract class" | t <- absclasses cf], - unlines [ prCon r | (_,rs) <- signatures cf, r <- rs, useSTL || not (posRule r) ], - unlines [ prList useSTL cb | cb <- listtypes cf ], - unlines [ prBasic b | b <- base ], - nsEnd inPackage + "void Skeleton::visit" ++ t ++ "(" ++ t ++ " *t) {} //abstract class" | t <- absclasses cf], + unlines [ prCon r | (_,rs) <- signatures cf, r <- rs, useSTL || not (posRule r) ], + unlines [ prList mode useSTL cb | cb <- listtypes cf ], + unlines [ prBasic b | b <- base ], + nsEnd inPackage ] where -- See OOAbstract 'posdata': @@ -102,19 +107,19 @@ mkCFile useSTL inPackage cf = unlines [ | otherwise = "visit" ++ cat ++ "(" ++ field ++ ");" where field = v ++ "->" ++ var -headerC :: String -headerC = unlines [ +headerC :: [Char] -> String +headerC hExt = unlines [ "/*** Visitor Design Pattern Skeleton. ***/", "/* This implements the common visitor design pattern.", " Note that this method uses Visitor-traversal of lists, so", " List->accept() does NOT traverse the list. This allows different", " algorithms to use context information differently. */", "", - "#include \"Skeleton.H\"", + "#include \"Skeleton" ++hExt++ "\"", "" ] -prBasic :: String -> String +prBasic :: [Char] -> String prBasic c = unlines [ "void Skeleton::visit" ++ c ++ "(" ++ c ++ " x)", "{", @@ -122,8 +127,11 @@ prBasic c = unlines [ "}" ] -prList :: Bool -> (String, Bool) -> String -prList True (cl,b) = unlines [ + +prList :: CppStdMode -> Bool -> (String, Bool) -> String + +-- useSTL = True +prList mode True (cl,b) = unlines [ "void Skeleton::visit" ++ cl ++ "("++ cl +++ "*" ++ vname ++ ")", "{", " for ("++ cl ++"::iterator i = " ++ @@ -131,14 +139,20 @@ prList True (cl,b) = unlines [ " {", if b then " (*i)->accept(this);" - else " visit" ++ drop 4 cl ++ "(*i) ;", + else " visit" ++ drop 4 cl ++ "(" ++visitArg++ ") ;", " }", "}" ] where vname = mkVariable cl + childCl = drop 4 cl -- drop "List" + visitArg = case mode of + CppStdBeyondAnsi _ -> "*i->get()" + _ -> "*i" + -prList False (cl,b) = unlines +-- useSTL = False +prList _ False (cl,b) = unlines [ "void Skeleton::visit" ++ cl ++ "("++ cl +++ "*" ++ vname ++ ")" , "{" , " while (" ++ vname ++ ")" diff --git a/source/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs b/source/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs index c5e9f3d9..a74eaee0 100644 --- a/source/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs +++ b/source/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs @@ -13,12 +13,14 @@ Created : 4 August, 2003 Modified : 22 May, 2004 / Antti-Juhani Kaijanaho 29 August, 2006 / Aarne Ranta + 22 October, 2021 / Hiroyuki Nagata -} -module BNFC.Backend.CPP.STL.CFtoSTLAbs (cf2CPPAbs) where +module BNFC.Backend.CPP.STL.CFtoSTLAbs ( cf2CPPAbs, CppStdMode(..) ) where import Data.List ( intercalate, intersperse ) +import Data.Char ( toLower ) import BNFC.Backend.Common.OOAbstract import BNFC.CF @@ -29,37 +31,63 @@ import BNFC.Utils ( (+++), applyWhen ) import BNFC.Backend.CPP.Common import BNFC.Backend.CPP.STL.STLUtils + --The result is two files (.H file, .C file) -cf2CPPAbs :: RecordPositions -> Maybe String -> String -> CF -> (String, String) -cf2CPPAbs rp inPackage _ cf = (mkHFile rp inPackage cab cf, mkCFile inPackage cab cf) +cf2CPPAbs :: RecordPositions -> CppStdMode -> Maybe String -> String -> CF -> (String, String) +cf2CPPAbs rp mode inPackage _ cf = (mkHFile rp mode inPackage cabs cf, mkCFile mode inPackage cabs cf) where - cab = cf2cabs cf + cabs = cf2cabs cf -- **** Header (.H) File Functions **** -- --Makes the Header file. -mkHFile :: RecordPositions -> Maybe String -> CAbs -> CF -> String -mkHFile rp inPackage cabs cf = unlines +mkHFile :: RecordPositions -> CppStdMode -> Maybe String -> CAbs -> CF -> String +mkHFile rp mode inPackage cabs cf = unlines [ "#ifndef " ++ hdef, "#define " ++ hdef, "", - "#include", - "#include", - "", + case mode of { + CppStdAnsi _ -> unlines [ + "#include ", + "#include ", + "#include "]; + CppStdBeyondAnsi _ -> unlines [ + "#include ", + "#include ", + "#include ", + "#include "]; + }, "//C++ Abstract Syntax Interface.", nsStart inPackage, "/******************** TypeDef Section ********************/", "", - unlines ["typedef " ++ d ++ " " ++ c ++ ";" | (c,d) <- basetypes], - "", - unlines ["typedef std::string " ++ s ++ ";" | s <- tokentypes cabs], - "", + case mode of { + CppStdAnsi _ -> unlines $ + ["typedef " ++ d ++ " " ++ c ++ ";" | (c,d) <- basetypes] + ++ [" "] + ++ ["typedef std::string " ++ s ++ ";" | s <- tokentypes cabs] + ++ [" "]; + ; + -- use "using" statement + CppStdBeyondAnsi _ -> unlines $ + ["using " ++ c ++ " = " ++ d ++ ";" | (c,d) <- basetypes] + ++ [""] + ++ ["using " ++ s ++ " = std::string;" | s <- tokentypes cabs] + ++ [""]; + }, "/******************** Forward Declarations ********************/", "", - unlines ["class " ++ c ++ ";" | c <- classes, notElem c (defineds cabs)], + case mode of { + CppStdAnsi _ -> unlines $ + ["class " ++ c ++ ";" | c <- classes, notElem c (defineds cabs)] + ; + CppStdBeyondAnsi _ -> unlines $ + ["class " ++ c ++ ";" | c <- classes, notElem c (defineds cabs)] + ; + }, "", "/******************** Visitor Interfaces ********************/", prVisitor cabs, @@ -68,13 +96,13 @@ mkHFile rp inPackage cabs cf = unlines "", "/******************** Abstract Syntax Classes ********************/", "", - unlines [prAbs rp c | c <- absclasses cabs], + unlines [prAbs mode rp c | c <- absclasses cabs], "", - unlines [prCon (c,r) | (c,rs) <- signatures cabs, r <- rs], + unlines [prCon mode (c,r) | (c,rs) <- signatures cabs, r <- rs], "", - unlines [prList c | c <- listtypes cabs], + unlines [prList mode primitives c | c <- listtypes cabs], "", - definedRules Nothing cf + definedRules mode Nothing cf "/******************** Defined Constructors ********************/", nsEnd inPackage, "#endif" @@ -82,6 +110,7 @@ mkHFile rp inPackage cabs cf = unlines where classes = allClasses cabs hdef = nsDefine inPackage "ABSYN_HEADER" + primitives = [c | (c,_) <- basetypes] ++ tokentypes cabs -- auxiliaries @@ -91,8 +120,8 @@ prVisitable = unlines [ "{", " public:", -- all classes with virtual methods require a virtual destructor - " virtual ~Visitable() {}", - " virtual void accept(Visitor *v) = 0;", + " virtual ~Visitable() {}", + " virtual void accept(Visitor *v) = 0;", "};" ] @@ -101,177 +130,326 @@ prVisitor cf = unlines [ "class Visitor", "{", "public:", - " virtual ~Visitor() {}", + " virtual ~Visitor() {}", unlines - [" virtual void visit"++c++"("++c++" *p) = 0;" | c <- allClasses cf, - notElem c (defineds cf)], + [" virtual void visit"++c++"("++ c +++ vararg ++") = 0;" | c <- allClasses cf, notElem c (defineds cf)], "", unlines - [" virtual void visit"++c++"(" ++c++" x) = 0;" | c <- allNonClasses cf], - "};" - ] - -prAbs :: RecordPositions -> String -> String -prAbs rp c = unlines [ - "class " ++ c ++ " : public Visitable", - "{", - "public:", - " virtual " ++ c ++ " *clone() const = 0;", - if rp == RecordPositions then " int line_number, char_number;" else "", - "};" - ] - -prCon :: (String, CAbsRule) -> String -prCon (c,(f,cs)) = unlines [ - "class " ++f++ " : public " ++ c, - "{", - "public:", - unlines - [" "++ typ +++ pointerIf st var ++ ";" | (typ,st,var) <- cs], - " " ++ f ++ "(const " ++ f ++ " &);", - " " ++ f ++ " &operator=(const " ++f++ " &);", - " " ++ f ++ "(" ++ conargs ++ ");", - -- Typ *p1, PIdent *p2, ListStm *p3); - " ~" ++f ++ "();", - " virtual void accept(Visitor *v);", - " virtual " ++f++ " *clone() const;", - " void swap(" ++f++ " &);", + [" virtual void visit"++c++"("++c++" x) = 0;" | c <- allNonClasses cf], "};" ] + where + vararg = "*p" + +prAbs :: CppStdMode -> RecordPositions -> String -> String +prAbs mode rp c = + case mode of { + CppStdAnsi _ -> unlines [ + "class " ++ c ++ " : public Visitable", + "{", + "public:", + " virtual " ++ c ++ " *clone() const = 0;", + if rp == RecordPositions then " int line_number, char_number;" else "", + "};" + ]; + CppStdBeyondAnsi _ -> unlines [ + "class " ++ c ++ " : public Visitable", + "{", + "public:", + " virtual" +++ wrapSharedPtr c +++ "clone() const = 0;", + if rp == RecordPositions then " int line_number, char_number;" else "", + "};" + ]; + } + +prCon :: CppStdMode -> (String, CAbsRule) -> String +prCon mode (c,(f,cs)) = + case mode of { + CppStdAnsi _ -> unlines [ + "class " ++f++ " : public " ++ c, + "{", + "public:", + unlines + [" "++ typ +++ pointerIf st var ++ ";" | (typ,st,var) <- cs], + " " ++ f ++ "(const " ++ f ++ " &);", + " " ++ f ++ " &operator=(const " ++f++ " &);", + " " ++ f ++ "(" ++ conargs ++ ");", + -- Typ *p1, PIdent *p2, ListStm *p3); + " ~" ++f ++ "();", + " virtual void accept(Visitor *v);", + " virtual " ++f++ " *clone() const;", + " void swap(" ++f++ " &);", + "};" + ]; + CppStdBeyondAnsi _ -> unlines [ + "class " ++f++ " : public " ++ c, + "{", + "public:", + unlines [" " ++ wrapSharedPtrIf isClass typ +++ var ++ ";" | (typ,isClass,var) <- cs], + if length cs > 0 then + -- Generate following initiliazer; + -- + -- Prog(std::shared_ptr p1) + -- : Program(), liststatement_{p1} {}; + unlines + [ " " ++f++ "(" ++ conargs ++ ")", + " :" +++ c ++ "(), " ++ intercalate ", " [var ++ "{p" ++ show i ++ "}" | ((_,_,var),i) <- zip cs [(1::Integer)..]], + " {};" + ] + else + " " ++f++ "(" ++ conargs ++ "):" +++ c +++ "(){};", + "", + " virtual void accept(Visitor *v) override;", + " " ++ wrapSharedPtr c +++ " clone() const;", + "};" + ]; + } where - conargs = concat $ intersperse ", " - [x +++ pointerIf st ("p" ++ show i) | ((x,st,_),i) <- zip cs [1::Int ..]] - -prList :: (String, Bool) -> String -prList (c, b) = unlines - [ "class " ++c++ " : public Visitable, public std::vector<" ++bas++ ">" - , "{" - , "public:" - , " virtual void accept(Visitor *v);" - , " virtual " ++ c ++ " *clone() const;" - , "};" - , "" - -- cons for this list type - , concat [ c, "* ", "cons", c, "(", bas, " x, ", c, "* xs);" ] - ] + conargs = + case mode of { + CppStdAnsi _ -> + concat $ intersperse ", " + [x +++ pointerIf st ("p" ++ show i) | ((x,st,_),i) <- zip cs [(1::Integer)..]] + ; + CppStdBeyondAnsi _ -> + intercalate ", " [wrapSharedPtrIf isClass x ++ " p" ++ show i | ((x,isClass,_),i) <- zip cs [(1::Integer)..]] + ; + } + +prList :: CppStdMode -> [String] -> (String, Bool) -> String +prList mode primitives (c, b) = case mode of { + CppStdAnsi _ -> unlines [ + "class " ++c++ " : public Visitable, public std::vector<" ++bas++ ">" + , "{" + , "public:" + , " virtual void accept(Visitor *v);" + , " virtual " ++ c ++ " *clone() const;" + , "};" + , "" + -- cons for this list type + , concat [ c, "* ", "cons", c, "(", bas, " x, ", c, "* xs);" ] + ]; + CppStdBeyondAnsi _ -> unlines [ + "class " ++c++ " : public Visitable" + , "{" + , "public:" + , " " ++c++ "() : " ++childClassVarName++ "{}" + , " {}" + , "" + , " std::list<" ++ wrapSharedPtr childClass++ ">" +++ childClassVarName ++ ";" + , "" + -- ref: https://stackoverflow.com/questions/51148797/how-can-i-define-iterator-and-const-iterator-in-my-class-while-i-uses-stdvecto + , " // define iterator and const_iterator, expose it" + , " using iterator = typename std::list<" ++ wrapSharedPtr childClass ++ ">::iterator;" + , " using const_iterator = typename std::list<" ++ wrapSharedPtr childClass++ ">::const_iterator;" + , " auto begin() const { return " ++childClassVarName++ ".begin(); }" + , " auto begin() { return " ++childClassVarName++ ".begin(); }" + , " auto end() const { return " ++childClassVarName++ ".end(); }" + , " auto end() { return " ++childClassVarName++ ".end(); }" + , "" + , " virtual void accept(Visitor *v);" + , " " ++ wrapSharedPtr c +++ " clone() const;" + , " void cons(" ++ wrapSharedPtrIf isNotBaseClass childClass ++ ");" + , " void reverse();" + , "};" + , "" + ]; + } where - bas = applyWhen b (++ "*") $ drop 4 c {- drop "List" -} + childClass = drop 4 c + childClassVarName = "list" ++ map toLower childClass ++ "_" + bas = applyWhen b (++ "*") $ drop 4 c {- drop "List" -} + -- if list element is primitive type, not to use smart-ptr for argument type + isNotBaseClass = not $ elem childClass primitives -- **** Implementation (.C) File Functions **** -- -mkCFile :: Maybe String -> CAbs -> CF -> String -mkCFile inPackage cabs cf = unlines $ [ +mkCFile :: CppStdMode -> Maybe String -> CAbs -> CF -> String +mkCFile mode inPackage cabs cf = unlines $ [ "//C++ Abstract Syntax Implementation.", "#include ", "#include ", "#include ", - "#include \"Absyn.H\"", + "#include \"Absyn"++hExt++"\"", nsStart inPackage, - unlines [prConC r | (_,rs) <- signatures cabs, r <- rs], - unlines [prListC l | l <- listtypes cabs], - definedRules (Just $ LC nil cons) cf + unlines [prConC mode c r | (c,rs) <- signatures cabs, r <- rs], + unlines [prListC mode primitives l | l <- listtypes cabs], + definedRules mode (Just $ LC nil cons) cf "/******************** Defined Constructors ********************/", nsEnd inPackage ] where - nil t = (,dummyType) $ concat [ "new List", identType t, "()" ] - cons t = (,dummyType) $ concat [ "consList", identType t ] - - -prConC :: CAbsRule -> String -prConC fcs@(f,_) = unlines [ + primitives = [c | (c,_) <- basetypes] ++ tokentypes cabs + nil t = case mode of + CppStdAnsi _ -> (,dummyType) $ concat [ "new List", identType t, "()" ] + CppStdBeyondAnsi _ -> (,dummyType) $ wrapMakeShared ("List" ++ identType t) ++ "()" + cons t = case mode of + CppStdAnsi _ -> (,dummyType) $ concat [ "consList", identType t ] + CppStdBeyondAnsi _ -> (,dummyType) $ concat [ "consList", identType t ] + hExt = case mode of + CppStdAnsi _ -> ".h" + CppStdBeyondAnsi _ -> ".hh" + + +prConC :: CppStdMode -> String -> CAbsRule -> String +prConC mode c fcs@(f,_) = unlines [ "/******************** " ++ f ++ " ********************/", - prConstructorC fcs, - prCopyC fcs, - prDestructorC fcs, - prAcceptC f, - prCloneC f, + prConstructorC mode fcs, + prCopyC mode fcs, + prDestructorC mode fcs, + prAcceptC mode f, + prCloneC mode c f, "" ] -prListC :: (String,Bool) -> String -prListC (c,b) = unlines +prListC :: CppStdMode -> [String] -> (String,Bool) -> String +prListC mode primitives (c,b) = unlines [ "/******************** " ++ c ++ " ********************/" - , "" - , prAcceptC c - , prCloneC c - , prConsC c b + , prAcceptC mode c + , prCloneC mode c c + , prConsC mode primitives c b ] - --The standard accept function for the Visitor pattern -prAcceptC :: String -> String -prAcceptC ty = unlines [ - "void " ++ ty ++ "::accept(Visitor *v)", - "{", - " v->visit" ++ ty ++ "(this);", - "}" - ] +prAcceptC :: CppStdMode -> String -> String +prAcceptC mode ty = case mode of { + CppStdAnsi _ -> unlines [ + "void " ++ ty ++ "::accept(Visitor *v)", + "{", + " v->visit" ++ ty ++ "(this);", + "}" + ]; + CppStdBeyondAnsi _ -> unlines [ + "void " ++ty++ "::accept(Visitor *v)", + "{", + " v->visit" ++ ty ++ "(this);", + "}" + ]; + } --The cloner makes a new deep copy of the object -prCloneC :: String -> String -prCloneC c = unlines [ - c +++ "*" ++ c ++ "::clone() const", - "{", - " return new" +++ c ++ "(*this);", - "}" - ] +prCloneC :: CppStdMode -> String -> String -> String +prCloneC mode f c = case mode of { + CppStdAnsi _ -> unlines [ + c +++ "*" ++ c ++ "::clone() const", + "{", + " return new" +++ c ++ "(*this);", + "}" + ]; + CppStdBeyondAnsi _ -> unlines [ + wrapSharedPtr f +++ c ++ "::clone() const ", + "{", + " return std::make_shared<" ++ c ++ ">(*this);", + "}" + ]; + } -- | Make a list constructor definition. -prConsC :: String -> Bool -> String -prConsC c b = unlines - [ concat [ c, "* ", "cons", c, "(", bas, " x, ", c, "* xs) {" ] - , " xs->insert(xs->begin(), x);" - , " return xs;" - , "}" - ] +prConsC :: CppStdMode -> [String] -> String -> Bool -> String +prConsC mode primitives c b = case mode of { + CppStdAnsi _ -> unlines [ + concat [ c, "* ", "cons", c, "(", bas, " x, ", c, "* xs) {" ] + , " xs->insert(xs->begin(), x);" + , " return xs;" + , "}" + ]; + CppStdBeyondAnsi _ -> unlines [ + -- Append a element into list tail (In C ++ term, "push_back") + concat [ "void ", c, "::cons(", consArg, " x) {" ] + , if isNotBaseClass then + " " ++inner++ ".push_back(x);" + else + " " ++inner++ ".push_back(std::make_unique<" ++bas++ ">(x));" + , "}" + , "" + -- Insert a element into list head (In C ++ term, "push_front" / in lisp term ? "cons") + -- This implementation is required in definedRules + , concat [wrapSharedPtr c, " cons", c, "(", consArg, " x, ", wrapSharedPtr c, " xs) {"] + , if isNotBaseClass then + " xs->" ++inner++ ".push_front(x);" + else + " xs->" ++inner++ ".push_front(std::make_unique<" ++bas++ ">(x));" + , " return xs;" + , "}" + , "" + , "void" +++ c ++ "::reverse() {" + , " std::reverse(" ++inner++ ".begin(), " ++inner++ ".end());" + , "}" + ]; + } where - bas = applyWhen b (++ "*") $ drop 4 c {- drop "List" -} + bas = case mode of { + CppStdAnsi _ -> applyWhen b (++ "*") $ drop 4 c {- drop "List" -}; + CppStdBeyondAnsi _ -> drop 4 c; + } + inner = map toLower c ++ "_" + -- if list element is primitive type, not to use smart-ptr for argument type + isNotBaseClass = not $ elem bas primitives + consArg = wrapSharedPtrIf isNotBaseClass bas + --The constructor assigns the parameters to the corresponding instance variables. -prConstructorC :: CAbsRule -> String -prConstructorC (f,cs) = unlines [ - f ++ "::" ++ f ++ "(" ++ conargs ++ ")", - "{", - unlines [" " ++ c ++ " = " ++ p ++ ";" | (c,p) <- zip cvs pvs], - "}" - ] +prConstructorC :: CppStdMode -> CAbsRule -> String +prConstructorC mode (f,cs) = case mode of { + CppStdAnsi _ -> unlines [ + f ++ "::" ++ f ++ "(" ++ conargs ++ ")", + "{", + unlines [" " ++ c ++ " = " ++ p ++ ";" | (c,p) <- zip cvs pvs], + "}" + ]; + CppStdBeyondAnsi _ -> unlines [ + ]; + } where cvs = [c | (_,_,c) <- cs] - pvs = ['p' : show i | ((_,_,_),i) <- zip cs [1::Int ..]] - conargs = intercalate ", " - [x +++ pointerIf st v | ((x,st,_),v) <- zip cs pvs] + pvs = ['p' : show i | ((_,_,_),i) <- zip cs [(1::Integer)..]] + + conargs = case mode of { + CppStdAnsi _ -> + intercalate ", " [x +++ pointerIf isClass v | ((x,isClass,_),v) <- zip cs pvs] + ; + CppStdBeyondAnsi _ -> + "" + ; + } --Copy constructor and copy assignment -prCopyC :: CAbsRule -> String -prCopyC (c,cs) = unlines [ - c ++ "::" ++ c ++ "(const" +++ c +++ "& other)", - "{", - unlines [" " ++ cv ++ " = other." ++ cloneIf st cv ++ ";" | (_,st,cv) <- cs], - "}", - "", - c +++ "&" ++ c ++ "::" ++ "operator=(const" +++ c +++ "& other)", - "{", - " " ++ c +++ "tmp(other);", - " swap(tmp);", - " return *this;", - "}", - "", - "void" +++ c ++ "::swap(" ++ c +++ "& other)", - "{", - unlines [" std::swap(" ++ cv ++ ", other." ++ cv ++ ");" | (_,_,cv) <- cs], - "}" - ] - where - cloneIf st cv = if st then (cv ++ "->clone()") else cv +prCopyC :: CppStdMode -> CAbsRule -> String +prCopyC mode (c,cs) = case mode of { + CppStdAnsi _ -> unlines [ + c ++ "::" ++ c ++ "(const" +++ c +++ "& other)", + "{", + unlines [" " ++ cv ++ " = other." ++ cloneIf st cv ++ ";" | (_,st,cv) <- cs], + "}", + "", + c +++ "&" ++ c ++ "::" ++ "operator=(const" +++ c +++ "& other)", + "{", + " " ++ c +++ "tmp(other);", + " swap(tmp);", + " return *this;", + "}", + "", + "void" +++ c ++ "::swap(" ++ c +++ "& other)", + "{", + unlines [" std::swap(" ++ cv ++ ", other." ++ cv ++ ");" | (_,_,cv) <- cs], + "}" + ]; + CppStdBeyondAnsi _ -> "" + } + where + cloneIf st cv = if st then (cv ++ "->clone()") else cv --The destructor deletes all a class's members. -prDestructorC :: CAbsRule -> String -prDestructorC (c,cs) = unlines [ - c ++ "::~" ++ c ++"()", - "{", - unlines [" delete(" ++ cv ++ ");" | (_,isPointer,cv) <- cs, isPointer], - "}" - ] +prDestructorC :: CppStdMode -> CAbsRule -> String +prDestructorC mode (c,cs) = case mode of { + CppStdAnsi _ -> unlines [ + c ++ "::~" ++ c ++"()", + "{", + unlines [" delete(" ++ cv ++ ");" | (_,isPointer,cv) <- cs, isPointer], + "}" + ]; + CppStdBeyondAnsi _ -> "" + ; + } diff --git a/source/src/BNFC/Backend/Common/OOAbstract.hs b/source/src/BNFC/Backend/Common/OOAbstract.hs index 6e0f7981..94aeff7f 100644 --- a/source/src/BNFC/Backend/Common/OOAbstract.hs +++ b/source/src/BNFC/Backend/Common/OOAbstract.hs @@ -29,10 +29,10 @@ data CAbs = CAbs { tokentypes :: [String], -- user non-position token types listtypes :: [(String,Bool)], -- list types used, whether of classes absclasses :: [String], -- grammar-def cats, normalized names - conclasses :: [Fun], -- constructors, except list ones + conclasses :: [Fun], -- constructors, except list ones signatures :: [(String,[CAbsRule])], -- rules for each class, incl. pos tokens postokens :: [String], -- position token types - defineds :: [Fun] -- defined (non-)constructors + defineds :: [Fun] -- defined (non-)constructors } -- (valcat,(constr,args)), True = is class (not basic), class variable stored diff --git a/source/src/BNFC/Backend/OCaml.hs b/source/src/BNFC/Backend/OCaml.hs index a1d408fc..0cd54080 100644 --- a/source/src/BNFC/Backend/OCaml.hs +++ b/source/src/BNFC/Backend/OCaml.hs @@ -114,7 +114,7 @@ makefile :: SharedOptions -> String -> Doc makefile opts basename = vcat [ mkVar "OCAMLC" "ocamlc" , mkVar "OCAMLYACC" $ ocamlParserName opts - , mkVar "OCAMLLEX" "ocamllex" + , mkVar "OCAMLLEX" "ocamllex -ml" -- prevent error of "transition table overflow, automaton is too big" https://stackoverflow.com/a/63461031/2565527 , mkVar "OCAMLCFLAGS" "" , mkRule "all" [] [ "$(OCAMLYACC) " ++ ocamlyaccFile opts diff --git a/testing/Main.hs b/testing/Main.hs index 409970ce..f9db77ad 100644 --- a/testing/Main.hs +++ b/testing/Main.hs @@ -5,7 +5,7 @@ module Main (main) where import Data.String.QQ (s) import System.Environment (getArgs) -import Test.Framework (htfMain) +import Test.Framework (htfMainWithArgs) import License import qualified SucceedLBNFTests @@ -20,7 +20,7 @@ main = do if | "--license" `elem` args -> greet license | "--help" `elem` args -> greet usage | "-h" `elem` args -> greet usage - | otherwise -> runAllTests + | otherwise -> runAllTests args -- All other args will pass into HTF greet :: String -> IO () greet msg = do @@ -33,22 +33,27 @@ usage = [s| Start bnfc-system-tests from inside `testing` directory. Options: ---license Print copyright and license text. ---help, -h Print this help text. + -n PATTERN --not=PATTERN Tests to exclude. + -l --list List all matching tests. + --fail-fast Fail and abort test run as soon as the first test fails. + --license Print copyright and license text. + -h --help Print this help text. |] -runAllTests = do +runAllTests :: [String] -> IO () +runAllTests args = do succeedLBNFTests <- SucceedLBNFTests.all failLBNFTests <- FailLBNFTests.all - htfMain $ + htfMainWithArgs + args -- Use : and [] for this list such that lines can be swapped swiftly -- (avoids the usual problems when trying to switch the first line -- with a later line). - + $ succeedLBNFTests : failLBNFTests : -- ParameterizedTests.layoutTest : - ParameterizedTests.current : -- Uncomment for prioritized test case. + -- ParameterizedTests.current : -- Uncomment for prioritized test case. -- RegressionTests.current : ParameterizedTests.all : RegressionTests.all : diff --git a/testing/Makefile b/testing/Makefile index 011c8262..be2de626 100644 --- a/testing/Makefile +++ b/testing/Makefile @@ -1,13 +1,18 @@ .PHONY: build license test usage -test: build - cabal run +SHELL := /bin/bash + +test: build exec-test + +exec-test: + cabal v2-install BNFC:exes --overwrite-policy=always + source ./scripts/env && cabal run bnfc-system-tests #-- "Parameterized tests:C\+\+ \(with namespace\):Examples:cpp" usage: build - cabal run --help + cabal run bnfc-system-tests -- --help license: build - cabal run --license + cabal run bnfc-system-tests -- --license build: make -C src diff --git a/testing/src/ParameterizedTests.hs b/testing/src/ParameterizedTests.hs index 620b94e4..79b6ff5f 100644 --- a/testing/src/ParameterizedTests.hs +++ b/testing/src/ParameterizedTests.hs @@ -343,6 +343,18 @@ haskellRunTestProg _lang args = do parameters :: [TestParameters] parameters = concat [ [] + -- C++ (extras) + , [ cBase { tpName = "C++ (with line numbers)" + , tpBnfcOptions = ["--cpp", "-l"] } + , cBase { tpName = "C++ (with namespace)" + , tpBnfcOptions = ["--cpp", "-p foobar"] } + ] + -- C++ (basic) + , [ cBase { tpName = "C++ (no STL)" + , tpBnfcOptions = ["--cpp-nostl"] } + , cBase { tpName = "C++ (ANSI)" + , tpBnfcOptions = ["--cpp", "--ansi"] } + ] -- OCaml/Menhir , [ ocaml { tpName = "OCaml/Menhir" , tpBnfcOptions = ["--ocaml", "--menhir"] } @@ -351,12 +363,6 @@ parameters = concat , [ ocaml ] -- Functor (Haskell & Agda) , [ haskellAgdaFunctorParameters] - -- C++ (extras) - , [ cBase { tpName = "C++ (with line numbers)" - , tpBnfcOptions = ["--cpp", "-l"] } - , cBase { tpName = "C++ (with namespace)" - , tpBnfcOptions = ["--cpp", "-p foobar"] } - ] -- C , [ TP { tpName = "C" , tpBnfcOptions = ["--c"] @@ -380,12 +386,6 @@ parameters = concat , tpBnfcOptions = ["--c", "--line-numbers"] } ] - -- C++ (basic) - , [ cBase { tpName = "C++ (no STL)" - , tpBnfcOptions = ["--cpp-nostl"] } - , cBase { tpName = "C++" - , tpBnfcOptions = ["--cpp"] } - ] -- Agda , [ haskellAgdaParameters ] -- Java/ANTLR