BNFC-2.8: src/BNFC/Backend/CPP/NoSTL/CFtoCPPAbs.hs
{-# LANGUAGE OverloadedStrings #-}
{-
BNF Converter: C++ abstract syntax generator
Copyright (C) 2004 Author: Michael Pellauer
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{-
**************************************************************
BNF Converter Module
Description : This module generates the C++ Abstract Syntax
tree classes. It generates both a Header file
and an Implementation file, and uses the Visitor
design pattern.
Author : Michael Pellauer (pellauer@cs.chalmers.se)
License : GPL (GNU General Public License)
Created : 4 August, 2003
Modified : 22 May, 2004 / Antti-Juhani Kaijanaho
**************************************************************
-}
module BNFC.Backend.CPP.NoSTL.CFtoCPPAbs (cf2CPPAbs) where
import BNFC.CF
import BNFC.Utils((+++),(++++))
import BNFC.Backend.Common.NamedVariables
import BNFC.Backend.Common.OOAbstract
import Data.List
import Data.Char(toLower)
import Text.PrettyPrint
--The result is two files (.H file, .C file)
cf2CPPAbs :: String -> CF -> (String, String)
cf2CPPAbs _ cf = (mkHFile cf, mkCFile cf)
{- **** Header (.H) File Functions **** -}
--Makes the Header file.
mkHFile :: CF -> String
mkHFile cf = unlines
[
"#ifndef ABSYN_HEADER",
"#define ABSYN_HEADER",
"",
header,
prTypeDefs user,
"/******************** Forward Declarations ********************/\n",
concatMap prForward classes,
"",
prVisitor classes,
prVisitable,
"",
"/******************** Abstract Syntax Classes ********************/\n",
concatMap (prDataH user) (getAbstractSyntax cf),
"",
"#endif"
]
where
user = fst (unzip (tokenPragmas cf))
header = "/* ~~~ C++ Abstract Syntax Interface generated by the BNF Converter.\n ~~~ */"
classes = allClasses (cf2cabs cf)
prForward s | isProperLabel s = "class " ++ s ++ ";\n"
prForward _ = ""
--Prints interface classes for all categories.
prDataH :: [UserDef] -> Data -> String
prDataH user (cat, rules) =
case lookup (show cat) rules of
Just _ -> concatMap (prRuleH user cat) rules
Nothing -> if isList cat
then concatMap (prRuleH user cat) rules
else unlines
[
"class" +++ (identCat cat) +++ ": public Visitable {",
"public:",
" virtual" +++ (identCat cat) +++ "*clone() const = 0;",
"};\n",
concatMap (prRuleH user cat) rules
]
--Interface definitions for rules vary on the type of rule.
prRuleH :: [UserDef] -> Cat -> (Fun, [Cat]) -> String
prRuleH user c (fun, cats) =
if isNilFun fun || isOneFun fun
then "" --these are not represented in the AbSyn
else if isConsFun fun
then --this is the linked list case.
unlines
[
"class" +++ c' +++ ": public Visitable",
"{",
" public:",
render $ nest 2 $ prInstVars user vs,
" " ++ c' ++ "(const" +++ c' +++ "&);",
" " ++ c' ++ " &operator=(const" +++ c' +++ "&);",
" " ++ c' ++ "(" ++ (prConstructorH 1 vs) ++ ");",
" " ++ c' ++ "(" ++ mem +++ memstar ++ "p);",
prDestructorH c',
" " ++ c' ++ "* reverse();",
" " ++ c' ++ "* reverse(" ++ c' ++ " *l);",
" virtual void accept(Visitor *v);",
" virtual " ++ c' ++ " *clone() const;",
" void swap(" ++ c' +++ "&);",
"};"
]
else --a standard rule
unlines
[
"class" +++ fun +++ ": public" +++ super,
"{",
" public:",
render $ nest 2 $ prInstVars user vs,
" " ++ fun ++ "(const" +++ fun +++ "&);",
" " ++ fun ++ " &operator=(const" +++ fun +++ "&);",
" " ++ fun ++ "(" ++ (prConstructorH 1 vs) ++ ");",
prDestructorH fun,
" virtual void accept(Visitor *v);",
" virtual " +++ fun +++ " *clone() const;",
" void swap(" ++ fun +++ "&);",
"};\n"
]
where
vs = getVars cats
c' = identCat (normCat c);
mem = drop 4 c'
memstar = if isBasic user mem then "" else "*"
super = if show c == fun then "Visitable" else (identCat c)
prConstructorH :: Int -> [(String, b)] -> String
prConstructorH _ [] = ""
prConstructorH n ((t,_):[]) = t +++ (optstar t) ++ "p" ++ (show n)
prConstructorH n ((t,_):vs) =( t +++ (optstar t) ++ "p" ++ (show n) ++ ", ") ++ (prConstructorH (n+1) vs)
prDestructorH n = " ~" ++ n ++ "();"
optstar x = if isBasic user x
then ""
else "*"
prVisitable :: String
prVisitable = unlines
[
"class Visitable",
"{",
" public:",
-- all classes with virtual methods require a virtual destructor
" virtual ~Visitable() {}",
" virtual void accept(Visitor *v) = 0;",
"};\n"
]
prVisitor :: [String] -> String
prVisitor fs = unlines
[
"/******************** Visitor Interfaces ********************/",
"",
"class Visitor",
"{",
" public:",
" virtual ~Visitor() {}",
(concatMap (prVisitFun) fs),
footer
]
where
footer = unlines
[ --later only include used categories
" virtual void visitInteger(Integer i) = 0;",
" virtual void visitDouble(Double d) = 0;",
" virtual void visitChar(Char c) = 0;",
" virtual void visitString(String s) = 0;",
"};"
]
prVisitFun f | isProperLabel f =
" virtual void visit" ++ f ++ "(" ++ f ++ " *p) = 0;\n"
prVisitFun _ = ""
--typedefs in the Header make generation much nicer.
prTypeDefs user = unlines
[
"/******************** TypeDef Section ********************/",
"typedef int Integer;",
"typedef char Char;",
"typedef double Double;",
"typedef char* String;",
"typedef char* Ident;",
concatMap prUserDef user
]
where
prUserDef s = "typedef char* " ++ show s ++ ";\n"
-- | A class's instance variables.
-- >>> prInstVars [Cat "MyTokn"] [("MyTokn",1), ("A",1), ("A",2)]
-- MyTokn mytokn_1;
-- A *a_1, *a_2;
prInstVars :: [UserDef] -> [IVar] -> Doc
prInstVars _ [] = empty
prInstVars user vars@((t,_):_) =
text t <+> uniques <> ";" $$ prInstVars user vs'
where
(uniques, vs') = prUniques t
--these functions group the types together nicely
prUniques :: String -> (Doc, [IVar])
prUniques t = (prVars (findIndices (\(y,_) -> y == t) vars), remType t vars)
prVars = hsep . punctuate comma . map prVar
prVar x = let (t,n) = vars !! x in varLinkName t <> text (showNum n)
varLinkName z = if isBasic user z
then text (map toLower z) <> "_"
else "*" <> text (map toLower z) <> "_"
remType :: String -> [IVar] -> [IVar]
remType _ [] = []
remType t ((t2,n):ts) = if t == t2
then (remType t ts)
else (t2,n) : (remType t ts)
{- **** Implementation (.C) File Functions **** -}
--Makes the .C file
mkCFile :: CF -> String
mkCFile cf = unlines
[
header,
concatMap (prDataC user) (getAbstractSyntax cf)
]
where
user = fst (unzip (tokenPragmas cf))
header = unlines
[
"//C++ Abstract Syntax Implementation generated by the BNF Converter.",
"#include <algorithm>",
"#include \"Absyn.H\""
]
--This is not represented in the implementation.
prDataC :: [UserDef] -> Data -> String
prDataC user (cat, rules) = concatMap (prRuleC user cat) rules
--Classes for rules vary based on the type of rule.
prRuleC user c (fun, cats) =
if isNilFun fun || isOneFun fun
then "" --these are not represented in the AbSyn
else if isConsFun fun
then --this is the linked list case.
unlines
[
"/******************** " ++ c' ++ " ********************/",
render $ prConstructorC user c' vs cats,
prCopyC user c' vs,
prDestructorC user c' vs,
prListFuncs user c',
prAcceptC c',
prCloneC user c' vs,
""
]
else --a standard rule
unlines
[
"/******************** " ++ fun ++ " ********************/",
render $ prConstructorC user fun vs cats,
prCopyC user fun vs,
prDestructorC user fun vs,
prAcceptC fun,
prCloneC user fun vs,
""
]
where
vs = getVars cats
c' = identCat (normCat c)
--These are all built-in list functions.
--Later we could include things like lookup,insert,delete,etc.
prListFuncs :: [UserDef] -> String -> String
prListFuncs user c = unlines
[
c ++ "::" ++ c ++ "(" ++ m +++ mstar ++ "p)",
"{",
" " ++ m' ++ " = p;",
" " ++ v ++ "= 0;",
"}",
c ++ "*" +++ c ++ "::" ++ "reverse()",
"{",
" if (" ++ v +++ "== 0) return this;",
" else",
" {",
" " ++ c ++ " *tmp =" +++ v ++ "->reverse(this);",
" " ++ v +++ "= 0;",
" return tmp;",
" }",
"}",
"",
c ++ "*" +++ c ++ "::" ++ "reverse(" ++ c ++ "* prev)",
"{",
" if (" ++ v +++ "== 0)",
" {",
" " ++ v +++ "= prev;",
" return this;",
" }",
" else",
" {",
" " ++ c +++ "*tmp =" +++ v ++ "->reverse(this);",
" " ++ v +++ "= prev;",
" return tmp;",
" }",
"}"
]
where
v = (map toLower c) ++ "_"
m = drop 4 c
mstar = if isBasic user m then "" else "*"
m' = drop 4 v
--The standard accept function for the Visitor pattern
prAcceptC :: String -> String
prAcceptC ty =
"\nvoid " ++ ty ++ "::accept(Visitor *v) { v->visit" ++ ty ++ "(this); }"
-- | The constructor just assigns the parameters to the corresponding instance
-- variables.
-- >>> prConstructorC [Cat "Integer"] "bla" [("A",1), ("Integer",1), ("A",2)] [Cat "A", Cat "Integer", Cat "A"]
-- bla::bla(A *p1, Integer p2, A *p3) { a_1 = p1; integer_ = p2; a_2 = p3; }
prConstructorC :: [UserDef] -> String -> [IVar] -> [Cat] -> Doc
prConstructorC user c vs cats =
text c <> "::" <> text c <> parens (args)
<+> "{" <+> text (prAssigns vs params) <> "}"
where
(types, params) = unzip (prParams cats (length cats) (length cats+1))
args = hsep $ punctuate "," $ zipWith prArg types params
prArg type_ name
| isBasic user type_ = text type_ <+> text name
| otherwise = text type_ <+> "*" <> text name
--Print copy constructor and copy assignment
prCopyC :: [UserDef] -> String -> [IVar] -> String
prCopyC user c vs =
c ++ "::" ++ c ++ "(const" +++ c +++ "& other) {" +++
concatMap doV vs ++++
"}" ++++
c +++ "&" ++ c ++ "::" ++ "operator=(const" +++ c +++ "& other) {" ++++
" " ++ c +++ "tmp(other);" ++++
" swap(tmp);" ++++
" return *this;" ++++
"}" ++++
"void" +++ c ++ "::swap(" ++ c +++ "& other) {" ++++
concatMap swapV vs ++++
"}\n"
where doV :: IVar -> String
doV v@(t, _)
| isBasic user t = " " ++ vn v ++ " = other." ++ vn v ++ ";\n"
| otherwise = " " ++ vn v ++ " = other." ++ vn v ++ "->clone();\n"
vn :: IVar -> String
vn (t, 0) = varName t
vn (t, n) = varName t ++ show n
swapV :: IVar -> String
swapV v = " std::swap(" ++ vn v ++ ", other." ++ vn v ++ ");\n"
--The cloner makes a new deep copy of the object
prCloneC :: [UserDef] -> String -> [IVar] -> String
prCloneC _ c _ =
c +++ "*" ++ c ++ "::clone() const {" ++++
" return new" +++ c ++ "(*this);\n}"
--The destructor deletes all a class's members.
prDestructorC :: [UserDef] -> String -> [IVar] -> String
prDestructorC user c vs =
c ++ "::~" ++ c ++"()" +++ "{" +++
(concatMap prDeletes vs) ++ "}"
where
prDeletes :: (String, Int) -> String
prDeletes (t, n) = if isBasic user t
then ""
else if n == 0
then "delete(" ++ (varName t) ++ "); "
else "delete(" ++ (varName t) ++ (show n) ++ "); "
--Prints the constructor's parameters.
prParams :: [Cat] -> Int -> Int -> [(String,String)]
prParams [] _ _ = []
prParams (c:cs) n m = (identCat c,"p" ++ (show (m-n)))
: (prParams cs (n-1) m)
--Prints the assignments of parameters to instance variables.
--This algorithm peeks ahead in the list so we don't use map or fold
prAssigns :: [IVar] -> [String] -> String
prAssigns [] _ = []
prAssigns _ [] = []
prAssigns ((t,n):vs) (p:ps) =
if n == 1 then
case findIndices (\(l,_) -> l == t) vs of
[] -> varName t +++ "=" +++ p ++ ";" +++ prAssigns vs ps
_ -> varName t ++ showNum n +++ "=" +++ p ++ ";" +++ prAssigns vs ps
else varName t ++ showNum n +++ "=" +++ p ++ ";" +++ prAssigns vs ps
{- **** Helper Functions **** -}
--Checks if something is a basic or user-defined type.
isBasic :: [UserDef] -> String -> Bool
isBasic user x =
if elem x (map show user)
then True
else case x of
"Integer" -> True
"Char" -> True
"String" -> True
"Double" -> True
"Ident" -> True
_ -> False