Improved C backend and added line number option

source/BNFC.cabal

@@ -143,17 +143,17 @@ Executable bnfc
     BNFC.Backend.C.CFtoBisonC,
     BNFC.Backend.C.CFtoFlexC,
     BNFC.Backend.C.CFtoCAbs,
-    BNFC.Backend.CPP.NoSTL.CFtoCVisitSkel,
+    BNFC.Backend.C.RegToFlex,
 
     -- C++ backend
     BNFC.Backend.CPP.PrettyPrinter,
     BNFC.Backend.CPP.Makefile,
     BNFC.Backend.CPP.Naming,
     BNFC.Backend.CPP.NoSTL,
-    BNFC.Backend.CPP.NoSTL.RegToFlex,
     BNFC.Backend.CPP.NoSTL.CFtoFlex,
     BNFC.Backend.CPP.NoSTL.CFtoBison,
     BNFC.Backend.CPP.NoSTL.CFtoCPPAbs,
+    BNFC.Backend.CPP.NoSTL.CFtoCVisitSkel,
 
     -- C++ STL backend
     BNFC.Backend.CPP.STL,

source/src/BNFC/Backend/C.hs

@@ -37,14 +37,14 @@ import qualified BNFC.Backend.Common.Makefile as Makefile
 
 makeC :: SharedOptions -> CF -> MkFiles ()
 makeC opts cf = do
-    let (hfile, cfile) = cf2CAbs prefix cf
+    let (hfile, cfile) = cf2CAbs (linenumbers opts) prefix cf
     mkfile "Absyn.h" hfile
     mkfile "Absyn.c" cfile
     let (flex, env) = cf2flex prefix cf
     mkfile (name ++ ".l") flex
-    let bison = cf2Bison prefix cf env
+    let bison = cf2Bison (linenumbers opts) prefix cf env
     mkfile (name ++ ".y") bison
-    let header = mkHeaderFile cf (allCats cf) (allEntryPoints cf) env
+    let header = mkHeaderFile (linenumbers opts) cf (allCats cf) (allEntryPoints cf) env
     mkfile "Parser.h" header
     let (skelH, skelC) = cf2CSkel cf
     mkfile "Skeleton.h" skelH
@@ -189,8 +189,8 @@ ctest cf =
   where
    def = show $ head (allEntryPoints cf)
 
-mkHeaderFile :: CF -> [Cat] -> [Cat] -> [(a, String)] -> String
-mkHeaderFile cf cats eps env = unlines
+mkHeaderFile :: RecordPositions -> CF -> [Cat] -> [Cat] -> [(a, String)] -> String
+mkHeaderFile _ cf cats eps env = unlines
  [
   "#ifndef PARSER_HEADER_FILE",
   "#define PARSER_HEADER_FILE",
@@ -205,8 +205,17 @@ mkHeaderFile cf cats eps env = unlines
   "  char* string_;",
   concatMap mkVar cats ++ "} YYSTYPE;",
   "",
+  -- https://www.gnu.org/software/bison/manual/html_node/Location-Type.html#Location-Type
+  "typedef struct YYLTYPE",
+  "{",
+  "  int first_line;",
+  "  int first_column;",
+  "  int last_line;",
+  "  int last_column;",
+  "} YYLTYPE;",
   "#define _ERROR_ 258",
   mkDefines (259::Int) env,
+  "extern YYLTYPE yylloc;",
   "extern YYSTYPE yylval;",
   concatMap mkFunc eps,
   "",
@@ -232,6 +241,7 @@ mkHeaderFile cf cats eps env = unlines
   mkIdent n =  if isUsedCat cf catIdent
    then ("#define _IDENT_ " ++ show n ++ "\n")
    else ""
-  mkFunc s | normCat s == s = identCat s ++ " p" ++ identCat s ++ "(FILE *inp);\n"
+  mkFunc s | normCat s == s = identCat s +++ " p" ++ identCat s ++ "(FILE *inp);\n" ++
+                              identCat s +++ "ps" ++ identCat s ++ "(const char *str);\n"
   mkFunc _ = ""
 

source/src/BNFC/Backend/C/CFtoBisonC.hs

@@ -42,6 +42,7 @@
 module BNFC.Backend.C.CFtoBisonC (cf2Bison, startSymbol) where
 
 import BNFC.CF
+import BNFC.Options (RecordPositions(..))
 import Data.List (intercalate)
 import Data.Maybe (fromMaybe)
 import BNFC.Backend.Common.NamedVariables hiding (varName)
@@ -57,8 +58,8 @@ type Action      = String
 type MetaVar     = String
 
 --The environment comes from the CFtoFlex
-cf2Bison :: String -> CF -> SymEnv -> String
-cf2Bison name cf env
+cf2Bison :: RecordPositions -> String -> CF -> SymEnv -> String
+cf2Bison rp name cf env
  = unlines
     [header name cf,
      union (allCatsNorm cf),
@@ -68,50 +69,77 @@ cf2Bison name cf env
      specialToks cf,
      startSymbol cf,
      "%%",
-     prRules (rulesForBison cf env)
+     prRules (rulesForBison rp cf env),
+     errorHandler name
     ]
   where
    user = fst (unzip (tokenPragmas cf))
 
 header :: String -> CF -> String
 header name cf = unlines
          ["/* This Bison file was machine-generated by BNFC */",
+          "%locations",
           "%{",
           "#include <stdlib.h>",
           "#include <stdio.h>",
           "#include <string.h>",
           "#include \"Absyn.h\"",
-          "#define initialize_lexer " ++ name ++ "_initialize_lexer",
+          "typedef struct " ++ name ++ "_buffer_state *YY_BUFFER_STATE;",
+          "YY_BUFFER_STATE " ++ name ++ "_scan_string(const char *str);",
+          "void " ++ name ++ "_delete_buffer(YY_BUFFER_STATE buf);",
           "extern int yyparse(void);",
           "extern int yylex(void);",
-          "int yy_mylinenumber;", 
-          "extern int initialize_lexer(FILE * inp);",
-          "void yyerror(const char *str)",
-          "{",
-          "  extern char *" ++ name ++ "text;", 
-          "  fprintf(stderr,\"error: line %d: %s at %s\\n\",",
-          "    yy_mylinenumber + 1, str, " ++ name ++ "text);",
-          "}",
+          "extern int " ++ name ++ "_init_lexer(FILE * inp);",
+          -- this must be deferred until yylloc is defined
+          "extern void yyerror(const char *str);",
           "",
           -- M.F. 2004-09-17 changed allEntryPoints to allCatsIdNorm. Seems to fix the [Ty2] bug.
-          unlines $ map parseMethod (allCatsNorm cf), -- (allEntryPoints cf),
+          unlines $ map (parseMethod name) (allCatsNorm cf), -- (allEntryPoints cf),
           concatMap reverseList (filter isList (allCatsNorm cf)),
           "%}"
           ]
 
+errorHandler :: String -> String
+errorHandler name = unlines
+          ["%%",
+          "void yyerror(const char *str)",
+          "{",
+          "  extern char *" ++ name ++ "text;",
+          "  fprintf(stderr,\"error: %d,%d: %s at %s\\n\",",
+          "  " ++ name ++ "lloc.first_line, " ++ name ++ "lloc.first_column, str, " ++ name ++ "text);",
+          "}"
+          ]
+
 --This generates a parser method for each entry point.
-parseMethod :: Cat -> String
-parseMethod cat =
+parseMethod :: String -> Cat -> String
+parseMethod name cat =
 --  if normCat cat /= cat      M.F. 2004-09-17 comment. No duplicates from allCatsIdNorm
 --  then ""
 --  else
   unlines
   [
-   cat' +++ resultName cat' +++ "= 0;",
+   "static " ++ cat' +++ resultName cat' +++ "= 0;",
    cat' ++ " p" ++ cat' ++ "(FILE *inp)",
    "{",
-   "  initialize_lexer(inp);",
-   "  if (yyparse())",
+   "  " ++ name ++ "_init_lexer(inp);",
+   "  int result = yyparse();",
+   "  if (result)",
+   "  { /* Failure */",
+   "    return 0;",
+   "  }",
+   "  else",
+   "  { /* Success */",
+   "    return" +++ resultName cat' ++ ";",
+   "  }",
+   "}",
+   cat' ++ " ps" ++ cat' ++ "(const char *str)",
+   "{",
+   "  YY_BUFFER_STATE buf;",
+   "  " ++ name ++ "_init_lexer(0);",
+   "  buf = " ++ name ++ "_scan_string(str);",
+   "  int result = yyparse();",
+   "  " ++ name ++ "_delete_buffer(buf);",
+   "  if (result)",
    "  { /* Failure */",
    "    return 0;",
    "  }",
@@ -175,12 +203,23 @@ declarations cf = concatMap (typeNT cf) (allCats cf)
    typeNT _ _ = ""
 
 --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] -> SymEnv -> String
 tokens user = concatMap (declTok user)
  where
   declTok u (s,r) = if s `elem` map show u
-    then "%token<string_> " ++ r ++ "    /*   " ++ s ++ "   */\n"
-    else "%token " ++ r ++ "    /*   " ++ s ++ "   */\n"
+    then "%token<string_> " ++ r ++ "    \"" ++ cStringEscape s ++ "\"\n"
+    else "%token " ++ r ++ "    \"" ++ cStringEscape s ++ "\"\n"
+
+-- escape characters inside a c string
+cStringEscape :: String -> String
+cStringEscape = concatMap escChar
+  where
+    escChar c
+      | c `elem` ("\"\\" :: String) = '\\':[c]
+      | otherwise = [c]
 
 specialToks :: CF -> String
 specialToks cf = concat [
@@ -198,13 +237,13 @@ startSymbol cf = "%start" +++ identCat (firstEntry cf)
 
 --The following functions are a (relatively) straightforward translation
 --of the ones in CFtoHappy.hs
-rulesForBison :: CF -> SymEnv -> Rules
-rulesForBison cf env = map mkOne $ ruleGroups cf where
-  mkOne (cat,rules) = constructRule cf env rules cat
+rulesForBison :: RecordPositions -> CF -> SymEnv -> Rules
+rulesForBison rp cf env = map mkOne $ ruleGroups cf where
+  mkOne (cat,rules) = constructRule rp cf env rules cat
 
 -- For every non-terminal, we construct a set of rules.
-constructRule :: CF -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)])
-constructRule cf env rules nt = (nt,[(p, generateAction (identCat (normCat nt)) (funRule r) b m +++ result) |
+constructRule :: RecordPositions -> CF -> SymEnv -> [Rule] -> NonTerminal -> (NonTerminal,[(Pattern,Action)])
+constructRule rp cf env rules nt = (nt,[(p, generateAction rp (identCat (normCat nt)) (funRule r) b m +++ result) |
      r0 <- rules,
      let (b,r) = if isConsFun (funRule r0) && elem (valCat r0) revs
                    then (True,revSepListRule r0)
@@ -217,27 +256,28 @@ constructRule cf env rules nt = (nt,[(p, generateAction (identCat (normCat nt))
    result = if isEntry nt then resultName (identCat (normCat nt)) ++ "= $$;" else ""
 
 -- | Generates a string containing the semantic action.
--- >>> generateAction "Foo" "Bar" False ["$1"]
+-- >>> generateAction NoRecordPositions "Foo" "Bar" False ["$1"]
 -- "make_Bar($1);"
--- >>> generateAction "Foo" "_" False ["$1"]
+-- >>> generateAction NoRecordPositions "Foo" "_" False ["$1"]
 -- "$1;"
--- >>> generateAction "ListFoo" "[]" False []
+-- >>> generateAction NoRecordPositions "ListFoo" "[]" False []
 -- "0;"
--- >>> generateAction "ListFoo" "(:[])" False ["$1"]
+-- >>> generateAction NoRecordPositions "ListFoo" "(:[])" False ["$1"]
 -- "make_ListFoo($1, 0);"
--- >>> generateAction "ListFoo" "(:)" False ["$1","$2"]
+-- >>> generateAction NoRecordPositions "ListFoo" "(:)" False ["$1","$2"]
 -- "make_ListFoo($1, $2);"
--- >>> generateAction "ListFoo" "(:)" True ["$1","$2"]
+-- >>> generateAction NoRecordPositions "ListFoo" "(:)" True ["$1","$2"]
 -- "make_ListFoo($2, $1);"
-generateAction :: String -> Fun -> Bool -> [MetaVar] -> Action
-generateAction nt f b ms 
-  | isCoercion f = unwords ms ++ ";"
+generateAction :: RecordPositions -> String -> Fun -> Bool -> [MetaVar] -> Action
+generateAction rp nt f b ms
+  | isCoercion f = unwords ms ++ ";" ++ loc
   | isNilFun f   = "0;"
   | isOneFun f   = concat ["make_", nt, "(", intercalate ", " ms', ", 0);"]
   | isConsFun f  = concat ["make_", nt, "(", intercalate ", " ms', ");"]
-  | otherwise    = concat ["make_", f, "(", intercalate ", " ms', ");"]
+  | otherwise    = concat ["make_", f, "(", intercalate ", " ms', ");", loc]
  where
   ms' = if b then reverse ms else ms
+  loc = if rp == RecordPositions then " $$->line_number = @$.first_line; $$->char_number = @$.first_column;" else ""
 
 -- Generate patterns and a set of metavariables indicating
 -- where in the pattern the non-terminal

source/src/BNFC/Backend/C/CFtoCAbs.hs

@@ -47,22 +47,23 @@ import Prelude'
 import BNFC.CF
 import BNFC.PrettyPrint
 import BNFC.Utils((+++))
+import BNFC.Options (RecordPositions(..))
 import BNFC.Backend.Common.NamedVariables
 import Data.Function (on)
 import Data.List
 import Data.Char(toLower)
 
 
 --The result is two files (.H file, .C file)
-cf2CAbs :: String -> CF -> (String, String)
-cf2CAbs _ cf = (mkHFile cf, mkCFile cf)
+cf2CAbs :: RecordPositions -> String -> CF -> (String, String)
+cf2CAbs rp _ cf = (mkHFile rp cf, mkCFile cf)
 
 
 {- **** Header (.H) File Functions **** -}
 
 --Makes the Header file.
-mkHFile :: CF -> String
-mkHFile cf = unlines
+mkHFile :: RecordPositions -> CF -> String
+mkHFile rp cf = unlines
  [
   "#ifndef ABSYN_HEADER",
   "#define ABSYN_HEADER",
@@ -73,7 +74,7 @@ mkHFile cf = unlines
   concatMap prForward classes,
   "",
   "/********************   Abstract Syntax Classes    ********************/\n",
-  concatMap prDataH (getAbstractSyntax cf),
+  concatMap (prDataH rp) (getAbstractSyntax cf),
   "",
   "#endif"
  ]
@@ -98,8 +99,8 @@ mkHFile cf = unlines
    else "_"
 
 -- | Prints struct definitions for all categories.
-prDataH :: Data -> String
-prDataH (cat, rules) =
+prDataH :: RecordPositions -> Data -> String
+prDataH rp (cat, rules) =
    if isList cat
       then unlines
        [
@@ -114,8 +115,8 @@ prDataH (cat, rules) =
       else unlines
        [
         "struct " ++ show cat ++ "_",
-
         "{",
+        if rp == RecordPositions then "  int line_number, char_number;" else "",
         "  enum { " ++ intercalate ", " (map prKind rules) ++ " } kind;",
         "  union",
         "  {",

source/src/BNFC/Backend/C/CFtoCPrinter.hs

@@ -375,9 +375,9 @@ prPrintData (cat, rules) = unlines $
  ] --Not a list:
  else
  [
-   "void pp" ++ cl ++ "(" ++ cl ++ " _p_, int _i_)",
+   "void pp" ++ cl ++ "(" ++ cl ++ " p, int _i_)",
    "{",
-   "  switch(_p_->kind)",
+   "  switch(p->kind)",
    "  {",
    concatMap prPrintRule rules,
    "  default:",
@@ -433,9 +433,9 @@ prPrintRule _ = ""
 prPrintCat :: String -> Either (Cat, Doc) String -> String
 prPrintCat fnm (c) = case c of
   Right t -> "    " ++ render (renderX t) ++ ";\n"
-  Left (cat, nt) | isTokenCat cat -> "    pp" ++ basicFunName (render nt) ++ "(_p_->u." ++ v ++ "_." ++ render nt ++ ", " ++ show (precCat cat) ++ ");\n"
+  Left (cat, nt) | isTokenCat cat -> "    pp" ++ basicFunName (render nt) ++ "(p->u." ++ v ++ "_." ++ render nt ++ ", " ++ show (precCat cat) ++ ");\n"
   Left (InternalCat, _) -> "    /* Internal Category */\n"
-  Left (cat, nt) -> "    pp" ++ identCat (normCat cat) ++ "(_p_->u." ++ v ++ "_." ++ render nt ++ ", " ++ show (precCat cat) ++ ");\n"
+  Left (cat, nt) -> "    pp" ++ identCat (normCat cat) ++ "(p->u." ++ v ++ "_." ++ render nt ++ ", " ++ show (precCat cat) ++ ");\n"
  where
   v = map toLower (normFun fnm)
 
@@ -488,9 +488,9 @@ prShowData (cat, rules) = unlines $
  ] -- Not a list:
  else
  [
-   "void sh" ++ cl ++ "(" ++ cl ++ " _p_)",
+   "void sh" ++ cl ++ "(" ++ cl ++ " p)",
    "{",
-   "  switch(_p_->kind)",
+   "  switch(p->kind)",
    "  {",
    concatMap prShowRule rules,
    "  default:",
@@ -541,10 +541,10 @@ prShowRule _ = ""
 prShowCat :: Fun -> (Cat, Doc) -> String
 prShowCat fnm c = case c of
     (cat,nt) | isTokenCat cat ->
-        "    sh" ++ basicFunName (render nt) ++ "(_p_->u." ++ v ++ "_." ++ render nt ++ ");\n"
+        "    sh" ++ basicFunName (render nt) ++ "(p->u." ++ v ++ "_." ++ render nt ++ ");\n"
     (InternalCat, _) -> "    /* Internal Category */\n"
     (cat,nt) ->
-        "    sh" ++ identCat (normCat cat) ++ "(_p_->u." ++ v ++ "_." ++ render nt ++ ");\n"
+        "    sh" ++ identCat (normCat cat) ++ "(p->u." ++ v ++ "_." ++ render nt ++ ");\n"
   where v = map toLower (normFun fnm)
 
 {- **** Helper Functions Section **** -}