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 { posTokens :: [String], -- position token types noPosTokens :: [String], -- user non-position token types -- listTypes :: [(String,Bool)], -- list types used, whether of classes catClasses :: [String], -- grammar-def cats, normalized names labelClasses :: [String], -- constructors, except list ones signatures :: Signature, -- rules for each class, incl. pos tokens defineds :: Functions -- defined (non-)constructors } lbnf2abs :: LBNF -> Abs lbnf2abs lbnf = Abs { posTokens = posToks , noPosTokens = noposToks --, listTypes = undefined , catClasses = catc -- also contains list categories , labelClasses = labelc , signatures = sig , defineds = def } where astRules = _lbnfASTRules lbnf tokens = _lbnfTokenDefs lbnf posToks = toList <$> Map.keys (Map.filter isPositionToken tokens) noposToks = toList <$> Map.keys (Map.filter (not . isPositionToken) tokens) catc = printCatName <$> Map.keys astRules labelc = printLabelName <$> concatMap Map.keys (Map.elems astRules) sig = _lbnfSignature lbnf def = _lbnfFunctions lbnf -- all those names that denote classes in C++ allClasses :: LBNF -> [String] allClasses lbnf = catClasses ++ labelClasses ++ tokenClasses where astRules = _lbnfASTRules lbnf tokens = _lbnfTokenDefs lbnf -- classes coming from grammar categories catClasses :: [String] catClasses = printCatName <$> Map.keys astRules -- classes coming from grammar labels labelClasses :: [String] labelClasses = printLabelName <$> concatMap Map.keys (Map.elems astRules) -- classes coming from grammar tokens tokenClasses :: [String] tokenClasses = toList <$> Map.keys (Map.filter isPositionToken tokens) -- all those names that denote non-class types in C++ allNonClasses :: LBNF -> [String] allNonClasses lbnf = map fst basetypes ++ nonPosTokens where tokens = _lbnfTokenDefs lbnf nonPosTokens = toList <$> Map.keys (Map.filter (not . isPositionToken) tokens) basetypes :: [([Char], [Char])] basetypes = [ ("Integer","int"), ("Char", "char"), ("Double", "double"), ("String", "std::string"), ("Ident", "std::string") ] classVar :: String -> String classVar c = map toLower c ++ "_" pointerIf :: Bool -> String -> String pointerIf b v = if b then "*" ++ v else v