diff --git a/source/CHANGELOG.md b/source/CHANGELOG.md index 2bebf2bc..7fa13f6d 100644 --- a/source/CHANGELOG.md +++ b/source/CHANGELOG.md @@ -1,5 +1,7 @@ # Unreleased +* C: preserve case in constructors (union): e.g. label `EInt` now is union member `eInt_` rather than `eint_` + [[#479](https://github.com/BNFC/bnfc/issues/479)] # 2.9.5 diff --git a/source/src/BNFC/Backend/C/CFtoCAbs.hs b/source/src/BNFC/Backend/C/CFtoCAbs.hs index b906ca85..3d69d3bc 100644 --- a/source/src/BNFC/Backend/C/CFtoCAbs.hs +++ b/source/src/BNFC/Backend/C/CFtoCAbs.hs @@ -35,7 +35,7 @@ import BNFC.PrettyPrint import BNFC.Options ( RecordPositions(..) ) import BNFC.Utils ( (+++), unless ) import BNFC.Backend.Common.NamedVariables -import BNFC.Backend.C.Common ( posixC ) +import BNFC.Backend.C.Common ( posixC, memName ) -- | The result is two files (.H file, .C file) @@ -304,12 +304,12 @@ mkCFile datas _cf = concat -- switch(p->kind) -- { -- case is_EInt: --- return make_EInt (p->u.eint_.integer_); +-- return make_EInt (p->u.eInt_.integer_); -- -- case is_EAdd: -- return make_EAdd --- ( clone_Exp(p->u.eadd_.exp_1) --- , clone_Exp(p->u.eadd_.exp_2) +-- ( clone_Exp(p->u.eAdd_.exp_1) +-- , clone_Exp(p->u.eAdd_.exp_2) -- ); -- -- default: @@ -375,7 +375,7 @@ prCloneC (cat, rules) prCloneCat :: String -> (Cat, Doc) -> String prCloneCat fnm (cat, nt) = cloner cat member where - member = concat [ "p->u.", map toLower fnm, "_.", render nt ] + member = concat [ "p->u.", memName fnm, ".", render nt ] -- | Clone or not depending on the category. -- Only pointers need to be cloned. @@ -401,8 +401,8 @@ cloner cat x = -- break; -- -- case is_EAdd: --- free_Exp(p->u.eadd_.exp_1); --- free_Exp(p->u.eadd_.exp_2); +-- free_Exp(p->u.eAdd_.exp_1); +-- free_Exp(p->u.eAdd_.exp_2); -- break; -- -- default: @@ -482,8 +482,8 @@ prDestructorC (cat, rules) prFreeCat fnm (cat, nt) = Just $ concat [ maybe ("free_" ++ identCat (normCat cat)) (const "free") $ maybeTokenCat cat , "(p->u." - , map toLower fnm - , "_.", render nt, ");" + , memName fnm + , ".", render nt, ");" ] @@ -614,21 +614,15 @@ prParams = zipWith prParam [1::Int ..] prParam n c = (text (identCat c), text ("p" ++ show n)) -- | Prints the assignments of parameters to instance variables. --- >>> prAssigns "A" [("A",1),("B",2)] [text "abc", text "def"] +-- >>> prAssigns "A" [("A",1),("BA",2)] [text "abc", text "def"] -- tmp->u.a_.a_ = abc; --- tmp->u.a_.b_2 = def; +-- tmp->u.a_.ba_2 = def; prAssigns :: String -> [IVar] -> [Doc] -> Doc prAssigns c vars params = vcat $ zipWith prAssign vars params where prAssign (t,n) p = - text ("tmp->u." ++ c' ++ "_." ++ vname t n) <+> char '=' <+> p <> semi + text ("tmp->u." ++ memName c ++ "." ++ vname t n) <+> char '=' <+> p <> semi vname t n | n == 1, [_] <- filter ((t ==) . fst) vars = varName t | otherwise = varName t ++ showNum n - c' = map toLower c - -{- **** Helper Functions **** -} - -memName :: String -> String -memName s = map toLower s ++ "_" diff --git a/source/src/BNFC/Backend/C/CFtoCPrinter.hs b/source/src/BNFC/Backend/C/CFtoCPrinter.hs index 85701121..f4ab6f99 100644 --- a/source/src/BNFC/Backend/C/CFtoCPrinter.hs +++ b/source/src/BNFC/Backend/C/CFtoCPrinter.hs @@ -33,7 +33,8 @@ import BNFC.Utils ( (+++), uniqOn, unless, unlessNull ) import BNFC.Backend.Common import BNFC.Backend.Common.NamedVariables -import BNFC.Backend.Common.StrUtils (renderCharOrString) +import BNFC.Backend.Common.StrUtils ( renderCharOrString ) +import BNFC.Backend.C.Common ( memName ) -- | Produces (.h file, .c file). @@ -446,7 +447,7 @@ prPrintRule r@(Rule fun _ _ _) = unless (isCoercion fun) $ concat where p = precRule r fnm = funName fun - pre = concat [ "p->u.", map toLower fnm, "_." ] + pre = concat [ "p->u.", memName fnm, "." ] -- | Only render the rhs (items) of a rule. @@ -567,8 +568,8 @@ prShowCat fnm (cat, nt) = concat [ " sh" , maybe (identCat $ normCat cat) basicFunName $ maybeTokenCat cat , "(p->u." - , map toLower fnm - , "_." + , memName fnm + , "." , render nt , ");\n" ] diff --git a/source/src/BNFC/Backend/C/CFtoCSkel.hs b/source/src/BNFC/Backend/C/CFtoCSkel.hs index ea21f072..4fc8af5e 100644 --- a/source/src/BNFC/Backend/C/CFtoCSkel.hs +++ b/source/src/BNFC/Backend/C/CFtoCSkel.hs @@ -19,6 +19,7 @@ import Prelude hiding ((<>)) import BNFC.CF import BNFC.Utils ( (+++), capitalize ) import BNFC.Backend.Common.NamedVariables +import BNFC.Backend.C.Common ( memName ) import Data.Char ( toLower ) import Data.Either ( lefts ) @@ -166,11 +167,11 @@ prData (cat, rules) -- | Visits all the instance variables of a category. -- >>> let ab = Cat "Ab" --- >>> prPrintRule (Rule "Abc" undefined [Left ab, Left ab] Parsable) --- case is_Abc: --- /* Code for Abc Goes Here */ --- visitAb(p->u.abc_.ab_1); --- visitAb(p->u.abc_.ab_2); +-- >>> prPrintRule (Rule "ABC" undefined [Left ab, Left ab] Parsable) +-- case is_ABC: +-- /* Code for ABC Goes Here */ +-- visitAb(p->u.aBC_.ab_1); +-- visitAb(p->u.aBC_.ab_2); -- break; -- -- >>> let ab = TokenCat "Ab" @@ -209,8 +210,7 @@ prCat fnm (cat, vname) = let visitf = "visit" <> if isTokenCat cat then basicFunName cat else text (identCat (normCat cat)) - in visitf <> parens ("p->u." <> text v <> "_." <> vname ) <> ";" - where v = map toLower fnm + in visitf <> parens ("p->u." <> text (memName fnm) <> "." <> vname ) <> ";" -- | The visit-function name of a basic type diff --git a/source/src/BNFC/Backend/C/Common.hs b/source/src/BNFC/Backend/C/Common.hs index ae4ccded..1ccc2796 100644 --- a/source/src/BNFC/Backend/C/Common.hs +++ b/source/src/BNFC/Backend/C/Common.hs @@ -1,10 +1,12 @@ -- | Common definitions for the modules of the C backend. module BNFC.Backend.C.Common - ( posixC + ( memName + , posixC ) where import Prelude +import BNFC.Backend.Common.NamedVariables -- | Switch C to language variant that has @strdup@. @@ -16,3 +18,8 @@ posixC = , " */" , "#define _POSIX_C_SOURCE 200809L" ] + +-- | Variant names in unions. + +memName :: String -> String +memName s = firstLowerCase s ++ "_" diff --git a/source/src/BNFC/GetCF.hs b/source/src/BNFC/GetCF.hs index fe9d6eaa..1c6fc23d 100644 --- a/source/src/BNFC/GetCF.hs +++ b/source/src/BNFC/GetCF.hs @@ -162,9 +162,13 @@ parseCF opts target content = do ] -- Warn or fail if the grammar uses names not unique modulo upper/lowercase. - when False $ - case nub $ filter (`notElem` nonUniqueNames) $ filter (not . isDefinedRule) $ - concatMap List1.toList $ duplicatesOn (map toLower . wpThing) names of + case nub + . filter (`notElem` nonUniqueNames) + . concatMap List1.toList + . duplicatesOn (map toLower . wpThing) + . filter (not . isDefinedRule) + $ names + of [] -> return () ns | target `elem` [ TargetJava ] -> dieUnlessForce $ unlines $ concat diff --git a/testing/src/ParameterizedTests.hs b/testing/src/ParameterizedTests.hs index cef7e0d7..ce0c945c 100644 --- a/testing/src/ParameterizedTests.hs +++ b/testing/src/ParameterizedTests.hs @@ -72,11 +72,12 @@ currentRegressionTest :: Test currentRegressionTest = makeTestSuite "Current parameterized test" $ map (`makeTestCase` ("regression-tests" cur)) parameters where + cur = "479_LabelsCaseSensitive" -- cur = "comments" -- cur = "358_MixFixLists" -- cur = "289_LexerKeywords" -- cur = "249_unicode" - cur = "266_define" + -- cur = "266_define" -- cur = "235_SymbolsOverlapTokens" -- cur = "202_comments" -- cur = "278_Keywords" @@ -192,7 +193,8 @@ testCases :: TestParameters -> [Test] testCases params = map (makeTestCase params) $ map ("regression-tests/" ++) $ - [ "266_define" + [ "479_LabelsCaseSensitive" + , "266_define" , "358_MixFixLists" , "235_SymbolsOverlapTokens" , "278_Keywords"