diff --git a/source/src/BNFC/Backend/C.hs b/source/src/BNFC/Backend/C.hs index 232f69f3..f1ba08ed 100644 --- a/source/src/BNFC/Backend/C.hs +++ b/source/src/BNFC/Backend/C.hs @@ -206,7 +206,7 @@ mkHeaderFile _ cf env = unlines $ concat , "typedef union" , "{" ] - , unionBuiltinTokens + , map (" " ++) unionBuiltinTokens , concatMap mkPointer $ allParserCatsNorm cf , [ "} YYSTYPE;" , "" diff --git a/source/src/BNFC/Backend/C/CFtoBisonC.hs b/source/src/BNFC/Backend/C/CFtoBisonC.hs index 9aeae6c8..29b4ae91 100644 --- a/source/src/BNFC/Backend/C/CFtoBisonC.hs +++ b/source/src/BNFC/Backend/C/CFtoBisonC.hs @@ -40,7 +40,14 @@ {-# LANGUAGE PatternGuards #-} -module BNFC.Backend.C.CFtoBisonC (cf2Bison, startSymbol, unionBuiltinTokens, mkPointer) where +module BNFC.Backend.C.CFtoBisonC + ( cf2Bison + , mkPointer + , resultName, typeName, varName + , specialToks, startSymbol + , unionBuiltinTokens + ) + where import Data.Char (toLower) import Data.List (intercalate, nub) @@ -202,7 +209,7 @@ union cats = unlines $ concat [ [ "%union" , "{" ] - , unionBuiltinTokens + , map (" " ++) unionBuiltinTokens , concatMap mkPointer cats , [ "}" ] @@ -217,10 +224,10 @@ mkPointer c unionBuiltinTokens :: [String] unionBuiltinTokens = - [ " int _int;" - , " char _char;" - , " double _double;" - , " char* _string;" + [ "int _int;" + , "char _char;" + , "double _double;" + , "char* _string;" ] --declares non-terminal types. diff --git a/source/src/BNFC/Backend/CPP/NoSTL.hs b/source/src/BNFC/Backend/CPP/NoSTL.hs index 7e70d117..238ba323 100644 --- a/source/src/BNFC/Backend/CPP/NoSTL.hs +++ b/source/src/BNFC/Backend/CPP/NoSTL.hs @@ -26,6 +26,7 @@ import BNFC.Utils import BNFC.CF import BNFC.Options import BNFC.Backend.Base +import BNFC.Backend.C.CFtoBisonC (unionBuiltinTokens) import BNFC.Backend.CPP.Makefile import BNFC.Backend.CPP.NoSTL.CFtoCPPAbs import BNFC.Backend.CPP.NoSTL.CFtoFlex @@ -132,31 +133,33 @@ cpptest cf = dat = identCat $ normCat cat def = identCat cat -mkHeaderFile cf cats eps env = unlines - [ - "#ifndef PARSER_HEADER_FILE", - "#define PARSER_HEADER_FILE", - "", - concatMap mkForwardDec (nub $ map normCat cats), - "typedef union", - "{", - " int int_;", - " char char_;", - " double double_;", - " char* string_;", - concatMap mkVar cats ++ "} YYSTYPE;", - "", - "#define _ERROR_ 258", - mkDefines (259 :: Int) env, - "extern YYSTYPE yylval;", - concatMap mkFunc eps, - "", - "#endif" - ] - where - mkForwardDec s = "class " ++ identCat s ++ ";\n" - mkVar s | normCat s == s = " " ++ identCat s ++"*" +++ map toLower (identCat s) ++ "_;\n" - mkVar _ = "" +mkHeaderFile cf cats eps env = unlines $ concat + [ [ "#ifndef PARSER_HEADER_FILE" + , "#define PARSER_HEADER_FILE" + , "" + ] + , map mkForwardDec $ nub $ map normCat cats + , [ "typedef union" + , "{" + ] + , map (" " ++) unionBuiltinTokens + , concatMap mkVar cats + , [ "} YYSTYPE;" + , "" + , "#define _ERROR_ 258" + , mkDefines (259 :: Int) env + , "extern YYSTYPE yylval;" + , "" + ] + , map mkFunc eps + , [ "" + , "#endif" + ] + ] + where + mkForwardDec s = "class " ++ identCat s ++ ";" + mkVar s | normCat s == s = [ " " ++ identCat s ++"*" +++ map toLower (identCat s) ++ "_;" ] + mkVar _ = [] mkDefines n [] = mkString n mkDefines n ((_,s):ss) = "#define " ++ s +++ show n ++ "\n" ++ mkDefines (n+1) ss mkString n = if isUsedCat cf (TokenCat catString) @@ -174,4 +177,4 @@ mkHeaderFile cf cats eps env = unlines mkIdent n = if isUsedCat cf (TokenCat catIdent) then "#define _IDENT_ " ++ show n ++ "\n" else "" - mkFunc s = identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(FILE *inp);\n" + mkFunc s = identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(FILE *inp);" diff --git a/source/src/BNFC/Backend/CPP/NoSTL/CFtoBison.hs b/source/src/BNFC/Backend/CPP/NoSTL/CFtoBison.hs index a93de938..c9e3047e 100644 --- a/source/src/BNFC/Backend/CPP/NoSTL/CFtoBison.hs +++ b/source/src/BNFC/Backend/CPP/NoSTL/CFtoBison.hs @@ -60,17 +60,18 @@ module BNFC.Backend.CPP.NoSTL.CFtoBison (cf2Bison) where -import Data.Char (toLower, isUpper) -import Data.List (intersperse, nub) -import Data.Maybe (fromMaybe) +import Data.Char ( toLower, isUpper ) +import Data.List ( intersperse, nub ) +import Data.Maybe ( fromMaybe ) import BNFC.CF import BNFC.Backend.Common.NamedVariables hiding (varName) -import BNFC.Backend.C.CFtoBisonC (startSymbol) -import BNFC.Backend.CPP.STL.CFtoBisonSTL (union) +import BNFC.Backend.C.CFtoBisonC + ( resultName, specialToks, startSymbol, typeName, varName ) +import BNFC.Backend.CPP.STL.CFtoBisonSTL ( tokens, union ) import BNFC.PrettyPrint import BNFC.TypeChecker -import BNFC.Utils ((+++), when) +import BNFC.Utils ( (+++) ) --This follows the basic structure of CFtoHappy. @@ -246,22 +247,6 @@ declarations cf = concatMap (typeNT cf) (allParserCats cf) typeNT cf nt | rulesForCat cf nt /= [] = "%type <" ++ varName nt ++ "> " ++ identCat nt ++ "\n" typeNT _ _ = "" ---declares terminal types. -tokens :: [UserDef] -> SymEnv -> String -tokens user = concatMap $ \ (s, r) -> - concat [ "%token", when (s `elem` user) "", " ", r, " // ", s, "\n" ] - -specialToks :: CF -> String -specialToks cf = concat [ - ifC catString "%token _STRING_\n", - ifC catChar "%token _CHAR_\n", - ifC catInteger "%token _INTEGER_\n", - ifC catDouble "%token _DOUBLE_\n", - ifC catIdent "%token _IDENT_\n" - ] - where - ifC cat s = if isUsedCat cf (TokenCat cat) then s else "" - --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs rulesForBison :: String -> CF -> SymEnv -> Rules @@ -328,19 +313,3 @@ prRules ((nt,((p,a):ls)):rs) = nt' = identCat nt pr [] = [] pr ((p,a):ls) = (unlines [(concat $ intersperse " " [" |", p, "{ $$ =", a , "}"])]) ++ pr ls - ---Some helper functions. -resultName :: String -> String -resultName s = "YY_RESULT_" ++ s ++ "_" - ---slightly stronger than the NamedVariable version. -varName :: Cat -> String -varName = (++ "_") . map toLower . identCat . normCat - -typeName :: String -> String -typeName "Ident" = "_IDENT_" -typeName "String" = "_STRING_" -typeName "Char" = "_CHAR_" -typeName "Integer" = "_INTEGER_" -typeName "Double" = "_DOUBLE_" -typeName x = x diff --git a/source/src/BNFC/Backend/CPP/NoSTL/CFtoFlex.hs b/source/src/BNFC/Backend/CPP/NoSTL/CFtoFlex.hs index b6d73e1a..1b36a2a5 100644 --- a/source/src/BNFC/Backend/CPP/NoSTL/CFtoFlex.hs +++ b/source/src/BNFC/Backend/CPP/NoSTL/CFtoFlex.hs @@ -97,58 +97,56 @@ lexSymbols ss = concatMap transSym ss s' = escapeChars s restOfFlex :: Maybe String -> CF -> SymEnv -> String -restOfFlex inPackage cf env = concat - [ - render $ lexComments inPackage (comments cf), - "\n\n", - userDefTokens, - ifC catString strStates, - ifC catChar chStates, - ifC catDouble ("{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t " ++ ns ++ "yylval.double_ = atof(yytext); return " ++ nsDefine inPackage "_DOUBLE_" ++ ";\n"), - ifC catInteger ("{DIGIT}+ \t " ++ ns ++ "yylval.int_ = atoi(yytext); return " ++ nsDefine inPackage "_INTEGER_" ++ ";\n"), - ifC catIdent ("{LETTER}{IDENT}* \t " ++ ns ++ "yylval.string_ = strdup(yytext); return " ++ nsDefine inPackage "_IDENT_" ++ ";\n"), - "\\n ++" ++ ns ++ "yy_mylinenumber ;\n", - "[ \\t\\r\\n\\f] \t /* ignore white space. */;\n", - ". \t return " ++ nsDefine inPackage "_ERROR_" ++ ";\n", - "%%\n", - footer +restOfFlex inPackage cf env = unlines $ concat + [ [ render $ lexComments inPackage (comments cf) + , "" + ] + , userDefTokens + , ifC catString strStates + , ifC catChar chStates + , ifC catDouble [ "{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? \t " ++ ns ++ "yylval._double = atof(yytext); return " ++ nsDefine inPackage "_DOUBLE_" ++ ";" ] + , ifC catInteger [ "{DIGIT}+ \t " ++ ns ++ "yylval._int = atoi(yytext); return " ++ nsDefine inPackage "_INTEGER_" ++ ";" ] + , ifC catIdent [ "{LETTER}{IDENT}* \t " ++ ns ++ "yylval._string = strdup(yytext); return " ++ nsDefine inPackage "_IDENT_" ++ ";" ] + , [ "\\n ++" ++ ns ++ "yy_mylinenumber ;" + , "[ \\t\\r\\n\\f] \t /* ignore white space. */;" + , ". \t return " ++ nsDefine inPackage "_ERROR_" ++ ";" + , "%%" + ] + , footer ] where - ifC cat s = if isUsedCat cf (TokenCat cat) then s else "" + ifC cat s = if isUsedCat cf (TokenCat cat) then s else [] ns = nsString inPackage - userDefTokens = unlines $ - ["" ++ printRegFlex exp ++ - " \t " ++ ns ++ "yylval.string_ = strdup(yytext); return " ++ sName name ++ ";" - | (name, exp) <- tokenPragmas cf] - where - sName n = fromMaybe n $ lookup n env - strStates = unlines --These handle escaped characters in Strings. - [ - "\"\\\"\" \t BEGIN STRING;", - "\\\\ \t BEGIN ESCAPED;", - "\\\" \t " ++ ns ++ "yylval.string_ = strdup(YY_PARSED_STRING); YY_BUFFER_RESET(); BEGIN YYINITIAL; return " ++ nsDefine inPackage "_STRING_" ++ ";", - ". \t YY_BUFFER_APPEND(yytext);", - "n \t YY_BUFFER_APPEND(\"\\n\"); BEGIN STRING;", - "\\\" \t YY_BUFFER_APPEND(\"\\\"\"); BEGIN STRING ;", - "\\\\ \t YY_BUFFER_APPEND(\"\\\\\"); BEGIN STRING;", - "t \t YY_BUFFER_APPEND(\"\\t\"); BEGIN STRING;", - ". \t YY_BUFFER_APPEND(yytext); BEGIN STRING;" - ] - chStates = unlines --These handle escaped characters in Chars. - [ - "\"'\" \tBEGIN CHAR;", - "\\\\ \t BEGIN CHARESC;", - "[^'] \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";", - "n \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = '\\n'; return " ++ nsDefine inPackage "_CHAR_" ++ ";", - "t \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = '\\t'; return " ++ nsDefine inPackage "_CHAR_" ++ ";", - ". \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";", - "\"'\" \t BEGIN YYINITIAL;" - ] - footer = unlines - [ - "void " ++ ns ++ "initialize_lexer(FILE *inp) { yyrestart(inp); BEGIN YYINITIAL; }", - "int yywrap(void) { return 1; }" - ] + userDefTokens = + [ "" ++ printRegFlex exp ++ + " \t " ++ ns ++ "yylval._string = strdup(yytext); return " ++ sName name ++ ";" + | (name, exp) <- tokenPragmas cf + ] + where sName n = fromMaybe n $ lookup n env + strStates = --These handle escaped characters in Strings. + [ "\"\\\"\" \t BEGIN STRING;" + , "\\\\ \t BEGIN ESCAPED;" + , "\\\" \t " ++ ns ++ "yylval._string = strdup(YY_PARSED_STRING); YY_BUFFER_RESET(); BEGIN YYINITIAL; return " ++ nsDefine inPackage "_STRING_" ++ ";" + , ". \t YY_BUFFER_APPEND(yytext);" + , "n \t YY_BUFFER_APPEND(\"\\n\"); BEGIN STRING;" + , "\\\" \t YY_BUFFER_APPEND(\"\\\"\"); BEGIN STRING ;" + , "\\\\ \t YY_BUFFER_APPEND(\"\\\\\"); BEGIN STRING;" + , "t \t YY_BUFFER_APPEND(\"\\t\"); BEGIN STRING;" + , ". \t YY_BUFFER_APPEND(yytext); BEGIN STRING;" + ] + chStates = --These handle escaped characters in Chars. + [ "\"'\" \tBEGIN CHAR;" + , "\\\\ \t BEGIN CHARESC;" + , "[^'] \t BEGIN CHAREND; " ++ ns ++ "yylval._char = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";" + , "n \t BEGIN CHAREND; " ++ ns ++ "yylval._char = '\\n'; return " ++ nsDefine inPackage "_CHAR_" ++ ";" + , "t \t BEGIN CHAREND; " ++ ns ++ "yylval._char = '\\t'; return " ++ nsDefine inPackage "_CHAR_" ++ ";" + , ". \t BEGIN CHAREND; " ++ ns ++ "yylval._char = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";" + , "\"'\" \t BEGIN YYINITIAL;" + ] + footer = + [ "void " ++ ns ++ "initialize_lexer(FILE *inp) { yyrestart(inp); BEGIN YYINITIAL; }" + , "int yywrap(void) { return 1; }" + ] -- --------------------------------------------------------------------------- diff --git a/source/src/BNFC/Backend/CPP/STL.hs b/source/src/BNFC/Backend/CPP/STL.hs index 37a75419..386bb140 100644 --- a/source/src/BNFC/Backend/CPP/STL.hs +++ b/source/src/BNFC/Backend/CPP/STL.hs @@ -28,6 +28,7 @@ import BNFC.Utils import BNFC.CF import BNFC.Options import BNFC.Backend.Base +import BNFC.Backend.C.CFtoBisonC (unionBuiltinTokens) import BNFC.Backend.CPP.Makefile import BNFC.Backend.CPP.STL.CFtoSTLAbs import BNFC.Backend.CPP.NoSTL.CFtoFlex @@ -136,38 +137,39 @@ cpptest inPackage cf = def = identCat cat scope = nsScope inPackage -mkHeaderFile inPackage cf cats eps env = unlines - [ - "#ifndef " ++ hdef, - "#define " ++ hdef, - "", - "#include", - "#include", - "", - nsStart inPackage, - concatMap mkForwardDec $ nub $ map normCat cats, - "typedef union", - "{", - " int int_;", - " char char_;", - " double double_;", - " char* string_;", - concatMap mkVar cats ++ "} YYSTYPE;", - "", - concatMap mkFuncs eps, - nsEnd inPackage, - "", - "#define " ++ nsDefine inPackage "_ERROR_" ++ " 258", - mkDefines (259 :: Int) env, - "extern " ++ nsScope inPackage ++ "YYSTYPE " ++ nsString inPackage ++ "yylval;", - "", - "#endif" - ] - where +mkHeaderFile inPackage cf cats eps env = unlines $ concat + [ [ "#ifndef " ++ hdef + , "#define " ++ hdef + , "" + , "#include" + , "#include" + , "" + , nsStart inPackage + ] + , map mkForwardDec $ nub $ map normCat cats + , [ "typedef union" + , "{" + ] + , map (" " ++) unionBuiltinTokens + , concatMap mkVar cats + , [ "} YYSTYPE;" + , "" + ] + , concatMap mkFuncs eps + , [ nsEnd inPackage + , "" + , "#define " ++ nsDefine inPackage "_ERROR_" ++ " 258" + , mkDefines (259 :: Int) env + , "extern " ++ nsScope inPackage ++ "YYSTYPE " ++ nsString inPackage ++ "yylval;" + , "" + , "#endif" + ] + ] + where hdef = nsDefine inPackage "PARSER_HEADER_FILE" - mkForwardDec s = "class " ++ identCat s ++ ";\n" - mkVar s | normCat s == s = " " ++ identCat s ++"*" +++ map toLower (identCat s) ++ "_;\n" - mkVar _ = "" + mkForwardDec s = "class " ++ identCat s ++ ";" + mkVar s | normCat s == s = [ " " ++ identCat s ++"*" +++ map toLower (identCat s) ++ "_;" ] + mkVar _ = [] mkDefines n [] = mkString n mkDefines n ((_,s):ss) = "#define " ++ s +++ show n ++ "\n" ++ mkDefines (n+1) ss -- "nsDefine inPackage s" not needed (see cf2flex::makeSymEnv) mkString n = if isUsedCat cf (TokenCat catString) @@ -185,5 +187,7 @@ mkHeaderFile inPackage cf cats eps env = unlines mkIdent n = if isUsedCat cf (TokenCat catIdent) then "#define " ++ nsDefine inPackage "_IDENT_ " ++ show n ++ "\n" else "" - mkFuncs s = identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(FILE *inp);\n" ++ - identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(const char *str);\n" + mkFuncs s = + [ identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(FILE *inp);" + , identCat (normCat s) ++ "*" +++ "p" ++ identCat s ++ "(const char *str);" + ] diff --git a/source/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs b/source/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs index 71da014b..a3bdd393 100644 --- a/source/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs +++ b/source/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs @@ -46,15 +46,19 @@ -} -module BNFC.Backend.CPP.STL.CFtoBisonSTL (cf2Bison, union) where +module BNFC.Backend.CPP.STL.CFtoBisonSTL + ( cf2Bison + , tokens, union + ) where import Prelude' -import Data.Char (toLower,isUpper) -import Data.List (nub, intercalate) -import Data.Maybe (fromMaybe) +import Data.Char ( isUpper ) +import Data.List ( nub, intercalate ) +import Data.Maybe ( fromMaybe ) -import BNFC.Backend.C.CFtoBisonC (startSymbol) +import BNFC.Backend.C.CFtoBisonC + ( resultName, specialToks, startSymbol, typeName, unionBuiltinTokens, varName ) import BNFC.Backend.CPP.STL.STLUtils import BNFC.Backend.Common.NamedVariables hiding (varName) import BNFC.CF @@ -250,10 +254,10 @@ parseMethod cf inPackage _ cat = unlines $ concat -- >>> union Nothing [foo, ListCat foo] -- %union -- { --- int int_; --- char char_; --- double double_; --- char* string_; +-- int _int; +-- char _char; +-- double _double; +-- char* _string; -- Foo* foo_; -- ListFoo* listfoo_; -- } @@ -267,21 +271,18 @@ parseMethod cf inPackage _ cat = unlines $ concat -- >>> union Nothing [foo, ListCat foo, foo2, ListCat foo2] -- %union -- { --- int int_; --- char char_; --- double double_; --- char* string_; +-- int _int; +-- char _char; +-- double _double; +-- char* _string; -- Foo* foo_; -- ListFoo* listfoo_; -- } union :: Maybe String -> [Cat] -> Doc -union inPackage cats = - "%union" $$ codeblock 2 ( - [ "int int_;" - , "char char_;" - , "double double_;" - , "char* string_;" ] - ++ map mkPointer normCats ) +union inPackage cats = vcat + [ "%union" + , codeblock 2 $ map text unionBuiltinTokens ++ map mkPointer normCats + ] where normCats = nub (map normCat cats) mkPointer s = scope <> text (identCat s) <> "*" <+> text (varName s) <> ";" @@ -298,18 +299,7 @@ declarations cf = concatMap typeNT $ --declares terminal types. tokens :: [UserDef] -> SymEnv -> String tokens user = concatMap $ \ (s, r) -> - concat [ "%token", when (s `elem` user) "", " ", r, " // ", s, "\n" ] - -specialToks :: CF -> String -specialToks cf = concat [ - ifC catString "%token _STRING_\n", - ifC catChar "%token _CHAR_\n", - ifC catInteger "%token _INTEGER_\n", - ifC catDouble "%token _DOUBLE_\n", - ifC catIdent "%token _IDENT_\n" - ] - where - ifC cat s = if isUsedCat cf (TokenCat cat) then s else "" + concat [ "%token", when (s `elem` user) "<_string>", " ", r, " // ", s, "\n" ] --The following functions are a (relatively) straightforward translation --of the ones in CFtoHappy.hs @@ -401,19 +391,3 @@ prRules ((nt, (p, a) : ls):rs) = nt' = identCat nt pr [] = [] pr ((p,a):ls) = unlines [unwords [" |", p, "{ ", a , "}"]] ++ pr ls - ---Some helper functions. -resultName :: String -> String -resultName s = "YY_RESULT_" ++ s ++ "_" - ---slightly stronger than the NamedVariable version. -varName :: Cat -> String -varName = (++ "_") . map toLower . identCat . normCat - -typeName :: String -> String -typeName "Ident" = "_IDENT_" -typeName "String" = "_STRING_" -typeName "Char" = "_CHAR_" -typeName "Integer" = "_INTEGER_" -typeName "Double" = "_DOUBLE_" -typeName x = x