{-
    BNF Converter: Antlr4 Java 1.8 Generator
    Copyright (C) 2004  Author:  Markus Forsberg, Michael Pellauer,
                                 Bjorn Bringert

    Description   : This module generates the ANTLR .g4 input file. It
                    follows the same basic structure of CFtoHappy.

    Author        : Gabriele Paganelli (gapag@distruzione.org)
    Created       : 15 Oct, 2015

-}

{-# LANGUAGE LambdaCase #-}

module BNFC.Backend.Java.CFtoAntlr4Parser ( cf2AntlrParse ) where

import Data.Foldable ( toList )
import Data.List     ( intercalate )
import Data.Maybe

import BNFC.CF
import BNFC.Options ( RecordPositions(..) )
import BNFC.Utils   ( (+++), (+.+), applyWhen )

import BNFC.Backend.Java.Utils
import BNFC.Backend.Common.NamedVariables
import BNFC.Backend.Java.CFtoCup15 ( definedRules )

-- Type declarations

-- | A definition of a non-terminal by all its rhss,
--   together with parse actions.
data PDef = PDef
  { PDef -> Maybe [Char]
_pdNT   :: Maybe String
      -- ^ If given, the name of the lhss.  Usually computed from 'pdCat'.
  , PDef -> Cat
_pdCat  :: Cat
      -- ^ The category to parse.
  , PDef -> [([Char], [Char], Maybe [Char])]
_pdAlts :: [(Pattern, Action, Maybe Fun)]
      -- ^ The possible rhss with actions.  If 'null', skip this 'PDef'.
      --   Where 'Nothing', skip ANTLR rule label.
  }
type Rules       = [PDef]
type Pattern     = String
type Action      = String
type MetaVar     = (String, Cat)

-- | Creates the ANTLR parser grammar for this CF.
--The environment comes from CFtoAntlr4Lexer
cf2AntlrParse :: String -> String -> CF -> RecordPositions -> KeywordEnv -> String
cf2AntlrParse :: [Char] -> [Char] -> CF -> RecordPositions -> KeywordEnv -> [Char]
cf2AntlrParse [Char]
packageBase [Char]
packageAbsyn CF
cf RecordPositions
_ KeywordEnv
env = [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ [Char]
header
    , [Char]
tokens
    , [Char]
"@members {"
    ]
  , ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"  " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> CF -> [[Char]]
definedRules [Char]
packageAbsyn CF
cf
  , [ [Char]
"}"
    , [Char]
""
    -- Generate start rules [#272]
    -- _X returns [ dX result ] : x=X EOF { $result = $x.result; }
    , [Char] -> Rules -> [Char]
prRules [Char]
packageAbsyn (Rules -> [Char]) -> Rules -> [Char]
forall a b. (a -> b) -> a -> b
$ (Cat -> PDef) -> [Cat] -> Rules
forall a b. (a -> b) -> [a] -> [b]
map Cat -> PDef
entrypoint ([Cat] -> Rules) -> [Cat] -> Rules
forall a b. (a -> b) -> a -> b
$ NonEmpty Cat -> [Cat]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Cat -> [Cat]) -> NonEmpty Cat -> [Cat]
forall a b. (a -> b) -> a -> b
$ CF -> NonEmpty Cat
forall f. CFG f -> NonEmpty Cat
allEntryPoints CF
cf
    -- Generate regular rules
    , [Char] -> Rules -> [Char]
prRules [Char]
packageAbsyn (Rules -> [Char]) -> Rules -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> CF -> KeywordEnv -> Rules
rulesForAntlr4 [Char]
packageAbsyn CF
cf KeywordEnv
env
    ]
  ]
  where
    header :: String
    header :: [Char]
header = [[Char]] -> [Char]
unlines
        [ [Char]
"// -*- Java -*- This ANTLRv4 file was machine-generated by BNFC"
        , [Char]
"parser grammar" [Char] -> [Char] -> [Char]
+++ [Char]
identifier [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"Parser;"
        ]
    tokens :: String
    tokens :: [Char]
tokens = [[Char]] -> [Char]
unlines
        [ [Char]
"options {"
        , [Char]
"  tokenVocab = "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
identifier[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"Lexer;"
        , [Char]
"}"
        ]
    identifier :: [Char]
identifier = [Char] -> [Char]
getLastInPackage [Char]
packageBase

-- | Generate start rule to help ANTLR.
--
--   @start_X returns [ X result ] : x=X EOF { $result = $x.result; } # Start_X@
--
entrypoint :: Cat -> PDef
entrypoint :: Cat -> PDef
entrypoint Cat
cat =
  Maybe [Char] -> Cat -> [([Char], [Char], Maybe [Char])] -> PDef
PDef ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
nt) Cat
cat [([Char]
pat, [Char]
act, Maybe [Char]
forall {a}. Maybe a
fun)]
  where
  nt :: [Char]
nt  = [Char] -> [Char]
firstLowerCase ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
startSymbol ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Cat -> [Char]
identCat Cat
cat
  pat :: [Char]
pat = [Char]
"x=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
catToNT Cat
cat [Char] -> [Char] -> [Char]
+++ [Char]
"EOF"
  act :: [Char]
act = [Char]
"$result = $x.result;"
  fun :: Maybe a
fun = Maybe a
forall {a}. Maybe a
Nothing -- No ANTLR Rule label, ("Start_" ++ identCat cat) conflicts with lhs.

--The following functions are a (relatively) straightforward translation
--of the ones in CFtoHappy.hs
rulesForAntlr4 :: String -> CF -> KeywordEnv -> Rules
rulesForAntlr4 :: [Char] -> CF -> KeywordEnv -> Rules
rulesForAntlr4 [Char]
packageAbsyn CF
cf KeywordEnv
env = ((Cat, [Rule]) -> PDef) -> [(Cat, [Rule])] -> Rules
forall a b. (a -> b) -> [a] -> [b]
map (Cat, [Rule]) -> PDef
mkOne [(Cat, [Rule])]
getrules
  where
    getrules :: [(Cat, [Rule])]
getrules          = CF -> [(Cat, [Rule])]
ruleGroups CF
cf
    mkOne :: (Cat, [Rule]) -> PDef
mkOne (Cat
cat,[Rule]
rules) = [Char] -> CF -> KeywordEnv -> [Rule] -> Cat -> PDef
constructRule [Char]
packageAbsyn CF
cf KeywordEnv
env [Rule]
rules Cat
cat

-- | For every non-terminal, we construct a set of rules. A rule is a sequence of
-- terminals and non-terminals, and an action to be performed.
constructRule :: String -> CF -> KeywordEnv -> [Rule] -> NonTerminal -> PDef
constructRule :: [Char] -> CF -> KeywordEnv -> [Rule] -> Cat -> PDef
constructRule [Char]
packageAbsyn CF
cf KeywordEnv
env [Rule]
rules Cat
nt =
  Maybe [Char] -> Cat -> [([Char], [Char], Maybe [Char])] -> PDef
PDef Maybe [Char]
forall {a}. Maybe a
Nothing Cat
nt ([([Char], [Char], Maybe [Char])] -> PDef)
-> [([Char], [Char], Maybe [Char])] -> PDef
forall a b. (a -> b) -> a -> b
$
    [ ( [Char]
p
      , [Char] -> Cat -> RFun -> [MetaVar] -> Bool -> [Char]
forall f.
IsFun f =>
[Char] -> Cat -> f -> [MetaVar] -> Bool -> [Char]
generateAction [Char]
packageAbsyn Cat
nt (Rule -> RFun
forall function. Rul function -> function
funRule Rule
r) [MetaVar]
m Bool
b
      , Maybe [Char]
forall {a}. Maybe a
Nothing  -- labels not needed for BNFC-generated AST parser
      -- , Just label
      -- -- Did not work:
      -- -- , if firstLowerCase (getLabelName label)
      -- --   == getRuleName (firstLowerCase $ identCat nt) then Nothing else Just label
      )
    | (Int
index, Rule
r0) <- [Int] -> [Rule] -> [(Int, Rule)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] [Rule]
rules
    , let b :: Bool
b      = RFun -> Bool
forall a. IsFun a => a -> Bool
isConsFun (Rule -> RFun
forall function. Rul function -> function
funRule Rule
r0) Bool -> Bool -> Bool
&& Cat -> [Cat] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Rule -> Cat
forall fun. Rul fun -> Cat
valCat Rule
r0) (CF -> [Cat]
forall function. CFG function -> [Cat]
cfgReversibleCats CF
cf)
    , let r :: Rule
r      = Bool -> (Rule -> Rule) -> Rule -> Rule
forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
b Rule -> Rule
forall f. Rul f -> Rul f
revSepListRule Rule
r0
    , let ([Char]
p,[MetaVar]
m0) = Int -> KeywordEnv -> Rule -> ([Char], [MetaVar])
generatePatterns Int
index KeywordEnv
env Rule
r
    , let m :: [MetaVar]
m      = Bool -> ([MetaVar] -> [MetaVar]) -> [MetaVar] -> [MetaVar]
forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
b [MetaVar] -> [MetaVar]
forall a. [a] -> [a]
reverse [MetaVar]
m0
    -- , let label  = funRule r
    ]

-- Generates a string containing the semantic action.
generateAction :: IsFun f => String -> NonTerminal -> f -> [MetaVar]
               -> Bool   -- ^ Whether the list should be reversed or not.
                         --   Only used if this is a list rule.
               -> Action
generateAction :: forall f.
IsFun f =>
[Char] -> Cat -> f -> [MetaVar] -> Bool -> [Char]
generateAction [Char]
packageAbsyn Cat
nt f
f [MetaVar]
ms Bool
rev
    | f -> Bool
forall a. IsFun a => a -> Bool
isNilFun f
f = [Char]
"$result = new " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"();"
    | f -> Bool
forall a. IsFun a => a -> Bool
isOneFun f
f = [Char]
"$result = new " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(); $result.addLast("
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p_1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"
    | f -> Bool
forall a. IsFun a => a -> Bool
isConsFun f
f = [Char]
"$result = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p_2 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"; "
                           [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"$result." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
add [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p_1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"
    | f -> Bool
forall a. IsFun a => a -> Bool
isCoercion f
f = [Char]
"$result = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++  [Char]
p_1 [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
";"
    | f -> Bool
forall a. IsFun a => a -> Bool
isDefinedRule f
f = [Char]
"$result = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ f -> [Char]
forall a. IsFun a => a -> [Char]
funName f
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_"
                        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ((MetaVar -> [Char]) -> [MetaVar] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map MetaVar -> [Char]
resultvalue [MetaVar]
ms) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"
    | Bool
otherwise = [Char]
"$result = new " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ((MetaVar -> [Char]) -> [MetaVar] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map MetaVar -> [Char]
resultvalue [MetaVar]
ms) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
");"
   where
     c :: [Char]
c                 = [Char]
packageAbsyn [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
                            if f -> Bool
forall a. IsFun a => a -> Bool
isNilFun f
f Bool -> Bool -> Bool
|| f -> Bool
forall a. IsFun a => a -> Bool
isOneFun f
f Bool -> Bool -> Bool
|| f -> Bool
forall a. IsFun a => a -> Bool
isConsFun f
f
                            then Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
nt) else f -> [Char]
forall a. IsFun a => a -> [Char]
funName f
f
     p_1 :: [Char]
p_1               = MetaVar -> [Char]
resultvalue (MetaVar -> [Char]) -> MetaVar -> [Char]
forall a b. (a -> b) -> a -> b
$ [MetaVar]
ms[MetaVar] -> Int -> MetaVar
forall a. [a] -> Int -> a
!!Int
0
     p_2 :: [Char]
p_2               = MetaVar -> [Char]
resultvalue (MetaVar -> [Char]) -> MetaVar -> [Char]
forall a b. (a -> b) -> a -> b
$ [MetaVar]
ms[MetaVar] -> Int -> MetaVar
forall a. [a] -> Int -> a
!!Int
1
     add :: [Char]
add               = if Bool
rev then [Char]
"addLast" else [Char]
"addFirst"
     gettext :: [Char]
gettext           = [Char]
"getText()"
     removeQuotes :: [Char] -> [Char]
removeQuotes [Char]
x    = [Char]
"substring(1, "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
x [Char] -> [Char] -> [Char]
+.+ [Char]
gettext [Char] -> [Char] -> [Char]
+.+ [Char]
"length()-1)"
     parseint :: [Char] -> [Char]
parseint [Char]
x        = [Char]
"Integer.parseInt("[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
x[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
")"
     parsedouble :: [Char] -> [Char]
parsedouble [Char]
x     = [Char]
"Double.parseDouble("[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
x[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
")"
     charat :: [Char]
charat            = [Char]
"charAt(1)"
     resultvalue :: MetaVar -> [Char]
resultvalue ([Char]
n,Cat
c) = case Cat
c of
                          TokenCat [Char]
"Ident"   -> [Char]
n'[Char] -> [Char] -> [Char]
+.+[Char]
gettext
                          TokenCat [Char]
"Integer" -> [Char] -> [Char]
parseint ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
n'[Char] -> [Char] -> [Char]
+.+[Char]
gettext
                          TokenCat [Char]
"Char"    -> [Char]
n'[Char] -> [Char] -> [Char]
+.+[Char]
gettext[Char] -> [Char] -> [Char]
+.+[Char]
charat
                          TokenCat [Char]
"Double"  -> [Char] -> [Char]
parsedouble ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
n'[Char] -> [Char] -> [Char]
+.+[Char]
gettext
                          TokenCat [Char]
"String"  -> [Char]
n'[Char] -> [Char] -> [Char]
+.+[Char]
gettext[Char] -> [Char] -> [Char]
+.+[Char] -> [Char]
removeQuotes [Char]
n'
                          Cat
_         -> [Char] -> [Char] -> [Char]
(+.+) [Char]
n' (if Cat -> Bool
isTokenCat Cat
c then [Char]
gettext else [Char]
"result")
                          where n' :: [Char]
n' = Char
'$'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
n

-- | Generate patterns and a set of metavariables indicating
-- where in the pattern the non-terminal
-- >>> generatePatterns 2 [] $ npRule "myfun" (Cat "A") [] Parsable
-- (" /* empty */ ",[])
-- >>> generatePatterns 3 [("def", "_SYMB_1")] $ npRule "myfun" (Cat "A") [Right "def", Left (Cat "B")] Parsable
-- ("_SYMB_1 p_3_2=b",[("p_3_2",B)])
generatePatterns :: Int -> KeywordEnv -> Rule -> (Pattern,[MetaVar])
generatePatterns :: Int -> KeywordEnv -> Rule -> ([Char], [MetaVar])
generatePatterns Int
ind KeywordEnv
env Rule
r =
  case Rule -> SentForm
forall function. Rul function -> SentForm
rhsRule Rule
r of
    []  -> ([Char]
" /* empty */ ", [])
    SentForm
its -> ( [[Char]] -> [Char]
unwords ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Int, Either Cat [Char]) -> Maybe [Char])
-> [(Int, Either Cat [Char])] -> [[Char]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Int -> Either Cat [Char] -> Maybe [Char])
-> (Int, Either Cat [Char]) -> Maybe [Char]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Either Cat [Char] -> Maybe [Char]
forall {a}. Show a => a -> Either Cat [Char] -> Maybe [Char]
mkIt) [(Int, Either Cat [Char])]
nits
           , [ (Int -> [Char]
forall {a}. Show a => a -> [Char]
var Int
i, Cat
cat) | (Int
i, Left Cat
cat) <- [(Int, Either Cat [Char])]
nits ]
           )
      where
      nits :: [(Int, Either Cat [Char])]
nits   = [Int] -> SentForm -> [(Int, Either Cat [Char])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..] SentForm
its
      var :: a -> [Char]
var a
i  = [Char]
"p_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall {a}. Show a => a -> [Char]
show Int
ind [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"_"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall {a}. Show a => a -> [Char]
show a
i   -- TODO: is ind needed for ANTLR?
      mkIt :: a -> Either Cat [Char] -> Maybe [Char]
mkIt a
i = \case
        Left  Cat
c -> [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ a -> [Char]
forall {a}. Show a => a -> [Char]
var a
i [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"=" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
catToNT Cat
c
        Right [Char]
s -> [Char] -> KeywordEnv -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
s KeywordEnv
env

catToNT :: Cat -> String
catToNT :: Cat -> [Char]
catToNT = \case
  TokenCat [Char]
"Ident"   -> [Char]
"IDENT"
  TokenCat [Char]
"Integer" -> [Char]
"INTEGER"
  TokenCat [Char]
"Char"    -> [Char]
"CHAR"
  TokenCat [Char]
"Double"  -> [Char]
"DOUBLE"
  TokenCat [Char]
"String"  -> [Char]
"STRING"
  Cat
c | Cat -> Bool
isTokenCat Cat
c   -> Cat -> [Char]
identCat Cat
c
    | Bool
otherwise      -> [Char] -> [Char]
firstLowerCase ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
getRuleName ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Cat -> [Char]
identCat Cat
c

-- | Puts together the pattern and actions and returns a string containing all
-- the rules.
prRules :: String -> Rules -> String
prRules :: [Char] -> Rules -> [Char]
prRules [Char]
packabs = (PDef -> [Char]) -> Rules -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((PDef -> [Char]) -> Rules -> [Char])
-> (PDef -> [Char]) -> Rules -> [Char]
forall a b. (a -> b) -> a -> b
$ \case

  -- No rules: skip.
  PDef Maybe [Char]
_mlhs Cat
_nt []         -> [Char]
""

  -- At least one rule: print!
  PDef Maybe [Char]
mlhs Cat
nt (([Char], [Char], Maybe [Char])
rhs : [([Char], [Char], Maybe [Char])]
rhss) -> [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat

    -- The definition header: lhs and type.
    [ [ [[Char]] -> [Char]
unwords [ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
nt' Maybe [Char]
mlhs
                , [Char]
"returns" , [Char]
"[" , [Char]
packabs[Char] -> [Char] -> [Char]
+.+[Char]
normcat , [Char]
"result" , [Char]
"]"
                ]
      ]
    -- The first rhs.
    , [Char] -> ([Char], [Char], Maybe [Char]) -> [[Char]]
alternative [Char]
"  :" ([Char], [Char], Maybe [Char])
rhs
    -- The other rhss.
    , (([Char], [Char], Maybe [Char]) -> [[Char]])
-> [([Char], [Char], Maybe [Char])] -> [[Char]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Char] -> ([Char], [Char], Maybe [Char]) -> [[Char]]
alternative [Char]
"  |") [([Char], [Char], Maybe [Char])]
rhss
    -- The definition footer.
    , [ [Char]
"  ;" ]
    ]
    where
    alternative :: [Char] -> ([Char], [Char], Maybe [Char]) -> [[Char]]
alternative [Char]
sep ([Char]
p, [Char]
a, Maybe [Char]
label) = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [ [[Char]] -> [Char]
unwords [ [Char]
sep , [Char]
p ] ]
      , [ [[Char]] -> [Char]
unwords [ [Char]
"    {" , [Char]
a , [Char]
"}" ] ]
      , [ [[Char]] -> [Char]
unwords [ [Char]
"    #" , [Char] -> [Char]
antlrRuleLabel [Char]
l ] | Just [Char]
l <- [Maybe [Char]
label] ]
      ]
    catid :: [Char]
catid              = Cat -> [Char]
identCat Cat
nt
    normcat :: [Char]
normcat            = Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
nt)
    nt' :: [Char]
nt'                = [Char] -> [Char]
getRuleName ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
firstLowerCase [Char]
catid
    antlrRuleLabel :: Fun -> String
    antlrRuleLabel :: [Char] -> [Char]
antlrRuleLabel [Char]
fnc
      | [Char] -> Bool
forall a. IsFun a => a -> Bool
isNilFun [Char]
fnc   = [Char]
catid [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_Empty"
      | [Char] -> Bool
forall a. IsFun a => a -> Bool
isOneFun [Char]
fnc   = [Char]
catid [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_AppendLast"
      | [Char] -> Bool
forall a. IsFun a => a -> Bool
isConsFun [Char]
fnc  = [Char]
catid [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"_PrependFirst"
      | [Char] -> Bool
forall a. IsFun a => a -> Bool
isCoercion [Char]
fnc = [Char]
"Coercion_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
catid
      | Bool
otherwise      = [Char] -> [Char]
getLabelName [Char]
fnc