module BNFC.Backend.CommonInterface.OOAbstractSyntax where

import BNFC.CF

import BNFC.Prelude
import qualified Data.Map         as Map

-- data structured used to generated abstract syntax
data Abs = Abs {
  Abs -> [String]
posTokens   :: [String],               -- position token types
  Abs -> [String]
noPosTokens :: [String],               -- user non-position token types
 -- listTypes   :: [(String,Bool)],        -- list types used, whether of classes
  Abs -> [String]
catClasses  :: [String],               -- grammar-def cats, normalized names
  Abs -> [String]
labelClasses  :: [String],               -- constructors, except list ones
  Abs -> Signature
signatures  :: Signature,              -- rules for each class, incl. pos tokens
  Abs -> Functions
defineds    :: Functions               -- defined (non-)constructors
}

lbnf2abs :: LBNF -> Abs
lbnf2abs :: LBNF -> Abs
lbnf2abs LBNF
lbnf = Abs :: [String]
-> [String]
-> [String]
-> [String]
-> Signature
-> Functions
-> Abs
Abs {
    posTokens :: [String]
posTokens    = [String]
posToks
  , noPosTokens :: [String]
noPosTokens  = [String]
noposToks
  --, listTypes   = undefined
  , catClasses :: [String]
catClasses   = [String]
catc -- also contains list categories
  , labelClasses :: [String]
labelClasses = [String]
labelc
  , signatures :: Signature
signatures   = Signature
sig
  , defineds :: Functions
defineds     = Functions
def
  }
    where
      astRules :: ASTRules
astRules  = LBNF -> ASTRules
_lbnfASTRules LBNF
lbnf
      tokens :: TokenDefs
tokens    = LBNF -> TokenDefs
_lbnfTokenDefs LBNF
lbnf
      posToks :: [String]
posToks   = NonEmpty Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Char -> String) -> [NonEmpty Char] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenDefs -> [NonEmpty Char]
forall k a. Map k a -> [k]
Map.keys ((WithPosition TokenDef -> Bool) -> TokenDefs -> TokenDefs
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter WithPosition TokenDef -> Bool
isPositionToken TokenDefs
tokens)
      noposToks :: [String]
noposToks = NonEmpty Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Char -> String) -> [NonEmpty Char] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenDefs -> [NonEmpty Char]
forall k a. Map k a -> [k]
Map.keys ((WithPosition TokenDef -> Bool) -> TokenDefs -> TokenDefs
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> (WithPosition TokenDef -> Bool) -> WithPosition TokenDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithPosition TokenDef -> Bool
isPositionToken) TokenDefs
tokens)
      catc :: [String]
catc      = Cat -> String
printCatName (Cat -> String) -> [Cat] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTRules -> [Cat]
forall k a. Map k a -> [k]
Map.keys ASTRules
astRules
      labelc :: [String]
labelc    = Label -> String
printLabelName (Label -> String) -> [Label] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Label (WithPosition ARuleRHS) -> [Label])
-> [Map Label (WithPosition ARuleRHS)] -> [Label]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Map Label (WithPosition ARuleRHS) -> [Label]
forall k a. Map k a -> [k]
Map.keys (ASTRules -> [Map Label (WithPosition ARuleRHS)]
forall k a. Map k a -> [a]
Map.elems ASTRules
astRules)
      sig :: Signature
sig       =  LBNF -> Signature
_lbnfSignature LBNF
lbnf
      def :: Functions
def       = LBNF -> Functions
_lbnfFunctions LBNF
lbnf

-- all those names that denote classes in C++
allClasses :: LBNF -> [String]
allClasses :: LBNF -> [String]
allClasses LBNF
lbnf = [String]
catClasses [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
labelClasses [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
tokenClasses
  where
    astRules :: ASTRules
astRules = LBNF -> ASTRules
_lbnfASTRules LBNF
lbnf
    tokens :: TokenDefs
tokens   = LBNF -> TokenDefs
_lbnfTokenDefs LBNF
lbnf
    -- classes coming from grammar categories
    catClasses :: [String]
    catClasses :: [String]
catClasses    = Cat -> String
printCatName (Cat -> String) -> [Cat] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASTRules -> [Cat]
forall k a. Map k a -> [k]
Map.keys ASTRules
astRules
    -- classes coming from grammar labels
    labelClasses :: [String]
    labelClasses :: [String]
labelClasses  = Label -> String
printLabelName (Label -> String) -> [Label] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map Label (WithPosition ARuleRHS) -> [Label])
-> [Map Label (WithPosition ARuleRHS)] -> [Label]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Map Label (WithPosition ARuleRHS) -> [Label]
forall k a. Map k a -> [k]
Map.keys (ASTRules -> [Map Label (WithPosition ARuleRHS)]
forall k a. Map k a -> [a]
Map.elems ASTRules
astRules)
    -- classes coming from grammar tokens
    tokenClasses :: [String]
    tokenClasses :: [String]
tokenClasses = NonEmpty Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList  (NonEmpty Char -> String) -> [NonEmpty Char] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenDefs -> [NonEmpty Char]
forall k a. Map k a -> [k]
Map.keys ((WithPosition TokenDef -> Bool) -> TokenDefs -> TokenDefs
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter WithPosition TokenDef -> Bool
isPositionToken TokenDefs
tokens)

-- all those names that denote non-class types in C++
allNonClasses :: LBNF -> [String]
allNonClasses :: LBNF -> [String]
allNonClasses LBNF
lbnf = ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
basetypes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
nonPosTokens
  where
    tokens :: TokenDefs
tokens       = LBNF -> TokenDefs
_lbnfTokenDefs LBNF
lbnf
    nonPosTokens :: [String]
nonPosTokens = NonEmpty Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList  (NonEmpty Char -> String) -> [NonEmpty Char] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenDefs -> [NonEmpty Char]
forall k a. Map k a -> [k]
Map.keys ((WithPosition TokenDef -> Bool) -> TokenDefs -> TokenDefs
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Bool -> Bool
not (Bool -> Bool)
-> (WithPosition TokenDef -> Bool) -> WithPosition TokenDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithPosition TokenDef -> Bool
isPositionToken) TokenDefs
tokens)

basetypes :: [([Char], [Char])]
basetypes :: [(String, String)]
basetypes = [
  (String
"Integer",String
"int"),
  (String
"Char",   String
"char"),
  (String
"Double", String
"double"),
  (String
"String", String
"std::string"),
  (String
"Ident",  String
"std::string")
  ]

classVar :: String -> String
classVar :: String -> String
classVar String
c = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"

pointerIf :: Bool -> String -> String
pointerIf :: Bool -> String -> String
pointerIf Bool
b String
v = if Bool
b then String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v else String
v