{-# LANGUAGE OverloadedStrings #-}

module BNFC.Backend.Haskell.Utilities.Parser where

import BNFC.Prelude

import Data.String (fromString)
import Prettyprinter

import BNFC.CF

tokenName :: Doc ()
tokenName :: Doc ()
tokenName = Doc ()
"Token"

parserCatName :: Cat -> Doc ()
parserCatName :: Cat -> Doc ()
parserCatName Cat
c = Doc ()
"p" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> String -> Doc ()
forall a. IsString a => String -> a
fromString (Cat -> String
printCatNamePrec' Cat
c)

generateP :: Bool -> Cat -> Doc ()
generateP :: Bool -> Cat -> Doc ()
generateP Bool
functor Cat
c =
  Doc ()
"%name" Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Cat -> Doc ()
parserCatName Cat
c Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> (if Bool
functor then Doc ()
"_internal" else Doc ()
forall ann. Doc ann
emptyDoc) Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
  String -> Doc ()
forall a. IsString a => String -> a
fromString (Cat -> String
printCatNamePrec' Cat
c)

qualify :: String -> String -> String
qualify :: String -> String -> String
qualify String
q String
s
  | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
q = String
s
  | Bool
otherwise = String
q String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s

-- | Generate patterns and a set of metavariables (de Bruijn indices) indicating
--   where in the pattern the non-terminals are locate.
--
-- >>> generatePatterns False [ NTerminal (Cat' (BaseCat 'E':|"xp")), Terminal (Keyword ('+':|[])), NTerminal (Cat' (BaseCat 'E':|"xp")) ]
-- ("Exp '+' Exp",["$1","$3"])
--
-- >>> generatePatterns True [ NTerminal (Cat' (BaseCat 'E':|"xp")), Terminal (Keyword ('+':|[])), NTerminal (Cat' (BaseCat 'E':|"xp")) ]
-- ("Exp '+' Exp",["(snd $1)","(snd $3)"])
--

generatePatterns :: Bool -> RHS -> (String, [String])
generatePatterns :: Bool -> RHS -> (String, [String])
generatePatterns Bool
_       []  = (String
"{- empty -}", [])
generatePatterns Bool
functor RHS
rhs =
  ( [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ RHS -> [String]
printRHS RHS
rhs
  , [ if Bool
functor
      then String
"(snd $" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
      else Char
'$' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i
      | (Int
i, Item' Keyword
_) <- ((Int, Item' Keyword) -> Bool)
-> [(Int, Item' Keyword)] -> [(Int, Item' Keyword)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Item' Keyword -> Bool
forall a. Item' a -> Bool
isNTerminal (Item' Keyword -> Bool)
-> ((Int, Item' Keyword) -> Item' Keyword)
-> (Int, Item' Keyword)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Item' Keyword) -> Item' Keyword
forall a b. (a, b) -> b
snd) ([Int] -> RHS -> [(Int, Item' Keyword)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..] RHS
rhs) ] )