{-
    BNF Converter: C++ Skeleton generation
    Copyright (C) 2004  Author:  Michael Pellauer

    Description   : This module generates the C++ Skeleton functions.

                    The generated files use the Visitor design pattern.

    Author        : Michael Pellauer
    Created       : 9 August, 2003
    Modified      : 29 August, 2006 Aarne Ranta

-}

module BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL (cf2CVisitSkel) where

import Data.Char

import BNFC.CF
import BNFC.Utils ((+++), unless)
import BNFC.Backend.Common.OOAbstract
import BNFC.Backend.CPP.Naming
import BNFC.Backend.CPP.STL.STLUtils

--Produces (.H file, .C file)
cf2CVisitSkel :: Bool -> Maybe String -> CF -> (String, String)
cf2CVisitSkel :: Bool -> Maybe String -> CF -> (String, String)
cf2CVisitSkel Bool
useSTL Maybe String
inPackage CF
cf =
 ( Bool -> Maybe String -> CAbs -> String
mkHFile Bool
useSTL Maybe String
inPackage CAbs
cab
 , Bool -> Maybe String -> CAbs -> String
mkCFile Bool
useSTL Maybe String
inPackage CAbs
cab
 )
 where
    cab :: CAbs
cab = CF -> CAbs
cf2cabs CF
cf

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

--Generates the Header File
mkHFile :: Bool -> Maybe String -> CAbs -> String
mkHFile :: Bool -> Maybe String -> CAbs -> String
mkHFile Bool
useSTL Maybe String
inPackage CAbs
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
"/* You might want to change the above name. */",
  String
"",
  String
"#include \"Absyn.H\"",
  String
"",
  Maybe String -> String
nsStart Maybe String
inPackage,
  String
"class Skeleton : public Visitor",
  String
"{",
  String
"public:",
  [String] -> String
unlines [String
"  void visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *p);" |
            String
b <- [String]
classes, String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
b (CAbs -> [String]
defineds CAbs
cf), Bool
useSTL Bool -> Bool -> Bool
|| String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
b (CAbs -> [String]
postokens CAbs
cf) ],
  [String] -> String
unlines [String
"  void visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
" x);" | String
b <- Bool -> CAbs -> [String]
basics Bool
useSTL CAbs
cf ],
  String
"};",
  Maybe String -> String
nsEnd Maybe String
inPackage,
  String
"",
  String
"#endif"
 ]
 where
   hdef :: String
hdef = Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"SKELETON_HEADER"
   classes :: [String]
classes = CAbs -> [String]
allClasses CAbs
cf

-- CPP/NoSTL treats 'position token' as just 'token'.
basics :: Bool -> CAbs -> [String]
basics :: Bool -> CAbs -> [String]
basics Bool
useSTL CAbs
cf = [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ ((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
  , CAbs -> [String]
tokentypes CAbs
cf
  , Bool -> [String] -> [String]
forall m. Monoid m => Bool -> m -> m
unless Bool
useSTL ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ CAbs -> [String]
postokens CAbs
cf
  ]


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

--Makes the .C File
mkCFile :: Bool -> Maybe String -> CAbs -> String
mkCFile :: Bool -> Maybe String -> CAbs -> String
mkCFile Bool
useSTL Maybe String
inPackage CAbs
cf = [String] -> String
unlines [
  String
headerC,
  Maybe String -> String
nsStart Maybe String
inPackage,
  [String] -> String
unlines [
    String
"void Skeleton::visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++
       String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *t) {} //abstract class" | String
t <- CAbs -> [String]
absclasses CAbs
cf],
  [String] -> String
unlines [ (String, [(String, Bool, String)]) -> String
prCon   (String, [(String, Bool, String)])
r  | (String
_,[(String, [(String, Bool, String)])]
rs)  <- CAbs -> [(String, [(String, [(String, Bool, String)])])]
signatures CAbs
cf, (String, [(String, Bool, String)])
r <- [(String, [(String, Bool, String)])]
rs, Bool
useSTL Bool -> Bool -> Bool
|| Bool -> Bool
not ((String, [(String, Bool, String)]) -> Bool
forall {b}. (String, b) -> Bool
posRule (String, [(String, Bool, String)])
r) ],
  [String] -> String
unlines [ Bool -> (String, Bool) -> String
prList Bool
useSTL (String, Bool)
cb | (String, Bool)
cb <- CAbs -> [(String, Bool)]
listtypes CAbs
cf ],
  [String] -> String
unlines [ String -> String
prBasic String
b  | String
b  <- [String]
base ],
  Maybe String -> String
nsEnd Maybe String
inPackage
 ]
  where
  -- See OOAbstract 'posdata':
  posRule :: (String, b) -> Bool
posRule (String
c, b
_) = String
c String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` CAbs -> [String]
postokens CAbs
cf
  base :: [String]
base = Bool -> CAbs -> [String]
basics Bool
useSTL CAbs
cf
  prCon :: (String, [(String, Bool, String)]) -> String
prCon (String
f,[(String, Bool, String)]
cs) = [String] -> String
unlines [
    String
"void Skeleton::visit" 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
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")",
    String
"{",
    String
"  /* Code For " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Goes Here */",
    String
"",
    [String] -> String
unlines [String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, Bool, String) -> String
visitArg (String, Bool, String)
c | (String, Bool, String)
c <- [(String, Bool, String)]
cs],
    String
"}"
   ]
   where
     v :: String
v = String -> String
mkVariable String
f
     visitArg :: (String, Bool, String) -> String
visitArg (String
cat,Bool
isPt,String
var)
       | Bool
isPt Bool -> Bool -> Bool
&& (Bool
useSTL Bool -> Bool -> Bool
|| String
cat String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
base)
                   = String
"if (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
field String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
field String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->accept(this);"
       | Bool
otherwise = String
"visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
field String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
       where field :: String
field = String
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
var

headerC :: String
headerC = [String] -> String
unlines [
      String
"/*** Visitor Design Pattern Skeleton. ***/",
      String
"/* This implements the common visitor design pattern.",
      String
"   Note that this method uses Visitor-traversal of lists, so",
      String
"   List->accept() does NOT traverse the list. This allows different",
      String
"   algorithms to use context information differently. */",
      String
"",
      String
"#include \"Skeleton.H\"",
      String
""
      ]

prBasic :: String -> String
prBasic String
c = [String] -> String
unlines [
  String
"void Skeleton::visit" 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
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" x)",
  String
"{",
  String
"  /* Code for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Goes Here */",
  String
"}"
  ]

prList :: Bool -> (String, Bool) -> String
prList Bool
True (String
cl,Bool
b) = [String] -> String
unlines [
  String
"void Skeleton::visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"("String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cl String -> String -> String
+++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")",
  String
"{",
  String
"  for ("String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cl String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"::iterator i = " String -> String -> String
forall a. [a] -> [a] -> [a]
++
       String
vnameString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"->begin() ; i != " String -> String -> String
forall a. [a] -> [a] -> [a]
++String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"->end() ; ++i)",
  String
"  {",
  if Bool
b
    then String
"    (*i)->accept(this);"
    else String
"    visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
cl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(*i) ;",
  String
"  }",
  String
"}"
  ]
 where
   vname :: String
vname = String -> String
mkVariable String
cl

prList Bool
False (String
cl,Bool
b) = [String] -> String
unlines
  [ String
"void Skeleton::visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"("String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cl String -> String -> String
+++ String
"*" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  , String
"{"
  , String
"  while (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
  , String
"  {"
  , String
"    /* Code For " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Goes Here */"
  , if Bool
b
      then String
"    if (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
field String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
field String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->accept(this);"
      else String
"    visit" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ecl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
field String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
");"
  , String
"    " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
next String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_;"
  , String
"  }"
  , String
"}"
  ]
  where
  ecl :: String
ecl    = Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 String
cl  -- drop "List"
  vname :: String
vname  = String -> String
mkVariable String
cl
  next :: String
next   = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cl
  member :: String
member = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
ecl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"
  field :: String
field  = String
vname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"->" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
member