{-# LANGUAGE NoImplicitPrelude #-}

{-
    BNF Converter: Java JLex generator
    Copyright (C) 2004  Author:  Michael Pellauer

    Description   : This module generates the JLex input file. This
                    file is quite different than Alex or Flex.

    Author        : Michael Pellauer
                    Bjorn Bringert

    Created       : 25 April, 2003
    Modified      : 4 Nov, 2004

-}

module BNFC.Backend.Java.CFtoJLex15 ( cf2jlex ) where

import Prelude hiding ((<>))

import BNFC.CF
import BNFC.Backend.Common.NamedVariables
import BNFC.Backend.C.CFtoFlexC           ( commentStates )
import BNFC.Backend.Java.RegToJLex
import BNFC.Options                       ( JavaLexerParser(..), RecordPositions(..) )
import BNFC.Utils                         ( cstring )

import Text.PrettyPrint

-- | The environment is returned for further use in the parser.
cf2jlex :: JavaLexerParser -> RecordPositions -> String -> CF -> (Doc, SymEnv)
cf2jlex :: JavaLexerParser -> RecordPositions -> [Char] -> CF -> (Doc, SymEnv)
cf2jlex JavaLexerParser
jflex RecordPositions
rp [Char]
packageBase CF
cf = (, SymEnv
env) (Doc -> (Doc, SymEnv)) -> ([Doc] -> Doc) -> [Doc] -> (Doc, SymEnv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
vcat ([Doc] -> (Doc, SymEnv)) -> [Doc] -> (Doc, SymEnv)
forall a b. (a -> b) -> a -> b
$
  [ JavaLexerParser -> RecordPositions -> [Char] -> Doc
prelude JavaLexerParser
jflex RecordPositions
rp [Char]
packageBase
  , CF -> Doc
cMacros CF
cf
  , JavaLexerParser -> SymEnv -> Doc
lexSymbols JavaLexerParser
jflex SymEnv
env
  , JavaLexerParser -> RecordPositions -> CF -> Doc
restOfJLex JavaLexerParser
jflex RecordPositions
rp CF
cf
  ]
  where
  env :: SymEnv
env = ([Char] -> Int -> ([Char], [Char])) -> [[Char]] -> [Int] -> SymEnv
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\ [Char]
s Int
n -> ([Char]
s, [Char]
"_SYMB_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n)) (CF -> [[Char]]
forall function. CFG function -> [[Char]]
cfgSymbols CF
cf [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ CF -> [[Char]]
forall function. CFG function -> [[Char]]
reservedWords CF
cf) [(Int
0 :: Int)..]

-- | File prelude.
prelude :: JavaLexerParser -> RecordPositions -> String -> Doc
prelude :: JavaLexerParser -> RecordPositions -> [Char] -> Doc
prelude JavaLexerParser
jflex RecordPositions
rp [Char]
packageBase = [Doc] -> Doc
vcat
    [ [Doc] -> Doc
hsep [ Doc
"// This", Doc
lexerName, Doc
"file was machine-generated by the BNF converter" ]
    , Doc
"package" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
packageBase Doc -> Doc -> Doc
<> Doc
";"
    , Doc
""
    , Doc
"import java_cup.runtime.*;"
    , Doc
"%%"
    , Doc
"%cup"
    , Doc
"%unicode"
    , (if RecordPositions
rp RecordPositions -> RecordPositions -> Bool
forall a. Eq a => a -> a -> Bool
== RecordPositions
RecordPositions
      then [Doc] -> Doc
vcat
        [ Doc
"%line"
        , (if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup then Doc
"%column" else Doc
"")
        , Doc
"%char" ]
      else Doc
"")
    , Doc
"%public"
    , Doc
"%{"
    , Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
        [ Doc
"String pstring = new String();"
        , Doc
"final int unknown = -1;"
        , Doc
"ComplexSymbolFactory.Location left = new ComplexSymbolFactory.Location(unknown, unknown);"
        , Doc
"ComplexSymbolFactory cf = new ComplexSymbolFactory();"
        , Doc
"public SymbolFactory getSymbolFactory() { return cf; }"
        , Doc
positionDeclarations
        , Doc
"public int line_num() { return (yyline+1); }"
        , Doc
"public ComplexSymbolFactory.Location left_loc() {"
        , if RecordPositions
rp RecordPositions -> RecordPositions -> Bool
forall a. Eq a => a -> a -> Bool
== RecordPositions
RecordPositions
            then Doc
"  return new ComplexSymbolFactory.Location(yyline+1, yycolumn+1, yychar);"
            else Doc
"  return left;"
        , Doc
"}"
        , Doc
"public ComplexSymbolFactory.Location right_loc() {"
        , Doc
"  ComplexSymbolFactory.Location left = left_loc();"
        , (if RecordPositions
rp RecordPositions -> RecordPositions -> Bool
forall a. Eq a => a -> a -> Bool
== RecordPositions
RecordPositions
            then Doc
"return new ComplexSymbolFactory.Location(left.getLine(), left.getColumn()+yylength(), left.getOffset()+yylength());"
            else Doc
"return left;")
        , Doc
"}"
        , Doc
"public String buff()" Doc -> Doc -> Doc
<+> Doc -> Doc
braces
            (if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup
            then Doc
"return new String(zzBuffer,zzCurrentPos,10).trim();"
            else Doc
"return new String(yy_buffer,yy_buffer_index,10).trim();")
        ]
    , Doc
"%}"
    , if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
/= JavaLexerParser
JFlexCup then [Doc] -> Doc
vcat [Doc
"%eofval{"
      , Doc
"  return cf.newSymbol(\"EOF\", sym.EOF, left_loc(), left_loc());"
      , Doc
"%eofval}"]
        else Doc
""
    ]
  where
    lexerName :: Doc
lexerName = case JavaLexerParser
jflex of
      JavaLexerParser
JFlexCup -> Doc
"JFlex"
      JavaLexerParser
JLexCup  -> Doc
"JLex"
      JavaLexerParser
Antlr4   -> Doc
forall a. HasCallStack => a
undefined
    positionDeclarations :: Doc
positionDeclarations
      -- JFlex always defines yyline, yychar, yycolumn, even if unused.
      | JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup     = Doc
""
      | RecordPositions
rp RecordPositions -> RecordPositions -> Bool
forall a. Eq a => a -> a -> Bool
== RecordPositions
RecordPositions = Doc
"int yycolumn = unknown - 1;"
      | Bool
otherwise             = [Doc] -> Doc
vcat
            -- subtract one so that one based numbering still ends up with unknown.
            [ Doc
"int yyline = unknown - 1;"
            , Doc
"int yycolumn = unknown - 1;"
            , Doc
"int yychar = unknown;"
            ]

--For now all categories are included.
--Optimally only the ones that are used should be generated.
cMacros :: CF -> Doc
cMacros :: CF -> Doc
cMacros CF
cf = [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
  [ [ Doc
"LETTER = ({CAPITAL}|{SMALL})"
    , Doc
"CAPITAL = [A-Z\\xC0-\\xD6\\xD8-\\xDE]"
    , Doc
"SMALL = [a-z\\xDF-\\xF6\\xF8-\\xFF]"
    , Doc
"DIGIT = [0-9]"
    , Doc
"IDENT = ({LETTER}|{DIGIT}|['_])"
    ]
  , ([Char] -> Doc) -> [[Char]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Doc
text ([Char] -> Doc) -> ([Char] -> [Char]) -> [Char] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"%state " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)) ([[Char]] -> [Doc]) -> [[Char]] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take (CF -> Int
numberOfBlockCommentForms CF
cf) [[Char]]
commentStates
  , [ Doc
"%state CHAR"
    , Doc
"%state CHARESC"
    , Doc
"%state CHAREND"
    , Doc
"%state STRING"
    , Doc
"%state ESCAPED"
    , Doc
"%%"
    ]
  ]

-- |
-- >>> lexSymbols JLexCup [("foo","bar")]
-- <YYINITIAL>foo { return cf.newSymbol("", sym.bar, left_loc(), right_loc()); }
--
-- >>> lexSymbols JLexCup [("\\","bar")]
-- <YYINITIAL>\\ { return cf.newSymbol("", sym.bar, left_loc(), right_loc()); }
--
-- >>> lexSymbols JLexCup [("/","bar")]
-- <YYINITIAL>/ { return cf.newSymbol("", sym.bar, left_loc(), right_loc()); }
--
-- >>> lexSymbols JFlexCup [("/","bar")]
-- <YYINITIAL>\/ { return cf.newSymbol("", sym.bar, left_loc(), right_loc()); }
--
-- >>> lexSymbols JFlexCup [("~","bar")]
-- <YYINITIAL>\~ { return cf.newSymbol("", sym.bar, left_loc(), right_loc()); }
--
lexSymbols :: JavaLexerParser -> SymEnv -> Doc
lexSymbols :: JavaLexerParser -> SymEnv -> Doc
lexSymbols JavaLexerParser
jflex SymEnv
ss = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$  (([Char], [Char]) -> Doc) -> SymEnv -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> Doc
transSym SymEnv
ss
  where
    transSym :: ([Char], [Char]) -> Doc
transSym ([Char]
s,[Char]
r) =
      Doc
"<YYINITIAL>" Doc -> Doc -> Doc
<> [Char] -> Doc
text ([Char] -> [Char]
escapeChars [Char]
s) Doc -> Doc -> Doc
<> Doc
" { return cf.newSymbol(\"\", sym."
      Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
r Doc -> Doc -> Doc
<> Doc
", left_loc(), right_loc()); }"
    --Helper function that escapes characters in strings
    escapeChars :: String -> String
    escapeChars :: [Char] -> [Char]
escapeChars = (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (JavaLexerParser -> Char -> [Char]
escapeChar JavaLexerParser
jflex)

restOfJLex :: JavaLexerParser -> RecordPositions -> CF -> Doc
restOfJLex :: JavaLexerParser -> RecordPositions -> CF -> Doc
restOfJLex JavaLexerParser
jflex RecordPositions
rp CF
cf = [Doc] -> Doc
vcat
    [ (SymEnv, [[Char]]) -> Doc
lexComments (CF -> (SymEnv, [[Char]])
comments CF
cf)
    , Doc
""
    , Doc
userDefTokens
    , [Char] -> Doc -> Doc
ifC [Char]
catString Doc
strStates
    , [Char] -> Doc -> Doc
ifC [Char]
catChar Doc
chStates
    , [Char] -> Doc -> Doc
ifC [Char]
catDouble
        Doc
"<YYINITIAL>{DIGIT}+\".\"{DIGIT}+(\"e\"(\\-)?{DIGIT}+)? { return cf.newSymbol(\"\", sym._DOUBLE_, left_loc(), right_loc(), new Double(yytext())); }"
    , [Char] -> Doc -> Doc
ifC [Char]
catInteger
        Doc
"<YYINITIAL>{DIGIT}+ { return cf.newSymbol(\"\", sym._INTEGER_, left_loc(), right_loc(), new Integer(yytext())); }"
    , [Char] -> Doc -> Doc
ifC [Char]
catIdent
        Doc
"<YYINITIAL>{LETTER}{IDENT}* { return cf.newSymbol(\"\", sym._IDENT_, left_loc(), right_loc(), yytext().intern()); }"
    , Doc
"<YYINITIAL>[ \\t\\r\\n\\f] { /* ignore white space. */ }"
    , if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup
        then Doc
"<<EOF>> { return cf.newSymbol(\"EOF\", sym.EOF, left_loc(), left_loc()); }"
        else Doc
""
    , if RecordPositions
rp RecordPositions -> RecordPositions -> Bool
forall a. Eq a => a -> a -> Bool
== RecordPositions
RecordPositions
        then Doc
". { throw new Error(\"Illegal Character <\"+yytext()+\"> at \"+(yyline+1)" Doc -> Doc -> Doc
<>
          (if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup then Doc
"+\":\"+(yycolumn+1)+\"(\"+yychar+\")\"" else Doc
"") Doc -> Doc -> Doc
<> Doc
"); }"
        else Doc
". { throw new Error(\"Illegal Character <\"+yytext()+\">\"); }"
    ]
  where
    ifC :: TokenCat -> Doc -> Doc
    ifC :: [Char] -> Doc -> Doc
ifC [Char]
cat Doc
s = if CF -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CF
cf ([Char] -> Cat
TokenCat [Char]
cat) then Doc
s else Doc
""
    userDefTokens :: Doc
userDefTokens = [Doc] -> Doc
vcat
        [ Doc
"<YYINITIAL>" Doc -> Doc -> Doc
<> [Char] -> Doc
text (JavaLexerParser -> Reg -> [Char]
printRegJLex JavaLexerParser
jflex Reg
exp)
            Doc -> Doc -> Doc
<+> Doc
"{ return cf.newSymbol(\"\", sym." Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
name
            Doc -> Doc -> Doc
<> Doc
", left_loc(), right_loc(), yytext().intern()); }"
        | ([Char]
name, Reg
exp) <- CF -> [([Char], Reg)]
forall f. CFG f -> [([Char], Reg)]
tokenPragmas CF
cf ]
    strStates :: Doc
strStates = [Doc] -> Doc
vcat --These handle escaped characters in Strings.
        [ Doc
"<YYINITIAL>\"\\\"\" { left = left_loc(); yybegin(STRING); }"
        , Doc
"<STRING>\\\\ { yybegin(ESCAPED); }"
        , Doc
"<STRING>\\\" { String foo = pstring; pstring = new String(); yybegin(YYINITIAL); return cf.newSymbol(\"\", sym._STRING_, left, right_loc(), foo.intern()); }"
        , Doc
"<STRING>.  { pstring += yytext(); }"
        , Doc
"<STRING>\\r\\n|\\r|\\n { throw new Error(\"Unterminated string on line \" + left.getLine() " Doc -> Doc -> Doc
<>
          (if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup then Doc
"+ \" begining at column \" + left.getColumn()" else Doc
"") Doc -> Doc -> Doc
<> Doc
"); }"
        , if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup
          then Doc
"<STRING><<EOF>> { throw new Error(\"Unterminated string at EOF, beginning at \" + left.getLine() + \":\" + left.getColumn()); }"
          else Doc
""
        , Doc
"<ESCAPED>n { pstring +=  \"\\n\"; yybegin(STRING); }"
        , Doc
"<ESCAPED>t  { pstring += \"\\t\"; yybegin(STRING); }"
        , Doc
"<ESCAPED>r  { pstring += \"\\r\"; yybegin(STRING); }"
        , Doc
"<ESCAPED>f  { pstring += \"\\f\"; yybegin(STRING); }"
        , Doc
"<ESCAPED>\\\" { pstring += \"\\\"\"; yybegin(STRING); }"
        , Doc
"<ESCAPED>\\\\ { pstring += \"\\\\\"; yybegin(STRING); }"
        , Doc
"<ESCAPED>.  { pstring += yytext(); yybegin(STRING); }"
        , Doc
"<ESCAPED>\\r\\n|\\r|\\n { throw new Error(\"Unterminated string on line \" + left.getLine() " Doc -> Doc -> Doc
<>
          (if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup then Doc
"+ \" beginning at column \" + left.getColumn()" else Doc
"") Doc -> Doc -> Doc
<> Doc
"); }"
        , if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup
          then Doc
"<ESCAPED><<EOF>> { throw new Error(\"Unterminated string at EOF, beginning at \" + left.getLine() + \":\" + left.getColumn()); }"
          else Doc
""
        ]
    chStates :: Doc
chStates = [Doc] -> Doc
vcat --These handle escaped characters in Chars.
        [ Doc
"<YYINITIAL>\"'\" { left = left_loc(); yybegin(CHAR); }"
        , Doc
"<CHAR>\\\\ { yybegin(CHARESC); }"
        , Doc
"<CHAR>[^'] { yybegin(CHAREND); return cf.newSymbol(\"\", sym._CHAR_, left, right_loc(), new Character(yytext().charAt(0))); }"
        , Doc
"<CHAR>\\r\\n|\\r|\\n { throw new Error(\"Unterminated character literal on line \" + left.getLine() " Doc -> Doc -> Doc
<>
          (if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup then Doc
"+ \" beginning at column \" + left.getColumn()" else Doc
"") Doc -> Doc -> Doc
<> Doc
"); }"
        , if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup
          then Doc
"<CHAR><<EOF>> { throw new Error(\"Unterminated character literal at EOF, beginning at \" + left.getLine() + \":\" + left.getColumn()); }"
          else Doc
""
        , Doc
"<CHARESC>n { yybegin(CHAREND); return cf.newSymbol(\"\", sym._CHAR_, left, right_loc(), new Character('\\n')); }"
        , Doc
"<CHARESC>t { yybegin(CHAREND); return cf.newSymbol(\"\", sym._CHAR_, left, right_loc(), new Character('\\t')); }"
        , Doc
"<CHARESC>r { yybegin(CHAREND); return cf.newSymbol(\"\", sym._CHAR_, left, right_loc(), new Character('\\r')); }"
        , Doc
"<CHARESC>f { yybegin(CHAREND); return cf.newSymbol(\"\", sym._CHAR_, left, right_loc(), new Character('\\f')); }"
        , Doc
"<CHARESC>. { yybegin(CHAREND); return cf.newSymbol(\"\", sym._CHAR_, left, right_loc(), new Character(yytext().charAt(0))); }"
        , Doc
"<CHARESC>\\r\\n|\\r|\\n { throw new Error(\"Unterminated character literal on line \" + left.getLine() " Doc -> Doc -> Doc
<>
          (if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup then Doc
"+ \" beginning at column \" + left.getColumn()" else Doc
"") Doc -> Doc -> Doc
<> Doc
"); }"
        , if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup
          then Doc
"<CHARESC><<EOF>> { throw new Error(\"Unterminated character literal at EOF, beginning at \" + left.getLine() + \":\" + left.getColumn()); }"
          else Doc
""
        , Doc
"<CHAREND>\"'\" {yybegin(YYINITIAL);}"
        , Doc
"<CHAREND>\\r\\n|\\r|\\n { throw new Error(\"Unterminated character literal on line \" + left.getLine() " Doc -> Doc -> Doc
<>
          (if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup then Doc
"+ \" beginning at column \" + left.getColumn()" else Doc
"") Doc -> Doc -> Doc
<> Doc
"); }"
        , if JavaLexerParser
jflex JavaLexerParser -> JavaLexerParser -> Bool
forall a. Eq a => a -> a -> Bool
== JavaLexerParser
JFlexCup
          then Doc
"<CHAREND><<EOF>> { throw new Error(\"Unterminated character literal at EOF, beginning at \" + left.getLine() + \":\" + left.getColumn()); }"
          else Doc
""
        ]

lexComments :: ([(String, String)], [String]) -> Doc
lexComments :: (SymEnv, [[Char]]) -> Doc
lexComments (SymEnv
m,[[Char]]
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
  [ ([Char] -> Doc) -> [[Char]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc
lexSingleComment [[Char]]
s
  , (([Char], [Char]) -> [Char] -> Doc) -> SymEnv -> [[Char]] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ([Char], [Char]) -> [Char] -> Doc
lexMultiComment SymEnv
m [[Char]]
commentStates
  ]

-- | Create lexer rule for single-line comments.
--
-- >>> lexSingleComment "--"
-- <YYINITIAL>"--"[^\n]* { /* skip */ }
--
-- >>> lexSingleComment "\""
-- <YYINITIAL>"\""[^\n]* { /* skip */ }
lexSingleComment :: String -> Doc
lexSingleComment :: [Char] -> Doc
lexSingleComment [Char]
c =
  Doc
"<YYINITIAL>" Doc -> Doc -> Doc
<> [Char] -> Doc
cstring [Char]
c Doc -> Doc -> Doc
<>  Doc
"[^\\n]* { /* skip */ }"

-- | Create lexer rule for multi-lines comments.
--
-- 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>"{-" { yybegin(COMMENT); }
-- <COMMENT>"-}" { yybegin(YYINITIAL); }
-- <COMMENT>. { /* skip */ }
-- <COMMENT>[\n] { /* skip */ }
--
-- >>> lexMultiComment ("\"'", "'\"") "COMMENT"
-- <YYINITIAL>"\"'" { yybegin(COMMENT); }
-- <COMMENT>"'\"" { yybegin(YYINITIAL); }
-- <COMMENT>. { /* skip */ }
-- <COMMENT>[\n] { /* skip */ }
--
lexMultiComment :: (String, String) -> String -> Doc
lexMultiComment :: ([Char], [Char]) -> [Char] -> Doc
lexMultiComment ([Char]
b,[Char]
e) [Char]
comment = [Doc] -> Doc
vcat
    [ Doc
"<YYINITIAL>" Doc -> Doc -> Doc
<> [Char] -> Doc
cstring [Char]
b Doc -> Doc -> Doc
<+> Doc
"{ yybegin(" Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
comment Doc -> Doc -> Doc
<> Doc
"); }"
    , Doc
commentTag Doc -> Doc -> Doc
<> [Char] -> Doc
cstring [Char]
e Doc -> Doc -> Doc
<+> Doc
"{ yybegin(YYINITIAL); }"
    , Doc
commentTag Doc -> Doc -> Doc
<> Doc
". { /* skip */ }"
    , Doc
commentTag Doc -> Doc -> Doc
<> Doc
"[\\n] { /* skip */ }"
    ]
  where
  commentTag :: Doc
commentTag = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char]
"<" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
comment [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
">"