{-
    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.Foldable (toList)

import BNFC.Utils
import BNFC.CF
import BNFC.Options
import BNFC.Backend.Base
import BNFC.Backend.C            ( bufferH, bufferC, comment, testfileHeader )
import BNFC.Backend.C.CFtoBisonC ( cf2Bison )
import BNFC.Backend.C.CFtoFlexC  ( cf2flex, ParserMode(..) )
import BNFC.Backend.CPP.Common   ( commentWithEmacsModeHint )
import BNFC.Backend.CPP.Makefile
import BNFC.Backend.CPP.STL.CFtoSTLAbs
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 ([Char]
hfile, [Char]
cfile) = RecordPositions -> Maybe [Char] -> [Char] -> CF -> ([Char], [Char])
cf2CPPAbs (SharedOptions -> RecordPositions
linenumbers SharedOptions
opts) (SharedOptions -> Maybe [Char]
inPackage SharedOptions
opts) [Char]
name CF
cf
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFile [Char]
"Absyn.H" [Char]
hfile
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFile [Char]
"Absyn.C" [Char]
cfile
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFile [Char]
"Buffer.H" [Char]
bufferH
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFile [Char]
"Buffer.C" forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
bufferC [Char]
"Buffer.H"
    let ([Char]
flex, SymMap
env) = ParserMode -> CF -> ([Char], SymMap)
cf2flex ParserMode
parserMode CF
cf
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFileWithHint ([Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".l") [Char]
flex
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFileWithHint ([Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
".y") forall a b. (a -> b) -> a -> b
$ RecordPositions -> ParserMode -> CF -> SymMap -> [Char]
cf2Bison (SharedOptions -> RecordPositions
linenumbers SharedOptions
opts) ParserMode
parserMode CF
cf SymMap
env
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFile [Char]
"Parser.H" forall a b. (a -> b) -> a -> b
$
      Maybe [Char] -> [Cat] -> [Char]
mkHeaderFile (SharedOptions -> Maybe [Char]
inPackage SharedOptions
opts) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall f. CFG f -> List1 Cat
allEntryPoints CF
cf)
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFile [Char]
"ParserError.H" forall a b. (a -> b) -> a -> b
$ Maybe [Char] -> [Char]
printParseErrHeader (SharedOptions -> Maybe [Char]
inPackage SharedOptions
opts)
    let ([Char]
skelH, [Char]
skelC) = Bool -> Maybe [Char] -> CF -> ([Char], [Char])
cf2CVisitSkel Bool
True (SharedOptions -> Maybe [Char]
inPackage SharedOptions
opts) CF
cf
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFile [Char]
"Skeleton.H" [Char]
skelH
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFile [Char]
"Skeleton.C" [Char]
skelC
    let ([Char]
prinH, [Char]
prinC) = Bool -> Maybe [Char] -> CF -> ([Char], [Char])
cf2CPPPrinter Bool
True (SharedOptions -> Maybe [Char]
inPackage SharedOptions
opts) CF
cf
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFile [Char]
"Printer.H" [Char]
prinH
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFile [Char]
"Printer.C" [Char]
prinC
    forall {c}. FileContent c => [Char] -> c -> MkFiles ()
mkCppFile [Char]
"Test.C" (Maybe [Char] -> CF -> [Char]
cpptest (SharedOptions -> Maybe [Char]
inPackage SharedOptions
opts) CF
cf)
    SharedOptions -> ([Char] -> Doc) -> MkFiles ()
Makefile.mkMakefile SharedOptions
opts forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char] -> Doc
makefile [Char]
prefix [Char]
name
  where
    name :: String
    name :: [Char]
name = SharedOptions -> [Char]
lang SharedOptions
opts
    -- The prefix is a string used by flex and bison
    -- that is prepended to generated function names.
    -- It should be a valid C identifier.
    prefix :: String
    prefix :: [Char]
prefix = [Char] -> [Char]
snakeCase_ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
"_"
    parserMode :: ParserMode
    parserMode :: ParserMode
parserMode = Maybe [Char] -> [Char] -> ParserMode
CppParser (SharedOptions -> Maybe [Char]
inPackage SharedOptions
opts) [Char]
prefix
    mkCppFile :: [Char] -> c -> MkFiles ()
mkCppFile         [Char]
x = forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile [Char]
x [Char] -> [Char]
comment
    mkCppFileWithHint :: [Char] -> c -> MkFiles ()
mkCppFileWithHint [Char]
x = forall c.
FileContent c =>
[Char] -> ([Char] -> [Char]) -> c -> MkFiles ()
mkfile [Char]
x [Char] -> [Char]
commentWithEmacsModeHint

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

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

mkHeaderFile :: Maybe String -> [Cat] -> String
mkHeaderFile :: Maybe [Char] -> [Cat] -> [Char]
mkHeaderFile Maybe [Char]
inPackage [Cat]
eps = [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ [Char]
"#ifndef " forall a. [a] -> [a] -> [a]
++ [Char]
hdef
    , [Char]
"#define " forall a. [a] -> [a] -> [a]
++ [Char]
hdef
    , [Char]
""
    , [Char]
"#include<vector>"
    , [Char]
"#include<string>"
    , [Char]
"#include<cstdio>"
    , [Char]
"#include \"Absyn.H\""
    , [Char]
""
    , Maybe [Char] -> [Char]
nsStart Maybe [Char]
inPackage
    ]
  , forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cat -> [[Char]]
mkFuncs [Cat]
eps
  , [ Maybe [Char] -> [Char]
nsEnd Maybe [Char]
inPackage
    , [Char]
""
    , [Char]
"#endif"
    ]
  ]
  where
  hdef :: [Char]
hdef = Maybe [Char] -> [Char] -> [Char]
nsDefine Maybe [Char]
inPackage [Char]
"PARSER_HEADER_FILE"
  mkFuncs :: Cat -> [[Char]]
mkFuncs Cat
s =
    [ Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
s) forall a. [a] -> [a] -> [a]
++ [Char]
"*" [Char] -> [Char] -> [Char]
+++ [Char]
"p" forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
identCat Cat
s forall a. [a] -> [a] -> [a]
++ [Char]
"(FILE *inp);"
    , Cat -> [Char]
identCat (Cat -> Cat
normCat Cat
s) forall a. [a] -> [a] -> [a]
++ [Char]
"*" [Char] -> [Char] -> [Char]
+++ [Char]
"p" forall a. [a] -> [a] -> [a]
++ Cat -> [Char]
identCat Cat
s forall a. [a] -> [a] -> [a]
++ [Char]
"(const char *str);"
    ]