{-# LANGUAGE TupleSections #-}

{-
    BNF Converter: C++ abstract syntax generator
    Copyright (C) 2004  Author:  Michael Pellauer

    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. It uses STL (Standard Template Library).

    Author        : Michael Pellauer
    Created       : 4 August, 2003
    Modified      : 22 May, 2004 / Antti-Juhani Kaijanaho
                    29 August, 2006 / Aarne Ranta

-}

module BNFC.Backend.CPP.STL.CFtoSTLAbs (cf2CPPAbs) where

import Data.List        ( intercalate, intersperse )

import BNFC.Backend.Common.OOAbstract
import BNFC.CF
import BNFC.Options     ( RecordPositions(..) )
import BNFC.TypeChecker ( ListConstructors(..) )
import BNFC.Utils       ( (+++), applyWhen )

import BNFC.Backend.CPP.Common
import BNFC.Backend.CPP.STL.STLUtils

--The result is two files (.H file, .C file)

cf2CPPAbs :: RecordPositions -> Maybe String -> String -> CF -> (String, String)
cf2CPPAbs :: RecordPositions -> Maybe String -> String -> CF -> (String, String)
cf2CPPAbs RecordPositions
rp Maybe String
inPackage String
_ CF
cf = (RecordPositions -> Maybe String -> CAbs -> CF -> String
mkHFile RecordPositions
rp Maybe String
inPackage CAbs
cab CF
cf, Maybe String -> CAbs -> CF -> String
mkCFile Maybe String
inPackage CAbs
cab CF
cf)
  where
    cab :: CAbs
cab = CF -> CAbs
cf2cabs CF
cf


-- **** Header (.H) File Functions **** --

--Makes the Header file.
mkHFile :: RecordPositions -> Maybe String -> CAbs -> CF -> String
mkHFile :: RecordPositions -> Maybe String -> CAbs -> CF -> String
mkHFile RecordPositions
rp Maybe String
inPackage CAbs
cabs CF
cf = [String] -> String
unlines
 [
  String
"#ifndef " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hdef,
  String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hdef,
  String
"",
  String
"#include<string>",
  String
"#include<vector>",
  String
"",
  String
"//C++ Abstract Syntax Interface.",
  Maybe String -> String
nsStart Maybe String
inPackage,
  String
"/********************   TypeDef Section    ********************/",
  String
"",
  [String] -> String
unlines [String
"typedef " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" | (String
c,String
d) <- [(String, String)]
basetypes],
  String
"",
  [String] -> String
unlines [String
"typedef std::string " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" | String
s <- CAbs -> [String]
tokentypes CAbs
cabs],
  String
"",
  String
"/********************   Forward Declarations    ********************/",
  String
"",
  [String] -> String
unlines [String
"class " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" | String
c <- [String]
classes, String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
c (CAbs -> [String]
defineds CAbs
cabs)],
  String
"",
  String
"/********************   Visitor Interfaces    ********************/",
  CAbs -> String
prVisitor CAbs
cabs,
  String
"",
  String
prVisitable,
  String
"",
  String
"/********************   Abstract Syntax Classes    ********************/",
  String
"",
  [String] -> String
unlines [RecordPositions -> String -> String
prAbs RecordPositions
rp String
c | String
c <- CAbs -> [String]
absclasses CAbs
cabs],
  String
"",
  [String] -> String
unlines [(String, CAbsRule) -> String
prCon (String
c,CAbsRule
r) | (String
c,[CAbsRule]
rs) <- CAbs -> [(String, [CAbsRule])]
signatures CAbs
cabs, CAbsRule
r <- [CAbsRule]
rs],
  String
"",
  [String] -> String
unlines [(String, Bool) -> String
prList (String, Bool)
c | (String, Bool)
c <- CAbs -> [(String, Bool)]
listtypes CAbs
cabs],
  String
"",
  Maybe ListConstructors -> CF -> String -> String
definedRules Maybe ListConstructors
forall a. Maybe a
Nothing CF
cf
  String
"/********************   Defined Constructors    ********************/",
  Maybe String -> String
nsEnd Maybe String
inPackage,
  String
"#endif"
 ]
 where
  classes :: [String]
classes = CAbs -> [String]
allClasses CAbs
cabs
  hdef :: String
hdef = Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"ABSYN_HEADER"

-- auxiliaries

prVisitable :: String
prVisitable :: String
prVisitable = [String] -> String
unlines [
  String
"class Visitable",
  String
"{",
  String
" public:",
  -- all classes with virtual methods require a virtual destructor
  String
"  virtual ~Visitable() {}",
  String
"  virtual void accept(Visitor *v) = 0;",
  String
"};"
  ]

prVisitor :: CAbs -> String
prVisitor :: CAbs -> String
prVisitor CAbs
cf = [String] -> String
unlines [
  String
"class Visitor",
  String
"{",
  String
"public:",
  String
"  virtual ~Visitor() {}",
  [String] -> String
unlines
    [String
"  virtual void visit"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"("String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" *p) = 0;" | String
c <- CAbs -> [String]
allClasses CAbs
cf,
                                                      String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
c (CAbs -> [String]
defineds CAbs
cf)],
  String
"",
  [String] -> String
unlines
    [String
"  virtual void visit"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" x) = 0;" | String
c <- CAbs -> [String]
allNonClasses CAbs
cf],
  String
"};"
 ]

prAbs :: RecordPositions -> String -> String
prAbs :: RecordPositions -> String -> String
prAbs RecordPositions
rp String
c = [String] -> String
unlines [
  String
"class " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : public Visitable",
  String
"{",
  String
"public:",
  String
"  virtual " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *clone() const = 0;",
  if RecordPositions
rp RecordPositions -> RecordPositions -> Bool
forall a. Eq a => a -> a -> Bool
== RecordPositions
RecordPositions then String
"  int line_number, char_number;" else String
"",
  String
"};"
  ]

prCon :: (String, CAbsRule) -> String
prCon :: (String, CAbsRule) -> String
prCon (String
c,(String
f,[(String, Bool, String)]
cs)) = [String] -> String
unlines [
  String
"class " String -> String -> String
forall a. [a] -> [a] -> [a]
++String
fString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : public " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c,
  String
"{",
  String
"public:",
  [String] -> String
unlines
    [String
"  "String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ String -> String -> String
+++ Bool -> String -> String
pointerIf Bool
st String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" | (String
typ,Bool
st,String
var) <- [(String, Bool, String)]
cs],
  String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" &);",
  String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" &operator=(const " String -> String -> String
forall a. [a] -> [a] -> [a]
++String
fString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" &);",
  String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
conargs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");",
    -- Typ *p1, PIdent *p2, ListStm *p3);
  String
"  ~" String -> String -> String
forall a. [a] -> [a] -> [a]
++String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"();",
  String
"  virtual void accept(Visitor *v);",
  String
"  virtual " String -> String -> String
forall a. [a] -> [a] -> [a]
++String
fString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *clone() const;",
  String
"  void swap(" String -> String -> String
forall a. [a] -> [a] -> [a]
++String
fString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" &);",
  String
"};"
  ]
 where
   conargs :: String
conargs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", "
     [String
x String -> String -> String
+++ Bool -> String -> String
pointerIf Bool
st (String
"p" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i) | ((String
x,Bool
st,String
_),Int
i) <- [(String, Bool, String)]
-> [Int] -> [((String, Bool, String), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, Bool, String)]
cs [Int
1::Int ..]]

prList :: (String, Bool) -> String
prList :: (String, Bool) -> String
prList (String
c, Bool
b) = [String] -> String
unlines
  [ String
"class " String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" : public Visitable, public std::vector<" String -> String -> String
forall a. [a] -> [a] -> [a]
++String
basString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">"
  , String
"{"
  , String
"public:"
  , String
"  virtual void accept(Visitor *v);"
  , String
"  virtual " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *clone() const;"
  , String
"};"
  , String
""
    -- cons for this list type
  , [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
c, String
"* ", String
"cons", String
c, String
"(", String
bas, String
" x, ", String
c, String
"* xs);" ]
  ]
  where
  bas :: String
bas = Bool -> (String -> String) -> String -> String
forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
b (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*") (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
c {- drop "List" -}


-- **** Implementation (.C) File Functions **** --

mkCFile :: Maybe String -> CAbs -> CF -> String
mkCFile :: Maybe String -> CAbs -> CF -> String
mkCFile Maybe String
inPackage CAbs
cabs CF
cf = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [
  String
"//C++ Abstract Syntax Implementation.",
  String
"#include <algorithm>",
  String
"#include <string>",
  String
"#include <vector>",
  String
"#include \"Absyn.H\"",
  Maybe String -> String
nsStart Maybe String
inPackage,
  [String] -> String
unlines [CAbsRule -> String
prConC  CAbsRule
r | (String
_,[CAbsRule]
rs) <- CAbs -> [(String, [CAbsRule])]
signatures CAbs
cabs, CAbsRule
r <- [CAbsRule]
rs],
  [String] -> String
unlines [(String, Bool) -> String
prListC (String, Bool)
l | (String, Bool)
l <- CAbs -> [(String, Bool)]
listtypes CAbs
cabs],
  Maybe ListConstructors -> CF -> String -> String
definedRules (ListConstructors -> Maybe ListConstructors
forall a. a -> Maybe a
Just (ListConstructors -> Maybe ListConstructors)
-> ListConstructors -> Maybe ListConstructors
forall a b. (a -> b) -> a -> b
$ (Base -> (String, Type))
-> (Base -> (String, Type)) -> ListConstructors
LC Base -> (String, Type)
nil Base -> (String, Type)
cons) CF
cf
  String
"/********************   Defined Constructors    ********************/",
  Maybe String -> String
nsEnd Maybe String
inPackage
  ]
  where
  nil :: Base -> (String, Type)
nil  Base
t = (,Type
dummyType) (String -> (String, Type)) -> String -> (String, Type)
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"new List", Base -> String
identType Base
t, String
"()" ]
  cons :: Base -> (String, Type)
cons Base
t = (,Type
dummyType) (String -> (String, Type)) -> String -> (String, Type)
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"consList", Base -> String
identType Base
t ]


prConC :: CAbsRule -> String
prConC :: CAbsRule -> String
prConC fcs :: CAbsRule
fcs@(String
f,[(String, Bool, String)]
_) = [String] -> String
unlines [
  String
"/********************   " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"    ********************/",
  CAbsRule -> String
prConstructorC CAbsRule
fcs,
  CAbsRule -> String
prCopyC CAbsRule
fcs,
  CAbsRule -> String
prDestructorC CAbsRule
fcs,
  String -> String
prAcceptC String
f,
  String -> String
prCloneC String
f,
  String
""
 ]

prListC :: (String,Bool) -> String
prListC :: (String, Bool) -> String
prListC (String
c,Bool
b) = [String] -> String
unlines
  [ String
"/********************   " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"    ********************/"
  , String
""
  , String -> String
prAcceptC String
c
  , String -> String
prCloneC String
c
  , String -> Bool -> String
prConsC String
c Bool
b
  ]


--The standard accept function for the Visitor pattern
prAcceptC :: String -> String
prAcceptC :: String -> String
prAcceptC String
ty = [String] -> String
unlines [
  String
"void " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::accept(Visitor *v)",
  String
"{",
  String
"  v->visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ty String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(this);",
  String
"}"
  ]

--The cloner makes a new deep copy of the object
prCloneC :: String -> String
prCloneC :: String -> String
prCloneC String
c = [String] -> String
unlines [
  String
c String -> String -> String
+++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::clone() const",
  String
"{",
  String
"  return new" String -> String -> String
+++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(*this);",
  String
"}"
  ]

-- | Make a list constructor definition.
prConsC :: String -> Bool -> String
prConsC :: String -> Bool -> String
prConsC String
c Bool
b = [String] -> String
unlines
  [ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
c, String
"* ", String
"cons", String
c, String
"(", String
bas, String
" x, ", String
c, String
"* xs) {" ]
  , String
"  xs->insert(xs->begin(), x);"
  , String
"  return xs;"
  , String
"}"
  ]
  where
  bas :: String
bas = Bool -> (String -> String) -> String -> String
forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
b (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*") (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
c {- drop "List" -}

--The constructor assigns the parameters to the corresponding instance variables.
prConstructorC :: CAbsRule -> String
prConstructorC :: CAbsRule -> String
prConstructorC (String
f,[(String, Bool, String)]
cs) = [String] -> String
unlines [
  String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
conargs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")",
  String
"{",
  [String] -> String
unlines [String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" | (String
c,String
p) <- [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
cvs [String]
pvs],
  String
"}"
  ]
 where
   cvs :: [String]
cvs = [String
c | (String
_,Bool
_,String
c) <- [(String, Bool, String)]
cs]
   pvs :: [String]
pvs = [Char
'p' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i | ((String
_,Bool
_,String
_),Int
i) <- [(String, Bool, String)]
-> [Int] -> [((String, Bool, String), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, Bool, String)]
cs [Int
1::Int ..]]
   conargs :: String
conargs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", "
     [String
x String -> String -> String
+++ Bool -> String -> String
pointerIf Bool
st String
v | ((String
x,Bool
st,String
_),String
v) <- [(String, Bool, String)]
-> [String] -> [((String, Bool, String), String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, Bool, String)]
cs [String]
pvs]


--Copy constructor and copy assignment
prCopyC :: CAbsRule -> String
prCopyC :: CAbsRule -> String
prCopyC (String
c,[(String, Bool, String)]
cs) = [String] -> String
unlines [
  String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const" String -> String -> String
+++ String
c String -> String -> String
+++ String
"& other)",
  String
"{",
  [String] -> String
unlines [String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cv String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = other." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Bool -> String -> String
cloneIf Bool
st String
cv String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";" | (String
_,Bool
st,String
cv) <- [(String, Bool, String)]
cs],
  String
"}",
  String
"",
  String
c String -> String -> String
+++ String
"&" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"operator=(const" String -> String -> String
+++ String
c String -> String -> String
+++ String
"& other)",
  String
"{",
  String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
+++ String
"tmp(other);",
  String
"  swap(tmp);",
  String
"  return *this;",
  String
"}",
  String
"",
  String
"void" String -> String -> String
+++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::swap(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
+++ String
"& other)",
  String
"{",
  [String] -> String
unlines [String
"  std::swap(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cv String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", other." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cv String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");" | (String
_,Bool
_,String
cv) <- [(String, Bool, String)]
cs],
  String
"}"
  ]
 where
   cloneIf :: Bool -> String -> String
cloneIf Bool
st String
cv = if Bool
st then (String
cv String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->clone()") else String
cv

--The destructor deletes all a class's members.
prDestructorC :: CAbsRule -> String
prDestructorC :: CAbsRule -> String
prDestructorC (String
c,[(String, Bool, String)]
cs) = [String] -> String
unlines [
  String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"::~" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"()",
  String
"{",
  [String] -> String
unlines [String
"  delete(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cv String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");" | (String
_,Bool
isPointer,String
cv) <- [(String, Bool, String)]
cs, Bool
isPointer],
  String
"}"
  ]