{-
    BNF Converter: TreeSitter Grammar Generator
    Copyright (C) 2004  Author:  Markus Forsberg, Michael Pellauer,
                                 Bjorn Bringert

    Description   : This module converts BNFC grammar to the contents of a
                    tree-sitter grammar.js file

    Author        : Kangjing Huang (huangkangjing@gmail.com)
    Created       : 08 Nov, 2023

-}

module BNFC.Backend.TreeSitter.CFtoTreeSitter where

import BNFC.Abs (Reg (RSeq, RSeqs, RStar, RAny))
import BNFC.Backend.TreeSitter.RegToJSReg
import BNFC.CF
import BNFC.Lexing (mkRegMultilineComment)
import BNFC.PrettyPrint
import Prelude hiding ((<>))

-- | Indent one level of 2 spaces
indent :: Doc -> Doc
indent :: Doc -> Doc
indent = Int -> Doc -> Doc
nest Int
2

-- | Create content of grammar.js file
cfToTreeSitter :: String -> CF -> Doc
cfToTreeSitter :: [Char] -> CF -> Doc
cfToTreeSitter [Char]
name CF
cf =
  -- Overall structure of grammar.js
  [Char] -> Doc
text [Char]
"module.exports = grammar({"
    Doc -> Doc -> Doc
$+$ Doc -> Doc
indent
      ( [Char] -> Doc
text [Char]
"name: '" Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
name Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"',"
          Doc -> Doc -> Doc
$+$ Doc
extrasSection
          Doc -> Doc -> Doc
$+$ Doc
wordSection
          Doc -> Doc -> Doc
$+$ Doc
rulesSection
      )
    Doc -> Doc -> Doc
$+$ [Char] -> Doc
text [Char]
"});"
  where
    extrasSection :: Doc
extrasSection = CF -> Doc
prExtras CF
cf
    wordSection :: Doc
wordSection = CF -> Doc
prWord CF
cf
    rulesSection :: Doc
rulesSection =
      [Char] -> Doc
text [Char]
"rules: {"
        Doc -> Doc -> Doc
$+$ Doc -> Doc
indent
          ( CF -> Doc
prRules CF
cf
              Doc -> Doc -> Doc
$+$ CF -> Doc
prUsrTokenRules CF
cf
              Doc -> Doc -> Doc
$+$ CF -> Doc
prBuiltinTokenRules CF
cf
          )
        Doc -> Doc -> Doc
$+$ [Char] -> Doc
text [Char]
"},"

-- | Print rules for comments
prExtras :: CF -> Doc
prExtras :: CF -> Doc
prExtras CF
cf =
  if Bool
extraNeeded
    then
      [Char] -> Doc
defineSymbol [Char]
"extras" Doc -> Doc -> Doc
<> Doc
"["
        Doc -> Doc -> Doc
$+$ Doc -> Doc
indent
          ( -- default rule for white spaces
            [Char] -> Doc
text [Char]
"/\\s/,"
              Doc -> Doc -> Doc
$+$ Doc
mRules
              Doc -> Doc -> Doc
$+$ Doc
sRules
          )
        Doc -> Doc -> Doc
$+$ [Char] -> Doc
text [Char]
"],"
    else Doc
empty
  where
    extraNeeded :: Bool
extraNeeded = [([Char], [Char])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Char], [Char])]
commentMRules Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
commentSRules Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    ([([Char], [Char])]
commentMRules, [[Char]]
commentSRules) = CF -> ([([Char], [Char])], [[Char]])
comments CF
cf
    mRules :: Doc
mRules = [Doc] -> Doc
vcat' ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (([Char], [Char]) -> Doc) -> [([Char], [Char])] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> Doc
mkOneMRule [([Char], [Char])]
commentMRules
    sRules :: Doc
sRules = [Doc] -> Doc
vcat' ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ([Char] -> Doc) -> [[Char]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc
mkOneSRule [[Char]]
commentSRules
    mkOneSRule :: [Char] -> Doc
mkOneSRule [Char]
s = [Char] -> Doc
text (Reg -> [Char]
printRegJSReg (Reg -> [Char]) -> Reg -> [Char]
forall a b. (a -> b) -> a -> b
$ Reg -> Reg -> Reg
RSeq ([Char] -> Reg
RSeqs [Char]
s) (Reg -> Reg
RStar Reg
RAny)) Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
","
    mkOneMRule :: ([Char], [Char]) -> Doc
mkOneMRule ([Char]
s, [Char]
e) = [Char] -> Doc
text (Reg -> [Char]
printRegJSReg (Reg -> [Char]) -> Reg -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Reg
mkRegMultilineComment [Char]
s [Char]
e) Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
","

-- | Print word section, this section is needed for tree-sitter
--   to do keyword extraction before any parsing/lexing, see
--   https://tree-sitter.github.io/tree-sitter/creating-parsers#keyword-extraction
--   TODO: currently, we just add every user defined token as well
--   as the predefined Ident token to this list to be safe. Ideally,
--   we should enumerate all defined tokens against all occurrences of
--   keywords. Any tokens patterns that could accept a keyword will go
--   into this list. This will require integration of a regex engine.
prWord :: CF -> Doc
prWord :: CF -> Doc
prWord CF
cf =
  if Bool
wordNeeded
    then
      [Char] -> Doc
defineSymbol [Char]
"word"
        Doc -> Doc -> Doc
$+$ Doc -> Doc
indent
          ( [Doc] -> Doc
wrapChoice
              ( [Doc]
usrTokensFormatted
                  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [[Char] -> Doc
text [Char]
"$.token_Ident" | Bool
identUsed]
              )
          )
          Doc -> Doc -> Doc
<> Doc
","
    else Doc
empty
  where
    wordNeeded :: Bool
wordNeeded = Bool
identUsed Bool -> Bool -> Bool
|| [([Char], Reg)]
usrTokens [([Char], Reg)] -> [([Char], Reg)] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
    identUsed :: Bool
identUsed = CF -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CF
cf ([Char] -> Cat
TokenCat [Char]
catIdent)
    usrTokens :: [([Char], Reg)]
usrTokens = CF -> [([Char], Reg)]
forall f. CFG f -> [([Char], Reg)]
tokenPragmas CF
cf
    usrTokensFormatted :: [Doc]
usrTokensFormatted =
      (([Char], Reg) -> Doc) -> [([Char], Reg)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Doc
text ([Char] -> Doc)
-> (([Char], Reg) -> [Char]) -> ([Char], Reg) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
refName ([Char] -> [Char])
-> (([Char], Reg) -> [Char]) -> ([Char], Reg) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Cat -> [Char]
formatCatName Bool
False (Cat -> [Char])
-> (([Char], Reg) -> Cat) -> ([Char], Reg) -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Cat
TokenCat ([Char] -> Cat)
-> (([Char], Reg) -> [Char]) -> ([Char], Reg) -> Cat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], Reg) -> [Char]
forall a b. (a, b) -> a
fst) ([([Char], Reg)] -> [Doc]) -> [([Char], Reg)] -> [Doc]
forall a b. (a -> b) -> a -> b
$ [([Char], Reg)]
usrTokens

-- | Print builtin token rules according to their usage
prBuiltinTokenRules :: CF -> Doc
prBuiltinTokenRules :: CF -> Doc
prBuiltinTokenRules CF
cf =
  [Char] -> Doc -> Doc
ifC [Char]
catInteger Doc
integerRule
    Doc -> Doc -> Doc
$+$ [Char] -> Doc -> Doc
ifC [Char]
catDouble Doc
doubleRule
    Doc -> Doc -> Doc
$+$ [Char] -> Doc -> Doc
ifC [Char]
catChar Doc
charRule
    Doc -> Doc -> Doc
$+$ [Char] -> Doc -> Doc
ifC [Char]
catString Doc
stringRule
    Doc -> Doc -> Doc
$+$ [Char] -> Doc -> Doc
ifC [Char]
catIdent Doc
identRule
  where
    ifC :: [Char] -> Doc -> Doc
ifC [Char]
cat Doc
d = if CF -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CF
cf ([Char] -> Cat
TokenCat [Char]
cat) then Doc
d else Doc
empty

-- | Predefined builtin token rules
integerRule, doubleRule, charRule, stringRule, identRule :: Doc
integerRule :: Doc
integerRule = [Char] -> Doc
defineSymbol [Char]
"token_Integer" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"/\\d+/" Doc -> Doc -> Doc
<> Doc
","
doubleRule :: Doc
doubleRule = [Char] -> Doc
defineSymbol [Char]
"token_Double" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"/\\d+\\.\\d+(e-?\\d+)?/" Doc -> Doc -> Doc
<> Doc
","
charRule :: Doc
charRule =
  [Char] -> Doc
defineSymbol [Char]
"token_Char" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"/'([^'\\\\]|(\\\\[\"'\\\\tnrf]))'/" Doc -> Doc -> Doc
<> Doc
","
stringRule :: Doc
stringRule =
  [Char] -> Doc
defineSymbol [Char]
"token_String" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"/\"([^'\\\\]|(\\\\[\"'\\\\tnrf]))*\"/" Doc -> Doc -> Doc
<> Doc
","
identRule :: Doc
identRule =
  [Char] -> Doc
defineSymbol [Char]
"token_Ident" Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
"/[a-zA-Z][a-zA-Z\\d_']*/" Doc -> Doc -> Doc
<> Doc
","

-- | First print the entrypoint rule, tree-sitter always use the
--   first rule as entrypoint and does not support multi-entrypoint.
--   Then print rest of the rules
prRules :: CF -> Doc
prRules :: CF -> Doc
prRules CF
cf =
  if Bool
onlyOneEntry
    then
      [Rule] -> Cat -> Doc
prOneCat [Rule]
entryRules Cat
entryCat
        Doc -> Doc -> Doc
$+$ Cat -> CF -> Doc
prOtherRules Cat
entryCat CF
cf
    else [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"Tree-sitter only supports one entrypoint"
  where
    --If entrypoint is defined, there must be only one entrypoint
    --If it is not defined, defaults to use the first rule as entrypoint
    onlyOneEntry :: Bool
onlyOneEntry = Bool -> Bool
not (CF -> Bool
forall f. CFG f -> Bool
hasEntryPoint CF
cf) Bool -> Bool -> Bool
|| Bool
onlyOneEntryDefined
    onlyOneEntryDefined :: Bool
onlyOneEntryDefined = NonEmpty Cat -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (CF -> NonEmpty Cat
forall f. CFG f -> NonEmpty Cat
allEntryPoints CF
cf) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
    entryCat :: Cat
entryCat = CF -> Cat
firstEntry CF
cf
    entryRules :: [Rule]
entryRules = CF -> Cat -> [Rule]
rulesForCat' CF
cf Cat
entryCat

-- | Print all other rules except the entrypoint
prOtherRules :: Cat -> CF -> Doc
prOtherRules :: Cat -> CF -> Doc
prOtherRules Cat
entryCat CF
cf = [Doc] -> Doc
vcat' ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Cat, [Rule]) -> Doc) -> [(Cat, [Rule])] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Cat, [Rule]) -> Doc
mkOne [(Cat, [Rule])]
rules
  where
    rules :: [(Cat, [Rule])]
rules = [(Cat
c, [Rule]
r) | (Cat
c, [Rule]
r) <- CF -> [(Cat, [Rule])]
ruleGroupsInternals CF
cf, Cat
c Cat -> Cat -> Bool
forall a. Eq a => a -> a -> Bool
/= Cat
entryCat]
    mkOne :: (Cat, [Rule]) -> Doc
mkOne (Cat
cat, [Rule]
rules) = [Rule] -> Cat -> Doc
prOneCat [Rule]
rules Cat
cat

prUsrTokenRules :: CF -> Doc
prUsrTokenRules :: CF -> Doc
prUsrTokenRules CF
cf = [Doc] -> Doc
vcat' ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (([Char], Reg) -> Doc) -> [([Char], Reg)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], Reg) -> Doc
prOneToken [([Char], Reg)]
tokens
  where
    tokens :: [([Char], Reg)]
tokens = CF -> [([Char], Reg)]
forall f. CFG f -> [([Char], Reg)]
tokenPragmas CF
cf

-- | Check if a set of rules contains internal rules
hasInternal :: [Rule] -> Bool
hasInternal :: [Rule] -> Bool
hasInternal = Bool -> Bool
not (Bool -> Bool) -> ([Rule] -> Bool) -> [Rule] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rule -> Bool) -> [Rule] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Rule -> Bool
forall f. Rul f -> Bool
isParsable

-- | Generates one or two tree-sitter rule(s) for one non-terminal from CF.
-- Uses choice function from tree-sitter to combine rules for the non-terminal
-- If the non-terminal has internal rules, an internal version of the non-terminal
-- will be created (prefixed with "_" in tree-sitter), and all internal rules will
-- be sectioned as such.
prOneCat :: [Rule] -> NonTerminal -> Doc
prOneCat :: [Rule] -> Cat -> Doc
prOneCat [Rule]
rules Cat
nt =
  [Char] -> Doc
defineSymbol (Bool -> Cat -> [Char]
formatCatName Bool
False Cat
nt)
    Doc -> Doc -> Doc
$+$ Doc -> Doc
indent (Doc -> Doc
appendComma Doc
parRhs)
    Doc -> Doc -> Doc
$+$ Doc
internalRules
  where
    int :: Bool
int = [Rule] -> Bool
hasInternal [Rule]
rules
    internalRules :: Doc
internalRules =
      if Bool
int
        then [Char] -> Doc
defineSymbol (Bool -> Cat -> [Char]
formatCatName Bool
True Cat
nt) Doc -> Doc -> Doc
$+$ Doc -> Doc
indent (Doc -> Doc
appendComma Doc
intRhs)
        else Doc
empty
    parRhs :: Doc
parRhs = [Doc] -> Doc
wrapChoice ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc]
transChoice [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Rule] -> [Doc]
forall {function}. [Rul function] -> [Doc]
genChoice ((Rule -> Bool) -> [Rule] -> [Rule]
forall a. (a -> Bool) -> [a] -> [a]
filter Rule -> Bool
forall f. Rul f -> Bool
isParsable [Rule]
rules)
    transChoice :: [Doc]
transChoice = [[Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
refName ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Bool -> Cat -> [Char]
formatCatName Bool
True Cat
nt | Bool
int]
    intRhs :: Doc
intRhs = [Doc] -> Doc
wrapChoice ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ [Rule] -> [Doc]
forall {function}. [Rul function] -> [Doc]
genChoice ((Rule -> Bool) -> [Rule] -> [Rule]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Rule -> Bool) -> Rule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rule -> Bool
forall f. Rul f -> Bool
isParsable) [Rule]
rules)
    genChoice :: [Rul function] -> [Doc]
genChoice = (Rul function -> Doc) -> [Rul function] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Doc] -> Doc
wrapSeq ([Doc] -> Doc) -> (Rul function -> [Doc]) -> Rul function -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SentForm -> [Doc]
formatRhs (SentForm -> [Doc])
-> (Rul function -> SentForm) -> Rul function -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rul function -> SentForm
forall function. Rul function -> SentForm
rhsRule)

-- | Generate one tree-sitter rule for one defined token
prOneToken :: (TokenCat, Reg) -> Doc
prOneToken :: ([Char], Reg) -> Doc
prOneToken ([Char]
cat, Reg
exp) =
  [Char] -> Doc
defineSymbol (Bool -> Cat -> [Char]
formatCatName Bool
False (Cat -> [Char]) -> Cat -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Cat
TokenCat [Char]
cat)
    Doc -> Doc -> Doc
$+$ Doc -> Doc
indent ([Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ Reg -> [Char]
printRegJSReg Reg
exp) Doc -> Doc -> Doc
<> Doc
","

-- | Start a defined symbol block in tree-sitter grammar
defineSymbol :: String -> Doc
defineSymbol :: [Char] -> Doc
defineSymbol [Char]
name = [Doc] -> Doc
hsep [[Char] -> Doc
text [Char]
name Doc -> Doc -> Doc
<> Doc
":", [Char] -> Doc
text [Char]
"$", [Char] -> Doc
text [Char]
"=>"]

appendComma :: Doc -> Doc
appendComma :: Doc -> Doc
appendComma = (Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
",")

commaJoin :: Bool -> [Doc] -> Doc
commaJoin :: Bool -> [Doc] -> Doc
commaJoin Bool
newline =
  (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Doc -> Doc -> Doc
comma Doc
empty
  where
    comma :: Doc -> Doc -> Doc
comma Doc
a Doc
b
      | Doc -> Bool
isEmpty Doc
a = Doc
b
      | Doc -> Bool
isEmpty Doc
b = Doc
a
      | Bool
otherwise = (if Bool
newline then Doc -> Doc -> Doc
($+$) else Doc -> Doc -> Doc
(<>)) (Doc
a Doc -> Doc -> Doc
<> Doc
",") Doc
b

wrapSeq :: [Doc] -> Doc
wrapSeq :: [Doc] -> Doc
wrapSeq = [Char] -> Bool -> [Doc] -> Doc
wrapOptListFun [Char]
"seq" Bool
False

wrapChoice :: [Doc] -> Doc
wrapChoice :: [Doc] -> Doc
wrapChoice = [Char] -> Bool -> [Doc] -> Doc
wrapOptListFun [Char]
"choice" Bool
True

-- | Wrap list using tree-sitter fun if the list contains multiple items
-- Returns the only item without wrapping otherwise
wrapOptListFun :: String -> Bool -> [Doc] -> Doc
wrapOptListFun :: [Char] -> Bool -> [Doc] -> Doc
wrapOptListFun [Char]
fun Bool
newline [Doc]
list =
  if [Doc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc]
list Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
    then [Doc] -> Doc
forall a. HasCallStack => [a] -> a
head [Doc]
list
    else [Char] -> Bool -> Doc -> Doc
wrapFun [Char]
fun Bool
newline (Bool -> [Doc] -> Doc
commaJoin Bool
newline [Doc]
list)

wrapFun :: String -> Bool -> Doc -> Doc
wrapFun :: [Char] -> Bool -> Doc -> Doc
wrapFun [Char]
fun Bool
newline Doc
arg = [Doc] -> Doc
joinOp [[Char] -> Doc
text [Char]
fun Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"(", Doc -> Doc
indent Doc
arg, [Char] -> Doc
text [Char]
")"]
  where
    joinOp :: [Doc] -> Doc
joinOp = if Bool
newline then [Doc] -> Doc
vcat' else [Doc] -> Doc
hcat

-- | Helper for referring to non-terminal names in tree-sitter
refName :: String -> String
refName :: [Char] -> [Char]
refName = ([Char]
"$." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)

-- | Format right hand side into list of strings
formatRhs :: SentForm -> [Doc]
formatRhs :: SentForm -> [Doc]
formatRhs =
  (Either Cat [Char] -> Doc) -> SentForm -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\case
    Left Cat
c -> [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
refName ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Bool -> Cat -> [Char]
formatCatName Bool
False Cat
c
    Right [Char]
term -> [Char] -> Doc
quoted [Char]
term)

quoted :: String -> Doc
quoted :: [Char] -> Doc
quoted [Char]
s = [Char] -> Doc
text [Char]
"\"" Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
s Doc -> Doc -> Doc
<> [Char] -> Doc
text [Char]
"\""

-- | Format string for cat name, prefix "_" if the name is for internal rules
formatCatName :: Bool -> Cat -> String
formatCatName :: Bool -> Cat -> [Char]
formatCatName Bool
internal Cat
c =
  if Bool
internal
    then [Char]
"_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
formatted
    else [Char]
formatted
  where
    formatted :: [Char]
formatted = Cat -> [Char]
formatName Cat
c
    formatName :: Cat -> [Char]
formatName (Cat [Char]
name) = [Char]
name
    formatName (TokenCat [Char]
name) = [Char]
"token_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name
    formatName (ListCat Cat
c) = [Char]
"list_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
formatName Cat
c
    formatName (CoercCat [Char]
name Integer
i) = [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i