content: {-# 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 rp inPackage _ cf = (mkHFile rp inPackage cab cf, mkCFile inPackage cab cf)
    where
      cab = cf2cabs cf
  
  
  -- **** Header (.H) File Functions **** --
  
  --Makes the Header file.
  mkHFile :: RecordPositions -> Maybe String -> CAbs -> CF -> String
  mkHFile rp inPackage cabs cf = unlines
   [
    "#ifndef " ++ hdef,
    "#define " ++ hdef,
    "",
    "#include<string>",
    "#include<vector>",
    "",
    "//C++ Abstract Syntax Interface.",
    nsStart inPackage,
    "/********************   TypeDef Section    ********************/",
    "",
    unlines ["typedef " ++ d ++ " " ++ c ++ ";" | (c,d) <- basetypes],
    "",
    unlines ["typedef std::string " ++ s ++ ";" | s <- tokentypes cabs],
    "",
    "/********************   Forward Declarations    ********************/",
    "",
    unlines ["class " ++ c ++ ";" | c <- classes, notElem c (defineds cabs)],
    "",
    "/********************   Visitor Interfaces    ********************/",
    prVisitor cabs,
    "",
    prVisitable,
    "",
    "/********************   Abstract Syntax Classes    ********************/",
    "",
    unlines [prAbs rp c | c <- absclasses cabs],
    "",
    unlines [prCon (c,r) | (c,rs) <- signatures cabs, r <- rs],
    "",
    unlines [prList c | c <- listtypes cabs],
    "",
    definedRules Nothing cf
    "/********************   Defined Constructors    ********************/",
    nsEnd inPackage,
    "#endif"
   ]
   where
    classes = allClasses cabs
    hdef = nsDefine inPackage "ABSYN_HEADER"
  
  -- auxiliaries
  
  prVisitable :: String
  prVisitable = unlines [
    "class Visitable",
    "{",
    " public:",
    -- all classes with virtual methods require a virtual destructor
    "  virtual ~Visitable() {}",
    "  virtual void accept(Visitor *v) = 0;",
    "};"
    ]
  
  prVisitor :: CAbs -> String
  prVisitor cf = unlines [
    "class Visitor",
    "{",
    "public:",
    "  virtual ~Visitor() {}",
    unlines
      ["  virtual void visit"++c++"("++c++" *p) = 0;" | c <- allClasses cf,
                                                        notElem c (defineds cf)],
    "",
    unlines
      ["  virtual void visit"++c++"(" ++c++" x) = 0;" | c <- allNonClasses cf],
    "};"
   ]
  
  prAbs :: RecordPositions -> String -> String
  prAbs rp c = unlines [
    "class " ++ c ++ " : public Visitable",
    "{",
    "public:",
    "  virtual " ++ c ++ " *clone() const = 0;",
    if rp == RecordPositions then "  int line_number, char_number;" else "",
    "};"
    ]
  
  prCon :: (String, CAbsRule) -> String
  prCon (c,(f,cs)) = unlines [
    "class " ++f++ " : public " ++ c,
    "{",
    "public:",
    unlines
      ["  "++ typ +++ pointerIf st var ++ ";" | (typ,st,var) <- cs],
    "  " ++ f ++ "(const " ++ f ++ " &);",
    "  " ++ f ++ " &operator=(const " ++f++ " &);",
    "  " ++ f ++ "(" ++ conargs ++ ");",
      -- Typ *p1, PIdent *p2, ListStm *p3);
    "  ~" ++f ++ "();",
    "  virtual void accept(Visitor *v);",
    "  virtual " ++f++ " *clone() const;",
    "  void swap(" ++f++ " &);",
    "};"
    ]
   where
     conargs = concat $ intersperse ", "
       [x +++ pointerIf st ("p" ++ show i) | ((x,st,_),i) <- zip cs [1::Int ..]]
  
  prList :: (String, Bool) -> String
  prList (c, b) = unlines
    [ "class " ++c++ " : public Visitable, public std::vector<" ++bas++ ">"
    , "{"
    , "public:"
    , "  virtual void accept(Visitor *v);"
    , "  virtual " ++ c ++ " *clone() const;"
    , "};"
    , ""
      -- cons for this list type
    , concat [ c, "* ", "cons", c, "(", bas, " x, ", c, "* xs);" ]
    ]
    where
    bas = applyWhen b (++ "*") $ drop 4 c {- drop "List" -}
  
  
  -- **** Implementation (.C) File Functions **** --
  
  mkCFile :: Maybe String -> CAbs -> CF -> String
  mkCFile inPackage cabs cf = unlines $ [
    "//C++ Abstract Syntax Implementation.",
    "#include <algorithm>",
    "#include <string>",
    "#include <vector>",
    "#include \"Absyn.H\"",
    nsStart inPackage,
    unlines [prConC  r | (_,rs) <- signatures cabs, r <- rs],
    unlines [prListC l | l <- listtypes cabs],
    definedRules (Just $ LC nil cons) cf
    "/********************   Defined Constructors    ********************/",
    nsEnd inPackage
    ]
    where
    nil  t = (,dummyType) $ concat [ "new List", identType t, "()" ]
    cons t = (,dummyType) $ concat [ "consList", identType t ]
  
  
  prConC :: CAbsRule -> String
  prConC fcs@(f,_) = unlines [
    "/********************   " ++ f ++ "    ********************/",
    prConstructorC fcs,
    prCopyC fcs,
    prDestructorC fcs,
    prAcceptC f,
    prCloneC f,
    ""
   ]
  
  prListC :: (String,Bool) -> String
  prListC (c,b) = unlines
    [ "/********************   " ++ c ++ "    ********************/"
    , ""
    , prAcceptC c
    , prCloneC c
    , prConsC c b
    ]
  
  
  --The standard accept function for the Visitor pattern
  prAcceptC :: String -> String
  prAcceptC ty = unlines [
    "void " ++ ty ++ "::accept(Visitor *v)",
    "{",
    "  v->visit" ++ ty ++ "(this);",
    "}"
    ]
  
  --The cloner makes a new deep copy of the object
  prCloneC :: String -> String
  prCloneC c = unlines [
    c +++ "*" ++ c ++ "::clone() const",
    "{",
    "  return new" +++ c ++ "(*this);",
    "}"
    ]
  
  -- | Make a list constructor definition.
  prConsC :: String -> Bool -> String
  prConsC c b = unlines
    [ concat [ c, "* ", "cons", c, "(", bas, " x, ", c, "* xs) {" ]
    , "  xs->insert(xs->begin(), x);"
    , "  return xs;"
    , "}"
    ]
    where
    bas = applyWhen b (++ "*") $ drop 4 c {- drop "List" -}
  
  --The constructor assigns the parameters to the corresponding instance variables.
  prConstructorC :: CAbsRule -> String
  prConstructorC (f,cs) = unlines [
    f ++ "::" ++ f ++ "(" ++ conargs ++ ")",
    "{",
    unlines ["  " ++ c ++ " = " ++ p ++ ";" | (c,p) <- zip cvs pvs],
    "}"
    ]
   where
     cvs = [c | (_,_,c) <- cs]
     pvs = ['p' : show i | ((_,_,_),i) <- zip cs [1::Int ..]]
     conargs = intercalate ", "
       [x +++ pointerIf st v | ((x,st,_),v) <- zip cs pvs]
  
  
  --Copy constructor and copy assignment
  prCopyC :: CAbsRule -> String
  prCopyC (c,cs) = unlines [
    c ++ "::" ++ c ++ "(const" +++ c +++ "& other)",
    "{",
    unlines ["  " ++ cv ++ " = other." ++ cloneIf st cv ++ ";" | (_,st,cv) <- cs],
    "}",
    "",
    c +++ "&" ++ c ++ "::" ++ "operator=(const" +++ c +++ "& other)",
    "{",
    "  " ++ c +++ "tmp(other);",
    "  swap(tmp);",
    "  return *this;",
    "}",
    "",
    "void" +++ c ++ "::swap(" ++ c +++ "& other)",
    "{",
    unlines ["  std::swap(" ++ cv ++ ", other." ++ cv ++ ");" | (_,_,cv) <- cs],
    "}"
    ]
   where
     cloneIf st cv = if st then (cv ++ "->clone()") else cv
  
  --The destructor deletes all a class's members.
  prDestructorC :: CAbsRule -> String
  prDestructorC (c,cs) = unlines [
    c ++ "::~" ++ c ++"()",
    "{",
    unlines ["  delete(" ++ cv ++ ");" | (_,isPointer,cv) <- cs, isPointer],
    "}"
    ]
  