[ #278 ] fixed for CPP: use _int, _string etc in token union

BNFC · Dec 25, 2019 · 16fda75 · 16fda75
1 parent 1f496fa
commit 16fda75
Show file tree

Hide file tree

Showing 7 changed files with 156 additions and 201 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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) "<string_>", " ", r, "    //   ", s, "\n" ]
-
-specialToks :: CF -> String
-specialToks cf = concat [
-  ifC catString "%token<string_> _STRING_\n",
-  ifC catChar "%token<char_> _CHAR_\n",
-  ifC catInteger "%token<int_> _INTEGER_\n",
-  ifC catDouble "%token<double_> _DOUBLE_\n",
-  ifC catIdent "%token<string_> _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
@@ -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 ("<YYINITIAL>{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)?      \t " ++ ns ++ "yylval.double_ = atof(yytext); return " ++ nsDefine inPackage "_DOUBLE_" ++ ";\n"),
-   ifC catInteger ("<YYINITIAL>{DIGIT}+      \t " ++ ns ++ "yylval.int_ = atoi(yytext); return " ++ nsDefine inPackage "_INTEGER_" ++ ";\n"),
-   ifC catIdent ("<YYINITIAL>{LETTER}{IDENT}*      \t " ++ ns ++ "yylval.string_ = strdup(yytext); return " ++ nsDefine inPackage "_IDENT_" ++ ";\n"),
-   "\\n  ++" ++ ns ++ "yy_mylinenumber ;\n",
-   "<YYINITIAL>[ \\t\\r\\n\\f]      \t /* ignore white space. */;\n",
-   "<YYINITIAL>.      \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  [ "<YYINITIAL>{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)?      \t " ++ ns ++ "yylval._double = atof(yytext); return " ++ nsDefine inPackage "_DOUBLE_" ++ ";" ]
+  , ifC catInteger [ "<YYINITIAL>{DIGIT}+      \t " ++ ns ++ "yylval._int = atoi(yytext); return " ++ nsDefine inPackage "_INTEGER_" ++ ";" ]
+  , ifC catIdent   [ "<YYINITIAL>{LETTER}{IDENT}*      \t " ++ ns ++ "yylval._string = strdup(yytext); return " ++ nsDefine inPackage "_IDENT_" ++ ";" ]
+  , [ "\\n  ++" ++ ns ++ "yy_mylinenumber ;"
+    , "<YYINITIAL>[ \\t\\r\\n\\f]      \t /* ignore white space. */;"
+    , "<YYINITIAL>.      \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 $
-     ["<YYINITIAL>" ++ 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.
-    [
-     "<YYINITIAL>\"\\\"\"      \t BEGIN STRING;",
-     "<STRING>\\\\      \t BEGIN ESCAPED;",
-     "<STRING>\\\"      \t " ++ ns ++ "yylval.string_ = strdup(YY_PARSED_STRING); YY_BUFFER_RESET(); BEGIN YYINITIAL; return " ++ nsDefine inPackage "_STRING_" ++ ";",
-     "<STRING>.      \t YY_BUFFER_APPEND(yytext);",
-     "<ESCAPED>n      \t YY_BUFFER_APPEND(\"\\n\"); BEGIN STRING;",
-     "<ESCAPED>\\\"      \t YY_BUFFER_APPEND(\"\\\"\"); BEGIN STRING ;",
-     "<ESCAPED>\\\\      \t YY_BUFFER_APPEND(\"\\\\\"); BEGIN STRING;",
-     "<ESCAPED>t       \t YY_BUFFER_APPEND(\"\\t\"); BEGIN STRING;",
-     "<ESCAPED>.       \t YY_BUFFER_APPEND(yytext); BEGIN STRING;"
-    ]
-   chStates = unlines --These handle escaped characters in Chars.
-    [
-     "<YYINITIAL>\"'\" \tBEGIN CHAR;",
-     "<CHAR>\\\\      \t BEGIN CHARESC;",
-     "<CHAR>[^']      \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";",
-     "<CHARESC>n      \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = '\\n'; return " ++ nsDefine inPackage "_CHAR_" ++ ";",
-     "<CHARESC>t      \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = '\\t'; return " ++ nsDefine inPackage "_CHAR_" ++ ";",
-     "<CHARESC>.      \t BEGIN CHAREND; " ++ ns ++ "yylval.char_ = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";",
-     "<CHAREND>\"'\"      \t BEGIN YYINITIAL;"
-    ]
-   footer = unlines
-    [
-     "void " ++ ns ++ "initialize_lexer(FILE *inp) { yyrestart(inp); BEGIN YYINITIAL; }",
-     "int yywrap(void) { return 1; }"
-    ]
+   userDefTokens =
+     [ "<YYINITIAL>" ++ 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.
+     [ "<YYINITIAL>\"\\\"\"      \t BEGIN STRING;"
+     , "<STRING>\\\\      \t BEGIN ESCAPED;"
+     , "<STRING>\\\"      \t " ++ ns ++ "yylval._string = strdup(YY_PARSED_STRING); YY_BUFFER_RESET(); BEGIN YYINITIAL; return " ++ nsDefine inPackage "_STRING_" ++ ";"
+     , "<STRING>.      \t YY_BUFFER_APPEND(yytext);"
+     , "<ESCAPED>n      \t YY_BUFFER_APPEND(\"\\n\"); BEGIN STRING;"
+     , "<ESCAPED>\\\"      \t YY_BUFFER_APPEND(\"\\\"\"); BEGIN STRING ;"
+     , "<ESCAPED>\\\\      \t YY_BUFFER_APPEND(\"\\\\\"); BEGIN STRING;"
+     , "<ESCAPED>t       \t YY_BUFFER_APPEND(\"\\t\"); BEGIN STRING;"
+     , "<ESCAPED>.       \t YY_BUFFER_APPEND(yytext); BEGIN STRING;"
+     ]
+   chStates = --These handle escaped characters in Chars.
+     [ "<YYINITIAL>\"'\" \tBEGIN CHAR;"
+     , "<CHAR>\\\\      \t BEGIN CHARESC;"
+     , "<CHAR>[^']      \t BEGIN CHAREND; " ++ ns ++ "yylval._char = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";"
+     , "<CHARESC>n      \t BEGIN CHAREND; " ++ ns ++ "yylval._char = '\\n'; return " ++ nsDefine inPackage "_CHAR_" ++ ";"
+     , "<CHARESC>t      \t BEGIN CHAREND; " ++ ns ++ "yylval._char = '\\t'; return " ++ nsDefine inPackage "_CHAR_" ++ ";"
+     , "<CHARESC>.      \t BEGIN CHAREND; " ++ ns ++ "yylval._char = yytext[0]; return " ++ nsDefine inPackage "_CHAR_" ++ ";"
+     , "<CHAREND>\"'\"      \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
@@ -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<vector>",
-  "#include<string>",
-  "",
-  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<vector>"
+    , "#include<string>"
+    , ""
+    , 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);"
+    ]