[ fixed #277 ] by retiring NoSTL.CFtoCVisitSkel in favor of a general…

…ized STL.CFtoCCVisitSkelSTLC The only difference is how lists are handles, thus, it makes much sense to share most of the implementation. (Wink mit dem Zaunpfahl an meine Vorgänger.)
BNFC · Jan 4, 2020 · 4fb4116 · 4fb4116
1 parent 61bd3da
commit 4fb4116
Show file tree

Hide file tree

Showing 8 changed files with 69 additions and 24 deletions.
diff --git a/source/BNFC.cabal b/source/BNFC.cabal
@@ -158,7 +158,7 @@ Executable bnfc
     BNFC.Backend.CPP.NoSTL.CFtoFlex
     BNFC.Backend.CPP.NoSTL.CFtoBison
     BNFC.Backend.CPP.NoSTL.CFtoCPPAbs
-    BNFC.Backend.CPP.NoSTL.CFtoCVisitSkel
+    -- BNFC.Backend.CPP.NoSTL.CFtoCVisitSkel -- retired
 
     -- C++ STL backend
     BNFC.Backend.CPP.STL
@@ -342,7 +342,7 @@ Test-suite unit-tests
     BNFC.Backend.CPP.NoSTL.CFtoFlex
     BNFC.Backend.CPP.NoSTL.CFtoBison
     BNFC.Backend.CPP.NoSTL.CFtoCPPAbs
-    BNFC.Backend.CPP.NoSTL.CFtoCVisitSkel
+    -- BNFC.Backend.CPP.NoSTL.CFtoCVisitSkel --retired
 
     -- C++ STL backend
     BNFC.Backend.CPP.STL

diff --git a/source/src/BNFC/Backend/CPP/NoSTL.hs b/source/src/BNFC/Backend/CPP/NoSTL.hs
@@ -32,7 +32,7 @@ import BNFC.Backend.CPP.Makefile
 import BNFC.Backend.CPP.NoSTL.CFtoCPPAbs
 import BNFC.Backend.CPP.NoSTL.CFtoFlex
 import BNFC.Backend.CPP.NoSTL.CFtoBison
-import BNFC.Backend.CPP.NoSTL.CFtoCVisitSkel
+import BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL
 import BNFC.Backend.CPP.PrettyPrinter
 import qualified BNFC.Backend.Common.Makefile as Makefile
 
@@ -47,7 +47,7 @@ makeCppNoStl opts cf = do
     mkfile (name ++ ".y") bison
     let header = mkHeaderFile cf (allParserCats cf) (allEntryPoints cf) (Map.elems env)
     mkfile "Parser.H" header
-    let (skelH, skelC) = cf2CVisitSkel cf
+    let (skelH, skelC) = cf2CVisitSkel False Nothing cf
     mkfile "Skeleton.H" skelH
     mkfile "Skeleton.C" skelC
     let (prinH, prinC) = cf2CPPPrinter False Nothing cf

diff --git a/source/src/BNFC/Backend/CPP/NoSTL/CFtoCVisitSkel.hs b/source/src/BNFC/Backend/CPP/NoSTL/CFtoCVisitSkel.hs
@@ -1,3 +1,7 @@
+---------------------------------------------------------------------------
+-- RETIRED, use STL/CFtoCVisitSkelSTL instead
+---------------------------------------------------------------------------
+
 {-# LANGUAGE NoImplicitPrelude #-}
 
 {-
@@ -43,18 +47,23 @@ module BNFC.Backend.CPP.NoSTL.CFtoCVisitSkel (cf2CVisitSkel) where
 
 import Prelude'
 
-import BNFC.CF
-import BNFC.Utils ((+++))
-import BNFC.Backend.Common.NamedVariables
-import BNFC.Backend.CPP.Naming (mkVariable)
 import Data.List
 import Data.Char(toLower, toUpper)
 import Data.Either (lefts)
+
+import BNFC.CF
+import BNFC.Utils ((+++))
 import BNFC.PrettyPrint
 
+import BNFC.Backend.Common.NamedVariables
+import BNFC.Backend.Common.OOAbstract (cf2cabs)
+import BNFC.Backend.CPP.Naming (mkVariable)
+import qualified BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL as STL
+
 --Produces (.H file, .C file)
 cf2CVisitSkel :: CF -> (String, String)
-cf2CVisitSkel cf = (mkHFile cf groups, mkCFile cf groups)
+cf2CVisitSkel cf = (STL.mkHFile Nothing (cf2cabs cf), mkCFile cf groups)
+  -- (mkHFile cf groups, mkCFile cf groups)
   where
     groups = fixCoercions (ruleGroupsInternals cf)
 

diff --git a/source/src/BNFC/Backend/CPP/STL.hs b/source/src/BNFC/Backend/CPP/STL.hs
@@ -50,7 +50,7 @@ makeCppStl opts cf = do
     mkfile (name ++ ".y") bison
     let header = mkHeaderFile (inPackage opts) cf (allParserCats cf) (allEntryPoints cf) (Map.elems env)
     mkfile "Parser.H" header
-    let (skelH, skelC) = cf2CVisitSkel (inPackage opts) cf
+    let (skelH, skelC) = cf2CVisitSkel True (inPackage opts) cf
     mkfile "Skeleton.H" skelH
     mkfile "Skeleton.C" skelC
     let (prinH, prinC) = cf2CPPPrinter True (inPackage opts) cf

diff --git a/source/src/BNFC/Backend/CPP/STL/CFtoCVisitSkelSTL.hs b/source/src/BNFC/Backend/CPP/STL/CFtoCVisitSkelSTL.hs
@@ -39,15 +39,20 @@
 
 module BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL (cf2CVisitSkel) where
 
+import Data.Char
+
 import BNFC.CF
 import BNFC.Utils ((+++))
 import BNFC.Backend.Common.OOAbstract
 import BNFC.Backend.CPP.Naming
 import BNFC.Backend.CPP.STL.STLUtils
 
 --Produces (.H file, .C file)
-cf2CVisitSkel :: Maybe String -> CF -> (String, String)
-cf2CVisitSkel inPackage cf = (mkHFile inPackage cab, mkCFile inPackage cab)
+cf2CVisitSkel :: Bool -> Maybe String -> CF -> (String, String)
+cf2CVisitSkel useSTL inPackage cf =
+ ( mkHFile inPackage cab
+ , mkCFile useSTL inPackage cab
+ )
  where
     cab = cf2cabs cf
 
@@ -83,15 +88,15 @@ mkHFile inPackage cf = unlines [
 -- **** Implementation (.C) File Functions ****
 
 --Makes the .C File
-mkCFile :: Maybe String -> CAbs -> String
-mkCFile inPackage cf = unlines [
+mkCFile :: Bool -> Maybe String -> CAbs -> String
+mkCFile useSTL inPackage cf = unlines [
   headerC,
   nsStart inPackage,
   unlines [
     "void Skeleton::visit" ++ t ++ "(" ++
        t ++ " *t) {} //abstract class" | t <- absclasses cf],
   unlines [prCon   r  | (_,rs)  <- signatures cf, r <- rs],
-  unlines [prList  cb | cb <- listtypes cf],
+  unlines [prList useSTL cb | cb <- listtypes cf],
   unlines [prBasic b  | b  <- tokentypes cf ++ map fst basetypes],
   nsEnd inPackage
  ]
@@ -114,7 +119,7 @@ prBasic c = unlines [
   "}"
   ]
 
-prList (cl,b) = unlines [
+prList True (cl,b) = unlines [
   "void Skeleton::visit" ++ cl ++ "("++ cl +++ "*" ++ vname ++ ")",
   "{",
   "  for ("++ cl ++"::iterator i = " ++
@@ -129,6 +134,26 @@ prList (cl,b) = unlines [
  where
    vname = mkVariable cl
 
+prList False (cl,b) = unlines
+  [ "void Skeleton::visit" ++ cl ++ "("++ cl +++ "*" ++ vname ++ ")"
+  , "{"
+  , "  while (" ++ vname ++ ")"
+  , "  {"
+  , "    /* Code For " ++ cl ++ " Goes Here */"
+  , if b
+      then "    if (" ++ field ++ ") " ++ field ++ "->accept(this);"
+      else "    visit" ++ ecl ++ "(" ++ field ++ ");"
+  , "    " ++ vname ++ " = " ++ vname ++ "->" ++ next ++ "_;"
+  , "  }"
+  , "}"
+  ]
+  where
+  ecl    = drop 4 cl  -- drop "List"
+  vname  = mkVariable cl
+  next   = map toLower cl
+  member = map toLower ecl ++ "_"
+  field  = vname ++ "->" ++ member
+
 prCon (f,cs) = unlines [
   "void Skeleton::visit" ++ f ++ "(" ++ f ++ " *" ++ v ++ ")",
   "{",
@@ -139,7 +164,7 @@ prCon (f,cs) = unlines [
  ]
  where
    v = mkVariable f
-   visitArg (cat,isPt,var) =
-     if isPt
-       then (v ++ "->" ++ var ++ "->accept(this);")
-       else ("visit" ++ cat ++ "(" ++ v ++ "->" ++ var ++ ");")
+   visitArg (cat,isPt,var)
+     | isPt      = "if (" ++ field ++ ") " ++ field ++ "->accept(this);"
+     | otherwise = "visit" ++ cat ++ "(" ++ field ++ ");"
+     where field = v ++ "->" ++ var
diff --git a/testing/regression-tests/235_SymbolsOverlapTokens/good01.in b/testing/regression-tests/235_SymbolsOverlapTokens/good01.in
@@ -1 +1 @@
-Integer MyId 1234567890 2.12345678901234e-300 'A' "Ha!" Foo_ Bar1
+Integer MyId [] 1234567890 2.12345678901234e-300 'A' "Ha!" Foo_ Bar1 Bar2 []
diff --git a/testing/regression-tests/235_SymbolsOverlapTokens/good01.out b/testing/regression-tests/235_SymbolsOverlapTokens/good01.out
@@ -1,7 +1,7 @@
 [Abstract Syntax]
 
-Init TypeInteger TypeMyId 1234567890 2.12345678901234e-300 'A' "Ha!" (Ident "Foo_") (MyId "Bar1")
+Init TypeInteger TypeMyId [] 1234567890 2.12345678901234e-300 'A' "Ha!" (Ident "Foo_") (MyId "Bar1") (MyId "Bar2") []
 
 [Linearized tree]
 
-Integer MyId 1234567890 2.12345678901234e-300 'A' "Ha!" Foo_ Bar1
+Integer MyId [] 1234567890 2.12345678901234e-300 'A' "Ha!" Foo_ Bar1 Bar2 []
diff --git a/testing/regression-tests/235_SymbolsOverlapTokens/test.cf b/testing/regression-tests/235_SymbolsOverlapTokens/test.cf
@@ -1,4 +1,12 @@
-Init.        Main ::= Type Type Integer Double Char String Ident MyId;
+-- #235 C-family backends confused keyword "Char" with token category Char etc.
+
+-- #277 C++ NoSTL backend produces ill-formed skeletons
+-- when user-defined token category is repeated on rhs.
+
+
+Init.        Main ::= Type Type "[" [Type] "]"
+                      Integer Double Char String Ident
+                      MyId MyId "[" [MyId] "]" ;
 
 TypeType.    Type ::= "Type"    ;  -- #235 conflict with non-terminal Type
 TypeInteger. Type ::= "Integer" ;  -- #235 conflict with token type Integer
@@ -8,4 +16,7 @@ TypeString.  Type ::= "String"  ;
 TypeIdent.   Type ::= "Ident"   ;
 TypeMyId.    Type ::= "MyId"    ;
 
+separator Type "," ;
+separator MyId "," ;
+
 token MyId letter (letter | digit)*;