{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TupleSections #-}

{-
    BNF Converter: C flex generator
    Copyright (C) 2004  Author:  Michael Pellauer
    Copyright (C) 2020  Andreas Abel

    Description   : This module generates the Flex file. It is
                    similar to JLex but with a few peculiarities.

    Author        : Michael Pellauer
    Created       : 5 August, 2003
-}

module BNFC.Backend.C.CFtoFlexC
  ( cf2flex
  , preludeForBuffer  -- C code defining a buffer for lexing string literals.
  , cMacros           -- Lexer definitions.
  , commentStates     -- Stream of names for lexer states for comments.
  , lexComments       -- Lexing rules for comments.
  , lexStrings        -- Lexing rules for string literals.
  , lexChars          -- Lexing rules for character literals.
  ) where

import Prelude hiding ((<>))
import Data.Bifunctor (first)
import Data.List  (isInfixOf)
import Data.Maybe (fromMaybe)
import qualified Data.Map as Map

import BNFC.CF
import BNFC.Backend.C.RegToFlex
import BNFC.Backend.Common.NamedVariables
import BNFC.PrettyPrint
import BNFC.Utils (cstring, unless, when)

-- | Entrypoint.
cf2flex :: String -> CF -> (String, SymMap) -- The environment is reused by the parser.
cf2flex :: String -> CF -> (String, SymMap)
cf2flex String
name CF
cf = (, SymMap
env) (String -> (String, SymMap)) -> String -> (String, SymMap)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
    [ Bool -> String -> String
prelude Bool
stringLiterals String
name
    , CF -> String
cMacros CF
cf
    , KeywordEnv -> String
lexSymbols KeywordEnv
env0
    , CF -> SymMap -> String
restOfFlex CF
cf SymMap
env
    ]
  where
    env :: SymMap
env  = [(SymKey, String)] -> SymMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(SymKey, String)]
env1
    env0 :: KeywordEnv
env0 = [String] -> [Int] -> KeywordEnv
forall a. [a] -> [Int] -> [(a, String)]
makeSymEnv (CF -> [String]
forall function. CFG function -> [String]
cfgSymbols CF
cf [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ CF -> [String]
forall function. CFG function -> [String]
reservedWords CF
cf) [Int
0 :: Int ..]
    env1 :: [(SymKey, String)]
env1 = ((String, String) -> (SymKey, String))
-> KeywordEnv -> [(SymKey, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> SymKey) -> (String, String) -> (SymKey, String)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> SymKey
Keyword )KeywordEnv
env0 [(SymKey, String)] -> [(SymKey, String)] -> [(SymKey, String)]
forall a. [a] -> [a] -> [a]
++ [SymKey] -> [Int] -> [(SymKey, String)]
forall a. [a] -> [Int] -> [(a, String)]
makeSymEnv ((String -> SymKey) -> [String] -> [SymKey]
forall a b. (a -> b) -> [a] -> [b]
map String -> SymKey
Tokentype ([String] -> [SymKey]) -> [String] -> [SymKey]
forall a b. (a -> b) -> a -> b
$ CF -> [String]
forall function. CFG function -> [String]
tokenNames CF
cf) [KeywordEnv -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length KeywordEnv
env0 ..]
    makeSymEnv :: [a] -> [Int] -> [(a, String)]
makeSymEnv = (a -> Int -> (a, String)) -> [a] -> [Int] -> [(a, String)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ((a -> Int -> (a, String)) -> [a] -> [Int] -> [(a, String)])
-> (a -> Int -> (a, String)) -> [a] -> [Int] -> [(a, String)]
forall a b. (a -> b) -> a -> b
$ \ a
s Int
n -> (a
s, String
"_SYMB_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)
    stringLiterals :: Bool
stringLiterals = CF -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CF
cf (String -> Cat
TokenCat String
catString)

prelude :: Bool -> String -> String
prelude :: Bool -> String -> String
prelude Bool
stringLiterals String
name = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ String
"/* -*- c -*- This FLex file was machine-generated by the BNF converter */"
    -- noinput and nounput are most often unused
    -- https://stackoverflow.com/questions/39075510/option-noinput-nounput-what-are-they-for
    , String
"%option noyywrap noinput nounput"
    , String
"%top{"
    , String
"/* strdup was not in the ISO C standard before 6/2019 (C2x), but in POSIX 1003.1."
    , String
" * See: https://en.cppreference.com/w/c/experimental/dynamic/strdup"
    , String
" * Setting _POSIX_C_SOURCE to 200809L activates strdup in string.h."
    , String
" */"
    -- The following #define needs to be at the top before the automatic #include <stdlib.h>
    , String
"#define _POSIX_C_SOURCE 200809L"
    , String
"}"
    , String
"%{"
    , String
"#define yylval " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"lval"
    , String
"#define yylloc " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"lloc"
    , String
"#define init_lexer " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_init_lexer"
    , String
"#include \"Parser.h\""
    , String
""
    ]
  , Bool -> [String] -> [String]
forall m. Monoid m => Bool -> m -> m
when Bool
stringLiterals ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
preludeForBuffer String
"Buffer.h"
    -- https://www.gnu.org/software/bison/manual/html_node/Token-Locations.html
    -- Flex is responsible for keeping tracking of the yylloc for Bison.
    -- Flex also doesn't do this automatically so we need this function
    -- https://stackoverflow.com/a/22125500/425756
  , [ String
"static void update_loc(YYLTYPE* loc, char* text)"
    , String
"{"
    , String
"  loc->first_line = loc->last_line;"
    , String
"  loc->first_column = loc->last_column;"
    , String
"  int i = 0;"  -- put this here as @for (int i...)@ is only allowed in C99
    , String
"  for (; text[i] != '\\0'; ++i) {"
    , String
"      if (text[i] == '\\n') {"
    , String
"          ++loc->last_line;"
    , String
"          loc->last_column = 0; "
    , String
"      } else {"
    , String
"          ++loc->last_column; "
    , String
"      }"
    , String
"  }"
    , String
"}"
    , String
"#define YY_USER_ACTION update_loc(&yylloc, yytext);"
    , String
""
    , String
"%}"
    ]
  ]

-- | Part of the lexer prelude needed when string literals are to be lexed.
--   Defines an interface to the Buffer.
preludeForBuffer :: String -> [String]
preludeForBuffer :: String -> [String]
preludeForBuffer String
bufferH =
    [ String
"/* BEGIN extensible string buffer */"
    , String
""
    , String
"#include \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
bufferH String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
    , String
""
    , String
"/* The initial size of the buffer to lex string literals. */"
    , String
"#define LITERAL_BUFFER_INITIAL_SIZE 1024"
    , String
""
    , String
"/* The pointer to the literal buffer. */"
    , String
"static Buffer literal_buffer = NULL;"
    , String
""
    , String
"/* Initialize the literal buffer. */"
    , String
"#define LITERAL_BUFFER_CREATE() literal_buffer = newBuffer(LITERAL_BUFFER_INITIAL_SIZE)"
    , String
""
    , String
"/* Append characters at the end of the buffer. */"
    , String
"#define LITERAL_BUFFER_APPEND(s) bufferAppendString(literal_buffer, s)"
    , String
""
    , String
"/* Append a character at the end of the buffer. */"
    , String
"#define LITERAL_BUFFER_APPEND_CHAR(c) bufferAppendChar(literal_buffer, c)"
    , String
""
    , String
"/* Release the buffer, returning a pointer to its content. */"
    , String
"#define LITERAL_BUFFER_HARVEST() releaseBuffer(literal_buffer)"
    , String
""
    , String
"/* In exceptional cases, e.g. when reaching EOF, we have to free the buffer. */"
    , String
"#define LITERAL_BUFFER_FREE() freeBuffer(literal_buffer)"
    , String
""
    , String
"/* END extensible string buffer */"
    , String
""
    ]

-- For now all categories are included.
-- Optimally only the ones that are used should be generated.
cMacros :: CF ->  String
cMacros :: CF -> String
cMacros CF
cf = [String] -> String
unlines
  [ String
"LETTER [a-zA-Z]"
  , String
"CAPITAL [A-Z]"
  , String
"SMALL [a-z]"
  , String
"DIGIT [0-9]"
  , String
"IDENT [a-zA-Z0-9'_]"
  , [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ String
"%START YYINITIAL CHAR CHARESC CHAREND STRING ESCAPED" ]
      , Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take (CF -> Int
numberOfBlockCommentForms CF
cf) [String]
commentStates
      ]
  , String
""
  , String
"%%  /* Rules. */"
  ]

lexSymbols :: KeywordEnv -> String
lexSymbols :: KeywordEnv -> String
lexSymbols KeywordEnv
ss = ((String, String) -> String) -> KeywordEnv -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> String
transSym KeywordEnv
ss
  where
    transSym :: (String, String) -> String
transSym (String
s,String
r) =
      String
"<YYINITIAL>\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"      \t return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\n"
        where
         s' :: String
s' = String -> String
escapeChars String
s

restOfFlex :: CF -> SymMap -> String
restOfFlex :: CF -> SymMap -> String
restOfFlex CF
cf SymMap
env = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Maybe String -> (KeywordEnv, [String]) -> Doc
lexComments Maybe String
forall a. Maybe a
Nothing (CF -> (KeywordEnv, [String])
comments CF
cf)
    , String
""
    ]
  , [String]
userDefTokens
  , String -> [String] -> [String]
forall a. String -> [a] -> [a]
ifC String
catString  ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> [String]
lexStrings String
"yylval" String
"_STRING_" String
"_ERROR_"
  , String -> [String] -> [String]
forall a. String -> [a] -> [a]
ifC String
catChar    ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
lexChars   String
"yylval" String
"_CHAR_"
  , String -> [String] -> [String]
forall a. String -> [a] -> [a]
ifC String
catDouble  [ String
"<YYINITIAL>{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)?      \t yylval._double = atof(yytext); return _DOUBLE_;" ]
  , String -> [String] -> [String]
forall a. String -> [a] -> [a]
ifC String
catInteger [ String
"<YYINITIAL>{DIGIT}+      \t yylval._int = atoi(yytext); return _INTEGER_;" ]
  , String -> [String] -> [String]
forall a. String -> [a] -> [a]
ifC String
catIdent   [ String
"<YYINITIAL>{LETTER}{IDENT}*      \t yylval._string = strdup(yytext); return _IDENT_;" ]
  , [ String
"<YYINITIAL>[ \\t\\r\\n\\f]      \t /* ignore white space. */;"
    , String
"<YYINITIAL>.      \t return _ERROR_;"
    , String
""
    , String
"%%  /* Initialization code. */"
    , String
""
    ]
  , [String]
footer
  ]
  where
  ifC :: String -> [a] -> [a]
ifC String
cat [a]
s = if CF -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CF
cf (String -> Cat
TokenCat String
cat) then [a]
s else []
  userDefTokens :: [String]
userDefTokens =
    [ String
"<YYINITIAL>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Reg -> String
printRegFlex Reg
exp String -> String -> String
forall a. [a] -> [a] -> [a]
++
       String
"    \t yylval._string = strdup(yytext); return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
sName String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    | (String
name, Reg
exp) <- CF -> [(String, Reg)]
forall f. CFG f -> [(String, Reg)]
tokenPragmas CF
cf
    ]
    where sName :: String -> String
sName String
n = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
n (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ SymKey -> SymMap -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (String -> SymKey
Tokentype String
n) SymMap
env
  footer :: [String]
footer =
    [
     String
"void init_lexer(FILE *inp)",
     String
"{",
     String
"  yyrestart(inp);",
     String
"  yylloc.first_line   = 1;",
     String
"  yylloc.first_column = 1;",
     String
"  yylloc.last_line    = 1;",
     String
"  yylloc.last_column  = 1;",
     String
"  BEGIN YYINITIAL;",
     String
"}"
    ]

-- | Lexing of strings, converting escaped characters.
lexStrings :: String -> String -> String -> [String]
lexStrings :: String -> String -> String -> [String]
lexStrings String
yylval String
stringToken String
errorToken =
    [ String
"<YYINITIAL>\"\\\"\"        \t LITERAL_BUFFER_CREATE(); BEGIN STRING;"
    , String
"<STRING>\\\\             \t BEGIN ESCAPED;"
    , String
"<STRING>\\\"             \t " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
yylval String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"._string = LITERAL_BUFFER_HARVEST(); BEGIN YYINITIAL; return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
stringToken String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    , String
"<STRING>.              \t LITERAL_BUFFER_APPEND_CHAR(yytext[0]);"
    , String
"<ESCAPED>n             \t LITERAL_BUFFER_APPEND_CHAR('\\n'); BEGIN STRING;"
    , String
"<ESCAPED>\\\"            \t LITERAL_BUFFER_APPEND_CHAR('\"');  BEGIN STRING;"
    , String
"<ESCAPED>\\\\            \t LITERAL_BUFFER_APPEND_CHAR('\\\\'); BEGIN STRING;"
    , String
"<ESCAPED>t             \t LITERAL_BUFFER_APPEND_CHAR('\\t'); BEGIN STRING;"
    , String
"<ESCAPED>.             \t LITERAL_BUFFER_APPEND(yytext);    BEGIN STRING;"
    , String
"<STRING,ESCAPED><<EOF>>\t LITERAL_BUFFER_FREE(); return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorToken String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    ]

-- | Lexing of characters, converting escaped characters.
lexChars :: String -> String -> [String]
lexChars :: String -> String -> [String]
lexChars String
yylval String
charToken =
    [ String
"<YYINITIAL>\"'\" \tBEGIN CHAR;"
    , String
"<CHAR>\\\\      \t BEGIN CHARESC;"
    , String
"<CHAR>[^']      \t BEGIN CHAREND; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
yylval String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"._char = yytext[0]; return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
charToken String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    , String
"<CHARESC>n      \t BEGIN CHAREND; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
yylval String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"._char = '\\n';     return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
charToken String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    , String
"<CHARESC>t      \t BEGIN CHAREND; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
yylval String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"._char = '\\t';     return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
charToken String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    , String
"<CHARESC>.      \t BEGIN CHAREND; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
yylval String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"._char = yytext[0]; return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
charToken String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
    , String
"<CHAREND>\"'\"      \t BEGIN YYINITIAL;"
    ]

-- ---------------------------------------------------------------------------
-- Comments

-- | Create flex rules for single-line and multi-lines comments.
-- The first argument is an optional namespace (for C++); the second
-- argument is the set of comment delimiters as returned by BNFC.CF.comments.
--
-- This function is only compiling the results of applying either
-- lexSingleComment or lexMultiComment on each comment delimiter or pair of
-- delimiters.
--
-- >>> lexComments (Just "myns.") ([("{-","-}")],["--"])
-- <YYINITIAL>"--"[^\n]* /* skip */; /* BNFC: comment "--" */
-- <YYINITIAL>"{-" BEGIN COMMENT; /* BNFC: block comment "{-" "-}" */
-- <COMMENT>"-}" BEGIN YYINITIAL;
-- <COMMENT>.    /* skip */;
-- <COMMENT>[\n] /* skip */;
lexComments :: Maybe String -> ([(String, String)], [String]) -> Doc
lexComments :: Maybe String -> (KeywordEnv, [String]) -> Doc
lexComments Maybe String
_ (KeywordEnv
m,[String]
s) = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map    String -> Doc
lexSingleComment [String]
s
  , ((String, String) -> String -> Doc)
-> KeywordEnv -> [String] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String, String) -> String -> Doc
lexMultiComment KeywordEnv
m [String]
commentStates
  ]

-- | If we have several block comments, we need different COMMENT lexing states.
commentStates :: [String]
commentStates :: [String]
commentStates = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"COMMENT" String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [Integer
1..]

-- | Create a lexer rule for single-line comments.
-- The first argument is -- an optional c++ namespace
-- The second argument is the delimiter that marks the beginning of the
-- comment.
--
-- >>> lexSingleComment "--"
-- <YYINITIAL>"--"[^\n]* /* skip */; /* BNFC: comment "--" */
--
-- >>> lexSingleComment "\""
-- <YYINITIAL>"\""[^\n]* /* skip */; /* BNFC: comment "\"" */
lexSingleComment :: String -> Doc
lexSingleComment :: String -> Doc
lexSingleComment String
c =
    Doc
"<YYINITIAL>" Doc -> Doc -> Doc
<> String -> Doc
cstring String
c Doc -> Doc -> Doc
<> Doc
"[^\\n]*"
    Doc -> Doc -> Doc
<+> Doc
"/* skip */;"
    Doc -> Doc -> Doc
<+> Bool -> Doc -> Doc
forall m. Monoid m => Bool -> m -> m
unless (String -> Bool
containsCCommentMarker String
c) (Doc
"/* BNFC: comment" Doc -> Doc -> Doc
<+> String -> Doc
cstring String
c Doc -> Doc -> Doc
<+> Doc
"*/")

containsCCommentMarker :: String -> Bool
containsCCommentMarker :: String -> Bool
containsCCommentMarker String
s = String
"/*" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s Bool -> Bool -> Bool
|| String
"*/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s

-- | Create a lexer rule for multi-lines comments.
-- The first argument is -- an optional c++ namespace
-- The second arguments is the pair of delimiter for the multi-lines comment:
-- start deleminiter and end delimiter.
-- There might be a possible bug here if a language includes 2 multi-line
-- comments. They could possibly start a comment with one character and end it
-- with another.  However this seems rare.
--
-- >>> lexMultiComment ("{-", "-}") "COMMENT"
-- <YYINITIAL>"{-" BEGIN COMMENT; /* BNFC: block comment "{-" "-}" */
-- <COMMENT>"-}" BEGIN YYINITIAL;
-- <COMMENT>.    /* skip */;
-- <COMMENT>[\n] /* skip */;
--
-- >>> lexMultiComment ("\"'", "'\"") "COMMENT"
-- <YYINITIAL>"\"'" BEGIN COMMENT; /* BNFC: block comment "\"'" "'\"" */
-- <COMMENT>"'\"" BEGIN YYINITIAL;
-- <COMMENT>.    /* skip */;
-- <COMMENT>[\n] /* skip */;
lexMultiComment :: (String, String) -> String -> Doc
lexMultiComment :: (String, String) -> String -> Doc
lexMultiComment (String
b,String
e) String
comment = [Doc] -> Doc
vcat
    [ Doc
"<YYINITIAL>" Doc -> Doc -> Doc
<> String -> Doc
cstring String
b Doc -> Doc -> Doc
<+> Doc
"BEGIN" Doc -> Doc -> Doc
<+> String -> Doc
text String
comment Doc -> Doc -> Doc
<> Doc
";"
      Doc -> Doc -> Doc
<+> Bool -> Doc -> Doc
forall m. Monoid m => Bool -> m -> m
unless (String -> Bool
containsCCommentMarker String
b Bool -> Bool -> Bool
|| String -> Bool
containsCCommentMarker String
e)
          (Doc
"/* BNFC: block comment" Doc -> Doc -> Doc
<+> String -> Doc
cstring String
b Doc -> Doc -> Doc
<+> String -> Doc
cstring String
e Doc -> Doc -> Doc
<+> Doc
"*/")
    , Doc
commentTag Doc -> Doc -> Doc
<> String -> Doc
cstring String
e Doc -> Doc -> Doc
<+> Doc
"BEGIN YYINITIAL;"
    , Doc
commentTag Doc -> Doc -> Doc
<> Doc
".    /* skip */;"
    , Doc
commentTag Doc -> Doc -> Doc
<> Doc
"[\\n] /* skip */;"
    ]
  where
  commentTag :: Doc
commentTag = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
comment String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"

-- | Helper function that escapes characters in strings.
escapeChars :: String -> String
escapeChars :: String -> String
escapeChars [] = []
escapeChars (Char
'\\':String
xs) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: (String -> String
escapeChars String
xs))
escapeChars (Char
'\"':String
xs) = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char
'\"' Char -> String -> String
forall a. a -> [a] -> [a]
: (String -> String
escapeChars String
xs))
escapeChars (Char
x:String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: (String -> String
escapeChars String
xs)