{-# LANGUAGE OverloadedStrings #-}

-- | Functions common to different backends.

module BNFC.Backend.Common where

import Prelude hiding ((<>))

import Data.Char

import BNFC.CF
import BNFC.PrettyPrint

-- Andreas, 2020-10-08, issue #292:
-- Since the produced lexer for Haskell and Ocaml only recognizes ASCII identifiers,
-- but cfgKeywords also contains those using unicode characters,
-- we have to reclassify any keyword using non-ASCII characters
-- as symbol.
unicodeAndSymbols :: CF -> [String]
unicodeAndSymbols :: CF -> [String]
unicodeAndSymbols CF
cf = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii) (CF -> [String]
forall function. CFG function -> [String]
cfgKeywords CF
cf) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ CF -> [String]
forall function. CFG function -> [String]
cfgSymbols CF
cf

asciiKeywords :: CF -> [String]
asciiKeywords :: CF -> [String]
asciiKeywords = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isAscii) ([String] -> [String]) -> (CF -> [String]) -> CF -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CF -> [String]
forall function. CFG function -> [String]
cfgKeywords

-- | Representation of the empty word as Flex regular expression
flexEps :: String
flexEps :: String
flexEps = String
"[^.\\n]?"

-- | Helper function for c-like languages that generates the code printing
-- the list separator according to the given precedence level:
--
-- >>> let my_render c = "my_render(\"" <> text c <> "\")"
-- >>> renderListSepByPrecedence "x" my_render []
-- <BLANKLINE>
--
-- >>> renderListSepByPrecedence "x" my_render [(0,",")]
-- my_render(",");
--
-- >>> renderListSepByPrecedence "x" my_render [(3,";"), (1, "--")]
-- switch(x)
-- {
--   case 3: my_render(";"); break;
--   default: my_render("--");
-- }
renderListSepByPrecedence :: Doc                 -- ^ Name of the coercion level variable
                         -> (String -> Doc)     -- ^ render function
                         -> [(Integer, String)] -- ^ separators by precedence
                         -> Doc
renderListSepByPrecedence :: Doc -> (String -> Doc) -> [(Integer, String)] -> Doc
renderListSepByPrecedence Doc
_ String -> Doc
_ [] = Doc
empty
renderListSepByPrecedence Doc
_ String -> Doc
render [(Integer
_,String
sep)] = String -> Doc
render String
sep Doc -> Doc -> Doc
<> Doc
";"
renderListSepByPrecedence Doc
var String -> Doc
render [(Integer, String)]
ss = Doc
"switch(" Doc -> Doc -> Doc
<> Doc
var Doc -> Doc -> Doc
<> Doc
")" Doc -> Doc -> Doc
$$ Int -> [Doc] -> Doc
codeblock Int
2
    ( [Doc
"case" Doc -> Doc -> Doc
<+> Integer -> Doc
integer Integer
i Doc -> Doc -> Doc
<:> String -> Doc
render String
sep Doc -> Doc -> Doc
<>Doc
"; break;" | (Integer
i, String
sep) <- [(Integer, String)] -> [(Integer, String)]
forall a. [a] -> [a]
init [(Integer, String)]
ss]
    [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
"default" Doc -> Doc -> Doc
<:> String -> Doc
render String
sep Doc -> Doc -> Doc
<>Doc
";" | let (Integer
_,String
sep) = [(Integer, String)] -> (Integer, String)
forall a. [a] -> a
last [(Integer, String)]
ss])
  where
    Doc
a <:> :: Doc -> Doc -> Doc
<:> Doc
b = Doc
a Doc -> Doc -> Doc
<> Doc
":" Doc -> Doc -> Doc
<+> Doc
b