[ #265 purge MkSharedString ] removed option --sharedstrings

This option has been untested for a long time.
The code produced by this module does not readily compile with GHC.

source/BNFC.cabal

@@ -137,7 +137,6 @@ Executable bnfc
     BNFC.Backend.Haskell.CFtoAbstract
     BNFC.Backend.Haskell.CFtoLayout
     BNFC.Backend.Haskell.MkErrM
-    BNFC.Backend.Haskell.MkSharedString
     BNFC.Backend.Haskell.HsOpts
     BNFC.Backend.Haskell.Utils
     -- Profile
@@ -318,7 +317,6 @@ Test-suite unit-tests
     BNFC.Backend.Haskell.CFtoAbstract
     BNFC.Backend.Haskell.CFtoLayout
     BNFC.Backend.Haskell.MkErrM
-    BNFC.Backend.Haskell.MkSharedString
     BNFC.Backend.Haskell.HsOpts
     BNFC.Backend.Haskell.Utils
     -- Profile

source/changelog

@@ -1,5 +1,5 @@
 2.9.0 Andreas Abel <andreas.abel@gu.se>
-	* Removed options --alex1 and --alex2
+	* Haskell: removed options --alex1, --alex2, and --sharestrings
 
 2.8.4 Andreas Abel <andreas.abel@gu.se>  October 2020
 	* GHC versions 7.10 - 8.10 supported, dropped GHC 7.6 and 7.8

source/src/BNFC/Backend/Haskell.hs

@@ -34,7 +34,6 @@ import BNFC.Backend.Haskell.CFtoPrinter
 import BNFC.Backend.Haskell.CFtoLayout
 import BNFC.Backend.Haskell.HsOpts
 import BNFC.Backend.Haskell.MkErrM
-import BNFC.Backend.Haskell.MkSharedString
 import BNFC.Backend.Haskell.ToCNF as ToCNF
 import BNFC.Backend.Haskell.Utils
 import BNFC.Backend.Txt2Tag
@@ -59,7 +58,6 @@ makeHaskell opts cf = do
       prMod  = printerFileM opts
       layMod = layoutFileM opts
       errMod = errFileM opts
-      shareMod = shareFileM opts
   do
     -- Generate abstract syntax and pretty printer.
     mkfile (absFile opts) $ cf2Abstract (tokenText opts) (generic opts) (functor opts) absMod cf
@@ -68,10 +66,9 @@ makeHaskell opts cf = do
     -- Generate Alex lexer.  Layout is resolved after lexing.
     case alexMode opts of
       Alex3 -> do
-        mkfile (alexFile opts) $ cf2alex3 lexMod shareMod (shareStrings opts) (tokenText opts) cf
+        mkfile (alexFile opts) $ cf2alex3 lexMod (tokenText opts) cf
         liftIO $ printf "Use Alex 3 to compile %s.\n" (alexFile opts)
 
-    Ctrl.when (shareStrings opts) $ mkfile (shareFile opts) $ sharedString shareMod (tokenText opts) cf
     Ctrl.when (hasLayout cf) $ mkfile (layoutFile opts) $
       cf2Layout (tokenText opts) layMod lexMod cf
 
@@ -160,7 +157,6 @@ distCleanRule opts makeFile = Makefile.mkRule "distclean" ["clean"] $
       , alexFile       -- Lex.x
       , happyFile      -- Par.y
       , printerFile    -- Print.hs
-      , shareFile      -- SharedString.hs -- only if: shareStrings opt
       , templateFile   -- Skel.hs
       , tFile          -- Test.hs
       , xmlFile        -- XML.hs

source/src/BNFC/Backend/Haskell/CFtoAlex3.hs

@@ -33,17 +33,17 @@ import BNFC.Options (TokenText(..))
 import BNFC.Backend.Common (unicodeAndSymbols)
 import BNFC.Backend.Haskell.Utils
 
-cf2alex3 :: String -> String -> Bool -> TokenText -> CF -> String
-cf2alex3 name shareMod shareStrings tokenText cf =
+cf2alex3 :: String -> TokenText -> CF -> String
+cf2alex3 name tokenText cf =
   unlines $ List.intercalate [""] $   -- equivalent to vsep: intersperse empty lines
-  [ prelude name shareMod shareStrings tokenText
+  [ prelude name tokenText
   , cMacros
   , rMacros cf
-  , restOfAlex shareMod shareStrings tokenText cf
+  , restOfAlex tokenText cf
   ]
 
-prelude :: String -> String -> Bool -> TokenText -> [String]
-prelude name shareMod shareStrings tokenText = concat
+prelude :: String -> TokenText -> [String]
+prelude name tokenText = concat
   [ [ "-- -*- haskell -*-"
     , "-- This Alex file was machine-generated by the BNF converter"
     , "{"
@@ -52,7 +52,6 @@ prelude name shareMod shareStrings tokenText = concat
     , "module " ++ name ++ " where"
     , ""
     ]
-  , [ "import " ++ shareMod | shareStrings ]
   , tokenTextImport tokenText
   , [ "import qualified Data.Bits"
     , "import Data.Word (Word8)"
@@ -88,8 +87,8 @@ rMacros cf = if null symbs then [] else
                          where s = if isPrint c then ['\\',c]
                                                 else '\\':show (ord c)
 
-restOfAlex :: String -> Bool -> TokenText -> CF -> [String]
-restOfAlex _ shareStrings tokenText cf = [
+restOfAlex :: TokenText -> CF -> [String]
+restOfAlex tokenText cf = [
   ":-",
   "",
   lexComments (comments cf),
@@ -100,19 +99,16 @@ restOfAlex _ shareStrings tokenText cf = [
   ident,
 
   ifC catString ("\\\" ([$u # [\\\" \\\\ \\n]] | (\\\\ (\\\" | \\\\ | \\' | n | t | r | f)))* \\\"" ++
-                  "\n    { tok (\\p s -> PT p (TL $ share $ unescapeInitTail s)) }"),
-  ifC catChar    "\\\' ($u # [\\\' \\\\] | \\\\ [\\\\ \\\' n t r f]) \\'\n    { tok (\\p s -> PT p (TC $ share s))  }",
-  ifC catInteger "$d+\n    { tok (\\p s -> PT p (TI $ share s))    }",
-  ifC catDouble  "$d+ \\. $d+ (e (\\-)? $d+)?\n    { tok (\\p s -> PT p (TD $ share s)) }",
+                  "\n    { tok (\\p s -> PT p (TL $ unescapeInitTail s)) }"),
+  ifC catChar    "\\\' ($u # [\\\' \\\\] | \\\\ [\\\\ \\\' n t r f]) \\'\n    { tok (\\p s -> PT p (TC s))  }",
+  ifC catInteger "$d+\n    { tok (\\p s -> PT p (TI s))    }",
+  ifC catDouble  "$d+ \\. $d+ (e (\\-)? $d+)?\n    { tok (\\p s -> PT p (TD s)) }",
   "",
   "{",
   "",
   "tok :: (Posn -> " ++ stringType ++ " -> Token) -> (Posn -> " ++ stringType ++ " -> Token)",
   "tok f p s = f p s",
   "",
-  "share :: "++stringType++" -> "++stringType,
-  "share = " ++ if shareStrings then "shareString" else "id",
-  "",
   "data Tok =",
   "   TS !"++stringType++" !Int    -- reserved words and symbols",
   " | TL !"++stringType++"         -- string literals",
@@ -302,11 +298,11 @@ restOfAlex _ shareStrings tokenText cf = [
 
    -- tokens consisting of special symbols
    pTSpec [] = ""
-   pTSpec _ = "@rsyms\n    { tok (\\p s -> PT p (eitherResIdent (TV . share) s)) }"
+   pTSpec _ = "@rsyms\n    { tok (\\p s -> PT p (eitherResIdent TV s)) }"
 
    userDefTokenTypes = unlines
      [ printRegAlex exp ++
-       "\n    { tok (\\p s -> PT p (eitherResIdent (T_"  ++ name ++ " . share) s)) }"
+       "\n    { tok (\\p s -> PT p (eitherResIdent T_"  ++ name ++ " s)) }"
      | (name,exp) <- tokenPragmas cf
      ]
 
@@ -321,7 +317,7 @@ restOfAlex _ shareStrings tokenText cf = [
      ]
 
    ident =
-     "$l $i*\n    { tok (\\p s -> PT p (eitherResIdent (TV . share) s)) }"
+     "$l $i*\n    { tok (\\p s -> PT p (eitherResIdent TV s)) }"
      --ifC "Ident"  "<ident>   ::= ^l ^i*   { ident  p = PT p . eitherResIdent TV }"
 
 

source/src/BNFC/Backend/Haskell/HsOpts.hs

@@ -36,8 +36,6 @@ tFile         = mkFile withLang "Test" "hs"
 tFileExe      = mkFile withLang "Test" ""
 errFile       = mkFile noLang   "ErrM" "hs"
 errFileM      = mkMod  noLang   "ErrM"
-shareFile     = mkFile noLang   "SharedString" "hs"
-shareFileM    = mkMod  noLang   "SharedString"
 layoutFileM   = mkMod  withLang "Layout"
 layoutFile    = mkFile withLang "Layout" "hs"
 xmlFile       = mkFile withLang "XML" "hs"

source/src/BNFC/Backend/HaskellGADT.hs

@@ -34,7 +34,6 @@ import BNFC.Backend.Haskell.CFtoPrinter
 import BNFC.Backend.Haskell.CFtoLayout
 import BNFC.Backend.XML
 import BNFC.Backend.Haskell.MkErrM
-import BNFC.Backend.Haskell.MkSharedString
 import qualified BNFC.Backend.Common.Makefile as Makefile
 import qualified BNFC.Backend.Haskell as Haskell
 
@@ -50,13 +49,12 @@ makeHaskellGadt opts cf = do
       prMod  = printerFileM opts
       layMod = layoutFileM opts
       errMod = errFileM opts
-      shareMod = shareFileM opts
   do
     mkfile (absFile opts) $ cf2Abstract (tokenText opts) absMod cf composOpMod
     mkfile (composOpFile opts) $ composOp composOpMod
     case alexMode opts of
       Alex3 -> do
-        mkfile (alexFile opts) $ cf2alex3 lexMod shareMod (shareStrings opts) (tokenText opts) cf
+        mkfile (alexFile opts) $ cf2alex3 lexMod (tokenText opts) cf
         liftIO $ putStrLn "   (Use Alex 3 to compile.)"
     mkfile (happyFile opts) $
       cf2Happy parMod absMod lexMod (glr opts) (tokenText opts) False cf
@@ -67,7 +65,6 @@ makeHaskellGadt opts cf = do
       cf2Layout (tokenText opts) layMod lexMod cf
     mkfile (tFile opts)        $ Haskell.testfile opts cf
     mkfile (errFile opts) $ mkErrM errMod
-    when (shareStrings opts) $ mkfile (shareFile opts)    $ sharedString shareMod (tokenText opts) cf
     Makefile.mkMakefile opts $ Haskell.makefile opts
     case xml opts of
       2 -> makeXML opts True cf

source/src/BNFC/Backend/HaskellProfile.hs

@@ -66,7 +66,7 @@ makeHaskellProfile opts cfp = do
 ----    mkfile (absFile  (inDir opts) name) $ cf2Abstract (absFileM (inDir opts) name) cf
     case alexMode opts of
       Alex3 -> do
-        mkfile (alexFile (inDir opts) name) $ cf2alex3 lexMod "" False StringToken cf
+        mkfile (alexFile (inDir opts) name) $ cf2alex3 lexMod StringToken cf
         liftIO $ putStrLn "   (Use Alex 3 to compile.)"
     mkfile (happyFile (inDir opts) name) $
                  cf2HappyProfileS parMod absMod lexMod cfp

source/src/BNFC/Options.hs

@@ -121,7 +121,6 @@ data SharedOptions = Options
   , functor       :: Bool        -- ^ Option @--functor@.  Make AST functorial?
   , generic       :: Bool        -- ^ Option @--generic@.  Derive Data, Generic, Typeable?
   , alexMode      :: AlexVersion -- ^ Options @--alex@.
-  , shareStrings  :: Bool        -- ^ Option @--sharestrings@.
   , tokenText     :: TokenText   -- ^ Options @--bytestrings@, @--string-token@, and @--text-token@.
   , glr           :: HappyMode   -- ^ Happy option @--glr@.
   , xml           :: Int         -- ^ Options @--xml@, generate DTD and XML printers.
@@ -156,7 +155,6 @@ defaultOptions = Options
   , functor         = False
   , generic         = False
   , alexMode        = Alex3
-  , shareStrings    = False
   , tokenText       = StringToken
   , glr             = Standard
   , xml             = 0
@@ -214,7 +212,6 @@ printOptions opts = unwords . concat $
   , [ "--functor"         | functor opts                        ]
   , [ "--generic"         | generic opts                        ]
   , unlessDefault alexMode opts $ \ o -> [ printAlexOption o ]
-  , [ "--sharestrings"    | shareStrings opts                   ]
   , [ "--bytestrings"     | tokenText opts == ByteStringToken   ]
   , [ "--text-token"      | tokenText opts == TextToken, not (agda opts) ]  -- default for --agda
   , [ "--string-token"    | tokenText opts == StringToken, agda opts ]      -- default unless --agda
@@ -353,9 +350,6 @@ specificOptions =
   , ( Option []    ["alex3"] (NoArg (\o -> o {alexMode = Alex3}))
           "Use Alex 3 as Haskell lexer tool (default)"
     , haskellTargets )
-  , ( Option []    ["sharestrings"] (NoArg (\o -> o {shareStrings = True}))
-          "Use string sharing in Alex 2 lexer [deprecated]"
-    , haskellTargets )
   , ( Option []    ["bytestrings"] (NoArg (\o -> o { tokenText = ByteStringToken }))
           "Use ByteString in Alex lexer"
     , haskellTargets )
@@ -555,7 +549,6 @@ warnDeprecatedOptions :: SharedOptions -> ParseOpt ()
 warnDeprecatedOptions Options{..} = do
   warnDeprecatedBackend alexMode
   warnDeprecatedBackend glr
-  Ctrl.when shareStrings $ warnDeprecated $ "feature --sharestrings"
 
 -- * Backward compatibility
 
@@ -601,13 +594,16 @@ classifyUnknownOption :: String -> Either (Either UnknownOption RemovedOption) O
 classifyUnknownOption = \case
   "--alex1" -> supportRemovedIn290 $ "Alex version 1"
   "--alex2" -> supportRemovedIn290 $ "Alex version 2"
+  s@"--sharestrings" -> optionRemovedIn290 s
   _ -> unknown
   where
   unknown  = Left $ Left UnknownOption
   obsolete = Right ObsoleteOption
   removed  = Left . Right . RemovedOption
   supportRemovedIn290 feature = removed $
     unwords [ "Support for", feature, "has been removed in version 2.9.0." ]
+  optionRemovedIn290 o = removed $
+    unwords [ "Option", o, "has been removed in version 2.9.0." ]
 
 -- | A translation function to maintain backward compatibility
 --   with the old option syntax.

source/src/LexBNF.x

@@ -31,29 +31,26 @@ $u = [. \n]          -- universal: any character
 
 $white+ ;
 @rsyms
-    { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
+    { tok (\p s -> PT p (eitherResIdent TV s)) }
 $l (\_ | ($d | $l)) *
-    { tok (\p s -> PT p (eitherResIdent (T_Identifier . share) s)) }
+    { tok (\p s -> PT p (eitherResIdent T_Identifier s)) }
 
 $l $i*
-    { tok (\p s -> PT p (eitherResIdent (TV . share) s)) }
+    { tok (\p s -> PT p (eitherResIdent TV s)) }
 \" ([$u # [\" \\ \n]] | (\\ (\" | \\ | \' | n | t | r | f)))* \"
-    { tok (\p s -> PT p (TL $ share $ unescapeInitTail s)) }
+    { tok (\p s -> PT p (TL $ unescapeInitTail s)) }
 \' ($u # [\' \\] | \\ [\\ \' n t r f]) \'
-    { tok (\p s -> PT p (TC $ share s))  }
+    { tok (\p s -> PT p (TC s))  }
 $d+
-    { tok (\p s -> PT p (TI $ share s))    }
+    { tok (\p s -> PT p (TI s))    }
 $d+ \. $d+ (e (\-)? $d+)?
-    { tok (\p s -> PT p (TD $ share s)) }
+    { tok (\p s -> PT p (TD s)) }
 
 {
 
 tok :: (Posn -> String -> Token) -> (Posn -> String -> Token)
 tok f p s = f p s
 
-share :: String -> String
-share = id
-
 data Tok =
    TS !String !Int    -- reserved words and symbols
  | TL !String         -- string literals