{-
    BNF Converter: C++ Main file
    Copyright (C) 2004  Author:  Markus Forsberg, Michael Pellauer
    Copyright (C) 2020  Andreas Abel

    Modified from CPPTop to BNFC.Backend.CPP.STL 2006 by Aarne Ranta.

-}

module BNFC.Backend.CPP.STL (makeCppStl,) where

import Data.Char
import Data.Foldable (toList)
import qualified Data.List as List
import qualified Data.Map as Map

import BNFC.Utils
import BNFC.CF
import BNFC.Options
import BNFC.Backend.Base
import BNFC.Backend.C            (bufferH, bufferC)
import BNFC.Backend.C.CFtoBisonC (unionBuiltinTokens)
import BNFC.Backend.CPP.Makefile
import BNFC.Backend.CPP.STL.CFtoSTLAbs
import BNFC.Backend.CPP.NoSTL.CFtoFlex
import BNFC.Backend.CPP.STL.CFtoBisonSTL
import BNFC.Backend.CPP.STL.CFtoCVisitSkelSTL
import BNFC.Backend.CPP.PrettyPrinter
import BNFC.Backend.CPP.STL.STLUtils
import qualified BNFC.Backend.Common.Makefile as Makefile

makeCppStl :: SharedOptions -> CF -> MkFiles ()
makeCppStl :: SharedOptions -> CF -> MkFiles ()
makeCppStl SharedOptions
opts CF
cf = do
    let (String
hfile, String
cfile) = RecordPositions -> Maybe String -> String -> CF -> (String, String)
cf2CPPAbs (SharedOptions -> RecordPositions
linenumbers SharedOptions
opts) (SharedOptions -> Maybe String
inPackage SharedOptions
opts) String
name CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Absyn.H" String
hfile
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Absyn.C" String
cfile
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Buffer.H" String
bufferH
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Buffer.C" (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> String
bufferC String
"Buffer.H"
    let (String
flex, SymMap
env) = Maybe String -> String -> CF -> (String, SymMap)
cf2flex (SharedOptions -> Maybe String
inPackage SharedOptions
opts) String
name CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".l") String
flex
    let bison :: String
bison = RecordPositions -> Maybe String -> String -> CF -> SymMap -> String
cf2Bison (SharedOptions -> RecordPositions
linenumbers SharedOptions
opts) (SharedOptions -> Maybe String
inPackage SharedOptions
opts) String
name CF
cf SymMap
env
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile (String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".y") String
bison
    let header :: String
header = Maybe String -> CF -> [Cat] -> [Cat] -> [String] -> String
forall (t :: * -> *) f.
Foldable t =>
Maybe String -> CFG f -> [Cat] -> t Cat -> [String] -> String
mkHeaderFile (SharedOptions -> Maybe String
inPackage SharedOptions
opts) CF
cf (CF -> [Cat]
forall f. CFG f -> [Cat]
allParserCats CF
cf) (NonEmpty Cat -> [Cat]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty Cat -> [Cat]) -> NonEmpty Cat -> [Cat]
forall a b. (a -> b) -> a -> b
$ CF -> NonEmpty Cat
forall f. CFG f -> NonEmpty Cat
allEntryPoints CF
cf) (SymMap -> [String]
forall k a. Map k a -> [a]
Map.elems SymMap
env)
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Parser.H" String
header
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"ParserError.H" (String -> MkFiles ()) -> String -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ Maybe String -> String
printParseErrHeader (SharedOptions -> Maybe String
inPackage SharedOptions
opts)
    let (String
skelH, String
skelC) = Bool -> Maybe String -> CF -> (String, String)
cf2CVisitSkel Bool
True (SharedOptions -> Maybe String
inPackage SharedOptions
opts) CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Skeleton.H" String
skelH
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Skeleton.C" String
skelC
    let (String
prinH, String
prinC) = Bool -> Maybe String -> CF -> (String, String)
cf2CPPPrinter Bool
True (SharedOptions -> Maybe String
inPackage SharedOptions
opts) CF
cf
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Printer.H" String
prinH
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Printer.C" String
prinC
    String -> String -> MkFiles ()
forall c. FileContent c => String -> c -> MkFiles ()
mkfile String
"Test.C" (Maybe String -> CF -> String
cpptest (SharedOptions -> Maybe String
inPackage SharedOptions
opts) CF
cf)
    SharedOptions -> (String -> Doc) -> MkFiles ()
Makefile.mkMakefile SharedOptions
opts ((String -> Doc) -> MkFiles ()) -> (String -> Doc) -> MkFiles ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Doc
makefile String
name
  where name :: String
name = SharedOptions -> String
lang SharedOptions
opts

printParseErrHeader :: Maybe String -> String
printParseErrHeader :: Maybe String -> String
printParseErrHeader Maybe String
inPackage =
  [String] -> String
unlines
  [
     String
" #pragma once "
     , String
" #include <string>"
     , String
" #include <stdexcept>"
     , String
""
     , Maybe String -> String
nsStart Maybe String
inPackage
     , String
" class parse_error : public std::runtime_error"
     , String
" {"
     , String
" public:"
     , String
"     parse_error(int line, std::string str)"
     , String
"         : std::runtime_error(str)"
     , String
"         , m_line(line) {}"
     , String
"     int getLine() {"
     , String
"         return m_line;"
     , String
"     } "
     , String
" private:"
     , String
"     int m_line;"
     , String
" }; "
     , Maybe String -> String
nsEnd Maybe String
inPackage
     ]

cpptest :: Maybe String -> CF -> String
cpptest :: Maybe String -> CF -> String
cpptest Maybe String
inPackage CF
cf =
  [String] -> String
unlines
   [
    String
"/*** Compiler Front-End Test automatically generated by the BNF Converter ***/",
    String
"/*                                                                          */",
    String
"/* This test will parse a file, print the abstract syntax tree, and then    */",
    String
"/* pretty-print the result.                                                 */",
    String
"/*                                                                          */",
    String
"/****************************************************************************/",
    String
"#include <cstdio>",
    String
"#include <string>",
    String
"#include <iostream>",
    String
"#include \"Parser.H\"",
    String
"#include \"Printer.H\"",
    String
"#include \"Absyn.H\"",
    String
"#include \"ParserError.H\"",
    String
"",
    String
"void usage() {",
    String
"  printf(\"usage: Call with one of the following argument " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"combinations:\\n\");",
    String
"  printf(\"\\t--help\\t\\tDisplay this help message.\\n\");",
    String
"  printf(\"\\t(no arguments)\\tParse stdin verbosely.\\n\");",
    String
"  printf(\"\\t(files)\\t\\tParse content of files verbosely.\\n\");",
    String
"  printf(\"\\t-s (files)\\tSilent mode. Parse content of files " String -> String -> String
forall a. [a] -> [a] -> [a]
++
      String
"silently.\\n\");",
    String
"}",
    String
"",
    String
"int main(int argc, char ** argv)",
    String
"{",
    String
"  FILE *input;",
    String
"  int quiet = 0;",
    String
"  char *filename = NULL;",
    String
"",
    String
"  if (argc > 1) {",
    String
"    if (strcmp(argv[1], \"-s\") == 0) {",
    String
"      quiet = 1;",
    String
"      if (argc > 2) {",
    String
"        filename = argv[2];",
    String
"      } else {",
    String
"        input = stdin;",
    String
"      }",
    String
"    } else {",
    String
"      filename = argv[1];",
    String
"    }",
    String
"  }",
    String
"",
    String
"  if (filename) {",
    String
"    input = fopen(filename, \"r\");",
    String
"    if (!input) {",
    String
"      usage();",
    String
"      exit(1);",
    String
"    }",
    String
"  } else input = stdin;",
    String
"  /* The default entry point is used. For other options see Parser.H */",
    String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scope String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dat String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" *parse_tree = NULL;",
    String
"  try { ",
    String
"  parse_tree = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scope String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"p" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
def String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(input);",
    String
"  } catch( " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scope String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"parse_error &e) {",
    String
"     std::cerr << \"Parse error on line \" << e.getLine() << \"\\n\"; ",
    String
"  }",
    String
"  if (parse_tree)",
    String
"  {",
    String
"    printf(\"\\nParse Successful!\\n\");",
    String
"    if (!quiet) {",
    String
"      printf(\"\\n[Abstract Syntax]\\n\");",
    String
"      " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scope String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ShowAbsyn *s = new " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scope String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"ShowAbsyn();",
    String
"      printf(\"%s\\n\\n\", s->show(parse_tree));",
    String
"      printf(\"[Linearized Tree]\\n\");",
    String
"      " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scope String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"PrintAbsyn *p = new " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scope String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"PrintAbsyn();",
    String
"      printf(\"%s\\n\\n\", p->print(parse_tree));",
    String
"    }",
    String
"    return 0;",
    String
"  }",
    String
"  return 1;",
    String
"}",
    String
""
   ]
  where
   cat :: Cat
cat = CF -> Cat
firstEntry CF
cf
   dat :: String
dat = Cat -> String
identCat (Cat -> String) -> Cat -> String
forall a b. (a -> b) -> a -> b
$ Cat -> Cat
normCat Cat
cat
   def :: String
def = Cat -> String
identCat Cat
cat
   scope :: String
scope = Maybe String -> String
nsScope Maybe String
inPackage

mkHeaderFile :: Maybe String -> CFG f -> [Cat] -> t Cat -> [String] -> String
mkHeaderFile Maybe String
inPackage CFG f
cf [Cat]
cats t Cat
eps [String]
env = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ 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<vector>"
    , String
"#include<string>"
    , String
""
    , Maybe String -> String
nsStart Maybe String
inPackage
    ]
  , (Cat -> String) -> [Cat] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Cat -> String
mkForwardDec ([Cat] -> [String]) -> [Cat] -> [String]
forall a b. (a -> b) -> a -> b
$ [Cat] -> [Cat]
forall a. Eq a => [a] -> [a]
List.nub ([Cat] -> [Cat]) -> [Cat] -> [Cat]
forall a b. (a -> b) -> a -> b
$ (Cat -> Cat) -> [Cat] -> [Cat]
forall a b. (a -> b) -> [a] -> [b]
map Cat -> Cat
normCat [Cat]
cats
  , [ String
"typedef union"
    , String
"{"
    ]
  , (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
unionBuiltinTokens
  , (Cat -> [String]) -> [Cat] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cat -> [String]
mkVar [Cat]
cats
  , [ String
"} YYSTYPE;"
    , String
""
    ]
  , (Cat -> [String]) -> t Cat -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cat -> [String]
mkFuncs t Cat
eps
  , [ Maybe String -> String
nsEnd Maybe String
inPackage
    , String
""
    , String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"_ERROR_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" 258"
    , Int -> [String] -> String
forall t. (Show t, Num t) => t -> [String] -> String
mkDefines (Int
259 :: Int) [String]
env
    , String
"extern " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
nsScope Maybe String
inPackage String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"YYSTYPE " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
nsString Maybe String
inPackage String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"yylval;"
    , String
""
    , String
"#endif"
    ]
  ]
  where
  hdef :: String
hdef = Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"PARSER_HEADER_FILE"
  mkForwardDec :: Cat -> String
mkForwardDec Cat
s = String
"class " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat Cat
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";"
  mkVar :: Cat -> [String]
mkVar Cat
s | Cat -> Cat
normCat Cat
s Cat -> Cat -> Bool
forall a. Eq a => a -> a -> Bool
== Cat
s = [ String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat Cat
s String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"*" String -> String -> String
+++ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Cat -> String
identCat Cat
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_;" ]
  mkVar Cat
_ = []
  mkDefines :: t -> [String] -> String
mkDefines t
n [] = t -> String
forall a. (Show a, Num a) => a -> String
mkString t
n
  mkDefines t
n (String
s:[String]
ss) = String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
+++ t -> String
forall a. Show a => a -> String
show t
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ t -> [String] -> String
mkDefines (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1) [String]
ss -- "nsDefine inPackage s" not needed (see cf2flex::makeSymEnv)
  mkString :: a -> String
mkString a
n =  if CFG f -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CFG f
cf (String -> Cat
TokenCat String
catString)
   then (String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"_STRING_ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Show a, Num a) => a -> String
mkChar (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1)
   else a -> String
forall a. (Show a, Num a) => a -> String
mkChar a
n
  mkChar :: a -> String
mkChar a
n =  if CFG f -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CFG f
cf (String -> Cat
TokenCat String
catChar)
   then (String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"_CHAR_ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Show a, Num a) => a -> String
mkInteger (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1)
   else a -> String
forall a. (Show a, Num a) => a -> String
mkInteger a
n
  mkInteger :: a -> String
mkInteger a
n =  if CFG f -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CFG f
cf (String -> Cat
TokenCat String
catInteger)
   then (String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"_INTEGER_ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. (Show a, Num a) => a -> String
mkDouble (a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1)
   else a -> String
forall a. (Show a, Num a) => a -> String
mkDouble a
n
  mkDouble :: a -> String
mkDouble a
n =  if CFG f -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CFG f
cf (String -> Cat
TokenCat String
catDouble)
   then (String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"_DOUBLE_ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
mkIdent(a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1)
   else a -> String
forall a. Show a => a -> String
mkIdent a
n
  mkIdent :: a -> String
mkIdent a
n =  if CFG f -> Cat -> Bool
forall f. CFG f -> Cat -> Bool
isUsedCat CFG f
cf (String -> Cat
TokenCat String
catIdent)
   then String
"#define " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> String
nsDefine Maybe String
inPackage String
"_IDENT_ " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
   else String
""
  mkFuncs :: Cat -> [String]
mkFuncs Cat
s =
    [ Cat -> String
identCat (Cat -> Cat
normCat Cat
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*" String -> String -> String
+++ String
"p" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat Cat
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(FILE *inp);"
    , Cat -> String
identCat (Cat -> Cat
normCat Cat
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"*" String -> String -> String
+++ String
"p" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Cat -> String
identCat Cat
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(const char *str);"
    ]