diff --git a/source/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs b/source/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs index d8b03bbf..3b86f05d 100644 --- a/source/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs +++ b/source/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs @@ -52,6 +52,7 @@ import BNFC.Backend.C.CFtoBisonC (startSymbol) import BNFC.Backend.CPP.STL.STLUtils import BNFC.Backend.Common.NamedVariables hiding (varName) import BNFC.CF +import BNFC.Options (LineNumber(..)) import BNFC.PrettyPrint import BNFC.TypeChecker import BNFC.Utils ((+++)) @@ -66,7 +67,7 @@ type Action = String type MetaVar = String --The environment comes from the CFtoFlex -cf2Bison :: Bool -> Maybe String -> String -> CF -> SymEnv -> String +cf2Bison :: LineNumber -> Maybe String -> String -> CF -> SymEnv -> String cf2Bison ln inPackage name cf env = unlines [header inPackage name cf, @@ -289,7 +290,7 @@ specialToks cf = concat [ --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs -rulesForBison :: Bool -> Maybe String -> String -> CF -> SymEnv -> Rules +rulesForBison :: LineNumber -> Maybe String -> String -> CF -> SymEnv -> Rules rulesForBison ln inPackage _ cf env = map mkOne (ruleGroups cf) ++ posRules where mkOne (cat,rules) = constructRule ln inPackage cf env rules cat posRules = map mkPos $ positionCats cf @@ -299,7 +300,7 @@ rulesForBison ln inPackage _ cf env = map mkOne (ruleGroups cf) ++ posRules wher -- For every non-terminal, we construct a set of rules. constructRule :: - Bool -> Maybe String -> CF -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) + LineNumber -> Maybe String -> CF -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) constructRule ln inPackage cf env rules nt = (nt,[(p, generateAction ln inPackage nt (ruleName r) b m +++ result) | r0 <- rules, @@ -318,7 +319,7 @@ constructRule ln inPackage cf env rules nt = result = if isEntry nt then (nsScope inPackage ++ resultName (identCat (normCat nt))) ++ "= $$;" else "" -- Generates a string containing the semantic action. -generateAction :: Bool -> Maybe String -> NonTerminal -> Fun -> Bool -> [(MetaVar,Bool)] -> Action +generateAction :: LineNumber -> Maybe String -> NonTerminal -> Fun -> Bool -> [(MetaVar,Bool)] -> Action generateAction ln inPackage cat f b mbs = reverses ++ if isCoercion f @@ -338,7 +339,7 @@ generateAction ln inPackage cat f b mbs = where ms = map fst mbs lastms = last ms - addLn ln = if ln then " $$->line_number = " ++ nsString inPackage ++ "yy_mylinenumber;" else "" -- O.F. + addLn ln = if ln == LineNumber then " $$->line_number = " ++ nsString inPackage ++ "yy_mylinenumber;" else "" -- O.F. identCatV = identCat . normCat reverses = unwords [ "std::reverse(" ++ m ++"->begin(),"++m++"->end()) ;" | diff --git a/source/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs b/source/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs index 4e18e55e..ff8b43a3 100644 --- a/source/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs +++ b/source/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs @@ -42,13 +42,14 @@ module BNFC.Backend.CPP.STL.CFtoSTLAbs (cf2CPPAbs) where import BNFC.Backend.Common.OOAbstract import BNFC.CF +import BNFC.Options (LineNumber(..)) import BNFC.Utils((+++)) import Data.List import BNFC.Backend.CPP.STL.STLUtils --The result is two files (.H file, .C file) -cf2CPPAbs :: Bool -> Maybe String -> String -> CF -> (String, String) +cf2CPPAbs :: LineNumber -> Maybe String -> String -> CF -> (String, String) cf2CPPAbs ln inPackage _ cf = (mkHFile ln inPackage cab, mkCFile inPackage cab) where cab = cf2cabs cf @@ -57,7 +58,7 @@ cf2CPPAbs ln inPackage _ cf = (mkHFile ln inPackage cab, mkCFile inPackage cab) -- **** Header (.H) File Functions **** -- --Makes the Header file. -mkHFile :: Bool -> Maybe String -> CAbs -> String +mkHFile :: LineNumber -> Maybe String -> CAbs -> String mkHFile ln inPackage cf = unlines [ "#ifndef " ++ hdef, @@ -125,13 +126,13 @@ prVisitor cf = unlines [ "};" ] -prAbs :: Bool -> String -> String +prAbs :: LineNumber -> String -> String prAbs ln c = unlines [ "class " ++ c ++ " : public Visitable", "{", "public:", " virtual " ++ c ++ " *clone() const = 0;", - if ln then " int line_number;" else "", + if ln == LineNumber then " int line_number;" else "", "};" ] diff --git a/source/src/BNFC/Backend/Java.hs b/source/src/BNFC/Backend/Java.hs index 4088fadb..10cf1ce5 100644 --- a/source/src/BNFC/Backend/Java.hs +++ b/source/src/BNFC/Backend/Java.hs @@ -300,7 +300,7 @@ antlrtest = parserLexerSelector :: String -> JavaLexerParser - -> Bool -- ^Pass line numbers to the symbols + -> LineNumber -- ^Pass line numbers to the symbols -> ParserLexerSpecification parserLexerSelector _ JLexCup ln = ParseLexSpec { lexer = cf2JLex ln @@ -332,15 +332,15 @@ data CFToLexer = CF2Lex } -- | Instances of cf-lexergen bridges -cf2JLex, cf2JFlex :: Bool -> CFToLexer +cf2JLex, cf2JFlex :: LineNumber -> CFToLexer cf2JLex ln = CF2Lex - { cf2lex = BNFC.Backend.Java.CFtoJLex15.cf2jlex (ln, False) + { cf2lex = BNFC.Backend.Java.CFtoJLex15.cf2jlex JLexCup ln , makelexerdetails = jlexmakedetails } cf2JFlex ln = CF2Lex - { cf2lex = BNFC.Backend.Java.CFtoJLex15.cf2jlex (ln, True) + { cf2lex = BNFC.Backend.Java.CFtoJLex15.cf2jlex JFlexCup ln , makelexerdetails = jflexmakedetails } @@ -353,7 +353,7 @@ cf2AntlrLex' l = CF2Lex -- | CF -> PARSER GENERATION TOOL BRIDGE -- | function translating the CF to an appropriate parser generation tool. -type CF2ParserFunction = String -> String -> CF -> Bool -> SymEnv -> String +type CF2ParserFunction = String -> String -> CF -> LineNumber -> SymEnv -> String -- | Chooses the translation from CF to the parser data CFToParser = CF2Parse @@ -362,8 +362,7 @@ data CFToParser = CF2Parse } -- | Instances of cf-parsergen bridges --- Bool is line numbering -cf2cup :: Bool -> CFToParser +cf2cup :: LineNumber -> CFToParser cf2cup ln = CF2Parse { cf2parse = BNFC.Backend.Java.CFtoCup15.cf2Cup , makeparserdetails = cupmakedetails ln @@ -420,7 +419,7 @@ mapEmpty _ = "" -- Instances of makefile details. jflexmakedetails, jlexmakedetails :: MakeFileDetails -cupmakedetails :: Bool -> MakeFileDetails +cupmakedetails :: LineNumber -> MakeFileDetails jlexmakedetails = MakeDetails { executable = runJava "JLex.Main" @@ -452,7 +451,7 @@ cupmakedetails ln = MakeDetails , moveresults = True } where - lnFlags = if ln then "-locations" else "-nopositions" + lnFlags = if ln == LineNumber then "-locations" else "-nopositions" antlrmakedetails :: String -> MakeFileDetails diff --git a/source/src/BNFC/Backend/Java/CFtoAntlr4Parser.hs b/source/src/BNFC/Backend/Java/CFtoAntlr4Parser.hs index 06be0c06..2125ff79 100644 --- a/source/src/BNFC/Backend/Java/CFtoAntlr4Parser.hs +++ b/source/src/BNFC/Backend/Java/CFtoAntlr4Parser.hs @@ -43,6 +43,7 @@ import Data.List import BNFC.CF import BNFC.Backend.Java.Utils import BNFC.Backend.Common.NamedVariables +import BNFC.Options (LineNumber(..)) import BNFC.Utils ( (+++), (+.+)) -- Type declarations @@ -53,8 +54,7 @@ type MetaVar = (String, Cat) -- | Creates the ANTLR parser grammar for this CF. --The environment comes from CFtoAntlr4Lexer ---The bool is line numbering, which is currently not supported. -cf2AntlrParse :: String -> String -> CF -> Bool -> SymEnv -> String +cf2AntlrParse :: String -> String -> CF -> LineNumber -> SymEnv -> String cf2AntlrParse packageBase packageAbsyn cf _ env = unlines [ header , tokens diff --git a/source/src/BNFC/Backend/Java/CFtoCup15.hs b/source/src/BNFC/Backend/Java/CFtoCup15.hs index e042a147..a78511d4 100644 --- a/source/src/BNFC/Backend/Java/CFtoCup15.hs +++ b/source/src/BNFC/Backend/Java/CFtoCup15.hs @@ -42,6 +42,7 @@ module BNFC.Backend.Java.CFtoCup15 ( cf2Cup ) where import BNFC.CF import Data.List import BNFC.Backend.Common.NamedVariables +import BNFC.Options (LineNumber(..)) import BNFC.Utils ( (+++) ) import BNFC.TypeChecker -- We need to (re-)typecheck to figure out list instances in -- defined rules. @@ -55,7 +56,7 @@ type Action = String type MetaVar = String --The environment comes from the CFtoJLex -cf2Cup :: String -> String -> CF -> Bool -> SymEnv -> String +cf2Cup :: String -> String -> CF -> LineNumber -> SymEnv -> String cf2Cup packageBase packageAbsyn cf ln env = unlines [ header , declarations packageAbsyn (allCats cf) @@ -206,13 +207,13 @@ specialRules cf = --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs -rulesForCup :: String -> CF -> Bool -> SymEnv -> Rules +rulesForCup :: String -> CF -> LineNumber -> SymEnv -> Rules rulesForCup packageAbsyn cf ln env = map mkOne $ ruleGroups cf where mkOne (cat,rules) = constructRule packageAbsyn cf ln env rules cat -- | For every non-terminal, we construct a set of rules. A rule is a sequence of -- terminals and non-terminals, and an action to be performed. -constructRule :: String -> CF -> Bool -> SymEnv -> [Rule] -> NonTerminal +constructRule :: String -> CF -> LineNumber -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)]) constructRule packageAbsyn cf ln env rules nt = (nt, [ (p, generateAction packageAbsyn nt (funRule r) (revM b m) b ln) @@ -230,7 +231,7 @@ constructRule packageAbsyn cf ln env rules nt = generateAction :: String -> NonTerminal -> Fun -> [MetaVar] -> Bool -- ^ Whether the list should be reversed or not. -- Only used if this is a list rule. - -> Bool -- ^ Record line and column info. + -> LineNumber -- ^ Record line and column info. -> Action generateAction packageAbsyn nt f ms rev ln | isNilFun f = "RESULT = new " ++ c ++ "();" @@ -251,7 +252,7 @@ generateAction packageAbsyn nt f ms rev ln p_2 = ms !! 1 add = if rev then "addLast" else "addFirst" lineInfo = - if ln + if ln == LineNumber then case ms of [] -> "\n((" ++ c ++ ")RESULT).line_num = -1;" ++ "\n((" ++ c ++ ")RESULT).col_num = -1;" ++ diff --git a/source/src/BNFC/Backend/Java/CFtoJLex15.hs b/source/src/BNFC/Backend/Java/CFtoJLex15.hs index f6a56883..97939bfc 100644 --- a/source/src/BNFC/Backend/Java/CFtoJLex15.hs +++ b/source/src/BNFC/Backend/Java/CFtoJLex15.hs @@ -40,16 +40,17 @@ module BNFC.Backend.Java.CFtoJLex15 ( cf2jlex ) where import BNFC.CF +import BNFC.Backend.Common.NamedVariables import BNFC.Backend.Java.RegToJLex +import BNFC.Options (JavaLexerParser(..), LineNumber(..)) import BNFC.Utils (cstring) -import BNFC.Backend.Common.NamedVariables import Text.PrettyPrint --The environment must be returned for the parser to use. -cf2jlex :: (Bool, Bool) -> String -> CF -> (Doc, SymEnv) -cf2jlex (ln, jflex) packageBase cf = (vcat +cf2jlex :: JavaLexerParser -> LineNumber -> String -> CF -> (Doc, SymEnv) +cf2jlex jflex ln packageBase cf = (vcat [ - prelude (ln, jflex) packageBase, + prelude jflex ln packageBase, cMacros, lexSymbols jflex env, restOfJLex cf @@ -60,8 +61,8 @@ cf2jlex (ln, jflex) packageBase cf = (vcat makeSymEnv (s:symbs) n = (s, "_SYMB_" ++ show n) : makeSymEnv symbs (n+1) -- | File prelude -prelude :: (Bool, Bool) -> String -> Doc -prelude (ln, jflex) packageBase = vcat +prelude :: JavaLexerParser -> LineNumber -> String -> Doc +prelude jflex ln packageBase = vcat [ "// This JLex file was machine-generated by the BNF converter" , "package" <+> text packageBase <> ";" , "" @@ -69,10 +70,10 @@ prelude (ln, jflex) packageBase = vcat , "%%" , "%cup" , "%unicode" - , (if ln + , (if ln == LineNumber then vcat [ "%line" - , (if jflex then "%column" else "") + , (if jflex == JFlexCup then "%column" else "") , "%char" ] else "") , "%public" @@ -86,18 +87,18 @@ prelude (ln, jflex) packageBase = vcat , positionDeclarations , "public int line_num() { return (yyline+1); }" , "public ComplexSymbolFactory.Location left_loc() {" - , if ln + , if ln == LineNumber then " return new ComplexSymbolFactory.Location(yyline+1, yycolumn+1, yychar);" else " return null;" , "}" , "public ComplexSymbolFactory.Location right_loc() {" , " ComplexSymbolFactory.Location left = left_loc();" - , (if ln + , (if ln == LineNumber then "return new ComplexSymbolFactory.Location(left.getLine(), left.getColumn()+yylength(), left.getOffset()+yylength());" else "return left;") , "}" , "public String buff()" <+> braces - (if jflex + (if jflex == JFlexCup then "return new String(zzBuffer,zzCurrentPos,10).trim();" else "return new String(yy_buffer,yy_buffer_index,10).trim();") ] @@ -109,8 +110,8 @@ prelude (ln, jflex) packageBase = vcat where positionDeclarations = -- JFlex always defines yyline, yychar, yycolumn, even if unused. - if jflex then "" - else if ln then "int yycolumn = unknown - 1;" + if jflex == JFlexCup then "" + else if ln == LineNumber then "int yycolumn = unknown - 1;" else vcat -- subtract one so that one based numbering still ends up with unknown. [ "int yyline = unknown - 1;" @@ -136,17 +137,17 @@ cMacros = vcat [ ] -- | --- >>> lexSymbols False [("foo","bar")] +-- >>> lexSymbols JLexCup [("foo","bar")] -- foo { return cf.newSymbol("", sym.bar, left_loc(), right_loc()); } --- >>> lexSymbols False [("\\","bar")] +-- >>> lexSymbols JLexCup [("\\","bar")] -- \\ { return cf.newSymbol("", sym.bar, left_loc(), right_loc()); } --- >>> lexSymbols False [("/","bar")] +-- >>> lexSymbols JLexCup [("/","bar")] -- / { return cf.newSymbol("", sym.bar, left_loc(), right_loc()); } --- >>> lexSymbols True [("/","bar")] +-- >>> lexSymbols JFlexCup [("/","bar")] -- \/ { return cf.newSymbol("", sym.bar, left_loc(), right_loc()); } --- >>> lexSymbols True [("~","bar")] +-- >>> lexSymbols JFlexCup [("~","bar")] -- \~ { return cf.newSymbol("", sym.bar, left_loc(), right_loc()); } -lexSymbols :: Bool -> SymEnv -> Doc +lexSymbols :: JavaLexerParser -> SymEnv -> Doc lexSymbols jflex ss = vcat $ map transSym ss where transSym (s,r) = diff --git a/source/src/BNFC/Backend/Java/CFtoJavaAbs15.hs b/source/src/BNFC/Backend/Java/CFtoJavaAbs15.hs index 7fe8eb51..9714f6f2 100644 --- a/source/src/BNFC/Backend/Java/CFtoJavaAbs15.hs +++ b/source/src/BNFC/Backend/Java/CFtoJavaAbs15.hs @@ -47,6 +47,7 @@ module BNFC.Backend.Java.CFtoJavaAbs15 (cf2JavaAbs, typename) where import BNFC.CF +import BNFC.Options (LineNumber(..)) import BNFC.Utils((+++),(++++)) import BNFC.Backend.Common.NamedVariables hiding (IVar, getVars, varName) import Data.Function (on) @@ -64,10 +65,9 @@ type IVar = (String, Int, String) --a # unique to that type --and an optional name (handles typedefs). ---Bool is line numbering --The result is a list of files which must be written to disk. --The tuple is (FileName, FileContents) -cf2JavaAbs :: String -> String -> CF -> Bool -> [(FilePath, String)] +cf2JavaAbs :: String -> String -> CF -> LineNumber -> [(FilePath, String)] cf2JavaAbs _ packageAbsyn cf ln = concatMap (prData ln header packageAbsyn user) rules where @@ -76,7 +76,7 @@ cf2JavaAbs _ packageAbsyn cf ln = rules = getAbstractSyntax cf --Generates a (possibly abstract) category class, and classes for all its rules. -prData :: Bool -> String -> String -> [UserDef] -> Data ->[(String, String)] +prData :: LineNumber -> String -> String -> [UserDef] -> Data ->[(String, String)] prData ln header packageAbsyn user (cat, rules) = categoryClass ++ mapMaybe (prRule ln header packageAbsyn funs user cat) rules where @@ -105,7 +105,7 @@ prVisitor packageAbsyn funs = prVisitFun f = " public R visit(" ++ packageAbsyn ++ "." ++ f ++ " p, A arg);" --Generates classes for a rule, depending on what type of rule it is. -prRule :: Bool -- ^ Include line number info in generated classes. +prRule :: LineNumber -- ^ Include line number info in generated classes. -> String -- ^ Header -> String -- ^ Abstract syntax package name -> [String] -- ^ Names of all constructors in the category @@ -182,17 +182,17 @@ prHashCode _ _ vs = -- | A class's instance variables. --- >>> prInstVars False [("A",1,""), ("B",1,""), ("A",2,"abc")] +-- >>> prInstVars NoLineNumber [("A",1,""), ("B",1,""), ("A",2,"abc")] -- public final A _1, abc_2; -- public final B _1; --- >>> prInstVars True [("A",1,""), ("B",1,""), ("A",2,"abc")] +-- >>> prInstVars LineNumber [("A",1,""), ("B",1,""), ("A",2,"abc")] -- public final A _1, abc_2; -- public final B _1; -- public int line_num, col_num, offset; -prInstVars :: Bool -> [IVar] -> Doc +prInstVars :: LineNumber -> [IVar] -> Doc prInstVars ln [] = case ln of - True -> "public int line_num, col_num, offset;" - False -> empty + LineNumber -> "public int line_num, col_num, offset;" + NoLineNumber -> empty prInstVars ln vars@((t,_,_):_) = "public" <+> "final" <+> text t <+> uniques <> ";" $$ prInstVars ln vs' where diff --git a/source/src/BNFC/Backend/Java/RegToJLex.hs b/source/src/BNFC/Backend/Java/RegToJLex.hs index 1a1be254..c55d883d 100644 --- a/source/src/BNFC/Backend/Java/RegToJLex.hs +++ b/source/src/BNFC/Backend/Java/RegToJLex.hs @@ -3,6 +3,7 @@ module BNFC.Backend.Java.RegToJLex (printRegJLex, escapeChar) where -- modified from pretty-printer generated by the BNF converter import AbsBNF +import BNFC.Options (JavaLexerParser(..)) -- the top-level printing method printRegJLex :: Reg -> String @@ -36,13 +37,13 @@ instance Print a => Print [a] where prt _ = prtList instance Print Char where - prt _ c = [escapeChar False c] + prt _ c = [escapeChar JLexCup c] prtList = map (concat . prt 0) -escapeChar :: Bool -> Char -> String +escapeChar :: JavaLexerParser -> Char -> String escapeChar _ '^' = "\\x5E" -- special case, since \^ is a control character escape -escapeChar False x | x `elem` jlexReserved = '\\' : [x] -escapeChar True x | x `elem` jflexReserved = '\\' : [x] +escapeChar JFlexCup x | x `elem` jflexReserved = '\\' : [x] +escapeChar _ x | x `elem` jlexReserved = '\\' : [x] escapeChar _ x = [x] -- Characters that must be escaped in JLex regular expressions diff --git a/source/src/BNFC/Options.hs b/source/src/BNFC/Options.hs index 32a8ca15..48ac8d96 100644 --- a/source/src/BNFC/Options.hs +++ b/source/src/BNFC/Options.hs @@ -57,6 +57,10 @@ data HappyMode = Standard | GLR data JavaLexerParser = JLexCup | JFlexCup | Antlr4 deriving (Eq,Show,Ord) + +data LineNumber = LineNumber | NoLineNumber + deriving (Eq,Show,Ord) + -- | This is the option record that is passed to the different backends data SharedOptions = Options -- Option shared by at least 2 backends @@ -77,7 +81,7 @@ data SharedOptions = Options , xml :: Int , ghcExtensions :: Bool -- C++ specific - , linenumbers :: Bool -- ^ Add and set line_number field for syntax classes + , linenumbers :: LineNumber -- ^ Add and set line_number field for syntax classes -- C# specific , visualStudio :: Bool -- ^ Generate Visual Studio solution/project files , wcf :: Bool -- ^ Windows Communication Foundation @@ -104,7 +108,7 @@ defaultOptions = Options , xml = 0 , ghcExtensions = False , lang = error "lang not set" - , linenumbers = False + , linenumbers = NoLineNumber , visualStudio = False , wcf = False , functor = False @@ -151,7 +155,7 @@ targetOptions = -- they apply to. specificOptions :: [(OptDescr (SharedOptions -> SharedOptions), [Target])] specificOptions = - [ ( Option ['l'] [] (NoArg (\o -> o {linenumbers = True})) + [ ( Option ['l'] [] (NoArg (\o -> o {linenumbers = LineNumber})) "Add and set line_number field for all syntax classes\nJava requires cup 0.11b-2014-06-11 or greater" , [TargetCpp, TargetJava] ) , ( Option ['p'] []