[ #287 ] fixed for C++: defined constructors now in Absyn module

source/BNFC.cabal

@@ -216,6 +216,7 @@ library
     BNFC.Backend.C.RegToFlex
 
     -- C++ backend
+    BNFC.Backend.CPP.Common
     BNFC.Backend.CPP.PrettyPrinter
     BNFC.Backend.CPP.Makefile
     BNFC.Backend.CPP.Naming

source/CHANGELOG.md

@@ -5,6 +5,7 @@ Andreas Abel <andreas.abel@gu.se>  (unreleased)
 * Haskell: fixes in layout preprocessor [#343,#344,#345]
 * C: fixed a space leak when parsing from a string in memory [#347]
 * C: new methods `free*` to deallocate syntax trees [#348]
+* C++: `define`d constructors now reside in `Absyn` [#287]
 * Ocaml: fixed translation of nested `define`d constructors
 
 # 2.9.1

source/src/BNFC/Backend/CPP/Common.hs

@@ -0,0 +1,67 @@
+-- | Common to the C++ backends.
+
+module BNFC.Backend.CPP.Common where
+
+import Data.Char  ( isUpper )
+import Data.List  ( nub, intercalate )
+
+import BNFC.CF
+import BNFC.TypeChecker
+
+-- | C++ code for the @define@d constructors.
+
+definedRules :: Bool -> CF -> String -> String
+definedRules onlyHeader cf banner
+  | null theLines = []
+  | otherwise     = unlines $ banner : "" : theLines
+  where
+    theLines = [ rule f xs e | FunDef f xs e <- cfgPragmas cf ]
+
+    ctx = buildContext cf
+
+    list = LC (const "[]") (\ t -> "List" ++ unBase t)
+      where
+        unBase (ListT t) = unBase t
+        unBase (BaseT x) = show $ normCat $ strToCat x
+
+    rule f xs e =
+      case runTypeChecker $ checkDefinition' list ctx f xs e of
+        Left err -> error $ "Panic! This should have been caught already:\n" ++ err
+        Right (args,(e',t))
+          | onlyHeader -> header ++ ";"
+          | otherwise  -> unlines
+            [ header ++ " {"
+            , "  return " ++ cppExp (map fst args) e' ++ ";"
+            , "}"
+            ]
+         where
+         header = cppType t ++ " " ++ funName f ++ "(" ++
+                  intercalate ", " (map cppArg args) ++ ")"
+      where
+        cppType :: Base -> String
+        cppType (ListT (BaseT x)) = "List" ++ show (normCat $ strToCat x) ++ "*"
+        cppType (ListT t)         = cppType t ++ "*"
+        cppType (BaseT x)
+            | x `elem` baseTokenCatNames = x
+            | isToken x ctx = "String"
+            | otherwise     = show (normCat $ strToCat x) ++ "*"
+
+        cppArg :: (String, Base) -> String
+        cppArg (x,t) = cppType t ++ " " ++ x ++ "_"
+
+        cppExp :: [String] -> Exp -> String
+        cppExp args = \case
+            App "[]" []    -> "0"
+            Var x          -> x ++ "_"  -- argument
+            App t [e]
+              | isToken t ctx    -> cppExp args e
+            App x es
+              | isUpper (head x) -> call ("new " ++ x) es
+              | x `elem` args    -> call (x ++ "_") es
+              | otherwise        -> call x es
+            LitInt n       -> show n
+            LitDouble x    -> show x
+            LitChar c      -> show c
+            LitString s    -> show s
+          where
+          call x es = x ++ "(" ++ intercalate ", " (map (cppExp args) es) ++ ")"

source/src/BNFC/Backend/CPP/NoSTL/CFtoBison.hs

@@ -25,7 +25,7 @@ import BNFC.CF
 import BNFC.Backend.Common.NamedVariables hiding (varName)
 import BNFC.Backend.C.CFtoBisonC
   ( resultName, specialToks, startSymbol, typeName, varName )
-import BNFC.Backend.CPP.STL.CFtoBisonSTL ( tokens, union, definedRules )
+import BNFC.Backend.CPP.STL.CFtoBisonSTL ( tokens, union )
 import BNFC.PrettyPrint
 import BNFC.Utils ( (+++) )
 
@@ -80,7 +80,6 @@ header name cf = unlines
     , "    yy_mylinenumber + 1, str, yytext);"
     , "}"
     , ""
-    , definedRules cf
     , concatMap reverseList $ filter isList $ allParserCatsNorm cf
     , unlines $ map parseResult dats
     , unlines $ map (parseMethod cf name) eps
@@ -190,7 +189,7 @@ generateAction f b ms =
   else if f == "[]"
   then "0;"
   else if isDefinedRule f
-  then concat [ f, "_", "(", concat $ intersperse ", " ms', ");" ]
+  then concat [ f, "(", concat $ intersperse ", " ms', ");" ]
   else concat ["new ", f, "(", (concat (intersperse ", " ms')), ");"]
  where
   ms' = if b then reverse ms else ms

source/src/BNFC/Backend/CPP/NoSTL/CFtoCPPAbs.hs

@@ -18,13 +18,15 @@ module BNFC.Backend.CPP.NoSTL.CFtoCPPAbs (cf2CPPAbs) where
 
 import Prelude hiding ((<>))
 
+import Data.List  ( findIndices, intersperse )
+import Data.Char  ( toLower )
+import Text.PrettyPrint
+
 import BNFC.CF
-import BNFC.Utils((+++),(++++))
+import BNFC.Utils ( (+++), (++++) )
 import BNFC.Backend.Common.NamedVariables
 import BNFC.Backend.Common.OOAbstract
-import Data.List
-import Data.Char(toLower)
-import Text.PrettyPrint
+import BNFC.Backend.CPP.Common
 
 
 --The result is two files (.H file, .C file)
@@ -52,6 +54,9 @@ mkHFile cf = unlines
   "/********************   Abstract Syntax Classes    ********************/\n",
   concatMap (prDataH user) (getAbstractSyntax cf),
   "",
+  definedRules True cf
+  "/********************   Defined Constructors    ********************/",
+  "",
   "#endif"
  ]
  where
@@ -218,7 +223,9 @@ mkCFile :: CF -> String
 mkCFile cf = unlines
  [
   header,
-  concatMap (prDataC user) (getAbstractSyntax cf)
+  concatMap (prDataC user) (getAbstractSyntax cf),
+  definedRules False cf
+  "/********************   Defined Constructors    ********************/"
  ]
  where
   user = fst (unzip (tokenPragmas cf))

source/src/BNFC/Backend/CPP/STL/CFtoBisonSTL.hs

@@ -24,7 +24,6 @@
 module BNFC.Backend.CPP.STL.CFtoBisonSTL
   ( cf2Bison
   , tokens, union
-  , definedRules
   ) where
 
 import Prelude hiding ((<>))
@@ -42,7 +41,6 @@ import BNFC.Backend.Common.NamedVariables hiding (varName)
 import BNFC.CF
 import BNFC.Options (RecordPositions(..))
 import BNFC.PrettyPrint
-import BNFC.TypeChecker
 import BNFC.Utils ((+++), when)
 
 --This follows the basic structure of CFtoHappy.
@@ -104,7 +102,6 @@ header inPackage name cf = unlines
     , "}"
     , ""
     , nsStart inPackage
-    , definedRules cf
     , unlines $ map parseResult dats
     , unlines $ map (parseMethod cf inPackage name) eps
     , nsEnd inPackage
@@ -115,53 +112,6 @@ header inPackage name cf = unlines
     eps  = toList (allEntryPoints cf) ++ map TokenCat (positionCats cf)
     dats = nub $ map normCat eps
 
-definedRules :: CF -> String
-definedRules cf =
-    unlines [ rule f xs e | FunDef f xs e <- cfgPragmas cf ]
-  where
-    ctx = buildContext cf
-
-    list = LC (const "[]") (\ t -> "List" ++ unBase t)
-      where
-        unBase (ListT t) = unBase t
-        unBase (BaseT x) = show $ normCat $ strToCat x
-
-    rule f xs e =
-        case runTypeChecker $ checkDefinition' list ctx f xs e of
-        Left err -> error $ "Panic! This should have been caught already:\n" ++ err
-        Right (args,(e',t)) -> unlines
-            [ cppType t ++ " " ++ funName f ++ "_ (" ++
-                intercalate ", " (map cppArg args) ++ ") {"
-            , "  return " ++ cppExp e' ++ ";"
-            , "}"
-            ]
-      where
-        cppType :: Base -> String
-        cppType (ListT (BaseT x)) = "List" ++ show (normCat $ strToCat x) ++ " *"
-        cppType (ListT t)         = cppType t ++ " *"
-        cppType (BaseT x)
-            | x `elem` baseTokenCatNames = x
-            | isToken x ctx = "String"
-            | otherwise     = show (normCat $ strToCat x) ++ " *"
-
-        cppArg :: (String, Base) -> String
-        cppArg (x,t) = cppType t ++ " " ++ x ++ "_"
-
-        cppExp :: Exp -> String
-        cppExp (App "[]" [])    = "0"
-        cppExp (Var x)          = x ++ "_"  -- argument
-        cppExp (App t [e])
-            | isToken t ctx     = cppExp e
-        cppExp (App x es)
-            | isUpper (head x)  = call ("new " ++ x) es
-            | otherwise         = call (x ++ "_") es
-        cppExp (LitInt n)       = show n
-        cppExp (LitDouble x)    = show x
-        cppExp (LitChar c)      = show c
-        cppExp (LitString s)    = show s
-
-        call x es = x ++ "(" ++ intercalate ", " (map cppExp es) ++ ")"
-
 
 -- | Generates declaration and initialization of the @YY_RESULT@ for a parser.
 --
@@ -331,7 +281,7 @@ generateAction rp inPackage cat f b mbs =
   else if f == "(:)"
   then lastms ++ "->push_back(" ++ head ms ++ ") ; $$ = " ++ lastms ++ " ;" ---- not left rec
   else if isDefinedRule f
-  then concat ["$$ = ", scope, f, "_", "(", intercalate ", " ms, ");" ]
+  then concat ["$$ = ", scope, f, "(", intercalate ", " ms, ");" ]
   else concat
     ["$$ = ", "new ", scope, f, "(", intercalate ", " ms, ");" ++ addLn rp]
  where

source/src/BNFC/Backend/CPP/STL/CFtoSTLAbs.hs

@@ -21,21 +21,22 @@ import BNFC.CF
 import BNFC.Options (RecordPositions(..))
 import BNFC.Utils((+++))
 import Data.List
+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, mkCFile inPackage cab)
+cf2CPPAbs rp inPackage _ cf = (mkHFile rp inPackage cab cf, mkCFile inPackage cab cf)
   where
     cab = cf2cabs cf
 
 
 -- **** Header (.H) File Functions **** --
 
 --Makes the Header file.
-mkHFile :: RecordPositions -> Maybe String -> CAbs -> String
-mkHFile rp inPackage cf = unlines
+mkHFile :: RecordPositions -> Maybe String -> CAbs -> CF -> String
+mkHFile rp inPackage cabs cf = unlines
  [
   "#ifndef " ++ hdef,
   "#define " ++ hdef,
@@ -49,29 +50,32 @@ mkHFile rp inPackage cf = unlines
   "",
   unlines ["typedef " ++ d ++ " " ++ c ++ ";" | (c,d) <- basetypes],
   "",
-  unlines ["typedef std::string " ++ s ++ ";" | s <- tokentypes cf],
+  unlines ["typedef std::string " ++ s ++ ";" | s <- tokentypes cabs],
   "",
   "/********************   Forward Declarations    ********************/",
   "",
-  unlines ["class " ++ c ++ ";" | c <- classes, notElem c (defineds cf)],
+  unlines ["class " ++ c ++ ";" | c <- classes, notElem c (defineds cabs)],
   "",
   "/********************   Visitor Interfaces    ********************/",
-  prVisitor cf,
+  prVisitor cabs,
   "",
   prVisitable,
   "",
   "/********************   Abstract Syntax Classes    ********************/",
   "",
-  unlines [prAbs rp c | c <- absclasses cf],
+  unlines [prAbs rp c | c <- absclasses cabs],
   "",
-  unlines [prCon (c,r) | (c,rs) <- signatures cf, r <- rs],
+  unlines [prCon (c,r) | (c,rs) <- signatures cabs, r <- rs],
   "",
-  unlines [prList c | c <- listtypes cf],
+  unlines [prList c | c <- listtypes cabs],
+  "",
+  definedRules True cf
+  "/********************   Defined Constructors    ********************/",
   nsEnd inPackage,
   "#endif"
  ]
  where
-  classes = allClasses cf
+  classes = allClasses cabs
   hdef = nsDefine inPackage "ABSYN_HEADER"
 
 -- auxiliaries
@@ -148,16 +152,18 @@ prList (c,b) = unlines [
 
 -- **** Implementation (.C) File Functions **** --
 
-mkCFile :: Maybe String -> CAbs -> String
-mkCFile inPackage cf = unlines $ [
+mkCFile :: Maybe String -> CAbs -> CF -> String
+mkCFile inPackage cabs cf = unlines $ [
   "//C++ Abstract Syntax Implementation generated by the BNF Converter.",
   "#include <algorithm>",
   "#include <string>",
   "#include <vector>",
   "#include \"Absyn.H\"",
   nsStart inPackage,
-  unlines [prConC  r | (_,rs) <- signatures cf, r <- rs],
-  unlines [prListC c | (c,_) <- listtypes cf],
+  unlines [prConC  r | (_,rs) <- signatures cabs, r <- rs],
+  unlines [prListC c | (c,_) <- listtypes cabs],
+  definedRules False cf
+  "/********************   Defined Constructors    ********************/",
   nsEnd inPackage
   ]