{-# LANGUAGE LambdaCase #-}

-- | Common to the C++ backends.

module BNFC.Backend.CPP.Common where

import Data.Char  ( isUpper )
import Data.List  ( intercalate )

import BNFC.CF
import BNFC.TypeChecker

import BNFC.Backend.C          ( comment )
import BNFC.Backend.CPP.Naming

-- | C++ line comment including mode hint for emacs.

commentWithEmacsModeHint :: String -> String
commentWithEmacsModeHint :: String -> String
commentWithEmacsModeHint = String -> String
comment (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"-*- c++ -*- " String -> String -> String
forall a. [a] -> [a] -> [a]
++)

-- | C++ code for the @define@d constructors.
--
-- @definedRules Nothing@ only prints the header.
definedRules :: Maybe ListConstructors -> CF -> String -> String
definedRules :: Maybe ListConstructors -> CF -> String -> String
definedRules Maybe ListConstructors
mlc CF
cf String
banner
  | [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
theLines = []
  | Bool
otherwise     = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
banner String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
theLines
  where
    theLines :: [String]
theLines = (Define -> String) -> [Define] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Define -> String
rule ([Define] -> [String]) -> [Define] -> [String]
forall a b. (a -> b) -> a -> b
$ CF -> [Define]
forall f. CFG f -> [Define]
definitions CF
cf

    ctx :: Context
ctx = CF -> Context
buildContext CF
cf

    rule :: Define -> String
rule (Define RFun
f Telescope
args Exp
e Base
t) =
      case Maybe ListConstructors
mlc of
        Maybe ListConstructors
Nothing -> String
header String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
        Just ListConstructors
lc -> [String] -> String
unlines
          [ String
header String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" {"
          , String
"  return " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ListConstructors -> [String] -> Exp -> String
cppExp ListConstructors
lc (((String, Base) -> String) -> Telescope -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Base) -> String
forall a b. (a, b) -> a
fst Telescope
args) Exp
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
          , String
"}"
          ]
      where
        header :: String
header = Base -> String
cppType Base
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
sanitizeCpp (RFun -> String
forall a. IsFun a => a -> String
funName RFun
f) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (((String, Base) -> String) -> Telescope -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Base) -> String
cppArg Telescope
args) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

        cppType :: Base -> String
        cppType :: Base -> String
cppType (ListT (BaseT String
x)) = String
"List" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*"
        cppType (ListT Base
t)         = Base -> String
cppType Base
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*"
        cppType (BaseT String
x)
            | String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
baseTokenCatNames = String
x
            | String -> Context -> Bool
isToken String
x Context
ctx = String
"String"
            | Bool
otherwise     = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*"

        cppArg :: (String, Base) -> String
        cppArg :: (String, Base) -> String
cppArg (String
x,Base
t) = Base -> String
cppType Base
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"

        cppExp :: ListConstructors -> [String] -> Exp -> String
        cppExp :: ListConstructors -> [String] -> Exp -> String
cppExp (LC Base -> (String, Type)
nil Base -> (String, Type)
cons) [String]
args = Exp -> String
loop
          where
          loop :: Exp -> String
loop = \case
            App String
"[]"  (FunT [] (ListT Base
t)) [] -> (String, Type) -> String
forall a b. (a, b) -> a
fst ((String, Type) -> String) -> (String, Type) -> String
forall a b. (a -> b) -> a -> b
$ Base -> (String, Type)
nil Base
t
            App String
"(:)" (FunT [Base]
_  (ListT Base
t)) [Exp]
es -> String -> [Exp] -> String
call ((String, Type) -> String
forall a b. (a, b) -> a
fst ((String, Type) -> String) -> (String, Type) -> String
forall a b. (a -> b) -> a -> b
$ Base -> (String, Type)
cons Base
t) [Exp]
es
            Var String
x          -> String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"  -- argument
            App String
t Type
_ [Exp
e]
              | String -> Context -> Bool
isToken String
t Context
ctx    -> Exp -> String
loop Exp
e
            App String
x Type
_ [Exp]
es
              | Char -> Bool
isUpper (String -> Char
forall a. [a] -> a
head String
x) -> String -> [Exp] -> String
call (String
"new " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x) [Exp]
es
              | String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args    -> String -> [Exp] -> String
call (String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_") [Exp]
es
              | Bool
otherwise        -> String -> [Exp] -> String
call (String -> String
sanitizeCpp String
x) [Exp]
es
            LitInt Integer
n       -> Integer -> String
forall a. Show a => a -> String
show Integer
n
            LitDouble Double
x    -> Double -> String
forall a. Show a => a -> String
show Double
x
            LitChar Char
c      -> Char -> String
forall a. Show a => a -> String
show Char
c
            LitString String
s    -> String -> String
forall a. Show a => a -> String
show String
s

          call :: String -> [Exp] -> String
call String
x [Exp]
es = String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Exp -> String) -> [Exp] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Exp -> String
loop [Exp]
es) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"