{-# LANGUAGE LambdaCase #-}
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
commentWithEmacsModeHint :: String -> String
= String -> String
comment forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"-*- c++ -*- " forall a. [a] -> [a] -> [a]
++)
definedRules :: Maybe ListConstructors -> CF -> String -> String
definedRules :: Maybe ListConstructors -> CF -> String -> String
definedRules Maybe ListConstructors
mlc CF
cf String
banner
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
theLines = []
| Bool
otherwise = [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ String
banner forall a. a -> [a] -> [a]
: String
"" forall a. a -> [a] -> [a]
: [String]
theLines
where
theLines :: [String]
theLines = forall a b. (a -> b) -> [a] -> [b]
map Define -> String
rule forall a b. (a -> b) -> a -> b
$ 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 forall a. [a] -> [a] -> [a]
++ String
";"
Just ListConstructors
lc -> [String] -> String
unlines
[ String
header forall a. [a] -> [a] -> [a]
++ String
" {"
, String
" return " forall a. [a] -> [a] -> [a]
++ ListConstructors -> [String] -> Exp -> String
cppExp ListConstructors
lc (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst Telescope
args) Exp
e forall a. [a] -> [a] -> [a]
++ String
";"
, String
"}"
]
where
header :: String
header = Base -> String
cppType Base
t forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String -> String
sanitizeCpp (forall a. IsFun a => a -> String
funName RFun
f) forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map (String, Base) -> String
cppArg Telescope
args) forall a. [a] -> [a] -> [a]
++ String
")"
cppType :: Base -> String
cppType :: Base -> String
cppType (ListT (BaseT String
x)) = String
"List" forall a. [a] -> [a] -> [a]
++ String
x forall a. [a] -> [a] -> [a]
++ String
"*"
cppType (ListT Base
t) = Base -> String
cppType Base
t forall a. [a] -> [a] -> [a]
++ String
"*"
cppType (BaseT String
x)
| String
x 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 forall a. [a] -> [a] -> [a]
++ String
"*"
cppArg :: (String, Base) -> String
cppArg :: (String, Base) -> String
cppArg (String
x,Base
t) = Base -> String
cppType Base
t forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
x 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)) [] -> forall a b. (a, b) -> a
fst 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 (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Base -> (String, Type)
cons Base
t) [Exp]
es
Var String
x -> String
x forall a. [a] -> [a] -> [a]
++ String
"_"
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 (forall a. [a] -> a
head String
x) -> String -> [Exp] -> String
call (String
"new " forall a. [a] -> [a] -> [a]
++ String
x) [Exp]
es
| String
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args -> String -> [Exp] -> String
call (String
x forall a. [a] -> [a] -> [a]
++ String
"_") [Exp]
es
| Bool
otherwise -> String -> [Exp] -> String
call (String -> String
sanitizeCpp String
x) [Exp]
es
LitInt Integer
n -> forall a. Show a => a -> String
show Integer
n
LitDouble Double
x -> forall a. Show a => a -> String
show Double
x
LitChar Char
c -> forall a. Show a => a -> String
show Char
c
LitString String
s -> forall a. Show a => a -> String
show String
s
call :: String -> [Exp] -> String
call String
x [Exp]
es = String
x forall a. [a] -> [a] -> [a]
++ String
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a b. (a -> b) -> [a] -> [b]
map Exp -> String
loop [Exp]
es) forall a. [a] -> [a] -> [a]
++ String
")"