[ #266 C ] fixed by adding a #define for a BNFC define to Absyn.h

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

@@ -43,10 +43,11 @@
 module BNFC.Backend.C.CFtoCAbs (cf2CAbs) where
 
 import Prelude'
+import Data.List (intercalate)
 
 import BNFC.CF
 import BNFC.PrettyPrint
-import BNFC.Utils((+++))
+import BNFC.Utils((+++), uncurry3, unless)
 import BNFC.Options (RecordPositions(..))
 import BNFC.Backend.Common.NamedVariables
 import Data.Function (on)
@@ -67,20 +68,30 @@ cf2CAbs rp _ cf = (mkHFile rp cf, mkCFile cf)
 -- | Makes the Header file.
 
 mkHFile :: RecordPositions -> CF -> String
-mkHFile rp cf = unlines
-   [ "#ifndef ABSYN_HEADER"
+mkHFile rp cf = unlines $ concat
+ [ [ "#ifndef ABSYN_HEADER"
  , "#define ABSYN_HEADER"
  , ""
  , header
  , prTypeDefs user
- , "/******************** Forward Declarations ********************/\n"
- , concatMap prForward classes
+ , "/******************** Forward Declarations ***********************/"
  , ""
- , "/******************** Abstract Syntax Classes ********************/\n"
- , concatMap (prDataH rp) (getAbstractSyntax cf)
+ ]
+ , map prForward classes
+ , [ ""
+ , "/******************** Abstract Syntax Classes ********************/"
+ , ""
+ ]
+ , map (prDataH rp) (getAbstractSyntax cf)
+ , unless (null definedConstructors)
+ [ "/******************** Defined Constructors ***********************/"
  , ""
+ ]
+ , map (uncurry3 prDefH) definedConstructors
+ , [ ""
  , "#endif"
  ]
+ ]
  where
  user = fst (unzip (tokenPragmas cf))
  header = "/* C++ Abstract Syntax Interface generated by the BNF Converter.*/\n"
@@ -97,6 +108,31 @@ mkHFile rp cf = unlines
  testRule (Rule f c _ _)
  | isList c && isConsFun f = identCat (normCat c)
  | otherwise = "_"
+ definedConstructors = [ (f, xs, e) | FunDef f xs e <- cfgPragmas cf ]
+
+-- | For @define@d constructors, make a CPP definition.
+--
+-- >>> prDefH "iSg" ["i"] (App "ICons" [Var "i", App "INil" []])
+-- "#define make_iSg(i) make_ICons(i,make_INil())"
+--
+-- >>> prDefH "snoc" ["xs","x"] (App "Cons" [Var "x", Var "xs"])
+-- "#define make_snoc(xs,x) make_Cons(x,xs)"
+--
+prDefH
+ :: String -- ^ Name of the defined constructors.
+ -> [String] -- ^ Names of the arguments.
+ -> Exp -- ^ Definition (referring to arguments and rule labels).
+ -> String
+prDefH f xs e = concat [ "#define make_", f, "(", intercalate "," xs, ") ", prExp e ]
+ where
+ prExp :: Exp -> String
+ prExp = \case
+ Var x -> x
+ App g es -> concat [ "make_", g, "(", intercalate "," (map prExp es), ")" ]
+ LitInt i -> show i
+ LitDouble d -> show d
+ LitChar c -> show c
+ LitString s -> show s
 
 -- | Prints struct definitions for all categories.
 prDataH :: RecordPositions -> Data -> String

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

@@ -45,22 +45,25 @@ module BNFC.Backend.C.CFtoCPrinter (cf2CPrinter) where
 
 import Prelude'
 
+import Data.Bifunctor ( second )
+import Data.Char ( toLower )
+import Data.Either ( lefts )
+import Data.List ( nub, isPrefixOf )
+
 import BNFC.CF
+import BNFC.PrettyPrint
 import BNFC.Utils ((+++), unless)
 import BNFC.Backend.Common (renderListSepByPrecedence)
 import BNFC.Backend.Common.NamedVariables
 import BNFC.Backend.Common.StrUtils (renderCharOrString)
-import Data.List
-import Data.Char(toLower)
-import Data.Either (lefts)
-import BNFC.PrettyPrint
 
 -- | Produces (.h file, .c file).
 
 cf2CPrinter :: CF -> (String, String)
 cf2CPrinter cf = (mkHFile cf groups, mkCFile cf groups)
  where
- groups = fixCoercions (ruleGroupsInternals cf)
+ groups = fixCoercions $ filterOutDefs $ ruleGroupsInternals cf
+ filterOutDefs = map $ second $ filter $ not . isDefinedRule . funRule
 
 {- **** Header (.h) File Methods **** -}
 

source/src/BNFC/Utils.hs

@@ -25,6 +25,7 @@ module BNFC.Utils
  , when, unless, unlessNull, unlessNull'
  , applyWhen, applyUnless
  , for
+ , curry3, uncurry3
  , duplicatesOn
  , (+++), (++++), (+-+), (+.+)
  , pad, table
@@ -110,6 +111,18 @@ unlessNull' l k = case l of
 for :: [a] -> (a -> b) -> [b]
 for = flip map
 
+-- * Tuple utilities.
+
+-- From https://hackage.haskell.org/package/extra-1.6.18/docs/Data-Tuple-Extra.html
+
+-- | Converts an uncurried function to a curried function.
+curry3 :: ((a, b, c) -> d) -> a -> b -> c -> d
+curry3 f a b c = f (a,b,c)
+
+-- | Converts a curried function to a function on a triple.
+uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d)
+uncurry3 f ~(a,b,c) = f a b c
+
 -- * String operations for printing.
 
 infixr 5 +++, ++++, +-+, +.+