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

-- CPP/NoSTL treats 'position token' as just 'token'.
basics :: Bool -> CAbs -> [String]
basics :: Bool -> CAbs -> [[Char]]
basics Bool
useSTL CAbs
cf = [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst [([Char], [Char])]
basetypes
  , CAbs -> [[Char]]
tokentypes CAbs
cf
  , Bool -> [[Char]] -> [[Char]]
forall m. Monoid m => Bool -> m -> m
unless Bool
useSTL ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ CAbs -> [[Char]]
postokens CAbs
cf
  ]


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

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

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

prBasic :: String -> String
prBasic :: [Char] -> [Char]
prBasic [Char]
c = [[Char]] -> [Char]
unlines [
  [Char]
"void Skeleton::visit" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"(" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" x)",
  [Char]
"{",
  [Char]
"  /* Code for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" Goes Here */",
  [Char]
"}"
  ]

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

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